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

Themes, classes and styles

Browse source 
run-app's #:theme gives "light", "dark" or the system's for a model, and is
set again when it changes. classed puts a view in classes, and #:styles
are rules of style: a kind and a class, and colours, a font size, a
padding and a radius. A button's rule may also give the colours while the
pointer is over it and while it is pressed; those are set on the presenter
in its template, as the Fluent theme sets its own.

Avalonia's Selectors.Class adds a class to a type-and-class selector it is
given rather than making a new one, so each style's selector is made anew.

🤖 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 18:08:34 +01:00
parent 56a01efe76
commit e3c54c4348
3 changed files with 201 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

185
src/app.bjo
View file

@ -25,8 +25,8 @@
;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed.
(export
App Live Control Sub
run-app next
App Live Control Sub StyleRule
run-app next style
;; Subscriptions.
every subscription
;; For tests and for hosts of their own: an app with no window.
@ -100,6 +100,16 @@
(DockPanel (: Avalonia.Controls.DockPanel (-> DockPanel)))
(DockEdge (: Avalonia.Controls.Dock))
(PropertyChange (: Avalonia.AvaloniaPropertyChangedEventArgs))
(Classes (: Avalonia.Controls.Classes))
(StyledElement (: Avalonia.StyledElement))
(Selector (: Avalonia.Styling.Selector))
(AvaloniaStyle (: Avalonia.Styling.Style (-> AvaloniaStyle)))
(Setter (: Avalonia.Styling.Setter (-> AvaloniaProperty Object Setter)))
(SetterBase (: Avalonia.Styling.SetterBase))
((IListOf %a) (: System.Collections.Generic.IList))
(StyleBase (: Avalonia.Styling.StyleBase))
(ThemeVariant (: Avalonia.Styling.ThemeVariant))
(ClrType (: System.Type))
(CancelArgs (: System.ComponentModel.CancelEventArgs))
(ICollection (: System.Collections.ICollection))
(Timer (: Avalonia.Threading.DispatcherTimer (-> Timer)))
@ -210,6 +220,23 @@
(auto-watermark-property (: Avalonia.Controls.AutoCompleteBox.WatermarkProperty #:get))
(auto-text (: Avalonia.Controls.AutoCompleteBox.Text (-> AutoCompleteBox string) #:get))
(expanded? (: Avalonia.Controls.Expander.IsExpanded (-> Expander bool) #:get))
(classes-of (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
(classes-clear! (: Avalonia.Controls.Classes.Clear (-> Classes void)))
(classes-add! (: Avalonia.Controls.Classes.Add (-> Classes string void)))
(of-type (: Avalonia.Styling.Selectors.OfType (-> Selector ClrType Selector)))
(with-class (: Avalonia.Styling.Selectors.Class (-> Selector string Selector)))
(in-template (: Avalonia.Styling.Selectors.Template (-> Selector Selector)))
(named (: Avalonia.Styling.Selectors.Name (-> Selector string Selector)))
(selector! (: Avalonia.Styling.Style.Selector (-> AvaloniaStyle Selector void) #:set))
(setters-of (: Avalonia.Styling.StyleBase.Setters (-> StyleBase (IListOf SetterBase)) #:get))
(type-named (: System.Type.GetType (-> string ClrType)))
(theme-light (: Avalonia.Styling.ThemeVariant.Light #:get))
(theme-dark (: Avalonia.Styling.ThemeVariant.Dark #:get))
(theme-default (: Avalonia.Styling.ThemeVariant.Default #:get))
(requested-theme! (: Avalonia.Application.RequestedThemeVariant (-> Application ThemeVariant void) #:set))
(presenter-background (: Avalonia.Controls.Presenters.ContentPresenter.BackgroundProperty #:get))
(presenter-foreground (: Avalonia.Controls.Presenters.ContentPresenter.ForegroundProperty #:get))
(corner-property (: Avalonia.Controls.Primitives.TemplatedControl.CornerRadiusProperty #:get))
(changed-property (: Avalonia.AvaloniaPropertyChangedEventArgs.Property
(-> PropertyChange AvaloniaProperty) #:get))
(wrap-item-spacing (: Avalonia.Controls.WrapPanel.ItemSpacingProperty #:get))
@ -459,6 +486,7 @@
((PropTip _) (Some (cast AvaloniaProperty tip-property)))
((PropExpanded _) (when-kind (= kind ExpanderKind) (cast AvaloniaProperty expanded-property)))
((PropDockSide _) (Some (cast AvaloniaProperty dock-property)))
((PropClasses _) None)
((PropDate _) (when-kind (= kind DateKind) (cast AvaloniaProperty date-property)))
;; Set by `set-prop!` itself.
((PropSource _) None)
@ -544,6 +572,7 @@
((PropTip s) (text s))
((PropExpanded b) (cast Object b))
((PropDate s) (text s))
((PropClasses _) (cast Object 0))
((PropDockSide i)
(cast Object (match i (0 DockEdge.Left) (1 DockEdge.Top) (2 DockEdge.Right) (_ DockEdge.Bottom))))))
@ -560,7 +589,7 @@
((PropRows _) 20) ((PropRow _) 21) ((PropColumn _) 22) ((PropRowSpan _) 23) ((PropColumnSpan _) 24)
((PropBackground _) 25) ((PropForeground _) 26) ((PropBorderColour _) 27) ((PropBorderWidth _) 28)
((PropRadius _) 29) ((PropShortcut _) 30) ((PropTip _) 31) ((PropExpanded _) 32) ((PropDate _) 33)
((PropDockSide _) 34)))
((PropDockSide _) 34) ((PropClasses _) 35)))
(: (-> Control AvaloniaProperty Object void))
(defun (put! control property value)
@ -588,6 +617,10 @@
((Tuple WrapKind (PropSpacing d))
(put! control (cast AvaloniaProperty wrap-item-spacing) (cast Object d))
(put! control (cast AvaloniaProperty wrap-line-spacing) (cast Object d)))
((Tuple _ (PropClasses names))
(def classes (classes-of (cast StyledElement control)))
(classes-clear! classes)
(loop (:for n names) (:do (classes-add! classes n))))
;; A number input's numbers are decimals.
((Tuple NumberKind (PropMinimum d))
(put! control (cast AvaloniaProperty number-minimum-property) (cast Object (cast System.Decimal d))))
@ -618,6 +651,7 @@
((Tuple WrapKind (PropSpacing _))
(clear (cast AvaloniaProperty wrap-item-spacing))
(clear (cast AvaloniaProperty wrap-line-spacing)))
((Tuple _ (PropClasses _)) (classes-clear! (classes-of (cast StyledElement control))))
(_
(match (slot kind p)
((Some property) (clear property))
@ -698,6 +732,8 @@
(: view (-> %model (View %m)))
(: subscriptions (-> %model (List (Sub %m))))
(: keys (-> %model (List (Key %m))))
(: theme (-> %model string))
(: shown-theme string #:mutable)
(: root (Option (Live %m)) #:mutable)
(: patching bool #:mutable)
(: stopped bool #:mutable)
@ -809,6 +845,7 @@
(: (-> (App %model %m) (List (Event %m)) void))
(defun (step! app commands)
(render! app)
(apply-theme! app)
(in-scope (.home app)
(loop (:for command commands)
(:do (spawn/daemon (run-command app command)))))
@ -857,6 +894,18 @@
(:do (set! kept (cons (Tuple (sub-key sub) (start-sub! app sub)) kept))))
(record-set! app (subs kept)))
;; Sets the theme the model asks for, when it is another than the one shown.
;; "light" and "dark" are those; anything else is the system's.
(: (-> (App %model %m) void))
(defun (apply-theme! app)
(def wanted ((.theme app) (.model app)))
(unless (= wanted (.shown-theme app))
(record-set! app (shown-theme wanted))
(def application (cast Object current-app))
(unless (eq? application (clr-default))
(requested-theme! (cast Application application)
(match wanted ("light" theme-light) ("dark" theme-dark) (_ theme-default))))))
(: (-> (App %model %m) void))
(defun (render! app)
(def next-view ((.view app) (.model app)))
@ -1166,16 +1215,132 @@
;; 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))))
(#:keys (-> %model (List (Key %m))))
(#:keys (-> %model (List (Key %m)))) (#:theme (-> %model string))
(App %model %m)))
(defun (start-app init gui-update view on-root #:subscriptions (fun (m) '())
#:keys (fun (m) '()))
#:keys (fun (m) '()) #:theme (fun (m) ""))
(def app (App (model init) (gui-update gui-update) (view view)
(subscriptions subscriptions) (keys keys) (root None) (patching #f) (stopped #f)
(subscriptions subscriptions) (keys keys) (theme theme) (shown-theme "")
(root None) (patching #f) (stopped #f)
(home (current-scope)) (subs '()) (on-root on-root)))
(step! app '())
app)
;; ---------------------------------------------------------------------------
;; Styles
;; ---------------------------------------------------------------------------
;; A style: the look of every view of a kind, or of a kind and a class.
(type (: StyleRule (Record (: kind string) (: class string) (: props (Vec Prop))
(: hover (Vec Prop)) (: pressed (Vec Prop)))))
(: (-> (Vec Prop) string (-> string Prop) (Vec Prop)))
(defun (with-colour props c make)
(if (string-empty? c) props (vec-add props (make c))))
;; The look of every view of `kind` in the class `#:class`, or of every view
;; of `kind` if there is no class. `kind` is the name of the constructor:
;; "button", "text", "text-input", "checkbox", "border" and so on.
;;
;; `#:hover-…` and `#:pressed-…` are the colours while the pointer is over a
;; button and while it is pressed. They are set inside the button's template,
;; as the Fluent theme sets its own, and so only a button has them.
(: style (-> string (#:class string) (#:colour string) (#:background string)
(#:hover-colour string) (#:hover-background string)
(#:pressed-colour string) (#:pressed-background string)
(#:font-size double) (#:padding double) (#:radius double)
StyleRule))
(defun (style kind #:class "" #:colour "" #:background "" #:hover-colour "" #:hover-background ""
#:pressed-colour "" #:pressed-background "" #:font-size 0.0 #:padding 0.0
#:radius 0.0)
(defun (size props make d) (if (> d 0.0) (vec-add props (make d)) props))
(StyleRule (kind kind) (class class)
(props (size (size (size (with-colour (with-colour [] colour PropForeground)
background PropBackground)
PropFontSize font-size)
PropPadding padding)
PropRadius radius))
(hover (with-colour (with-colour [] hover-colour PropForeground)
hover-background PropBackground))
(pressed (with-colour (with-colour [] pressed-colour PropForeground)
pressed-background PropBackground))))
;; The kind a constructor's name makes, and the Avalonia class of it.
(: (-> string (Option (Tuple Kind string))))
(defun (styled-kind name)
(match name
("text" (Some (Tuple TextKind "Avalonia.Controls.TextBlock")))
("button" (Some (Tuple ButtonKind "Avalonia.Controls.Button")))
("text-input" (Some (Tuple TextInputKind "Avalonia.Controls.TextBox")))
("text-area" (Some (Tuple TextAreaKind "Avalonia.Controls.TextBox")))
("checkbox" (Some (Tuple CheckBoxKind "Avalonia.Controls.CheckBox")))
("toggle-switch" (Some (Tuple ToggleSwitchKind "Avalonia.Controls.ToggleSwitch")))
("radio" (Some (Tuple RadioKind "Avalonia.Controls.RadioButton")))
("list-box" (Some (Tuple ListBoxKind "Avalonia.Controls.ListBox")))
("dropdown" (Some (Tuple DropdownKind "Avalonia.Controls.ComboBox")))
("border" (Some (Tuple BorderKind "Avalonia.Controls.Border")))
("column" (Some (Tuple ColumnKind "Avalonia.Controls.StackPanel")))
("row" (Some (Tuple RowKind "Avalonia.Controls.StackPanel")))
("grid" (Some (Tuple GridKind "Avalonia.Controls.Grid")))
(_ None)))
;; The setters are a List of Avalonia's, so they are reached as an IList.
(: (-> AvaloniaStyle Setter void))
(defun (add-setter! s setter)
(ignore (list-add! (cast IList (cast Object (setters-of (cast StyleBase s)))) (cast Object setter))))
;; A setter for each prop that the kind takes.
(: (-> AvaloniaStyle Kind (Vec Prop) void))
(defun (add-setters! s kind props)
(loop (:for p props)
(:do (def property
(match (Tuple kind p)
((Tuple BorderKind (PropRadius _)) (Some (cast AvaloniaProperty corner-radius-property)))
((Tuple _ (PropRadius _))
(if (templated? kind) (Some (cast AvaloniaProperty corner-property)) None))
(_ (slot kind p))))
(match (Tuple property (boxed p))
((Tuple (Some prop) (Some value))
(add-setter! s (Setter. prop value)))
(_ unit)))))
;; The setters of a state of a button, on the presenter in its template.
(: (-> AvaloniaStyle (Vec Prop) void))
(defun (add-presenter-setters! s props)
(loop (:for p props)
(:do (match (Tuple p (boxed p))
((Tuple (PropBackground _) (Some v))
(add-setter! s (Setter. (cast AvaloniaProperty presenter-background) v)))
((Tuple (PropForeground _) (Some v))
(add-setter! s (Setter. (cast AvaloniaProperty presenter-foreground) v)))
(_ unit)))))
;; The Avalonia styles of a rule: the look at rest, and for a button the look
;; while the pointer is over it and while it is pressed. A kind that has no
;; name here makes none.
(: (-> StyleRule (List AvaloniaStyle)))
(defun (avalonia-styles rule)
(match (styled-kind (.kind rule))
(None '())
((Some (Tuple kind type-name))
;; Made anew for each style, because Selectors.Class adds a class to a
;; type-and-class selector it is given, and does not make a new one.
(defun (base)
(def t (of-type (clr-default) (type-named #"${type-name}, Avalonia.Controls")))
(if (string-empty? (.class rule)) t (with-class t (.class rule))))
(defun (make sel) (def s (AvaloniaStyle.)) (selector! s sel) s)
(def at-rest (make (base)))
(add-setters! at-rest kind (.props rule))
(defun (state pseudo props)
(def s (make (named (of-type (in-template (with-class (base) pseudo))
(type-named "Avalonia.Controls.Presenters.ContentPresenter, Avalonia.Controls"))
"PART_ContentPresenter")))
(add-presenter-setters! s props)
s)
(if (and (= kind ButtonKind) (or (> (vec-length (.hover rule)) 0) (> (vec-length (.pressed rule)) 0)))
(list at-rest (state ":pointerover" (.hover rule)) (state ":pressed" (.pressed rule)))
(list at-rest)))))
;; 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.
@ -1210,10 +1375,11 @@
(: (-> %model (-> %m %model (Tuple %model (List (Event %m)))) (-> %model (View %m))
(#:subscriptions (-> %model (List (Sub %m))))
(#:keys (-> %model (List (Key %m)))) (#:on-close (Option %m))
(#:theme (-> %model string)) (#:styles (List StyleRule))
(#: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
#:on-close None #:theme (fun (m) "") #:styles '()
#: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
@ -1222,6 +1388,9 @@
(ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.))))
lifetime))
(.Add (app-styles current-app) (FluentTheme. (clr-default)))
(loop (:for rule styles)
(:do (loop (:for s (avalonia-styles rule))
(:do (.Add (app-styles current-app) s)))))
(def w (Window.))
(window-title! w title)
(ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty width-property)
@ -1231,7 +1400,7 @@
(with-cancel (cancel)
(def app (start-app init gui-update view
(fun (c) (window-content! (cast ContentControl w) (cast Object c)))
#:subscriptions subscriptions #:keys keys))
#:subscriptions subscriptions #:keys keys #:theme theme))
;; 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

11
src/view.bjo
View file

@ -24,7 +24,7 @@
toggle-switch radio number-input date-picker auto-complete expander
column row grid scroll border flow dock
;; Wrappers.
keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right
keyed at paint with-context-menu tooltip at-top at-bottom at-left at-right classed
;; Keyboard shortcuts.
Key key key-gesture key-message
@ -83,7 +83,8 @@
(: PropTip string) ; shown when the pointer rests on a view
(: PropExpanded bool) ; whether an expander shows its content
(: PropDate string) ; a date picker's date, as "2026-10-25"
(: PropDockSide int)))) ; where a view is in its dock: 0 to 3
(: PropDockSide int) ; where a view is in its dock: 0 to 3
(: PropClasses (Vec string))))) ; the classes that styles match
;; An event, and the message it sends.
(type (: (On %m) (Union (: OnClick %m)
@ -143,6 +144,12 @@
(defun (with-context-menu v #:rest items)
(container ContextKind [] [v (container ContextMenuKind [] (array->vec items))]))
;; The view, in the classes `names`, which the styles given to `run-app`
;; match with `#:class`.
(: classed (-> (View %m) #:rest string (View %m)))
(defun (classed v #:rest names)
(record-set v (props (vec-add (.props v) (PropClasses (array->vec names))))))
;; The view, with `text` shown when the pointer rests on it.
(: tooltip (-> (View %m) string (View %m)))
(defun (tooltip v text)

16
tests/inputs.bjo
View file

@ -32,6 +32,8 @@
(AutoCompleteBox (: Avalonia.Controls.AutoCompleteBox))
(Expander (: Avalonia.Controls.Expander))
(DockEdge (: Avalonia.Controls.Dock))
(StyledElement (: Avalonia.StyledElement))
(Classes (: Avalonia.Controls.Classes))
((Nullable %a) (: System.Nullable)))
(import/extern
@ -52,6 +54,7 @@
(dock-of (: Avalonia.Controls.DockPanel.GetDock (-> Control DockEdge)))
(children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get))
(count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))
(classes-of (: Avalonia.StyledElement.Classes (-> StyledElement Classes) #:get))
(clr-string (: System.Convert.ToString (-> string ClrString))))
(type (: Msg (Union (: Switched bool) (: Picked string) (: Amount double) (: Dated string)
@ -81,7 +84,8 @@
(expander "More" (.open m) Opened (text "inside")) ; 5
(tooltip (text "hover me") "a tip") ; 6
(flow #:spacing 4.0 (text "a") (text "b") (text "c")) ; 7
(dock (at-top (text "top")) (text "fill")))) ; 8
(dock (at-top (text "top")) (text "fill")) ; 8
(if (.open m) (classed (text "c") "wide") (classed (text "c") "big" "red")))) ; 9
(defun (main)
(def app (start-app (Model (on #f) (pick "tea") (amount 2.0) (date "2026-10-25")
@ -127,4 +131,14 @@
(expect "a flow's children" (count (children (cast Panel (ctl '(7))))) 3)
(expect "a docked child" (written (dock-of (ctl '(8 0)))) "Top")
;; --- classes ---------------------------------------------------------------------
;; The expander was opened above, so the view has "wide" and not the others.
(def cls (classes-of (cast StyledElement (ctl '(9)))))
(defun (has-class? (: c Classes) (: name string)) (.Contains c name))
(expect "a class" (has-class? cls "wide") #t)
(expect "the classes of the last view are gone" (has-class? cls "big") #f)
(put! '(5) (cast AvaloniaProperty expanded-property) (cast Object #f))
(expect "and change with the model" (list (has-class? cls "big") (has-class? cls "red") (has-class? cls "wide"))
'(#t #t #f))
(println "bjogui inputs ok"))