From 56e94758c270e5a5d5805b440dd2eea69f9e0c2a Mon Sep 17 00:00:00 2001 From: zilti Date: Tue, 30 Oct 2018 10:11:36 +0000 Subject: [PATCH] Some stuff --- docs/clojurefx.html | 71 ++++++++---- docs/manual.texinfo | 53 ++++++--- project.clj | 8 +- src/clojurefx/clojurefx.clj | 174 ++++++++++++++++++----------- test/clojurefx/fxml_test.clj | 68 ++++++----- test/clojurefx/scenegraph_test.clj | 30 ++++- 6 files changed, 261 insertions(+), 143 deletions(-) diff --git a/docs/clojurefx.html b/docs/clojurefx.html index 17caaef..9b7bc2c 100644 --- a/docs/clojurefx.html +++ b/docs/clojurefx.html @@ -3,9 +3,10 @@ - +Copyright (C) 2016-2018 Daniel Ziltener. --> + + ClojureFX Manual @@ -13,7 +14,6 @@ Copyright (C) 2017 Daniel Ziltener. --> - @@ -92,7 +92,7 @@ Next:

ClojureFX

-

This is the documentation to ClojureFX, version 0.4.0. +

This is the documentation to ClojureFX, version 0.5.0.

• Installation and deployment:  adding ClojureFX and probably tools.jar to your build tool. @@ -120,9 +120,9 @@ Next: , P

1 Installation and deployment

-

The first, straightforward part of this is to add the dependency to your project.clj or build.boot, which consists simply of adding [clojurefx "0.4.0"]. +

The first, straightforward part of this is to add the dependency to your project.clj or build.boot, which consists simply of adding [clojurefx "0.5.0"].

-

For the users of OpenJDK 7 and 8, OpenJFX, the opensource implementation of JavaFX, is not included yet (it will be starting with OpenJDK 9). Luckily, many Linux distributions ship a separate OpenJFX package by now, but for those that don’t, the OpenJDK wiki has an article “Building OpenJFX”. Alternatively, you can of course install the Oracle JDK manually. +

For the users of OpenJDK 7 and 8, OpenJFX, the opensource implementation of JavaFX, is not included. Luckily, many Linux distributions ship a separate OpenJFX package by now, but for those that don’t, the OpenJDK wiki has an article “Building OpenJFX”. Starting with OpenJDK 9, JavaFX is available as a library. Alternatively, you can of course install the Oracle JDK manually.

