From e3c54c43482c5ba2f6af8f725fe9f49e61dbb13c93d8f6fe7e26489c4274ec52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Linus=20Bj=C3=B6rnstam?= Date: Sun, 25 Oct 2026 18:08:34 +0100 Subject: [PATCH] Themes, classes and styles MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- src/app.bjo | 185 +++++++++++++++++++++++++++++++++++++++++++++-- src/view.bjo | 11 ++- tests/inputs.bjo | 16 +++- 3 files changed, 201 insertions(+), 11 deletions(-) diff --git a/src/app.bjo b/src/app.bjo index bd36901..ff6e6b6 100644 --- a/src/app.bjo +++ b/src/app.bjo @@ -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 diff --git a/src/view.bjo b/src/view.bjo index 9a5b3c6..6046508 100644 --- a/src/view.bjo +++ b/src/view.bjo @@ -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) diff --git a/tests/inputs.bjo b/tests/inputs.bjo index 1cdd91c..dab22b4 100644 --- a/tests/inputs.bjo +++ b/tests/inputs.bjo @@ -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"))