bjogui/tests/commands.bjo

;; 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/commands.bjo — commands that act on the controls and the
;; clipboard, and pictures from memory.
;;
;;     bjo run tests/commands.bjo
;;
;; Avalonia runs with no screen, and the app is shown in a window of it, so
;; that a control can take the keyboard, a scroll view is laid out, and there
;; is a clipboard.

(import (std prelude))
(import (std simpletest))
(import (std interop))
(import (bjogui view))
(import (bjogui app))

(import/class
  (Object        (: System.Object))
  (Control       (: Avalonia.Controls.Control))
  (Window        (: Avalonia.Controls.Window (-> Window)))
  (ContentControl (: Avalonia.Controls.ContentControl))
  (Layoutable    (: Avalonia.Layout.Layoutable))
  (InputElement  (: Avalonia.Input.InputElement))
  (ScrollViewer  (: Avalonia.Controls.ScrollViewer))
  (Image         (: Avalonia.Controls.Image))
  (IImage        (: Avalonia.Media.IImage))
  (Vector        (: Avalonia.Vector)))

(import/extern
  (content!      (: Avalonia.Controls.ContentControl.Content (-> ContentControl Object void) #:set))
  (show!         (: Avalonia.Controls.Window.Show (-> Window void)))
  (width!        (: Avalonia.Layout.Layoutable.Width (-> Layoutable double void) #:set))
  (height!       (: Avalonia.Layout.Layoutable.Height (-> Layoutable double void) #:set))
  (update-layout! (: Avalonia.Layout.Layoutable.UpdateLayout (-> Layoutable void)))
  (focused?      (: Avalonia.Input.InputElement.IsFocused (-> InputElement bool) #:get))
  (offset-of     (: Avalonia.Controls.ScrollViewer.Offset (-> ScrollViewer Vector) #:get))
  (vector-y      (: Avalonia.Vector.Y (-> Vector double) #:get))
  (source-of     (: Avalonia.Controls.Image.Source (-> Image IImage) #:get))
  (sleep-ms      (: System.Threading.Thread.Sleep (-> int void) #:blocking)))

(type (: Msg (Union FocusName FocusOther End Start Into (: Copy string) Paste (: Pasted (Option string)))))
(type (: Model (Record (: messages int) (: pasted (Option string)))))

(: (-> Msg Model (Tuple Model (List (Event Msg)))))
(defun (gui-update msg m0)
  (def m (record-set m0 (messages (+ (.messages m0) 1))))
  (match msg
    (FocusName (next m (focus "name")))
    (FocusOther (next m (focus "other")))
    (End (next m (scroll-to-end "log")))
    (Start (next m (scroll-to-start "log")))
    (Into (next m (scroll-into-view "line 25")))
    ((Copy s) (next m (copy-text s)))
    (Paste (next m (paste-text Pasted)))
    ((Pasted s) (next (record-set m (pasted s))))))

(def picture (file-read-bytes "docs/mixer.png"))

(: (-> Model (View Msg)))
(defun (view m)
  (column
    (keyed "name" (text-input "" (fun (s) Start)))                                    ; 0
    (keyed "other" (text-input "" (fun (s) Start)))                                   ; 1
    (keyed "log" (scroll (apply column (vec->array (vec-map (fun (i) (keyed #"line ${i}" (text #"line ${i}")))
                                                            (->vec (range 0 40)))))
                         #:height 60.0))                                              ; 2
    (image-data picture #:width 46.0 #:height 30.0)                                   ; 3
    (image-data (: (make-array 3 #:fill (cast byte 7)) (Array byte)))))               ; 4

(defun (main)
  (start-headless!)
  (def w (Window.))
  (width! (cast Layoutable w) 300.0)
  (height! (cast Layoutable w) 400.0)
  (def app (start-app (Model (messages 0) (pasted None)) gui-update view
                      (fun (c) (content! (cast ContentControl w) (cast Object c)))))
  (show! w)
  (defun (ctl path) (app-control-at app path))
  (defun (settle) (app-run-pending! app) (update-layout! (cast Layoutable w)))
  (: (-> (-> bool) bool))
  (defun (wait-for done?)
    (let go ((tries 0))
      (settle)
      (cond ((done?) #t)
            ((> tries 200) #f)
            (else (sleep-ms 10) (go (+ tries 1))))))
  (defun (log-offset) (vector-y (offset-of (cast ScrollViewer (ctl '(2))))))
  (settle)

  ;; --- focus ------------------------------------------------------------------------
  (app-dispatch! app FocusName)
  (expect "focus gives the keyboard to the keyed control"
          (wait-for (fun () (focused? (cast InputElement (ctl '(0)))))) #t)
  (app-dispatch! app FocusOther)
  (expect "and to another" (wait-for (fun () (focused? (cast InputElement (ctl '(1)))))) #t)
  (expect "which the first has no more" (focused? (cast InputElement (ctl '(0)))) #f)

  ;; --- scrolling --------------------------------------------------------------------
  (expect "the log starts at the top" (log-offset) 0.0)
  (app-dispatch! app End)
  (expect "scroll-to-end" (wait-for (fun () (> (log-offset) 500.0))) #t)
  (app-dispatch! app Start)
  (expect "scroll-to-start" (wait-for (fun () (= (log-offset) 0.0))) #t)
  (app-dispatch! app Into)
  (expect "scroll-into-view" (wait-for (fun () (> (log-offset) 300.0))) #t)

  ;; --- the clipboard -----------------------------------------------------------------
  (app-dispatch! app (Copy "copied"))
  (app-dispatch! app Paste)
  (expect "a copy is pasted" (wait-for (fun () (= (.pasted (app-model app)) (Some "copied")))) #t)

  ;; --- commands that send nothing --------------------------------------------------
  (sleep-ms 50)
  (settle)
  (expect "send nothing: only the messages dispatched, and Pasted" (.messages (app-model app)) 8)

  ;; --- pictures from memory ---------------------------------------------------------
  (expect "a picture from bytes" (eq? (cast Object (source-of (cast Image (ctl '(3))))) (clr-default)) #f)
  (expect "bytes that are no picture show nothing"
          (eq? (cast Object (source-of (cast Image (ctl '(4))))) (clr-default)) #t)

  (println "bjogui commands ok"))