Linus Björnstam
e773bc424e
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>
323 lines
14 KiB
Text
323 lines
14 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/src/view.bjo — the module (bjogui view).
|
|
;;
|
|
;; A view is a value: what the window shows for one model. `view` functions
|
|
;; build it with the constructors here, and (bjogui app) makes the controls
|
|
;; for it and changes them when the next view differs. Nothing here knows
|
|
;; about Avalonia, so a view can be built and compared in a test with no
|
|
;; window.
|
|
;;
|
|
;; An event is a message, or a function that makes one from what the control
|
|
;; holds. The app gives the message to `update`.
|
|
|
|
(export
|
|
;; Types.
|
|
View Kind Prop On
|
|
|
|
;; Constructors.
|
|
text button text-input text-area checkbox slider progress-bar dropdown image
|
|
list-box tabs tab
|
|
column row grid scroll border
|
|
;; Wrappers.
|
|
keyed at paint
|
|
|
|
;; Reading one.
|
|
view-kind view-props view-events view-children view-key)
|
|
|
|
(import (std prelude))
|
|
|
|
;; ---------------------------------------------------------------------------
|
|
;; The types
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
;; What control a view is.
|
|
(type (: Kind (Union TextKind ButtonKind TextInputKind TextAreaKind CheckBoxKind
|
|
SliderKind ProgressKind DropdownKind ImageKind
|
|
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.
|
|
(type (: Prop (Union (: Label string) ; the text of a text, a button or a checkbox
|
|
(: Value string) ; the text in a text input
|
|
(: Placeholder string) ; shown in an empty text input
|
|
(: Checked bool)
|
|
(: Enabled bool)
|
|
(: FontSize double)
|
|
(: Width double)
|
|
(: Height double)
|
|
(: Margin double)
|
|
(: Padding double)
|
|
(: Spacing double)
|
|
(: Wrap bool) ; a text breaks its lines at the width
|
|
(: Minimum double) ; of a slider or a progress bar
|
|
(: Maximum double)
|
|
(: Amount double) ; where a slider or a progress bar is
|
|
(: Step double) ; what an arrow key moves a slider by
|
|
(: Items (Vec string)) ; what a dropdown offers
|
|
(: Selected int) ; which item is chosen; -1 for none
|
|
(: Source string) ; the file an image shows
|
|
(: Columns string) ; a grid's columns, as "Auto,*,2*"
|
|
(: Rows string)
|
|
(: Row int) ; where a view is in its grid
|
|
(: Column int)
|
|
(: RowSpan int)
|
|
(: ColumnSpan int)
|
|
(: Background string) ; a colour: "red", "#08f", "#80ff8800"
|
|
(: Foreground string) ; the colour of the text
|
|
(: BorderColour string)
|
|
(: BorderWidth double)
|
|
(: Radius double)))) ; how round a border's corners are
|
|
|
|
;; An event, and the message it sends.
|
|
(type (: (On %m) (Union (: Click %m)
|
|
(: Input (-> string %m))
|
|
(: Toggle (-> bool %m))
|
|
(: Slide (-> double %m))
|
|
(: Select (-> int %m)))))
|
|
|
|
;; 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)))
|
|
(: key (Option string)))))
|
|
|
|
(: view-kind (-> (View %m) Kind))
|
|
(defun (view-kind v) (.kind v))
|
|
|
|
(: view-props (-> (View %m) (Vec Prop)))
|
|
(defun (view-props v) (.props v))
|
|
|
|
(: view-events (-> (View %m) (Vec (On %m))))
|
|
(defun (view-events v) (.events v))
|
|
|
|
(: 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 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)
|
|
(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
|
|
;; ---------------------------------------------------------------------------
|
|
|
|
;; A size of zero or less means: the size the control asks for. The
|
|
;; constructors leave such a size out of the props, so the control keeps its
|
|
;; own.
|
|
(: (-> (Vec Prop) (-> double Prop) double (Vec Prop)))
|
|
(defun (with-size props make size)
|
|
(if (> size 0.0) (vec-add props (make size)) props))
|
|
|
|
(: (-> (Vec Prop) double double double double (Vec Prop)))
|
|
(defun (with-layout props width height margin padding)
|
|
(with-size (with-size (with-size (with-size props Width width) Height height)
|
|
Margin margin)
|
|
Padding padding))
|
|
|
|
(: (-> Kind (Vec Prop) (Vec (On %m)) (View %m)))
|
|
(defun (leaf kind props events)
|
|
(View (kind kind) (props props) (events events) (children []) (key None)))
|
|
|
|
;; A text.
|
|
(: (-> string (#:size double) (#:wrap bool) (#:width double) (#:height double)
|
|
(#:margin double)
|
|
(View %m)))
|
|
(defun (text s #:size 0.0 #:wrap #f #:width 0.0 #:height 0.0 #:margin 0.0)
|
|
(leaf TextKind
|
|
(with-layout (with-size [(Label s) (Wrap wrap)] FontSize size) width height margin 0.0)
|
|
[]))
|
|
|
|
;; A button that sends `msg` when it is clicked.
|
|
(: (-> string %m (#:enabled bool) (#:width double) (#:height double)
|
|
(#:margin double) (#:padding double)
|
|
(View %m)))
|
|
(defun (button label msg #:enabled #t #:width 0.0 #:height 0.0 #:margin 0.0 #:padding 0.0)
|
|
(leaf ButtonKind
|
|
(with-layout [(Label label) (Enabled enabled)] width height margin padding)
|
|
[(Click msg)]))
|
|
|
|
;; A one-line text input that holds `value`. Each change sends `(on-input
|
|
;; text)`, with the whole text.
|
|
(: (-> string (-> string %m) (#:placeholder string) (#:enabled bool)
|
|
(#:width double) (#:margin double)
|
|
(View %m)))
|
|
(defun (text-input value on-input #:placeholder "" #:enabled #t #:width 0.0 #:margin 0.0)
|
|
(leaf TextInputKind
|
|
(with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)]
|
|
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 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)))
|
|
(defun (checkbox label checked? on-toggle #:enabled #t #:margin 0.0)
|
|
(leaf CheckBoxKind
|
|
(with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0)
|
|
[(Toggle on-toggle)]))
|
|
|
|
(: (-> 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)
|
|
(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)))
|
|
(defun (column #:spacing 0.0 #:margin 0.0 #:rest children)
|
|
(stack ColumnKind spacing margin children))
|
|
|
|
;; Views side by side.
|
|
(: (-> (#: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 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)
|
|
(container ScrollKind (with-layout [] width height margin 0.0) [child]))
|