diff --git a/src/app.bjo b/src/app.bjo index ddbde1a..bd36901 100644 --- a/src/app.bjo +++ b/src/app.bjo @@ -89,6 +89,17 @@ (KeyModifiers (: Avalonia.Input.KeyModifiers)) (KeyEventArgs (: Avalonia.Input.KeyEventArgs)) (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)) (ICollection (: System.Collections.ICollection)) (Timer (: Avalonia.Threading.DispatcherTimer (-> Timer))) @@ -183,6 +194,26 @@ (modifiers-of (: Avalonia.Input.KeyEventArgs.KeyModifiers (-> KeyEventArgs KeyModifiers) #:get)) (handled! (: Avalonia.Interactivity.RoutedEventArgs.Handled (-> RoutedEventArgs bool void) #:set)) (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)) ;; A grid's sizes are not Avalonia properties, so they are set as .NET @@ -199,6 +230,7 @@ ;; Events. (click-event (: Avalonia.Controls.Button.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)) ;; TextChanging and not TextChanged: TextChanged is posted to the ;; dispatcher and comes later, after the patch that set the text is over. @@ -274,6 +306,8 @@ (ColumnKind #t) (RowKind #t) (GridKind #t) + (WrapKind #t) + (DockKind #t) (_ #f))) (: (-> Kind bool)) @@ -295,8 +329,19 @@ (GridKind #f) (BorderKind #f) (ContextKind #f) + (WrapKind #f) + (DockKind #f) (_ #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. (: (-> Kind bool)) (defun (items? kind) @@ -317,6 +362,7 @@ (TabKind #t) (BorderKind #t) (ContextKind #t) + (ExpanderKind #t) (_ #f))) ;; A kind that chooses one of its items or options. @@ -349,59 +395,75 @@ (defun (slot kind p) (defun (when-kind ok? prop) (if ok? (Some prop) None)) (match p - ((Label _) + ((PropLabel _) (match kind (TextKind (Some (cast AvaloniaProperty text-block-text))) (ButtonKind (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))) (MenuItemKind (Some (cast AvaloniaProperty menu-header-property))) (_ None))) - ((Value _) (when-kind (text-box? kind) (cast AvaloniaProperty text-box-text))) - ((Placeholder _) (when-kind (text-box? kind) (cast AvaloniaProperty watermark-property))) - ((Checked _) (when-kind (= kind CheckBoxKind) (cast AvaloniaProperty is-checked-property))) - ((Enabled _) (Some (cast AvaloniaProperty is-enabled-property))) - ((FontSize _) + ((PropValue _) + (cond ((text-box? kind) (Some (cast AvaloniaProperty text-box-text))) + ((= kind AutoCompleteKind) (Some (cast AvaloniaProperty auto-text-property))) + (else None))) + ((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))) ((templated? kind) (Some (cast AvaloniaProperty font-size-property))) (else None))) - ((Width _) (Some (cast AvaloniaProperty width-property))) - ((Height _) (Some (cast AvaloniaProperty height-property))) - ((Margin _) (Some (cast AvaloniaProperty margin-property))) - ((Padding _) + ((PropWidth _) (Some (cast AvaloniaProperty width-property))) + ((PropHeight _) (Some (cast AvaloniaProperty height-property))) + ((PropMargin _) (Some (cast AvaloniaProperty margin-property))) + ((PropPadding _) (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))) - ((Maximum _) (when-kind (range? kind) (cast AvaloniaProperty maximum-property))) - ((Amount _) (when-kind (range? kind) (cast AvaloniaProperty value-property))) - ((Step _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property))) - ((Items _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty items-source-property))) - ((Selected _) (when-kind (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 _) + ((PropSpacing _) (when-kind (stack? kind) (cast AvaloniaProperty spacing-property))) + ((PropWrap _) (when-kind (= kind TextKind) (cast AvaloniaProperty text-block-wrapping))) + ((PropMinimum _) (when-kind (range? kind) (cast AvaloniaProperty minimum-property))) + ((PropMaximum _) (when-kind (range? kind) (cast AvaloniaProperty maximum-property))) + ((PropAmount _) (when-kind (range? kind) (cast AvaloniaProperty value-property))) + ((PropStep _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property))) + ((PropItems _) + (cond ((= kind DropdownKind) (Some (cast AvaloniaProperty items-source-property))) + ((= kind AutoCompleteKind) (Some (cast AvaloniaProperty auto-items-property))) + (else None))) + ((PropSelected _) (when-kind (selecting? kind) (cast AvaloniaProperty selected-index-property))) + ((PropRow _) (Some (cast AvaloniaProperty grid-row-property))) + ((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))) ((= kind BorderKind) (Some (cast AvaloniaProperty border-background))) ((panel? kind) (Some (cast AvaloniaProperty panel-background))) ((templated? kind) (Some (cast AvaloniaProperty background-property))) (else None))) - ((Foreground _) + ((PropForeground _) (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))) - ((Shortcut _) (when-kind (= kind MenuItemKind) (cast AvaloniaProperty input-gesture-property))) + ((PropBorderColour _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-brush-property))) + ((PropBorderWidth _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-thickness-property))) + ((PropRadius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-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. - ((Source _) None) - ((Columns _) None) - ((Rows _) None))) + ((PropSource _) None) + ((PropColumns _) None) + ((PropRows _) None))) (: (-> bool TextWrapping)) (defun (wrapping wrap?) @@ -423,10 +485,17 @@ (: (-> Prop (Option Object))) (defun (boxed p) (match p - ((Background s) (brush s)) - ((Foreground s) (brush s)) - ((BorderColour s) (brush s)) - ((Shortcut s) (match (gesture s) ((Some g) (Some (cast Object g))) (None None))) + ((PropBackground s) (brush s)) + ((PropForeground s) (brush s)) + ((PropBorderColour s) (brush s)) + ((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))))) ;; Keys, as Avalonia reads them. None for keys it cannot read. @@ -440,52 +509,58 @@ (defun (plain p) (defun (text s) (cast Object (->clr-string s))) (match p - ((Label s) (text s)) - ((Value s) (text s)) - ((Placeholder s) (text s)) - ((Checked b) (cast Object b)) - ((Enabled b) (cast Object b)) - ((FontSize d) (cast Object d)) - ((Width d) (cast Object d)) - ((Height d) (cast Object d)) - ((Margin d) (cast Object (Thickness. d))) - ((Padding d) (cast Object (Thickness. d))) - ((Spacing d) (cast Object d)) - ((Wrap b) (cast Object (wrapping b))) - ((Minimum d) (cast Object d)) - ((Maximum d) (cast Object d)) - ((Amount d) (cast Object d)) - ((Step d) (cast Object d)) + ((PropLabel s) (text s)) + ((PropValue s) (text s)) + ((PropPlaceholder s) (text s)) + ((PropChecked b) (cast Object b)) + ((PropEnabled b) (cast Object b)) + ((PropFontSize d) (cast Object d)) + ((PropWidth d) (cast Object d)) + ((PropHeight d) (cast Object d)) + ((PropMargin d) (cast Object (Thickness. d))) + ((PropPadding d) (cast Object (Thickness. d))) + ((PropSpacing d) (cast Object d)) + ((PropWrap b) (cast Object (wrapping b))) + ((PropMinimum d) (cast Object d)) + ((PropMaximum d) (cast Object d)) + ((PropAmount d) (cast Object d)) + ((PropStep d) (cast Object d)) ;; A .NET array of .NET strings, which a ComboBox shows as they are. - ((Items xs) (cast Object (: (vec->array (vec-map ->clr-string xs)) (Array ClrString)))) - ((Selected i) (cast Object i)) - ((Row i) (cast Object i)) - ((Column i) (cast Object i)) - ((RowSpan i) (cast Object i)) - ((ColumnSpan i) (cast Object i)) - ((Source s) (text s)) - ((Columns s) (text s)) - ((Rows s) (text s)) - ((Background s) (text s)) - ((Foreground s) (text s)) - ((BorderColour s) (text s)) - ((BorderWidth d) (cast Object (Thickness. d))) - ((Radius d) (cast Object (CornerRadius. d))) - ((Shortcut s) (text s)))) + ((PropItems xs) (cast Object (: (vec->array (vec-map ->clr-string xs)) (Array ClrString)))) + ((PropSelected i) (cast Object i)) + ((PropRow i) (cast Object i)) + ((PropColumn i) (cast Object i)) + ((PropRowSpan i) (cast Object i)) + ((PropColumnSpan i) (cast Object i)) + ((PropSource s) (text s)) + ((PropColumns s) (text s)) + ((PropRows s) (text s)) + ((PropBackground s) (text s)) + ((PropForeground s) (text s)) + ((PropBorderColour s) (text s)) + ((PropBorderWidth d) (cast Object (Thickness. d))) + ((PropRadius d) (cast Object (CornerRadius. d))) + ((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 ;; property. (: (-> Prop int)) (defun (tag p) (match p - ((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3) - ((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7) - ((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) - ((Background _) 25) ((Foreground _) 26) ((BorderColour _) 27) ((BorderWidth _) 28) - ((Radius _) 29) ((Shortcut _) 30))) + ((PropLabel _) 0) ((PropValue _) 1) ((PropPlaceholder _) 2) ((PropChecked _) 3) + ((PropEnabled _) 4) ((PropFontSize _) 5) ((PropWidth _) 6) ((PropHeight _) 7) + ((PropMargin _) 8) ((PropPadding _) 9) ((PropSpacing _) 10) ((PropWrap _) 11) + ((PropMinimum _) 12) ((PropMaximum _) 13) ((PropAmount _) 14) ((PropStep _) 15) + ((PropItems _) 16) ((PropSelected _) 17) ((PropSource _) 18) ((PropColumns _) 19) + ((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24) + ((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28) + ((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33) + ((PropDockSide _) 34))) (: (-> Control AvaloniaProperty Object void)) (defun (put! control property value) @@ -501,15 +576,27 @@ (: (-> Control Kind Prop void)) (defun (set-prop! control kind p) (match (Tuple kind p) - ((Tuple ImageKind (Source path)) + ((Tuple ImageKind (PropSource path)) (match (load-bitmap path) ((Some b) (put! control (cast AvaloniaProperty image-source-property) (cast Object b))) (None (clear-value (cast AvaloniaObject control) (cast AvaloniaProperty image-source-property))))) - ((Tuple GridKind (Columns s)) (grid-columns! (cast Grid control) (parse-columns s))) - ((Tuple GridKind (Rows s)) (grid-rows! (cast Grid control) (parse-rows s))) - ((Tuple GridKind (Spacing d)) + ((Tuple GridKind (PropColumns s)) (grid-columns! (cast Grid control) (parse-columns s))) + ((Tuple GridKind (PropRows s)) (grid-rows! (cast Grid control) (parse-rows s))) + ((Tuple GridKind (PropSpacing d)) (put! control (cast AvaloniaProperty grid-row-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) ((Some property) @@ -522,12 +609,15 @@ (defun (clear-prop! control kind p) (defun (clear property) (clear-value (cast AvaloniaObject control) property)) (match (Tuple kind p) - ((Tuple ImageKind (Source _)) (clear (cast AvaloniaProperty image-source-property))) - ((Tuple GridKind (Columns _)) (grid-columns! (cast Grid control) (parse-columns "*"))) - ((Tuple GridKind (Rows _)) (grid-rows! (cast Grid control) (parse-rows "*"))) - ((Tuple GridKind (Spacing _)) + ((Tuple ImageKind (PropSource _)) (clear (cast AvaloniaProperty image-source-property))) + ((Tuple GridKind (PropColumns _)) (grid-columns! (cast Grid control) (parse-columns "*"))) + ((Tuple GridKind (PropRows _)) (grid-rows! (cast Grid control) (parse-rows "*"))) + ((Tuple GridKind (PropSpacing _)) (clear (cast AvaloniaProperty grid-row-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) ((Some property) (clear property)) @@ -678,10 +768,10 @@ (defun (in-view v) (def props (view-props v)) (if (and (= (view-kind v) MenuItemKind) - (not (vec-contains props (Enabled #f))) - (any? (fun (p) (match p ((Shortcut s) (same? s)) (_ #f))) props)) + (not (vec-contains props (PropEnabled #f))) + (any? (fun (p) (match p ((PropShortcut s) (same? s)) (_ #f))) props)) (loop (:for on (view-events v)) - (:when-let (Click msg) on) + (:when-let (OnClick msg) on) (:finish #t (Some msg)) => None) (loop (:for c (view-children v)) @@ -812,33 +902,69 @@ (fun (sender e) (when (eq? (event-source e) (cast Object control)) (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 (MenuItemKind (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 (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) (on-event (cast RoutedEvent text-changing-event) (fun () (def s (text-box-value (cast TextBox control))) - (fun (on) (match on ((Input f) (Some (f s))) (_ None)))))) - (CheckBoxKind + (fun (on) (match on ((OnInput f) (Some (f s))) (_ None)))))) + (RadioKind (on-event (cast RoutedEvent checked-event) (fun () (def b (.GetValueOrDefault (is-checked (cast ToggleButton control)))) - (fun (on) (match on ((Toggle f) (Some (f b))) (_ None)))))) + (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 (on-event (cast RoutedEvent value-changed-event) (fun () (def d (range-value (cast RangeBase control))) - (fun (on) (match on ((Slide f) (Some (f d))) (_ None)))))) + (fun (on) (match on ((OnSlide f) (Some (f d))) (_ None)))))) ((or DropdownKind ListBoxKind TabsKind) (on-event (cast RoutedEvent selection-changed-event) (fun () (def i (selected-index (cast SelectingItemsControl control))) - (fun (on) (match on ((Select f) (Some (f i))) (_ None)))))) + (fun (on) (match on ((OnSelect f) (Some (f i))) (_ None)))))) (_ unit))) (: (-> Kind Control)) @@ -884,7 +1010,15 @@ (MenuItemKind (cast Control (MenuItem.))) (SeparatorKind (cast Control (Separator.))) (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. (: (-> Kind Control IList)) @@ -918,7 +1052,7 @@ (when (selecting? kind) (loop (:for p props) (:do (match p - ((Selected i) + ((PropSelected i) (unless (= (selected-index (cast SelectingItemsControl control)) i) (put! control (cast AvaloniaProperty selected-index-property) (cast Object i)))) (_ unit)))))) diff --git a/src/view.bjo b/src/view.bjo index 51d1e67..9a5b3c6 100644 --- a/src/view.bjo +++ b/src/view.bjo @@ -21,9 +21,10 @@ text button text-input text-area checkbox slider progress-bar dropdown image list-box tabs tab 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. - keyed at paint with-context-menu + keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right ;; Keyboard shortcuts. Key key key-gesture key-message @@ -42,48 +43,54 @@ SliderKind ProgressKind DropdownKind ImageKind ListBoxKind TabsKind TabKind MenuBarKind MenuItemKind SeparatorKind ContextKind ContextMenuKind + ToggleSwitchKind RadioKind NumberKind DateKind AutoCompleteKind + ExpanderKind WrapKind DockKind ColumnKind RowKind GridKind ScrollKind BorderKind))) ;; A property of a control. A kind takes only some of them; the app ignores ;; the others. -(type (: Prop (Union (: Label string) ; the text of a text, a button or a checkbox - (: Value string) ; the text in a text input - (: Placeholder string) ; shown in an empty text input - (: Checked bool) - (: Enabled bool) - (: FontSize double) - (: Width double) - (: Height double) - (: Margin double) - (: Padding double) - (: Spacing double) - (: Wrap bool) ; a text breaks its lines at the width - (: Minimum double) ; of a slider or a progress bar - (: Maximum double) - (: Amount double) ; where a slider or a progress bar is - (: Step double) ; what an arrow key moves a slider by - (: Items (Vec string)) ; what a dropdown offers - (: Selected int) ; which 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) - (: 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 - (: Shortcut string)))) ; a menu item's keys, as "Ctrl+S" +(type (: Prop (Union (: PropLabel string) ; the text of a text, a button or a checkbox + (: PropValue string) ; the text in a text input + (: PropPlaceholder string) ; shown in an empty text input + (: PropChecked bool) + (: PropEnabled bool) + (: PropFontSize double) + (: PropWidth double) + (: PropHeight double) + (: PropMargin double) + (: PropPadding double) + (: PropSpacing double) + (: PropWrap bool) ; a text breaks its lines at the width + (: PropMinimum double) ; of a slider or a progress bar + (: PropMaximum double) + (: PropAmount double) ; where a slider or a progress bar is + (: PropStep double) ; what an arrow key moves a slider by + (: PropItems (Vec string)) ; what a dropdown offers + (: PropSelected int) ; which item is chosen; -1 for none + (: PropSource string) ; the file an image shows + (: PropColumns string) ; a grid's columns, as "Auto,*,2*" + (: PropRows string) + (: PropRow int) ; where a view is in its grid + (: PropColumn int) + (: PropRowSpan int) + (: PropColumnSpan int) + (: PropBackground string) ; a colour: "red", "#08f", "#80ff8800" + (: PropForeground string) ; the colour of the text + (: PropBorderColour string) + (: PropBorderWidth double) + (: PropRadius double) ; how round a border's corners are + (: 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. -(type (: (On %m) (Union (: Click %m) - (: Input (-> string %m)) - (: Toggle (-> bool %m)) - (: Slide (-> double %m)) - (: Select (-> int %m))))) +(type (: (On %m) (Union (: OnClick %m) + (: OnInput (-> string %m)) + (: OnToggle (-> bool %m)) + (: OnSlide (-> double %m)) + (: OnSelect (-> int %m))))) ;; One control and what is in it. ;; @@ -128,7 +135,7 @@ (: 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)))) + (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 items are made by `menu-item`, `submenu` and `menu-separator`. @@ -136,12 +143,35 @@ (defun (with-context-menu v #:rest 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. (: at (-> int int (View %m) (#:row-span int) (#:column-span int) (View %m))) (defun (at row column v #:row-span 1 #:column-span 1) - (record-set v (props (vec-add (vec-add (vec-add (vec-add (.props v) (Row row)) (Column column)) - (RowSpan row-span)) - (ColumnSpan column-span))))) + (record-set v (props (vec-add (vec-add (vec-add (vec-add (.props v) (PropRow row)) (PropColumn column)) + (PropRowSpan row-span)) + (PropColumnSpan column-span))))) ;; --------------------------------------------------------------------------- ;; Constructors @@ -156,9 +186,9 @@ (: (-> (Vec Prop) double double double double (Vec Prop))) (defun (with-layout props width height margin padding) - (with-size (with-size (with-size (with-size props Width width) Height height) - Margin margin) - Padding padding)) + (with-size (with-size (with-size (with-size props PropWidth width) PropHeight height) + PropMargin margin) + PropPadding padding)) (: (-> Kind (Vec Prop) (Vec (On %m)) (View %m))) (defun (leaf kind props events) @@ -170,7 +200,7 @@ (View %m))) (defun (text s #:size 0.0 #:wrap #f #:width 0.0 #:height 0.0 #:margin 0.0) (leaf TextKind - (with-layout (with-size [(Label s) (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. @@ -179,8 +209,8 @@ (View %m))) (defun (button label msg #:enabled #t #:width 0.0 #:height 0.0 #:margin 0.0 #:padding 0.0) (leaf ButtonKind - (with-layout [(Label label) (Enabled enabled)] width height margin padding) - [(Click msg)])) + (with-layout [(PropLabel label) (PropEnabled enabled)] width height margin padding) + [(OnClick msg)])) ;; A one-line text input that holds `value`. Each change sends `(on-input ;; text)`, with the whole text. @@ -189,9 +219,9 @@ (View %m))) (defun (text-input value on-input #:placeholder "" #:enabled #t #:width 0.0 #:margin 0.0) (leaf TextInputKind - (with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)] + (with-layout [(PropValue value) (PropPlaceholder placeholder) (PropEnabled enabled)] 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 ;; 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 #:margin 0.0) (leaf TextAreaKind - (with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)] + (with-layout [(PropValue value) (PropPlaceholder placeholder) (PropEnabled enabled)] width height margin 0.0) - [(Input on-input)])) + [(OnInput on-input)])) ;; A slider at `value`, from `minimum` to `maximum`. A move sends `(on-change ;; value)`. @@ -215,17 +245,17 @@ ;; The bounds come before the value, because a value outside the bounds ;; that are there is moved inside them. (leaf SliderKind - (with-layout [(Minimum minimum) (Maximum maximum) (Amount value) (Step step) - (Enabled enabled)] + (with-layout [(PropMinimum minimum) (PropMaximum maximum) (PropAmount value) (PropStep step) + (PropEnabled enabled)] 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 ;; otherwise. (: (-> double (#:maximum double) (#:width double) (#:margin double) (View %m))) (defun (progress-bar value #:maximum 1.0 #:width 0.0 #:margin 0.0) (leaf ProgressKind - (with-layout [(Minimum 0.0) (Maximum maximum) (Amount value)] width 0.0 margin 0.0) + (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, @@ -236,15 +266,15 @@ ;; The items come before the choice, because the choice is an index into ;; them. (leaf DropdownKind - (with-layout [(Items options) (Selected selected) (Enabled enabled)] + (with-layout [(PropItems options) (PropSelected selected) (PropEnabled enabled)] 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 ;; nothing. (: (-> string (#:width double) (#:height double) (#:margin double) (View %m))) (defun (image path #:width 0.0 #:height 0.0 #:margin 0.0) - (leaf ImageKind (with-layout [(Source path)] width height margin 0.0) [])) + (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 ;; none for -1. A choice sends `(on-select index)`. Give the items keys if @@ -253,8 +283,8 @@ (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)]) + (props (with-layout [(PropSelected selected)] width height margin 0.0)) + (events [(OnSelect on-select)]) (children items) (key None))) @@ -263,15 +293,15 @@ (: (-> 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)]) + (props (with-layout [(PropSelected selected)] 0.0 0.0 margin 0.0)) + (events [(OnSelect 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))) + (View (kind TabKind) (props [(PropLabel header)]) (events []) (children [content]) (key None))) ;; A bar of menus, made by `submenu`, for the top of the window. (: (-> #:rest (View %m) (View %m))) @@ -281,7 +311,7 @@ ;; A menu of items, in a menu bar or in another menu. (: (-> string #:rest (View %m) (View %m))) (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))) ;; An item that sends `msg` when it is chosen. `#:shortcut`, such as @@ -291,22 +321,78 @@ (defun (menu-item label msg #:shortcut "" #:enabled #t) (leaf MenuItemKind (if (string-empty? shortcut) - [(Label label) (Enabled enabled)] - [(Label label) (Enabled enabled) (Shortcut shortcut)]) - [(Click msg)])) + [(PropLabel label) (PropEnabled enabled)] + [(PropLabel label) (PropEnabled enabled) (PropShortcut shortcut)]) + [(OnClick msg)])) ;; A line between items of a menu. (: (-> (View %m))) (defun (menu-separator) (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 ;; the new state. (: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m))) (defun (checkbox label checked? on-toggle #:enabled #t #:margin 0.0) (leaf CheckBoxKind - (with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0) - [(Toggle on-toggle)])) + (with-layout [(PropLabel label) (PropChecked checked?) (PropEnabled enabled)] 0.0 0.0 margin 0.0) + [(OnToggle on-toggle)])) (: (-> Kind (Vec Prop) (Vec (View %m)) (View %m))) (defun (container kind props children) @@ -314,7 +400,7 @@ (: (-> Kind double double (Array (View %m)) (View %m))) (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))) ;; Views one above the other. @@ -335,7 +421,7 @@ #:rest (View %m) (View %m))) (defun (grid #:columns "*" #:rows "*" #:spacing 0.0 #:margin 0.0 #:rest children) (container GridKind - (with-layout (with-size [(Columns columns) (Rows rows)] Spacing spacing) + (with-layout (with-size [(PropColumns columns) (PropRows rows)] PropSpacing spacing) 0.0 0.0 margin 0.0) (array->vec children))) @@ -350,12 +436,24 @@ (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) + PropBorderWidth thickness) + PropRadius radius) + PropBorderColour colour) + PropBackground background) [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. (: (-> (View %m) (#:width double) (#:height double) (#:margin double) (View %m))) (defun (scroll child #:width 0.0 #:height 0.0 #:margin 0.0) diff --git a/tests/inputs.bjo b/tests/inputs.bjo new file mode 100644 index 0000000..1cdd91c --- /dev/null +++ b/tests/inputs.bjo @@ -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"))