bjogui/examples/mixer.bjo

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.

;; bjogui/examples/mixer.bjo — controls of the program's own: knobs and a
;; timeline, drawn with (bjogui draw).
;;
;;     bjo run examples/mixer.bjo
;;
;; Drag a knob up or down, or click it and press the arrow keys. Click or
;; drag on the timeline to move the playhead, double-click to put a mark
;; there, and press Left or Right to step by a second. "Play" moves the
;; playhead with a subscription.
;;
;; Each component keeps what only it needs, such as where a drag started or
;; where the pointer hovers, in a state of its own. The model holds only the
;; values, and the components send outputs that are made messages of.
;;
;; The picture in the Readme is this program, taken with
;;
;;     BJOGUI_SCREENSHOT=docs/mixer.png bjo run examples/mixer.bjo

(import (std prelude))
(import (std maths))
(import (bjogui draw))
(import (bjogui view))
(import (bjogui app))

(def pi 3.141592653589793)

;; ---------------------------------------------------------------------------
;; A knob, for a value from 0 to 1
;; ---------------------------------------------------------------------------

;; Where a drag started, and the value then; and whether it has the keys.
(type (: KnobState (Record (: drag (Option (Tuple double double))) (: focused bool))))

(: (-> double double))
(defun (within-one v) (max 0.0 (min 1.0 v)))

;; The arc runs from the bottom left, through the top, to the bottom right.
(def knob-start (* 0.75 pi))
(def knob-sweep (* 1.5 pi))

