bjoli/bjogui
SHA256
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Windows besides the main one, and dialogs of the program's own

Browse source 
run-app's #:windows gives the windows a model has. The app opens a window
when it is first in the list, patches its view and title while it stays,
and closes it when it is gone. A click on its close button sends its
on-close message, and the model closes it. A #:modal window is a dialog
over the main window, so a dialog of the program's own is a window whose
state is in the model.

Windows wait for the main window to be shown, because a dialog cannot
belong to a hidden one, and the program ends when the main window closes.
Key shortcuts and commands such as focus reach the other windows too, and
#:screenshot saves a picture of each one beside the main window'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:
Linus Björnstam 2026-10-25 21:21:09 +01:00
parent 708256d0b3
commit 5127fbac13
7 changed files with 583 additions and 45 deletions
Download patch file Download diff file Expand all files Collapse all files

59
Readme.org
View file

@ -405,6 +405,40 @@ there.
(keyed "draft" (text-input (.draft m) Draft))
#+END_SRC
* Windows and dialogs of your own
[[file:docs/contacts.png]] [[file:docs/contacts-edit.png]]
A program can have windows besides the main one. ~run-app~'s ~#:windows~
gives the windows a model has, as ~view~ gives the main window's view, and
the app opens, changes and closes them to match.
#+BEGIN_SRC scheme
(: windows (-> Model (List (WindowView Msg))))
(defun (windows m)
(match (.draft m)
((Some d) (list (window "edit" "Edit contact" Cancel (draft-view d) #:modal #t)))
(None '())))
(run-app init gui-update view #:windows windows)
#+END_SRC
- ~(window key title on-close content #:width #:height #:modal)~ is a window,
known by its key. It is opened when it is first in the list, its view and
title are changed as the main window's view is while it stays, and it is
closed when it is gone.
- A click on its close button does not close it: it sends ~on-close~, and the
window closes when the next model has it no more.
- With no ~#:width~ or ~#:height~ it is as big as its content.
- A ~#:modal~ window is a dialog: the main window takes no input until it is
closed. So a dialog of one's own is a window whose state, such as a draft
being edited, is in the model, and whose view is a view like any other.
- ~window-map~ maps a window's messages, as ~view-map~ does a view's.
- The program ends when the main window is closed, and the others with it.
[[file:examples/contacts.bjo][examples/contacts.bjo]] edits a contact in a
modal dialog, and shows the chosen one in a second window.
* Dialogs: (bjogui dialogs)
A dialog is a command, and its answer comes back as a message.
@ -439,16 +473,18 @@ answered.
* Running: (bjogui app)
- ~(run-app init gui-update view #:subscriptions #:keys #:theme #:styles
#:on-close #:title #:width #:height)~ opens a window and runs until it is
closed.
#:windows #:on-close #:title #:width #:height)~ opens a window and runs
until it is closed.
- ~#:screenshot path~ makes ~run-app~ save a PNG of the window once it is
shown, at twice its size, and close it. It is the environment variable
~BJOGUI_SCREENSHOT~ unless the program says otherwise, so any program can
be pictured with no change: ~BJOGUI_SCREENSHOT=docs/todo.png bjo run
examples/todo.bjo~ made the picture above.
- ~(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.
shown, at twice its size, and close it. Each other window that is open is
saved beside it, with its key after the name: ~shot-edit.png~. It is the
environment variable ~BJOGUI_SCREENSHOT~ unless the program says
otherwise, so any program can be pictured with no change:
~BJOGUI_SCREENSHOT=docs/todo.png bjo run examples/todo.bjo~ made the
picture above.
- ~(start-app init gui-update view on-root #:subscriptions #:windows)~ 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
@ -459,6 +495,8 @@ answered.
does.
- ~app-model~ reads the model, and ~app-control-at~ finds a control by its
path of child indices.
- ~app-windows~ gives the keys of the other windows that are open, and
~app-window-control~ finds a control in one of them.
~tests/app.bjo~ and ~tests/effects.bjo~ use these to drive an app through
its real controls.
@ -485,18 +523,19 @@ bjo run tests/canvas.bjo # prints "bjogui canvas ok"
bjo run tests/components.bjo # prints "bjogui components ok"
bjo run tests/native.bjo # prints "bjogui native ok"
bjo run tests/commands.bjo # prints "bjogui commands ok"
bjo run tests/windows.bjo # prints "bjogui windows ok"
bjo run examples/counter.bjo
bjo run examples/stopwatch.bjo
bjo run examples/todo.bjo
bjo run examples/styles.bjo
bjo run examples/sketch.bjo
bjo run examples/mixer.bjo
bjo run examples/contacts.bjo
#+END_SRC
* Not yet
- A data grid, and lists that make controls only for the items on screen.
- Dialogs of one's own, with a view and a state.
- The macOS menu bar.
- Pointer-over and pressed colours for kinds other than buttons.
- A component asks for no size of its own: it is given one, or fills the

BIN
docs/contacts-edit.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 19 KiB

BIN
docs/contacts.png Normal file
View file

Binary file not shown.
Side by side

After

Width:  |  Height:  |  Size: 17 KiB

108
examples/contacts.bjo Normal file
View file

@ -0,0 +1,108 @@
;; 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/contacts.bjo — a dialog of the program's own, and a
;; second window.
;;
;; bjo run examples/contacts.bjo
;;
;; "Edit" opens a dialog with the contact's name and address. What is typed
;; there is a draft in the model, so the dialog is a view like any other;
;; "Save" puts it back, and "Cancel", Escape or the close button drop it.
;; "Details" opens a window that stays open beside the main one, and follows
;; the contact chosen in the list.
;;
;; The windows are the model's: `windows` gives those it has, and the app
;; opens, changes and closes them to match.
(import (std prelude))
(import (bjogui view))
(import (bjogui app))
(type (: Contact (Record (: name string) (: address string))))
;; The contact being edited, and which one it is.
(type (: Draft (Record (: index int) (: contact Contact))))
(type (: Msg (Union (: Edit int) (: DraftName string) (: DraftAddress string) Save Cancel
(: Choose int) ToggleDetails)))
(type (: Model (Record (: contacts (Vec Contact)) (: draft (Option Draft)) (: chosen int)
(: details bool))))
(: gui-update (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
(defun (edit-draft f)
(match (.draft m)
((Some d) (record-set m (draft (Some (record-set d (contact (f (.contact d))))))))
(None m)))
(match msg
((Edit i)
(next (record-set m (draft (Some (Draft (index i) (contact (vec-ref (.contacts m) i))))))
(focus "draft-name")))
((DraftName s) (next (edit-draft (fun (c) (record-set c (name s))))))
((DraftAddress s) (next (edit-draft (fun (c) (record-set c (address s))))))
(Save
(next (match (.draft m)
((Some d) (record-set m (contacts (vec-set (.contacts m) (.index d) (.contact d)))
(draft None)))
(None m))))
(Cancel (next (record-set m (draft None))))
((Choose i) (next (record-set m (chosen i))))
(ToggleDetails (next (record-set m (details (not (.details m))))))))
(: view (-> Model (View Msg)))
(defun (view m)
(column #:spacing 8.0 #:margin 16.0
(list-box (vec-map (fun (c) (text (.name c) #:margin 4.0)) (.contacts m)) (.chosen m) Choose
#:height 150.0)
(row #:spacing 8.0
(button "Edit" (Edit (.chosen m)) #:enabled (>= (.chosen m) 0) #:width 80.0)
(button (if (.details m) "Hide details" "Details") ToggleDetails))))
(: (-> Draft (View Msg)))
(defun (draft-view d)
(def c (.contact d))
(grid #:columns "Auto,250" #:rows "Auto,Auto,Auto" #:spacing 8.0 #:margin 16.0
(at 0 0 (text "Name"))
(at 0 1 (keyed "draft-name" (text-input (.name c) DraftName)))
(at 1 0 (text "Address"))
(at 1 1 (text-input (.address c) DraftAddress))
(at 2 1 (row #:spacing 8.0
(button "Save" Save #:width 80.0)
(button "Cancel" Cancel #:width 80.0)))))
(: windows (-> Model (List (WindowView Msg))))
(defun (windows m)
(def dialog
(match (.draft m)
((Some d) (list (window "edit" #"Edit ${(.name (vec-ref (.contacts m) (.index d)))}" Cancel
(draft-view d) #:modal #t)))
(None '())))
(def details
(if (and (.details m) (>= (.chosen m) 0))
(let ((c (vec-ref (.contacts m) (.chosen m))))
(list (window "details" "Details" ToggleDetails
(column #:spacing 4.0 #:margin 16.0
(text (.name c) #:size 18.0)
(text (.address c)))
#:width 260.0 #:height 110.0)))
'()))
(list-append dialog details))
;; Escape and Enter are the dialog's while it is open.
(: keys (-> Model (List (Key Msg))))
(defun (keys m)
(match (.draft m)
((Some _) (list (key "Escape" Cancel) (key "Enter" Save)))
(None '())))
(defun (main)
(run-app (Model (contacts [(Contact (name "Ada Lovelace") (address "12 St James's Square, London"))
(Contact (name "Alan Turing") (address "Hollymeade, Wilmslow"))
(Contact (name "Grace Hopper") (address "Arlington, Virginia"))])
(draft None) (chosen 0) (details #f))
gui-update view
#:windows windows #:keys keys
#:title "Contacts" #:width 360.0 #:height 260.0))

248
src/app.bjo
View file

@ -33,7 +33,7 @@
focus scroll-to-end scroll-to-start scroll-into-view copy-text paste-text
;; For tests and for hosts of their own: an app with no window.
start-app app-dispatch! app-send! app-stop! app-run-pending! app-press! app-input!
app-model app-control app-control-at start-headless!)
app-model app-control app-control-at app-windows app-window-control start-headless!)
(import (std prelude))
(import (std interop))
@ -176,7 +176,12 @@
(IClipboard (: Avalonia.Input.Platform.IClipboard))
(Stream (: System.IO.Stream))
(MemoryStream (: System.IO.MemoryStream (-> (Array byte) MemoryStream)))
(StreamBitmap (: Avalonia.Media.Imaging.Bitmap (-> Stream StreamBitmap))))
(StreamBitmap (: Avalonia.Media.Imaging.Bitmap (-> Stream StreamBitmap)))
;; Windows besides the main one.
(ShutdownMode (: Avalonia.Controls.ShutdownMode))
(CloseReason (: Avalonia.Controls.WindowCloseReason))
(SizeToContent (: Avalonia.Controls.SizeToContent))
(StartupLocation (: Avalonia.Controls.WindowStartupLocation)))
(import/extern
;; Properties, as the objects `SetValue` takes.
@ -430,7 +435,18 @@
(clipboard-text! (: Avalonia.Input.Platform.IClipboard.SetTextAsync (-> IClipboard string Task)))
(scroll-end! (: Avalonia.Controls.ScrollViewer.ScrollToEnd (-> ScrollViewer void)))
(scroll-home! (: Avalonia.Controls.ScrollViewer.ScrollToHome (-> ScrollViewer void)))
(bring-into-view! (: Avalonia.Controls.ControlExtensions.BringIntoView (-> Control void))))
(bring-into-view! (: Avalonia.Controls.ControlExtensions.BringIntoView (-> Control void)))
;; Windows besides the main one.
(shutdown-mode! (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.ShutdownMode
(-> Lifetime ShutdownMode void) #:set))
(close-reason (: Avalonia.Controls.WindowClosingEventArgs.CloseReason (-> ClosingArgs CloseReason) #:get))
(show-window! (: Avalonia.Controls.Window.Show (-> Window void)))
(show-dialog! (: Avalonia.Controls.Window.ShowDialog (-> Window Window Task)))
(close-window! (: Avalonia.Controls.Window.Close (-> Window void)))
(size-to-content-property (: Avalonia.Controls.Window.SizeToContentProperty #:get))
(startup-location-property (: Avalonia.Controls.Window.WindowStartupLocationProperty #:get))
(visual-visible? (: Avalonia.Visual.IsVisible (-> Visual bool) #:get)))
;; ---------------------------------------------------------------------------
;; Properties
@ -912,6 +928,13 @@
;; The app
;; ---------------------------------------------------------------------------
;; A window besides the main one, while it is open: its key, the Avalonia
;; window, the live view it shows, and the WindowView it was last given.
(type (: (Opened %m) (Record (: win-key string)
(: frame Window)
(: win-root (Live %m) #:mutable)
(: win-spec (WindowView %m) #:mutable))))
;; A running program.
;;
;; `patching` is true while the controls are being changed. A control that
@ -935,7 +958,10 @@
(: stopped bool #:mutable)
(: home Scope)
(: subs (List (Tuple string Scope)) #:mutable)
(: on-root (-> Control void)))))
(: on-root (-> Control void))
(: windows-of (-> %model (List (WindowView %m))))
(: opened (List (Opened %m)) #:mutable)
(: owner (Option Window) #:mutable))))
(: (-> (App %model %m) %model))
(defun (app-model app) (.model app))
@ -1023,7 +1049,10 @@
(:finish #t (Some msg))
=> None)))
(def found
(match (match (.root app) ((Some live) (in-view (.view live))) (None None))
(match (loop (:for live (live-roots app))
(:when-let (Some msg) (in-view (.view live)))
(:finish #t (Some msg))
=> None)
((Some msg) (Some msg))
(None (loop (:for k ((.keys app) (.model app)))
(:when (same? (key-gesture k)))
@ -1047,6 +1076,8 @@
(: (-> (App %model %m) void))
(defun (app-stop! app)
(record-set! app (stopped #t))
(loop (:for o (.opened app)) (:do (close-window! (.frame o))))
(record-set! app (opened '()))
(loop (:for (Tuple _ scope) (.subs app)) (:do (stop-scope! scope)))
(record-set! app (subs '())))
@ -1132,6 +1163,7 @@
(unless (eq? now live)
(record-set! app (root (Some now)))
((.on-root app) (.control now)))))
(sync-windows! app)
(record-set! app (patching #f)))
;; Gives the message that `pick` finds in the control's events to `gui-update`.
@ -1537,18 +1569,27 @@
(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
(-> Control void) (#:subscriptions (-> %model (List (Sub %m))))
(#:keys (-> %model (List (Key %m)))) (#:theme (-> %model string))
(#:windows (-> %model (List (WindowView %m))))
(App %model %m)))
(defun (start-app init gui-update view on-root #:subscriptions (fun (m) '())
#:keys (fun (m) '()) #:theme (fun (m) ""))
#:keys (fun (m) '()) #:theme (fun (m) "") #:windows (fun (m) '()))
(def app (make-app init gui-update view on-root subscriptions keys theme windows))
(step! app '())
app)
;; An app that has not shown its view yet.
(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
(-> Control void) (-> %model (List (Sub %m))) (-> %model (List (Key %m)))
(-> %model string) (-> %model (List (WindowView %m)))
(App %model %m)))
(defun (make-app init gui-update view on-root subscriptions keys theme windows)
(def app (App (model init) (gui-update gui-update) (view view)
(subscriptions subscriptions) (keys keys) (theme theme) (shown-theme "")
(root None) (patching #f) (stopped #f)
(home (current-scope)) (subs '()) (on-root on-root)))
(home (current-scope)) (subs '()) (on-root on-root)
(windows-of windows) (opened '()) (owner None)))
(mutablevec-add! running (Running (find (fun (key) (keyed-control app key)))
(roots (fun () (match (.root app)
((Some live) (list (.control live)))
(None '()))))))
(step! app '())
(roots (fun () (list-map (fun (l) (.control l)) (live-roots app))))))
app)
;; ---------------------------------------------------------------------------
@ -1666,21 +1707,32 @@
(list at-rest (state ":pointerover" (.hover rule)) (state ":pressed" (.pressed rule)))
(list at-rest)))))
;; A picture of `v`, `width` by `height`, saved to `path`. Twice the pixels,
;; so that it is sharp on a screen with a scale of 2.
(: (-> Visual double double string void))
(defun (save-picture! v width height path)
(def bitmap (RenderBitmap. (PixelSize. (cast System.Int32 (* 2.0 width))
(cast System.Int32 (* 2.0 height)))
(Vector. 192.0 192.0)))
(render-into! bitmap v)
(save-png! (cast Bitmap bitmap) path (clr-default)))
;; Saves a picture of the window to `path` once it has been shown and laid
;; out, and closes it. Twice the pixels of the window, so that it is sharp on
;; a screen with a scale of 2.
(: (-> Lifetime Window double double string void))
(defun (screenshot-later! lifetime w width height path)
;; out, and of each other window that is open beside it, with its key after
;; the name: "shot.png" and "shot-edit.png". Then closes them.
(: (-> Lifetime Window double double string (-> (List (Tuple string Window))) void))
(defun (screenshot-later! lifetime w width height path others)
(def timer (Timer.))
(interval! timer (seconds->span 1.0))
(ignore (add-event-handler! timer "Tick"
(: (fun (sender e)
(timer-stop! timer)
(def bitmap (RenderBitmap. (PixelSize. (cast System.Int32 (* 2.0 width))
(cast System.Int32 (* 2.0 height)))
(Vector. 192.0 192.0)))
(render-into! bitmap (cast Visual w))
(save-png! (cast Bitmap bitmap) path (clr-default))
(save-picture! (cast Visual w) width height path)
(def stem (if (string-ends-with? path ".png") (string-drop-right path 4) path))
(loop (:for (Tuple key other) (others))
(:do (def b (bounds-of (cast Visual other)))
(save-picture! (cast Visual other) (rect-width b) (rect-height b)
#"${stem}-${key}.png")))
(shutdown! lifetime 0))
(-> Object EventArgs void))))
(timer-start! timer))
@ -1701,10 +1753,11 @@
(#:subscriptions (-> %model (List (Sub %m))))
(#:keys (-> %model (List (Key %m)))) (#:on-close (Option %m))
(#:theme (-> %model string)) (#:styles (List StyleRule))
(#:windows (-> %model (List (WindowView %m))))
(#:title string) (#:width double) (#:height double) (#:screenshot string)
void))
(defun (run-app init gui-update view #:subscriptions (fun (m) '()) #:keys (fun (m) '())
#:on-close None #:theme (fun (m) "") #:styles '()
#:on-close None #:theme (fun (m) "") #:styles '() #:windows (fun (m) '())
#:title "bjogui" #:width 400.0 #:height 300.0
#:screenshot (option-ref-or (get-environment-variable "BJOGUI_SCREENSHOT") ""))
;; The Application is made inside the setup, because making one uses the
@ -1712,6 +1765,9 @@
(def lifetime (Lifetime.))
(ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.))))
lifetime))
;; The program ends when the main window is closed, and not only when the
;; last one is: the others are the model's.
(shutdown-mode! lifetime ShutdownMode.OnMainWindowClose)
(.Add (app-styles current-app) (FluentTheme. (clr-default)))
(loop (:for rule styles)
(:do (loop (:for s (avalonia-styles rule))
@ -1723,9 +1779,20 @@
(ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty height-property)
(cast Object height) Priority.LocalValue))
(with-cancel (cancel)
(def app (start-app init gui-update view
;; The other windows belong to the main one, so it is the app's before
;; the first view, which may have some.
(def app (make-app init gui-update view
(fun (c) (window-content! (cast ContentControl w) (cast Object c)))
#:subscriptions subscriptions #:keys keys #:theme theme))
subscriptions keys theme windows))
(record-set! app (owner (Some w)))
(step! app '())
;; The windows the first models had wait for the main window.
(ignore (add-event-handler! w "Opened"
(: (fun (sender e)
(record-set! app (patching #t))
(sync-windows! app)
(record-set! app (patching #f)))
(-> Object Object void))))
;; With `#:on-close`, closing the window is a message. The program closes
;; it with `quit`, which closes it by program, and that is not asked.
(match on-close
@ -1737,15 +1804,11 @@
(app-dispatch! app msg)))
(-> Object Object void)))))
(None unit))
;; Keys that no control took, such as a shortcut pressed in a text input.
(on! (cast Control w) (cast RoutedEvent key-down-event)
(fun (sender e)
(def k (cast KeyEventArgs e))
(when (press! app (KeyGesture. (key-of k) (modifiers-of k)))
(handled! e #t))))
(listen-keys! app w)
(main-window! lifetime w)
(unless (string-empty? screenshot)
(screenshot-later! lifetime w width height screenshot))
(screenshot-later! lifetime w width height screenshot
(fun () (list-map (fun (o) (Tuple (.win-key o) (.frame o))) (.opened app)))))
(ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString))))
(app-stop! app)
(cancel (Requested "the window is closed"))))
@ -2013,9 +2076,10 @@
(:when-let (Some found) (walk c))
(:finish #t (Some found))
=> None)))
(match (.root app)
((Some live) (walk live))
(None None)))
(loop (:for live (live-roots app))
(:when-let (Some found) (walk live))
(:finish #t (Some found))
=> None))
;; A command that runs `act` on the UI thread and sends no message. It runs
;; after the controls are laid out, so a control the same update made is
@ -2110,3 +2174,121 @@
(guard (fun ()
(wrap (promise-join (bjo (read-clipboard)))
(fun (r) (on-text (match r ((Ok t) t) ((Err _) None))))))))
;; ---------------------------------------------------------------------------
;; Windows besides the main one
;; ---------------------------------------------------------------------------
;; The live views at the roots: the main window's, and each other window's.
(: (-> (App %model %m) (List (Live %m))))
(defun (live-roots app)
(def others (list-map (fun (o) (.win-root o)) (.opened app)))
(match (.root app)
((Some live) (cons live others))
(None others)))
;; The keys of the windows besides the main one that are open, in order.
(: (-> (App %model %m) (List string)))
(defun (app-windows app)
(list-map (fun (o) (.win-key o)) (.opened app)))
;; The control at `path` in the window with `key`: a child index for each
;; level below its root.
(: (-> (App %model %m) string (List int) Control))
(defun (app-window-control app key 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 (loop (:for o (.opened app))
(:when (= (.win-key o) key))
(:finish #t (Some o))
=> None)
((Some o) (walk (.win-root o) path))
(None (raise (cast Exception (InvalidOperation. #"no window is open with the key ${key}"))))))
;; Keys that no control took, such as a shortcut pressed in a text input,
;; are the app's: its menu items' and its `#:keys`.
(: (-> (App %model %m) Window void))
(defun (listen-keys! app w)
(on! (cast Control w) (cast RoutedEvent key-down-event)
(fun (sender e)
(def k (cast KeyEventArgs e))
(when (press! app (KeyGesture. (key-of k) (modifiers-of k)))
(handled! e #t)))))
(: (-> Window AvaloniaProperty Object void))
(defun (window-put! w property value)
(ignore (set-value (cast AvaloniaObject w) property value Priority.LocalValue)))
;; Opens a window for `spec`. A click on its close button sends the spec's
;; `on-close`, posted so that the window is not closed by the update while
;; it is still closing; the window closes when the model has it no more.
(: (-> (App %model %m) (WindowView %m) (Opened %m)))
(defun (open-window! app spec)
(def w (Window.))
(window-title! w (window-title spec))
(if (and (> (window-width spec) 0.0) (> (window-height spec) 0.0))
(begin
(window-put! w (cast AvaloniaProperty width-property) (cast Object (window-width spec)))
(window-put! w (cast AvaloniaProperty height-property) (cast Object (window-height spec))))
(window-put! w (cast AvaloniaProperty size-to-content-property) (cast Object SizeToContent.WidthAndHeight)))
(def live (mount app (window-content spec)))
(window-content! (cast ContentControl w) (cast Object (.control live)))
(def opened (Opened (win-key (window-key spec)) (frame w) (win-root live) (win-spec spec)))
(ignore (add-event-handler! w "Closing"
(: (fun (sender e)
(def args (cast ClosingArgs e))
(when (and (not (programmatic? args))
(= (close-reason args) CloseReason.WindowClosing)
(not (.stopped app)))
(cancel-close! (cast CancelArgs e) #t)
(post! app (window-on-close (.win-spec opened)))))
(-> Object Object void))))
(listen-keys! app w)
(match (.owner app)
((Some owner)
(window-put! w (cast AvaloniaProperty startup-location-property) (cast Object StartupLocation.CenterOwner))
(if (window-modal? spec)
(ignore (show-dialog! w owner))
(show-window! w)))
(None (show-window! w)))
opened)
;; Opens the windows the model has that are not open, changes those that
;; stay, and closes those that are gone. Not before the main window is
;; shown: a window belongs to it, and a dialog cannot belong to a window
;; that is not shown. `run-app` calls this again when it is.
(: (-> (App %model %m) void))
(defun (sync-windows! app)
(unless (match (.owner app) ((Some w) (not (visual-visible? (cast Visual w)))) (None #f))
(sync-shown-windows! app)))
(: (-> (App %model %m) void))
(defun (sync-shown-windows! app)
(def wanted ((.windows-of app) (.model app)))
(defun (wanted? key) (any? (fun (spec) (= (window-key spec) key)) wanted))
(loop (:for o (.opened app))
(:when (not (wanted? (.win-key o))))
(:do (close-window! (.frame o))))
(def next
(loop (:for spec wanted)
(:acc out
(listing
(match (loop (:for o (.opened app))
(:when (= (.win-key o) (window-key spec)))
(:finish #t (Some o))
=> None)
((Some o)
(def now (patch! app (.win-root o) (window-content spec)))
(unless (eq? now (.win-root o))
(record-set! o (win-root now))
(window-content! (cast ContentControl (.frame o)) (cast Object (.control now))))
(unless (= (window-title spec) (window-title (.win-spec o)))
(window-title! (.frame o) (window-title spec)))
(record-set! o (win-spec spec))
o)
(None (open-window! app spec)))))
=> out))
(record-set! app (opened next)))

66
src/view.bjo
View file

@ -34,7 +34,11 @@
at-point on-press on-move on-release
;; Views of another message type.
view-map
view-map window-map
;; Windows besides the main one.
WindowView window window-key window-title window-on-close window-content
window-width window-height window-modal?
;; Components.
Component Input Pointer Custom component drawn
@ -807,3 +811,63 @@
(: hosted-view (-> (Hosted %m) double double double (View %m)))
(defun (hosted-view h width height margin)
(leaf NativeKind (with-layout [] width height margin 0.0) [(OnHosted h)]))
;; ---------------------------------------------------------------------------
;; Windows
;; ---------------------------------------------------------------------------
;; A window besides the main one, and what it shows. `#:windows` of
;; `run-app` gives the windows a model has, as it gives `view` the main
;; window's view.
(type (: (WindowView %m) (Record (: key string)
(: title string)
(: on-close %m)
(: content (View %m))
(: width double)
(: height double)
(: modal bool))))
;; A window, known by `key`, with `title`, showing `content`. It is opened
;; when it is first in the list of windows, changed as a view is while it
;; stays, and closed when it is gone.
;;
;; The user's click on its close button does not close it: it sends
;; `on-close`, and the window closes when the next model has it no more.
;;
;; With no `#:width` or `#:height`, it is as big as its content. A
;; `#:modal` window is a dialog: the main window takes no input until it is
;; closed.
(: window (-> string string %m (View %m) (#:width double) (#:height double) (#:modal bool)
(WindowView %m)))
(defun (window key title on-close content #:width 0.0 #:height 0.0 #:modal #f)
(WindowView (key key) (title title) (on-close on-close) (content content)
(width width) (height height) (modal modal)))
;; The window, sending `(f msg)` for each message it would send, as
;; `view-map` does for a view.
(: window-map (-> (-> %a %b) (WindowView %a) (WindowView %b)))
(defun (window-map f w)
(WindowView (key (.key w)) (title (.title w)) (on-close (f (.on-close w)))
(content (view-map f (.content w)))
(width (.width w)) (height (.height w)) (modal (.modal w))))
(: window-key (-> (WindowView %m) string))
(defun (window-key w) (.key w))
(: window-title (-> (WindowView %m) string))
(defun (window-title w) (.title w))
(: window-on-close (-> (WindowView %m) %m))
(defun (window-on-close w) (.on-close w))
(: window-content (-> (WindowView %m) (View %m)))
(defun (window-content w) (.content w))
(: window-width (-> (WindowView %m) double))
(defun (window-width w) (.width w))
(: window-height (-> (WindowView %m) double))
(defun (window-height w) (.height w))
(: window-modal? (-> (WindowView %m) bool))
(defun (window-modal? w) (.modal w))

145
tests/windows.bjo Normal file
View file

@ -0,0 +1,145 @@
;; 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/windows.bjo — windows besides the main one.
;;
;; bjo run tests/windows.bjo
;;
;; Avalonia runs with no screen, so the windows are real but not seen. A
;; click on a window's close button is made as the platform makes it.
(import (std prelude))
(import (std simpletest))
(import (std interop))
(import (bjogui view))
(import (bjogui app))
(import/class
(Object (: System.Object))
(Control (: Avalonia.Controls.Control))
(Window (: Avalonia.Controls.Window))
(TopLevel (: Avalonia.Controls.TopLevel))
(Visual (: Avalonia.Visual))
(TextBox (: Avalonia.Controls.TextBox))
(TextBlock (: Avalonia.Controls.TextBlock))
(InputElement (: Avalonia.Input.InputElement))
(Interactive (: Avalonia.Interactivity.Interactive))
(RoutedEvent (: Avalonia.Interactivity.RoutedEvent))
(RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs (-> RoutedEvent RoutedEventArgs)))
(CloseReason (: Avalonia.Controls.WindowCloseReason))
(ClrType (: System.Type))
(PropertyInfo (: System.Reflection.PropertyInfo)))
(import/extern
(top-level-of (: Avalonia.Controls.TopLevel.GetTopLevel (-> Visual TopLevel)))
(title-of (: Avalonia.Controls.Window.Title (-> Window string) #:get))
(visible? (: Avalonia.Visual.IsVisible (-> Visual bool) #:get))
(box-text! (: Avalonia.Controls.TextBox.Text (-> TextBox string void) #:set))
(block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get))
(focused? (: Avalonia.Input.InputElement.IsFocused (-> InputElement bool) #:get))
(click-event (: Avalonia.Controls.Button.ClickEvent #:get))
(raise-event (: Avalonia.Interactivity.Interactive.RaiseEvent (-> Interactive RoutedEventArgs void)))
;; What a click on the close button calls: the window's platform's Closing.
;; Avalonia hides it from C#, so it is found by reflection.
(type-named (: System.Type.GetType (-> string ClrType)))
(property-of (: System.Type.GetProperty (-> ClrType string PropertyInfo)))
(value-of (: System.Reflection.PropertyInfo.GetValue (-> PropertyInfo Object Object)))
(invoke (: System.Delegate.DynamicInvoke (-> Delegate (Array Object) Object)))
(sleep-ms (: System.Threading.Thread.Sleep (-> int void) #:blocking)))
(type (: Msg (Union OpenSettings CloseSettings OpenNotes CloseNotes (: Name string) Save FocusName)))
(type (: Model (Record (: settings bool) (: notes bool) (: name string) (: saved (List string)))))
(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m)
(match msg
(OpenSettings (next (record-set m (settings #t))))
(CloseSettings (next (record-set m (settings #f))))
(OpenNotes (next (record-set m (notes #t))))
(CloseNotes (next (record-set m (notes #f))))
((Name s) (next (record-set m (name s))))
(Save (next (record-set m (saved (cons (.name m) (.saved m))))))
(FocusName (next m (focus "name")))))
(: (-> Model (View Msg)))
(defun (view m)
(text #"name: ${(.name m)}"))
(: (-> Model (List (WindowView Msg))))
(defun (windows m)
(def settings
(window "settings" "Settings" CloseSettings
(column (keyed "name" (text-input (.name m) Name)) ; 0
(button "Save" Save)) ; 1
#:modal #t))
(def notes
(window "notes" #"Notes: ${(.name m)}" CloseNotes (text (.name m)) #:width 200.0 #:height 100.0))
(list-append (if (.settings m) (list settings) '())
(if (.notes m) (list notes) '())))
(defun (main)
(start-headless!)
(def app (start-app (Model (settings #f) (notes #f) (name "") (saved '()))
gui-update view (fun (c) unit) #:windows windows))
(defun (in-window key path) (app-window-control app key path))
(defun (frame key) (cast Window (top-level-of (cast Visual (in-window key '())))))
(defun (click c) (raise-event (cast Interactive c) (RoutedEventArgs. (cast RoutedEvent click-event))))
(: (-> (-> bool) bool))
(defun (wait-for done?)
(let go ((tries 0))
(app-run-pending! app)
(cond ((done?) #t)
((> tries 200) #f)
(else (sleep-ms 10) (go (+ tries 1))))))
(expect "no windows at first" (app-windows app) '())
;; --- opening, and the window's own view ---------------------------------------
(app-dispatch! app OpenSettings)
(expect "a window is opened" (app-windows app) '("settings"))
(def settings (frame "settings"))
(expect "with its title" (title-of settings) "Settings")
(expect "and shown" (visible? (cast Visual settings)) #t)
(box-text! (cast TextBox (in-window "settings" '(0))) "Ada")
(expect "its controls send messages" (.name (app-model app)) "Ada")
(expect "which the main view shows" (block-text (cast TextBlock (app-control app))) "name: Ada")
(click (in-window "settings" '(1)))
(expect "a button in it" (.saved (app-model app)) '("Ada"))
;; --- two windows, and changes ---------------------------------------------------
(app-dispatch! app OpenNotes)
(expect "a second window" (app-windows app) '("settings" "notes"))
(expect "the first is the same window" (eq? (cast Object (frame "settings")) (cast Object settings)) #t)
(expect "a title from the model" (title-of (frame "notes")) "Notes: Ada")
(app-dispatch! app (Name "Bob"))
(expect "changes with it" (title-of (frame "notes")) "Notes: Bob")
(expect "and so does its view" (block-text (cast TextBlock (in-window "notes" '()))) "Bob")
;; --- a command finds a control in a window ---------------------------------------
(app-dispatch! app FocusName)
(expect "focus in a window" (wait-for (fun () (focused? (cast InputElement (in-window "settings" '(0)))))) #t)
;; --- closing ----------------------------------------------------------------------
(app-dispatch! app CloseSettings)
(expect "a window the model has no more is closed" (app-windows app) '("notes"))
(expect "and not shown" (visible? (cast Visual settings)) #f)
(def notes (frame "notes"))
(defun (impl-of (: o Object) type-name property)
(value-of (property-of (type-named type-name) property) o))
(def platform (impl-of (cast Object notes) "Avalonia.Controls.TopLevel, Avalonia.Controls" "PlatformImpl"))
(def closing (impl-of platform "Avalonia.Platform.IWindowImpl, Avalonia.Controls" "Closing"))
(ignore (invoke (cast Delegate closing) (: (make-array 1 #:fill (cast Object CloseReason.WindowClosing)) (Array Object))))
(expect "a click on the close button does not close it" (visible? (cast Visual notes)) #t)
(expect "it sends on-close" (wait-for (fun () (not (.notes (app-model app))))) #t)
(expect "and the model closes it" (app-windows app) '())
(expect "so it is gone" (visible? (cast Visual notes)) #f)
;; --- stopping closes them ---------------------------------------------------------
(app-dispatch! app OpenNotes)
(def again (frame "notes"))
(app-stop! app)
(expect "a stopped app closes its windows" (visible? (cast Visual again)) #f)
(println "bjogui windows ok"))