Linus Björnstam
52ebd0ace8
A native is made with a function that makes the control and hooks its events, and one that puts a value on it. hosted puts it in a view: the control is made once for its place, given a value only when the view's value changes, and what it sends while it is given one is dropped. Its outputs become the app's messages through on-output and view-map, and may be sent from any thread. 🤖 Generated with [ECA](https://eca.dev) (anthropic/claude-opus-4-8) Co-Authored-By: eca-agent <git@eca.dev>
65 lines
2.9 KiB
Text
65 lines
2.9 KiB
Text
;; 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/native.bjo — the module (bjogui native).
|
|
;;
|
|
;; Controls that bjogui does not wrap: any Avalonia control, Avalonia's own
|
|
;; or another package's, in a view. The program makes the control itself and
|
|
;; hooks its events, so it names Avalonia's types here, and only here.
|
|
;;
|
|
;; (: calendar (Native string string))
|
|
;; (def calendar
|
|
;; (native (fun (send)
|
|
;; (def c (Calendar.))
|
|
;; (add-event-handler! c "SelectedDatesChanged" (fun (s e) (send (picked c))))
|
|
;; (cast Control c))
|
|
;; (fun (control date) (show-date! (cast Calendar control) date))))
|
|
;;
|
|
;; (hosted calendar (.date model) Picked)
|
|
|
|
(export Native native hosted)
|
|
|
|
(import (std prelude))
|
|
(import (bjogui view))
|
|
|
|
(import/class
|
|
(Object (: System.Object))
|
|
(Control (: Avalonia.Controls.Control)))
|
|
|
|
;; A kind of control, for values of type %v, that sends outputs of type %o.
|
|
(type (: (Native %v %o) #:opaque (Record (: make (-> (-> %o void) Control))
|
|
(: update (-> Control %v void)))))
|
|
|
|
;; A kind of control that bjogui does not wrap.
|
|
;;
|
|
;; `(make send)` makes one control, and hooks its events: an event calls
|
|
;; `send` with an output, which `hosted` makes a message of. `send` may be
|
|
;; called from any thread.
|
|
;;
|
|
;; `(put-value control value)` puts a value on the control: once after `make`,
|
|
;; and again each time the view gives another value. What the control sends
|
|
;; while it is updated is dropped, because it is not the user's.
|
|
;;
|
|
;; Make it once, at the top of a module, as a component: a view in the place
|
|
;; of another kind is a new control.
|
|
(: native (-> (-> (-> %o void) Control) (-> Control %v void) (Native %v %o)))
|
|
(defun (native make put-value)
|
|
(Native (make make) (update put-value)))
|
|
|
|
;; A control of the kind `n`, showing `value`. Each output it sends is given
|
|
;; to `on-output`, and the message that makes is the app's. `#:width`,
|
|
;; `#:height` and `#:margin` are set on the control as on any other view.
|
|
(: hosted (-> (Native %v %o) %v (-> %o %m) (#:width double) (#:height double) (#:margin double)
|
|
(View %m))
|
|
(where (Eq %v)))
|
|
(defun (hosted n value on-output #:width 0.0 #:height 0.0 #:margin 0.0)
|
|
(def make (.make n))
|
|
(def put-value (.update n))
|
|
(hosted-view (Hosted (identity (cast Object n))
|
|
(value (cast Object value))
|
|
(same-value? (fun (o) (= value (cast %v o))))
|
|
(make (fun (send) (cast Object (make (fun (o) (send (cast Object o)))))))
|
|
(update (fun (c) (put-value (cast Control c) value)))
|
|
(deliver (fun (o) (on-output (cast %o o)))))
|
|
width height margin))
|