List boxes, tabs, colours and borders
A list box's items and a tab control's tabs are views, patched by key as a column's children are: Panel.Children and ItemsControl.Items are both an IList, so one patch serves both. A list can choose an item only once its items are there, so the choice is set after the children. A routed event bubbles, so each handler now takes only its own control's events. Before, a dropdown in a list item would have been heard as the list's choice too. paint gives any view a text and a background colour, and border a frame. A colour that cannot be read leaves the theme's. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent <git@eca.dev>
This commit is contained in:
parent
95b6707cc1
commit
e773bc424e
4 changed files with 432 additions and 36 deletions
38
Readme.org
38
Readme.org
|
|
@ -58,9 +58,12 @@ being changed, and they are dropped, so only the user's events are messages.
|
|||
| ~(progress-bar value)~ | ~ProgressBar~ | nothing |
|
||||
| ~(dropdown options selected on-select)~ | ~ComboBox~ | ~(on-select index)~ |
|
||||
| ~(image path)~ | ~Image~ | nothing |
|
||||
| ~(list-box views selected on-select)~ | ~ListBox~ | ~(on-select index)~ |
|
||||
| ~(tabs selected on-select (tab header view) ...)~ | ~TabControl~ | ~(on-select index)~ |
|
||||
| ~(column child ...)~, ~(row child ...)~ | ~StackPanel~ | nothing |
|
||||
| ~(grid #:columns #:rows child ...)~ | ~Grid~ | nothing |
|
||||
| ~(scroll child)~ | ~ScrollViewer~ | nothing |
|
||||
| ~(border child)~ | ~Border~ | nothing |
|
||||
|
||||
They take keywords where they apply: ~#:size~ (the font size of a text),
|
||||
~#:wrap~ (a text breaks its lines at its width), ~#:width~, ~#:height~,
|
||||
|
|
@ -86,6 +89,35 @@ number is pixels. ~(at row column view)~ puts a view in a cell, counting from
|
|||
|
||||
An image that cannot be read shows nothing.
|
||||
|
||||
A list box's items are views, so an item can be anything: a text, a row with
|
||||
a checkbox, a dropdown. Give them keys if the list can change order. Each
|
||||
item is a control, so a list of thousands makes thousands of controls.
|
||||
|
||||
#+BEGIN_SRC scheme
|
||||
(tabs (.tab m) Tab
|
||||
(tab "Todo" (list-box (vec-map (fun (t) (keyed (.id t) (text (.title t)))) (.todos m))
|
||||
(.chosen m) Chose))
|
||||
(tab "Settings" (checkbox "Dark" (.dark m) Dark)))
|
||||
#+END_SRC
|
||||
|
||||
* Colours and borders
|
||||
|
||||
~(paint view #:colour #:background)~ colours any view: ~#:colour~ is the
|
||||
text, ~#:background~ what is behind it. A colour is a name such as ~"red"~,
|
||||
or ~"#rgb"~, ~"#rrggbb"~ or ~"#aarrggbb"~. The empty string, the default,
|
||||
leaves the colour to the theme, and so does a colour that cannot be read.
|
||||
|
||||
~(border child #:colour #:thickness #:radius #:background #:padding)~ draws
|
||||
a line around a view, with round corners if ~#:radius~ is more than zero.
|
||||
|
||||
#+BEGIN_SRC scheme
|
||||
(border (paint (text "Saved") #:colour "#c0392b")
|
||||
#:colour "#2980b9" #:radius 8.0 #:background "#ecf0f1" #:padding 8.0)
|
||||
#+END_SRC
|
||||
|
||||
The Fluent theme gives a button its own colours when the pointer is over it
|
||||
or it is pressed, so a painted button shows the theme's colour then.
|
||||
|
||||
* Work: commands and subscriptions
|
||||
|
||||
~gui-update~ is a plain function, so it cannot wait, and the compiler says so
|
||||
|
|
@ -154,13 +186,15 @@ cancelled, and the program ends.
|
|||
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 tests/lists.bjo # prints "bjogui lists ok"
|
||||
bjo run examples/counter.bjo
|
||||
bjo run examples/stopwatch.bjo
|
||||
#+END_SRC
|
||||
|
||||
* Not yet
|
||||
|
||||
- A list box with a selection, tabs, menus and dialogs.
|
||||
- Colours, borders and styles of one's own.
|
||||
- Menus and dialogs.
|
||||
- Styles of one's own, with classes, and colours for the pointer-over and
|
||||
pressed states.
|
||||
- A moved control is taken out of the panel and put back, so it may lose the
|
||||
keyboard focus.
|
||||
|
|
|
|||
202
src/app.bjo
202
src/app.bjo
|
|
@ -71,6 +71,16 @@
|
|||
(Image (: Avalonia.Controls.Image (-> Image)))
|
||||
(Bitmap (: Avalonia.Media.Imaging.Bitmap (-> string Bitmap)))
|
||||
(TextWrapping (: Avalonia.Media.TextWrapping))
|
||||
(IBrush (: Avalonia.Media.IBrush))
|
||||
(CornerRadius (: Avalonia.CornerRadius (-> double CornerRadius)))
|
||||
(ListBox (: Avalonia.Controls.ListBox (-> ListBox)))
|
||||
(TabControl (: Avalonia.Controls.TabControl (-> TabControl)))
|
||||
(TabItem (: Avalonia.Controls.TabItem (-> TabItem)))
|
||||
(Border (: Avalonia.Controls.Border (-> Border)))
|
||||
(ItemsControl (: Avalonia.Controls.ItemsControl))
|
||||
(ItemCollection (: Avalonia.Controls.ItemCollection))
|
||||
(IList (: System.Collections.IList))
|
||||
(ICollection (: System.Collections.ICollection))
|
||||
(Controls (: Avalonia.Controls.Controls))
|
||||
(Panel (: Avalonia.Controls.Panel))
|
||||
(StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel)))
|
||||
|
|
@ -133,6 +143,19 @@
|
|||
(grid-column-span-property (: Avalonia.Controls.Grid.ColumnSpanProperty #:get))
|
||||
(grid-row-spacing-property (: Avalonia.Controls.Grid.RowSpacingProperty #:get))
|
||||
(grid-column-spacing-property (: Avalonia.Controls.Grid.ColumnSpacingProperty #:get))
|
||||
(header-property (: Avalonia.Controls.Primitives.HeaderedContentControl.HeaderProperty #:get))
|
||||
(text-block-background (: Avalonia.Controls.TextBlock.BackgroundProperty #:get))
|
||||
(text-block-foreground (: Avalonia.Controls.TextBlock.ForegroundProperty #:get))
|
||||
(background-property (: Avalonia.Controls.Primitives.TemplatedControl.BackgroundProperty #:get))
|
||||
(foreground-property (: Avalonia.Controls.Primitives.TemplatedControl.ForegroundProperty #:get))
|
||||
(panel-background (: Avalonia.Controls.Panel.BackgroundProperty #:get))
|
||||
(border-background (: Avalonia.Controls.Border.BackgroundProperty #:get))
|
||||
(border-brush-property (: Avalonia.Controls.Border.BorderBrushProperty #:get))
|
||||
(border-thickness-property (: Avalonia.Controls.Border.BorderThicknessProperty #:get))
|
||||
(corner-radius-property (: Avalonia.Controls.Border.CornerRadiusProperty #:get))
|
||||
(decorator-padding (: Avalonia.Controls.Decorator.PaddingProperty #:get))
|
||||
(decorator-child (: Avalonia.Controls.Decorator.ChildProperty #:get))
|
||||
(parse-brush (: Avalonia.Media.Brush.Parse (-> string IBrush)))
|
||||
|
||||
;; A grid's sizes are not Avalonia properties, so they are set as .NET
|
||||
;; properties are.
|
||||
|
|
@ -165,6 +188,17 @@
|
|||
(selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex
|
||||
(-> SelectingItemsControl int) #:get))
|
||||
(panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
|
||||
(items-of (: Avalonia.Controls.ItemsControl.Items (-> ItemsControl ItemCollection) #:get))
|
||||
(event-source (: Avalonia.Interactivity.RoutedEventArgs.Source (-> RoutedEventArgs Object) #:get))
|
||||
;; Panel.Children and ItemsControl.Items are both an IList, so one patch
|
||||
;; serves a panel's children and a list's items.
|
||||
(list-count (: System.Collections.ICollection.Count (-> ICollection int) #:get))
|
||||
(list-ref (: System.Collections.IList.get_Item (-> IList int Object)))
|
||||
(list-index-of (: System.Collections.IList.IndexOf (-> IList Object int)))
|
||||
(list-insert! (: System.Collections.IList.Insert (-> IList int Object void)))
|
||||
(list-add! (: System.Collections.IList.Add (-> IList Object int)))
|
||||
(list-remove! (: System.Collections.IList.Remove (-> IList Object void)))
|
||||
(list-remove-at! (: System.Collections.IList.RemoveAt (-> IList int void)))
|
||||
(content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set))
|
||||
(clr-string (: System.Convert.ToString (-> string ClrString)))
|
||||
|
||||
|
|
@ -219,8 +253,35 @@
|
|||
(ColumnKind #f)
|
||||
(RowKind #f)
|
||||
(GridKind #f)
|
||||
(BorderKind #f)
|
||||
(_ #t)))
|
||||
|
||||
;; A kind whose children are the items of an Avalonia ItemsControl.
|
||||
(: (-> Kind bool))
|
||||
(defun (items? kind)
|
||||
(match kind
|
||||
(ListBoxKind #t)
|
||||
(TabsKind #t)
|
||||
(_ #f)))
|
||||
|
||||
;; A kind with one child, which is its content.
|
||||
(: (-> Kind bool))
|
||||
(defun (single? kind)
|
||||
(match kind
|
||||
(ScrollKind #t)
|
||||
(TabKind #t)
|
||||
(BorderKind #t)
|
||||
(_ #f)))
|
||||
|
||||
;; A kind that chooses one of its items or options.
|
||||
(: (-> Kind bool))
|
||||
(defun (selecting? kind)
|
||||
(match kind
|
||||
(DropdownKind #t)
|
||||
(ListBoxKind #t)
|
||||
(TabsKind #t)
|
||||
(_ #f)))
|
||||
|
||||
(: (-> Kind bool))
|
||||
(defun (text-box? kind)
|
||||
(match kind
|
||||
|
|
@ -247,6 +308,7 @@
|
|||
(TextKind (Some (cast AvaloniaProperty text-block-text)))
|
||||
(ButtonKind (Some (cast AvaloniaProperty content-property)))
|
||||
(CheckBoxKind (Some (cast AvaloniaProperty content-property)))
|
||||
(TabKind (Some (cast AvaloniaProperty header-property)))
|
||||
(_ None)))
|
||||
((Value _) (when-kind (text-box? kind) (cast AvaloniaProperty text-box-text)))
|
||||
((Placeholder _) (when-kind (text-box? kind) (cast AvaloniaProperty watermark-property)))
|
||||
|
|
@ -259,7 +321,10 @@
|
|||
((Width _) (Some (cast AvaloniaProperty width-property)))
|
||||
((Height _) (Some (cast AvaloniaProperty height-property)))
|
||||
((Margin _) (Some (cast AvaloniaProperty margin-property)))
|
||||
((Padding _) (when-kind (templated? kind) (cast AvaloniaProperty padding-property)))
|
||||
((Padding _)
|
||||
(cond ((= kind BorderKind) (Some (cast AvaloniaProperty decorator-padding)))
|
||||
((templated? kind) (Some (cast AvaloniaProperty padding-property)))
|
||||
(else None)))
|
||||
((Spacing _) (when-kind (stack? kind) (cast AvaloniaProperty spacing-property)))
|
||||
((Wrap _) (when-kind (= kind TextKind) (cast AvaloniaProperty text-block-wrapping)))
|
||||
((Minimum _) (when-kind (range? kind) (cast AvaloniaProperty minimum-property)))
|
||||
|
|
@ -267,11 +332,24 @@
|
|||
((Amount _) (when-kind (range? kind) (cast AvaloniaProperty value-property)))
|
||||
((Step _) (when-kind (= kind SliderKind) (cast AvaloniaProperty small-change-property)))
|
||||
((Items _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty items-source-property)))
|
||||
((Selected _) (when-kind (= kind DropdownKind) (cast AvaloniaProperty selected-index-property)))
|
||||
((Selected _) (when-kind (selecting? kind) (cast AvaloniaProperty selected-index-property)))
|
||||
((Row _) (Some (cast AvaloniaProperty grid-row-property)))
|
||||
((Column _) (Some (cast AvaloniaProperty grid-column-property)))
|
||||
((RowSpan _) (Some (cast AvaloniaProperty grid-row-span-property)))
|
||||
((ColumnSpan _) (Some (cast AvaloniaProperty grid-column-span-property)))
|
||||
((Background _)
|
||||
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-background)))
|
||||
((= kind BorderKind) (Some (cast AvaloniaProperty border-background)))
|
||||
((panel? kind) (Some (cast AvaloniaProperty panel-background)))
|
||||
((templated? kind) (Some (cast AvaloniaProperty background-property)))
|
||||
(else None)))
|
||||
((Foreground _)
|
||||
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-foreground)))
|
||||
((templated? kind) (Some (cast AvaloniaProperty foreground-property)))
|
||||
(else None)))
|
||||
((BorderColour _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-brush-property)))
|
||||
((BorderWidth _) (when-kind (= kind BorderKind) (cast AvaloniaProperty border-thickness-property)))
|
||||
((Radius _) (when-kind (= kind BorderKind) (cast AvaloniaProperty corner-radius-property)))
|
||||
;; Set by `set-prop!` itself.
|
||||
((Source _) None)
|
||||
((Columns _) None)
|
||||
|
|
@ -284,9 +362,26 @@
|
|||
(: (-> string ClrString))
|
||||
(defun (->clr-string s) (clr-string s))
|
||||
|
||||
;; The value of a prop, as the object `SetValue` takes.
|
||||
(: (-> Prop Object))
|
||||
;; A colour, as Avalonia reads one. None for one it cannot read.
|
||||
(: (-> string (Option Object)))
|
||||
(defun (brush s)
|
||||
(match (try (parse-brush s) #:catch (System.Exception))
|
||||
((Ok b) (Some (cast Object b)))
|
||||
((Err _) None)))
|
||||
|
||||
;; The value of a prop, as the object `SetValue` takes. None for a value that
|
||||
;; cannot be one, such as a colour that cannot be read: the property is then
|
||||
;; cleared, and the theme's value shows.
|
||||
(: (-> Prop (Option Object)))
|
||||
(defun (boxed p)
|
||||
(match p
|
||||
((Background s) (brush s))
|
||||
((Foreground s) (brush s))
|
||||
((BorderColour s) (brush s))
|
||||
(_ (Some (plain p)))))
|
||||
|
||||
(: (-> Prop Object))
|
||||
(defun (plain p)
|
||||
(defun (text s) (cast Object (->clr-string s)))
|
||||
(match p
|
||||
((Label s) (text s))
|
||||
|
|
@ -314,7 +409,12 @@
|
|||
((ColumnSpan i) (cast Object i))
|
||||
((Source s) (text s))
|
||||
((Columns s) (text s))
|
||||
((Rows s) (text s))))
|
||||
((Rows s) (text s))
|
||||
((Background s) (text s))
|
||||
((Foreground s) (text s))
|
||||
((BorderColour s) (text s))
|
||||
((BorderWidth d) (cast Object (Thickness. d)))
|
||||
((Radius d) (cast Object (CornerRadius. d)))))
|
||||
|
||||
;; Which prop it is, without its value. Two props with one tag set the same
|
||||
;; property.
|
||||
|
|
@ -326,7 +426,9 @@
|
|||
((Margin _) 8) ((Padding _) 9) ((Spacing _) 10) ((Wrap _) 11)
|
||||
((Minimum _) 12) ((Maximum _) 13) ((Amount _) 14) ((Step _) 15)
|
||||
((Items _) 16) ((Selected _) 17) ((Source _) 18) ((Columns _) 19)
|
||||
((Rows _) 20) ((Row _) 21) ((Column _) 22) ((RowSpan _) 23) ((ColumnSpan _) 24)))
|
||||
((Rows _) 20) ((Row _) 21) ((Column _) 22) ((RowSpan _) 23) ((ColumnSpan _) 24)
|
||||
((Background _) 25) ((Foreground _) 26) ((BorderColour _) 27) ((BorderWidth _) 28)
|
||||
((Radius _) 29)))
|
||||
|
||||
(: (-> Control AvaloniaProperty Object void))
|
||||
(defun (put! control property value)
|
||||
|
|
@ -353,7 +455,10 @@
|
|||
(put! control (cast AvaloniaProperty grid-column-spacing-property) (cast Object d)))
|
||||
(_
|
||||
(match (slot kind p)
|
||||
((Some property) (put! control property (boxed p)))
|
||||
((Some property)
|
||||
(match (boxed p)
|
||||
((Some value) (put! control property value))
|
||||
(None (clear-value (cast AvaloniaObject control) property))))
|
||||
(None unit)))))
|
||||
|
||||
(: (-> Control Kind Prop void))
|
||||
|
|
@ -603,8 +708,13 @@
|
|||
(: (-> (App %model %m) (Live %m) Kind void))
|
||||
(defun (listen! app live kind)
|
||||
(def control (.control live))
|
||||
;; Only the control's own events: a routed event bubbles, so a list's
|
||||
;; handler would hear the selection of a dropdown in one of its items too.
|
||||
(defun (on-event (: event RoutedEvent) pick)
|
||||
(on! control event (fun (sender e) (fire! app live (pick)))))
|
||||
(on! control event
|
||||
(fun (sender e)
|
||||
(when (eq? (event-source e) (cast Object control))
|
||||
(fire! app live (pick))))))
|
||||
(match kind
|
||||
(ButtonKind
|
||||
(on-event (cast RoutedEvent click-event)
|
||||
|
|
@ -624,7 +734,7 @@
|
|||
(fun ()
|
||||
(def d (range-value (cast RangeBase control)))
|
||||
(fun (on) (match on ((Slide f) (Some (f d))) (_ None))))))
|
||||
(DropdownKind
|
||||
((or DropdownKind ListBoxKind TabsKind)
|
||||
(on-event (cast RoutedEvent selection-changed-event)
|
||||
(fun ()
|
||||
(def i (selected-index (cast SelectingItemsControl control)))
|
||||
|
|
@ -665,14 +775,45 @@
|
|||
(put! panel (cast AvaloniaProperty orientation-property) (cast Object Orientation.Horizontal))
|
||||
panel)
|
||||
(GridKind (cast Control (Grid.)))
|
||||
(ScrollKind (cast Control (ScrollViewer.)))))
|
||||
(ScrollKind (cast Control (ScrollViewer.)))
|
||||
(ListBoxKind (cast Control (ListBox.)))
|
||||
(TabsKind (cast Control (TabControl.)))
|
||||
(TabKind (cast Control (TabItem.)))
|
||||
(BorderKind (cast Control (Border.)))))
|
||||
|
||||
;; Where the controls of a panel's children, or of a list's items, are.
|
||||
(: (-> Kind Control IList))
|
||||
(defun (child-list kind parent)
|
||||
(if (items? kind)
|
||||
(cast IList (items-of (cast ItemsControl parent)))
|
||||
(cast IList (panel-children (cast Panel parent)))))
|
||||
|
||||
;; Makes `child` the one child of a scroll, a tab or a border.
|
||||
(: (-> Kind Control Control void))
|
||||
(defun (set-single! kind parent child)
|
||||
(if (= kind BorderKind)
|
||||
(put! parent (cast AvaloniaProperty decorator-child) (cast Object child))
|
||||
(content! (cast ContentControl parent) (cast Object child))))
|
||||
|
||||
;; Puts a child's control in its parent's, as the last one.
|
||||
(: (-> Kind Control Control void))
|
||||
(defun (adopt! kind parent child)
|
||||
(if (= kind ScrollKind)
|
||||
(content! (cast ContentControl parent) (cast Object child))
|
||||
(.Add (panel-children (cast Panel parent)) child)))
|
||||
(if (single? kind)
|
||||
(set-single! kind parent child)
|
||||
(ignore (list-add! (child-list kind parent) (cast Object child)))))
|
||||
|
||||
;; A list or tabs can choose an item only once the items are there, so the
|
||||
;; choice is set again after the children. A dropdown whose items changed
|
||||
;; may have dropped its choice, so it is set again too.
|
||||
(: (-> Control Kind (Vec Prop) void))
|
||||
(defun (sync-selection! control kind props)
|
||||
(when (selecting? kind)
|
||||
(loop (:for p props)
|
||||
(:do (match p
|
||||
((Selected i)
|
||||
(unless (= (selected-index (cast SelectingItemsControl control)) i)
|
||||
(put! control (cast AvaloniaProperty selected-index-property) (cast Object i))))
|
||||
(_ unit))))))
|
||||
|
||||
;; Makes the controls for a view.
|
||||
(: (-> (App %model %m) (View %m) (Live %m)))
|
||||
|
|
@ -686,6 +827,7 @@
|
|||
(:do (def c (mount app child))
|
||||
(mutablevec-add! (.children live) c)
|
||||
(adopt! kind control (.control c))))
|
||||
(sync-selection! control kind (view-props v))
|
||||
live)
|
||||
|
||||
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
|
||||
|
|
@ -699,20 +841,21 @@
|
|||
(begin
|
||||
(patch-props! (.control live) kind (view-props old) (view-props next))
|
||||
(record-set! live (view next))
|
||||
(cond ((panel? kind) (patch-children! app live (view-children next)))
|
||||
((= kind ScrollKind) (patch-content! app live (view-children next)))
|
||||
(cond ((single? kind) (patch-single! app live kind (view-children next)))
|
||||
((or (panel? kind) (items? kind)) (patch-children! app live kind (view-children next)))
|
||||
(else unit))
|
||||
(sync-selection! (.control live) kind (view-props next))
|
||||
live)))
|
||||
|
||||
;; A scroll's one child is its content.
|
||||
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
|
||||
(defun (patch-content! app live views)
|
||||
;; The one child of a scroll, a tab or a border.
|
||||
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
|
||||
(defun (patch-single! app live kind views)
|
||||
(def kids (.children live))
|
||||
(def was (mutablevec-ref kids 0))
|
||||
(def now (patch! app was (vec-ref views 0)))
|
||||
(unless (eq? now was)
|
||||
(mutablevec-set! kids 0 now)
|
||||
(content! (cast ContentControl (.control live)) (cast Object (.control now)))))
|
||||
(set-single! kind (.control live) (.control now))))
|
||||
|
||||
;; Which child each view is: its key, or its place among the children that
|
||||
;; have none. The two kinds cannot be mistaken for each other.
|
||||
|
|
@ -731,10 +874,10 @@
|
|||
;; its control, and is changed to the next view. The others are made new,
|
||||
;; and those left over are removed. Then the controls are put in the order
|
||||
;; of the next view, moving only those that are out of place.
|
||||
(: (-> (App %model %m) (Live %m) (Vec (View %m)) void))
|
||||
(defun (patch-children! app live views)
|
||||
(: (-> (App %model %m) (Live %m) Kind (Vec (View %m)) void))
|
||||
(defun (patch-children! app live kind views)
|
||||
(def kids (.children live))
|
||||
(def controls (panel-children (cast Panel (.control live))))
|
||||
(def controls (child-list kind (.control live)))
|
||||
(def olds (mutablevec->vec kids))
|
||||
(def old-ids (identities (vec-map (fun (l) (.view l)) olds)))
|
||||
(def new-ids (identities views))
|
||||
|
|
@ -761,15 +904,16 @@
|
|||
|
||||
(loop (:for (Tuple i was) (enumerate olds))
|
||||
(:when (not (array-ref kept i)))
|
||||
(:do (ignore (.Remove controls (.control was)))))
|
||||
(:do (list-remove! controls (cast Object (.control was)))))
|
||||
|
||||
;; A control out of place is taken out and put back where it belongs.
|
||||
(loop (:for (Tuple j now) (enumerate (mutablevec->vec nexts)))
|
||||
(:do (def c (.control now))
|
||||
(unless (and (< j (.-Count controls)) (eq? (.get_Item controls j) c))
|
||||
(def at (.IndexOf controls c))
|
||||
(if (>= at 0)
|
||||
(.Move controls at j)
|
||||
(.Insert controls j c)))))
|
||||
(:do (def c (cast Object (.control now)))
|
||||
(unless (and (< j (list-count (cast ICollection controls)))
|
||||
(eq? (list-ref controls j) c))
|
||||
(def at (list-index-of controls c))
|
||||
(when (>= at 0) (list-remove-at! controls at))
|
||||
(list-insert! controls j c))))
|
||||
|
||||
(mutablevec-clear! kids)
|
||||
(loop (:for now (mutablevec->vec nexts)) (:do (mutablevec-add! kids now))))
|
||||
|
|
|
|||
69
src/view.bjo
69
src/view.bjo
|
|
@ -19,9 +19,10 @@
|
|||
|
||||
;; Constructors.
|
||||
text button text-input text-area checkbox slider progress-bar dropdown image
|
||||
column row grid scroll
|
||||
list-box tabs tab
|
||||
column row grid scroll border
|
||||
;; Wrappers.
|
||||
keyed at
|
||||
keyed at paint
|
||||
|
||||
;; Reading one.
|
||||
view-kind view-props view-events view-children view-key)
|
||||
|
|
@ -35,7 +36,8 @@
|
|||
;; What control a view is.
|
||||
(type (: Kind (Union TextKind ButtonKind TextInputKind TextAreaKind CheckBoxKind
|
||||
SliderKind ProgressKind DropdownKind ImageKind
|
||||
ColumnKind RowKind GridKind ScrollKind)))
|
||||
ListBoxKind TabsKind TabKind
|
||||
ColumnKind RowKind GridKind ScrollKind BorderKind)))
|
||||
|
||||
;; A property of a control. A kind takes only some of them; the app ignores
|
||||
;; the others.
|
||||
|
|
@ -56,14 +58,19 @@
|
|||
(: Amount double) ; where a slider or a progress bar is
|
||||
(: Step double) ; what an arrow key moves a slider by
|
||||
(: Items (Vec string)) ; what a dropdown offers
|
||||
(: Selected int) ; which of them is chosen; -1 for none
|
||||
(: Selected int) ; which item is chosen; -1 for none
|
||||
(: Source string) ; the file an image shows
|
||||
(: Columns string) ; a grid's columns, as "Auto,*,2*"
|
||||
(: Rows string)
|
||||
(: Row int) ; where a view is in its grid
|
||||
(: Column int)
|
||||
(: RowSpan int)
|
||||
(: ColumnSpan int))))
|
||||
(: ColumnSpan int)
|
||||
(: Background string) ; a colour: "red", "#08f", "#80ff8800"
|
||||
(: Foreground string) ; the colour of the text
|
||||
(: BorderColour string)
|
||||
(: BorderWidth double)
|
||||
(: Radius double)))) ; how round a border's corners are
|
||||
|
||||
;; An event, and the message it sends.
|
||||
(type (: (On %m) (Union (: Click %m)
|
||||
|
|
@ -109,6 +116,14 @@
|
|||
(defun (keyed key v)
|
||||
(record-set v (key (Some key))))
|
||||
|
||||
;; The view, in colours. A colour is a name, such as "red", or "#rgb",
|
||||
;; "#rrggbb" or "#aarrggbb". The empty string, the default, leaves the colour
|
||||
;; to the theme, and so does a colour that cannot be read.
|
||||
(: paint (-> (View %m) (#:colour string) (#:background string) (View %m)))
|
||||
(defun (paint v #:colour "" #:background "")
|
||||
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c))))
|
||||
(record-set v (props (with (with (.props v) Foreground colour) Background background))))
|
||||
|
||||
;; The view, in a cell of its grid. Rows and columns count from 0.
|
||||
(: at (-> int int (View %m) (#:row-span int) (#:column-span int) (View %m)))
|
||||
(defun (at row column v #:row-span 1 #:column-span 1)
|
||||
|
|
@ -219,6 +234,33 @@
|
|||
(defun (image path #:width 0.0 #:height 0.0 #:margin 0.0)
|
||||
(leaf ImageKind (with-layout [(Source path)] width height margin 0.0) []))
|
||||
|
||||
;; A list of views to choose one of, with the one at `selected` chosen, or
|
||||
;; none for -1. A choice sends `(on-select index)`. Give the items keys if
|
||||
;; the list can change order.
|
||||
(: (-> (Vec (View %m)) int (-> int %m) (#:width double) (#:height double) (#:margin double)
|
||||
(View %m)))
|
||||
(defun (list-box items selected on-select #:width 0.0 #:height 0.0 #:margin 0.0)
|
||||
(View (kind ListBoxKind)
|
||||
(props (with-layout [(Selected selected)] width height margin 0.0))
|
||||
(events [(Select on-select)])
|
||||
(children items)
|
||||
(key None)))
|
||||
|
||||
;; Tabs, with the one at `selected` shown. A click on another tab sends
|
||||
;; `(on-select index)`. Each tab is made by `tab`.
|
||||
(: (-> int (-> int %m) (#:margin double) #:rest (View %m) (View %m)))
|
||||
(defun (tabs selected on-select #:margin 0.0 #:rest tabs)
|
||||
(View (kind TabsKind)
|
||||
(props (with-layout [(Selected selected)] 0.0 0.0 margin 0.0))
|
||||
(events [(Select on-select)])
|
||||
(children (array->vec tabs))
|
||||
(key None)))
|
||||
|
||||
;; A tab of `tabs`: its header, and what it shows when it is chosen.
|
||||
(: (-> string (View %m) (View %m)))
|
||||
(defun (tab header content)
|
||||
(View (kind TabKind) (props [(Label header)]) (events []) (children [content]) (key None)))
|
||||
|
||||
;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with
|
||||
;; the new state.
|
||||
(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m)))
|
||||
|
|
@ -258,6 +300,23 @@
|
|||
0.0 0.0 margin 0.0)
|
||||
(array->vec children)))
|
||||
|
||||
;; A view in a frame: a line of `#:colour` and `#:thickness` around it,
|
||||
;; corners as round as `#:radius`, `#:background` behind it, and `#:padding`
|
||||
;; between the line and the view.
|
||||
(: (-> (View %m) (#:colour string) (#:thickness double) (#:radius double)
|
||||
(#:background string) (#:padding double) (#:margin double)
|
||||
(View %m)))
|
||||
(defun (border child #:colour "" #:thickness 1.0 #:radius 0.0 #:background ""
|
||||
#:padding 0.0 #:margin 0.0)
|
||||
(defun (with props make c) (if (string-empty? c) props (vec-add props (make c))))
|
||||
(container BorderKind
|
||||
(with (with (with-size (with-size (with-layout [] 0.0 0.0 margin padding)
|
||||
BorderWidth thickness)
|
||||
Radius radius)
|
||||
BorderColour colour)
|
||||
Background background)
|
||||
[child]))
|
||||
|
||||
;; A view that scrolls when it is taller than the space it has.
|
||||
(: (-> (View %m) (#:width double) (#:height double) (#:margin double) (View %m)))
|
||||
(defun (scroll child #:width 0.0 #:height 0.0 #:margin 0.0)
|
||||
|
|
|
|||
159
tests/lists.bjo
Normal file
159
tests/lists.bjo
Normal file
|
|
@ -0,0 +1,159 @@
|
|||
;; 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/lists.bjo — list boxes, tabs, colours and borders.
|
||||
;;
|
||||
;; bjo run tests/lists.bjo
|
||||
;;
|
||||
;; No window is opened.
|
||||
|
||||
(import (std prelude))
|
||||
(import (std simpletest))
|
||||
(import (bjogui view))
|
||||
(import (bjogui app))
|
||||
|
||||
(import/class
|
||||
(Object (: System.Object))
|
||||
(Disposable (: System.IDisposable))
|
||||
(AvaloniaObject (: Avalonia.AvaloniaObject))
|
||||
(AvaloniaProperty (: Avalonia.AvaloniaProperty))
|
||||
(Priority (: Avalonia.Data.BindingPriority))
|
||||
(Control (: Avalonia.Controls.Control))
|
||||
(ItemsControl (: Avalonia.Controls.ItemsControl))
|
||||
(ItemCollection (: Avalonia.Controls.ItemCollection))
|
||||
(SelectingItemsControl (: Avalonia.Controls.Primitives.SelectingItemsControl))
|
||||
(Headered (: Avalonia.Controls.Primitives.HeaderedContentControl))
|
||||
(ContentControl (: Avalonia.Controls.ContentControl))
|
||||
(TextBlock (: Avalonia.Controls.TextBlock))
|
||||
(Button (: Avalonia.Controls.Primitives.TemplatedControl))
|
||||
(Border (: Avalonia.Controls.Border))
|
||||
(Decorator (: Avalonia.Controls.Decorator))
|
||||
(IBrush (: Avalonia.Media.IBrush)))
|
||||
|
||||
(import/extern
|
||||
(set-value (: Avalonia.AvaloniaObject.SetValue
|
||||
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
|
||||
(selected-index-property
|
||||
(: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndexProperty #:get))
|
||||
(items (: Avalonia.Controls.ItemsControl.Items (-> ItemsControl ItemCollection) #:get))
|
||||
(item-at (: Avalonia.Controls.ItemCollection.get_Item (-> ItemCollection int Object)))
|
||||
(item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get))
|
||||
(selected-index (: Avalonia.Controls.Primitives.SelectingItemsControl.SelectedIndex
|
||||
(-> SelectingItemsControl int) #:get))
|
||||
(header (: Avalonia.Controls.Primitives.HeaderedContentControl.Header
|
||||
(-> Headered Object) #:get))
|
||||
(content (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object) #:get))
|
||||
(block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get))
|
||||
(foreground (: Avalonia.Controls.TextBlock.Foreground (-> TextBlock IBrush) #:get))
|
||||
(background (: Avalonia.Controls.TextBlock.Background (-> TextBlock IBrush) #:get))
|
||||
(button-background (: Avalonia.Controls.Primitives.TemplatedControl.Background
|
||||
(-> Button IBrush) #:get))
|
||||
(child (: Avalonia.Controls.Decorator.Child (-> Decorator Control) #:get))
|
||||
(border-brush (: Avalonia.Controls.Border.BorderBrush (-> Border IBrush) #:get)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The program under test
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(type (: Msg (Union (: Chose int) (: Picked int) (: Tab int) Reverse (: Colour string))))
|
||||
(type (: Model (Record (: ids (List string)) (: chosen int) (: picked int) (: tab int)
|
||||
(: colour string))))
|
||||
|
||||
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||
(defun (gui-update msg m)
|
||||
(next (match msg
|
||||
((Chose i) (record-set m (chosen i)))
|
||||
((Picked i) (record-set m (picked i)))
|
||||
((Tab i) (record-set m (tab i)))
|
||||
(Reverse (record-set m (ids (list-reverse (.ids m)))))
|
||||
((Colour c) (record-set m (colour c))))))
|
||||
|
||||
(: (-> Model (View Msg)))
|
||||
(defun (view m)
|
||||
(column
|
||||
;; 0: the items are keyed texts, and one is a dropdown, whose own choice
|
||||
;; must not be taken for the list's.
|
||||
(list-box (vec-add (vec-map (fun (id) (keyed id (text #"item ${id}"))) (list->vec (.ids m)))
|
||||
(keyed "drop" (dropdown ["x" "y"] (.picked m) Picked)))
|
||||
(.chosen m) Chose)
|
||||
;; 1
|
||||
(tabs (.tab m) Tab
|
||||
(tab "One" (text "first"))
|
||||
(tab "Two" (text "second")))
|
||||
;; 2
|
||||
(paint (text "painted") #:colour (.colour m) #:background "#00ff00")
|
||||
;; 3
|
||||
(border (text "framed") #:colour "blue" #:thickness 2.0 #:radius 4.0 #:padding 3.0)
|
||||
;; 4
|
||||
(paint (button "b" Reverse) #:background "#123456")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The test
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defun (main)
|
||||
(def app (start-app (Model (ids '("a" "b" "c")) (chosen 1) (picked 0) (tab 0) (colour "red"))
|
||||
gui-update view (fun (c) unit)))
|
||||
(defun (ctl path) (app-control-at app path))
|
||||
(defun (choose! path i)
|
||||
(ignore (set-value (cast AvaloniaObject (ctl path))
|
||||
(cast AvaloniaProperty selected-index-property)
|
||||
(cast Object i) Priority.LocalValue)))
|
||||
(defun (brush b) (.ToString (cast Object b)))
|
||||
|
||||
;; --- list box ---------------------------------------------------------------
|
||||
(def lb (ctl '(0)))
|
||||
(def lb-items (items (cast ItemsControl lb)))
|
||||
(expect "a list box's items" (item-count (cast ItemsControl lb)) 4)
|
||||
(expect "an item is the view's control" (eq? (item-at lb-items 0) (cast Object (ctl '(0 0)))) #t)
|
||||
(expect "the choice is set after the items" (selected-index (cast SelectingItemsControl lb)) 1)
|
||||
(choose! '(0) 2)
|
||||
(expect "a choice is a message" (.chosen (app-model app)) 2)
|
||||
|
||||
(def a (ctl '(0 0)))
|
||||
(def c (ctl '(0 2)))
|
||||
(app-dispatch! app Reverse)
|
||||
(expect "reversed items keep their controls"
|
||||
(list (eq? (item-at lb-items 0) (cast Object c)) (eq? (item-at lb-items 2) (cast Object a)))
|
||||
'(#t #t))
|
||||
(expect "and the text" (block-text (cast TextBlock (ctl '(0 0)))) "item c")
|
||||
(expect "the choice is the model's after a move" (selected-index (cast SelectingItemsControl lb)) 2)
|
||||
|
||||
(choose! '(0 3) 1)
|
||||
(expect "a dropdown in an item sends its own message" (.picked (app-model app)) 1)
|
||||
(expect "and not the list's" (.chosen (app-model app)) 2)
|
||||
|
||||
;; --- tabs -------------------------------------------------------------------
|
||||
(def tb (ctl '(1)))
|
||||
(expect "tabs" (item-count (cast ItemsControl tb)) 2)
|
||||
(expect "a tab's header" (.ToString (header (cast Headered (ctl '(1 1))))) "Two")
|
||||
(expect "a tab's content" (eq? (content (cast ContentControl (ctl '(1 1)))) (cast Object (ctl '(1 1 0)))) #t)
|
||||
(choose! '(1) 1)
|
||||
(expect "a tab chosen is a message" (.tab (app-model app)) 1)
|
||||
(app-dispatch! app (Tab 0))
|
||||
(expect "the model chooses the tab" (selected-index (cast SelectingItemsControl tb)) 0)
|
||||
|
||||
;; --- colours ----------------------------------------------------------------
|
||||
(def painted (cast TextBlock (ctl '(2))))
|
||||
;; A text with no colour of its own: what the theme gives.
|
||||
(def plain (cast TextBlock (ctl '(3 0))))
|
||||
(expect "a colour" (brush (foreground painted)) "Red")
|
||||
(expect "a background" (brush (background painted)) "Lime")
|
||||
(app-dispatch! app (Colour "#80123456"))
|
||||
(expect "a colour with alpha" (brush (foreground painted)) "#80123456")
|
||||
(app-dispatch! app (Colour "no such colour"))
|
||||
(expect "a colour that cannot be read is the theme's"
|
||||
(brush (foreground painted)) (brush (foreground plain)))
|
||||
(app-dispatch! app (Colour "blue"))
|
||||
(expect "and back" (brush (foreground painted)) "Blue")
|
||||
(app-dispatch! app (Colour ""))
|
||||
(expect "no colour is the theme's" (brush (foreground painted)) (brush (foreground plain)))
|
||||
(expect "a button's background" (brush (button-background (cast Button (ctl '(4))))) "#ff123456")
|
||||
|
||||
;; --- border -----------------------------------------------------------------
|
||||
(def framed (ctl '(3)))
|
||||
(expect "a border holds its child" (eq? (child (cast Decorator framed)) (ctl '(3 0))) #t)
|
||||
(expect "its colour" (brush (border-brush (cast Border framed))) "Blue")
|
||||
|
||||
(println "bjogui lists ok"))
|
||||
Loading…
Add table
Add a link
Reference in a new issue