85 lines
3.6 KiB
Text
85 lines
3.6 KiB
Text
|
;; 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/tree.bjo — tree views.
|
||
|
|
;;
|
||
|
|
;; bjo run tests/tree.bjo
|
||
|
|
;;
|
||
|
|
;; No window is opened.
|
||
|
|
|
||
|
|
(import (std prelude))
|
||
|
|
(import (std simpletest))
|
||
|
|
(import (std interop))
|
||
|
|
(import (bjogui view))
|
||
|
|
(import (bjogui app))
|
||
|
|
|
||
|
|
(import/class
|
||
|
|
(Object (: System.Object))
|
||
|
|
(Disposable (: System.IDisposable))
|
||
|
|
(AvaloniaObject (: Avalonia.AvaloniaObject))
|
||
|
|
(AvaloniaProperty (: Avalonia.AvaloniaProperty))
|
||
|
|
(Priority (: Avalonia.Data.BindingPriority))
|
||
|
|
(ItemsControl (: Avalonia.Controls.ItemsControl))
|
||
|
|
(TreeView (: Avalonia.Controls.TreeView))
|
||
|
|
(TreeViewItem (: Avalonia.Controls.TreeViewItem))
|
||
|
|
(Headered (: Avalonia.Controls.Primitives.HeaderedItemsControl)))
|
||
|
|
|
||
|
|
(import/extern
|
||
|
|
(set-value (: Avalonia.AvaloniaObject.SetValue
|
||
|
|
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
|
||
|
|
(selected-property (: Avalonia.Controls.TreeView.SelectedItemProperty #:get))
|
||
|
|
(selected (: Avalonia.Controls.TreeView.SelectedItem (-> TreeView Object) #:get))
|
||
|
|
(item-count (: Avalonia.Controls.ItemsControl.ItemCount (-> ItemsControl int) #:get))
|
||
|
|
(header (: Avalonia.Controls.Primitives.HeaderedItemsControl.Header (-> Headered Object) #:get))
|
||
|
|
(expanded? (: Avalonia.Controls.TreeViewItem.IsExpanded (-> TreeViewItem bool) #:get))
|
||
|
|
(same? (: System.Object.ReferenceEquals (-> Object Object bool))))
|
||
|
|
|
||
|
|
(type (: Msg (Union (: Chose string) Reverse)))
|
||
|
|
(type (: Model (Record (: chosen string) (: fruit (List string)))))
|
||
|
|
|
||
|
|
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||
|
|
(defun (gui-update msg m)
|
||
|
|
(next (match msg
|
||
|
|
((Chose k) (record-set m (chosen k)))
|
||
|
|
(Reverse (record-set m (fruit (list-reverse (.fruit m))))))))
|
||
|
|
|
||
|
|
(: (-> Model (View Msg)))
|
||
|
|
(defun (view m)
|
||
|
|
(tree-view (.chosen m) Chose
|
||
|
|
(apply tree-node "fruit" "Fruit" #:expanded #t
|
||
|
|
(vec->array (vec-map (fun (f) (tree-node f (string-upcase f))) (list->vec (.fruit m)))))
|
||
|
|
(tree-node "veg" "Vegetables"
|
||
|
|
(tree-node "kale" "KALE"))))
|
||
|
|
|
||
|
|
(defun (main)
|
||
|
|
(def app (start-app (Model (chosen "pear") (fruit '("apple" "pear")))
|
||
|
|
gui-update view (fun (c) unit)))
|
||
|
|
(defun (ctl path) (app-control-at app path))
|
||
|
|
(def tree (cast TreeView (ctl '())))
|
||
|
|
(defun (chosen-is? path) (same? (selected tree) (cast Object (ctl path))))
|
||
|
|
|
||
|
|
(expect "the top nodes" (item-count (cast ItemsControl tree)) 2)
|
||
|
|
(expect "a node's nodes" (item-count (cast ItemsControl (ctl '(0)))) 2)
|
||
|
|
(expect "a header" (.ToString (header (cast Headered (ctl '(0 1))))) "PEAR")
|
||
|
|
(expect "open at first" (expanded? (cast TreeViewItem (ctl '(0)))) #t)
|
||
|
|
(expect "closed at first" (expanded? (cast TreeViewItem (ctl '(1)))) #f)
|
||
|
|
(expect "the chosen node is chosen once the nodes are there" (chosen-is? '(0 1)) #t)
|
||
|
|
|
||
|
|
(ignore (set-value (cast AvaloniaObject tree) (cast AvaloniaProperty selected-property)
|
||
|
|
(cast Object (ctl '(1 0))) Priority.LocalValue))
|
||
|
|
(expect "a node chosen sends its key" (.chosen (app-model app)) "kale")
|
||
|
|
|
||
|
|
(app-dispatch! app (Chose "apple"))
|
||
|
|
(expect "the model chooses the node" (chosen-is? '(0 0)) #t)
|
||
|
|
|
||
|
|
(def apple (ctl '(0 0)))
|
||
|
|
(app-dispatch! app Reverse)
|
||
|
|
(expect "nodes moved by key keep their controls" (same? (cast Object (ctl '(0 1))) (cast Object apple)) #t)
|
||
|
|
(expect "and the choice" (chosen-is? '(0 1)) #t)
|
||
|
|
|
||
|
|
(app-dispatch! app (Chose ""))
|
||
|
|
(expect "no choice" (same? (selected tree) (clr-default)) #t)
|
||
|
|
|
||
|
|
(println "bjogui tree ok"))
|