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

Switches, radios, numbers, dates, completion, expanders, tooltips, flows, docks

Browse source 
A number input's numbers are decimals in Avalonia, so they are converted
where they are set. A date is "yyyy-MM-dd" both ways. An expander and a
completion box raise their own events from the parts of their templates, so
they listen to the property instead.

The cases of Prop and On are now PropLabel, OnClick and so on. They are
exported with their types, and as Label, Value, Selected and Click they
took names that a program's own messages want.

The panel is flow and not wrap, which is CML'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 18:05:12 +01:00
parent cfcb1851b7
commit 56a01efe76
3 changed files with 532 additions and 170 deletions
Download patch file Download diff file Expand all files Collapse all files

322
src/app.bjo
View file

@ -89,6 +89,17 @@
(KeyModifiers (: Avalonia.Input.KeyModifiers)) (KeyModifiers (: Avalonia.Input.KeyModifiers))
(KeyEventArgs (: Avalonia.Input.KeyEventArgs)) (KeyEventArgs (: Avalonia.Input.KeyEventArgs))
(ClosingArgs (: Avalonia.Controls.WindowClosingEventArgs)) (ClosingArgs (: Avalonia.Controls.WindowClosingEventArgs))
(ToggleSwitch (: Avalonia.Controls.ToggleSwitch (-> ToggleSwitch)))
(RadioButton (: Avalonia.Controls.RadioButton (-> RadioButton)))
(NumericUpDown (: Avalonia.Controls.NumericUpDown (-> NumericUpDown)))
(DatePicker (: Avalonia.Controls.DatePicker (-> DatePicker)))
(DateTimeOffset (: System.DateTimeOffset))
(AutoCompleteBox (: Avalonia.Controls.AutoCompleteBox (-> AutoCompleteBox)))
(Expander (: Avalonia.Controls.Expander (-> Expander)))
(WrapPanel (: Avalonia.Controls.WrapPanel (-> WrapPanel)))
(DockPanel (: Avalonia.Controls.DockPanel (-> DockPanel)))
(DockEdge (: Avalonia.Controls.Dock))
(PropertyChange (: Avalonia.AvaloniaPropertyChangedEventArgs))
(CancelArgs (: System.ComponentModel.CancelEventArgs)) (CancelArgs (: System.ComponentModel.CancelEventArgs))
(ICollection (: System.Collections.ICollection)) (ICollection (: System.Collections.ICollection))
(Timer (: Avalonia.Threading.DispatcherTimer (-> Timer))) (Timer (: Avalonia.Threading.DispatcherTimer (-> Timer)))
@ -183,6 +194,26 @@
(modifiers-of (: Avalonia.Input.KeyEventArgs.KeyModifiers (-> KeyEventArgs KeyModifiers) #:get)) (modifiers-of (: Avalonia.Input.KeyEventArgs.KeyModifiers (-> KeyEventArgs KeyModifiers) #:get))
(handled! (: Avalonia.Interactivity.RoutedEventArgs.Handled (-> RoutedEventArgs bool void) #:set)) (handled! (: Avalonia.Interactivity.RoutedEventArgs.Handled (-> RoutedEventArgs bool void) #:set))
(programmatic? (: Avalonia.Controls.WindowClosingEventArgs.IsProgrammatic (-> ClosingArgs bool) #:get)) (programmatic? (: Avalonia.Controls.WindowClosingEventArgs.IsProgrammatic (-> ClosingArgs bool) #:get))
(tip-property (: Avalonia.Controls.ToolTip.TipProperty #:get))
(dock-property (: Avalonia.Controls.DockPanel.DockProperty #:get))
(expanded-property (: Avalonia.Controls.Expander.IsExpandedProperty #:get))
(number-value-property (: Avalonia.Controls.NumericUpDown.ValueProperty #:get))
(number-minimum-property (: Avalonia.Controls.NumericUpDown.MinimumProperty #:get))
(number-maximum-property (: Avalonia.Controls.NumericUpDown.MaximumProperty #:get))
(number-increment-property (: Avalonia.Controls.NumericUpDown.IncrementProperty #:get))
(number-value (: Avalonia.Controls.NumericUpDown.Value (-> NumericUpDown (Nullable decimal)) #:get))
(date-property (: Avalonia.Controls.DatePicker.SelectedDateProperty #:get))
(selected-date (: Avalonia.Controls.DatePicker.SelectedDate (-> DatePicker (Nullable DateTimeOffset)) #:get))
(parse-date (: System.DateTimeOffset.Parse (-> string DateTimeOffset)))
(auto-text-property (: Avalonia.Controls.AutoCompleteBox.TextProperty #:get))
(auto-items-property (: Avalonia.Controls.AutoCompleteBox.ItemsSourceProperty #:get))
(auto-watermark-property (: Avalonia.Controls.AutoCompleteBox.WatermarkProperty #:get))
(auto-text (: Avalonia.Controls.AutoCompleteBox.Text (-> AutoCompleteBox string) #:get))
(expanded? (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
(changed-property (: Avalonia.AvaloniaPropertyChangedEventArgs.Property
(-> PropertyChange AvaloniaProperty) #:get))
(wrap-item-spacing (: Avalonia.Controls.WrapPanel.ItemSpacingProperty #:get))
(wrap-line-spacing (: Avalonia.Controls.WrapPanel.LineSpacingProperty #:get))
(cancel-close! (: System.ComponentModel.CancelEventArgs.Cancel (-> CancelArgs bool void) #:set)) (cancel-close! (: System.ComponentModel.CancelEventArgs.Cancel (-> CancelArgs bool void) #:set))
;; A grid's sizes are not Avalonia properties, so they are set as .NET ;; A grid's sizes are not Avalonia properties, so they are set as .NET
@ -199,6 +230,7 @@
;; Events. ;; Events.
(click-event (: Avalonia.Controls.Button.ClickEvent #:get)) (click-event (: Avalonia.Controls.Button.ClickEvent #:get))
(menu-click-event (: Avalonia.Controls.MenuItem.ClickEvent #:get)) (menu-click-event (: Avalonia.Controls.MenuItem.ClickEvent #:get))
(number-changed-event (: Avalonia.Controls.NumericUpDown.ValueChangedEvent #:get))
(key-down-event (: Avalonia.Input.InputElement.KeyDownEvent #:get)) (key-down-event (: Avalonia.Input.InputElement.KeyDownEvent #:get))
;; TextChanging and not TextChanged: TextChanged is posted to the ;; TextChanging and not TextChanged: TextChanged is posted to the
;; dispatcher and comes later, after the patch that set the text is over. ;; dispatcher and comes later, after the patch that set the text is over.
@ -274,6 +306,8 @@
(ColumnKind #t) (ColumnKind #t)
(RowKind #t) (RowKind #t)
(GridKind #t) (GridKind #t)
(WrapKind #t)
(DockKind #t)
(_ #f))) (_ #f)))
(: (-> Kind bool)) (: (-> Kind bool))
@ -295,8 +329,19 @@
(GridKind #f) (GridKind #f)
(BorderKind #f) (BorderKind #f)
(ContextKind #f) (ContextKind #f)
(WrapKind #f)
(DockKind #f)
(_ #t))) (_ #t)))
;; A kind that is on or off, as a checkbox.
(: (-> Kind bool))
(defun (toggle? kind)
(match kind
(CheckBoxKind #t)
(ToggleSwitchKind #t)
(RadioKind #t)
(_ #f)))
;; A kind whose children are the items of an Avalonia ItemsControl. ;; A kind whose children are the items of an Avalonia ItemsControl.
(: (-> Kind bool)) (: (-> Kind bool))
(defun (items? kind) (defun (items? kind)
@ -317,6 +362,7 @@
(TabKind #t) (TabKind #t)
(BorderKind #t) (BorderKind #t)
(ContextKind #t) (ContextKind #t)
(ExpanderKind #t)
(_ #f))) (_ #f)))
;; A kind that chooses one of its items or options. ;; A kind that chooses one of its items or options.
@ -349,59 +395,75 @@
(defun (slot kind p) (defun (slot kind p)
(defun (when-kind ok? prop) (if ok? (Some prop) None)) (defun (when-kind ok? prop) (if ok? (Some prop) None))
(match p (match p
((Label _) ((PropLabel _)
(match kind (match kind
(TextKind (Some (cast AvaloniaProperty text-block-text))) (TextKind (Some (cast AvaloniaProperty text-block-text)))
(ButtonKind (Some (cast AvaloniaProperty content-property))) (ButtonKind (Some (cast AvaloniaProperty content-property)))
(CheckBoxKind (Some (cast AvaloniaProperty content-property))) (CheckBoxKind (Some (cast AvaloniaProperty content-property)))
(ToggleSwitchKind (Some (cast AvaloniaProperty content-property)))
(RadioKind (Some (cast AvaloniaProperty content-property)))
(ExpanderKind (Some (cast AvaloniaProperty header-property)))
(TabKind (Some (cast AvaloniaProperty header-property))) (TabKind (Some (cast AvaloniaProperty header-property)))
(MenuItemKind (Some (cast AvaloniaProperty menu-header-property))) (MenuItemKind (Some (cast AvaloniaProperty menu-header-property)))
(_ None))) (_ None)))
((Value _) (when-kind (text-box? kind) (cast AvaloniaProperty text-box-text))) ((PropValue _)
((Placeholder _) (when-kind (text-box? kind) (cast AvaloniaProperty watermark-property))) (cond ((text-box? kind) (Some (cast AvaloniaProperty text-box-text)))
((Checked _) (when-kind (= kind CheckBoxKind) (cast AvaloniaProperty is-checked-property))) ((= kind AutoCompleteKind) (Some (cast AvaloniaProperty auto-text-property)))
((Enabled _) (Some (cast AvaloniaProperty is-enabled-property))) (else None)))
((FontSize _) ((PropPlaceholder _)
(cond ((text-box? kind) (Some (cast AvaloniaProperty watermark-property)))
((= kind AutoCompleteKind) (Some (cast AvaloniaProperty auto-watermark-property)))
(else None)))
((PropChecked _) (when-kind (toggle? kind) (cast AvaloniaProperty is-checked-property)))
((PropEnabled _) (Some (cast AvaloniaProperty is-enabled-property)))
((PropFontSize _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size))) (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size)))
((templated? kind) (Some (cast AvaloniaProperty font-size-property))) ((templated? kind) (Some (cast AvaloniaProperty font-size-property)))
(else None))) (else None)))
((Width _) (Some (cast AvaloniaProperty width-property))) ((PropWidth _) (Some (cast AvaloniaProperty width-property)))
((Height _) (Some (cast AvaloniaProperty height-property))) ((PropHeight _) (Some (cast AvaloniaProperty height-property)))
((Margin _) (Some (cast AvaloniaProperty margin-property))) ((PropMargin _) (Some (cast AvaloniaProperty margin-property)))
((Padding _) ((PropPadding _)
(cond ((= kind BorderKind) (Some (cast AvaloniaProperty decorator-padding))) (cond ((= kind BorderKind) (Some (cast AvaloniaProperty decorator-padding)))
((templated? kind) (Some (cast AvaloniaProperty padding-property))) ((templated? kind) (Some (cast AvaloniaProperty padding-property)))
(else None))) (else None)))
((Spacing _) (when-kind (stack? kind) (cast AvaloniaProperty spacing-property))) ((PropSpacing _) (when-kind (stack? kind) (cast AvaloniaProperty spacing-property)))
((Wrap _) (when-kind (= kind TextKind) (cast AvaloniaProperty text-block-wrapping))) ((PropWrap _) (when-kind (= kind TextKind) (cast AvaloniaProperty text-block-wrapping)))
((Minimum _) (when-kind (range? kind) (cast AvaloniaProperty minimum-property))) ((PropMinimum _) (when-kind (range? kind) (cast AvaloniaProperty minimum-property)))
((Maximum _) (when-kind (range? kind) (cast AvaloniaProperty maximum-property))) ((PropMaximum _) (when-kind (range? kind) (cast AvaloniaProperty maximum-property)))
((Amount _) (when-kind (range? kind) (cast AvaloniaProperty value-property))) ((PropAmount _) (when-kind (range? kind) (cast AvaloniaProperty value-property)))
((Step _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property))) ((PropStep _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property)))
((Items _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty items-source-property))) ((PropItems _)
((Selected _) (when-kind (selecting? kind) (cast AvaloniaProperty selected-index-property))) (cond ((= kind DropdownKind) (Some (cast AvaloniaProperty items-source-property)))
((Row _) (Some (cast AvaloniaProperty grid-row-property))) ((= kind AutoCompleteKind) (Some (cast AvaloniaProperty auto-items-property)))
((Column _) (Some (cast AvaloniaProperty grid-column-property))) (else None)))
((RowSpan _) (Some (cast AvaloniaProperty grid-row-span-property))) ((PropSelected _) (when-kind (selecting? kind) (cast AvaloniaProperty selected-index-property)))
((ColumnSpan _) (Some (cast AvaloniaProperty grid-column-span-property))) ((PropRow _) (Some (cast AvaloniaProperty grid-row-property)))
((Background _) ((PropColumn _) (Some (cast AvaloniaProperty grid-column-property)))
((PropRowSpan _) (Some (cast AvaloniaProperty grid-row-span-property)))
((PropColumnSpan _) (Some (cast AvaloniaProperty grid-column-span-property)))
((PropBackground _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-background))) (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-background)))
((= kind BorderKind) (Some (cast AvaloniaProperty border-background))) ((= kind BorderKind) (Some (cast AvaloniaProperty border-background)))
((panel? kind) (Some (cast AvaloniaProperty panel-background))) ((panel? kind) (Some (cast AvaloniaProperty panel-background)))
((templated? kind) (Some (cast AvaloniaProperty background-property))) ((templated? kind) (Some (cast AvaloniaProperty background-property)))
(else None))) (else None)))
((Foreground _) ((PropForeground _)
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-foreground))) (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-foreground)))
((templated? kind) (Some (cast AvaloniaProperty foreground-property))) ((templated? kind) (Some (cast AvaloniaProperty foreground-property)))
(else None))) (else None)))
((BorderColour _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-brush-property))) ((PropBorderColour _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-brush-property)))
((BorderWidth _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-thickness-property))) ((PropBorderWidth _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-thickness-property)))
((Radius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property))) ((PropRadius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property)))
((Shortcut _) (when-kind (= kind MenuItemKind) (cast AvaloniaProperty input-gesture-property))) ((PropShortcut _) (when-kind (= kind MenuItemKind) (cast AvaloniaProperty input-gesture-property)))
((PropTip _) (Some (cast AvaloniaProperty tip-property)))
((PropExpanded _) (when-kind (= kind ExpanderKind) (cast AvaloniaProperty expanded-property)))
((PropDockSide _) (Some (cast AvaloniaProperty dock-property)))
((PropDate _) (when-kind (= kind DateKind) (cast AvaloniaProperty date-property)))
;; Set by `set-prop!` itself. ;; Set by `set-prop!` itself.
((Source _) None) ((PropSource _) None)
((Columns _) None) ((PropColumns _) None)
((Rows _) None))) ((PropRows _) None)))
(: (-> bool TextWrapping)) (: (-> bool TextWrapping))
(defun (wrapping wrap?) (defun (wrapping wrap?)
@ -423,10 +485,17 @@
(: (-> Prop (Option Object))) (: (-> Prop (Option Object)))
(defun (boxed p) (defun (boxed p)
(match p (match p
((Background s) (brush s)) ((PropBackground s) (brush s))
((Foreground s) (brush s)) ((PropForeground s) (brush s))
((BorderColour s) (brush s)) ((PropBorderColour s) (brush s))
((Shortcut s) (match (gesture s) ((Some g) (Some (cast Object g))) (None None))) ((PropShortcut s) (match (gesture s) ((Some g) (Some (cast Object g))) (None None)))
;; No date, or one that cannot be read, is none: the property is cleared.
((PropDate s)
(if (string-empty? s)
None
(match (try (parse-date s) #:catch (System.Exception))
((Ok d) (Some (cast Object d)))
((Err _) None))))
(_ (Some (plain p))))) (_ (Some (plain p)))))
;; Keys, as Avalonia reads them. None for keys it cannot read. ;; Keys, as Avalonia reads them. None for keys it cannot read.
@ -440,52 +509,58 @@
(defun (plain p) (defun (plain p)
(defun (text s) (cast Object (->clr-string s))) (defun (text s) (cast Object (->clr-string s)))
(match p (match p
((Label s) (text s)) ((PropLabel s) (text s))
((Value s) (text s)) ((PropValue s) (text s))
((Placeholder s) (text s)) ((PropPlaceholder s) (text s))
((Checked b) (cast Object b)) ((PropChecked b) (cast Object b))
((Enabled b) (cast Object b)) ((PropEnabled b) (cast Object b))
((FontSize d) (cast Object d)) ((PropFontSize d) (cast Object d))
((Width d) (cast Object d)) ((PropWidth d) (cast Object d))
((Height d) (cast Object d)) ((PropHeight d) (cast Object d))
((Margin d) (cast Object (Thickness. d))) ((PropMargin d) (cast Object (Thickness. d)))
((Padding d) (cast Object (Thickness. d))) ((PropPadding d) (cast Object (Thickness. d)))
((Spacing d) (cast Object d)) ((PropSpacing d) (cast Object d))
((Wrap b) (cast Object (wrapping b))) ((PropWrap b) (cast Object (wrapping b)))
((Minimum d) (cast Object d)) ((PropMinimum d) (cast Object d))
((Maximum d) (cast Object d)) ((PropMaximum d) (cast Object d))
((Amount d) (cast Object d)) ((PropAmount d) (cast Object d))
((Step d) (cast Object d)) ((PropStep d) (cast Object d))
;; A .NET array of .NET strings, which a ComboBox shows as they are. ;; 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)))) ((PropItems xs) (cast Object (: (vec->array (vec-map ->clr-string xs)) (Array ClrString))))
((Selected i) (cast Object i)) ((PropSelected i) (cast Object i))
((Row i) (cast Object i)) ((PropRow i) (cast Object i))
((Column i) (cast Object i)) ((PropColumn i) (cast Object i))
((RowSpan i) (cast Object i)) ((PropRowSpan i) (cast Object i))
((ColumnSpan i) (cast Object i)) ((PropColumnSpan i) (cast Object i))
((Source s) (text s)) ((PropSource s) (text s))
((Columns s) (text s)) ((PropColumns s) (text s))
((Rows s) (text s)) ((PropRows s) (text s))
((Background s) (text s)) ((PropBackground s) (text s))
((Foreground s) (text s)) ((PropForeground s) (text s))
((BorderColour s) (text s)) ((PropBorderColour s) (text s))
((BorderWidth d) (cast Object (Thickness. d))) ((PropBorderWidth d) (cast Object (Thickness. d)))
((Radius d) (cast Object (CornerRadius. d))) ((PropRadius d) (cast Object (CornerRadius. d)))
((Shortcut s) (text s)))) ((PropShortcut s) (text s))
((PropTip s) (text s))
((PropExpanded b) (cast Object b))
((PropDate s) (text s))
((PropDockSide i)
(cast Object (match i (0 DockEdge.Left) (1 DockEdge.Top) (2 DockEdge.Right) (_ DockEdge.Bottom))))))
;; Which prop it is, without its value. Two props with one tag set the same ;; Which prop it is, without its value. Two props with one tag set the same
;; property. ;; property.
(: (-> Prop int)) (: (-> Prop int))
(defun (tag p) (defun (tag p)
(match p (match p
((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3) ((PropLabel _) 0) ((PropValue _) 1) ((PropPlaceholder _) 2) ((PropChecked _) 3)
((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7) ((PropEnabled _) 4) ((PropFontSize _) 5) ((PropWidth _) 6) ((PropHeight _) 7)
((Margin _) 8) ((Padding _) 9) ((Spacing _) 10) ((Wrap _) 11) ((PropMargin _) 8) ((PropPadding _) 9) ((PropSpacing _) 10) ((PropWrap _) 11)
((Minimum _) 12) ((Maximum _) 13) ((Amount _) 14) ((Step _) 15) ((PropMinimum _) 12) ((PropMaximum _) 13) ((PropAmount _) 14) ((PropStep _) 15)
((Items _) 16) ((Selected _) 17) ((Source _) 18) ((Columns _) 19) ((PropItems _) 16) ((PropSelected _) 17) ((PropSource _) 18) ((PropColumns _) 19)
((Rows _) 20) ((Row _) 21) ((Column _) 22) ((RowSpan _) 23) ((ColumnSpan _) 24) ((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24)
((Background _) 25) ((Foreground _) 26) ((BorderColour _) 27) ((BorderWidth _) 28) ((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28)
((Radius _) 29) ((Shortcut _) 30))) ((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33)
((PropDockSide _) 34)))
(: (-> Control AvaloniaProperty Object void)) (: (-> Control AvaloniaProperty Object void))
(defun (put! control property value) (defun (put! control property value)
@ -501,15 +576,27 @@
(: (-> Control Kind Prop void)) (: (-> Control Kind Prop void))
(defun (set-prop! control kind p) (defun (set-prop! control kind p)
(match (Tuple kind p) (match (Tuple kind p)
((Tuple ImageKind (Source path)) ((Tuple ImageKind (PropSource path))
(match (load-bitmap path) (match (load-bitmap path)
((Some b) (put! control (cast AvaloniaProperty image-source-property) (cast Object b))) ((Some b) (put! control (cast AvaloniaProperty image-source-property) (cast Object b)))
(None (clear-value (cast AvaloniaObject control) (cast AvaloniaProperty image-source-property))))) (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 (PropColumns s)) (grid-columns! (cast Grid control) (parse-columns s)))
((Tuple GridKind (Rows s)) (grid-rows! (cast Grid control) (parse-rows s))) ((Tuple GridKind (PropRows s)) (grid-rows! (cast Grid control) (parse-rows s)))
((Tuple GridKind (Spacing d)) ((Tuple GridKind (PropSpacing d))
(put! control (cast AvaloniaProperty grid-row-spacing-property) (cast Object d)) (put! control (cast AvaloniaProperty grid-row-spacing-property) (cast Object d))
(put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d))) (put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d)))
((Tuple WrapKind (PropSpacing d))
(put! control (cast AvaloniaProperty wrap-item-spacing) (cast Object d))
(put! control (cast AvaloniaProperty wrap-line-spacing) (cast Object d)))
;; A number input's numbers are decimals.
((Tuple NumberKind (PropMinimum d))
(put! control (cast AvaloniaProperty number-minimum-property) (cast Object (cast System.Decimal d))))
((Tuple NumberKind (PropMaximum d))
(put! control (cast AvaloniaProperty number-maximum-property) (cast Object (cast System.Decimal d))))
((Tuple NumberKind (PropStep d))
(put! control (cast AvaloniaProperty number-increment-property) (cast Object (cast System.Decimal d))))
((Tuple NumberKind (PropAmount d))
(put! control (cast AvaloniaProperty number-value-property) (cast Object (cast System.Decimal d))))
(_ (_
(match (slot kind p) (match (slot kind p)
((Some property) ((Some property)
@ -522,12 +609,15 @@
(defun (clear-prop! control kind p) (defun (clear-prop! control kind p)
(defun (clear property) (clear-value (cast AvaloniaObject control) property)) (defun (clear property) (clear-value (cast AvaloniaObject control) property))
(match (Tuple kind p) (match (Tuple kind p)
((Tuple ImageKind (Source _)) (clear (cast AvaloniaProperty image-source-property))) ((Tuple ImageKind (PropSource _)) (clear (cast AvaloniaProperty image-source-property)))
((Tuple GridKind (Columns _)) (grid-columns! (cast Grid control) (parse-columns "*"))) ((Tuple GridKind (PropColumns _)) (grid-columns! (cast Grid control) (parse-columns "*")))
((Tuple GridKind (Rows _)) (grid-rows! (cast Grid control) (parse-rows "*"))) ((Tuple GridKind (PropRows _)) (grid-rows! (cast Grid control) (parse-rows "*")))
((Tuple GridKind (Spacing _)) ((Tuple GridKind (PropSpacing _))
(clear (cast AvaloniaProperty grid-row-spacing-property)) (clear (cast AvaloniaProperty grid-row-spacing-property))
(clear (cast AvaloniaProperty grid-column-spacing-property))) (clear (cast AvaloniaProperty grid-column-spacing-property)))
((Tuple WrapKind (PropSpacing _))
(clear (cast AvaloniaProperty wrap-item-spacing))
(clear (cast AvaloniaProperty wrap-line-spacing)))
(_ (_
(match (slot kind p) (match (slot kind p)
((Some property) (clear property)) ((Some property) (clear property))
@ -678,10 +768,10 @@
(defun (in-view v) (defun (in-view v)
(def props (view-props v)) (def props (view-props v))
(if (and (= (view-kind v) MenuItemKind) (if (and (= (view-kind v) MenuItemKind)
(not (vec-contains props (Enabled #f))) (not (vec-contains props (PropEnabled #f)))
(any? (fun (p) (match p ((Shortcut s) (same? s)) (_ #f))) props)) (any? (fun (p) (match p ((PropShortcut s) (same? s)) (_ #f))) props))
(loop (:for on (view-events v)) (loop (:for on (view-events v))
(:when-let (Click msg) on) (:when-let (OnClick msg) on)
(:finish #t (Some msg)) (:finish #t (Some msg))
=> None) => None)
(loop (:for c (view-children v)) (loop (:for c (view-children v))
@ -812,33 +902,69 @@
(fun (sender e) (fun (sender e)
(when (eq? (event-source e) (cast Object control)) (when (eq? (event-source e) (cast Object control))
(fire! app live (pick)))))) (fire! app live (pick))))))
(defun (on-change (: property AvaloniaProperty) pick)
(ignore (add-event-handler! control "PropertyChanged"
(: (fun (sender e)
(when (eq? (changed-property (cast PropertyChange e)) property)
(fire! app live (pick))))
(-> Object Object void)))))
(match kind (match kind
(MenuItemKind (MenuItemKind
(on-event (cast RoutedEvent menu-click-event) (on-event (cast RoutedEvent menu-click-event)
(fun () (fun (on) (match on ((Click msg) (Some msg)) (_ None)))))) (fun () (fun (on) (match on ((OnClick msg) (Some msg)) (_ None))))))
(ButtonKind (ButtonKind
(on-event (cast RoutedEvent click-event) (on-event (cast RoutedEvent click-event)
(fun () (fun (on) (match on ((Click msg) (Some msg)) (_ None)))))) (fun () (fun (on) (match on ((OnClick msg) (Some msg)) (_ None))))))
((or TextInputKind TextAreaKind) ((or TextInputKind TextAreaKind)
(on-event (cast RoutedEvent text-changing-event) (on-event (cast RoutedEvent text-changing-event)
(fun () (fun ()
(def s (text-box-value (cast TextBox control))) (def s (text-box-value (cast TextBox control)))
(fun (on) (match on ((Input f) (Some (f s))) (_ None)))))) (fun (on) (match on ((OnInput f) (Some (f s))) (_ None))))))
(CheckBoxKind (RadioKind
(on-event (cast RoutedEvent checked-event) (on-event (cast RoutedEvent checked-event)
(fun () (fun ()
(def b (.GetValueOrDefault (is-checked (cast ToggleButton control)))) (def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
(fun (on) (match on ((Toggle f) (Some (f b))) (_ None)))))) (fun (on) (match on ((OnClick msg) (if b (Some msg) None)) (_ None))))))
(NumberKind
(on-event (cast RoutedEvent number-changed-event)
(fun ()
(def d (cast System.Double (.GetValueOrDefault (number-value (cast NumericUpDown control)))))
(fun (on) (match on ((OnSlide f) (Some (f d))) (_ None))))))
;; An expander's and a completion box's own events come from the parts of
;; their templates, so they listen to the property itself.
(ExpanderKind
(on-change (cast AvaloniaProperty expanded-property)
(fun ()
(def b (expanded? (cast Expander control)))
(fun (on) (match on ((OnToggle f) (Some (f b))) (_ None))))))
(AutoCompleteKind
(on-change (cast AvaloniaProperty auto-text-property)
(fun ()
(def s (auto-text (cast AutoCompleteBox control)))
(fun (on) (match on ((OnInput f) (Some (f s))) (_ None))))))
(DateKind
;; A .NET event and not a routed one.
(ignore (add-event-handler! control "SelectedDateChanged"
(: (fun (sender e)
(def d (selected-date (cast DatePicker control)))
(def s (if (.-HasValue d) (.ToString (.-Value d) "yyyy-MM-dd") ""))
(fire! app live (fun (on) (match on ((OnInput f) (Some (f s))) (_ None)))))
(-> Object Object void)))))
((or CheckBoxKind ToggleSwitchKind)
(on-event (cast RoutedEvent checked-event)
(fun ()
(def b (.GetValueOrDefault (is-checked (cast ToggleButton control))))
(fun (on) (match on ((OnToggle f) (Some (f b))) (_ None))))))
(SliderKind (SliderKind
(on-event (cast RoutedEvent value-changed-event) (on-event (cast RoutedEvent value-changed-event)
(fun () (fun ()
(def d (range-value (cast RangeBase control))) (def d (range-value (cast RangeBase control)))
(fun (on) (match on ((Slide f) (Some (f d))) (_ None)))))) (fun (on) (match on ((OnSlide f) (Some (f d))) (_ None))))))
((or DropdownKind ListBoxKind TabsKind) ((or DropdownKind ListBoxKind TabsKind)
(on-event (cast RoutedEvent selection-changed-event) (on-event (cast RoutedEvent selection-changed-event)
(fun () (fun ()
(def i (selected-index (cast SelectingItemsControl control))) (def i (selected-index (cast SelectingItemsControl control)))
(fun (on) (match on ((Select f) (Some (f i))) (_ None)))))) (fun (on) (match on ((OnSelect f) (Some (f i))) (_ None))))))
(_ unit))) (_ unit)))
(: (-> Kind Control)) (: (-> Kind Control))
@ -884,7 +1010,15 @@
(MenuItemKind (cast Control (MenuItem.))) (MenuItemKind (cast Control (MenuItem.)))
(SeparatorKind (cast Control (Separator.))) (SeparatorKind (cast Control (Separator.)))
(ContextKind (cast Control (Border.))) (ContextKind (cast Control (Border.)))
(ContextMenuKind (cast Control (ContextMenu.))))) (ContextMenuKind (cast Control (ContextMenu.)))
(ToggleSwitchKind (cast Control (ToggleSwitch.)))
(RadioKind (cast Control (RadioButton.)))
(NumberKind (cast Control (NumericUpDown.)))
(DateKind (cast Control (DatePicker.)))
(AutoCompleteKind (cast Control (AutoCompleteBox.)))
(ExpanderKind (cast Control (Expander.)))
(WrapKind (cast Control (WrapPanel.)))
(DockKind (cast Control (DockPanel.)))))
;; Where the controls of a panel's children, or of a list's items, are. ;; Where the controls of a panel's children, or of a list's items, are.
(: (-> Kind Control IList)) (: (-> Kind Control IList))
@ -918,7 +1052,7 @@
(when (selecting? kind) (when (selecting? kind)
(loop (:for p props) (loop (:for p props)
(:do (match p (:do (match p
((Selected i) ((PropSelected i)
(unless (= (selected-index (cast SelectingItemsControl control)) i) (unless (= (selected-index (cast SelectingItemsControl control)) i)
(put! control (cast AvaloniaProperty selected-index-property) (cast Object i)))) (put! control (cast AvaloniaProperty selected-index-property) (cast Object i))))
(_ unit)))))) (_ unit))))))

250
src/view.bjo
View file

@ -21,9 +21,10 @@
text button text-input text-area checkbox slider progress-bar dropdown image text button text-input text-area checkbox slider progress-bar dropdown image
list-box tabs tab list-box tabs tab
menu-bar submenu menu-item menu-separator menu-bar submenu menu-item menu-separator
column row grid scroll border toggle-switch radio number-input date-picker auto-complete expander
column row grid scroll border flow dock
;; Wrappers. ;; Wrappers.
keyed at paint with-context-menu keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right
;; Keyboard shortcuts. ;; Keyboard shortcuts.
Key key key-gesture key-message Key key key-gesture key-message
@ -42,48 +43,54 @@
SliderKind ProgressKind DropdownKind ImageKind SliderKind ProgressKind DropdownKind ImageKind
ListBoxKind TabsKind TabKind ListBoxKind TabsKind TabKind
MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind
ToggleSwitchKind RadioKind NumberKind DateKind AutoCompleteKind
ExpanderKind WrapKind DockKind
ColumnKind RowKind GridKind ScrollKind BorderKind))) ColumnKind RowKind GridKind ScrollKind BorderKind)))
;; A property of a control. A kind takes only some of them; the app ignores ;; A property of a control. A kind takes only some of them; the app ignores
;; the others. ;; the others.
(type (: Prop (Union (: Label string) ; the text of a text, a button or a checkbox (type (: Prop (Union (: PropLabel string) ; the text of a text, a button or a checkbox
(: Value string) ; the text in a text input (: PropValue string) ; the text in a text input
(: Placeholder string) ; shown in an empty text input (: PropPlaceholder string) ; shown in an empty text input
(: Checked bool) (: PropChecked bool)
(: Enabled bool) (: PropEnabled bool)
(: FontSize double) (: PropFontSize double)
(: Width double) (: PropWidth double)
(: Height double) (: PropHeight double)
(: Margin double) (: PropMargin double)
(: Padding double) (: PropPadding double)
(: Spacing double) (: PropSpacing double)
(: Wrap bool) ; a text breaks its lines at the width (: PropWrap bool) ; a text breaks its lines at the width
(: Minimum double) ; of a slider or a progress bar (: PropMinimum double) ; of a slider or a progress bar
(: Maximum double) (: PropMaximum double)
(: Amount double) ; where a slider or a progress bar is (: PropAmount double) ; where a slider or a progress bar is
(: Step double) ; what an arrow key moves a slider by (: PropStep double) ; what an arrow key moves a slider by
(: Items (Vec string)) ; what a dropdown offers (: PropItems (Vec string)) ; what a dropdown offers
(: Selected int) ; which item is chosen; -1 for none (: PropSelected int) ; which item is chosen; -1 for none
(: Source string) ; the file an image shows (: PropSource string) ; the file an image shows
(: Columns string) ; a grid's columns, as "Auto,*,2*" (: PropColumns string) ; a grid's columns, as "Auto,*,2*"
(: Rows string) (: PropRows string)
(: Row int) ; where a view is in its grid (: PropRow int) ; where a view is in its grid
(: Column int) (: PropColumn int)
(: RowSpan int) (: PropRowSpan int)
(: ColumnSpan int) (: PropColumnSpan int)
(: Background string) ; a colour: "red", "#08f", "#80ff8800" (: PropBackground string) ; a colour: "red", "#08f", "#80ff8800"
(: Foreground string) ; the colour of the text (: PropForeground string) ; the colour of the text
(: BorderColour string) (: PropBorderColour string)
(: BorderWidth double) (: PropBorderWidth double)
(: Radius double) ; how round a border's corners are (: PropRadius double) ; how round a border's corners are
(: Shortcut string)))) ; a menu item's keys, as "Ctrl+S" (: PropShortcut string) ; a menu item's keys, as "Ctrl+S"
(: PropTip string) ; shown when the pointer rests on a view
(: PropExpanded bool) ; whether an expander shows its content
(: PropDate string) ; a date picker's date, as "2026-10-25"
(: PropDockSide int)))) ; where a view is in its dock: 0 to 3
;; An event, and the message it sends. ;; An event, and the message it sends.
(type (: (On %m) (Union (: Click %m) (type (: (On %m) (Union (: OnClick %m)
(: Input (-> string %m)) (: OnInput (-> string %m))
(: Toggle (-> bool %m)) (: OnToggle (-> bool %m))
(: Slide (-> double %m)) (: OnSlide (-> double %m))
(: Select (-> int %m))))) (: OnSelect (-> int %m)))))
;; One control and what is in it. ;; One control and what is in it.
;; ;;
@ -128,7 +135,7 @@
(: paint (-> (View %m) (#:colour string) (#:background string) (View %m))) (: paint (-> (View %m) (#:colour string) (#:background string) (View %m)))
(defun (paint v #:colour "" #:background "") (defun (paint v #:colour "" #:background "")
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c)))) (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)))) (record-set v (props (with (with (.props v) PropForeground colour) PropBackground background))))
;; The view, with a menu that opens when it is clicked with the right button. ;; The view, with a menu that opens when it is clicked with the right button.
;; The items are made by `menu-item`, `submenu` and `menu-separator`. ;; The items are made by `menu-item`, `submenu` and `menu-separator`.
@ -136,12 +143,35 @@
(defun (with-context-menu v #:rest items) (defun (with-context-menu v #:rest items)
(container ContextKind [] [v (container ContextMenuKind [] (array->vec items))])) (container ContextKind [] [v (container ContextMenuKind [] (array->vec items))]))
;; The view, with `text` shown when the pointer rests on it.
(: tooltip (-> (View %m) string (View %m)))
(defun (tooltip v text)
(record-set v (props (vec-add (.props v) (PropTip text)))))
(: (-> int (View %m) (View %m)))
(defun (docked side v)
(record-set v (props (vec-add (.props v) (PropDockSide side)))))
;; The view, at an edge of its dock. The last child of a dock that is put at
;; no edge fills what is left.
(: at-left (-> (View %m) (View %m)))
(defun (at-left v) (docked 0 v))
(: at-top (-> (View %m) (View %m)))
(defun (at-top v) (docked 1 v))
(: at-right (-> (View %m) (View %m)))
(defun (at-right v) (docked 2 v))
(: at-bottom (-> (View %m) (View %m)))
(defun (at-bottom v) (docked 3 v))
;; The view, in a cell of its grid. Rows and columns count from 0. ;; 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))) (: at (-> int int (View %m) (#:row-span int) (#:column-span int) (View %m)))
(defun (at row column v #:row-span 1 #:column-span 1) (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)) (record-set v (props (vec-add (vec-add (vec-add (vec-add (.props v) (PropRow row)) (PropColumn column))
(RowSpan row-span)) (PropRowSpan row-span))
(ColumnSpan column-span))))) (PropColumnSpan column-span)))))
;; --------------------------------------------------------------------------- ;; ---------------------------------------------------------------------------
;; Constructors ;; Constructors
@ -156,9 +186,9 @@
(: (-> (Vec Prop) double double double double (Vec Prop))) (: (-> (Vec Prop) double double double double (Vec Prop)))
(defun (with-layout props width height margin padding) (defun (with-layout props width height margin padding)
(with-size (with-size (with-size (with-size props Width width) Height height) (with-size (with-size (with-size (with-size props PropWidth width) PropHeight height)
Margin margin) PropMargin margin)
Padding padding)) PropPadding padding))
(: (-> Kind (Vec Prop) (Vec (On %m)) (View %m))) (: (-> Kind (Vec Prop) (Vec (On %m)) (View %m)))
(defun (leaf kind props events) (defun (leaf kind props events)
@ -170,7 +200,7 @@
(View %m))) (View %m)))
(defun (text s #:size 0.0 #:wrap #f #: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 (leaf TextKind
(with-layout (with-size [(Label s) (Wrap wrap)] FontSize size) width height margin 0.0) (with-layout (with-size [(PropLabel s) (PropWrap wrap)] PropFontSize size) width height margin 0.0)
[])) []))
;; A button that sends `msg` when it is clicked. ;; A button that sends `msg` when it is clicked.
@ -179,8 +209,8 @@
(View %m))) (View %m)))
(defun (button label msg #:enabled #t #:width 0.0 #:height 0.0 #:margin 0.0 #:padding 0.0) (defun (button label msg #:enabled #t #:width 0.0 #:height 0.0 #:margin 0.0 #:padding 0.0)
(leaf ButtonKind (leaf ButtonKind
(with-layout [(Label label) (Enabled enabled)] width height margin padding) (with-layout [(PropLabel label) (PropEnabled enabled)] width height margin padding)
[(Click msg)])) [(OnClick msg)]))
;; A one-line text input that holds `value`. Each change sends `(on-input ;; A one-line text input that holds `value`. Each change sends `(on-input
;; text)`, with the whole text. ;; text)`, with the whole text.
@ -189,9 +219,9 @@
(View %m))) (View %m)))
(defun (text-input value on-input #:placeholder "" #:enabled #t #:width 0.0 #:margin 0.0) (defun (text-input value on-input #:placeholder "" #:enabled #t #:width 0.0 #:margin 0.0)
(leaf TextInputKind (leaf TextInputKind
(with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)] (with-layout [(PropValue value) (PropPlaceholder placeholder) (PropEnabled enabled)]
width 0.0 margin 0.0) width 0.0 margin 0.0)
[(Input on-input)])) [(OnInput on-input)]))
;; A text input of several lines, that breaks its lines at its width. Each ;; A text input of several lines, that breaks its lines at its width. Each
;; change sends `(on-input text)`, with the whole text. ;; change sends `(on-input text)`, with the whole text.
@ -201,9 +231,9 @@
(defun (text-area value on-input #:placeholder "" #:enabled #t #:width 0.0 #:height 0.0 (defun (text-area value on-input #:placeholder "" #:enabled #t #:width 0.0 #:height 0.0
#:margin 0.0) #:margin 0.0)
(leaf TextAreaKind (leaf TextAreaKind
(with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)] (with-layout [(PropValue value) (PropPlaceholder placeholder) (PropEnabled enabled)]
width height margin 0.0) width height margin 0.0)
[(Input on-input)])) [(OnInput on-input)]))
;; A slider at `value`, from `minimum` to `maximum`. A move sends `(on-change ;; A slider at `value`, from `minimum` to `maximum`. A move sends `(on-change
;; value)`. ;; value)`.
@ -215,17 +245,17 @@
;; The bounds come before the value, because a value outside the bounds ;; The bounds come before the value, because a value outside the bounds
;; that are there is moved inside them. ;; that are there is moved inside them.
(leaf SliderKind (leaf SliderKind
(with-layout [(Minimum minimum) (Maximum maximum) (Amount value) (Step step) (with-layout [(PropMinimum minimum) (PropMaximum maximum) (PropAmount value) (PropStep step)
(Enabled enabled)] (PropEnabled enabled)]
width 0.0 margin 0.0) width 0.0 margin 0.0)
[(Slide on-change)])) [(OnSlide on-change)]))
;; A bar that is `value` of the way from 0 to `#:maximum`, 1 unless told ;; A bar that is `value` of the way from 0 to `#:maximum`, 1 unless told
;; otherwise. ;; otherwise.
(: (-> double (#:maximum double) (#:width double) (#:margin double) (View %m))) (: (-> double (#:maximum double) (#:width double) (#:margin double) (View %m)))
(defun (progress-bar value #:maximum 1.0 #:width 0.0 #:margin 0.0) (defun (progress-bar value #:maximum 1.0 #:width 0.0 #:margin 0.0)
(leaf ProgressKind (leaf ProgressKind
(with-layout [(Minimum 0.0) (Maximum maximum) (Amount value)] width 0.0 margin 0.0) (with-layout [(PropMinimum 0.0) (PropMaximum maximum) (PropAmount value)] width 0.0 margin 0.0)
[])) []))
;; A list to choose one of `options` from, with the one at `selected` chosen, ;; A list to choose one of `options` from, with the one at `selected` chosen,
@ -236,15 +266,15 @@
;; The items come before the choice, because the choice is an index into ;; The items come before the choice, because the choice is an index into
;; them. ;; them.
(leaf DropdownKind (leaf DropdownKind
(with-layout [(Items options) (Selected selected) (Enabled enabled)] (with-layout [(PropItems options) (PropSelected selected) (PropEnabled enabled)]
width 0.0 margin 0.0) width 0.0 margin 0.0)
[(Select on-select)])) [(OnSelect on-select)]))
;; The picture in the file at `path`. A file that cannot be read shows ;; The picture in the file at `path`. A file that cannot be read shows
;; nothing. ;; nothing.
(: (-> string (#:width double) (#:height double) (#:margin double) (View %m))) (: (-> string (#:width double) (#:height double) (#:margin double) (View %m)))
(defun (image path #:width 0.0 #:height 0.0 #:margin 0.0) (defun (image path #:width 0.0 #:height 0.0 #:margin 0.0)
(leaf ImageKind (with-layout [(Source path)] width height margin 0.0) [])) (leaf ImageKind (with-layout [(PropSource path)] width height margin 0.0) []))
;; A list of views to choose one of, with the one at `selected` chosen, or ;; 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 ;; none for -1. A choice sends `(on-select index)`. Give the items keys if
@ -253,8 +283,8 @@
(View %m))) (View %m)))
(defun (list-box items selected on-select #:width 0.0 #:height 0.0 #:margin 0.0) (defun (list-box items selected on-select #:width 0.0 #:height 0.0 #:margin 0.0)
(View (kind ListBoxKind) (View (kind ListBoxKind)
(props (with-layout [(Selected selected)] width height margin 0.0)) (props (with-layout [(PropSelected selected)] width height margin 0.0))
(events [(Select on-select)]) (events [(OnSelect on-select)])
(children items) (children items)
(key None))) (key None)))
@ -263,15 +293,15 @@
(: (-> int (-> int %m) (#:margin double) #:rest (View %m) (View %m))) (: (-> int (-> int %m) (#:margin double) #:rest (View %m) (View %m)))
(defun (tabs selected on-select #:margin 0.0 #:rest tabs) (defun (tabs selected on-select #:margin 0.0 #:rest tabs)
(View (kind TabsKind) (View (kind TabsKind)
(props (with-layout [(Selected selected)] 0.0 0.0 margin 0.0)) (props (with-layout [(PropSelected selected)] 0.0 0.0 margin 0.0))
(events [(Select on-select)]) (events [(OnSelect on-select)])
(children (array->vec tabs)) (children (array->vec tabs))
(key None))) (key None)))
;; A tab of `tabs`: its header, and what it shows when it is chosen. ;; A tab of `tabs`: its header, and what it shows when it is chosen.
(: (-> string (View %m) (View %m))) (: (-> string (View %m) (View %m)))
(defun (tab header content) (defun (tab header content)
(View (kind TabKind) (props [(Label header)]) (events []) (children [content]) (key None))) (View (kind TabKind) (props [(PropLabel header)]) (events []) (children [content]) (key None)))
;; A bar of menus, made by `submenu`, for the top of the window. ;; A bar of menus, made by `submenu`, for the top of the window.
(: (-> #:rest (View %m) (View %m))) (: (-> #:rest (View %m) (View %m)))
@ -281,7 +311,7 @@
;; A menu of items, in a menu bar or in another menu. ;; A menu of items, in a menu bar or in another menu.
(: (-> string #:rest (View %m) (View %m))) (: (-> string #:rest (View %m) (View %m)))
(defun (submenu label #:rest items) (defun (submenu label #:rest items)
(View (kind MenuItemKind) (props [(Label label)]) (events []) (children (array->vec items)) (View (kind MenuItemKind) (props [(PropLabel label)]) (events []) (children (array->vec items))
(key None))) (key None)))
;; An item that sends `msg` when it is chosen. `#:shortcut`, such as ;; An item that sends `msg` when it is chosen. `#:shortcut`, such as
@ -291,22 +321,78 @@
(defun (menu-item label msg #:shortcut "" #:enabled #t) (defun (menu-item label msg #:shortcut "" #:enabled #t)
(leaf MenuItemKind (leaf MenuItemKind
(if (string-empty? shortcut) (if (string-empty? shortcut)
[(Label label) (Enabled enabled)] [(PropLabel label) (PropEnabled enabled)]
[(Label label) (Enabled enabled) (Shortcut shortcut)]) [(PropLabel label) (PropEnabled enabled) (PropShortcut shortcut)])
[(Click msg)])) [(OnClick msg)]))
;; A line between items of a menu. ;; A line between items of a menu.
(: (-> (View %m))) (: (-> (View %m)))
(defun (menu-separator) (defun (menu-separator)
(leaf SeparatorKind [] [])) (leaf SeparatorKind [] []))
;; A switch that is on when `on?`. A flip sends `(on-toggle on)`.
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
(defun (toggle-switch label on? on-toggle #:enabled #t #:margin 0.0)
(leaf ToggleSwitchKind
(with-layout [(PropLabel label) (PropChecked on?) (PropEnabled enabled)] 0.0 0.0 margin 0.0)
[(OnToggle on-toggle)]))
;; One of a set of choices, chosen when `chosen?`. Choosing it sends `msg`.
;; The model says which is chosen, so give one of a set `#t` and the others
;; `#f`.
(: (-> string bool %m (#:enabled bool) (#:margin double) (View %m)))
(defun (radio label chosen? msg #:enabled #t #:margin 0.0)
(leaf RadioKind
(with-layout [(PropLabel label) (PropChecked chosen?) (PropEnabled enabled)] 0.0 0.0 margin 0.0)
[(OnClick msg)]))
;; A number to type, or to step with arrows by `#:step`. A change sends
;; `(on-change value)`.
(: (-> double (-> double %m) (#:minimum double) (#:maximum double) (#:step double)
(#:enabled bool) (#:width double) (#:margin double)
(View %m)))
(defun (number-input value on-change #:minimum -1e9 #:maximum 1e9 #:step 1.0 #:enabled #t
#:width 0.0 #:margin 0.0)
(leaf NumberKind
(with-layout [(PropMinimum minimum) (PropMaximum maximum) (PropStep step) (PropAmount value)
(PropEnabled enabled)]
width 0.0 margin 0.0)
[(OnSlide on-change)]))
;; A date to pick, as "2026-10-25", or "" for none. A pick sends
;; `(on-change date)`.
(: (-> string (-> string %m) (#:enabled bool) (#:margin double) (View %m)))
(defun (date-picker date on-change #:enabled #t #:margin 0.0)
(leaf DateKind (with-layout [(PropDate date) (PropEnabled enabled)] 0.0 0.0 margin 0.0)
[(OnInput on-change)]))
;; A text input that offers the `options` that match what is typed. Each
;; change sends `(on-input text)`.
(: (-> string (Vec string) (-> string %m) (#:placeholder string) (#:width double)
(#:margin double)
(View %m)))
(defun (auto-complete value options on-input #:placeholder "" #:width 0.0 #:margin 0.0)
(leaf AutoCompleteKind
(with-layout [(PropItems options) (PropValue value) (PropPlaceholder placeholder)] width 0.0 margin 0.0)
[(OnInput on-input)]))
;; A header that shows `child` below it when `expanded?`. A click on the
;; header sends `(on-toggle expanded)`.
(: (-> string bool (-> bool %m) (View %m) (#:margin double) (View %m)))
(defun (expander header expanded? on-toggle child #:margin 0.0)
(View (kind ExpanderKind)
(props (with-layout [(PropLabel header) (PropExpanded expanded?)] 0.0 0.0 margin 0.0))
(events [(OnToggle on-toggle)])
(children [child])
(key None)))
;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with ;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with
;; the new state. ;; the new state.
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m))) (: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
(defun (checkbox label checked? on-toggle #:enabled #t #:margin 0.0) (defun (checkbox label checked? on-toggle #:enabled #t #:margin 0.0)
(leaf CheckBoxKind (leaf CheckBoxKind
(with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0) (with-layout [(PropLabel label) (PropChecked checked?) (PropEnabled enabled)] 0.0 0.0 margin 0.0)
[(Toggle on-toggle)])) [(OnToggle on-toggle)]))
(: (-> Kind (Vec Prop) (Vec (View %m)) (View %m))) (: (-> Kind (Vec Prop) (Vec (View %m)) (View %m)))
(defun (container kind props children) (defun (container kind props children)
@ -314,7 +400,7 @@
(: (-> Kind double double (Array (View %m)) (View %m))) (: (-> Kind double double (Array (View %m)) (View %m)))
(defun (stack kind spacing margin children) (defun (stack kind spacing margin children)
(container kind (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0) (container kind (with-layout (with-size [] PropSpacing spacing) 0.0 0.0 margin 0.0)
(array->vec children))) (array->vec children)))
;; Views one above the other. ;; Views one above the other.
@ -335,7 +421,7 @@
#:rest (View %m) (View %m))) #:rest (View %m) (View %m)))
(defun (grid #:columns "*" #:rows "*" #:spacing 0.0 #:margin 0.0 #:rest children) (defun (grid #:columns "*" #:rows "*" #:spacing 0.0 #:margin 0.0 #:rest children)
(container GridKind (container GridKind
(with-layout (with-size [(Columns columns) (Rows rows)] Spacing spacing) (with-layout (with-size [(PropColumns columns) (PropRows rows)] PropSpacing spacing)
0.0 0.0 margin 0.0) 0.0 0.0 margin 0.0)
(array->vec children))) (array->vec children)))
@ -350,12 +436,24 @@
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c)))) (defun (with props make c) (if (string-empty? c) props (vec-add props (make c))))
(container BorderKind (container BorderKind
(with (with (with-size (with-size (with-layout [] 0.0 0.0 margin padding) (with (with (with-size (with-size (with-layout [] 0.0 0.0 margin padding)
BorderWidth thickness) PropBorderWidth thickness)
Radius radius) PropRadius radius)
BorderColour colour) PropBorderColour colour)
Background background) PropBackground background)
[child])) [child]))
;; Views side by side, on as many lines as they need.
(: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m)))
(defun (flow #:spacing 0.0 #:margin 0.0 #:rest children)
(stack WrapKind spacing margin children))
;; Views at the edges, put there with `at-top`, `at-bottom`, `at-left` and
;; `at-right`, in order from the outside in. The last child, at no edge,
;; fills the middle.
(: (-> (#:margin double) #:rest (View %m) (View %m)))
(defun (dock #:margin 0.0 #:rest children)
(stack DockKind 0.0 margin children))
;; A view that scrolls when it is taller than the space it has. ;; A view that scrolls when it is taller than the space it has.
(: (-> (View %m) (#:width double) (#:height double) (#:margin double) (View %m))) (: (-> (View %m) (#:width double) (#:height double) (#:margin double) (View %m)))
(defun (scroll child #:width 0.0 #:height 0.0 #:margin 0.0) (defun (scroll child #:width 0.0 #:height 0.0 #:margin 0.0)

130
tests/inputs.bjo Normal file
View file

@ -0,0 +1,130 @@
;; 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/inputs.bjo — switches, radios, numbers, dates, completion,
;; expanders, tooltips, flows and docks.
;;
;; bjo run tests/inputs.bjo
;;
;; No window is opened. A control is changed as a user's input would change
;; it, through its Avalonia property, and the message is checked.
(import (std prelude))
(import (std simpletest))
(import (bjogui view))
(import (bjogui app))
(import/class
(Object (: System.Object))
(ClrString (: System.String))
(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))
(ToggleButton (: Avalonia.Controls.Primitives.ToggleButton))
(NumericUpDown (: Avalonia.Controls.NumericUpDown))
(DatePicker (: Avalonia.Controls.DatePicker))
(DateTimeOffset (: System.DateTimeOffset))
(AutoCompleteBox (: Avalonia.Controls.AutoCompleteBox))
(Expander (: Avalonia.Controls.Expander))
(DockEdge (: Avalonia.Controls.Dock))
((Nullable %a) (: System.Nullable)))
(import/extern
(set-value (: Avalonia.AvaloniaObject.SetValue
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
(checked-property (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get))
(number-property (: Avalonia.Controls.NumericUpDown.ValueProperty #:get))
(date-property (: Avalonia.Controls.DatePicker.SelectedDateProperty #:get))
(auto-property (: Avalonia.Controls.AutoCompleteBox.TextProperty #:get))
(expanded-property (: Avalonia.Controls.Expander.IsExpandedProperty #:get))
(is-checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked
(-> ToggleButton (Nullable bool)) #:get))
(number-value (: Avalonia.Controls.NumericUpDown.Value (-> NumericUpDown (Nullable decimal)) #:get))
(selected-date (: Avalonia.Controls.DatePicker.SelectedDate (-> DatePicker (Nullable DateTimeOffset)) #:get))
(parse-date (: System.DateTimeOffset.Parse (-> string DateTimeOffset)))
(expanded? (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
(tip-of (: Avalonia.Controls.ToolTip.GetTip (-> Control Object)))
(dock-of (: Avalonia.Controls.DockPanel.GetDock (-> Control DockEdge)))
(children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
(count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))
(clr-string (: System.Convert.ToString (-> string ClrString))))
(type (: Msg (Union (: Switched bool) (: Picked string) (: Amount double) (: Dated string)
(: Typed string) (: Opened bool))))
(type (: Model (Record (: on bool) (: pick string) (: amount double) (: date string)
(: typed string) (: open bool))))
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
(next (match msg
((Switched b) (record-set m (on b)))
((Picked s) (record-set m (pick s)))
((Amount d) (record-set m (amount d)))
((Dated s) (record-set m (date s)))
((Typed s) (record-set m (typed s)))
((Opened b) (record-set m (open b))))))
(: (-> Model (View Msg)))
(defun (view m)
(column
(toggle-switch "Wi-Fi" (.on m) Switched) ; 0
(row (radio "tea" (= (.pick m) "tea") (Picked "tea")) ; 1 0
(radio "coffee" (= (.pick m) "coffee") (Picked "coffee"))) ; 1 1
(number-input (.amount m) Amount #:minimum 0.0 #:maximum 10.0 #:step 0.5) ; 2
(date-picker (.date m) Dated) ; 3
(auto-complete (.typed m) ["apple" "apricot" "banana"] Typed) ; 4
(expander "More" (.open m) Opened (text "inside")) ; 5
(tooltip (text "hover me") "a tip") ; 6
(flow #:spacing 4.0 (text "a") (text "b") (text "c")) ; 7
(dock (at-top (text "top")) (text "fill")))) ; 8
(defun (main)
(def app (start-app (Model (on #f) (pick "tea") (amount 2.0) (date "2026-10-25")
(typed "") (open #f))
gui-update view (fun (c) unit)))
(defun (ctl path) (app-control-at app path))
(defun (put! path property value)
(ignore (set-value (cast AvaloniaObject (ctl path)) property value Priority.LocalValue)))
(defun (model) (app-model app))
;; --- switch and radios --------------------------------------------------------
(put! '(0) (cast AvaloniaProperty checked-property) (cast Object #t))
(expect "a switch sends its state" (.on (model)) #t)
(expect "a radio shows the model's choice"
(.GetValueOrDefault (is-checked (cast ToggleButton (ctl '(1 0))))) #t)
(put! '(1 1) (cast AvaloniaProperty checked-property) (cast Object #t))
(expect "choosing a radio sends its message" (.pick (model)) "coffee")
(expect "the other one is not chosen any more"
(.GetValueOrDefault (is-checked (cast ToggleButton (ctl '(1 0))))) #f)
;; --- number ---------------------------------------------------------------------
(expect "a number input's value" (cast System.Double (.GetValueOrDefault (number-value (cast NumericUpDown (ctl '(2)))))) 2.0)
(put! '(2) (cast AvaloniaProperty number-property) (cast Object (cast System.Decimal 3.5)))
(expect "a number sends its value" (.amount (model)) 3.5)
;; --- date -----------------------------------------------------------------------
(expect "a date picker's date" (.ToString (.-Value (selected-date (cast DatePicker (ctl '(3))))) "yyyy-MM-dd")
"2026-10-25")
(put! '(3) (cast AvaloniaProperty date-property) (cast Object (parse-date "2026-12-24")))
(expect "a date picked is sent" (.date (model)) "2026-12-24")
;; --- completion -------------------------------------------------------------------
(put! '(4) (cast AvaloniaProperty auto-property) (cast Object (clr-string "ap")))
(expect "completion sends what is typed" (.typed (model)) "ap")
;; --- expander ---------------------------------------------------------------------
(expect "an expander starts closed" (expanded? (cast Expander (ctl '(5)))) #f)
(put! '(5) (cast AvaloniaProperty expanded-property) (cast Object #t))
(expect "opening it sends a message" (.open (model)) #t)
;; --- tooltip, flow, dock ---------------------------------------------------------
(expect "a tooltip" (.ToString (tip-of (ctl '(6)))) "a tip")
(expect "a flow's children" (count (children (cast Panel (ctl '(7))))) 3)
(expect "a docked child" (written (dock-of (ctl '(8 0)))) "Top")
(println "bjogui inputs ok"))