commit 2f4c99ba62b02ddc4c6d6ff5c59ebed895e3b3b7883330a5f14eda58ee804ee0 Author: Linus Björnstam Date: Sun Oct 25 16:18:09 2026 +0100 Views, events as messages, and a patch, over plain Avalonia A program is a model, an update and a view. A view is a Bjolang value; an event finds its message in the view its control was last given, and the next view is compared with the last so only what differs is changed. Controls are made with plain constructors and changed with SetValue, so nothing is subclassed, and a program never names an Avalonia type. Text, button, text input, checkbox, column and row. tests/app.bjo drives an app through its real controls with no window. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ca84534 --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +.bjo/ +publish/ +*.dll +*.exe +*.pdb +*.bjobuild +*.runtimeconfig.json +*.deps.json diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..d22367a --- /dev/null +++ b/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + 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 https://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/Readme.org b/Readme.org new file mode 100644 index 0000000..181c3cd --- /dev/null +++ b/Readme.org @@ -0,0 +1,88 @@ +#+TITLE: bjogui + +Desktop programs in Bjolang, written as a model, an ~update~ and a ~view~, and +shown with [[https://avaloniaui.net][Avalonia]]. + +#+BEGIN_SRC scheme +(import (bjogui view)) +(import (bjogui app)) + +(type (: Msg (Union Inc Dec))) + +(: update (-> Msg int int)) +(defun (update msg n) + (match msg (Inc (+ n 1)) (Dec (- n 1)))) + +(: view (-> int (View Msg))) +(defun (view n) + (row #:spacing 8.0 #:margin 16.0 + (button "-" Dec) + (text #"${n}") + (button "+" Inc))) + +(defun (main) + (run-app 0 update view #:title "Counter")) +#+END_SRC + +A program never names an Avalonia type. A view is a Bjolang value, an event +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 +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. + +Children are matched by their place in the list. A child whose kind changes +gets a new control. + +A control that is changed raises events of its own: a text input whose text +is set says that its text changed. Those events come while the controls are +being changed, and they are dropped, so only the user's events are messages. + +* The views: (bjogui view) + +| Constructor | Control | Sends | +|--------------------------------------------------+--------------+-----------------------------| +| ~(text s)~ | ~TextBlock~ | nothing | +| ~(button label msg)~ | ~Button~ | ~msg~ on a click | +| ~(text-input value on-input)~ | ~TextBox~ | ~(on-input text)~ on a change | +| ~(checkbox label checked? on-toggle)~ | ~CheckBox~ | ~(on-toggle checked)~ | +| ~(column child ...)~, ~(row child ...)~ | ~StackPanel~ | nothing | + +They take keywords where they apply: ~#:size~ (the font size of a text), +~#:width~, ~#:height~, ~#:margin~, ~#:padding~, ~#:spacing~ (between the +children of a column or a row), ~#:enabled~ and ~#:placeholder~. A size of +zero, the default, leaves the size to the control. + +* 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 + its real controls. + +* Requirements + +- Avalonia 11.3, which ~bjo~ restores from NuGet. On Linux it needs X11 or + XWayland. +- A Bjolang with ~(std interop)~, which makes the delegates that Avalonia's + events take. + +* Tests + +#+BEGIN_SRC sh +bjo run tests/app.bjo # prints "bjogui ok" +bjo run examples/counter.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. diff --git a/examples/counter.bjo b/examples/counter.bjo new file mode 100644 index 0000000..ca968fb --- /dev/null +++ b/examples/counter.bjo @@ -0,0 +1,34 @@ +;; 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/counter.bjo — a counter and a greeting in a window. +;; +;; bjo run examples/counter.bjo + +(import (std prelude)) +(import (bjogui view)) +(import (bjogui app)) + +(type (: Msg (Union Inc Dec (: Typed string)))) +(type (: Model (Record (: count int) (: name string)))) + +(: update (-> Msg Model Model)) +(defun (update msg m) + (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))))) + +(: view (-> Model (View Msg))) +(defun (view m) + (column #:spacing 8.0 #:margin 16.0 + (text-input (.name m) Typed #:placeholder "Your name") + (text #"Hello, ${(if (string-empty? (.name m)) "stranger" (.name m))}!" #:size 18.0) + (row #:spacing 8.0 + (button "-" Dec #:width 40.0) + (text #"${(.count m)}" #:size 18.0 #:margin 4.0) + (button "+" Inc #:width 40.0)))) + +(defun (main) + (run-app (Model (count 0) (name "")) update view #:title "Counter" #:width 320.0 #:height 200.0)) diff --git a/manifest.bjodat b/manifest.bjodat new file mode 100644 index 0000000..33285c1 --- /dev/null +++ b/manifest.bjodat @@ -0,0 +1,12 @@ +(package + (name (bjogui)) + (version "0.1.0") + (description "Desktop programs as a model, an update and a view, shown with Avalonia.") + (license "MPL-2.0") + + ;; Avalonia draws the controls. Avalonia.Desktop picks the platform: X11 on + ;; Linux, Win32 on Windows, Cocoa on macOS. + (packages + (nuget (id "Avalonia") (version "11.3.2")) + (nuget (id "Avalonia.Desktop") (version "11.3.2")) + (nuget (id "Avalonia.Themes.Fluent") (version "11.3.2")))) diff --git a/packages.lock.json b/packages.lock.json new file mode 100644 index 0000000..ac60a16 --- /dev/null +++ b/packages.lock.json @@ -0,0 +1,176 @@ +{ + "version": 1, + "dependencies": { + "net10.0": { + "Avalonia": { + "type": "Direct", + "requested": "[11.3.2, )", + "resolved": "11.3.2", + "contentHash": "3w1v4/wEpHFq6WWVNyyrne2Jyz5bdQvnK3AW36rCto42L+AtdbnO/SG2SIqJ7ObXJl+Y3LXz2XDGx9Blzqduow==", + "dependencies": { + "Avalonia.BuildServices": "0.0.31", + "Avalonia.Remote.Protocol": "11.3.2", + "MicroCom.Runtime": "0.11.0" + } + }, + "Avalonia.Desktop": { + "type": "Direct", + "requested": "[11.3.2, )", + "resolved": "11.3.2", + "contentHash": "b2ZPZ60UN0Uib3ZxFrf+ixYiJTBFaXrpQAcXTSUKTDw0nAU29sbfjvdtpBkBd6+idWpNtI+GhOjf0Mw0v1ncQg==", + "dependencies": { + "Avalonia": "11.3.2", + "Avalonia.Native": "11.3.2", + "Avalonia.Skia": "11.3.2", + "Avalonia.Win32": "11.3.2", + "Avalonia.X11": "11.3.2" + } + }, + "Avalonia.Themes.Fluent": { + "type": "Direct", + "requested": "[11.3.2, )", + "resolved": "11.3.2", + "contentHash": "aRCCmFSumpHJOxsXbdUUc/AaJ/O1HLggfvSxtXYm84QCutuP4OCqgxP9Pka1hb1+2e/TQxfNqM/6KRKPt4SaRg==", + "dependencies": { + "Avalonia": "11.3.2" + } + }, + "Avalonia.Angle.Windows.Natives": { + "type": "Transitive", + "resolved": "2.1.25547.20250602", + "contentHash": "ZL0VLc4s9rvNNFt19Pxm5UNAkmKNylugAwJPX9ulXZ6JWs/l6XZihPWWTyezaoNOVyEPU8YbURtW7XMAtqXH5A==" + }, + "Avalonia.BuildServices": { + "type": "Transitive", + "resolved": "0.0.31", + "contentHash": "KmCN6Hc+45q4OnF10ge450yVUvWuxU6bdQiyKqiSvrHKpahNrEdk0kG6Ip6GHk2SKOCttGQuA206JVdkldEENg==" + }, + "Avalonia.FreeDesktop": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "8laGOvPM83kB4xUqXGIRxN61Q5Ux/97URL7CU2Dizh4Nm7Ydj9+urKLTylk6dxWG7kZlo4e4k9G2aVUPkxTBGA==", + "dependencies": { + "Avalonia": "11.3.2", + "Tmds.DBus.Protocol": "0.21.2" + } + }, + "Avalonia.Native": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "dv3PVUcClxeDlNSoBjTdNuRYXdbzT3BgtpjEX/fv3pVreKfbh39wWQ+n4ecGh0FUKIlcj0X8BEaQ83t5eRsLnA==", + "dependencies": { + "Avalonia": "11.3.2" + } + }, + "Avalonia.Remote.Protocol": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "my6aXePR+N7tl3xDKdYNH2ZFZWUSNmyeU37HIgYJX2fQ4IOBv7SeaWBEd1F/qVsIbOlYxaqE7qOPfeFFtdYq/A==" + }, + "Avalonia.Skia": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "PJIPSqkWbQpKyWPMEIDAWYQaJ8xpJASg2H75sGWCkthLj+mCG/DZxdHI6UsDAcxKu/ppSRkX88RGo117bRYfFg==", + "dependencies": { + "Avalonia": "11.3.2", + "HarfBuzzSharp": "8.3.1.1", + "HarfBuzzSharp.NativeAssets.Linux": "8.3.1.1", + "HarfBuzzSharp.NativeAssets.WebAssembly": "8.3.1.1", + "SkiaSharp": "2.88.9", + "SkiaSharp.NativeAssets.Linux": "2.88.9", + "SkiaSharp.NativeAssets.WebAssembly": "2.88.9" + } + }, + "Avalonia.Win32": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "CpM6zBwDwMFKw9/iyj0d8jxXKLZena/HFblS9Oc7BmLH8qxe8icr7ZBI5rElebrxDA5O590dAtfWdtOvB1/AZQ==", + "dependencies": { + "Avalonia": "11.3.2", + "Avalonia.Angle.Windows.Natives": "2.1.25547.20250602" + } + }, + "Avalonia.X11": { + "type": "Transitive", + "resolved": "11.3.2", + "contentHash": "MEMXOIaAr6jMtl9BhJ8sj7Vz+z19dWfcryWksV35LsolQhQmjmzJPVcCppdnvm5HxkohUXB1qN1RqWN1cqRwBQ==", + "dependencies": { + "Avalonia": "11.3.2", + "Avalonia.FreeDesktop": "11.3.2", + "Avalonia.Skia": "11.3.2" + } + }, + "HarfBuzzSharp": { + "type": "Transitive", + "resolved": "8.3.1.1", + "contentHash": "tLZN66oe/uiRPTZfrCU4i8ScVGwqHNh5MHrXj0yVf4l7Mz0FhTGnQ71RGySROTmdognAs0JtluHkL41pIabWuQ==", + "dependencies": { + "HarfBuzzSharp.NativeAssets.Win32": "8.3.1.1", + "HarfBuzzSharp.NativeAssets.macOS": "8.3.1.1" + } + }, + "HarfBuzzSharp.NativeAssets.Linux": { + "type": "Transitive", + "resolved": "8.3.1.1", + "contentHash": "3EZ1mpIiKWRLL5hUYA82ZHteeDIVaEA/Z0rA/wU6tjx6crcAkJnBPwDXZugBSfo8+J3EznvRJf49uMsqYfKrHg==" + }, + "HarfBuzzSharp.NativeAssets.macOS": { + "type": "Transitive", + "resolved": "8.3.1.1", + "contentHash": "jbtCsgftcaFLCA13tVKo5iWdElJScrulLTKJre36O4YQTIlwDtPPqhRZNk+Y0vv4D1gxbscasGRucUDfS44ofQ==" + }, + "HarfBuzzSharp.NativeAssets.WebAssembly": { + "type": "Transitive", + "resolved": "8.3.1.1", + "contentHash": "loJweK2u/mH/3C2zBa0ggJlITIszOkK64HLAZB7FUT670dTg965whLFYHDQo69NmC4+d9UN0icLC9VHidXaVCA==" + }, + "HarfBuzzSharp.NativeAssets.Win32": { + "type": "Transitive", + "resolved": "8.3.1.1", + "contentHash": "UsJtQsfAJoFDZrXc4hCUfRPMqccfKZ0iumJ/upcUjz/cmsTgVFGNEL5yaJWmkqsuFYdMWbj/En5/kS4PFl9hBA==" + }, + "MicroCom.Runtime": { + "type": "Transitive", + "resolved": "0.11.0", + "contentHash": "MEnrZ3UIiH40hjzMDsxrTyi8dtqB5ziv3iBeeU4bXsL/7NLSal9F1lZKpK+tfBRnUoDSdtcW3KufE4yhATOMCA==" + }, + "SkiaSharp": { + "type": "Transitive", + "resolved": "2.88.9", + "contentHash": "3MD5VHjXXieSHCleRLuaTXmL2pD0mB7CcOB1x2kA1I4bhptf4e3R27iM93264ZYuAq6mkUyX5XbcxnZvMJYc1Q==", + "dependencies": { + "SkiaSharp.NativeAssets.Win32": "2.88.9", + "SkiaSharp.NativeAssets.macOS": "2.88.9" + } + }, + "SkiaSharp.NativeAssets.Linux": { + "type": "Transitive", + "resolved": "2.88.9", + "contentHash": "cWSaJKVPWAaT/WIn9c8T5uT/l4ETwHxNJTkEOtNKjphNo8AW6TF9O32aRkxqw3l8GUdUo66Bu7EiqtFh/XG0Zg==", + "dependencies": { + "SkiaSharp": "2.88.9" + } + }, + "SkiaSharp.NativeAssets.macOS": { + "type": "Transitive", + "resolved": "2.88.9", + "contentHash": "Nv5spmKc4505Ep7oUoJ5vp3KweFpeNqxpyGDWyeEPTX2uR6S6syXIm3gj75dM0YJz7NPvcix48mR5laqs8dPuA==" + }, + "SkiaSharp.NativeAssets.WebAssembly": { + "type": "Transitive", + "resolved": "2.88.9", + "contentHash": "kt06RccBHSnAs2wDYdBSfsjIDbY3EpsOVqnlDgKdgvyuRA8ZFDaHRdWNx1VHjGgYzmnFCGiTJBnXFl5BqGwGnA==" + }, + "SkiaSharp.NativeAssets.Win32": { + "type": "Transitive", + "resolved": "2.88.9", + "contentHash": "wb2kYgU7iy84nQLYZwMeJXixvK++GoIuECjU4ECaUKNuflyRlJKyiRhN1MAHswvlvzuvkrjRWlK0Za6+kYQK7w==" + }, + "Tmds.DBus.Protocol": { + "type": "Transitive", + "resolved": "0.21.2", + "contentHash": "ScSMrUrrw8px4kK1Glh0fZv/HQUlg1078bNXNPfRPKQ3WbRzV9HpsydYEOgSoMK5LWICMf2bMwIFH0pGjxjcMA==" + } + } + } +} \ No newline at end of file diff --git a/src/app.bjo b/src/app.bjo new file mode 100644 index 0000000..b906b54 --- /dev/null +++ b/src/app.bjo @@ -0,0 +1,424 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +;; bjogui/src/app.bjo — the module (bjogui app). +;; +;; Runs a program written as a model, an `update` and a `view`, in an Avalonia +;; window. Every Avalonia name stays in this module: what it exports takes +;; and gives Bjolang values, and a control only as an opaque `Control`. +;; +;; The loop: an event finds its message in the view the control was last +;; given. `update` makes the next model from it, and `view` the next view. +;; The next view is compared with the last one, control by control, and only +;; what differs is changed. So a control keeps its focus, its caret and its +;; scroll position when the model changes. +;; +;; Every control is made with plain constructors and changed with +;; `AvaloniaObject.SetValue`, so no Avalonia class is subclassed. + +(export + App Live Control + run-app + ;; For tests and for hosts of their own: an app with no window. + start-app app-dispatch! app-model app-control app-control-at) + +(import (std prelude)) +(import (std interop)) +(import (std mutable vec)) +(import (bjogui view)) + +;; --------------------------------------------------------------------------- +;; Avalonia +;; --------------------------------------------------------------------------- + +(import/class + (Object (: System.Object)) + (InvalidOperation (: System.InvalidOperationException (-> string InvalidOperation))) + (ClrString (: System.String)) + (Disposable (: System.IDisposable)) + (Services (: System.IServiceProvider)) + ((Nullable %a) (: System.Nullable)) + ((EventHandler %a) (: System.EventHandler)) + (AvaloniaObject (: Avalonia.AvaloniaObject)) + (AvaloniaProperty (: Avalonia.AvaloniaProperty)) + (Priority (: Avalonia.Data.BindingPriority)) + (Thickness (: Avalonia.Thickness (-> double Thickness))) + (Orientation (: Avalonia.Layout.Orientation)) + (HAlignment (: Avalonia.Layout.HorizontalAlignment)) + (Control (: Avalonia.Controls.Control)) + (Controls (: Avalonia.Controls.Controls)) + (Panel (: Avalonia.Controls.Panel)) + (StackPanel (: Avalonia.Controls.StackPanel (-> StackPanel))) + (TextBlock (: Avalonia.Controls.TextBlock (-> TextBlock))) + (Button (: Avalonia.Controls.Button (-> Button))) + (TextBox (: Avalonia.Controls.TextBox (-> TextBox))) + (CheckBox (: Avalonia.Controls.CheckBox (-> CheckBox))) + (ToggleButton (: Avalonia.Controls.Primitives.ToggleButton)) + (ContentControl (: Avalonia.Controls.ContentControl)) + (Window (: Avalonia.Controls.Window (-> Window))) + (Interactive (: Avalonia.Interactivity.Interactive)) + (RoutedEvent (: Avalonia.Interactivity.RoutedEvent)) + (RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs)) + (Routes (: Avalonia.Interactivity.RoutingStrategies)) + (Application (: Avalonia.Application (-> Application))) + (Styles (: Avalonia.Styling.Styles)) + (FluentTheme (: Avalonia.Themes.Fluent.FluentTheme (-> Services FluentTheme))) + (AppBuilder (: Avalonia.AppBuilder)) + (ILifetime (: Avalonia.Controls.ApplicationLifetimes.IApplicationLifetime)) + (Lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime + (-> Lifetime)))) + +(import/extern + ;; Properties, as the objects `SetValue` takes. + (text-block-text (: Avalonia.Controls.TextBlock.TextProperty #:get)) + (text-block-font-size (: Avalonia.Controls.TextBlock.FontSizeProperty #:get)) + (content-property (: Avalonia.Controls.ContentControl.ContentProperty #:get)) + (text-box-text (: Avalonia.Controls.TextBox.TextProperty #:get)) + (watermark-property (: Avalonia.Controls.TextBox.WatermarkProperty #:get)) + (is-checked-property (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get)) + (is-enabled-property (: Avalonia.Input.InputElement.IsEnabledProperty #:get)) + (font-size-property (: Avalonia.Controls.Primitives.TemplatedControl.FontSizeProperty #:get)) + (padding-property (: Avalonia.Controls.Primitives.TemplatedControl.PaddingProperty #:get)) + (width-property (: Avalonia.Layout.Layoutable.WidthProperty #:get)) + (height-property (: Avalonia.Layout.Layoutable.HeightProperty #:get)) + (margin-property (: Avalonia.Layout.Layoutable.MarginProperty #:get)) + (spacing-property (: Avalonia.Controls.StackPanel.SpacingProperty #:get)) + (orientation-property (: Avalonia.Controls.StackPanel.OrientationProperty #:get)) + (content-alignment-property + (: Avalonia.Controls.ContentControl.HorizontalContentAlignmentProperty #:get)) + + (set-value (: Avalonia.AvaloniaObject.SetValue + (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) + (clear-value (: Avalonia.AvaloniaObject.ClearValue (-> AvaloniaObject AvaloniaProperty void))) + + ;; Events. + (click-event (: Avalonia.Controls.Button.ClickEvent #:get)) + ;; TextChanging and not TextChanged: TextChanged is posted to the + ;; dispatcher and comes later, after the patch that set the text is over. + (text-changing-event (: Avalonia.Controls.TextBox.TextChangingEvent #:get)) + (checked-event (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedChangedEvent #:get)) + (add-handler (: Avalonia.Interactivity.Interactive.AddHandler + (-> Interactive RoutedEvent Delegate Routes bool void))) + + ;; What a control holds. + (text-box-value (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get)) + (is-checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked + (-> ToggleButton (Nullable bool)) #:get)) + (panel-children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) + (clr-string (: System.Convert.ToString (-> string ClrString))) + + ;; The window and the application. + (configure (: Avalonia.AppBuilder.Configure (-> (-> Application) AppBuilder))) + (use-platform-detect (: Avalonia.AppBuilderDesktopExtensions.UsePlatformDetect + (-> AppBuilder AppBuilder))) + (setup-with-lifetime (: Avalonia.AppBuilder.SetupWithLifetime (-> AppBuilder ILifetime AppBuilder))) + (current-app (: Avalonia.Application.Current #:get)) + (app-styles (: Avalonia.Application.Styles (-> Application Styles) #:get)) + (main-window! (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.MainWindow + (-> Lifetime Window void) #:set)) + (start-lifetime (: Avalonia.Controls.ApplicationLifetimes.ClassicDesktopStyleApplicationLifetime.Start + (-> Lifetime (Array ClrString) int))) + (window-title! (: Avalonia.Controls.Window.Title (-> Window string void) #:set)) + (window-content! (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set))) + +;; --------------------------------------------------------------------------- +;; Properties +;; --------------------------------------------------------------------------- + +(: (-> Kind bool)) +(defun (stack? kind) + (match kind + (ColumnKind #t) + (RowKind #t) + (_ #f))) + +;; A kind that Avalonia draws with a template, and so has a padding and a +;; font size of its own. +(: (-> Kind bool)) +(defun (templated? kind) + (match kind + (ButtonKind #t) + (TextInputKind #t) + (CheckBoxKind #t) + (_ #f))) + +;; The Avalonia property that a prop sets on a control of this kind. None +;; for a prop that the kind does not take. +(: (-> Kind Prop (Option AvaloniaProperty))) +(defun (slot kind p) + (match p + ((Label _) + (match kind + (TextKind (Some (cast AvaloniaProperty text-block-text))) + (ButtonKind (Some (cast AvaloniaProperty content-property))) + (CheckBoxKind (Some (cast AvaloniaProperty content-property))) + (_ None))) + ((Value _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty text-box-text)) None)) + ((Placeholder _) (if (= kind TextInputKind) (Some (cast AvaloniaProperty watermark-property)) None)) + ((Checked _) (if (= kind CheckBoxKind) (Some (cast AvaloniaProperty is-checked-property)) None)) + ((Enabled _) (Some (cast AvaloniaProperty is-enabled-property))) + ((FontSize _) + (cond ((= kind TextKind) (Some (cast AvaloniaProperty text-block-font-size))) + ((templated? kind) (Some (cast AvaloniaProperty font-size-property))) + (else None))) + ((Width _) (Some (cast AvaloniaProperty width-property))) + ((Height _) (Some (cast AvaloniaProperty height-property))) + ((Margin _) (Some (cast AvaloniaProperty margin-property))) + ((Padding _) (if (templated? kind) (Some (cast AvaloniaProperty padding-property)) None)) + ((Spacing _) (if (stack? kind) (Some (cast AvaloniaProperty spacing-property)) None)))) + +;; The value of a prop, as the object `SetValue` takes. +(: (-> Prop Object)) +(defun (boxed p) + (match p + ((Label s) (cast Object (clr-string s))) + ((Value s) (cast Object (clr-string s))) + ((Placeholder s) (cast Object (clr-string s))) + ((Checked b) (cast Object b)) + ((Enabled b) (cast Object b)) + ((FontSize d) (cast Object d)) + ((Width d) (cast Object d)) + ((Height d) (cast Object d)) + ((Margin d) (cast Object (Thickness. d))) + ((Padding d) (cast Object (Thickness. d))) + ((Spacing d) (cast Object d)))) + +;; Which prop it is, without its value. Two props with one tag set the same +;; property. +(: (-> Prop int)) +(defun (tag p) + (match p + ((Label _) 0) ((Value _) 1) ((Placeholder _) 2) ((Checked _) 3) + ((Enabled _) 4) ((FontSize _) 5) ((Width _) 6) ((Height _) 7) + ((Margin _) 8) ((Padding _) 9) ((Spacing _) 10))) + +(: (-> Control Kind Prop void)) +(defun (set-prop! control kind p) + (match (slot kind p) + ((Some property) + (ignore (set-value (cast AvaloniaObject control) property (boxed p) Priority.LocalValue))) + (None unit))) + +(: (-> Control Kind Prop void)) +(defun (clear-prop! control kind p) + (match (slot kind p) + ((Some property) (clear-value (cast AvaloniaObject control) property)) + (None unit))) + +;; Clears the props that are gone, and sets the ones that are new or have +;; another value. A prop with the same value is not set again. +(: (-> Control Kind (Vec Prop) (Vec Prop) void)) +(defun (patch-props! control kind old new) + (loop (:for p old) + (:when (not (any? (fun (q) (= (tag q) (tag p))) new))) + (:do (clear-prop! control kind p))) + (loop (:for p new) + (:when (not (vec-contains old p))) + (:do (set-prop! control kind p)))) + +;; --------------------------------------------------------------------------- +;; The app +;; --------------------------------------------------------------------------- + +;; A control, the view it was last given, and the live children it holds. +(type (: (Live %m) #:opaque (Record (: control Control) + (: view (View %m) #:mutable) + (: children (MutableVec (Live %m)))))) + +;; A running program. +;; +;; `patching` is true while the controls are being changed. A control that +;; is changed raises its own events, such as a text input whose text is set, +;; and those are not the user's: they are dropped. +(type (: (App %model %m) #:opaque (Record (: model %model #:mutable) + (: update (-> %m %model %model)) + (: view (-> %model (View %m))) + (: root (Option (Live %m)) #:mutable) + (: patching bool #:mutable) + (: on-root (-> Control void))))) + +(: (-> (App %model %m) %model)) +(defun (app-model app) (.model app)) + +;; The control the view is shown in. It changes when the root view changes +;; kind. +(: (-> (App %model %m) Control)) +(defun (app-control app) + (match (.root app) + ((Some live) (.control live)) + (None (raise (cast Exception (InvalidOperation. "the app has no view")))))) + +;; The control at `path`, a child index for each level below the root. +(: (-> (App %model %m) (List int) Control)) +(defun (app-control-at app path) + (: (-> (Live %m) (List int) Control)) + (defun (walk live path) + (match path + (() (.control live)) + ((List i rest ...) (walk (mutablevec-ref (.children live) i) rest)))) + (match (.root app) + ((Some live) (walk live path)) + (None (raise (cast Exception (InvalidOperation. "the app has no view")))))) + +;; Makes the next model from `msg`, and shows its view. +(: (-> (App %model %m) %m void)) +(defun (app-dispatch! app msg) + (record-set! app (model ((.update app) msg (.model app)))) + (render! app)) + +(: (-> (App %model %m) void)) +(defun (render! app) + (def next ((.view app) (.model app))) + (record-set! app (patching #t)) + (match (.root app) + (None + (def live (mount app next)) + (record-set! app (root (Some live))) + ((.on-root app) (.control live))) + ((Some live) + (def now (patch! app live next)) + (unless (eq? now live) + (record-set! app (root (Some now))) + ((.on-root app) (.control now))))) + (record-set! app (patching #f))) + +;; Gives the message that `pick` finds in the control's events to `update`. +(: (-> (App %model %m) (Live %m) (-> (On %m) (Option %m)) void)) +(defun (fire! app live pick) + (unless (.patching app) + (match (loop (:for on (.events (.view live))) + (:when-let (Some msg) (pick on)) + (:finish #t (Some msg)) + => None) + ((Some msg) (app-dispatch! app msg)) + (None unit)))) + +(: (-> Control RoutedEvent (-> Object RoutedEventArgs void) void)) +(defun (on! control event handler) + (add-handler (cast Interactive control) event + (cast Delegate (cast Object (: (as-delegate handler) (EventHandler RoutedEventArgs)))) + Routes.Bubble #f)) + +;; Adds the handlers of the kind. A handler reads the view the control has +;; when the event comes, so a new view needs no new handler. +(: (-> (App %model %m) (Live %m) Kind void)) +(defun (listen! app live kind) + (def control (.control live)) + (match kind + (ButtonKind + (on! control (cast RoutedEvent click-event) + (fun (sender e) + (fire! app live (fun (on) (match on ((Click msg) (Some msg)) (_ None))))))) + (TextInputKind + (on! control (cast RoutedEvent text-changing-event) + (fun (sender e) + (def s (text-box-value (cast TextBox control))) + (fire! app live (fun (on) (match on ((Input f) (Some (f s))) (_ None))))))) + (CheckBoxKind + (on! control (cast RoutedEvent checked-event) + (fun (sender e) + (def b (.GetValueOrDefault (is-checked (cast ToggleButton control)))) + (fire! app live (fun (on) (match on ((Toggle f) (Some (f b))) (_ None))))))) + (_ unit))) + +(: (-> Kind Control)) +(defun (make-control kind) + (match kind + (TextKind (cast Control (TextBlock.))) + (ButtonKind + ;; Centred, because a button given a width shows its label at the left. + (def b (Button.)) + (ignore (set-value (cast AvaloniaObject b) (cast AvaloniaProperty content-alignment-property) + (cast Object HAlignment.Center) Priority.LocalValue)) + (cast Control b)) + (TextInputKind (cast Control (TextBox.))) + (CheckBoxKind (cast Control (CheckBox.))) + (ColumnKind (cast Control (StackPanel.))) + (RowKind + (def panel (StackPanel.)) + (ignore (set-value (cast AvaloniaObject panel) (cast AvaloniaProperty orientation-property) + (cast Object Orientation.Horizontal) Priority.LocalValue)) + (cast Control panel)))) + +;; Makes the controls for a view. +(: (-> (App %model %m) (View %m) (Live %m))) +(defun (mount app v) + (def kind (view-kind v)) + (def control (make-control kind)) + (def live (Live (control control) (view v) (children (mutablevec)))) + (loop (:for p (view-props v)) (:do (set-prop! control kind p))) + (listen! app live kind) + (loop (:for child (view-children v)) + (:do (def c (mount app child)) + (mutablevec-add! (.children live) c) + (.Add (panel-children (cast Panel control)) (.control c)))) + live) + +;; Changes the controls of `live` to show `next`. Gives `live` itself, or new +;; controls when the kind is another. +(: (-> (App %model %m) (Live %m) (View %m) (Live %m))) +(defun (patch! app live next) + (def old (.view live)) + (def kind (view-kind next)) + (if (not (= (view-kind old) kind)) + (mount app next) + (begin + (patch-props! (.control live) kind (view-props old) (view-props next)) + (record-set! live (view next)) + (when (stack? kind) + (patch-children! app live (view-children next))) + live))) + +;; Children are matched by their place: the first with the first, and so on. +;; Those past the end of the shorter list are added or removed. +(: (-> (App %model %m) (Live %m) (Vec (View %m)) void)) +(defun (patch-children! app live views) + (def kids (.children live)) + (def controls (panel-children (cast Panel (.control live)))) + (def n (vec-length views)) + (loop (:for i (range 0 (min n (mutablevec-length kids)))) + (:do (def was (mutablevec-ref kids i)) + (def now (patch! app was (vec-ref views i))) + (unless (eq? now was) + (mutablevec-set! kids i now) + (.set_Item controls i (.control now))))) + (loop (:while (> (mutablevec-length kids) n)) + (:do (ignore (mutablevec-pop! kids)) + (.RemoveAt controls (mutablevec-length kids)))) + (loop (:for i (range (mutablevec-length kids) n)) + (:do (def c (mount app (vec-ref views i))) + (mutablevec-add! kids c) + (.Add controls (.control c))))) + +;; An app with no window: its view is made now, and `on-root` is given the +;; control to show each time that control changes. +(: (-> %model (-> %m %model %model) (-> %model (View %m)) (-> Control void) + (App %model %m))) +(defun (start-app init update view on-root) + (def app (App (model init) (update update) (view view) (root None) (patching #f) + (on-root on-root))) + (render! app) + app) + +;; Runs the program in a window, until the window is closed. +(: (-> %model (-> %m %model %model) (-> %model (View %m)) + (#:title string) (#:width double) (#:height double) + void)) +(defun (run-app init update view #:title "bjogui" #:width 400.0 #:height 300.0) + ;; The Application is made inside the setup, because making one uses the + ;; dispatcher, and the dispatcher is the platform's only after the setup. + (def lifetime (Lifetime.)) + (ignore (setup-with-lifetime (use-platform-detect (configure (fun () (Application.)))) + lifetime)) + (.Add (app-styles current-app) (FluentTheme. (clr-default))) + (def w (Window.)) + (window-title! w title) + (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty width-property) + (cast Object width) Priority.LocalValue)) + (ignore (set-value (cast AvaloniaObject w) (cast AvaloniaProperty height-property) + (cast Object height) Priority.LocalValue)) + (ignore (start-app init update view + (fun (c) (window-content! (cast ContentControl w) (cast Object c))))) + (main-window! lifetime w) + (ignore (start-lifetime lifetime (: (make-array 0) (Array ClrString))))) diff --git a/src/view.bjo b/src/view.bjo new file mode 100644 index 0000000..bdf3665 --- /dev/null +++ b/src/view.bjo @@ -0,0 +1,144 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. + +;; bjogui/src/view.bjo — the module (bjogui view). +;; +;; A view is a value: what the window shows for one model. `view` functions +;; build it with the constructors here, and (bjogui app) makes the controls +;; for it and changes them when the next view differs. Nothing here knows +;; about Avalonia, so a view can be built and compared in a test with no +;; window. +;; +;; An event is a message, or a function that makes one from what the control +;; holds. The app gives the message to `update`. + +(export + ;; Types. + View Kind Prop On + + ;; Constructors. + text button text-input checkbox column row + + ;; Reading one. + view-kind view-props view-events view-children) + +(import (std prelude)) + +;; --------------------------------------------------------------------------- +;; The types +;; --------------------------------------------------------------------------- + +;; What control a view is. +(type (: Kind (Union TextKind ButtonKind TextInputKind CheckBoxKind ColumnKind RowKind))) + +;; A property of a control. A kind takes only some of them; the app ignores +;; the others. +(type (: Prop (Union (: Label string) ; the text of a text, a button or a checkbox + (: Value string) ; the text in a text input + (: Placeholder string) ; shown in an empty text input + (: Checked bool) + (: Enabled bool) + (: FontSize double) + (: Width double) + (: Height double) + (: Margin double) + (: Padding double) + (: Spacing double)))) + +;; An event, and the message it sends. +(type (: (On %m) (Union (: Click %m) + (: Input (-> string %m)) + (: Toggle (-> bool %m))))) + +;; One control and what is in it. +(type (: (View %m) (Record (: kind Kind) + (: props (Vec Prop)) + (: events (Vec (On %m))) + (: children (Vec (View %m)))))) + +(: view-kind (-> (View %m) Kind)) +(defun (view-kind v) (.kind v)) + +(: view-props (-> (View %m) (Vec Prop))) +(defun (view-props v) (.props v)) + +(: view-events (-> (View %m) (Vec (On %m)))) +(defun (view-events v) (.events v)) + +(: view-children (-> (View %m) (Vec (View %m)))) +(defun (view-children v) (.children v)) + +;; --------------------------------------------------------------------------- +;; Constructors +;; --------------------------------------------------------------------------- + +;; A size of zero or less means: the size the control asks for. The +;; constructors leave such a size out of the props, so the control keeps its +;; own. +(: (-> (Vec Prop) (-> double Prop) double (Vec Prop))) +(defun (with-size props make size) + (if (> size 0.0) (vec-add props (make size)) props)) + +(: (-> (Vec Prop) double double double double (Vec Prop))) +(defun (with-layout props width height margin padding) + (with-size (with-size (with-size (with-size props Width width) Height height) + Margin margin) + Padding padding)) + +(: (-> Kind (Vec Prop) (Vec (On %m)) (View %m))) +(defun (leaf kind props events) + (View (kind kind) (props props) (events events) (children []))) + +;; A text. +(: (-> string (#:size double) (#:width double) (#:height double) (#:margin double) + (View %m))) +(defun (text s #:size 0.0 #:width 0.0 #:height 0.0 #:margin 0.0) + (leaf TextKind + (with-layout (with-size [(Label s)] FontSize size) width height margin 0.0) + [])) + +;; A button that sends `msg` when it is clicked. +(: (-> string %m (#:enabled bool) (#:width double) (#:height double) + (#:margin double) (#:padding double) + (View %m))) +(defun (button label msg #:enabled #t #:width 0.0 #:height 0.0 #:margin 0.0 #:padding 0.0) + (leaf ButtonKind + (with-layout [(Label label) (Enabled enabled)] width height margin padding) + [(Click msg)])) + +;; A one-line text input that holds `value`. Each change sends `(on-input +;; text)`, with the whole text. +(: (-> string (-> string %m) (#:placeholder string) (#:enabled bool) + (#:width double) (#:margin double) + (View %m))) +(defun (text-input value on-input #:placeholder "" #:enabled #t #:width 0.0 #:margin 0.0) + (leaf TextInputKind + (with-layout [(Value value) (Placeholder placeholder) (Enabled enabled)] + width 0.0 margin 0.0) + [(Input on-input)])) + +;; A checkbox that is `checked?`. A click sends `(on-toggle checked)`, with +;; the new state. +(: (-> string bool (-> bool %m) (#:enabled bool) (#:margin double) (View %m))) +(defun (checkbox label checked? on-toggle #:enabled #t #:margin 0.0) + (leaf CheckBoxKind + (with-layout [(Label label) (Checked checked?) (Enabled enabled)] 0.0 0.0 margin 0.0) + [(Toggle on-toggle)])) + +(: (-> Kind double double (Array (View %m)) (View %m))) +(defun (stack kind spacing margin children) + (View (kind kind) + (props (with-layout (with-size [] Spacing spacing) 0.0 0.0 margin 0.0)) + (events []) + (children (array->vec children)))) + +;; Views one above the other. +(: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m))) +(defun (column #:spacing 0.0 #:margin 0.0 #:rest children) + (stack ColumnKind spacing margin children)) + +;; Views side by side. +(: (-> (#:spacing double) (#:margin double) #:rest (View %m) (View %m))) +(defun (row #:spacing 0.0 #:margin 0.0 #:rest children) + (stack RowKind spacing margin children)) diff --git a/tests/app.bjo b/tests/app.bjo new file mode 100644 index 0000000..59f9ef3 --- /dev/null +++ b/tests/app.bjo @@ -0,0 +1,156 @@ +;; 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/app.bjo — an app driven through its real controls. +;; +;; bjo run tests/app.bjo +;; +;; 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. + +(import (std prelude)) +(import (std simpletest)) +(import (bjogui view)) +(import (bjogui app)) + +(import/class + (Object (: System.Object)) + (Interactive (: Avalonia.Interactivity.Interactive)) + (RoutedEvent (: Avalonia.Interactivity.RoutedEvent)) + (RoutedEventArgs (: Avalonia.Interactivity.RoutedEventArgs (-> RoutedEvent RoutedEventArgs))) + (TextBlock (: Avalonia.Controls.TextBlock)) + (TextBox (: Avalonia.Controls.TextBox)) + (ContentControl (: Avalonia.Controls.ContentControl)) + (CheckBox (: Avalonia.Controls.CheckBox)) + (ToggleButton (: Avalonia.Controls.Primitives.ToggleButton)) + (InputElement (: Avalonia.Input.InputElement)) + (StackPanel (: Avalonia.Controls.StackPanel)) + (Panel (: Avalonia.Controls.Panel)) + (Controls (: Avalonia.Controls.Controls)) + ((Nullable %a) (: System.Nullable)) + (AvaloniaObject (: Avalonia.AvaloniaObject)) + (AvaloniaProperty (: Avalonia.AvaloniaProperty)) + (Priority (: Avalonia.Data.BindingPriority)) + (Disposable (: System.IDisposable))) + +(import/extern + (click-event (: Avalonia.Controls.Button.ClickEvent #:get)) + (is-checked-property (: Avalonia.Controls.Primitives.ToggleButton.IsCheckedProperty #:get)) + (set-value (: Avalonia.AvaloniaObject.SetValue + (-> AvaloniaObject AvaloniaProperty Object Priority Disposable))) + (raise-event (: Avalonia.Interactivity.Interactive.RaiseEvent (-> Interactive RoutedEventArgs void))) + (block-text (: Avalonia.Controls.TextBlock.Text (-> TextBlock string) #:get)) + (box-text (: Avalonia.Controls.TextBox.Text (-> TextBox string) #:get)) + (box-text! (: Avalonia.Controls.TextBox.Text (-> TextBox string void) #:set)) + (caret (: Avalonia.Controls.TextBox.CaretIndex (-> TextBox int) #:get)) + (caret! (: Avalonia.Controls.TextBox.CaretIndex (-> TextBox int void) #:set)) + (checked (: Avalonia.Controls.Primitives.ToggleButton.IsChecked + (-> ToggleButton (Nullable bool)) #:get)) + (enabled? (: Avalonia.Input.InputElement.IsEnabled (-> InputElement bool) #:get)) + (content (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object) #:get)) + (children (: Avalonia.Controls.Panel.Children (-> Panel Controls) #:get)) + (count (: Avalonia.Controls.Controls.Count (-> Controls int) #:get))) + +;; --------------------------------------------------------------------------- +;; The program under test +;; --------------------------------------------------------------------------- + +(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) + (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))))) + +(: greeting (-> Model string)) +(defun (greeting m) + (def hello #"hello, ${(.name m)}") + (if (.loud m) (string-upcase hello) hello)) + +(: view (-> Model (View Msg))) +(defun (view m) + (column #:spacing 4.0 + (text #"count: ${(.count m)}") + (row (button "+" Inc) (button "-" Dec #:enabled (> (.count m) 0))) + (text-input (.name m) Typed #:placeholder "name") + (checkbox "shout" (.loud m) Shout) + (text (greeting m) #:size 20.0) + ;; A line for each count over 2, to check that children come and go. + (apply column (vec->array (vec-map (fun (i) (text #"line ${i}")) + (->vec (range 0 (max 0 (- (.count m) 2))))))))) + +;; --------------------------------------------------------------------------- +;; The test +;; --------------------------------------------------------------------------- + +(defun (main) + (def/mutable roots 0) + (def app (start-app (Model (count 0) (name "") (loud #f)) update view + (fun (c) (set! roots (+ roots 1))))) + + (defun (at path) (app-control-at app path)) + (defun (label path) (block-text (cast TextBlock (at path)))) + (defun (click path) + (raise-event (cast Interactive (at path)) (RoutedEventArgs. (cast RoutedEvent click-event)))) + + (expect "the root is shown once" roots 1) + (expect "the first view" (label '(0)) "count: 0") + (expect "a button's label" (written (content (cast ContentControl (at '(1 0))))) "+") + (expect "a disabled button" (enabled? (cast InputElement (at '(1 1)))) #f) + + ;; --- clicks --------------------------------------------------------------- + (def counter (at '(0))) + (click '(1 0)) + (expect "a click is a message" (label '(0)) "count: 1") + (expect "and the model has it" (.count (app-model app)) 1) + (expect "the button is enabled again" (enabled? (cast InputElement (at '(1 1)))) #t) + (expect "the control is the same one" (eq? counter (at '(0))) #t) + (click '(1 1)) + (expect "the other button" (label '(0)) "count: 0") + + ;; --- text input ----------------------------------------------------------- + (def input (cast TextBox (at '(2)))) + (box-text! input "Ada") + (expect "typing is a message" (.name (app-model app)) "Ada") + (expect "the greeting follows" (label '(4)) "hello, Ada") + (caret! input 1) + (app-dispatch! app Inc) + (expect "a patch keeps the caret" (caret input) 1) + (expect "and the text" (box-text input) "Ada") + (app-dispatch! app (Typed "Grace")) + (expect "a new model sets the text" (box-text input) "Grace") + (expect "without a message of its own" (.name (app-model app)) "Grace") + + ;; --- checkbox ------------------------------------------------------------- + (def check (cast ToggleButton (at '(3)))) + ;; A click on a checkbox toggles it in a method Avalonia calls for a + ;; pointer, not for a raised Click. The test sets it as that method does. + (ignore (set-value (cast AvaloniaObject check) (cast AvaloniaProperty is-checked-property) + (cast Object #t) Priority.LocalValue)) + (expect "a toggle is a message" (.loud (app-model app)) #t) + (expect "the checkbox shows it" (.GetValueOrDefault (checked check)) #t) + (expect "the greeting is loud" (label '(4)) "HELLO, GRACE") + + ;; --- children come and go ------------------------------------------------- + (def lines (cast Panel (at '(5)))) + (expect "no lines yet" (count (children lines)) 0) + (app-dispatch! app Inc) + (app-dispatch! app Inc) + (app-dispatch! app Inc) + (expect "two lines" (count (children lines)) 2) + (expect "the second line" (label '(5 1)) "line 1") + (app-dispatch! app Dec) + (expect "one line" (count (children lines)) 1) + (app-dispatch! app Reset) + (expect "no lines" (count (children lines)) 0) + (expect "reset clears the text" (box-text input) "") + (expect "and the checkbox" (.GetValueOrDefault (checked check)) #f) + (expect "the root was never replaced" roots 1) + (println "bjogui ok"))