Switches, radios, numbers, dates, completion, expanders, tooltips, flows, docks
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:
parent
cfcb1851b7
commit
56a01efe76
3 changed files with 532 additions and 170 deletions
322
src/app.bjo
322
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))))))
|
||||
|
|
|
|||
250
src/view.bjo
250
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)
|
||||
|
|
|
|||
130
tests/inputs.bjo
Normal file
130
tests/inputs.bjo
Normal 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"))
|
||||
Loading…
Add table
Add a link
Reference in a new issue