;; 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))