Commands and subscriptions, and gui-update
gui-update is a plain function, so it cannot wait. It returns the work to do as values. A command is an (Event %m), synced in a fiber of its own, whose answer is the next message. A subscription is a source of messages that the model asks for: after each update the app starts the new ones and cancels the ones that are gone, by key. every sends a message on a timer, and subscription takes a source of one's own. The fibers belong to the app's scope and post their messages to the UI thread, so gui-update and view only run there. Closing the window cancels them. The prelude's path macros already use the name update, hence gui-update. 🤖 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
2f4c99ba62
commit
4f48282314
6 changed files with 460 additions and 67 deletions
74
Readme.org
74
Readme.org
|
|
@ -1,7 +1,7 @@
|
|||
#+TITLE: bjogui
|
||||
|
||||
Desktop programs in Bjolang, written as a model, an ~update~ and a ~view~, and
|
||||
shown with [[https://avaloniaui.net][Avalonia]].
|
||||
Desktop programs in Bjolang, written as a model, a ~gui-update~ and a ~view~,
|
||||
and shown with [[https://avaloniaui.net][Avalonia]].
|
||||
|
||||
#+BEGIN_SRC scheme
|
||||
(import (bjogui view))
|
||||
|
|
@ -9,9 +9,9 @@ shown with [[https://avaloniaui.net][Avalonia]].
|
|||
|
||||
(type (: Msg (Union Inc Dec)))
|
||||
|
||||
(: update (-> Msg int int))
|
||||
(defun (update msg n)
|
||||
(match msg (Inc (+ n 1)) (Dec (- n 1))))
|
||||
(: gui-update (-> Msg int (Tuple int (List (Event Msg)))))
|
||||
(defun (gui-update msg n)
|
||||
(next (match msg (Inc (+ n 1)) (Dec (- n 1)))))
|
||||
|
||||
(: view (-> int (View Msg)))
|
||||
(defun (view n)
|
||||
|
|
@ -21,7 +21,7 @@ shown with [[https://avaloniaui.net][Avalonia]].
|
|||
(button "+" Inc)))
|
||||
|
||||
(defun (main)
|
||||
(run-app 0 update view #:title "Counter"))
|
||||
(run-app 0 gui-update view #:title "Counter"))
|
||||
#+END_SRC
|
||||
|
||||
A program never names an Avalonia type. A view is a Bjolang value, an event
|
||||
|
|
@ -30,7 +30,7 @@ is a message, and the controls are made and changed by the package.
|
|||
* How it works
|
||||
|
||||
An event finds its message in the view its control was last given.
|
||||
~update~ makes the next model from the message, and ~view~ makes the next
|
||||
~gui-update~ makes the next model from the message, and ~view~ makes 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.
|
||||
|
|
@ -57,14 +57,59 @@ They take keywords where they apply: ~#:size~ (the font size of a text),
|
|||
children of a column or a row), ~#:enabled~ and ~#:placeholder~. A size of
|
||||
zero, the default, leaves the size to the control.
|
||||
|
||||
* Work: commands and subscriptions
|
||||
|
||||
~gui-update~ is a plain function, so it cannot wait, and the compiler says so
|
||||
if it tries. Work is a value it returns, and the app runs it.
|
||||
|
||||
A *command* is an ~(Event %m)~: an event whose answer is a message. ~(next m
|
||||
command ...)~ is the next model and the commands to start; ~(next m)~ is the
|
||||
model alone. The app syncs each command in a fiber of its own and gives its
|
||||
message to ~gui-update~. Any event will do: a ~timeout~, a ~blocking~ call, a
|
||||
channel, a ~choose~ of several.
|
||||
|
||||
#+BEGIN_SRC scheme
|
||||
(Load (next (record-set m (loading #t))
|
||||
(wrap (blocking (fun () (file-read-text path))) Loaded)))
|
||||
#+END_SRC
|
||||
|
||||
A *subscription* is a source of messages that runs while the model asks for
|
||||
it. ~subscriptions~ gives the list for a model. After each update the app
|
||||
starts those that are new and cancels those that are gone; the others keep
|
||||
running. A subscription is known by its key.
|
||||
|
||||
- ~(every duration msg)~ sends ~msg~ each time ~duration~ has passed.
|
||||
- ~(subscription key next-event)~ is a source of your own: ~next-event~ gives
|
||||
the event of the next message, and is called again after each one.
|
||||
~(subscription "jobs" (fun () (wrap (chan-recv jobs) Got)))~ sends what
|
||||
comes on a channel.
|
||||
|
||||
#+BEGIN_SRC scheme
|
||||
(: subscriptions (-> Model (List (Sub Msg))))
|
||||
(defun (subscriptions m)
|
||||
(if (.running m) (list (every (milliseconds 100) Tick)) '()))
|
||||
#+END_SRC
|
||||
|
||||
The fibers belong to the app. They post their messages to the UI thread, so
|
||||
~gui-update~ and ~view~ always run there. When the window is closed they are
|
||||
cancelled, and the program ends.
|
||||
|
||||
* Running: (bjogui app)
|
||||
|
||||
- ~(run-app init update view #:title #:width #:height)~ opens a window and
|
||||
runs until it is closed.
|
||||
- ~(start-app init update view on-root)~ makes the controls with no window,
|
||||
and gives ~on-root~ the control to show. ~app-dispatch!~ sends a message,
|
||||
~app-model~ reads the model, and ~app-control-at~ finds a control by its
|
||||
path of child indices. ~tests/app.bjo~ uses these to drive an app through
|
||||
- ~(run-app init gui-update view #:subscriptions #:title #:width #:height)~
|
||||
opens a window and runs until it is closed.
|
||||
- ~(start-app init gui-update view on-root #:subscriptions)~ makes the controls
|
||||
with no window, and gives ~on-root~ the control to show. Its fibers belong
|
||||
to the scope it is started in.
|
||||
- ~app-dispatch!~ gives a message on the UI thread, and ~app-send!~ from any
|
||||
thread.
|
||||
- ~app-run-pending!~ runs what fibers have posted, where no loop of
|
||||
Avalonia's does.
|
||||
- ~app-stop!~ cancels the subscriptions and drops later messages.
|
||||
- ~app-model~ reads the model, and ~app-control-at~ finds a control by its
|
||||
path of child indices.
|
||||
|
||||
~tests/app.bjo~ and ~tests/effects.bjo~ use these to drive an app through
|
||||
its real controls.
|
||||
|
||||
* Requirements
|
||||
|
|
@ -78,11 +123,12 @@ zero, the default, leaves the size to the control.
|
|||
|
||||
#+BEGIN_SRC sh
|
||||
bjo run tests/app.bjo # prints "bjogui ok"
|
||||
bjo run tests/effects.bjo # prints "bjogui effects ok"
|
||||
bjo run examples/counter.bjo
|
||||
bjo run examples/stopwatch.bjo
|
||||
#+END_SRC
|
||||
|
||||
* Not yet
|
||||
|
||||
- Keyed children, for lists whose items move.
|
||||
- Messages from fibers and timers, for work that is not a click.
|
||||
- More controls: lists, grids, images, scroll views, menus.
|
||||
|
|
|
|||
|
|
@ -13,12 +13,13 @@
|
|||
(type (: Msg (Union Inc Dec (: Typed string))))
|
||||
(type (: Model (Record (: count int) (: name string))))
|
||||
|
||||
(: update (-> Msg Model Model))
|
||||
(defun (update msg m)
|
||||
(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||
(defun (gui-update msg m)
|
||||
(next
|
||||
(match msg
|
||||
(Inc (record-set m (count (+ (.count m) 1))))
|
||||
(Dec (record-set m (count (- (.count m) 1))))
|
||||
((Typed s) (record-set m (name s)))))
|
||||
((Typed s) (record-set m (name s))))))
|
||||
|
||||
(: view (-> Model (View Msg)))
|
||||
(defun (view m)
|
||||
|
|
@ -31,4 +32,4 @@
|
|||
(button "+" Inc #:width 40.0))))
|
||||
|
||||
(defun (main)
|
||||
(run-app (Model (count 0) (name "")) update view #:title "Counter" #:width 320.0 #:height 200.0))
|
||||
(run-app (Model (count 0) (name "")) gui-update view #:title "Counter" #:width 320.0 #:height 200.0))
|
||||
|
|
|
|||
55
examples/stopwatch.bjo
Normal file
55
examples/stopwatch.bjo
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
;; 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/examples/stopwatch.bjo — a subscription and a command.
|
||||
;;
|
||||
;; bjo run examples/stopwatch.bjo
|
||||
;;
|
||||
;; The stopwatch ticks while it runs: `subscriptions` asks for a tick only
|
||||
;; then, so stopping it stops the fiber. "Lap" saves the time after a pause,
|
||||
;; to show a command: the pause runs in a fiber, and the window does not wait
|
||||
;; for it.
|
||||
|
||||
(import (std prelude))
|
||||
(import (bjogui view))
|
||||
(import (bjogui app))
|
||||
|
||||
(type (: Msg (Union Toggle Tick Reset Lap (: Saved int))))
|
||||
(type (: Model (Record (: tenths int) (: running bool) (: saving bool) (: laps (List int)))))
|
||||
|
||||
(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||
(defun (gui-update msg m)
|
||||
(match msg
|
||||
(Toggle (next (record-set m (running (not (.running m))))))
|
||||
(Tick (next (record-set m (tenths (+ (.tenths m) 1)))))
|
||||
(Reset (next (record-set m (tenths 0) (laps '()))))
|
||||
;; The time is taken now, and saved half a second later.
|
||||
(Lap (next (record-set m (saving #t))
|
||||
(wrap (timeout (milliseconds 500)) (fun (_) (Saved (.tenths m))))))
|
||||
((Saved t) (next (record-set m (saving #f) (laps (cons t (.laps m))))))))
|
||||
|
||||
(: subscriptions (-> Model (List (Sub Msg))))
|
||||
(defun (subscriptions m)
|
||||
(if (.running m) (list (every (milliseconds 100) Tick)) '()))
|
||||
|
||||
(: (-> int string))
|
||||
(defun (show tenths)
|
||||
#"${(/ tenths 10)}.${(% tenths 10)} s")
|
||||
|
||||
(: view (-> Model (View Msg)))
|
||||
(defun (view m)
|
||||
(column #:spacing 8.0 #:margin 16.0
|
||||
(text (show (.tenths m)) #:size 32.0)
|
||||
(row #:spacing 8.0
|
||||
(button (if (.running m) "Stop" "Start") Toggle #:width 80.0)
|
||||
(button "Lap" Lap #:enabled (not (.saving m)) #:width 80.0)
|
||||
(button "Reset" Reset #:width 80.0))
|
||||
(apply column (vec->array (vec-map (fun (t) (text #"lap: ${(show t)}"))
|
||||
(list->vec (.laps m)))))))
|
||||
|
||||
(defun (main)
|
||||
(run-app (Model (tenths 0) (running #f) (saving #f) (laps '()))
|
||||
gui-update view
|
||||
#:subscriptions subscriptions
|
||||
#:title "Stopwatch" #:width 320.0 #:height 300.0))
|
||||
220
src/app.bjo
220
src/app.bjo
|
|
@ -4,24 +4,34 @@
|
|||
|
||||
;; 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`.
|
||||
;; Runs a program written as a model, a `gui-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.
|
||||
;; given. `gui-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.
|
||||
;;
|
||||
;; `gui-update` does no work of its own: it is a plain function, so it cannot
|
||||
;; wait. Work is a value it returns. A command is an `(Event %m)`: the app
|
||||
;; syncs it in a fiber, and gives the message it answers to `gui-update`. A
|
||||
;; subscription is a source of messages that runs as long as the model asks
|
||||
;; for it: after each update the app starts the subscriptions that are new
|
||||
;; and stops those that are gone.
|
||||
;;
|
||||
;; Every control is made with plain constructors and changed with
|
||||
;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed.
|
||||
|
||||
(export
|
||||
App Live Control
|
||||
run-app
|
||||
App Live Control Sub
|
||||
run-app next
|
||||
;; Subscriptions.
|
||||
every subscription
|
||||
;; For tests and for hosts of their own: an app with no window.
|
||||
start-app app-dispatch! app-model app-control app-control-at)
|
||||
start-app app-dispatch! app-send! app-stop! app-run-pending!
|
||||
app-model app-control app-control-at)
|
||||
|
||||
(import (std prelude))
|
||||
(import (std interop))
|
||||
|
|
@ -67,7 +77,10 @@
|
|||
(AppBuilder (: Avalonia.AppBuilder))
|
||||
(ILifetime (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime))
|
||||
(Lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime
|
||||
(-> Lifetime))))
|
||||
(-> Lifetime)))
|
||||
(Dispatcher (: Avalonia.Threading.Dispatcher))
|
||||
(UiPriority (: Avalonia.Threading.DispatcherPriority))
|
||||
((DispatcherOp %a) (: Avalonia.Threading.DispatcherOperation)))
|
||||
|
||||
(import/extern
|
||||
;; Properties, as the objects `SetValue` takes.
|
||||
|
|
@ -108,6 +121,13 @@
|
|||
(panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
|
||||
(clr-string (: System.Convert.ToString (-> string ClrString)))
|
||||
|
||||
;; The UI thread. Controls may be touched only there, so a message from a
|
||||
;; fiber is posted to it.
|
||||
(ui-dispatcher (: Avalonia.Threading.Dispatcher.UIThread #:get))
|
||||
(ui-thread? (: Avalonia.Threading.Dispatcher.CheckAccess (-> Dispatcher bool)))
|
||||
(ui-post (: Avalonia.Threading.Dispatcher.InvokeAsync (-> Dispatcher (-> Unit) (DispatcherOp Unit))))
|
||||
(ui-run-jobs (: Avalonia.Threading.Dispatcher.RunJobs (-> Dispatcher (Nullable UiPriority) void)))
|
||||
|
||||
;; The window and the application.
|
||||
(configure (: Avalonia.AppBuilder.Configure (-> (-> Application) AppBuilder)))
|
||||
(use-platform-detect (: Avalonia.AppBuilderDesktopExtensions.UsePlatformDetect
|
||||
|
|
@ -226,16 +246,65 @@
|
|||
(: view (View %m) #:mutable)
|
||||
(: children (MutableVec (Live %m))))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; Commands and subscriptions
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; A source of messages that runs while the model asks for it. `key` says
|
||||
;; which one it is: after an update, a subscription whose key was there before
|
||||
;; keeps running, and is not started again.
|
||||
;;
|
||||
;; `next-event` gives the event of the next message. A fiber of the
|
||||
;; subscription's own calls it, syncs the event, sends the message, and calls
|
||||
;; it again. The fiber is cancelled at that `sync` when the key is gone, and
|
||||
;; when the app stops.
|
||||
(type (: (Sub %m) #:opaque (Record (: key string)
|
||||
(: next-event (-> (Event %m))))))
|
||||
|
||||
;; A subscription to a source of your own: `(subscription "jobs" (fun ()
|
||||
;; (chan-recv jobs)))` sends each value that comes on a channel. Two
|
||||
;; subscriptions with the same key are one: the first is the one that runs.
|
||||
(: subscription (-> string (-> (Event %m)) (Sub %m)))
|
||||
(defun (subscription key next-event)
|
||||
(Sub (key key) (next-event next-event)))
|
||||
|
||||
;; Sends `msg` each time `d` has passed. The time is counted from the last
|
||||
;; message, so a slow update makes the next one later and they do not queue
|
||||
;; up.
|
||||
(: every (-> Duration %m (Sub %m)) (where (Written %m)))
|
||||
(defun (every d msg)
|
||||
(Sub (key #"every ${(duration-ticks d)} ${(written msg)}")
|
||||
(next-event (fun () (wrap (timeout d) (fun (_) msg))))))
|
||||
|
||||
;; The next model, and the commands to run. `(next m)` is the model alone.
|
||||
(: next (-> %model #:rest (Event %m) (Tuple %model (List (Event %m)))))
|
||||
(defun (next m #:rest commands)
|
||||
(Tuple m (->list commands)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The app
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
;; 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))
|
||||
;;
|
||||
;; `home` is the scope the app's fibers belong to. A message can arrive from
|
||||
;; Avalonia on a thread with no scope, so each update is run in it.
|
||||
;; `subs` holds each running subscription's key, and the scope it runs in, so
|
||||
;; that one can be cancelled and the others not.
|
||||
(type (: (App %model %m) #:opaque
|
||||
(Record (: model %model #:mutable)
|
||||
(: gui-update (-> %m %model (Tuple %model (List (Event %m)))))
|
||||
(: view (-> %model (View %m)))
|
||||
(: subscriptions (-> %model (List (Sub %m))))
|
||||
(: root (Option (Live %m)) #:mutable)
|
||||
(: patching bool #:mutable)
|
||||
(: stopped bool #:mutable)
|
||||
(: home Scope)
|
||||
(: subs (List (Tuple string Scope)) #:mutable)
|
||||
(: on-root (-> Control void)))))
|
||||
|
||||
(: (-> (App %model %m) %model))
|
||||
|
|
@ -261,29 +330,110 @@
|
|||
((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.
|
||||
;; Makes the next model from `msg`, shows its view, starts its commands, and
|
||||
;; starts and stops subscriptions. Only on the UI thread; from anywhere else,
|
||||
;; use `app-send!`. A stopped app drops the message.
|
||||
(: (-> (App %model %m) %m void))
|
||||
(defun (app-dispatch! app msg)
|
||||
(record-set! app (model ((.update app) msg (.model app))))
|
||||
(render! app))
|
||||
(unless (.stopped app)
|
||||
(def (Tuple model commands) ((.gui-update app) msg (.model app)))
|
||||
(record-set! app (model model))
|
||||
(step! app commands)))
|
||||
|
||||
;; Gives `msg` to the app from any thread. Off the UI thread it is posted to
|
||||
;; the UI thread, and runs there after the messages posted before it.
|
||||
(: (-> (App %model %m) %m void))
|
||||
(defun (app-send! app msg)
|
||||
(if (ui-thread? ui-dispatcher)
|
||||
(app-dispatch! app msg)
|
||||
(post! app msg)))
|
||||
|
||||
;; Posts `msg` to the UI thread. What a fiber does: it is never on the UI
|
||||
;; thread, and it must not run an update itself.
|
||||
(: (-> (App %model %m) %m void))
|
||||
(defun (post! app msg)
|
||||
(ignore (ui-post ui-dispatcher (fun () (app-dispatch! app msg) unit))))
|
||||
|
||||
;; Runs the messages that fibers have posted to the UI thread, now. For a test
|
||||
;; or a host with no window, where no loop of Avalonia's runs them.
|
||||
(: (-> (App %model %m) void))
|
||||
(defun (app-run-pending! app)
|
||||
(ui-run-jobs ui-dispatcher (clr-default)))
|
||||
|
||||
;; Stops the app: its subscriptions are cancelled, and later messages are
|
||||
;; dropped. A command that is still running is cancelled when the scope the
|
||||
;; app was started in ends.
|
||||
(: (-> (App %model %m) void))
|
||||
(defun (app-stop! app)
|
||||
(record-set! app (stopped #t))
|
||||
(loop (:for (Tuple _ scope) (.subs app)) (:do (stop-scope! scope)))
|
||||
(record-set! app (subs '())))
|
||||
|
||||
(: (-> (App %model %m) (List (Event %m)) void))
|
||||
(defun (step! app commands)
|
||||
(render! app)
|
||||
(in-scope (.home app)
|
||||
(loop (:for command commands)
|
||||
(:do (spawn/daemon (run-command app command)))))
|
||||
(sync-subs! app))
|
||||
|
||||
(: (-bjo-> (App %model %m) (Event %m) void))
|
||||
(defbjo (run-command app command)
|
||||
(post! app (sync command)))
|
||||
|
||||
(: (-bjo-> (App %model %m) (-> (Event %m)) void))
|
||||
(defbjo (run-sub app next-event)
|
||||
(let go ()
|
||||
(post! app (sync (next-event)))
|
||||
(go)))
|
||||
|
||||
;; Cancels a subscription's scope, and so its fiber. The scope is not closed:
|
||||
;; closing waits, and nothing is owned in it to release.
|
||||
(: (-> Scope void))
|
||||
(defun (stop-scope! scope)
|
||||
(scope-cancel! scope (Requested "the subscription is gone")))
|
||||
|
||||
;; Starts a subscription in a scope of its own, inside the app's, so that it
|
||||
;; can be cancelled alone.
|
||||
(: (-> (App %model %m) (Sub %m) Scope))
|
||||
(defun (start-sub! app sub)
|
||||
(in-scope (.home app)
|
||||
(def scope (scope-open! 0))
|
||||
(in-scope scope
|
||||
(spawn/daemon (run-sub app (.next-event sub))))
|
||||
scope))
|
||||
|
||||
(: (-> (App %model %m) void))
|
||||
(defun (sync-subs! app)
|
||||
(def wanted ((.subscriptions app) (.model app)))
|
||||
(defun (wanted? key) (any? (fun (sub) (= (.key sub) key)) wanted))
|
||||
(def/mutable kept '())
|
||||
(loop (:for (Tuple key scope) (.subs app))
|
||||
(:do (if (wanted? key)
|
||||
(set! kept (cons (Tuple key scope) kept))
|
||||
(stop-scope! scope))))
|
||||
(loop (:for sub wanted)
|
||||
(:when (not (any? (fun (t) (= (fst t) (.key sub))) kept)))
|
||||
(:do (set! kept (cons (Tuple (.key sub) (start-sub! app sub)) kept))))
|
||||
(record-set! app (subs kept)))
|
||||
|
||||
(: (-> (App %model %m) void))
|
||||
(defun (render! app)
|
||||
(def next ((.view app) (.model app)))
|
||||
(def next-view ((.view app) (.model app)))
|
||||
(record-set! app (patching #t))
|
||||
(match (.root app)
|
||||
(None
|
||||
(def live (mount app next))
|
||||
(def live (mount app next-view))
|
||||
(record-set! app (root (Some live)))
|
||||
((.on-root app) (.control live)))
|
||||
((Some live)
|
||||
(def now (patch! app live next))
|
||||
(def now (patch! app live next-view))
|
||||
(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`.
|
||||
;; Gives the message that `pick` finds in the control's events to `gui-update`.
|
||||
(: (-> (App %model %m) (Live %m) (-> (On %m) (Option %m)) void))
|
||||
(defun (fire! app live pick)
|
||||
(unless (.patching app)
|
||||
|
|
@ -391,21 +541,27 @@
|
|||
(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)
|
||||
;; An app with no window: its view is made now, its subscriptions started,
|
||||
;; and `on-root` is given the control to show each time that control changes.
|
||||
;; Its fibers belong to the scope it is started in.
|
||||
(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
|
||||
(-> Control void) (#:subscriptions (-> %model (List (Sub %m))))
|
||||
(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)
|
||||
(defun (start-app init gui-update view on-root #:subscriptions (fun (m) '()))
|
||||
(def app (App (model init) (gui-update gui-update) (view view)
|
||||
(subscriptions subscriptions) (root None) (patching #f) (stopped #f)
|
||||
(home (current-scope)) (subs '()) (on-root on-root)))
|
||||
(step! app '())
|
||||
app)
|
||||
|
||||
;; Runs the program in a window, until the window is closed.
|
||||
(: (-> %model (-> %m %model %model) (-> %model (View %m))
|
||||
;; Runs the program in a window, until the window is closed. Then the
|
||||
;; subscriptions and the commands still running are cancelled.
|
||||
(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
|
||||
(#:subscriptions (-> %model (List (Sub %m))))
|
||||
(#:title string) (#:width double) (#:height double)
|
||||
void))
|
||||
(defun (run-app init update view #:title "bjogui" #:width 400.0 #:height 300.0)
|
||||
(defun (run-app init gui-update view #:subscriptions (fun (m) '())
|
||||
#: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.))
|
||||
|
|
@ -418,7 +574,11 @@
|
|||
(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)))))
|
||||
(with-cancel (cancel)
|
||||
(def app (start-app init gui-update view
|
||||
(fun (c) (window-content! (cast ContentControl w) (cast Object c)))
|
||||
#:subscriptions subscriptions))
|
||||
(main-window! lifetime w)
|
||||
(ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString)))))
|
||||
(ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString))))
|
||||
(app-stop! app)
|
||||
(cancel (Requested "the window is closed"))))
|
||||
|
|
|
|||
|
|
@ -8,7 +8,7 @@
|
|||
;;
|
||||
;; No window is opened. The test raises the events a user would cause on the
|
||||
;; Avalonia controls, and reads back what the controls hold, so it goes
|
||||
;; through the handlers, update, view and patch as a program does.
|
||||
;; through the handlers, gui-update, view and patch as a program does.
|
||||
|
||||
(import (std prelude))
|
||||
(import (std simpletest))
|
||||
|
|
@ -60,14 +60,15 @@
|
|||
(type (: Msg (Union Inc Dec (: Typed string) (: Shout bool) Reset)))
|
||||
(type (: Model (Record (: count int) (: name string) (: loud bool))))
|
||||
|
||||
(: update (-> Msg Model Model))
|
||||
(defun (update msg m)
|
||||
(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||
(defun (gui-update msg m)
|
||||
(next
|
||||
(match msg
|
||||
(Inc (record-set m (count (+ (.count m) 1))))
|
||||
(Dec (record-set m (count (- (.count m) 1))))
|
||||
((Typed s) (record-set m (name s)))
|
||||
((Shout b) (record-set m (loud b)))
|
||||
(Reset (Model (count 0) (name "") (loud #f)))))
|
||||
(Reset (Model (count 0) (name "") (loud #f))))))
|
||||
|
||||
(: greeting (-> Model string))
|
||||
(defun (greeting m)
|
||||
|
|
@ -92,7 +93,7 @@
|
|||
|
||||
(defun (main)
|
||||
(def/mutable roots 0)
|
||||
(def app (start-app (Model (count 0) (name "") (loud #f)) update view
|
||||
(def app (start-app (Model (count 0) (name "") (loud #f)) gui-update view
|
||||
(fun (c) (set! roots (+ roots 1)))))
|
||||
|
||||
(defun (at path) (app-control-at app path))
|
||||
|
|
|
|||
130
tests/effects.bjo
Normal file
130
tests/effects.bjo
Normal file
|
|
@ -0,0 +1,130 @@
|
|||
;; 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/effects.bjo — commands and subscriptions.
|
||||
;;
|
||||
;; bjo run tests/effects.bjo
|
||||
;;
|
||||
;; No window is opened. The fibers of commands and subscriptions post their
|
||||
;; messages to the UI thread, and the test runs what was posted with
|
||||
;; `app-run-pending!`, as Avalonia's loop would.
|
||||
|
||||
(import (std prelude))
|
||||
(import (std simpletest))
|
||||
(import (bjogui view))
|
||||
(import (bjogui app))
|
||||
|
||||
(import/class
|
||||
(TextBlock (: Avalonia.Controls.TextBlock)))
|
||||
|
||||
(import/extern
|
||||
(block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get))
|
||||
(sleep-ms (: System.Threading.Thread.Sleep (-> int void) #:blocking)))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The program under test
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(type (: Msg (Union Load (: Loaded string) Compute (: Computed int)
|
||||
Start Stop Tick (: Got int) Other)))
|
||||
|
||||
(type (: Model (Record (: text string) (: answer int) (: running bool)
|
||||
(: ticks int) (: got (List int)) (: others int))))
|
||||
|
||||
(def jobs (: (make-chan) (Chan int)))
|
||||
|
||||
(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
|
||||
(defun (gui-update msg m)
|
||||
(match msg
|
||||
(Load (next (record-set m (text "loading"))
|
||||
(wrap (timeout (milliseconds 20)) (fun (_) (Loaded "done")))))
|
||||
((Loaded s) (next (record-set m (text s))))
|
||||
(Compute (next m (wrap (blocking (fun () (* 6 7)))
|
||||
(fun (r) (match r ((Ok n) (Computed n)) ((Err _) (Computed -1)))))))
|
||||
((Computed n) (next (record-set m (answer n))))
|
||||
(Start (next (record-set m (running #t))))
|
||||
(Stop (next (record-set m (running #f))))
|
||||
(Tick (next (record-set m (ticks (+ (.ticks m) 1)))))
|
||||
((Got n) (next (record-set m (got (cons n (.got m))))))
|
||||
(Other (next (record-set m (others (+ (.others m) 1)))))))
|
||||
|
||||
;; A channel is a rendezvous, so a send waits for the subscription's fiber.
|
||||
;; It is a fiber of its own, because `main` cannot wait on an event.
|
||||
(: (-bjo-> void))
|
||||
(defbjo (feed-jobs)
|
||||
(chan-put jobs 1)
|
||||
(chan-put jobs 2))
|
||||
|
||||
(: subscriptions (-> Model (List (Sub Msg))))
|
||||
(defun (subscriptions m)
|
||||
(cons (subscription "jobs" (fun () (wrap (chan-recv jobs) Got)))
|
||||
(if (.running m) (list (every (milliseconds 10) Tick)) '())))
|
||||
|
||||
(: view (-> Model (View Msg)))
|
||||
(defun (view m)
|
||||
(column (text (.text m)) (text #"ticks: ${(.ticks m)}")))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; The test
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(defun (main)
|
||||
(def app (start-app (Model (text "") (answer 0) (running #f) (ticks 0) (got '()) (others 0))
|
||||
gui-update view (fun (c) unit)
|
||||
#:subscriptions subscriptions))
|
||||
|
||||
;; Runs what the fibers posted until `done?` holds, for two seconds at most.
|
||||
(: (-> (-> Model bool) bool))
|
||||
(defun (wait-for done?)
|
||||
(let go ((tries 0))
|
||||
(app-run-pending! app)
|
||||
(cond ((done? (app-model app)) #t)
|
||||
((> tries 200) #f)
|
||||
(else (sleep-ms 10) (go (+ tries 1))))))
|
||||
|
||||
;; Waits a while and runs what was posted, for a check that nothing came.
|
||||
(defun (settle)
|
||||
(sleep-ms 60)
|
||||
(app-run-pending! app))
|
||||
|
||||
;; --- commands -------------------------------------------------------------
|
||||
(app-dispatch! app Load)
|
||||
(expect "a command does not wait" (.text (app-model app)) "loading")
|
||||
(expect "its message comes" (wait-for (fun (m) (= (.text m) "done"))) #t)
|
||||
(expect "and is shown" (block-text (cast TextBlock (app-control-at app '(0)))) "done")
|
||||
|
||||
(app-dispatch! app Compute)
|
||||
(expect "a blocking command" (wait-for (fun (m) (= (.answer m) 42))) #t)
|
||||
|
||||
;; --- a subscription that the model turns on and off ------------------------
|
||||
(app-dispatch! app Start)
|
||||
(expect "a running subscription ticks" (wait-for (fun (m) (>= (.ticks m) 3))) #t)
|
||||
(app-dispatch! app Other)
|
||||
(expect "it keeps ticking across other messages"
|
||||
(let ((now (.ticks (app-model app)))) (wait-for (fun (m) (> (.ticks m) now))))
|
||||
#t)
|
||||
(app-dispatch! app Stop)
|
||||
(settle)
|
||||
(def stopped-at (.ticks (app-model app)))
|
||||
(settle)
|
||||
(expect "a subscription that is gone stops" (.ticks (app-model app)) stopped-at)
|
||||
(app-dispatch! app Start)
|
||||
(expect "and starts again" (wait-for (fun (m) (> (.ticks m) stopped-at))) #t)
|
||||
(app-dispatch! app Stop)
|
||||
|
||||
;; --- a subscription of one's own --------------------------------------------
|
||||
(spawn (feed-jobs))
|
||||
(expect "values from a channel" (wait-for (fun (m) (= (.got m) '(2 1)))) #t)
|
||||
|
||||
;; --- stopping --------------------------------------------------------------
|
||||
(app-dispatch! app Start)
|
||||
(expect "ticking again" (wait-for (fun (m) (> (.ticks m) stopped-at))) #t)
|
||||
(app-stop! app)
|
||||
(settle)
|
||||
(def final (.ticks (app-model app)))
|
||||
(settle)
|
||||
(expect "a stopped app hears nothing" (.ticks (app-model app)) final)
|
||||
(app-dispatch! app Other)
|
||||
(expect "and takes no messages" (.others (app-model app)) 1)
|
||||
(println "bjogui effects ok"))
|
||||
Loading…
Add table
Add a link
Reference in a new issue