videocapture.core - Videocapture

(defn preview-player-start [instance]
  (debug "Starting preview player.")
  (go (let [{:keys [pipeline appcaps image-container]} @videocapture.videocapture/vcapture
	    is-working? (atom false)]
	(fx/run-now (.addListener image-container
				  (fx/fi javafx.beans.value.ChangeListener [observable oldValue newValue]
					 (reset! is-working? true)
					 (fx/run-later (.setImage (.-videoView instance) newValue)))))
	(debug "Preview pipeline running.")
	(<! (async/timeout 4000))
	(.debugToDotFile pipeline 15 "preview")
	(if (and (not @is-working?) (= :device (settings/get-setting :camera :type)))
	  (do (gui-util/alert :error "Kamerafehler" "Leider ist ein Kamerafehler aufgetreten. Der Computer wird automatisch abgeschaltet. Nach dem Abschalten bitte die USB-Kamera aus- und wieder einstecken, dann den Computer einschalten.")
	      (sh/sh "systemctl" "poweroff"))
	  (when (not @is-working?)
	    (gui-util/notification :error "Kameraverbindung fehlgeschlagen" "Es konnte noch keine Verbindung zur Kamera aufgebaut werden. Erneuter Versuch...")
	    (mount/stop #'videocapture.videocapture/vcapture)
	    (async/put! (:disable-player @gui-out) true)
	    (Thread/sleep 400)
	    (async/put! (:re-init @gui-out) true)))
	[pipeline appcaps (fn [] (let [ch (chan)]
				  ;;(mount/stop #'videocapture.videocapture/vcapture)
				  (async/put! ch true) ch)) ;;(partial preview-player-stop instance pipeline)
	 ])))

(defn playback-player-stop [instance pipe]
  (go
    (.stop pipe)
    (fx/run-now (.adjustValue (.-seekSlider instance) 0.0)
		(.setText (.-timeLabel instance) ""))))

(defn playback-player-start [instance filename]
  (let [gst-listener (new AppSinkListener)
	image-container (.getImageContainer gst-listener)
	[pipe specials] (recorder/build-pipeline :playback)
	videosink ^Element (.getElementByName pipe "displaysink")
	filein ^Element (.getElementByName pipe "filein")
	extension (settings/get-setting :C :file-extension)
	not-eos? (atom true)]
    (debug "Abspielen von" (str (.toURI (io/file (str filename extension)))))
    (.set filein "uri" (str (.toURI (io/file (str filename extension)))))
    (.connect videosink gst-listener)
    (fx/run-now (.addListener image-container
			      (fx/fi javafx.beans.value.ChangeListener [observable oldValue newValue]
				     (fx/run-now (.setImage (.-videoView instance) newValue)))))
    (.connect (.getBus pipe) (fx/fi org.freedesktop.gstreamer.Bus$EOS
				    [src] (reset! not-eos? false)))
    (go (try (.play pipe) (catch Exception e (error e))))
    (Thread/sleep 200)
    (.debugToDotFile pipe 15 "playback")
    (debug "Videolänge in Sekunden:" (.queryDuration pipe) "Double:" (double (.toSeconds (.queryDuration pipe))))
    (.setMax (.-seekSlider instance) (double (.toSeconds (.queryDuration pipe))))
    (go-loop [position (.toSeconds (.queryPosition ^Pipeline pipe))
	      act      true]
      (if (and (.isPlaying pipe) @not-eos?)
	(do (when act
	      (fx/run-now (.adjustValue (.-seekSlider instance) (double position))
			  (let [point (t/duration position :seconds)
				text (str (leading-zero (t/as point :hours)) ":" (leading-zero (mod (t/as point :minutes) 60)) ":" (leading-zero (mod (t/as point :seconds) 60)))]
			    (.setText (.-timeLabel instance) text))))
	    (async/alt!
	      [(:seek-drag-start @gui-out)] (do (debug "Userinteraktion: Drag start")
						(recur (.toSeconds (.queryPosition pipe)) false))
	      [(:seek-drag-stop @gui-out)] (do (debug "Userinteraktion: Drag stop")
					       (.seek pipe (long (.getValue (.-seekSlider instance))) TimeUnit/SECONDS)
					       (debug "Userinteraktion: Setze Abspielzeit auf" (long (.getValue (.-seekSlider instance))) "Sekunden.")
					       (recur (long (.getValue (.-seekSlider instance))) true))
	      [(async/timeout 100)] (do (recur (.toSeconds (.queryPosition pipe)) act))))
	(when-not @not-eos?
	  (debug "Stream ended.")
	  (>! (:stop-button @gui-out) true))))
    (partial playback-player-stop instance pipe)))

(defn record-video-stop [instance pipe specials]
  (info "Ending stream.")
  (go
    (info "Stopping recording...")
    (reset! (:clock @core) nil)
    (mount/stop #'videocapture.videocapture/vcapture)
    (Thread/sleep 100)
    (fx/run-later (.setProgress (.-statusBar instance) 0.0)
		  (.setText (.-statusText instance) "OK")
		  (gui-util/alert :information "Aufnahme abgeschlossen." "Vergessen Sie nicht, die Videodatei zu prüfen, zu sichern und einzureichen!"))
    ))

(defn- filenamegen [instance]
  (if (= "therapie-mainwindow.fxml" (settings/get-setting :gui))
    (str (settings/get-setting :xdg :home) (.getText (.-therapistNrField instance)) "_" (.getText (.-patientNrField instance)) "_" (.getText (.-sessionField instance)) "_" (t/format "yyyy-MM-dd kkmmss" (t/local-date-time)) "_" (settings/get-setting :form :room))
    (str (settings/get-setting :xdg :home) (.getValue (.-groupList instance)) "_" (.getText (.-name1Field instance)) "+" (.getText (.-name2Field instance)) "_" (t/format "yyyyMMddkkmmss" (t/local-date-time)) "_" (settings/get-setting :form :room))))

(defn record-video [instance]
  (let []
    (info "Starting video recording.")
    (debug "GUI:" (settings/get-setting :gui))
    (if-not (or (= "therapie-mainwindow.fxml" (settings/get-setting :gui))
		(and (not (str/blank? (.getText (.-name1Field instance))))
		     (not (str/blank? (.getText (.-name2Field instance))))
		     (not (str/blank? (.getValue (.-groupList instance))))))
      (do (gui-util/notification :error "Bitte alle Informationen eintragen!" "Vergessen Sie nicht, die Felder \"Gruppe\", \"Name 1\" und \"Name 2\" auszufüllen!")
	  :lyrion/fail)
      (let [ ;;timestamp (f/unparse (f/formatter "yyyyMMddhhmmss") (l/local-now))
	    timestamp (t/format "yyyyMMddkkmmss" (t/local-date-time))
	    filename (filenamegen instance)]
	(let [{:keys [pipeline appcaps image-container]} @videocapture.videocapture/vcapture]
	  (fx/run-now (.addListener image-container
				    (fx/fi javafx.beans.value.ChangeListener [observable oldValue newValue]
					   (fx/run-later (.setImage (.-videoView instance) newValue)))))
	  (Thread/sleep 100)
	  (videocapture.videocapture/record filename)
	  (fx/run-later
	   (gui-util/notification :information "Aufnahme gestartet." "Der Aufnahmestatus wird in der Statusleiste angezeigt.")
	   (.setText (.-statusText instance) "Aufnahme läuft...")
	   (.setProgress (.-statusBar instance) -1))
	  (reset! (:clock @core) (t/instant))
	  (Thread/sleep 100)
	  ;;(.debugToDotFile pipe 15 "recorder")
	  (info "Recording started.")
	  (info "Recorder running.")
	  (Thread/sleep 1000)
	  [filename pipeline (partial record-video-stop instance pipeline appcaps)])))))

(defn- leading-zero [input]
  (if (= (count (str input)) 1)
    (str "0" input)
    (str input)))

(defn videotimer []
  (let [comm (chan)
	clearance (atom true)]
    (go
      (<! (async/timeout 2000))
      (loop []
	(async/alt!
	  (async/timeout 100) (do (fx/run-now
				    (if (nil? @(:clock @core))
				      (when @clearance
					(.setText (.-timeLabel @(:instance @core)) "")
					(reset! clearance false))
				      (let [clock @(:clock @core)
					    dur (t/duration clock (t/instant))
					    text (str (leading-zero (t/as dur :hours)) ":" (leading-zero (mod (t/as dur :minutes) 60)) ":" (leading-zero (mod (t/as dur :seconds) 60)))]
					(reset! clearance true)
					(.setText (.-timeLabel @(:instance @core)) text))))
				  (recur))
	  comm                (do nil))))
    comm))

(defn set-gui-state [instance state]
  (fx/run-later
   (try
     (let [clazz (class instance)]
       (doseq [action (settings/get-setting :C :gui-states state)
	       :let [field (.getField clazz (str (:identifier action)))
		     field-obj (.get field instance)
		     field-method (first (filter #(= (.getName %) (str (:method action))) (.getMethods (class field-obj))))]]
	 (.invoke field-method field-obj (into-array Object [(:value action)]))))
     (catch Exception e (error e)))))

(defn mainloop [instance]
  (go (let [[pipe specials stoppable] (<! (preview-player-start instance))]

	(debug "Mainloop gestartet.")
	(fx/run-now
	 (set-gui-state instance :stop)
	 (set-gui-state instance :init)
	 (load-disclaimer instance))
	(gui-util/unmask instance)
	(loop [pipe pipe
	       specials specials
	       stoppable stoppable
	       filename nil]
	  (async/alt!
	    [(:record-button @gui-out)] (do (gui-util/mask instance)
					    (<! (stoppable))
					    (let [recorder-res (record-video instance)]
					      (gui-util/unmask instance)
					      (if (= :lyrion/fail recorder-res)
						(recur pipe specials stoppable filename)
						(do (set-gui-state instance :record)
						    (reset! filehandler/video-comment nil)
						    (recur (nth recorder-res 1) specials (nth recorder-res 2) (nth recorder-res 0))))))
	    [(:save-button @gui-out)] (do (filehandler/save-video-auto instance filename)
					  (recur pipe specials stoppable filename))
	    [(:upload-button @gui-out)] (do (filehandler/smb-upload-video instance filename)
					    (recur pipe specials stoppable filename))
	    [(:play-button @gui-out)] (do (when stoppable (<! (stoppable)))
					  (let [stoppable (playback-player-start instance filename)]
					    (set-gui-state instance :play)
					    (recur pipe specials stoppable filename)))
	    [(:stop-button @gui-out)] (if-not (nil? stoppable)
					(do (gui-util/mask instance "Aufnahme wird beendet...")
					    (<! (stoppable))
					    (gui-util/unmask instance)
					    (set-gui-state instance :stop)
					    (recur pipe specials nil filename))
					(recur pipe specials stoppable filename))
	    [(:report-error-button @gui-out)] (do (filehandler/error-report-dialog instance)
						  (recur pipe specials stoppable filename))
	    [(:nuke-button @gui-out)] (duke-nukem instance filename)
	    [(:source-choose @gui-out)] (tune-workstation instance)
	    [(:shutdown-button @gui-out)] (shutdown-machine (settings/get-setting :C :exit-action) instance filename)
	    [(:disable-player @gui-out)] (do (when-not (nil? stoppable) (<! (stoppable)))
					     (recur pipe specials nil filename))
	    [(:re-init @gui-out)] (do (when-not (nil? stoppable) (<! (stoppable))))
	    [(async/timeout 500)] (recur pipe specials stoppable filename)
	    )))))

(defn core-start []
  (let [comm (videotimer)]
    {:input-validator (atom nil)
     :instance (atom nil)
     :comm comm
     :clock (atom nil)}))

(defn core-stop [state]
  (async/put! (:comm @state) false))

(mount/defstate core
  :start (core-start)
  :stop (core-stop core))

(declare mainloop)

(defn stage-init [instance]
  (gui-util/mask instance)
  (Gst/init "VideoCapture" (into-array String []))

  (try (.addAll (.getItems (.-groupList instance)) (into-array String (cons "" (settings/get-setting :form :groups)))) (catch Exception e nil))

  (reset! (:input-validator @core) (new ValidationSupport))
  (reset! (:instance @core) instance)

  (when-not (settings/get-setting :supervisor :activated)
    (set-gui-state instance :disable-supervisor))

  (when (settings/get-setting :supervisor :activated)
    (debug "Adding watch to detect new workstations.")
    (add-watch (:sockets @videocapture.network/network) :gui-watcher
	       (fn [k reference old-state new-state]
		 (fx/run-now (let [items (remove #(nil? (:workstation %)) new-state)]
			       (.setAll (.getItems ^ChoiceBox (.-sourceSelect instance)) (into-array String (map :workstation items))))))))

  (go
    (<! (async/timeout 5000))
    (when-let [logscroll (try (.-supervisorLogScroll instance) (catch Exception e (trace e)))]
      (fx/run-now (.setVvalue logscroll 1.0))

      (let [supervisor-log (.-supervisorLog instance)]
	(go-loop [old-state []]
	  (<! (async/timeout 100))
	  (if (or (= :workstation (:type @network/network)) (not (nil? @(:active-workstation @network/network))))
	    (let [new-state (if (= :supervisor (:type @network/network))
			      @(:messages @(:active-workstation @network/network))
			      @(:messages @network/network))]
	      (when-not (= old-state new-state)
		(fx/run-now (.setAll (.getChildren supervisor-log) (into-array Label (map #(Label. %) new-state))))
		(fx/run-later (.setVvalue logscroll 1.0)))
	      (recur new-state))
	    (recur []))))))

  (go-loop []
    (gui-util/mask instance)
    (<! (async/timeout 100))
    (<! (mainloop instance))
    (recur)))

(defn load-disclaimer [instance]
  (let [dpane (.-disclaimerGrid instance)
	disclaimer (settings/get-setting :disclaimer)
	dkeys (keys disclaimer)]
    (debug "Adding" (count dkeys) "disclaimer entries.")
    (debug disclaimer)
    (doseq [i (range 0 (count dkeys))
	    :let [dkey (nth dkeys i)
		  dbg (debug dkey)
		  dval-raw (read-string (get disclaimer dkey))
		  dbg (debug dval-raw "is of type" (type dval-raw))
		  dval (if (seq? dval-raw)
			 version/version
			 (get disclaimer dkey))
		  dbg (debug dkey dval)
		  klabel (new javafx.scene.control.Label dkey)
		  vlabel (new javafx.scene.control.Label dval)]]
      (debug dkey "=>" dval)
      (do
	(.setStyle klabel "-fx-wrap-text: true")
	(.setStyle vlabel "-fx-wrap-text: true")
	(.add dpane klabel 0 i)
	(.add dpane vlabel 1 i)))))

(defn init []
  nil)

(declare -main)
(defn start [^javafx.stage.Stage stage]
  (info "Starting program.")
  (mount/start)
  (sh/sh "mkdir" "-p" (settings/get-setting :xdg :home))
  (timbre/merge-config!
   {:appenders {:spit (appenders/spit-appender {:fname (str (settings/get-setting :xdg :home) "videocapture.log")})}})
  (debug (System/getProperty "java.version"))
  (let [mainwindow (fxml/load-fxml-with-controller (io/resource (str "fxml/" (settings/get-setting :gui))) "videocapture.core/stage-init")
	scene (new javafx.scene.Scene mainwindow 1024 768)]
    (try
      (.add (.getStylesheets scene) (.toExternalForm (io/resource "css/gui.css")))
      (.add (.getIcons stage) (Image. (.openStream (io/resource "images/icon.png"))))
      (.setOnKeyPressed scene (fx/fi javafx.event.EventHandler [event]
				     (when (and (.isControlDown ^KeyEvent event)
						(= KeyCode/O (.getCode ^KeyEvent event)))
				       (debug "Ctrl+O pressed.")
				       (async/put! (:disable-player @gui-out) true)
				       (let [settingswindow (videocapture.settings/init stage)]
					 (.setOnHidden settingswindow
						       (fx/fi javafx.event.EventHandler [event]
							      (async/put! (:re-init @gui-out) true)))))))
      (.setOnCloseRequest stage (fx/fi javafx.event.EventHandler [event]
				       (mount/stop)
				       (System/exit 1)))
      (catch Exception e (fatal e) (System/exit 1)))

    (.setFullScreenExitHint stage "")
    (.setTitle stage "Video Capture")
    (.setScene stage scene)
    (.setFullScreen stage true)
    (.setMaximized stage true)
    (.show stage)))

(defn stop []
  nil)

(defn -main [& args]
  (mu/on-upndown :info mu-log :before)
  (fx/start-app init start stop)
  )

(ns videocapture.core
  (:gen-class)
  (:require [clojurefx.clojurefx :as fx]
	    [clojurefx.fxml :as fxml]
	    [clojure.core.async :as async :refer [chan <! >! go go-loop]]
	    [clojure.string :as str]
	    [clojure.edn :as edn]
	    [clojure.java.io :as io]
	    [clojure.reflect :as reflect]
	    [java-time :as t]
	    [mount.core :as mount]
	    [mount-up.core :as mu]
	    [postal.core :as go-postal]
	    [videocapture.gui-util :as gui-util]
	    [videocapture.filehandler :as filehandler]
	    [videocapture.pipeparser :as recorder]
	    [videocapture.settings :as settings]
	    [videocapture.network :as network]
	    [videocapture.version :as version]
	    videocapture.videocapture
	    [taoensso.timbre :as timbre
	     :refer [log trace debug info warn error fatal report
		     logf tracef debugf infof warnf errorf fatalf reportf
		     spy get-env]]
	    [taoensso.timbre.appenders.core :as appenders]
	    [clojure.java.shell :as sh])
  (:import (org.freedesktop.gstreamer Gst
				      Element
				      ElementFactory Pipeline)
	   (org.controlsfx.glyphfont Glyph)
	   (javafx.scene.control ButtonType ButtonType Alert$AlertType Alert ChoiceBox Label)
	   javafx.scene.paint.Color
	   videocapture.AppSinkListener
	   (java.util.concurrent TimeUnit)
	   (javafx.scene.image Image)
	   (javafx.scene.input KeyCode KeyEvent)
	   (org.controlsfx.validation ValidationSupport Validator)))

(defn mu-log [data] (info data))

(mount/in-cljc-mode)

(declare core load-disclaimer)

<<gui-state>>
<<input-handling>>
<<input-effects>>

<<timer-display>>

<<preview>>
<<playback>>
<<recording>>

<<mainloop>>
<<init>>