bjoli/bjogui
SHA256
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Keyed children, and eight more controls

Browse source 
A child is now known by its key, or by its place among the children with no
key. One whose identity was there before keeps its control, and the
controls are put in the new order by moving only those out of place. So a
list that is sorted, or has an item put in front, keeps its controls.

Text areas, sliders, progress bars, dropdowns, images, grids with cells and
spans, and scroll views. A grid's sizes are .NET properties and not
Avalonia's, so they are set by a setter of their own. A text is centred in
its height, so a label lines up with the control beside it.

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

Co-Authored-By: eca-agent <git@eca.dev>
This commit is contained in:
Linus Björnstam 2026-10-25 17:13:35 +01:00
parent 4f48282314
commit 95b6707cc1
4 changed files with 680 additions and 91 deletions
Download patch file Download diff file Expand all files Collapse all files

359
src/app.bjo
View file

@ -36,6 +36,7 @@
(import (std prelude))
(import (std interop))
(import (std mutable vec))
(import (std mutable map))
(import (bjogui view))
;; ---------------------------------------------------------------------------
@ -56,7 +57,20 @@
(Thickness (: Avalonia.Thickness (-> double Thickness)))
(Orientation (: Avalonia.Layout.Orientation))
(HAlignment (: Avalonia.Layout.HorizontalAlignment))
(VAlignment (: Avalonia.Layout.VerticalAlignment))
(Control (: Avalonia.Controls.Control))
(Grid (: Avalonia.Controls.Grid (-> Grid)))
(ColumnDefs (: Avalonia.Controls.ColumnDefinitions))
(RowDefs (: Avalonia.Controls.RowDefinitions))
(ScrollViewer (: Avalonia.Controls.ScrollViewer (-> ScrollViewer)))
(Slider (: Avalonia.Controls.Slider (-> Slider)))
(ProgressBar (: Avalonia.Controls.ProgressBar (-> ProgressBar)))
(RangeBase (: Avalonia.Controls.Primitives.RangeBase))
(ComboBox (: Avalonia.Controls.ComboBox (-> ComboBox)))
(SelectingItemsControl (: Avalonia.Controls.Primitives.SelectingItemsControl))
(Image (: Avalonia.Controls.Image (-> Image)))
(Bitmap (: Avalonia.Media.Imaging.Bitmap (-> string Bitmap)))
(TextWrapping (: Avalonia.Media.TextWrapping))
(Controls (: Avalonia.Controls.Controls))
(Panel (: Avalonia.Controls.Panel))
(StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel)))
@ -100,6 +114,32 @@
(orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get))
(content-alignment-property
(: Avalonia.Controls.ContentControl.HorizontalContentAlignmentProperty #:get))
(horizontal-alignment-property (: Avalonia.Layout.Layoutable.HorizontalAlignmentProperty #:get))
(vertical-alignment-property (: Avalonia.Layout.Layoutable.VerticalAlignmentProperty #:get))
(text-block-wrapping (: Avalonia.Controls.TextBlock.TextWrappingProperty #:get))
(text-box-wrapping (: Avalonia.Controls.TextBox.TextWrappingProperty #:get))
(accepts-return-property (: Avalonia.Controls.TextBox.AcceptsReturnProperty #:get))
(minimum-property (: Avalonia.Controls.Primitives.RangeBase.MinimumProperty #:get))
(maximum-property (: Avalonia.Controls.Primitives.RangeBase.MaximumProperty #:get))
(value-property (: Avalonia.Controls.Primitives.RangeBase.ValueProperty #:get))
(small-change-property (: Avalonia.Controls.Primitives.RangeBase.SmallChangeProperty #:get))
(items-source-property (: Avalonia.Controls.ItemsControl.ItemsSourceProperty #:get))
(selected-index-property
(: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndexProperty #:get))
(image-source-property (: Avalonia.Controls.Image.SourceProperty #:get))
(grid-row-property (: Avalonia.Controls.Grid.RowProperty #:get))
(grid-column-property (: Avalonia.Controls.Grid.ColumnProperty #:get))
(grid-row-span-property (: Avalonia.Controls.Grid.RowSpanProperty #:get))
(grid-column-span-property (: Avalonia.Controls.Grid.ColumnSpanProperty #:get))
(grid-row-spacing-property (: Avalonia.Controls.Grid.RowSpacingProperty #:get))
(grid-column-spacing-property (: Avalonia.Controls.Grid.ColumnSpacingProperty #:get))
;; A grid's sizes are not Avalonia properties, so they are set as .NET
;; properties are.
(grid-columns! (: Avalonia.Controls.Grid.ColumnDefinitions (-> Grid ColumnDefs void) #:set))
(grid-rows! (: Avalonia.Controls.Grid.RowDefinitions (-> Grid RowDefs void) #:set))
(parse-columns (: Avalonia.Controls.ColumnDefinitions.Parse (-> string ColumnDefs)))
(parse-rows (: Avalonia.Controls.RowDefinitions.Parse (-> string RowDefs)))
(set-value (: Avalonia.AvaloniaObject.SetValue
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
@ -111,6 +151,9 @@
;; dispatcher and comes later, after the patch that set the text is over.
(text-changing-event (: Avalonia.Controls.TextBox.TextChangingEvent #:get))
(checked-event (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedChangedEvent #:get))
(value-changed-event (: Avalonia.Controls.Primitives.RangeBase.ValueChangedEvent #:get))
(selection-changed-event
(: Avalonia.Controls.Primitives.SelectingItemsControl.SelectionChangedEvent #:get))
(add-handler (: Avalonia.Interactivity.Interactive.AddHandler
(-> Interactive RoutedEvent Delegate Routes bool void)))
@ -118,7 +161,11 @@
(text-box-value (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get))
(is-checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked
(-> ToggleButton (Nullable bool)) #:get))
(range-value (: Avalonia.Controls.Primitives.RangeBase.Value (-> RangeBase double) #:get))
(selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex
(-> SelectingItemsControl int) #:get))
(panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
(content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set))
(clr-string (: System.Convert.ToString (-> string ClrString)))
;; The UI thread. Controls may be touched only there, so a message from a
@ -146,6 +193,15 @@
;; Properties
;; ---------------------------------------------------------------------------
;; A kind whose children are the children of an Avalonia Panel.
(: (-> Kind bool))
(defun (panel? kind)
(match kind
(ColumnKind #t)
(RowKind #t)
(GridKind #t)
(_ #f)))
(: (-> Kind bool))
(defun (stack? kind)
(match kind
@ -158,15 +214,33 @@
(: (-> Kind bool))
(defun (templated? kind)
(match kind
(ButtonKind #t)
(TextKind #f)
(ImageKind #f)
(ColumnKind #f)
(RowKind #f)
(GridKind #f)
(_ #t)))
(: (-> Kind bool))
(defun (text-box? kind)
(match kind
(TextInputKind #t)
(CheckBoxKind #t)
(TextAreaKind #t)
(_ #f)))
(: (-> Kind bool))
(defun (range? kind)
(match kind
(SliderKind #t)
(ProgressKind #t)
(_ #f)))
;; The Avalonia property that a prop sets on a control of this kind. None
;; for a prop that the kind does not take.
;; for a prop that the kind does not take, and for the props that `set-prop!`
;; sets in a way of their own.
(: (-> Kind Prop (Option AvaloniaProperty)))
(defun (slot kind p)
(defun (when-kind ok? prop) (if ok? (Some prop) None))
(match p
((Label _)
(match kind
@ -174,9 +248,9 @@
(ButtonKind (Some (cast AvaloniaProperty content-property)))
(CheckBoxKind (Some (cast AvaloniaProperty content-property)))
(_ None)))
((Value _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty text-box-text)) None))
((Placeholder _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty watermark-property)) None))
((Checked _) (if (= kind CheckBoxKind) (Some (cast AvaloniaProperty is-checked-property)) None))
((Value _) (when-kind (text-box? kind) (cast AvaloniaProperty text-box-text)))
((Placeholder _) (when-kind (text-box? kind) (cast AvaloniaProperty watermark-property)))
((Checked _) (when-kind (= kind CheckBoxKind) (cast AvaloniaProperty is-checked-property)))
((Enabled _) (Some (cast AvaloniaProperty is-enabled-property)))
((FontSize _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size)))
@ -185,16 +259,39 @@
((Width _) (Some (cast AvaloniaProperty width-property)))
((Height _) (Some (cast AvaloniaProperty height-property)))
((Margin _) (Some (cast AvaloniaProperty margin-property)))
((Padding _) (if (templated? kind) (Some (cast AvaloniaProperty padding-property)) None))
((Spacing _) (if (stack? kind) (Some (cast AvaloniaProperty spacing-property)) None))))
((Padding _) (when-kind (templated? kind) (cast AvaloniaProperty padding-property)))
((Spacing _) (when-kind (stack? kind) (cast AvaloniaProperty spacing-property)))
((Wrap _) (when-kind (= kind TextKind) (cast AvaloniaProperty text-block-wrapping)))
((Minimum _) (when-kind (range? kind) (cast AvaloniaProperty minimum-property)))
((Maximum _) (when-kind (range? kind) (cast AvaloniaProperty maximum-property)))
((Amount _) (when-kind (range? kind) (cast AvaloniaProperty value-property)))
((Step _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property)))
((Items _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty items-source-property)))
((Selected _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty selected-index-property)))
((Row _) (Some (cast AvaloniaProperty grid-row-property)))
((Column _) (Some (cast AvaloniaProperty grid-column-property)))
((RowSpan _) (Some (cast AvaloniaProperty grid-row-span-property)))
((ColumnSpan _) (Some (cast AvaloniaProperty grid-column-span-property)))
;; Set by `set-prop!` itself.
((Source _) None)
((Columns _) None)
((Rows _) None)))
(: (-> bool TextWrapping))
(defun (wrapping wrap?)
(if wrap? TextWrapping.Wrap TextWrapping.NoWrap))
(: (-> string ClrString))
(defun (->clr-string s) (clr-string s))
;; The value of a prop, as the object `SetValue` takes.
(: (-> Prop Object))
(defun (boxed p)
(defun (text s) (cast Object (->clr-string s)))
(match p
((Label s) (cast Object (clr-string s)))
((Value s) (cast Object (clr-string s)))
((Placeholder s) (cast Object (clr-string s)))
((Label s) (text s))
((Value s) (text s))
((Placeholder s) (text s))
((Checked b) (cast Object b))
((Enabled b) (cast Object b))
((FontSize d) (cast Object d))
@ -202,7 +299,22 @@
((Height d) (cast Object d))
((Margin d) (cast Object (Thickness. d)))
((Padding d) (cast Object (Thickness. d)))
((Spacing d) (cast Object d))))
((Spacing d) (cast Object d))
((Wrap b) (cast Object (wrapping b)))
((Minimum d) (cast Object d))
((Maximum d) (cast Object d))
((Amount d) (cast Object d))
((Step d) (cast Object d))
;; A .NET array of .NET strings, which a ComboBox shows as they are.
((Items xs) (cast Object (: (vec->array (vec-map ->clr-string xs)) (Array ClrString))))
((Selected i) (cast Object i))
((Row i) (cast Object i))
((Column i) (cast Object i))
((RowSpan i) (cast Object i))
((ColumnSpan i) (cast Object i))
((Source s) (text s))
((Columns s) (text s))
((Rows s) (text s))))
;; Which prop it is, without its value. Two props with one tag set the same
;; property.
@ -211,20 +323,53 @@
(match p
((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3)
((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7)
((Margin _) 8) ((Padding _) 9) ((Spacing _) 10)))
((Margin _) 8) ((Padding _) 9) ((Spacing _) 10) ((Wrap _) 11)
((Minimum _) 12) ((Maximum _) 13) ((Amount _) 14) ((Step _) 15)
((Items _) 16) ((Selected _) 17) ((Source _) 18) ((Columns _) 19)
((Rows _) 20) ((Row _) 21) ((Column _) 22) ((RowSpan _) 23) ((ColumnSpan _) 24)))
(: (-> Control AvaloniaProperty Object void))
(defun (put! control property value)
(ignore (set-value (cast AvaloniaObject control) property value Priority.LocalValue)))
;; The picture in a file, or None when it cannot be read.
(: (-> string (Option Bitmap)))
(defun (load-bitmap path)
(match (try (Bitmap. path) #:catch (System.Exception))
((Ok b) (Some b))
((Err _) None)))
(: (-> Control Kind Prop void))
(defun (set-prop! control kind p)
(match (slot kind p)
((Some property)
(ignore (set-value (cast AvaloniaObject control) property (boxed p) Priority.LocalValue)))
(None unit)))
(match (Tuple kind p)
((Tuple ImageKind (Source path))
(match (load-bitmap path)
((Some b) (put! control (cast AvaloniaProperty image-source-property) (cast Object b)))
(None (clear-value (cast AvaloniaObject control) (cast AvaloniaProperty image-source-property)))))
((Tuple GridKind (Columns s)) (grid-columns! (cast Grid control) (parse-columns s)))
((Tuple GridKind (Rows s)) (grid-rows! (cast Grid control) (parse-rows s)))
((Tuple GridKind (Spacing d))
(put! control (cast AvaloniaProperty grid-row-spacing-property) (cast Object d))
(put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d)))
(_
(match (slot kind p)
((Some property) (put! control property (boxed p)))
(None unit)))))
(: (-> Control Kind Prop void))
(defun (clear-prop! control kind p)
(match (slot kind p)
((Some property) (clear-value (cast AvaloniaObject control) property))
(None unit)))
(defun (clear property) (clear-value (cast AvaloniaObject control) property))
(match (Tuple kind p)
((Tuple ImageKind (Source _)) (clear (cast AvaloniaProperty image-source-property)))
((Tuple GridKind (Columns _)) (grid-columns! (cast Grid control) (parse-columns "*")))
((Tuple GridKind (Rows _)) (grid-rows! (cast Grid control) (parse-rows "*")))
((Tuple GridKind (Spacing _))
(clear (cast AvaloniaProperty grid-row-spacing-property))
(clear (cast AvaloniaProperty grid-column-spacing-property)))
(_
(match (slot kind p)
((Some property) (clear property))
(None unit)))))
;; Clears the props that are gone, and sets the ones that are new or have
;; another value. A prop with the same value is not set again.
@ -403,18 +548,21 @@
(spawn/daemon (run-sub app (.next-event sub))))
scope))
(: (-> (Sub %m) string))
(defun (sub-key sub) (.key sub))
(: (-> (App %model %m) void))
(defun (sync-subs! app)
(def wanted ((.subscriptions app) (.model app)))
(defun (wanted? key) (any? (fun (sub) (= (.key sub) key)) wanted))
(defun (wanted? key) (any? (fun (sub) (= (sub-key sub) key)) wanted))
(def/mutable kept '())
(loop (:for (Tuple key scope) (.subs app))
(:do (if (wanted? key)
(set! kept (cons (Tuple key scope) kept))
(stop-scope! scope))))
(loop (:for sub wanted)
(:when (not (any? (fun (t) (= (fst t) (.key sub))) kept)))
(:do (set! kept (cons (Tuple (.key sub) (start-sub! app sub)) kept))))
(:when (not (any? (fun (t) (= (fst t) (sub-key sub))) kept)))
(:do (set! kept (cons (Tuple (sub-key sub) (start-sub! app sub)) kept))))
(record-set! app (subs kept)))
(: (-> (App %model %m) void))
@ -455,41 +603,76 @@
(: (-> (App %model %m) (Live %m) Kind void))
(defun (listen! app live kind)
(def control (.control live))
(defun (on-event (: event RoutedEvent) pick)
(on! control event (fun (sender e) (fire! app live (pick)))))
(match kind
(ButtonKind
(on! control (cast RoutedEvent click-event)
(fun (sender e)
(fire! app live (fun (on) (match on ((Click msg) (Some msg)) (_ None)))))))
(TextInputKind
(on! control (cast RoutedEvent text-changing-event)
(fun (sender e)
(def s (text-box-value (cast TextBox control)))
(fire! app live (fun (on) (match on ((Input f) (Some (f s))) (_ None)))))))
(on-event (cast RoutedEvent click-event)
(fun () (fun (on) (match on ((Click msg) (Some msg)) (_ None))))))
((or TextInputKind TextAreaKind)
(on-event (cast RoutedEvent text-changing-event)
(fun ()
(def s (text-box-value (cast TextBox control)))
(fun (on) (match on ((Input f) (Some (f s))) (_ None))))))
(CheckBoxKind
(on! control (cast RoutedEvent checked-event)
(fun (sender e)
(def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
(fire! app live (fun (on) (match on ((Toggle f) (Some (f b))) (_ None)))))))
(on-event (cast RoutedEvent checked-event)
(fun ()
(def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
(fun (on) (match on ((Toggle f) (Some (f b))) (_ None))))))
(SliderKind
(on-event (cast RoutedEvent value-changed-event)
(fun ()
(def d (range-value (cast RangeBase control)))
(fun (on) (match on ((Slide f) (Some (f d))) (_ None))))))
(DropdownKind
(on-event (cast RoutedEvent selection-changed-event)
(fun ()
(def i (selected-index (cast SelectingItemsControl control)))
(fun (on) (match on ((Select f) (Some (f i))) (_ None))))))
(_ unit)))
(: (-> Kind Control))
(defun (make-control kind)
(match kind
(TextKind (cast Control (TextBlock.)))
(TextKind
;; Centred in the height it is given, so a label lines up with the
;; control beside it in a row or a grid.
(def t (cast Control (TextBlock.)))
(put! t (cast AvaloniaProperty vertical-alignment-property) (cast Object VAlignment.Center))
t)
(ButtonKind
;; Centred, because a button given a width shows its label at the left.
(def b (Button.))
(ignore (set-value (cast AvaloniaObject b) (cast AvaloniaProperty content-alignment-property)
(cast Object HAlignment.Center) Priority.LocalValue))
(cast Control b))
(def b (cast Control (Button.)))
(put! b (cast AvaloniaProperty content-alignment-property) (cast Object HAlignment.Center))
b)
(TextInputKind (cast Control (TextBox.)))
(TextAreaKind
(def t (cast Control (TextBox.)))
(put! t (cast AvaloniaProperty accepts-return-property) (cast Object #t))
(put! t (cast AvaloniaProperty text-box-wrapping) (cast Object TextWrapping.Wrap))
t)
(CheckBoxKind (cast Control (CheckBox.)))
(SliderKind (cast Control (Slider.)))
(ProgressKind (cast Control (ProgressBar.)))
(DropdownKind
(def d (cast Control (ComboBox.)))
(put! d (cast AvaloniaProperty horizontal-alignment-property) (cast Object HAlignment.Stretch))
d)
(ImageKind (cast Control (Image.)))
(ColumnKind (cast Control (StackPanel.)))
(RowKind
(def panel (StackPanel.))
(ignore (set-value (cast AvaloniaObject panel) (cast AvaloniaProperty orientation-property)
(cast Object Orientation.Horizontal) Priority.LocalValue))
(cast Control panel))))
(def panel (cast Control (StackPanel.)))
(put! panel (cast AvaloniaProperty orientation-property) (cast Object Orientation.Horizontal))
panel)
(GridKind (cast Control (Grid.)))
(ScrollKind (cast Control (ScrollViewer.)))))
;; Puts a child's control in its parent's, as the last one.
(: (-> Kind Control Control void))
(defun (adopt! kind parent child)
(if (= kind ScrollKind)
(content! (cast ContentControl parent) (cast Object child))
(.Add (panel-children (cast Panel parent)) child)))
;; Makes the controls for a view.
(: (-> (App %model %m) (View %m) (Live %m)))
@ -502,7 +685,7 @@
(loop (:for child (view-children v))
(:do (def c (mount app child))
(mutablevec-add! (.children live) c)
(.Add (panel-children (cast Panel control)) (.control c))))
(adopt! kind control (.control c))))
live)
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
@ -516,30 +699,80 @@
(begin
(patch-props! (.control live) kind (view-props old) (view-props next))
(record-set! live (view next))
(when (stack? kind)
(patch-children! app live (view-children next)))
(cond ((panel? kind) (patch-children! app live (view-children next)))
((= kind ScrollKind) (patch-content! app live (view-children next)))
(else unit))
live)))
;; Children are matched by their place: the first with the first, and so on.
;; Those past the end of the shorter list are added or removed.
;; A scroll's one child is its content.
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
(defun (patch-content! app live views)
(def kids (.children live))
(def was (mutablevec-ref kids 0))
(def now (patch! app was (vec-ref views 0)))
(unless (eq? now was)
(mutablevec-set! kids 0 now)
(content! (cast ContentControl (.control live)) (cast Object (.control now)))))
;; Which child each view is: its key, or its place among the children that
;; have none. The two kinds cannot be mistaken for each other.
(: (-> (Vec (View %m)) (Vec string)))
(defun (identities views)
(def/mutable unkeyed 0)
(loop (:for v views)
(:acc out (vecing (match (view-key v)
((Some k) (string-append "k" k))
(None (set! unkeyed (+ unkeyed 1))
#"i${(- unkeyed 1)}"))))
=> out))
;; Children are matched by identity: a child of the last view whose key, or
;; whose place among those with no key, is a child's of the next one keeps
;; its control, and is changed to the next view. The others are made new,
;; and those left over are removed. Then the controls are put in the order
;; of the next view, moving only those that are out of place.
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
(defun (patch-children! app live views)
(def kids (.children live))
(def controls (panel-children (cast Panel (.control live))))
(def n (vec-length views))
(loop (:for i (range 0 (min n (mutablevec-length kids))))
(:do (def was (mutablevec-ref kids i))
(def now (patch! app was (vec-ref views i)))
(unless (eq? now was)
(mutablevec-set! kids i now)
(.set_Item controls i (.control now)))))
(loop (:while (> (mutablevec-length kids) n))
(:do (ignore (mutablevec-pop! kids))
(.RemoveAt controls (mutablevec-length kids))))
(loop (:for i (range (mutablevec-length kids) n))
(:do (def c (mount app (vec-ref views i)))
(mutablevec-add! kids c)
(.Add controls (.control c)))))
(def olds (mutablevec->vec kids))
(def old-ids (identities (vec-map (fun (l) (.view l)) olds)))
(def new-ids (identities views))
;; Where each identity was. A second child with one identity is new.
(def where (mutablemap))
(loop (:for (Tuple i id) (enumerate old-ids))
(:when (not (mutablemap-contains? where id)))
(:do (mutablemap-set! where id i)))
(def kept (: (make-array (vec-length olds) #:fill #f) (Array bool)))
(def nexts (mutablevec))
(loop (:for (Tuple j v) (enumerate views))
(:do (def now
(match (mutablemap-try-ref where (vec-ref new-ids j))
((Some i)
(ignore (mutablemap-remove! where (vec-ref new-ids j)))
(def was (vec-ref olds i))
(def now (patch! app was v))
(when (eq? now was) (array-set! kept i #t))
now)
(None (mount app v))))
(mutablevec-add! nexts now)))
(loop (:for (Tuple i was) (enumerate olds))
(:when (not (array-ref kept i)))
(:do (ignore (.Remove controls (.control was)))))
(loop (:for (Tuple j now) (enumerate (mutablevec->vec nexts)))
(:do (def c (.control now))
(unless (and (< j (.-Count controls)) (eq? (.get_Item controls j) c))
(def at (.IndexOf controls c))
(if (>= at 0)
(.Move controls at j)
(.Insert controls j c)))))
(mutablevec-clear! kids)
(loop (:for now (mutablevec->vec nexts)) (:do (mutablevec-add! kids now))))
;; An app with no window: its view is made now, its subscriptions started,
;; and `on-root` is given the control to show each time that control changes.

148
src/view.bjo
View file

@ -18,10 +18,13 @@
View Kind Prop On
;; Constructors.
text button text-input checkbox column row
text button text-input text-area checkbox slider progress-bar dropdown image
column row grid scroll
;; Wrappers.
keyed at
;; Reading one.
view-kind view-props view-events view-children)
view-kind view-props view-events view-children view-key)
(import (std prelude))
@ -30,7 +33,9 @@
;; ---------------------------------------------------------------------------
;; What control a view is.
(type (: Kind (Union TextKind ButtonKind TextInputKind CheckBoxKind ColumnKind RowKind)))
(type (: Kind (Union TextKind ButtonKind TextInputKind TextAreaKind CheckBoxKind
SliderKind ProgressKind DropdownKind ImageKind
ColumnKind RowKind GridKind ScrollKind)))
;; A property of a control. A kind takes only some of them; the app ignores
;; the others.
@ -44,18 +49,40 @@
(: Height double)
(: Margin double)
(: Padding double)
(: Spacing double))))
(: Spacing double)
(: Wrap bool) ; a text breaks its lines at the width
(: Minimum double) ; of a slider or a progress bar
(: Maximum double)
(: Amount double) ; where a slider or a progress bar is
(: Step double) ; what an arrow key moves a slider by
(: Items (Vec string)) ; what a dropdown offers
(: Selected int) ; which of them is chosen; -1 for none
(: Source string) ; the file an image shows
(: Columns string) ; a grid's columns, as "Auto,*,2*"
(: Rows string)
(: Row int) ; where a view is in its grid
(: Column int)
(: RowSpan int)
(: ColumnSpan int))))
;; An event, and the message it sends.
(type (: (On %m) (Union (: Click %m)
(: Input (-> string %m))
(: Toggle (-> bool %m)))))
(: Toggle (-> bool %m))
(: Slide (-> double %m))
(: Select (-> int %m)))))
;; One control and what is in it.
;;
;; `key` says which child of its parent a view is. Children with keys are
;; matched by key when the next view is compared with the last one, so a
;; child that moves keeps its control. Children without one are matched by
;; their place among the others without one.
(type (: (View %m) (Record (: kind Kind)
(: props (Vec Prop))
(: events (Vec (On %m)))
(: children (Vec (View %m))))))
(: children (Vec (View %m)))
(: key (Option string)))))
(: view-kind (-> (View %m) Kind))
(defun (view-kind v) (.kind v))
@ -69,6 +96,26 @@
(: view-children (-> (View %m) (Vec (View %m))))
(defun (view-children v) (.children v))
(: view-key (-> (View %m) (Option string)))
(defun (view-key v) (.key v))
;; ---------------------------------------------------------------------------
;; Wrappers
;; ---------------------------------------------------------------------------
;; The view, with a key that says which child it is. Give each item of a list
;; that can change order a key of its own, such as its id.
(: keyed (-> string (View %m) (View %m)))
(defun (keyed key v)
(record-set v (key (Some key))))
;; The view, in a cell of its grid. Rows and columns count from 0.
(: at (-> int int (View %m) (#:row-span int) (#:column-span int) (View %m)))
(defun (at row column v #:row-span 1 #:column-span 1)
(record-set v (props (vec-add (vec-add (vec-add (vec-add (.props v) (Row row)) (Column column))
(RowSpan row-span))
(ColumnSpan column-span)))))
;; ---------------------------------------------------------------------------
;; Constructors
;; ---------------------------------------------------------------------------
@ -88,14 +135,15 @@
(: (-> Kind (Vec Prop) (Vec (On %m)) (View %m)))
(defun (leaf kind props events)
(View (kind kind) (props props) (events events) (children [])))
(View (kind kind) (props props) (events events) (children []) (key None)))
;; A text.
(: (-> string (#:size double) (#:width double) (#:height double) (#:margin double)
(: (-> string (#:size double) (#:wrap bool) (#:width double) (#:height double)
(#:margin double)
(View %m)))
(defun (text s #:size 0.0 #:width 0.0 #:height 0.0 #:margin 0.0)
(defun (text s #:size 0.0 #:wrap #f #:width 0.0 #:height 0.0 #:margin 0.0)
(leaf TextKind
(with-layout (with-size [(Label s)] FontSize size) width height margin 0.0)
(with-layout (with-size [(Label s) (Wrap wrap)] FontSize size) width height margin 0.0)
[]))
;; A button that sends `msg` when it is clicked.
@ -118,6 +166,59 @@
width 0.0 margin 0.0)
[(Input on-input)]))
;; A text input of several lines, that breaks its lines at its width. Each
;; change sends `(on-input text)`, with the whole text.
(: (-> string (-> string %m) (#:placeholder string) (#:enabled bool)
(#:width double) (#:height double) (#:margin double)
(View %m)))
(defun (text-area value on-input #:placeholder "" #:enabled #t #:width 0.0 #:height 0.0
#:margin 0.0)
(leaf TextAreaKind
(with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)]
width height margin 0.0)
[(Input on-input)]))
;; A slider at `value`, from `minimum` to `maximum`. A move sends `(on-change
;; value)`.
(: (-> double double double (-> double %m) (#:step double) (#:enabled bool)
(#:width double) (#:margin double)
(View %m)))
(defun (slider value minimum maximum on-change #:step 1.0 #:enabled #t #:width 0.0
#:margin 0.0)
;; The bounds come before the value, because a value outside the bounds
;; that are there is moved inside them.
(leaf SliderKind
(with-layout [(Minimum minimum) (Maximum maximum) (Amount value) (Step step)
(Enabled enabled)]
width 0.0 margin 0.0)
[(Slide on-change)]))
;; A bar that is `value` of the way from 0 to `#:maximum`, 1 unless told
;; otherwise.
(: (-> double (#:maximum double) (#:width double) (#:margin double) (View %m)))
(defun (progress-bar value #:maximum 1.0 #:width 0.0 #:margin 0.0)
(leaf ProgressKind
(with-layout [(Minimum 0.0) (Maximum maximum) (Amount value)] width 0.0 margin 0.0)
[]))
;; A list to choose one of `options` from, with the one at `selected` chosen,
;; or none for -1. A choice sends `(on-select index)`.
(: (-> (Vec string) int (-> int %m) (#:enabled bool) (#:width double) (#:margin double)
(View %m)))
(defun (dropdown options selected on-select #:enabled #t #:width 0.0 #:margin 0.0)
;; The items come before the choice, because the choice is an index into
;; them.
(leaf DropdownKind
(with-layout [(Items options) (Selected selected) (Enabled enabled)]
width 0.0 margin 0.0)
[(Select on-select)]))
;; The picture in the file at `path`. A file that cannot be read shows
;; nothing.
(: (-> string (#:width double) (#:height double) (#:margin double) (View %m)))
(defun (image path #:width 0.0 #:height 0.0 #:margin 0.0)
(leaf ImageKind (with-layout [(Source path)] width height margin 0.0) []))
;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with
;; the new state.
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
@ -126,12 +227,14 @@
(with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0)
[(Toggle on-toggle)]))
(: (-> Kind (Vec Prop) (Vec (View %m)) (View %m)))
(defun (container kind props children)
(View (kind kind) (props props) (events []) (children children) (key None)))
(: (-> Kind double double (Array (View %m)) (View %m)))
(defun (stack kind spacing margin children)
(View (kind kind)
(props (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0))
(events [])
(children (array->vec children))))
(container kind (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0)
(array->vec children)))
;; Views one above the other.
(: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m)))
@ -142,3 +245,20 @@
(: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m)))
(defun (row #:spacing 0.0 #:margin 0.0 #:rest children)
(stack RowKind spacing margin children))
;; Views in the cells of a grid. `#:columns` and `#:rows` are the sizes, as
;; in Avalonia: "Auto" fits the content, "*" shares what is left, "2*" takes
;; two shares, and a number is pixels. Put a view in a cell with `at`; one
;; that is not put anywhere is in the first.
(: (-> (#:columns string) (#:rows string) (#:spacing double) (#:margin double)
#:rest (View %m) (View %m)))
(defun (grid #:columns "*" #:rows "*" #:spacing 0.0 #:margin 0.0 #:rest children)
(container GridKind
(with-layout (with-size [(Columns columns) (Rows rows)] Spacing spacing)
0.0 0.0 margin 0.0)
(array->vec children)))
;; 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)
(container ScrollKind (with-layout [] width height margin 0.0) [child]))