Components with view-map, and canvases with shapes and the pointer

view-map gives a view's every message to a function first, so a part with a
message type, an update and a view of its own goes in a larger view with
the case of the larger message that carries its own.

canvas is a surface for rect, ellipse, line and path, placed by their own
numbers, and other views by at-point. on-press, on-move and on-release send
the place on the canvas. They come from whatever is drawn on it too, so
they are taken from any source, and a press takes the pointer for the drag.
examples/sketch.bjo draws with it, and docs/sketch.png is its picture.

🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8)

Co-Authored-By: eca-agent <git@eca.dev>

examples/sketch.bjo

@@ -0,0 +1,132 @@
+;; 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))