diff --git a/Readme.org b/Readme.org index 07e4100..dd6a5f1 100644 --- a/Readme.org +++ b/Readme.org @@ -35,8 +35,11 @@ view. The next view is compared with the last one, control by control, and only what differs is changed. So a control keeps its focus, its caret and its scroll position when the model changes. -Children are matched by their place in the list. A child whose kind changes -gets a new control. +Children are matched by key, and those with no key by their place among +the others with none. Give each item of a list that can change order a key +with ~(keyed id view)~: a child that moves then keeps its control, and the +control is moved rather than made again. A child whose kind changes gets a +new control. A control that is changed raises events of its own: a text input whose text is set says that its text changed. Those events come while the controls are @@ -44,18 +47,44 @@ being changed, and they are dropped, so only the user's events are messages. * The views: (bjogui view) -| Constructor | Control | Sends | -|--------------------------------------------------+--------------+-----------------------------| -| ~(text s)~ | ~TextBlock~ | nothing | -| ~(button label msg)~ | ~Button~ | ~msg~ on a click | -| ~(text-input value on-input)~ | ~TextBox~ | ~(on-input text)~ on a change | -| ~(checkbox label checked? on-toggle)~ | ~CheckBox~ | ~(on-toggle checked)~ | -| ~(column child ...)~, ~(row child ...)~ | ~StackPanel~ | nothing | +| Constructor | Control | Sends | +|------------------------------------------------------+---------------+-------------------------------| +| ~(text s)~ | ~TextBlock~ | nothing | +| ~(button label msg)~ | ~Button~ | ~msg~ on a click | +| ~(text-input value on-input)~ | ~TextBox~ | ~(on-input text)~ on a change | +| ~(text-area value on-input)~ | ~TextBox~, several lines | ~(on-input text)~ | +| ~(checkbox label checked? on-toggle)~ | ~CheckBox~ | ~(on-toggle checked)~ | +| ~(slider value minimum maximum on-change)~ | ~Slider~ | ~(on-change value)~ | +| ~(progress-bar value)~ | ~ProgressBar~ | nothing | +| ~(dropdown options selected on-select)~ | ~ComboBox~ | ~(on-select index)~ | +| ~(image path)~ | ~Image~ | nothing | +| ~(column child ...)~, ~(row child ...)~ | ~StackPanel~ | nothing | +| ~(grid #:columns #:rows child ...)~ | ~Grid~ | nothing | +| ~(scroll child)~ | ~ScrollViewer~ | nothing | They take keywords where they apply: ~#:size~ (the font size of a text), -~#:width~, ~#:height~, ~#:margin~, ~#:padding~, ~#:spacing~ (between the -children of a column or a row), ~#:enabled~ and ~#:placeholder~. A size of -zero, the default, leaves the size to the control. +~#:wrap~ (a text breaks its lines at its width), ~#:width~, ~#:height~, +~#:margin~, ~#:padding~, ~#:spacing~ (between the children of a column, a row +or a grid), ~#:enabled~, ~#:placeholder~, ~#:step~ (a slider's arrow key) and +~#:maximum~ (a progress bar's full, 1 unless told otherwise). A size of zero, +the default, leaves the size to the control. + +A grid's ~#:columns~ and ~#:rows~ are sizes as Avalonia writes them: ~"Auto"~ +fits the content, ~"*"~ shares what is left, ~"2*"~ takes two shares, and a +number is pixels. ~(at row column view)~ puts a view in a cell, counting from +0, with ~#:row-span~ and ~#:column-span~. + +#+BEGIN_SRC scheme +(grid #:columns "Auto,*" #:rows "Auto,Auto" #:spacing 6.0 + (at 0 0 (text "Volume")) (at 0 1 (slider (.volume m) 0.0 10.0 Volume)) + (at 1 0 (text "Colour")) (at 1 1 (dropdown ["red" "green" "blue"] (.colour m) Colour))) + +(scroll (apply column (vec->array (vec-map (fun (t) (keyed (.id t) (text (.title t)))) + (.todos m)))) + #:height 200.0) +#+END_SRC + +An image that cannot be read shows nothing. * Work: commands and subscriptions @@ -124,11 +153,14 @@ cancelled, and the program ends. #+BEGIN_SRC sh bjo run tests/app.bjo # prints "bjogui ok" bjo run tests/effects.bjo # prints "bjogui effects ok" +bjo run tests/controls.bjo # prints "bjogui controls ok" bjo run examples/counter.bjo bjo run examples/stopwatch.bjo #+END_SRC * Not yet -- Keyed children, for lists whose items move. -- More controls: lists, grids, images, scroll views, menus. +- A list box with a selection, tabs, menus and dialogs. +- Colours, borders and styles of one's own. +- A moved control is taken out of the panel and put back, so it may lose the + keyboard focus. diff --git a/src/app.bjo b/src/app.bjo index 10f8215..bebc561 100644 --- a/src/app.bjo +++ b/src/app.bjo @@ -36,6 +36,7 @@ (import (std prelude)) (import (std interop)) (import (std mutable vec)) +(import (std mutable map)) (import (bjogui view)) ;; --------------------------------------------------------------------------- @@ -56,7 +57,20 @@ (Thickness (: Avalonia.Thickness (-> double Thickness))) (Orientation (: Avalonia.Layout.Orientation)) (HAlignment (: Avalonia.Layout.HorizontalAlignment)) + (VAlignment (: Avalonia.Layout.VerticalAlignment)) (Control (: Avalonia.Controls.Control)) + (Grid (: Avalonia.Controls.Grid (-> Grid))) + (ColumnDefs (: Avalonia.Controls.ColumnDefinitions)) + (RowDefs (: Avalonia.Controls.RowDefinitions)) + (ScrollViewer (: Avalonia.Controls.ScrollViewer (-> ScrollViewer))) + (Slider (: Avalonia.Controls.Slider (-> Slider))) + (ProgressBar (: Avalonia.Controls.ProgressBar (-> ProgressBar))) + (RangeBase (: Avalonia.Controls.Primitives.RangeBase)) + (ComboBox (: Avalonia.Controls.ComboBox (-> ComboBox))) + (SelectingItemsControl (: Avalonia.Controls.Primitives.SelectingItemsControl)) + (Image (: Avalonia.Controls.Image (-> Image))) + (Bitmap (: Avalonia.Media.Imaging.Bitmap (-> string Bitmap))) + (TextWrapping (: Avalonia.Media.TextWrapping)) (Controls (: Avalonia.Controls.Controls)) (Panel (: Avalonia.Controls.Panel)) (StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel))) @@ -100,6 +114,32 @@ (orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get)) (content-alignment-property (: Avalonia.Controls.ContentControl.HorizontalContentAlignmentProperty #:get)) + (horizontal-alignment-property (: Avalonia.Layout.Layoutable.HorizontalAlignmentProperty #:get)) + (vertical-alignment-property (: Avalonia.Layout.Layoutable.VerticalAlignmentProperty #:get)) + (text-block-wrapping (: Avalonia.Controls.TextBlock.TextWrappingProperty #:get)) + (text-box-wrapping (: Avalonia.Controls.TextBox.TextWrappingProperty #:get)) + (accepts-return-property (: Avalonia.Controls.TextBox.AcceptsReturnProperty #:get)) + (minimum-property (: Avalonia.Controls.Primitives.RangeBase.MinimumProperty #:get)) + (maximum-property (: Avalonia.Controls.Primitives.RangeBase.MaximumProperty #:get)) + (value-property (: Avalonia.Controls.Primitives.RangeBase.ValueProperty #:get)) + (small-change-property (: Avalonia.Controls.Primitives.RangeBase.SmallChangeProperty #:get)) + (items-source-property (: Avalonia.Controls.ItemsControl.ItemsSourceProperty #:get)) + (selected-index-property + (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndexProperty #:get)) + (image-source-property (: Avalonia.Controls.Image.SourceProperty #:get)) + (grid-row-property (: Avalonia.Controls.Grid.RowProperty #:get)) + (grid-column-property (: Avalonia.Controls.Grid.ColumnProperty #:get)) + (grid-row-span-property (: Avalonia.Controls.Grid.RowSpanProperty #:get)) + (grid-column-span-property (: Avalonia.Controls.Grid.ColumnSpanProperty #:get)) + (grid-row-spacing-property (: Avalonia.Controls.Grid.RowSpacingProperty #:get)) + (grid-column-spacing-property (: Avalonia.Controls.Grid.ColumnSpacingProperty #:get)) + + ;; A grid's sizes are not Avalonia properties, so they are set as .NET + ;; properties are. + (grid-columns! (: Avalonia.Controls.Grid.ColumnDefinitions (-> Grid ColumnDefs void) #:set)) + (grid-rows! (: Avalonia.Controls.Grid.RowDefinitions (-> Grid RowDefs void) #:set)) + (parse-columns (: Avalonia.Controls.ColumnDefinitions.Parse (-> string ColumnDefs))) + (parse-rows (: Avalonia.Controls.RowDefinitions.Parse (-> string RowDefs))) (set-value (: Avalonia.AvaloniaObject.SetValue (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) @@ -111,6 +151,9 @@ ;; dispatcher and comes later, after the patch that set the text is over. (text-changing-event (: Avalonia.Controls.TextBox.TextChangingEvent #:get)) (checked-event (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedChangedEvent #:get)) + (value-changed-event (: Avalonia.Controls.Primitives.RangeBase.ValueChangedEvent #:get)) + (selection-changed-event + (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectionChangedEvent #:get)) (add-handler (: Avalonia.Interactivity.Interactive.AddHandler (-> Interactive RoutedEvent Delegate Routes bool void))) @@ -118,7 +161,11 @@ (text-box-value (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get)) (is-checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked (-> ToggleButton (Nullable bool)) #:get)) + (range-value (: Avalonia.Controls.Primitives.RangeBase.Value (-> RangeBase double) #:get)) + (selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex + (-> SelectingItemsControl int) #:get)) (panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) + (content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set)) (clr-string (: System.Convert.ToString (-> string ClrString))) ;; The UI thread. Controls may be touched only there, so a message from a @@ -146,6 +193,15 @@ ;; Properties ;; --------------------------------------------------------------------------- +;; A kind whose children are the children of an Avalonia Panel. +(: (-> Kind bool)) +(defun (panel? kind) + (match kind + (ColumnKind #t) + (RowKind #t) + (GridKind #t) + (_ #f))) + (: (-> Kind bool)) (defun (stack? kind) (match kind @@ -158,15 +214,33 @@ (: (-> Kind bool)) (defun (templated? kind) (match kind - (ButtonKind #t) + (TextKind #f) + (ImageKind #f) + (ColumnKind #f) + (RowKind #f) + (GridKind #f) + (_ #t))) + +(: (-> Kind bool)) +(defun (text-box? kind) + (match kind (TextInputKind #t) - (CheckBoxKind #t) + (TextAreaKind #t) + (_ #f))) + +(: (-> Kind bool)) +(defun (range? kind) + (match kind + (SliderKind #t) + (ProgressKind #t) (_ #f))) ;; The Avalonia property that a prop sets on a control of this kind. None -;; for a prop that the kind does not take. +;; for a prop that the kind does not take, and for the props that `set-prop!` +;; sets in a way of their own. (: (-> Kind Prop (Option AvaloniaProperty))) (defun (slot kind p) + (defun (when-kind ok? prop) (if ok? (Some prop) None)) (match p ((Label _) (match kind @@ -174,9 +248,9 @@ (ButtonKind (Some (cast AvaloniaProperty content-property))) (CheckBoxKind (Some (cast AvaloniaProperty content-property))) (_ None))) - ((Value _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty text-box-text)) None)) - ((Placeholder _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty watermark-property)) None)) - ((Checked _) (if (= kind CheckBoxKind) (Some (cast AvaloniaProperty is-checked-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 _) (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size))) @@ -185,16 +259,39 @@ ((Width _) (Some (cast AvaloniaProperty width-property))) ((Height _) (Some (cast AvaloniaProperty height-property))) ((Margin _) (Some (cast AvaloniaProperty margin-property))) - ((Padding _) (if (templated? kind) (Some (cast AvaloniaProperty padding-property)) None)) - ((Spacing _) (if (stack? kind) (Some (cast AvaloniaProperty spacing-property)) None)))) + ((Padding _) (when-kind (templated? kind) (cast AvaloniaProperty padding-property))) + ((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 (= kind DropdownKind) (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))) + ;; Set by `set-prop!` itself. + ((Source _) None) + ((Columns _) None) + ((Rows _) None))) + +(: (-> bool TextWrapping)) +(defun (wrapping wrap?) + (if wrap? TextWrapping.Wrap TextWrapping.NoWrap)) + +(: (-> string ClrString)) +(defun (->clr-string s) (clr-string s)) ;; The value of a prop, as the object `SetValue` takes. (: (-> Prop Object)) (defun (boxed p) + (defun (text s) (cast Object (->clr-string s))) (match p - ((Label s) (cast Object (clr-string s))) - ((Value s) (cast Object (clr-string s))) - ((Placeholder s) (cast Object (clr-string s))) + ((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)) @@ -202,7 +299,22 @@ ((Height d) (cast Object d)) ((Margin d) (cast Object (Thickness. d))) ((Padding d) (cast Object (Thickness. d))) - ((Spacing d) (cast Object 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)) + ;; 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)))) ;; Which prop it is, without its value. Two props with one tag set the same ;; property. @@ -211,20 +323,53 @@ (match p ((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3) ((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7) - ((Margin _) 8) ((Padding _) 9) ((Spacing _) 10))) + ((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))) + +(: (-> Control AvaloniaProperty Object void)) +(defun (put! control property value) + (ignore (set-value (cast AvaloniaObject control) property value Priority.LocalValue))) + +;; The picture in a file, or None when it cannot be read. +(: (-> string (Option Bitmap))) +(defun (load-bitmap path) + (match (try (Bitmap. path) #:catch (System.Exception)) + ((Ok b) (Some b)) + ((Err _) None))) (: (-> Control Kind Prop void)) (defun (set-prop! control kind p) - (match (slot kind p) - ((Some property) - (ignore (set-value (cast AvaloniaObject control) property (boxed p) Priority.LocalValue))) - (None unit))) + (match (Tuple kind p) + ((Tuple ImageKind (Source 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)) + (put! control (cast AvaloniaProperty grid-row-spacing-property) (cast Object d)) + (put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d))) + (_ + (match (slot kind p) + ((Some property) (put! control property (boxed p))) + (None unit))))) (: (-> Control Kind Prop void)) (defun (clear-prop! control kind p) - (match (slot kind p) - ((Some property) (clear-value (cast AvaloniaObject control) property)) - (None unit))) + (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 _)) + (clear (cast AvaloniaProperty grid-row-spacing-property)) + (clear (cast AvaloniaProperty grid-column-spacing-property))) + (_ + (match (slot kind p) + ((Some property) (clear property)) + (None unit))))) ;; Clears the props that are gone, and sets the ones that are new or have ;; another value. A prop with the same value is not set again. @@ -403,18 +548,21 @@ (spawn/daemon (run-sub app (.next-event sub)))) scope)) +(: (-> (Sub %m) string)) +(defun (sub-key sub) (.key sub)) + (: (-> (App %model %m) void)) (defun (sync-subs! app) (def wanted ((.subscriptions app) (.model app))) - (defun (wanted? key) (any? (fun (sub) (= (.key sub) key)) wanted)) + (defun (wanted? key) (any? (fun (sub) (= (sub-key sub) key)) wanted)) (def/mutable kept '()) (loop (:for (Tuple key scope) (.subs app)) (:do (if (wanted? key) (set! kept (cons (Tuple key scope) kept)) (stop-scope! scope)))) (loop (:for sub wanted) - (:when (not (any? (fun (t) (= (fst t) (.key sub))) kept))) - (:do (set! kept (cons (Tuple (.key sub) (start-sub! app sub)) kept)))) + (:when (not (any? (fun (t) (= (fst t) (sub-key sub))) kept))) + (:do (set! kept (cons (Tuple (sub-key sub) (start-sub! app sub)) kept)))) (record-set! app (subs kept))) (: (-> (App %model %m) void)) @@ -455,41 +603,76 @@ (: (-> (App %model %m) (Live %m) Kind void)) (defun (listen! app live kind) (def control (.control live)) + (defun (on-event (: event RoutedEvent) pick) + (on! control event (fun (sender e) (fire! app live (pick))))) (match kind (ButtonKind - (on! control (cast RoutedEvent click-event) - (fun (sender e) - (fire! app live (fun (on) (match on ((Click msg) (Some msg)) (_ None))))))) - (TextInputKind - (on! control (cast RoutedEvent text-changing-event) - (fun (sender e) - (def s (text-box-value (cast TextBox control))) - (fire! app live (fun (on) (match on ((Input f) (Some (f s))) (_ None))))))) + (on-event (cast RoutedEvent click-event) + (fun () (fun (on) (match on ((Click 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 - (on! control (cast RoutedEvent checked-event) - (fun (sender e) - (def b (.GetValueOrDefault (is-checked (cast ToggleButton control)))) - (fire! app live (fun (on) (match on ((Toggle f) (Some (f b))) (_ None))))))) + (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)))))) + (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)))))) + (DropdownKind + (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)))))) (_ unit))) (: (-> Kind Control)) (defun (make-control kind) (match kind - (TextKind (cast Control (TextBlock.))) + (TextKind + ;; Centred in the height it is given, so a label lines up with the + ;; control beside it in a row or a grid. + (def t (cast Control (TextBlock.))) + (put! t (cast AvaloniaProperty vertical-alignment-property) (cast Object VAlignment.Center)) + t) (ButtonKind ;; Centred, because a button given a width shows its label at the left. - (def b (Button.)) - (ignore (set-value (cast AvaloniaObject b) (cast AvaloniaProperty content-alignment-property) - (cast Object HAlignment.Center) Priority.LocalValue)) - (cast Control b)) + (def b (cast Control (Button.))) + (put! b (cast AvaloniaProperty content-alignment-property) (cast Object HAlignment.Center)) + b) (TextInputKind (cast Control (TextBox.))) + (TextAreaKind + (def t (cast Control (TextBox.))) + (put! t (cast AvaloniaProperty accepts-return-property) (cast Object #t)) + (put! t (cast AvaloniaProperty text-box-wrapping) (cast Object TextWrapping.Wrap)) + t) (CheckBoxKind (cast Control (CheckBox.))) + (SliderKind (cast Control (Slider.))) + (ProgressKind (cast Control (ProgressBar.))) + (DropdownKind + (def d (cast Control (ComboBox.))) + (put! d (cast AvaloniaProperty horizontal-alignment-property) (cast Object HAlignment.Stretch)) + d) + (ImageKind (cast Control (Image.))) (ColumnKind (cast Control (StackPanel.))) (RowKind - (def panel (StackPanel.)) - (ignore (set-value (cast AvaloniaObject panel) (cast AvaloniaProperty orientation-property) - (cast Object Orientation.Horizontal) Priority.LocalValue)) - (cast Control panel)))) + (def panel (cast Control (StackPanel.))) + (put! panel (cast AvaloniaProperty orientation-property) (cast Object Orientation.Horizontal)) + panel) + (GridKind (cast Control (Grid.))) + (ScrollKind (cast Control (ScrollViewer.))))) + +;; Puts a child's control in its parent's, as the last one. +(: (-> Kind Control Control void)) +(defun (adopt! kind parent child) + (if (= kind ScrollKind) + (content! (cast ContentControl parent) (cast Object child)) + (.Add (panel-children (cast Panel parent)) child))) ;; Makes the controls for a view. (: (-> (App %model %m) (View %m) (Live %m))) @@ -502,7 +685,7 @@ (loop (:for child (view-children v)) (:do (def c (mount app child)) (mutablevec-add! (.children live) c) - (.Add (panel-children (cast Panel control)) (.control c)))) + (adopt! kind control (.control c)))) live) ;; Changes the controls of `live` to show `next`. Gives `live` itself, or new @@ -516,30 +699,80 @@ (begin (patch-props! (.control live) kind (view-props old) (view-props next)) (record-set! live (view next)) - (when (stack? kind) - (patch-children! app live (view-children next))) + (cond ((panel? kind) (patch-children! app live (view-children next))) + ((= kind ScrollKind) (patch-content! app live (view-children next))) + (else unit)) live))) -;; Children are matched by their place: the first with the first, and so on. -;; Those past the end of the shorter list are added or removed. +;; A scroll's one child is its content. +(: (-> (App %model %m) (Live %m) (Vec (View %m)) void)) +(defun (patch-content! app live views) + (def kids (.children live)) + (def was (mutablevec-ref kids 0)) + (def now (patch! app was (vec-ref views 0))) + (unless (eq? now was) + (mutablevec-set! kids 0 now) + (content! (cast ContentControl (.control live)) (cast Object (.control now))))) + +;; Which child each view is: its key, or its place among the children that +;; have none. The two kinds cannot be mistaken for each other. +(: (-> (Vec (View %m)) (Vec string))) +(defun (identities views) + (def/mutable unkeyed 0) + (loop (:for v views) + (:acc out (vecing (match (view-key v) + ((Some k) (string-append "k" k)) + (None (set! unkeyed (+ unkeyed 1)) + #"i${(- unkeyed 1)}")))) + => out)) + +;; Children are matched by identity: a child of the last view whose key, or +;; whose place among those with no key, is a child's of the next one keeps +;; its control, and is changed to the next view. The others are made new, +;; and those left over are removed. Then the controls are put in the order +;; of the next view, moving only those that are out of place. (: (-> (App %model %m) (Live %m) (Vec (View %m)) void)) (defun (patch-children! app live views) (def kids (.children live)) (def controls (panel-children (cast Panel (.control live)))) - (def n (vec-length views)) - (loop (:for i (range 0 (min n (mutablevec-length kids)))) - (:do (def was (mutablevec-ref kids i)) - (def now (patch! app was (vec-ref views i))) - (unless (eq? now was) - (mutablevec-set! kids i now) - (.set_Item controls i (.control now))))) - (loop (:while (> (mutablevec-length kids) n)) - (:do (ignore (mutablevec-pop! kids)) - (.RemoveAt controls (mutablevec-length kids)))) - (loop (:for i (range (mutablevec-length kids) n)) - (:do (def c (mount app (vec-ref views i))) - (mutablevec-add! kids c) - (.Add controls (.control c))))) + (def olds (mutablevec->vec kids)) + (def old-ids (identities (vec-map (fun (l) (.view l)) olds))) + (def new-ids (identities views)) + + ;; Where each identity was. A second child with one identity is new. + (def where (mutablemap)) + (loop (:for (Tuple i id) (enumerate old-ids)) + (:when (not (mutablemap-contains? where id))) + (:do (mutablemap-set! where id i))) + (def kept (: (make-array (vec-length olds) #:fill #f) (Array bool))) + + (def nexts (mutablevec)) + (loop (:for (Tuple j v) (enumerate views)) + (:do (def now + (match (mutablemap-try-ref where (vec-ref new-ids j)) + ((Some i) + (ignore (mutablemap-remove! where (vec-ref new-ids j))) + (def was (vec-ref olds i)) + (def now (patch! app was v)) + (when (eq? now was) (array-set! kept i #t)) + now) + (None (mount app v)))) + (mutablevec-add! nexts now))) + + (loop (:for (Tuple i was) (enumerate olds)) + (:when (not (array-ref kept i))) + (:do (ignore (.Remove controls (.control was))))) + + (loop (:for (Tuple j now) (enumerate (mutablevec->vec nexts))) + (:do (def c (.control now)) + (unless (and (< j (.-Count controls)) (eq? (.get_Item controls j) c)) + (def at (.IndexOf controls c)) + (if (>= at 0) + (.Move controls at j) + (.Insert controls j c))))) + + (mutablevec-clear! kids) + (loop (:for now (mutablevec->vec nexts)) (:do (mutablevec-add! kids now)))) ;; An app with no window: its view is made now, its subscriptions started, ;; and `on-root` is given the control to show each time that control changes. diff --git a/src/view.bjo b/src/view.bjo index bdf3665..aab67a2 100644 --- a/src/view.bjo +++ b/src/view.bjo @@ -18,10 +18,13 @@ View Kind Prop On ;; Constructors. - text button text-input checkbox column row + text button text-input text-area checkbox slider progress-bar dropdown image + column row grid scroll + ;; Wrappers. + keyed at ;; Reading one. - view-kind view-props view-events view-children) + view-kind view-props view-events view-children view-key) (import (std prelude)) @@ -30,7 +33,9 @@ ;; --------------------------------------------------------------------------- ;; What control a view is. -(type (: Kind (Union TextKind ButtonKind TextInputKind CheckBoxKind ColumnKind RowKind))) +(type (: Kind (Union TextKind ButtonKind TextInputKind TextAreaKind CheckBoxKind + SliderKind ProgressKind DropdownKind ImageKind + ColumnKind RowKind GridKind ScrollKind))) ;; A property of a control. A kind takes only some of them; the app ignores ;; the others. @@ -44,18 +49,40 @@ (: Height double) (: Margin double) (: Padding double) - (: Spacing 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 of them 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)))) ;; An event, and the message it sends. (type (: (On %m) (Union (: Click %m) (: Input (-> string %m)) - (: Toggle (-> bool %m))))) + (: Toggle (-> bool %m)) + (: Slide (-> double %m)) + (: Select (-> int %m))))) ;; One control and what is in it. +;; +;; `key` says which child of its parent a view is. Children with keys are +;; matched by key when the next view is compared with the last one, so a +;; child that moves keeps its control. Children without one are matched by +;; their place among the others without one. (type (: (View %m) (Record (: kind Kind) (: props (Vec Prop)) (: events (Vec (On %m))) - (: children (Vec (View %m)))))) + (: children (Vec (View %m))) + (: key (Option string))))) (: view-kind (-> (View %m) Kind)) (defun (view-kind v) (.kind v)) @@ -69,6 +96,26 @@ (: view-children (-> (View %m) (Vec (View %m)))) (defun (view-children v) (.children v)) +(: view-key (-> (View %m) (Option string))) +(defun (view-key v) (.key v)) + +;; --------------------------------------------------------------------------- +;; Wrappers +;; --------------------------------------------------------------------------- + +;; The view, with a key that says which child it is. Give each item of a list +;; that can change order a key of its own, such as its id. +(: keyed (-> string (View %m) (View %m))) +(defun (keyed key v) + (record-set v (key (Some key)))) + +;; 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))))) + ;; --------------------------------------------------------------------------- ;; Constructors ;; --------------------------------------------------------------------------- @@ -88,14 +135,15 @@ (: (-> Kind (Vec Prop) (Vec (On %m)) (View %m))) (defun (leaf kind props events) - (View (kind kind) (props props) (events events) (children []))) + (View (kind kind) (props props) (events events) (children []) (key None))) ;; A text. -(: (-> string (#:size double) (#:width double) (#:height double) (#:margin double) +(: (-> string (#:size double) (#:wrap bool) (#:width double) (#:height double) + (#:margin double) (View %m))) -(defun (text s #:size 0.0 #:width 0.0 #:height 0.0 #:margin 0.0) +(defun (text s #:size 0.0 #:wrap #f #:width 0.0 #:height 0.0 #:margin 0.0) (leaf TextKind - (with-layout (with-size [(Label s)] FontSize size) width height margin 0.0) + (with-layout (with-size [(Label s) (Wrap wrap)] FontSize size) width height margin 0.0) [])) ;; A button that sends `msg` when it is clicked. @@ -118,6 +166,59 @@ width 0.0 margin 0.0) [(Input 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. +(: (-> string (-> string %m) (#:placeholder string) (#:enabled bool) + (#:width double) (#:height double) (#:margin double) + (View %m))) +(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)] + width height margin 0.0) + [(Input on-input)])) + +;; A slider at `value`, from `minimum` to `maximum`. A move sends `(on-change +;; value)`. +(: (-> double double double (-> double %m) (#:step double) (#:enabled bool) + (#:width double) (#:margin double) + (View %m))) +(defun (slider value minimum maximum on-change #:step 1.0 #:enabled #t #:width 0.0 + #:margin 0.0) + ;; 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)] + width 0.0 margin 0.0) + [(Slide 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) + [])) + +;; A list to choose one of `options` from, with the one at `selected` chosen, +;; or none for -1. A choice sends `(on-select index)`. +(: (-> (Vec string) int (-> int %m) (#:enabled bool) (#:width double) (#:margin double) + (View %m))) +(defun (dropdown options selected on-select #:enabled #t #:width 0.0 #:margin 0.0) + ;; The items come before the choice, because the choice is an index into + ;; them. + (leaf DropdownKind + (with-layout [(Items options) (Selected selected) (Enabled enabled)] + width 0.0 margin 0.0) + [(Select 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) [])) + ;; 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))) @@ -126,12 +227,14 @@ (with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0) [(Toggle on-toggle)])) +(: (-> Kind (Vec Prop) (Vec (View %m)) (View %m))) +(defun (container kind props children) + (View (kind kind) (props props) (events []) (children children) (key None))) + (: (-> Kind double double (Array (View %m)) (View %m))) (defun (stack kind spacing margin children) - (View (kind kind) - (props (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0)) - (events []) - (children (array->vec children)))) + (container kind (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0) + (array->vec children))) ;; Views one above the other. (: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m))) @@ -142,3 +245,20 @@ (: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m))) (defun (row #:spacing 0.0 #:margin 0.0 #:rest children) (stack RowKind spacing margin children)) + +;; Views in the cells of a grid. `#:columns` and `#:rows` are the sizes, as +;; in Avalonia: "Auto" fits the content, "*" shares what is left, "2*" takes +;; two shares, and a number is pixels. Put a view in a cell with `at`; one +;; that is not put anywhere is in the first. +(: (-> (#:columns string) (#:rows string) (#:spacing double) (#:margin double) + #: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) + 0.0 0.0 margin 0.0) + (array->vec 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) + (container ScrollKind (with-layout [] width height margin 0.0) [child])) diff --git a/tests/controls.bjo b/tests/controls.bjo new file mode 100644 index 0000000..5c4cef6 --- /dev/null +++ b/tests/controls.bjo @@ -0,0 +1,204 @@ +;; 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/controls.bjo — keyed children, and the controls past the +;; first six. +;; +;; bjo run tests/controls.bjo +;; +;; No window is opened. Controls are compared by identity with `eq?`, to see +;; which were kept and which were made new. + +(import (std prelude)) +(import (std simpletest)) +(import (bjogui view)) +(import (bjogui app)) +(import (std interop)) + +(import/class + (Object (: System.Object)) + (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)) + (Grid (: Avalonia.Controls.Grid)) + (ColumnDefs (: Avalonia.Controls.ColumnDefinitions)) + (TextBlock (: Avalonia.Controls.TextBlock)) + (TextBox (: Avalonia.Controls.TextBox)) + (ContentControl (: Avalonia.Controls.ContentControl)) + (ScrollViewer (: Avalonia.Controls.ScrollViewer)) + (RangeBase (: Avalonia.Controls.Primitives.RangeBase)) + (ItemsControl (: Avalonia.Controls.ItemsControl)) + (SelectingItemsControl (: Avalonia.Controls.Primitives.SelectingItemsControl)) + (Image (: Avalonia.Controls.Image)) + (IImage (: Avalonia.Media.IImage))) + +(import/extern + (set-value (: Avalonia.AvaloniaObject.SetValue + (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) + (range-value-property (: Avalonia.Controls.Primitives.RangeBase.ValueProperty #:get)) + (selected-index-property + (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndexProperty #:get)) + (children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) + (count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get)) + (child-at (: Avalonia.Controls.Controls.get_Item (-> Controls int Control))) + (block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get)) + (box-text! (: Avalonia.Controls.TextBox.Text (-> TextBox string void) #:set)) + (accepts-return? (: Avalonia.Controls.TextBox.AcceptsReturn (-> TextBox bool) #:get)) + (range-value (: Avalonia.Controls.Primitives.RangeBase.Value (-> RangeBase double) #:get)) + (range-maximum (: Avalonia.Controls.Primitives.RangeBase.Maximum (-> RangeBase double) #:get)) + (item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get)) + (selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex + (-> SelectingItemsControl int) #:get)) + (grid-row (: Avalonia.Controls.Grid.GetRow (-> Control int))) + (grid-column (: Avalonia.Controls.Grid.GetColumn (-> Control int))) + (grid-columns (: Avalonia.Controls.Grid.ColumnDefinitions (-> Grid ColumnDefs) #:get)) + (scroll-content (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object) #:get)) + (image-source (: Avalonia.Controls.Image.Source (-> Image IImage) #:get)) + (null? (: System.Object.ReferenceEquals (-> Object Object bool)))) + +;; --------------------------------------------------------------------------- +;; A list, keyed or not +;; --------------------------------------------------------------------------- + +(type (: Item (Record (: id string) (: name string)))) +;; The items, and whether to key them. +(type (: Lst (Record (: items (List Item)) (: keyed? bool)))) + +(: (-> Lst Lst (Tuple Lst (List (Event Lst))))) +(defun (replace msg m) (next msg)) + +(: (-> Lst (View Lst))) +(defun (list-view l) + (apply column + (vec->array + (vec-map (fun (it) + (def v (text (.name it))) + (if (.keyed? l) (keyed (.id it) v) v)) + (list->vec (.items l)))))) + +(: (-> (List string) bool Lst)) +(defun (items ids keyed?) + (Lst (items (list-map item ids)) (keyed? keyed?))) + +(: (-> string Item)) +(defun (item id) (Item (id id) (name (string-append "item " id)))) + +;; --------------------------------------------------------------------------- +;; The other controls +;; --------------------------------------------------------------------------- + +(type (: Msg (Union (: Typed string) (: Slid double) (: Chose int) (: Show bool) Nothing))) +(type (: Model (Record (: notes string) (: level double) (: choice int) (: scrolled bool)))) + +(: (-> Msg Model (Tuple Model (List (Event Msg))))) +(defun (gui-update msg m) + (next (match msg + ((Typed s) (record-set m (notes s))) + ((Slid d) (record-set m (level d))) + ((Chose i) (record-set m (choice i))) + ((Show b) (record-set m (scrolled b))) + (Nothing m)))) + +(: (-> Model (View Msg))) +(defun (view m) + (column + (text-area (.notes m) Typed #:height 80.0) ; 0 + (slider (.level m) 0.0 10.0 Slid) ; 1 + (progress-bar (/ (.level m) 10.0)) ; 2 + (dropdown ["red" "green" "blue"] (.choice m) Chose) ; 3 + (grid #:columns "Auto,*" #:rows "Auto,Auto" #:spacing 4.0 ; 4 + (at 0 0 (text "name")) + (at 0 1 (text "value")) + (at 1 1 (text (.notes m)))) + (scroll (if (.scrolled m) (column (text "a") (text "b")) (text "just one")) + #:height 50.0) ; 5 + (image "/no/such/file.png" #:width 10.0) ; 6 + (text "a long line" #:wrap #t))) ; 7 + +(defun (main) + ;; --- keyed children --------------------------------------------------------- + (def lst (start-app (items '("a" "b" "c") #t) + replace list-view (fun (c) unit))) + (defun (at-row i) (app-control-at lst (list i))) + (defun (names) + (def kids (children (cast Panel (app-control lst)))) + (loop (:for i (range 0 (count kids))) + (:acc out (listing (block-text (cast TextBlock (child-at kids i))))) + => out)) + (def a (at-row 0)) + (def b (at-row 1)) + (def c (at-row 2)) + + (app-dispatch! lst (items '("c" "b" "a") #t)) + (expect "reversed" (names) '("item c" "item b" "item a")) + (expect "the controls moved with their keys" + (list (eq? (at-row 0) c) (eq? (at-row 1) b) (eq? (at-row 2) a)) '(#t #t #t)) + + (app-dispatch! lst (items '("z" "c" "b" "a") #t)) + (expect "one put in front" (names) '("item z" "item c" "item b" "item a")) + (expect "the others kept" (list (eq? (at-row 1) c) (eq? (at-row 3) a)) '(#t #t)) + + (app-dispatch! lst (items '("z" "b" "a") #t)) + (expect "one taken out" (names) '("item z" "item b" "item a")) + (expect "the rest kept" (list (eq? (at-row 1) b) (eq? (at-row 2) a)) '(#t #t)) + + (app-dispatch! lst (items '("a" "a" "b") #t)) + (expect "a key twice" (names) '("item a" "item a" "item b")) + (expect "the first keeps the control" (eq? (at-row 0) a) #t) + + ;; With no keys, children are matched by place: the first control now + ;; shows what the new first item is. + (app-dispatch! lst (items '("a" "b") #f)) + (def first (at-row 0)) + (app-dispatch! lst (items '("y" "a" "b") #f)) + (expect "unkeyed, by place" (names) '("item y" "item a" "item b")) + (expect "the first control shows the new first" (eq? (at-row 0) first) #t) + + ;; --- the other controls ----------------------------------------------------- + (def app (start-app (Model (notes "") (level 2.0) (choice 1) (scrolled #f)) + gui-update view (fun (c) unit))) + (defun (ctl i) (app-control-at app (list i))) + + (def area (cast TextBox (ctl 0))) + (expect "a text area takes Enter" (accepts-return? area) #t) + (box-text! area "one\ntwo") + (expect "a text area sends its text" (.notes (app-model app)) "one\ntwo") + + (def slide (cast RangeBase (ctl 1))) + (expect "a slider's value" (range-value slide) 2.0) + (expect "a slider's bounds" (range-maximum slide) 10.0) + (ignore (set-value (cast AvaloniaObject slide) (cast AvaloniaProperty range-value-property) + (cast Object 7.0) Priority.LocalValue)) + (expect "a slider sends where it is" (.level (app-model app)) 7.0) + (expect "a progress bar follows" (range-value (cast RangeBase (ctl 2))) 0.7) + + (def drop (cast SelectingItemsControl (ctl 3))) + (expect "a dropdown's items" (item-count (cast ItemsControl drop)) 3) + (expect "a dropdown's choice" (selected-index drop) 1) + (ignore (set-value (cast AvaloniaObject drop) (cast AvaloniaProperty selected-index-property) + (cast Object 2) Priority.LocalValue)) + (expect "a dropdown sends the choice" (.choice (app-model app)) 2) + + (def g (cast Grid (ctl 4))) + (expect "a grid's columns" (.-Count (grid-columns g)) 2) + (expect "a cell" (list (grid-row (app-control-at app '(4 2))) (grid-column (app-control-at app '(4 2)))) + '(1 1)) + (expect "the cell shows the model" (block-text (cast TextBlock (app-control-at app '(4 2)))) "one\ntwo") + + (def sc (cast ContentControl (ctl 5))) + (def inner (app-control-at app '(5 0))) + (expect "a scroll holds its child" (eq? (scroll-content sc) (cast Object inner)) #t) + (app-dispatch! app (Show #t)) + (expect "a child of another kind replaces it" + (eq? (scroll-content sc) (cast Object (app-control-at app '(5 0)))) #t) + (expect "and is not the old one" (eq? (app-control-at app '(5 0)) inner) #f) + + (expect "an image that cannot be read shows nothing" + (null? (cast Object (image-source (cast Image (ctl 6)))) (clr-default)) #t) + + (println "bjogui controls ok"))