Views, events as messages, and a patch, over plain Avalonia
A program is a model, an update and a view. A view is a Bjolang value; an event finds its message in the view its control was last given, and the next view is compared with the last so only what differs is changed. Controls are made with plain constructors and changed with SetValue, so nothing is subclassed, and a program never names an Avalonia type. Text, button, text input, checkbox, column and row. tests/app.bjo drives an app through its real controls with no window. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent <git@eca.dev>
This commit is contained in:
commit
2f4c99ba62
9 changed files with 1415 additions and 0 deletions
424
src/app.bjo
Normal file
424
src/app.bjo
Normal file
|
|
@ -0,0 +1,424 @@
|
|||
;; 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/app.bjo — the module (bjogui app).
|
||||
;;
|
||||
;; Runs a program written as a model, an `update` and a `view`, in an Avalonia
|
||||
;; window. Every Avalonia name stays in this module: what it exports takes
|
||||
;; and gives Bjolang values, and a control only as an opaque `Control`.
|
||||
;;
|
||||
;; The loop: an event finds its message in the view the control was last
|
||||
;; given. `update` makes the next model from it, and `view` the next 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.
|
||||
;;
|
||||
;; Every control is made with plain constructors and changed with
|
||||
;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed.
|
||||
|
||||
(export
|
||||
App Live Control
|
||||
run-app
|
||||
;; For tests and for hosts of their own: an app with no window.
|
||||
start-app app-dispatch! app-model app-control app-control-at)
|
||||
|
||||
(import (std prelude))
|
||||
(import (std interop))
|
||||
(import (std mutable vec))
|
||||
(import (bjogui view))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Avalonia
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(import/class
|
||||
(Object (: System.Object))
|
||||
(InvalidOperation (: System.InvalidOperationException (-> string InvalidOperation)))
|
||||
(ClrString (: System.String))
|
||||
(Disposable (: System.IDisposable))
|
||||
(Services (: System.IServiceProvider))
|
||||
((Nullable %a) (: System.Nullable))
|
||||
((EventHandler %a) (: System.EventHandler))
|
||||
(AvaloniaObject (: Avalonia.AvaloniaObject))
|
||||
(AvaloniaProperty (: Avalonia.AvaloniaProperty))
|
||||
(Priority (: Avalonia.Data.BindingPriority))
|
||||
(Thickness (: Avalonia.Thickness (-> double Thickness)))
|
||||
(Orientation (: Avalonia.Layout.Orientation))
|
||||
(HAlignment (: Avalonia.Layout.HorizontalAlignment))
|
||||
(Control (: Avalonia.Controls.Control))
|
||||
(Controls (: Avalonia.Controls.Controls))
|
||||
(Panel (: Avalonia.Controls.Panel))
|
||||
(StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel)))
|
||||
(TextBlock (: Avalonia.Controls.TextBlock (-> TextBlock)))
|
||||
(Button (: Avalonia.Controls.Button (-> Button)))
|
||||
(TextBox (: Avalonia.Controls.TextBox (-> TextBox)))
|
||||
(CheckBox (: Avalonia.Controls.CheckBox (-> CheckBox)))
|
||||
(ToggleButton (: Avalonia.Controls.Primitives.ToggleButton))
|
||||
(ContentControl (: Avalonia.Controls.ContentControl))
|
||||
(Window (: Avalonia.Controls.Window (-> Window)))
|
||||
(Interactive (: Avalonia.Interactivity.Interactive))
|
||||
(RoutedEvent (: Avalonia.Interactivity.RoutedEvent))
|
||||
(RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs))
|
||||
(Routes (: Avalonia.Interactivity.RoutingStrategies))
|
||||
(Application (: Avalonia.Application (-> Application)))
|
||||
(Styles (: Avalonia.Styling.Styles))
|
||||
(FluentTheme (: Avalonia.Themes.Fluent.FluentTheme (-> Services FluentTheme)))
|
||||
(AppBuilder (: Avalonia.AppBuilder))
|
||||
(ILifetime (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime))
|
||||
(Lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime
|
||||
(-> Lifetime))))
|
||||
|
||||
(import/extern
|
||||
;; Properties, as the objects `SetValue` takes.
|
||||
(text-block-text (: Avalonia.Controls.TextBlock.TextProperty #:get))
|
||||
(text-block-font-size (: Avalonia.Controls.TextBlock.FontSizeProperty #:get))
|
||||
(content-property (: Avalonia.Controls.ContentControl.ContentProperty #:get))
|
||||
(text-box-text (: Avalonia.Controls.TextBox.TextProperty #:get))
|
||||
(watermark-property (: Avalonia.Controls.TextBox.WatermarkProperty #:get))
|
||||
(is-checked-property (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get))
|
||||
(is-enabled-property (: Avalonia.Input.InputElement.IsEnabledProperty #:get))
|
||||
(font-size-property (: Avalonia.Controls.Primitives.TemplatedControl.FontSizeProperty #:get))
|
||||
(padding-property (: Avalonia.Controls.Primitives.TemplatedControl.PaddingProperty #:get))
|
||||
(width-property (: Avalonia.Layout.Layoutable.WidthProperty #:get))
|
||||
(height-property (: Avalonia.Layout.Layoutable.HeightProperty #:get))
|
||||
(margin-property (: Avalonia.Layout.Layoutable.MarginProperty #:get))
|
||||
(spacing-property (: Avalonia.Controls.StackPanel.SpacingProperty #:get))
|
||||
(orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get))
|
||||
(content-alignment-property
|
||||
(: Avalonia.Controls.ContentControl.HorizontalContentAlignmentProperty #:get))
|
||||
|
||||
(set-value (: Avalonia.AvaloniaObject.SetValue
|
||||
(-> AvaloniaObject AvaloniaProperty Object Priority Disposable)))
|
||||
(clear-value (: Avalonia.AvaloniaObject.ClearValue (-> AvaloniaObject AvaloniaProperty void)))
|
||||
|
||||
;; Events.
|
||||
(click-event (: Avalonia.Controls.Button.ClickEvent #:get))
|
||||
;; TextChanging and not TextChanged: TextChanged is posted to the
|
||||
;; 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))
|
||||
(add-handler (: Avalonia.Interactivity.Interactive.AddHandler
|
||||
(-> Interactive RoutedEvent Delegate Routes bool void)))
|
||||
|
||||
;; What a control holds.
|
||||
(text-box-value (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get))
|
||||
(is-checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked
|
||||
(-> ToggleButton (Nullable bool)) #:get))
|
||||
(panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
|
||||
(clr-string (: System.Convert.ToString (-> string ClrString)))
|
||||
|
||||
;; The window and the application.
|
||||
(configure (: Avalonia.AppBuilder.Configure (-> (-> Application) AppBuilder)))
|
||||
(use-platform-detect (: Avalonia.AppBuilderDesktopExtensions.UsePlatformDetect
|
||||
(-> AppBuilder AppBuilder)))
|
||||
(setup-with-lifetime (: Avalonia.AppBuilder.SetupWithLifetime (-> AppBuilder ILifetime AppBuilder)))
|
||||
(current-app (: Avalonia.Application.Current #:get))
|
||||
(app-styles (: Avalonia.Application.Styles (-> Application Styles) #:get))
|
||||
(main-window! (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.MainWindow
|
||||
(-> Lifetime Window void) #:set))
|
||||
(start-lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.Start
|
||||
(-> Lifetime (Array ClrString) int)))
|
||||
(window-title! (: Avalonia.Controls.Window.Title (-> Window string void) #:set))
|
||||
(window-content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Properties
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(: (-> Kind bool))
|
||||
(defun (stack? kind)
|
||||
(match kind
|
||||
(ColumnKind #t)
|
||||
(RowKind #t)
|
||||
(_ #f)))
|
||||
|
||||
;; A kind that Avalonia draws with a template, and so has a padding and a
|
||||
;; font size of its own.
|
||||
(: (-> Kind bool))
|
||||
(defun (templated? kind)
|
||||
(match kind
|
||||
(ButtonKind #t)
|
||||
(TextInputKind #t)
|
||||
(CheckBoxKind #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.
|
||||
(: (-> Kind Prop (Option AvaloniaProperty)))
|
||||
(defun (slot kind p)
|
||||
(match p
|
||||
((Label _)
|
||||
(match kind
|
||||
(TextKind (Some (cast AvaloniaProperty text-block-text)))
|
||||
(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))
|
||||
((Enabled _) (Some (cast AvaloniaProperty is-enabled-property)))
|
||||
((FontSize _)
|
||||
(cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size)))
|
||||
((templated? kind) (Some (cast AvaloniaProperty font-size-property)))
|
||||
(else None)))
|
||||
((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))))
|
||||
|
||||
;; The value of a prop, as the object `SetValue` takes.
|
||||
(: (-> Prop Object))
|
||||
(defun (boxed p)
|
||||
(match p
|
||||
((Label s) (cast Object (clr-string s)))
|
||||
((Value s) (cast Object (clr-string s)))
|
||||
((Placeholder s) (cast Object (clr-string s)))
|
||||
((Checked b) (cast Object b))
|
||||
((Enabled b) (cast Object b))
|
||||
((FontSize d) (cast Object d))
|
||||
((Width d) (cast Object d))
|
||||
((Height d) (cast Object d))
|
||||
((Margin d) (cast Object (Thickness. d)))
|
||||
((Padding d) (cast Object (Thickness. d)))
|
||||
((Spacing d) (cast Object d))))
|
||||
|
||||
;; Which prop it is, without its value. Two props with one tag set the same
|
||||
;; property.
|
||||
(: (-> Prop int))
|
||||
(defun (tag p)
|
||||
(match p
|
||||
((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3)
|
||||
((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7)
|
||||
((Margin _) 8) ((Padding _) 9) ((Spacing _) 10)))
|
||||
|
||||
(: (-> 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)))
|
||||
|
||||
(: (-> Control Kind Prop void))
|
||||
(defun (clear-prop! control kind p)
|
||||
(match (slot kind p)
|
||||
((Some property) (clear-value (cast AvaloniaObject control) 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.
|
||||
(: (-> Control Kind (Vec Prop) (Vec Prop) void))
|
||||
(defun (patch-props! control kind old new)
|
||||
(loop (:for p old)
|
||||
(:when (not (any? (fun (q) (= (tag q) (tag p))) new)))
|
||||
(:do (clear-prop! control kind p)))
|
||||
(loop (:for p new)
|
||||
(:when (not (vec-contains old p)))
|
||||
(:do (set-prop! control kind p))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The app
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; A control, the view it was last given, and the live children it holds.
|
||||
(type (: (Live %m) #:opaque (Record (: control Control)
|
||||
(: view (View %m) #:mutable)
|
||||
(: children (MutableVec (Live %m))))))
|
||||
|
||||
;; A running program.
|
||||
;;
|
||||
;; `patching` is true while the controls are being changed. A control that
|
||||
;; is changed raises its own events, such as a text input whose text is set,
|
||||
;; and those are not the user's: they are dropped.
|
||||
(type (: (App %model %m) #:opaque (Record (: model %model #:mutable)
|
||||
(: update (-> %m %model %model))
|
||||
(: view (-> %model (View %m)))
|
||||
(: root (Option (Live %m)) #:mutable)
|
||||
(: patching bool #:mutable)
|
||||
(: on-root (-> Control void)))))
|
||||
|
||||
(: (-> (App %model %m) %model))
|
||||
(defun (app-model app) (.model app))
|
||||
|
||||
;; The control the view is shown in. It changes when the root view changes
|
||||
;; kind.
|
||||
(: (-> (App %model %m) Control))
|
||||
(defun (app-control app)
|
||||
(match (.root app)
|
||||
((Some live) (.control live))
|
||||
(None (raise (cast Exception (InvalidOperation. "the app has no view"))))))
|
||||
|
||||
;; The control at `path`, a child index for each level below the root.
|
||||
(: (-> (App %model %m) (List int) Control))
|
||||
(defun (app-control-at app path)
|
||||
(: (-> (Live %m) (List int) Control))
|
||||
(defun (walk live path)
|
||||
(match path
|
||||
(() (.control live))
|
||||
((List i rest ...) (walk (mutablevec-ref (.children live) i) rest))))
|
||||
(match (.root app)
|
||||
((Some live) (walk live path))
|
||||
(None (raise (cast Exception (InvalidOperation. "the app has no view"))))))
|
||||
|
||||
;; Makes the next model from `msg`, and shows its view.
|
||||
(: (-> (App %model %m) %m void))
|
||||
(defun (app-dispatch! app msg)
|
||||
(record-set! app (model ((.update app) msg (.model app))))
|
||||
(render! app))
|
||||
|
||||
(: (-> (App %model %m) void))
|
||||
(defun (render! app)
|
||||
(def next ((.view app) (.model app)))
|
||||
(record-set! app (patching #t))
|
||||
(match (.root app)
|
||||
(None
|
||||
(def live (mount app next))
|
||||
(record-set! app (root (Some live)))
|
||||
((.on-root app) (.control live)))
|
||||
((Some live)
|
||||
(def now (patch! app live next))
|
||||
(unless (eq? now live)
|
||||
(record-set! app (root (Some now)))
|
||||
((.on-root app) (.control now)))))
|
||||
(record-set! app (patching #f)))
|
||||
|
||||
;; Gives the message that `pick` finds in the control's events to `update`.
|
||||
(: (-> (App %model %m) (Live %m) (-> (On %m) (Option %m)) void))
|
||||
(defun (fire! app live pick)
|
||||
(unless (.patching app)
|
||||
(match (loop (:for on (.events (.view live)))
|
||||
(:when-let (Some msg) (pick on))
|
||||
(:finish #t (Some msg))
|
||||
=> None)
|
||||
((Some msg) (app-dispatch! app msg))
|
||||
(None unit))))
|
||||
|
||||
(: (-> Control RoutedEvent (-> Object RoutedEventArgs void) void))
|
||||
(defun (on! control event handler)
|
||||
(add-handler (cast Interactive control) event
|
||||
(cast Delegate (cast Object (: (as-delegate handler) (EventHandler RoutedEventArgs))))
|
||||
Routes.Bubble #f))
|
||||
|
||||
;; Adds the handlers of the kind. A handler reads the view the control has
|
||||
;; when the event comes, so a new view needs no new handler.
|
||||
(: (-> (App %model %m) (Live %m) Kind void))
|
||||
(defun (listen! app live kind)
|
||||
(def control (.control live))
|
||||
(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)))))))
|
||||
(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)))))))
|
||||
(_ unit)))
|
||||
|
||||
(: (-> Kind Control))
|
||||
(defun (make-control kind)
|
||||
(match kind
|
||||
(TextKind (cast Control (TextBlock.)))
|
||||
(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))
|
||||
(TextInputKind (cast Control (TextBox.)))
|
||||
(CheckBoxKind (cast Control (CheckBox.)))
|
||||
(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))))
|
||||
|
||||
;; Makes the controls for a view.
|
||||
(: (-> (App %model %m) (View %m) (Live %m)))
|
||||
(defun (mount app v)
|
||||
(def kind (view-kind v))
|
||||
(def control (make-control kind))
|
||||
(def live (Live (control control) (view v) (children (mutablevec))))
|
||||
(loop (:for p (view-props v)) (:do (set-prop! control kind p)))
|
||||
(listen! app live kind)
|
||||
(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))))
|
||||
live)
|
||||
|
||||
;; Changes the controls of `live` to show `next`. Gives `live` itself, or new
|
||||
;; controls when the kind is another.
|
||||
(: (-> (App %model %m) (Live %m) (View %m) (Live %m)))
|
||||
(defun (patch! app live next)
|
||||
(def old (.view live))
|
||||
(def kind (view-kind next))
|
||||
(if (not (= (view-kind old) kind))
|
||||
(mount app next)
|
||||
(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)))
|
||||
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.
|
||||
(: (-> (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)))))
|
||||
|
||||
;; An app with no window: its view is made now, and `on-root` is given the
|
||||
;; control to show each time that control changes.
|
||||
(: (-> %model (-> %m %model %model) (-> %model (View %m)) (-> Control void)
|
||||
(App %model %m)))
|
||||
(defun (start-app init update view on-root)
|
||||
(def app (App (model init) (update update) (view view) (root None) (patching #f)
|
||||
(on-root on-root)))
|
||||
(render! app)
|
||||
app)
|
||||
|
||||
;; Runs the program in a window, until the window is closed.
|
||||
(: (-> %model (-> %m %model %model) (-> %model (View %m))
|
||||
(#:title string) (#:width double) (#:height double)
|
||||
void))
|
||||
(defun (run-app init update view #:title "bjogui" #:width 400.0 #:height 300.0)
|
||||
;; The Application is made inside the setup, because making one uses the
|
||||
;; dispatcher, and the dispatcher is the platform's only after the setup.
|
||||
(def lifetime (Lifetime.))
|
||||
(ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.))))
|
||||
lifetime))
|
||||
(.Add (app-styles current-app) (FluentTheme. (clr-default)))
|
||||
(def w (Window.))
|
||||
(window-title! w title)
|
||||
(ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty width-property)
|
||||
(cast Object width) Priority.LocalValue))
|
||||
(ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty height-property)
|
||||
(cast Object height) Priority.LocalValue))
|
||||
(ignore (start-app init update view
|
||||
(fun (c) (window-content! (cast ContentControl w) (cast Object c)))))
|
||||
(main-window! lifetime w)
|
||||
(ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString)))))
|
||||
144
src/view.bjo
Normal file
144
src/view.bjo
Normal file
|
|
@ -0,0 +1,144 @@
|
|||
;; 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 checkbox column row
|
||||
|
||||
;; Reading one.
|
||||
view-kind view-props view-events view-children)
|
||||
|
||||
(import (std prelude))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The types
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; What control a view is.
|
||||
(type (: Kind (Union TextKind ButtonKind TextInputKind CheckBoxKind ColumnKind RowKind)))
|
||||
|
||||
;; 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))))
|
||||
|
||||
;; An event, and the message it sends.
|
||||
(type (: (On %m) (Union (: Click %m)
|
||||
(: Input (-> string %m))
|
||||
(: Toggle (-> bool %m)))))
|
||||
|
||||
;; One control and what is in it.
|
||||
(type (: (View %m) (Record (: kind Kind)
|
||||
(: props (Vec Prop))
|
||||
(: events (Vec (On %m)))
|
||||
(: children (Vec (View %m))))))
|
||||
|
||||
(: 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))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; 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 [])))
|
||||
|
||||
;; A text.
|
||||
(: (-> string (#:size double) (#:width double) (#:height double) (#:margin double)
|
||||
(View %m)))
|
||||
(defun (text s #:size 0.0 #:width 0.0 #:height 0.0 #:margin 0.0)
|
||||
(leaf TextKind
|
||||
(with-layout (with-size [(Label s)] 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 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 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))))
|
||||
|
||||
;; 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))
|
||||
Loading…
Add table
Add a link
Reference in a new issue