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>

src/view.bjo

@@ -23,9 +23,14 @@
   menu-bar submenu menu-item menu-separator
   toggle-switch radio number-input date-picker auto-complete expander
   tree-view tree-node
+  canvas rect ellipse line path
   column row grid scroll border flow dock
   ;; Wrappers.
   keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right classed
+  at-point on-press on-move on-release
+
+  ;; Views of another message type.
+  view-map
 
   ;; Keyboard shortcuts.
   Key key key-gesture key-message
@@ -46,6 +51,7 @@
                      MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind
                      ToggleSwitchKind RadioKind NumberKind DateKind AutoCompleteKind
                      ExpanderKind WrapKind DockKind TreeKind TreeNodeKind
+                     CanvasKind RectKind EllipseKind LineKind PathKind
                      ColumnKind RowKind GridKind ScrollKind BorderKind)))
 
 ;; A property of a control. A kind takes only some of them; the app ignores
@@ -86,7 +92,15 @@
                      (: PropDate string)            ; a date picker's date, as "2026-10-25"
                      (: PropDockSide int)           ; where a view is in its dock: 0 to 3
                      (: PropClasses (Vec string))   ; the classes that styles match
-                     (: PropChosenKey string))))    ; the key of a tree's chosen node
+                     (: PropChosenKey string)       ; the key of a tree's chosen node
+                     (: PropLeft double)            ; where a view is on its canvas
+                     (: PropTop double)
+                     (: PropFill string)            ; the colour inside a shape
+                     (: PropStroke string)          ; the colour of a shape's line
+                     (: PropStrokeWidth double)
+                     (: PropStart double double)    ; the ends of a line
+                     (: PropEnd double double)
+                     (: PropData string))))         ; a path, as "M 0 0 L 10 10 Z"
 
 ;; An event, and the message it sends.
 (type (: (On %m) (Union (: OnClick %m)
@@ -94,7 +108,10 @@
                         (: OnToggle (-> bool %m))
                         (: OnSlide (-> double %m))
                         (: OnSelect (-> int %m))
-                        (: OnPick (-> string %m)))))
+                        (: OnPick (-> string %m))
+                        (: OnPress (-> double double %m))
+                        (: OnMove (-> double double %m))
+                        (: OnRelease (-> double double %m)))))
 
 ;; One control and what is in it.
 ;;
