bjogui/examples/sketch.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/sketch.bjo — drawing with the pointer, and two components.
;;
;;     bjo run examples/sketch.bjo
;;
;; Press and drag on the canvas to draw a stroke. The colour and the width
;; are chosen by two pickers, each a component of its own: a message type, an
;; update and a view, which know nothing of the sketch. The sketch puts them
;; in its view with `view-map`, and hands their messages back to them.
;;
;; The picture in the Readme is this program, taken with
;;
;;     BJOGUI_SCREENSHOT=docs/sketch.png bjo run examples/sketch.bjo

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

;; ---------------------------------------------------------------------------
;; A picker: one of some choices, shown as buttons
;; ---------------------------------------------------------------------------

(type (: PickerMsg (Union (: Picked int))))
(type (: Picker (Record (: label string) (: choices (Vec string)) (: chosen int))))

(: (-> PickerMsg Picker Picker))
(defun (picker-update msg p)
  (match msg ((Picked i) (record-set p (chosen i)))))

(: (-> Picker (View PickerMsg)))
(defun (picker-view p)
  (apply row #:spacing 4.0
         (vec->array
           (vec-add-first
             (vec-map (fun (i)
                        (def label (vec-ref (.choices p) i))
                        (if (= i (.chosen p))
                            (paint (button label (Picked i)) #:background "#2c3e50" #:colour "white")
                            (button label (Picked i))))
                      (->vec (range 0 (vec-length (.choices p)))))
             (text (.label p) #:margin 4.0)))))

(: (-> Picker string))
(defun (picked p) (vec-ref (.choices p) (.chosen p)))

;; ---------------------------------------------------------------------------
;; The sketch
;; ---------------------------------------------------------------------------

(type (: Stroke (Record (: colour string) (: width double) (: points (List (Tuple double double))))))

(type (: Msg (Union (: Colour PickerMsg) (: Width PickerMsg)
                    (: Down double double) (: Drag double double) Up Clear)))

(type (: Model (Record (: strokes (List Stroke)) (: drawing (Option Stroke))
                       (: colour Picker) (: width Picker))))

(: (-> Model double))
(defun (width-of m) (string->double (picked (.width m))))

(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
  (next
    (match msg
      ((Colour pm) (record-set m (colour (picker-update pm (.colour m)))))
      ((Width pm) (record-set m (width (picker-update pm (.width m)))))
      ((Down x y)
       (record-set m (drawing (Some (Stroke (colour (picked (.colour m))) (width (width-of m))
                                            (points (list (Tuple x y))))))))
      ((Drag x y)
       (match (.drawing m)
         ((Some s) (record-set m (drawing (Some (record-set s (points (cons (Tuple x y) (.points s))))))))
         (None m)))
      (Up
       (match (.drawing m)
         ((Some s) (record-set m (strokes (cons s (.strokes m))) (drawing None)))
         (None m)))
      (Clear (record-set m (strokes '()) (drawing None))))))

;; A stroke as a path: a move to its first point and a line to each other.
(: (-> Stroke (View Msg)))
(defun (stroke-view s)
  (def points (list-reverse (.points s)))
  (def data
    (loop (:for (Tuple i p) (enumerate points))
          (:let (Tuple x y) p)
          (:acc parts (vecing #"${(if (= i 0) "M" "L")} ${x} ${y}"))
          => (string-join parts " ")))
  (path data #:stroke (.colour s) #:stroke-width (.width s)))

(: (-> Model (View Msg)))
(defun (view m)
  (def strokes (list-reverse (match (.drawing m)
                               ((Some s) (cons s (.strokes m)))
                               (None (.strokes m)))))
  (column #:spacing 8.0 #:margin 12.0
    (view-map Colour (picker-view (.colour m)))
    (view-map Width (picker-view (.width m)))
    (border
      (on-release
        (on-move
          (on-press
            (apply canvas 460.0 260.0 #:background "white"
                   (vec->array (vec-map stroke-view (list->vec strokes))))
            Down)
          Drag)
        (fun (x y) Up))
      #:colour "#bdc3c7")
    (row #:spacing 8.0
      (button "Clear" Clear)
      (text #"${(length (.strokes m))} strokes"))))

;; Strokes to show in the picture: a wave, a loop and a line.
(: (-> string double (-> double (Tuple double double)) Stroke))
(defun (drawn colour width f)
  (Stroke (colour colour) (width width)
          (points (list-reverse (list-map (fun (i) (f (cast System.Double i))) (->list (range 0 61)))))))

(defun (main)
  (def wave (drawn "steelblue" 4.0 (fun (i) (Tuple (+ 20.0 (* i 7.0)) (+ 70.0 (* 35.0 (sin (/ i 6.0))))))))
  (def loop-stroke (drawn "firebrick" 6.0 (fun (i) (Tuple (+ 330.0 (* 70.0 (cos (/ i 9.55))))
                                                       (+ 160.0 (* 60.0 (sin (/ i 9.55))))))))
  (def line-stroke (drawn "seagreen" 2.0 (fun (i) (Tuple (+ 30.0 (* i 4.0)) (+ 230.0 (* -1.5 i))))))
  (run-app (Model (strokes (list line-stroke loop-stroke wave)) (drawing None)
                  (colour (Picker (label "Colour") (choices ["steelblue" "firebrick" "seagreen" "black"]) (chosen 1)))
                  (width (Picker (label "Width") (choices ["2" "4" "6" "10"]) (chosen 2))))
           gui-update view
           #:title "Sketch" #:width 500.0 #:height 420.0))