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

48
Readme.org
View file

@ -35,8 +35,11 @@ view. The next view is compared with the last one, control by control, and
only what differs is changed. So a control keeps its focus, its caret and its
scroll position when the model changes.
Children are matched by their place in the list. A child whose kind changes
gets a new control.
Children are matched by key, and those with no key by their place among
the others with none. Give each item of a list that can change order a key
with ~(keyed id view)~: a child that moves then keeps its control, and the
control is moved rather than made again. A child whose kind changes gets a
new control.
A control that is changed raises events of its own: a text input whose text
is set says that its text changed. Those events come while the controls are
@ -45,17 +48,43 @@ being changed, and they are dropped, so only the user's events are messages.
* The views: (bjogui view)
| Constructor | Control | Sends |
|--------------------------------------------------+--------------+-----------------------------|
|------------------------------------------------------+---------------+-------------------------------|
| ~(text s)~ | ~TextBlock~ | nothing |
| ~(button label msg)~ | ~Button~ | ~msg~ on a click |
| ~(text-input value on-input)~ | ~TextBox~ | ~(on-input text)~ on a change |
| ~(text-area value on-input)~ | ~TextBox~, several lines | ~(on-input text)~ |
| ~(checkbox label checked? on-toggle)~ | ~CheckBox~ | ~(on-toggle checked)~ |
| ~(slider value minimum maximum on-change)~ | ~Slider~ | ~(on-change value)~ |
| ~(progress-bar value)~ | ~ProgressBar~ | nothing |
| ~(dropdown options selected on-select)~ | ~ComboBox~ | ~(on-select index)~ |
| ~(image path)~ | ~Image~ | nothing |
| ~(column child ...)~, ~(row child ...)~ | ~StackPanel~ | nothing |
| ~(grid #:columns #:rows child ...)~ | ~Grid~ | nothing |
| ~(scroll child)~ | ~ScrollViewer~ | nothing |
They take keywords where they apply: ~#:size~ (the font size of a text),
~#:width~, ~#:height~, ~#:margin~, ~#:padding~, ~#:spacing~ (between the
children of a column or a row), ~#:enabled~ and ~#:placeholder~. A size of
zero, the default, leaves the size to the control.
~#:wrap~ (a text breaks its lines at its width), ~#:width~, ~#:height~,
~#:margin~, ~#:padding~, ~#:spacing~ (between the children of a column, a row
or a grid), ~#:enabled~, ~#:placeholder~, ~#:step~ (a slider's arrow key) and
~#:maximum~ (a progress bar's full, 1 unless told otherwise). A size of zero,
the default, leaves the size to the control.
A grid's ~#:columns~ and ~#:rows~ are sizes as Avalonia writes them: ~"Auto"~
fits the content, ~"*"~ shares what is left, ~"2*"~ takes two shares, and a
number is pixels. ~(at row column view)~ puts a view in a cell, counting from
0, with ~#:row-span~ and ~#:column-span~.
#+BEGIN_SRC scheme
(grid #:columns "Auto,*" #:rows "Auto,Auto" #:spacing 6.0
(at 0 0 (text "Volume")) (at 0 1 (slider (.volume m) 0.0 10.0 Volume))
(at 1 0 (text "Colour")) (at 1 1 (dropdown ["red" "green" "blue"] (.colour m) Colour)))
(scroll (apply column (vec->array (vec-map (fun (t) (keyed (.id t) (text (.title t))))
(.todos m))))
#:height 200.0)
#+END_SRC
An image that cannot be read shows nothing.
* Work: commands and subscriptions
@ -124,11 +153,14 @@ cancelled, and the program ends.
#+BEGIN_SRC sh
bjo run tests/app.bjo # prints "bjogui ok"
bjo run tests/effects.bjo # prints "bjogui effects ok"
bjo run tests/controls.bjo # prints "bjogui controls ok"
bjo run examples/counter.bjo
bjo run examples/stopwatch.bjo
#+END_SRC
* Not yet
- Keyed children, for lists whose items move.
- More controls: lists, grids, images, scroll views, menus.
- A list box with a selection, tabs, menus and dialogs.
- Colours, borders and styles of one's own.
- A moved control is taken out of the panel and put back, so it may lose the
keyboard focus.

351
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 (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)
(ignore (set-value (cast AvaloniaObject control) property (boxed p) Priority.LocalValue)))
(None unit)))
((Some property) (put! control property (boxed p)))
(None unit)))))
(: (-> Control Kind Prop void))
(defun (clear-prop! control kind p)
(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-value (cast AvaloniaObject control) property))
(None unit)))
((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)
(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)))
(fire! app live (fun (on) (match on ((Input f) (Some (f s))) (_ None)))))))
(fun (on) (match on ((Input f) (Some (f s))) (_ None))))))
(CheckBoxKind
(on! control (cast RoutedEvent checked-event)
(fun (sender e)
(on-event (cast RoutedEvent checked-event)
(fun ()
(def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
(fire! app live (fun (on) (match on ((Toggle f) (Some (f b))) (_ None)))))))
(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]))

204
tests/controls.bjo Normal file
View file

@ -0,0 +1,204 @@
;; 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/tests/controls.bjo — keyed children, and the controls past the
;; first six.
;;
;; bjo run tests/controls.bjo
;;
;; No window is opened. Controls are compared by identity with `eq?`, to see
;; which were kept and which were made new.
(import (std prelude))
(import (std simpletest))
(import (bjogui view))
(import (bjogui app))
(import (std interop))
(import/class
(Object (: System.Object))
(Disposable (: System.IDisposable))
(AvaloniaObject (: Avalonia.AvaloniaObject))
(AvaloniaProperty (: Avalonia.AvaloniaProperty))
(Priority (: Avalonia.Data.BindingPriority))
(Control (: Avalonia.Controls.Control))
(Controls (: Avalonia.Controls.Controls))
(Panel (: Avalonia.Controls.Panel))
(Grid (: Avalonia.Controls.Grid))
(ColumnDefs (: Avalonia.Controls.ColumnDefinitions))
(TextBlock (: Avalonia.Controls.TextBlock))
(TextBox (: Avalonia.Controls.TextBox))
(ContentControl (: Avalonia.Controls.ContentControl))
(ScrollViewer (: Avalonia.Controls.ScrollViewer))
(RangeBase (: Avalonia.Controls.Primitives.RangeBase))
(ItemsControl (: Avalonia.Controls.ItemsControl))
(SelectingItemsControl (: Avalonia.Controls.Primitives.SelectingItemsControl))
(Image (: Avalonia.Controls.Image))
(IImage (: Avalonia.Media.IImage)))
(import/extern
(set-value (: Avalonia.AvaloniaObject.SetValue
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
(range-value-property (: Avalonia.Controls.Primitives.RangeBase.ValueProperty #:get))
(selected-index-property
(: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndexProperty #:get))
(children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
(count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))
(child-at (: Avalonia.Controls.Controls.get_Item (-> Controls int Control)))
(block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get))
(box-text! (: Avalonia.Controls.TextBox.Text (-> TextBox string void) #:set))
(accepts-return? (: Avalonia.Controls.TextBox.AcceptsReturn (-> TextBox bool) #:get))
(range-value (: Avalonia.Controls.Primitives.RangeBase.Value (-> RangeBase double) #:get))
(range-maximum (: Avalonia.Controls.Primitives.RangeBase.Maximum (-> RangeBase double) #:get))
(item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get))
(selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex
(-> SelectingItemsControl int) #:get))
(grid-row (: Avalonia.Controls.Grid.GetRow (-> Control int)))
(grid-column (: Avalonia.Controls.Grid.GetColumn (-> Control int)))
(grid-columns (: Avalonia.Controls.Grid.ColumnDefinitions (-> Grid ColumnDefs) #:get))
(scroll-content (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object) #:get))
(image-source (: Avalonia.Controls.Image.Source (-> Image IImage) #:get))
(null? (: System.Object.ReferenceEquals (-> Object Object bool))))
;; ---------------------------------------------------------------------------
;; A list, keyed or not
;; ---------------------------------------------------------------------------
(type (: Item (Record (: id string) (: name string))))
;; The items, and whether to key them.
(type (: Lst (Record (: items (List Item)) (: keyed? bool))))
(: (-> Lst Lst (Tuple Lst (List (Event Lst)))))
(defun (replace msg m) (next msg))
(: (-> Lst (View Lst)))
(defun (list-view l)
(apply column
(vec->array
(vec-map (fun (it)
(def v (text (.name it)))
(if (.keyed? l) (keyed (.id it) v) v))
(list->vec (.items l))))))
(: (-> (List string) bool Lst))
(defun (items ids keyed?)
(Lst (items (list-map item ids)) (keyed? keyed?)))
(: (-> string Item))
(defun (item id) (Item (id id) (name (string-append "item " id))))
;; ---------------------------------------------------------------------------
;; The other controls
;; ---------------------------------------------------------------------------
(type (: Msg (Union (: Typed string) (: Slid double) (: Chose int) (: Show bool) Nothing)))
(type (: Model (Record (: notes string) (: level double) (: choice int) (: scrolled bool))))
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
(next (match msg
((Typed s) (record-set m (notes s)))
((Slid d) (record-set m (level d)))
((Chose i) (record-set m (choice i)))
((Show b) (record-set m (scrolled b)))
(Nothing m))))
(: (-> Model (View Msg)))
(defun (view m)
(column
(text-area (.notes m) Typed #:height 80.0) ; 0
(slider (.level m) 0.0 10.0 Slid) ; 1
(progress-bar (/ (.level m) 10.0)) ; 2
(dropdown ["red" "green" "blue"] (.choice m) Chose) ; 3
(grid #:columns "Auto,*" #:rows "Auto,Auto" #:spacing 4.0 ; 4
(at 0 0 (text "name"))
(at 0 1 (text "value"))
(at 1 1 (text (.notes m))))
(scroll (if (.scrolled m) (column (text "a") (text "b")) (text "just one"))
#:height 50.0) ; 5
(image "/no/such/file.png" #:width 10.0) ; 6
(text "a long line" #:wrap #t))) ; 7
(defun (main)
;; --- keyed children ---------------------------------------------------------
(def lst (start-app (items '("a" "b" "c") #t)
replace list-view (fun (c) unit)))
(defun (at-row i) (app-control-at lst (list i)))
(defun (names)
(def kids (children (cast Panel (app-control lst))))
(loop (:for i (range 0 (count kids)))
(:acc out (listing (block-text (cast TextBlock (child-at kids i)))))
=> out))
(def a (at-row 0))
(def b (at-row 1))
(def c (at-row 2))
(app-dispatch! lst (items '("c" "b" "a") #t))
(expect "reversed" (names) '("item c" "item b" "item a"))
(expect "the controls moved with their keys"
(list (eq? (at-row 0) c) (eq? (at-row 1) b) (eq? (at-row 2) a)) '(#t #t #t))
(app-dispatch! lst (items '("z" "c" "b" "a") #t))
(expect "one put in front" (names) '("item z" "item c" "item b" "item a"))
(expect "the others kept" (list (eq? (at-row 1) c) (eq? (at-row 3) a)) '(#t #t))
(app-dispatch! lst (items '("z" "b" "a") #t))
(expect "one taken out" (names) '("item z" "item b" "item a"))
(expect "the rest kept" (list (eq? (at-row 1) b) (eq? (at-row 2) a)) '(#t #t))
(app-dispatch! lst (items '("a" "a" "b") #t))
(expect "a key twice" (names) '("item a" "item a" "item b"))
(expect "the first keeps the control" (eq? (at-row 0) a) #t)
;; With no keys, children are matched by place: the first control now
;; shows what the new first item is.
(app-dispatch! lst (items '("a" "b") #f))
(def first (at-row 0))
(app-dispatch! lst (items '("y" "a" "b") #f))
(expect "unkeyed, by place" (names) '("item y" "item a" "item b"))
(expect "the first control shows the new first" (eq? (at-row 0) first) #t)
;; --- the other controls -----------------------------------------------------
(def app (start-app (Model (notes "") (level 2.0) (choice 1) (scrolled #f))
gui-update view (fun (c) unit)))
(defun (ctl i) (app-control-at app (list i)))
(def area (cast TextBox (ctl 0)))
(expect "a text area takes Enter" (accepts-return? area) #t)
(box-text! area "one\ntwo")
(expect "a text area sends its text" (.notes (app-model app)) "one\ntwo")
(def slide (cast RangeBase (ctl 1)))
(expect "a slider's value" (range-value slide) 2.0)
(expect "a slider's bounds" (range-maximum slide) 10.0)
(ignore (set-value (cast AvaloniaObject slide) (cast AvaloniaProperty range-value-property)
(cast Object 7.0) Priority.LocalValue))
(expect "a slider sends where it is" (.level (app-model app)) 7.0)
(expect "a progress bar follows" (range-value (cast RangeBase (ctl 2))) 0.7)
(def drop (cast SelectingItemsControl (ctl 3)))
(expect "a dropdown's items" (item-count (cast ItemsControl drop)) 3)
(expect "a dropdown's choice" (selected-index drop) 1)
(ignore (set-value (cast AvaloniaObject drop) (cast AvaloniaProperty selected-index-property)
(cast Object 2) Priority.LocalValue))
(expect "a dropdown sends the choice" (.choice (app-model app)) 2)
(def g (cast Grid (ctl 4)))
(expect "a grid's columns" (.-Count (grid-columns g)) 2)
(expect "a cell" (list (grid-row (app-control-at app '(4 2))) (grid-column (app-control-at app '(4 2))))
'(1 1))
(expect "the cell shows the model" (block-text (cast TextBlock (app-control-at app '(4 2)))) "one\ntwo")
(def sc (cast ContentControl (ctl 5)))
(def inner (app-control-at app '(5 0)))
(expect "a scroll holds its child" (eq? (scroll-content sc) (cast Object inner)) #t)
(app-dispatch! app (Show #t))
(expect "a child of another kind replaces it"
(eq? (scroll-content sc) (cast Object (app-control-at app '(5 0)))) #t)
(expect "and is not the old one" (eq? (app-control-at app '(5 0)) inner) #f)
(expect "an image that cannot be read shows nothing"
(null? (cast Object (image-source (cast Image (ctl 6)))) (clr-default)) #t)
(println "bjogui controls ok"))