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
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