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))))

69
src/view.bjo
View file

@ -19,9 +19,10 @@
;; Constructors.
text button text-input text-area checkbox slider progress-bar dropdown image
column row grid scroll
list-box tabs tab
column row grid scroll border
;; Wrappers.
keyed at
keyed at paint
;; Reading one.
view-kind view-props view-events view-children view-key)
@ -35,7 +36,8 @@
;; What control a view is.
(type (: Kind (Union TextKind ButtonKind TextInputKind TextAreaKind CheckBoxKind
SliderKind ProgressKind DropdownKind ImageKind
ColumnKind RowKind GridKind ScrollKind)))
ListBoxKind TabsKind TabKind
ColumnKind RowKind GridKind ScrollKind BorderKind)))
;; A property of a control. A kind takes only some of them; the app ignores
;; the others.
@ -56,14 +58,19 @@
(: 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
(: Selected int) ; which item 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))))
(: ColumnSpan int)
(: Background string) ; a colour: "red", "#08f", "#80ff8800"
(: Foreground string) ; the colour of the text
(: BorderColour string)
(: BorderWidth double)
(: Radius double)))) ; how round a border's corners are
;; An event, and the message it sends.
(type (: (On %m) (Union (: Click %m)
@ -109,6 +116,14 @@
(defun (keyed key v)
(record-set v (key (Some key))))
;; The view, in colours. A colour is a name, such as "red", or "#rgb",
;; "#rrggbb" or "#aarrggbb". The empty string, the default, leaves the colour
;; to the theme, and so does a colour that cannot be read.
(: paint (-> (View %m) (#:colour string) (#:background string) (View %m)))
(defun (paint v #:colour "" #:background "")
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c))))
(record-set v (props (with (with (.props v) Foreground colour) Background background))))
;; 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)
@ -219,6 +234,33 @@
(defun (image path #:width 0.0 #:height 0.0 #:margin 0.0)
(leaf ImageKind (with-layout [(Source path)] width height margin 0.0) []))
;; A list of views to choose one of, with the one at `selected` chosen, or
;; none for -1. A choice sends `(on-select index)`. Give the items keys if
;; the list can change order.
(: (-> (Vec (View %m)) int (-> int %m) (#:width double) (#:height double) (#:margin double)
(View %m)))
(defun (list-box items selected on-select #:width 0.0 #:height 0.0 #:margin 0.0)
(View (kind ListBoxKind)
(props (with-layout [(Selected selected)] width height margin 0.0))
(events [(Select on-select)])
(children items)
(key None)))
;; Tabs, with the one at `selected` shown. A click on another tab sends
;; `(on-select index)`. Each tab is made by `tab`.
(: (-> int (-> int %m) (#:margin double) #:rest (View %m) (View %m)))
(defun (tabs selected on-select #:margin 0.0 #:rest tabs)
(View (kind TabsKind)
(props (with-layout [(Selected selected)] 0.0 0.0 margin 0.0))
(events [(Select on-select)])
(children (array->vec tabs))
(key None)))
;; A tab of `tabs`: its header, and what it shows when it is chosen.
(: (-> string (View %m) (View %m)))
(defun (tab header content)
(View (kind TabKind) (props [(Label header)]) (events []) (children [content]) (key None)))
;; 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)))
@ -258,6 +300,23 @@
0.0 0.0 margin 0.0)
(array->vec children)))
;; A view in a frame: a line of `#:colour` and `#:thickness` around it,
;; corners as round as `#:radius`, `#:background` behind it, and `#:padding`
;; between the line and the view.
(: (-> (View %m) (#:colour string) (#:thickness double) (#:radius double)
(#:background string) (#:padding double) (#:margin double)
(View %m)))
(defun (border child #:colour "" #:thickness 1.0 #:radius 0.0 #:background ""
#:padding 0.0 #:margin 0.0)
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c))))
(container BorderKind
(with (with (with-size (with-size (with-layout [] 0.0 0.0 margin padding)
BorderWidth thickness)
Radius radius)
BorderColour colour)
Background background)
[child]))
;; 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)