@@ -141,25 +141,24 @@ Next: @@ -363,6 +386,8 @@ Previous: , Up: Jump to:   + + + + + + @@ -390,6 +421,8 @@ Previous: , Up: Jump to:  
C   +F +   G   L @@ -375,6 +400,12 @@ Previous: , Up:
C
compile: Scenegraph API
connect: Core API
F
fi: Core API
find-child-by-class: Core API
find-child-by-id: Core API
G
generate-controller: FXML API
C   +F +   G   L diff --git a/docs/manual.texinfo b/docs/manual.texinfo index 584acbc..9a4815e 100644 --- a/docs/manual.texinfo +++ b/docs/manual.texinfo @@ -5,7 +5,7 @@ @copying This manual is for ClojureFX, version 0.4.0. -Copyright @copyright{} 2017 Daniel Ziltener. +Copyright @copyright{} 2016-2018 Daniel Ziltener. @end copying @titlepage @@ -24,7 +24,7 @@ Copyright @copyright{} 2017 Daniel Ziltener. @node Top @top ClojureFX -This is the documentation to ClojureFX, version 0.4.0. +This is the documentation to ClojureFX, version 0.5.0. @c@end ifnottex @menu @@ -40,9 +40,9 @@ This is the documentation to ClojureFX, version 0.4.0. @node Installation and deployment @chapter Installation and deployment -The first, straightforward part of this is to add the dependency to your @file{project.clj} or @file{build.boot}, which consists simply of adding @code{[clojurefx "0.4.0"]}. +The first, straightforward part of this is to add the dependency to your @file{project.clj} or @file{build.boot}, which consists simply of adding @code{[clojurefx "0.5.0"]}. -For the users of @emph{OpenJDK} 7 and 8, @emph{OpenJFX}, the opensource implementation of JavaFX, is not included yet (it will be starting with OpenJDK 9). Luckily, many Linux distributions ship a separate OpenJFX package by now, but for those that don't, the OpenJDK wiki has an article @uref{https://wiki.openjdk.java.net/display/OpenJFX/Building+OpenJFX, ``Building OpenJFX''}. Alternatively, you can of course install the Oracle JDK manually. +For the users of @emph{OpenJDK} 7 and 8, @emph{OpenJFX}, the opensource implementation of JavaFX, is not included. Luckily, many Linux distributions ship a separate OpenJFX package by now, but for those that don't, the OpenJDK wiki has an article @uref{https://wiki.openjdk.java.net/display/OpenJFX/Building+OpenJFX, ``Building OpenJFX''}. Starting with OpenJDK 9, JavaFX is available as a library. Alternatively, you can of course install the Oracle JDK manually. @node Getting started @chapter Getting started @@ -55,25 +55,24 @@ For the ``nasty hack'', you have to add a @code{defonce} @emph{before} you impor @code{(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))} -Subclassing @indicateurl{javafx.application.Application} is a tad more work and requires you to aot-compile the namespace: +Alternatively, and preferredly, you can use @code{start-app}: @lisp (ns example.core (:require [clojurefx.clojurefx :as fx]) - (:gen-class :main true - :extends javafx.application.Application)) + (:gen-class)) -(defn -init [this] +(defn init [] nil) -(defn -start [this ^javafx.stage.Stage stage] +(defn start [^javafx.stage.Stage stage] (.show stage)) -(defn -stop [this] +(defn stop [] nil) (defn -main [& args] - (javafx.application.Application/launch example.core args)) + (fx/start-app init start stop)) @end lisp @node Core API @@ -87,18 +86,38 @@ This macro runs the code given on the JavaFX thread and blocks the current threa This macro runs the code given on the JavaFX thread and immediately returns. Prefixing the s-exp with an @@ has the same effect as using @code{run-now}. @end deffn +@deffn clojurefx.clojurefx fi interface args & code +This macro is used to use a Clojure function as a functional interface. The interface name is needed: @code{(fx/fi javafx.event.Event [event] eventhandling-code)} +@end deffn + +@deffn clojurefx.clojurefx connect instance function args & code +This macro is used to use a Clojure function as a functional interface. The function must be written in kebab case: @code{(fx/connect btn set-on-action [event] (do-something-with event))} +@end deffn + +@deffn clojurefx.clojurefx find-child-by-class node clazz +With this function, you can find an element / elements in a scenegraph by one of its CSS classes. +@end deffn + +@deffn clojurefx.clojurefx find-child-by-id node id +Analogous to find-child-by-class, but to find an element by fx:id. +@end deffn + @node Coding a scenegraph @chapter Coding a scenegraph -@strong{This part of the library is not yet completed; mainly, the problem is that some objects can have children while not being a Parent.} +You can write a scenegraph in-code using the @code{compile} function. It is straightforward, alternating between the class name and the element's properties. Make sure though to either use @code{start-app} function or first initialize the toolkit: + +@code{(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))} + +There are no further dependencies for this, since the calls are made using Clojure's reflection API. Let's look at an example: @lisp (require '[clojurefx.clojure :refer [compile]]) -(compile [VBox @{:id "TopLevelVBox" - :children [Label @{:text "Hi!"@} - Label @{:text "I'm ClojureFX!"@} - HBox @{:id "HorizontalBox" - :children [Button @{:text "Alright."@}]@}]@}]) +(compile [Scene @{:root [VBox @{:id "TopLevelVBox" + :children [Label @{:text "Hi!"@} + Label @{:text "I'm ClojureFX!"@} + HBox @{:id "HorizontalBox" + :children [Button @{:text "Alright."@}]@}]@}]@}]) @end lisp @node Scenegraph API diff --git a/project.clj b/project.clj index 1c363f6..9ead1c9 100644 --- a/project.clj +++ b/project.clj @@ -5,8 +5,9 @@ :signing {:gpg-key "68484437"} :dependencies [[org.clojure/clojure "1.9.0"] [org.clojure/core.async "0.4.474" :scope "test"] - [org.openjfx/javafx-fxml "11-ea+25"] - [org.openjfx/javafx-swing "11-ea+25"] + [org.clojars.tristefigure/shuriken "0.14.28" :scope "test"] + [org.openjfx/javafx-fxml "11-ea+25" :scope "test"] + [org.openjfx/javafx-swing "11-ea+25" :scope "test"] [swiss-arrows "1.0.0"] [camel-snake-kebab "0.4.0"] [com.taoensso/timbre "4.10.0" :exclusions [com.taoensso/carmine]] @@ -16,7 +17,8 @@ [clojure-jsr-223 "0.1.0"] ] :profiles {:test {:source-paths ["test"] - :resource-paths ["test-resources"]} + :resource-paths ["test-resources"] + :aot :all} :uberjar {:aot :all}} :aot :all :omit-source true diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj index d4a792d..7a7ccf6 100644 --- a/src/clojurefx/clojurefx.clj +++ b/src/clojurefx/clojurefx.clj @@ -5,42 +5,61 @@ [clojure.reflect :as reflect] [clojure.string :as str] [swiss.arrows :refer :all] - [clojure.spec.alpha :as s]) + [clojure.spec.alpha :as s] + [clojure.pprint :refer :all] + [shuriken.macro :as sm]) (:import (javafx.scene.layout Region) (javafx.scene.shape Rectangle) - (clojurefx.ApplicationInitializer))) + (clojurefx.ApplicationInitializer) + (java.lang.reflect Method) + (javafx.scene.control Button))) (timbre/refer-timbre) ;; ## Specs -(s/def ::node (fn [x] (or (instance? javafx.scene.Node x) (instance? javafx.scene.Scene x)))) +(s/def ::node (partial instance? javafx.scene.Node)) +(s/def ::scene (partial instance? javafx.scene.Scene)) +(s/def ::stage (partial instance? javafx.stage.Stage)) +(s/def ::scenegraph (s/or :node ::node + :scene ::scene + :stage ::stage)) +(s/def ::args (s/coll-of symbol?)) +(s/def ::code (s/coll-of any?)) ;; ## Functional interfaces +(defn fi* [interface args code] + (debug "fi*") + (let [iface-ref (reflect/type-reflect interface) + methods (filter #(instance? clojure.reflect.Method %) (:members iface-ref)) + functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods) + method-sym (:name (first functional-method))] + (eval `(proxy [~interface] [] + (~method-sym ~args + ~@code))))) + (defmacro fi "This macro is used to make use of functional interfaces. The class name of the functional interface has to be given." [interface args & code] - (let [iface-ref (reflect/type-reflect interface) + (debug "fi") + ;;`(fi* ~interface '~args '~code) + (let [iface-ref (reflect/type-reflect interface) methods (filter #(instance? clojure.reflect.Method %) (:members iface-ref)) - functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods) + functional-method (filter (fn [x] (some #(= % :abstract) (:flags x))) methods) method-sym (:name (first functional-method))] - (debug "method-sym:" method-sym) - (when-not (= (count functional-method) 1) (throw (new Exception (str "can't take an interface with more than one method:" (pr-str functional-method))))) - - (debug (pr-str `(proxy [~interface] [] - (~method-sym ~args ~@code)))) - + (debug "Writing proxy.") `(proxy [~interface] [] (~method-sym ~args - ~@code)))) + ~@code))) + ) (defn- map2 "Like map, but takes two elements at a time." ([fun a b] (list (fun a b))) ([fun [a b & coll]] - (cons (fun a b) (map2 fun coll)))) + (cons (fun a b) (map2 fun coll)))) (defn typematcher [arg-types methods] @@ -54,28 +73,32 @@ :else (recur arg-types (rest methods))))) +(declare camelcase-low) + +(def instancecache (atom {})) +(defmacro objwrap [obj sym] + (do + (swap! instancecache assoc sym obj) + `(let [obj# (get @instancecache ~sym)] + (debug "Calling back object" obj# "with hash" ~sym) + (swap! instancecache dissoc ~sym) + obj#))) + (defmacro connect - "This macro is used to make use of functional interfaces. The args list has to be provided with the arg types, like in Java: [Type name1 Type name2]." - [instance args & code] - (let [class-ref (reflect/type-reflect (class instance)) - ifaces (flatten (map reflect/type-reflect (into #{} (:bases class-ref)))) - methods (filter #(instance? clojure.reflect.Method %) (:members ifaces)) - functional-methods (filter (fn [x] (some #(= % :abstract) (:flags x))) methods) - arg-types (map2 (fn [a _] a) args) - method (typematcher arg-types functional-methods)] - (debug "method-sym:" (:name method)) - - `(proxy [~(:declaring-class method)] [] - (~(:name method) ~(map2 (fn [_ b] b) args) - ~@code)) - )) - -(defmacro handle - "" - [obj prop fun] - (let [argument (->> fun (drop 1) first) - code (drop 2 fun)] - `(.setValue (~(symbol (str (name obj) "/" (name prop)))) (fi javafx.event.ActionEvent ~argument ~@code)))) + [instance method args & code] + `(let [instance# ~instance + dbg# (debug "instance#" instance#) + method# '~(if (instance? clojure.lang.Cons method) (second method) method) + dbg# (debug "method#" method#) + functional-method# (first (clojure.lang.Reflector/getMethods (class instance#) 1 (camelcase-low (name method#)) false)) + dbg# (debug "functional-method#" functional-method#) + functional-para# (symbol (.getName (first (.getParameterTypes ^Method functional-method#)))) + dbg# (debug "functional-para#" functional-para#) + code# '~(if (= 1 (count code)) (first code) code) + dbg# (debug "code#" code#)] + (eval `(~(symbol (str "." (camelcase-low (name method#)))) ~`(objwrap ~instance# ~(hash instance#)) + (fi ~functional-para# ~'~args '~@code#)))) + ) (defn start-app [app-init app-start app-stop] (clojurefx.ApplicationInitializer/initApp app-init app-start app-stop)) @@ -90,9 +113,13 @@ (let [splitted (str/split (name kebabcase) #"-")] (reduce #(str %1 (str/capitalize %2)) "" splitted))) +(defn camelcase-low [kebabcase] + (let [splitted (str/split (name kebabcase) #"-")] + (reduce #(str %1 (str/capitalize %2)) (first splitted) (rest splitted)))) + ;; ## Threading helpers -(defn run-later*" +(defn run-later* " Simple wrapper for Platform/runLater. You should use run-later. " [f] (assert (instance? Runnable f)) @@ -139,7 +166,6 @@ first)) (defn invoke-constructor [clazz args] - (info "Constructing" clazz "with" (first args)) (clojure.lang.Reflector/invokeConstructor clazz (into-array args))) ;; ## Scene graph walker @@ -147,8 +173,6 @@ (and (not (nil? node)) (not (empty? (clojure.lang.Reflector/getMethods (class node) 0 method false))))) (defn- graph-node-has-children? [node] - ;{:pre [(s/valid? ::node node)] - ; :post [boolean?]} (or (has-method? node "getChildren") (has-method? node "getGraphic") (has-method? node "getMenus") @@ -156,20 +180,22 @@ (has-method? node "getContent") (has-method? node "getTabs") (has-method? node "getItems") - (has-method? node "getRoot")) + (has-method? node "getRoot") + (has-method? node "getScene")) ) (defn- graph-node-get-children [node] - {:pre [(s/valid? ::node node)] + {:pre [(s/valid? ::scenegraph node)] :post [coll?]} (cond (has-method? node "getChildren") (.getChildren node) - (has-method? node "getGraphic") [(.getGraphic node)] - (has-method? node "getMenus") (.getMenus node) - (has-method? node "getContent") [(.getContent node)] - (has-method? node "getTabs") (.getTabs node) - (has-method? node "getColumns") (.getColumns node) - (has-method? node "getItems") (.getItems node) - (has-method? node "getRoot") [(.getRoot node)]) + (has-method? node "getGraphic") [(.getGraphic node)] + (has-method? node "getMenus") (.getMenus node) + (has-method? node "getContent") [(.getContent node)] + (has-method? node "getTabs") (.getTabs node) + (has-method? node "getColumns") (.getColumns node) + (has-method? node "getItems") (.getItems node) + (has-method? node "getRoot") [(.getRoot node)] + (has-method? node "getScene") [(.getScene node)]) ) ;; (def struct (compile [Scene {:root [VBox {:children [Label {:text "Hi!" :style-class ["test"]}]}]}])) @@ -182,32 +208,37 @@ (zip/node zipper) (lazy-seq (cons (zip/node zipper) (flat-zipper (zip/next zipper)))))) +(defn- has-id? [node id] + {:pre [(s/valid? ::scenegraph node) (string? id)] + :post [boolean?]} + (if (s/valid? ::node node) + (= id (.getId node)) + false)) + (defn find-child-by-id [node id] - {:pre [(s/valid? ::node node) - (string? id)] - :post [#(or (s/valid? ::node node) nil?)]} + {:pre [(s/valid? ::scenegraph node) + (string? id)] + :post [#(or (s/valid? ::scenegraph node) nil?)]} (let [zipper (scenegraph-zipper node)] - (filter #(= id (.getId %)) (flat-zipper zipper)))) + (first (filter #(has-id? % id) (flat-zipper zipper))))) (defn- contains-class? [node clazz] - {:pre [(s/valid? ::node node) (string? clazz)] + {:pre [(s/valid? ::scenegraph node) (string? clazz)] :post [boolean?]} - (s/valid? ::node node) - (if (instance? javafx.scene.Scene node) - false - (< 0 (count (filter #(= % clazz) (.getStyleClass node)))))) + (if (s/valid? ::node node) + (< 0 (count (filter #(= % clazz) (.getStyleClass node)))) + false)) (defn find-child-by-class [node clazz] - {:pre [(s/valid? ::node node) - (string? clazz)] - :post [#(or (s/valid? ::node node) nil?)]} + {:pre [(s/valid? ::scenegraph node) + (string? clazz)] + :post [#(or (s/valid? ::scenegraph node) nil?)]} (let [zipper (scenegraph-zipper node)] (filter #(contains-class? % clazz) (flat-zipper zipper)))) ;; ## Properties (defn find-property [obj prop] - (info obj prop) (clojure.lang.Reflector/invokeInstanceMethod obj (str (camelcase prop) "Property") (into-array []))) (defn get-property-value @@ -216,30 +247,39 @@ (defn set-property-value ([obj prop val] - (info obj ": Setting property" prop "to" val) (clojure.lang.Reflector/invokeInstanceMethod obj (str "set" (camelcase prop)) (into-array [val])))) ;; ## In-code scenegraph (declare compile-o-matic) +(defn- apply-connects [nodeobj [[method args & code] & conncoll]] + {:pre [(s/valid? ::node nodeobj) + (symbol? method) + (s/valid? ::args args) + (s/valid? ::code code)]} + (eval `(connect ~`(objwrap ~nodeobj ~(hash nodeobj)) '~method '~args ~code)) + (debug "Heyy!") + (if (not (or (nil? conncoll) (empty? conncoll))) + (recur nodeobj conncoll))) + (defn- apply-props-to-node [nodeobj propmap] (doseq [[k v] propmap] - (case k - :children (.add (.getChildren nodeobj) (compile-o-matic v)) - :style-class (.addAll (.getStyleClass nodeobj) (compile-o-matic v)) - (set-property-value nodeobj k (compile-o-matic v)))) + (cond + (= k :children) (.add (.getChildren nodeobj) (compile-o-matic v)) + (= k :style-class) (.addAll (.getStyleClass nodeobj) (compile-o-matic v)) + (= k :connect) (apply-connects nodeobj v) + :else (set-property-value nodeobj k (compile-o-matic v))) + ) nodeobj) (defn- propmap-splitter [clazz propmap] (let [constructor-args (keys (get @constructor-args clazz))] - (info "Constructor args for" clazz "are" constructor-args) [(map propmap constructor-args) (apply dissoc propmap constructor-args)])) (defn- build-node [clazz propmap] (let [[cargs props] (propmap-splitter clazz propmap) nodeobj (invoke-constructor clazz (map compile-o-matic cargs))] - (info cargs " " props) (apply-props-to-node nodeobj props) nodeobj)) diff --git a/test/clojurefx/fxml_test.clj b/test/clojurefx/fxml_test.clj index 9f7d38e..81365f0 100644 --- a/test/clojurefx/fxml_test.clj +++ b/test/clojurefx/fxml_test.clj @@ -3,39 +3,37 @@ [clojure.core.async :as async :refer [! chan go go-loop]] [clojure.test :as t] [clojure.java.io :as io] - [taoensso.timbre :as timbre])) -;(timbre/refer-timbre) + [taoensso.timbre :as timbre + :refer [debug]])) ; -;(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.)) -; -;(def test1-fxml (io/resource "fxml/exampleWindow.fxml")) -; -;(t/deftest fxml-loading -; (debug "FXML loading") -; (t/is (instance? javafx.scene.Node (sut/load-fxml test1-fxml)))) -; -;(def test2-fxml (io/resource "fxml/exampleControllerWindow.fxml")) -; -;(t/deftest controller-generation -; (t/is (instance? java.lang.Class (sut/generate-controller test2-fxml "a.b/c")))) -; -; -; -;(def instance (atom nil)) -;(def clicked (atom false)) -; -;(defn initialize [inst] -; (reset! instance inst)) -; -;(defn test-1-click [_ e] -; (reset! clicked true)) -; -;(sut/load-fxml-with-controller test2-fxml "clojurefx.fxml-test/initialize") -; -;(t/deftest proper-init -; (t/is (instance? ch.lyrion.Test1 @instance))) -; -;(.fire (.simpleButton @instance)) -; -;(t/deftest testfire-result -; (t/is @clicked)) +(go (defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))) +(Thread/sleep 500) + +(def test1-fxml (io/resource "fxml/exampleWindow.fxml")) + +(t/deftest fxml-loading + (t/is (instance? javafx.scene.Node (sut/load-fxml test1-fxml)))) + +(def test2-fxml (io/resource "fxml/exampleControllerWindow.fxml")) + +(t/deftest controller-generation + (t/is (instance? java.lang.Class (sut/generate-controller test2-fxml "a.b/c")))) + +(def instance (atom nil)) +(def clicked (atom false)) + +(defn initialize [inst] + (reset! instance inst)) + +(defn test-1-click [_ e] + (reset! clicked true)) + +(sut/load-fxml-with-controller test2-fxml "clojurefx.fxml-test/initialize") + +(t/deftest proper-init + (t/is (instance? ch.lyrion.Test1 @instance))) + +(.fire (.simpleButton @instance)) + +(t/deftest testfire-result + (t/is @clicked)) diff --git a/test/clojurefx/scenegraph_test.clj b/test/clojurefx/scenegraph_test.clj index 28978e8..3d8b2c1 100644 --- a/test/clojurefx/scenegraph_test.clj +++ b/test/clojurefx/scenegraph_test.clj @@ -5,7 +5,7 @@ [clojure.test :as t] [taoensso.timbre :as timbre :refer [info]]) - (:import (javafx.scene.control Label) + (:import (javafx.scene.control Label Button) (javafx.scene Scene) (javafx.scene.layout VBox))) @@ -19,4 +19,30 @@ (t/is (instance? Label (first (find-child-by-class (compile [Scene {:root [VBox {:children [Label {:text "Hi!" :style-class ["test"]}]}]}]) "test")) - ))) \ No newline at end of file + ))) + +(t/deftest test-find-child-by-id + (t/is (instance? Label + (find-child-by-id (compile [Scene {:root [VBox {:children [Label {:text "Hi!" :id "test"}]}]}]) + "test") + ))) + +(t/deftest functional-interfaces-fi + (let [fired (atom false) + btn (Button.)] + (.setOnAction btn (fi javafx.event.EventHandler [event] (reset! fired true))) + (.fire btn) + (t/is @fired))) + +(t/deftest functional-interfaces-connect + (let [fired (atom false) + btn (Button.)] + (connect btn set-on-action [event] (reset! fired true)) + (.fire btn) + (t/is @fired))) + +(t/deftest connect-in-compile + (let [fired (atom false) + graph (compile [Scene {:root [VBox {:children [Button {:id "Button" :connect ['(set-on-action [event] (reset! fired true))]}]}]}])] + (.fire (find-child-by-id graph "Button")) + (t/is @fired))) \ No newline at end of file