ezdish.scm

(module-extends javafx.application.Application)

(import (srfi 1)
        (except (kawa base) match)
        (srfi 9 records)
        (class javafx.application Application)
        (class javafx.scene Group Scene)
        (class javafx.stage Stage)
        (class javafx.scene.canvas Canvas)
        (class javafx.scene.control Button)
        (class javafx.print PrinterJob)
        (class javafx.scene.layout VBox)
        (class javafx.scene.layout HBox)
        (class javafx.scene.canvas GraphicsContext)
        (class javafx.scene.paint Color))

;; Each 'window' is a JavaFX scenegraph

(define *windows* '())

(define *drawings* '())

(define-record-type window
  (make-window name width height root)
  window?
  (name window-name set-window-name!)
  (width window-width set-window-width!)
  (height window-height set-window-height!)
  (root window-root set-window-root!))

;; A drawing is a JavaFX 2d Canvas
(define-record-type drawing
  (make-drawing canvas)
  drawing?
  (canvas drawing-canvas set-drawing-canvas!))

(define-record-type line
  (make-line x0 y0 x1 y1)
  line?
  (x0 line-x0 set-line-x0!)
  (x1 line-x1 set-line-x1!)
  (y0 line-y0 set-line-y0!)
  (y1 line-y1 set-line-y1!))

;; Default drawing
(define *ezd* (make-drawing (Canvas 800 800)))

(set! *drawings* (cons *ezd* *drawings*))

(define (ezd-one command)
  ;; A COMMAND is an s-expression of the form:
  ;; (command ...)
  (let ((command-name (car command)))
    (case command-name
      ((window)
       (match
        command
        ((_ name width height)
         (let* ((name (Group))
                (scene (Scene name width height)))
           (set! *windows* (cons name *windows*))))))
      ((line)
       (match
        command
        ((_ x0 y0 x1 y1)
         (let* ((drawing (first *drawings*))
                (canvas (drawing-canvas drawing))
                (context (canvas:getGraphicsContext2D))
                (window (first *windows*))
                (children (window:getChildren))
                (lin (make-line x0 y0 x1 y1)))
           (begin
             (children:add canvas)
             (context:moveTo (line-x0 lin) (line-y0 lin))
             (context:lineTo (line-x1 lin) (line-y1 lin))))))))))

(define (start (stage ::Stage))
  (begin
    (ezd-one '(window popup 800 800))
    (ezd-one '(line 0 0 400 400))
    (display *windows*)))

(Application:launch (module-class))

;; eof

;; COMPILATION OUTPUT

;; -*- mode: compilation; default-directory: "c:/Users/rml/Dropbox/Code/ezdfx/" -*-
;; Compilation started at Sat Jun 27 23:08:54

;; cd .. && make ezdish
;; kawa test/ezdish.scm

;; c:\Users\rml\Dropbox\Code\ezdfx>"c:/Program Files/AdoptOpenJDK/jdk-11.0.7.10-hotspot/bin/java.exe" --module-path "c:/Users/rml/Downloads/javafx-sdk-11.0.2/lib" --add-modules javafx.controls -classpath "C:\Users\rml\Dropbox\Code\personal\classpath\kawa.jar" kawa.repl --console  test/ezdish.scm
;; test/ezdish.scm:736:27: warning - no known slot 'getGraphicsContext2D' in java.lang.Object
;; test/ezdish.scm:738:28: warning - no known slot 'getChildren' in java.lang.Object
;; test/ezdish.scm:741:15: warning - no known slot 'add' in java.lang.Object
;; test/ezdish.scm:742:15: warning - no known slot 'moveTo' in java.lang.Object
;; test/ezdish.scm:743:15: warning - no known slot 'lineTo' in java.lang.Object
;; Exception in Application start method
;; java.lang.RuntimeException: Exception in Application start method
;;  at javafx.graphics/com.sun.javafx.application.LauncherImpl.launchApplication1(LauncherImpl.java:900)
;;  at javafx.graphics/com.sun.javafx.application.LauncherImpl.lambda$launchApplication$2(LauncherImpl.java:195)
;;  at java.base/java.lang.Thread.run(Thread.java:834)
;; Caused by: Argument  (null) to 'car' has wrong type
;;  at gnu.mapping.CallContext.matchError(CallContext.java:185)
;;  at gnu.expr.GenericProc.applyToConsumerGP(GenericProc.java:132)
;;  at gnu.mapping.CallContext.runUntilDone(CallContext.java:586)
;;  at gnu.mapping.CallContext.runUntilValue(CallContext.java:669)
;;  at gnu.mapping.Procedure.apply1(Procedure.java:154)
;;  at test.ezdish.ezdOne(ezdish.scm:734)
;;  at test.ezdish.ezdOne$check(ezdish.scm:718)
;;  at gnu.mapping.CallContext.runUntilValue(CallContext.java:656)
;;  at gnu.mapping.Procedure.apply1(Procedure.java:154)
;;  at test.ezdish.start(ezdish.scm:748)
;;  at javafx.graphics/com.sun.javafx.application.LauncherImpl.lambda$launchApplication1$9(LauncherImpl.java:846)
;;  at javafx.graphics/com.sun.javafx.application.PlatformImpl.lambda$runAndWait$12(PlatformImpl.java:455)
;;  at javafx.graphics/com.sun.javafx.application.PlatformImpl.lambda$runLater$10(PlatformImpl.java:428)
;;  at java.base/java.security.AccessController.doPrivileged(Native Method)
;;  at javafx.graphics/com.sun.javafx.application.PlatformImpl.lambda$runLater$11(PlatformImpl.java:427)
;;  at javafx.graphics/com.sun.glass.ui.InvokeLaterDispatcher$Future.run(InvokeLaterDispatcher.java:96)
;;  at javafx.graphics/com.sun.glass.ui.win.WinApplication._runLoop(Native Method)
;;  at javafx.graphics/com.sun.glass.ui.win.WinApplication.lambda$runLoop$3(WinApplication.java:174)
;;  ... 1 more

;; c:\Users\rml\Dropbox\Code\ezdfx>rem "java.exe" -classpath "C:\Users\rml\Dropbox\Code\personal\classpath\kawa.jar" kawa.repl --console --no-inline --r5rs test/ezdish.scm

;; c:\Users\rml\Dropbox\Code\ezdfx>rem -Dkawa.import.path=".:./lib/"

;; Compilation finished at Sat Jun 27 23:08:58