(: knob (Component double KnobState double))
(def knob
  (component (KnobState (drag None) (focused #f))
    (fun (pen w h s v)
      (def cx (/ w 2.0))
      (def cy (/ h 2.0))
      (def r (- (min cx cy) 6.0))
      (fill-circle pen cx cy r (if (.focused s) "#3d4a5c" "#2c3e50"))
      (stroke-arc pen cx cy (- r 6.0) knob-start knob-sweep "#55606e" #:width 5.0 #:cap "round")
      (stroke-arc pen cx cy (- r 6.0) knob-start (* v knob-sweep) "#f39c12" #:width 5.0 #:cap "round")
      ;; The pointer, at the end of the value's arc.
      (def a (+ knob-start (* v knob-sweep)))
      (stroke-line pen (+ cx (* 0.25 r (cos a))) (+ cy (* 0.25 r (sin a)))
                   (+ cx (* 0.6 r (cos a))) (+ cy (* 0.6 r (sin a)))
                   "white" #:width 3.0 #:cap "round")
      (draw-text pen #"${(exact-round (* v 100.0))}%" cx (+ cy (* 0.55 r)) "white"
                 #:size 11.0 #:align "centre"))
    #:input (fun (in w h s v)
              (match in
                ((PointerDown p) (Tuple (record-set s (drag (Some (Tuple (.y p) v)))) None))
                ((PointerMove p)
                 (match (.drag s)
                   ((Some (Tuple y0 v0)) (Tuple s (Some (within-one (+ v0 (/ (- y0 (.y p)) 150.0))))))
                   (None (Tuple s None))))
                ((PointerUp _) (Tuple (record-set s (drag None)) None))
                ((Wheel _ _ dy) (Tuple s (Some (within-one (+ v (* dy 0.05))))))
                ((KeyDown "Up") (Tuple s (Some (within-one (+ v 0.05)))))
                ((KeyDown "Down") (Tuple s (Some (within-one (- v 0.05)))))
                (FocusIn (Tuple (record-set s (focused #t)) None))
                (FocusOut (Tuple (record-set s (focused #f)) None))
                (_ (Tuple s None))))
    #:cursor (fun (s v) (match (.drag s) ((Some _) "SizeNorthSouth") (None "Hand")))
    #:focusable #t))

;; ---------------------------------------------------------------------------
;; A timeline, with a playhead and marks
;; ---------------------------------------------------------------------------

(type (: Timeline (Record (: length double) (: position double) (: marks (Vec double)))))

;; Where the pointer hovers, and whether the playhead is being dragged.
(type (: TimelineState (Record (: hover (Option double)) (: dragging bool))))

(type (: TimelineOut (Union (: Seek double) (: AddMark double))))

(def margin 12.0)

(: (-> double string))
(defun (clock seconds)
  (def s (exact-floor seconds))
  (def secs (string-pad-left (number->string (remainder s 60)) 2 #:with #\0))
  #"${(quotient s 60)}:${secs}")

;; The timeline at `w` by `h`.
(: (-> Pen double double TimelineState Timeline void))
(defun (draw-timeline pen w h s t)
  (def span (- w (* 2.0 margin)))
  (defun (x-of time) (+ margin (* span (/ time (.length t)))))
  (fill-rect pen 0.0 0.0 w h "#1e2730" #:radius 6.0)
  (fill-rect pen margin 30.0 span 8.0 "#33404d" #:radius 4.0)
  (fill-rect pen margin 30.0 (- (x-of (.position t)) margin) 8.0 "#2e86de" #:radius 4.0)
  ;; A tick each five seconds, with the time under every second one.
  (loop (:for i (range 0 (+ 1 (exact-floor (/ (.length t) 5.0)))))
        (:do (def x (x-of (* 5.0 (cast double i))))
             (stroke-line pen x 44.0 x (if (even? i) 52.0 48.0) "#7f8c8d")
             (when (even? i)
               (draw-text pen (clock (* 5.0 (cast double i))) x 53.0 "#95a5a6" #:size 10.0 #:align "centre"))))
  (loop (:for m (.marks t))
        (:do (def x (x-of m))
             (fill-polygon pen [(Tuple (- x 5.0) 14.0) (Tuple (+ x 5.0) 14.0) (Tuple x 22.0)] "#f1c40f")))
  (match (.hover s)
    ((Some time)
     (def x (x-of time))
     (stroke-line pen x 8.0 x 44.0 "#ffffff60" #:dash [2.0 2.0])
     (draw-text pen (clock time) x 0.0 "#bdc3c7" #:size 10.0 #:align "centre"))
    (None unit))
  (def px (x-of (.position t)))
  (stroke-line pen px 10.0 px 44.0 "#e74c3c" #:width 2.0)
  (fill-circle pen px 34.0 (if (.dragging s) 8.0 6.0) "#e74c3c"))

;; The next state for `in`, and the place to move the playhead to or to mark.
(: (-> Input double double TimelineState Timeline (Tuple TimelineState (Option TimelineOut))))
(defun (timeline-input in w h s t)
  (defun (time-at x)
    (max 0.0 (min (.length t) (* (.length t) (/ (- x margin) (- w (* 2.0 margin)))))))
  (match in
    ((PointerDown p)
     (if (= (.clicks p) 2)
         (Tuple s (Some (AddMark (time-at (.x p)))))
         (Tuple (record-set s (dragging #t)) (Some (Seek (time-at (.x p)))))))
    ((PointerMove p)
     (def hovered (record-set s (hover (Some (time-at (.x p))))))
     (Tuple hovered (if (.dragging s) (Some (Seek (time-at (.x p)))) None)))
    ((PointerUp _) (Tuple (record-set s (dragging #f)) None))
    (PointerLeave (Tuple (record-set s (hover None)) None))
    ((KeyDown "Right") (Tuple s (Some (Seek (min (.length t) (+ (.position t) 1.0))))))
    ((KeyDown "Left") (Tuple s (Some (Seek (max 0.0 (- (.position t) 1.0))))))
    (_ (Tuple s None))))

(: (-> TimelineState Timeline string))
(defun (timeline-cursor s t) (if (.dragging s) "SizeWestEast" "Hand"))

(: timeline (Component Timeline TimelineState TimelineOut))
(def timeline
  (component (TimelineState (hover None) (dragging #f)) draw-timeline
    #:input timeline-input
    #:cursor timeline-cursor
    #:focusable #t))

;; ---------------------------------------------------------------------------
;; The mixer
;; ---------------------------------------------------------------------------

(type (: Msg (Union (: Volume double) (: Bass double) (: Treble double)
                    (: Track TimelineOut) Play Tick)))

(type (: Model (Record (: volume double) (: bass double) (: treble double)
                       (: track Timeline) (: playing bool))))

(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
  (def t (.track m))
  (next (match msg
          ((Volume v) (record-set m (volume v)))
          ((Bass v) (record-set m (bass v)))
          ((Treble v) (record-set m (treble v)))
          ((Track (Seek time)) (record-set m (track (record-set t (position time)))))
          ((Track (AddMark time)) (record-set m (track (record-set t (marks (vec-add (.marks t) time))))))
          (Play (record-set m (playing (not (.playing m)))))
          (Tick
           (def time (+ (.position t) 0.1))
           (if (>= time (.length t))
               (record-set m (playing #f) (track (record-set t (position (.length t)))))
               (record-set m (track (record-set t (position time)))))))))

(: subscriptions (-> Model (List (Sub Msg))))
(defun (subscriptions m)
  (if (.playing m) (list (every (milliseconds 100) Tick)) '()))

(: (-> string double (-> double Msg) (View Msg)))
(defun (labelled-knob label v msg)
  (column #:spacing 4.0
    (drawn knob v msg #:width 84.0 #:height 84.0)
    (text label #:margin 2.0)))

(: view (-> Model (View Msg)))
(defun (view m)
  (column #:spacing 12.0 #:margin 16.0
    (row #:spacing 16.0
      (labelled-knob "Volume" (.volume m) Volume)
      (labelled-knob "Bass" (.bass m) Bass)
      (labelled-knob "Treble" (.treble m) Treble))
    (drawn timeline (.track m) Track #:height 68.0)
    (row #:spacing 8.0
      (button (if (.playing m) "Pause" "Play") Play #:width 80.0)
      (text #"${(clock (.position (.track m)))} of ${(clock (.length (.track m)))}"))))

(defun (main)
  (run-app (Model (volume 0.7) (bass 0.4) (treble 0.55)
                  (track (Timeline (length 60.0) (position 21.5) (marks [8.0 33.0 47.5])))
                  (playing #f))
           gui-update view
           #:subscriptions subscriptions
           #:title "Mixer" #:width 460.0 #:height 300.0))