@@ -153,6 +170,59 @@
 (defun (classed v #:rest names)
   (record-set v (props (vec-add (.props v) (PropClasses (array->vec names))))))
 
+;; The view, at `x`, `y` on its canvas, counted from the top left corner.
+(: at-point (-> double double (View %m) (View %m)))
+(defun (at-point x y v)
+  (record-set v (props (vec-add (vec-add (.props v) (PropLeft x)) (PropTop y)))))
+
+(: (-> (On %m) (View %m) (View %m)))
+(defun (with-event on v)
+  (record-set v (events (vec-add (.events v) on))))
+
+;; The canvas, sending `(f x y)` when a button is pressed on it, with the
+;; place on the canvas. The canvas takes the pointer until the button is let
+;; go, so a drag that leaves it still reaches it. Only a canvas has these.
+(: on-press (-> (View %m) (-> double double %m) (View %m)))
+(defun (on-press v f) (with-event (OnPress f) v))
+
+;; The canvas, sending `(f x y)` each time the pointer moves over it, or
+;; anywhere while a button pressed on it is held.
+(: on-move (-> (View %m) (-> double double %m) (View %m)))
+(defun (on-move v f) (with-event (OnMove f) v))
+
+;; The canvas, sending `(f x y)` when the button pressed on it is let go.
+(: on-release (-> (View %m) (-> double double %m) (View %m)))
+(defun (on-release v f) (with-event (OnRelease f) v))
+
+;; ---------------------------------------------------------------------------
+;; Views of another message type
+;; ---------------------------------------------------------------------------
+
+;; The view, sending `(f msg)` for each message it would send. This is how a
+;; part of a program with messages of its own is put in a larger view: its
+;; view is mapped with the case of the larger message that carries its own.
+;;
+;;     (view-map Picker (date-range-view (.range m)))
+(: view-map (-> (-> %a %b) (View %a) (View %b)))
+(defun (view-map f v)
+  (: (-> (On %a) (On %b)))
+  (defun (map-on on)
+    (match on
+      ((OnClick m) (OnClick (f m)))
+      ((OnInput g) (OnInput (fun (s) (f (g s)))))
+      ((OnToggle g) (OnToggle (fun (b) (f (g b)))))
+      ((OnSlide g) (OnSlide (fun (d) (f (g d)))))
+      ((OnSelect g) (OnSelect (fun (i) (f (g i)))))
+      ((OnPick g) (OnPick (fun (k) (f (g k)))))
+      ((OnPress g) (OnPress (fun (x y) (f (g x y)))))
+      ((OnMove g) (OnMove (fun (x y) (f (g x y)))))
+      ((OnRelease g) (OnRelease (fun (x y) (f (g x y)))))))
+  (View (kind (.kind v))
+        (props (.props v))
+        (events (vec-map map-on (.events v)))
+        (children (vec-map (fun (c) (view-map f c)) (.children v)))
+        (key (.key v))))
+
 ;; The view, with `text` shown when the pointer rests on it.
 (: tooltip (-> (View %m) string (View %m)))
 (defun (tooltip v text)
@@ -486,6 +556,57 @@
 (defun (dock #:margin 0.0 #:rest children)
   (stack DockKind 0.0 margin children))
 
+;; A surface to draw on, `width` by `height`, with shapes and other views at
+;; places of their own: a shape by its numbers, a view by `at-point`. Its
+;; pointer messages come from `on-press`, `on-move` and `on-release`.
+(: (-> double double (#:background string) (#:margin double) #:rest (View %m) (View %m)))
+(defun (canvas width height #:background "" #:margin 0.0 #:rest children)
+  (container CanvasKind
+             (with-layout (if (string-empty? background) [] [(PropBackground background)])
+                          width height margin 0.0)
+             (array->vec children)))
+
+(: (-> (Vec Prop) string string double (Vec Prop)))
+(defun (with-paint props fill stroke stroke-width)
+  (defun (with ps make c) (if (string-empty? c) ps (vec-add ps (make c))))
+  (with (with (if (> stroke-width 0.0) (vec-add props (PropStrokeWidth stroke-width)) props)
+              PropFill fill)
+        PropStroke stroke))
+
+;; A rectangle at `x`, `y`, `width` by `height`, with corners as round as
+;; `#:radius`.
+(: (-> double double double double (#:fill string) (#:stroke string) (#:stroke-width double)
+       (#:radius double)
+       (View %m)))
+(defun (rect x y width height #:fill "" #:stroke "" #:stroke-width 1.0 #:radius 0.0)
+  (leaf RectKind
+        (with-paint (with-size [(PropLeft x) (PropTop y) (PropWidth width) (PropHeight height)]
+                               PropRadius radius)
+                    fill stroke stroke-width)
+        []))
+
+;; An ellipse in the rectangle at `x`, `y`, `width` by `height`.
+(: (-> double double double double (#:fill string) (#:stroke string) (#:stroke-width double)
+       (View %m)))
+(defun (ellipse x y width height #:fill "" #:stroke "" #:stroke-width 1.0)
+  (leaf EllipseKind
+        (with-paint [(PropLeft x) (PropTop y) (PropWidth width) (PropHeight height)]
+                    fill stroke stroke-width)
+        []))
+
+;; A line from `x1`, `y1` to `x2`, `y2`.
+(: (-> double double double double (#:stroke string) (#:stroke-width double) (View %m)))
+(defun (line x1 y1 x2 y2 #:stroke "black" #:stroke-width 1.0)
+  (leaf LineKind
+        (with-paint [(PropStart x1 y1) (PropEnd x2 y2)] "" stroke stroke-width)
+        []))
+
+;; A path, written as SVG writes one: "M 10 10 L 50 10 L 30 40 Z" is a
+;; triangle. Its numbers are places on the canvas.
+(: (-> string (#:fill string) (#:stroke string) (#:stroke-width double) (View %m)))
+(defun (path data #:fill "" #:stroke "" #:stroke-width 1.0)
+  (leaf PathKind (with-paint [(PropData data)] fill stroke stroke-width) []))
+
 ;; A view that scrolls when it is taller than the space it has.
 (: (-> (View %m) (#:width double) (#:height double) (#:margin double) (View %m)))
 (defun (scroll child #:width 0.0 #:height 0.0 #:margin 0.0)