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

List boxes, tabs, colours and borders

Browse source 
A list box's items and a tab control's tabs are views, patched by key as a
column's children are: Panel.Children and ItemsControl.Items are both an
IList, so one patch serves both. A list can choose an item only once its
items are there, so the choice is set after the children.

A routed event bubbles, so each handler now takes only its own control's
events. Before, a dropdown in a list item would have been heard as the
list's choice too.

paint gives any view a text and a background colour, and border a frame. A
colour that cannot be read leaves the theme's.

🤖 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:21:40 +01:00
parent 95b6707cc1
commit e773bc424e
4 changed files with 432 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

202
src/app.bjo
View file

@ -71,6 +71,16 @@
(Image (: Avalonia.Controls.Image (-> Image)))
(Bitmap (: Avalonia.Media.Imaging.Bitmap (-> string Bitmap)))
(TextWrapping (: Avalonia.Media.TextWrapping))
(IBrush (: Avalonia.Media.IBrush))
(CornerRadius (: Avalonia.CornerRadius (-> double CornerRadius)))
(ListBox (: Avalonia.Controls.ListBox (-> ListBox)))
(TabControl (: Avalonia.Controls.TabControl (-> TabControl)))
(TabItem (: Avalonia.Controls.TabItem (-> TabItem)))
(Border (: Avalonia.Controls.Border (-> Border)))
(ItemsControl (: Avalonia.Controls.ItemsControl))
(ItemCollection (: Avalonia.Controls.ItemCollection))
(IList (: System.Collections.IList))
(ICollection (: System.Collections.ICollection))
(Controls (: Avalonia.Controls.Controls))
(Panel (: Avalonia.Controls.Panel))
(StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel)))
@ -133,6 +143,19 @@
(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))
(header-property (: Avalonia.Controls.Primitives.HeaderedContentControl.HeaderProperty #:get))
(text-block-background (: Avalonia.Controls.TextBlock.BackgroundProperty #:get))
(text-block-foreground (: Avalonia.Controls.TextBlock.ForegroundProperty #:get))
(background-property (: Avalonia.Controls.Primitives.TemplatedControl.BackgroundProperty #:get))
(foreground-property (: Avalonia.Controls.Primitives.TemplatedControl.ForegroundProperty #:get))
(panel-background (: Avalonia.Controls.Panel.BackgroundProperty #:get))
(border-background (: Avalonia.Controls.Border.BackgroundProperty #:get))
(border-brush-property (: Avalonia.Controls.Border.BorderBrushProperty #:get))
(border-thickness-property (: Avalonia.Controls.Border.BorderThicknessProperty #:get))
(corner-radius-property (: Avalonia.Controls.Border.CornerRadiusProperty #:get))
(decorator-padding (: Avalonia.Controls.Decorator.PaddingProperty #:get))
(decorator-child (: Avalonia.Controls.Decorator.ChildProperty #:get))
(parse-brush (: Avalonia.Media.Brush.Parse (-> string IBrush)))
;; A grid's sizes are not Avalonia properties, so they are set as .NET
;; properties are.
@ -165,6 +188,17 @@
(selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex
(-> SelectingItemsControl int) #:get))
(panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
(items-of (: Avalonia.Controls.ItemsControl.Items (-> ItemsControl ItemCollection) #:get))
(event-source (: Avalonia.Interactivity.RoutedEventArgs.Source (-> RoutedEventArgs Object) #:get))
;; Panel.Children and ItemsControl.Items are both an IList, so one patch
;; serves a panel's children and a list's items.
(list-count (: System.Collections.ICollection.Count (-> ICollection int) #:get))
(list-ref (: System.Collections.IList.get_Item (-> IList int Object)))
(list-index-of (: System.Collections.IList.IndexOf (-> IList Object int)))
(list-insert! (: System.Collections.IList.Insert (-> IList int Object void)))
(list-add! (: System.Collections.IList.Add (-> IList Object int)))
(list-remove! (: System.Collections.IList.Remove (-> IList Object void)))
(list-remove-at! (: System.Collections.IList.RemoveAt (-> IList int void)))
(content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set))
(clr-string (: System.Convert.ToString (-> string ClrString)))
@ -219,8 +253,35 @@
(ColumnKind #f)
(RowKind #f)
(GridKind #f)
(BorderKind #f)
(_ #t)))
;; A kind whose children are the items of an Avalonia ItemsControl.
(: (-> Kind bool))
(defun (items? kind)
(match kind
(ListBoxKind #t)
(TabsKind #t)
(_ #f)))
;; A kind with one child, which is its content.
(: (-> Kind bool))
(defun (single? kind)
(match kind
(ScrollKind #t)
(TabKind #t)
(BorderKind #t)
(_ #f)))
;; A kind that chooses one of its items or options.
(: (-> Kind bool))
(defun (selecting? kind)
(match kind
(DropdownKind #t)
(ListBoxKind #t)
(TabsKind #t)
(_ #f)))
(: (-> Kind bool))
(defun (text-box? kind)
(match kind
@ -247,6 +308,7 @@
(TextKind (Some (cast AvaloniaProperty text-block-text)))
(ButtonKind (Some (cast AvaloniaProperty content-property)))
(CheckBoxKind (Some (cast AvaloniaProperty content-property)))
(TabKind (Some (cast AvaloniaProperty header-property)))
(_ None)))
((Value _) (when-kind (text-box? kind) (cast AvaloniaProperty text-box-text)))
((Placeholder _) (when-kind (text-box? kind) (cast AvaloniaProperty watermark-property)))
@ -259,7 +321,10 @@
((Width _) (Some (cast AvaloniaProperty width-property)))
((Height _) (Some (cast AvaloniaProperty height-property)))
((Margin _) (Some (cast AvaloniaProperty margin-property)))
((Padding _) (when-kind (templated? kind) (cast AvaloniaProperty padding-property)))
((Padding _)
(cond ((= kind BorderKind) (Some (cast AvaloniaProperty decorator-padding)))
((templated? kind) (Some (cast AvaloniaProperty padding-property)))
(else None)))
((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)))
@ -267,11 +332,24 @@
((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)))
((Selected _) (when-kind (selecting? kind) (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)))
((Background _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-background)))
((= kind BorderKind) (Some (cast AvaloniaProperty border-background)))
((panel? kind) (Some (cast AvaloniaProperty panel-background)))
((templated? kind) (Some (cast AvaloniaProperty background-property)))
(else None)))
((Foreground _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-foreground)))
((templated? kind) (Some (cast AvaloniaProperty foreground-property)))
(else None)))
((BorderColour _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-brush-property)))
((BorderWidth _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-thickness-property)))
((Radius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property)))
;; Set by `set-prop!` itself.
((Source _) None)
((Columns _) None)
@ -284,9 +362,26 @@
(: (-> string ClrString))
(defun (->clr-string s) (clr-string s))
;; The value of a prop, as the object `SetValue` takes.
(: (-> Prop Object))
;; A colour, as Avalonia reads one. None for one it cannot read.
(: (-> string (Option Object)))
(defun (brush s)
(match (try (parse-brush s) #:catch (System.Exception))
((Ok b) (Some (cast Object b)))
((Err _) None)))
;; The value of a prop, as the object `SetValue` takes. None for a value that
;; cannot be one, such as a colour that cannot be read: the property is then
;; cleared, and the theme's value shows.
(: (-> Prop (Option Object)))
(defun (boxed p)
(match p
((Background s) (brush s))
((Foreground s) (brush s))
((BorderColour s) (brush s))
(_ (Some (plain p)))))
(: (-> Prop Object))
(defun (plain p)
(defun (text s) (cast Object (->clr-string s)))
(match p
((Label s) (text s))
@ -314,7 +409,12 @@
((ColumnSpan i) (cast Object i))
((Source s) (text s))
((Columns s) (text s))
((Rows s) (text s))))
((Rows s) (text s))
((Background s) (text s))
((Foreground s) (text s))
((BorderColour s) (text s))
((BorderWidth d) (cast Object (Thickness. d)))
((Radius d) (cast Object (CornerRadius. d)))))
;; Which prop it is, without its value. Two props with one tag set the same
;; property.
@ -326,7 +426,9 @@
((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)))
((Rows _) 20) ((Row _) 21) ((Column _) 22) ((RowSpan _) 23) ((ColumnSpan _) 24)
((Background _) 25) ((Foreground _) 26) ((BorderColour _) 27) ((BorderWidth _) 28)
((Radius _) 29)))
(: (-> Control AvaloniaProperty Object void))
(defun (put! control property value)
@ -353,7 +455,10 @@
(put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d)))
(_
(match (slot kind p)
((Some property) (put! control property (boxed p)))
((Some property)
(match (boxed p)
((Some value) (put! control property value))
(None (clear-value (cast AvaloniaObject control) property))))
(None unit)))))
(: (-> Control Kind Prop void))
@ -603,8 +708,13 @@
(: (-> (App %model %m) (Live %m) Kind void))
(defun (listen! app live kind)
(def control (.control live))
;; Only the control's own events: a routed event bubbles, so a list's
;; handler would hear the selection of a dropdown in one of its items too.
(defun (on-event (: event RoutedEvent) pick)
(on! control event (fun (sender e) (fire! app live (pick)))))
(on! control event
(fun (sender e)
(when (eq? (event-source e) (cast Object control))
(fire! app live (pick))))))
(match kind
(ButtonKind
(on-event (cast RoutedEvent click-event)
@ -624,7 +734,7 @@
(fun ()
(def d (range-value (cast RangeBase control)))
(fun (on) (match on ((Slide f) (Some (f d))) (_ None))))))
(DropdownKind
((or DropdownKind ListBoxKind TabsKind)
(on-event (cast RoutedEvent selection-changed-event)
(fun ()
(def i (selected-index (cast SelectingItemsControl control)))
@ -665,14 +775,45 @@
(put! panel (cast AvaloniaProperty orientation-property) (cast Object Orientation.Horizontal))
panel)
(GridKind (cast Control (Grid.)))
(ScrollKind (cast Control (ScrollViewer.)))))
(ScrollKind (cast Control (ScrollViewer.)))
(ListBoxKind (cast Control (ListBox.)))
(TabsKind (cast Control (TabControl.)))
(TabKind (cast Control (TabItem.)))
(BorderKind (cast Control (Border.)))))
;; Where the controls of a panel's children, or of a list's items, are.
(: (-> Kind Control IList))
(defun (child-list kind parent)
(if (items? kind)
(cast IList (items-of (cast ItemsControl parent)))
(cast IList (panel-children (cast Panel parent)))))
;; Makes `child` the one child of a scroll, a tab or a border.
(: (-> Kind Control Control void))
(defun (set-single! kind parent child)
(if (= kind BorderKind)
(put! parent (cast AvaloniaProperty decorator-child) (cast Object child))
(content! (cast ContentControl parent) (cast Object child))))
;; 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)))
(if (single? kind)
(set-single! kind parent child)
(ignore (list-add! (child-list kind parent) (cast Object child)))))
;; A list or tabs can choose an item only once the items are there, so the
;; choice is set again after the children. A dropdown whose items changed
;; may have dropped its choice, so it is set again too.
(: (-> Control Kind (Vec Prop) void))
(defun (sync-selection! control kind props)
(when (selecting? kind)
(loop (:for p props)
(:do (match p
((Selected i)
(unless (= (selected-index (cast SelectingItemsControl control)) i)
(put! control (cast AvaloniaProperty selected-index-property) (cast Object i))))
(_ unit))))))
;; Makes the controls for a view.
(: (-> (App %model %m) (View %m) (Live %m)))
@ -686,6 +827,7 @@
(:do (def c (mount app child))
(mutablevec-add! (.children live) c)
(adopt! kind control (.control c))))
(sync-selection! control kind (view-props v))
live)
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
@ -699,20 +841,21 @@
(begin
(patch-props! (.control live) kind (view-props old) (view-props next))
(record-set! live (view next))
(cond ((panel? kind) (patch-children! app live (view-children next)))
((= kind ScrollKind) (patch-content! app live (view-children next)))
(cond ((single? kind) (patch-single! app live kind (view-children next)))
((or (panel? kind) (items? kind)) (patch-children! app live kind (view-children next)))
(else unit))
(sync-selection! (.control live) kind (view-props next))
live)))
;; A scroll's one child is its content.
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
(defun (patch-content! app live views)
;; The one child of a scroll, a tab or a border.
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
(defun (patch-single! app live kind 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)))))
(set-single! kind (.control live) (.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.
@ -731,10 +874,10 @@
;; 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)
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
(defun (patch-children! app live kind views)
(def kids (.children live))
(def controls (panel-children (cast Panel (.control live))))
(def controls (child-list kind (.control live)))
(def olds (mutablevec->vec kids))
(def old-ids (identities (vec-map (fun (l) (.view l)) olds)))
(def new-ids (identities views))
@ -761,15 +904,16 @@
(loop (:for (Tuple i was) (enumerate olds))
(:when (not (array-ref kept i)))
(:do (ignore (.Remove controls (.control was)))))
(:do (list-remove! controls (cast Object (.control was)))))
;; A control out of place is taken out and put back where it belongs.
(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)))))
(:do (def c (cast Object (.control now)))
(unless (and (< j (list-count (cast ICollection controls)))
(eq? (list-ref controls j) c))
(def at (list-index-of controls c))
(when (>= at 0) (list-remove-at! controls at))
(list-insert! controls j c))))
(mutablevec-clear! kids)
(loop (:for now (mutablevec->vec nexts)) (:do (mutablevec-add! kids now))))