diff --git a/docs/manual.texinfo b/docs/manual.texinfo index 8bfdade..584acbc 100644 --- a/docs/manual.texinfo +++ b/docs/manual.texinfo @@ -90,7 +90,7 @@ This macro runs the code given on the JavaFX thread and immediately returns. Pre @node Coding a scenegraph @chapter Coding a scenegraph -@strong{This part of the library has not been tested for a long time; I will get to it eventually, but expect things to be somewhat broken.} +@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.} @lisp (require '[clojurefx.clojure :refer [compile]]) diff --git a/project.clj b/project.clj index 26a71b4..1c363f6 100644 --- a/project.clj +++ b/project.clj @@ -10,9 +10,9 @@ [swiss-arrows "1.0.0"] [camel-snake-kebab "0.4.0"] [com.taoensso/timbre "4.10.0" :exclusions [com.taoensso/carmine]] - [net.openhft/compiler "2.3.0"] - [org.ow2.asm/asm "6.0"] - [org.ow2.asm/asm-util "6.0"] + [net.openhft/compiler "2.3.1"] + [org.ow2.asm/asm "6.2.1"] + [org.ow2.asm/asm-util "6.2.1"] [clojure-jsr-223 "0.1.0"] ] :profiles {:test {:source-paths ["test"] diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj index aa4fe2b..be0f319 100644 --- a/src/clojurefx/clojurefx.clj +++ b/src/clojurefx/clojurefx.clj @@ -4,13 +4,17 @@ [clojure.zip :as zip] [clojure.reflect :as reflect] [clojure.string :as str] - [swiss.arrows :refer :all]) + [swiss.arrows :refer :all] + [clojure.spec.alpha :as s]) (:import (javafx.scene.layout Region) (javafx.scene.shape Rectangle) (clojurefx.ApplicationInitializer))) (timbre/refer-timbre) +;; ## Specs +(s/def ::node (partial instance? javafx.scene.Node)) + ;; ## Functional interfaces (defmacro fi @@ -138,6 +142,61 @@ (info "Constructing" clazz "with" (first args)) (clojure.lang.Reflector/invokeConstructor clazz (into-array args))) + +;; ## Scene graph walker +(defn- has-method? [node method] + (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") + (has-method? node "getColumns") + (has-method? node "getContent") + (has-method? node "getTabs") + (has-method? node "getItems")) + ) + +(defn- graph-node-get-children [node] + {:pre [(s/valid? ::node 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)) + ) + +(defn scenegraph-zipper [node] + (zip/zipper graph-node-has-children? graph-node-get-children nil node)) + +(defn- flat-zipper [zipper] + (let [next (zip/next zipper)] + (if (zip/end? next) + (node next) + (lazy-seq (cons (node next) next))))) + +(defn find-child-by-id [node id] + {:pre [(s/valid? ::node node) + (string? id)] + :post [#(or (s/valid? ::node node) nil?)]} + (let [zipper (scenegraph-zipper node)] + (filter #(= id (.getId %)) (flat-zipper zipper)))) + +(defn- contains-class? [coll clazz] + (> 0 (count (filter #(= % clazz) coll)))) + +(defn find-child-by-class [node clazz] + {:pre [(s/valid? ::node node) + (string? id)] + :post [#(or (s/valid? ::node node) nil?)]} + (let [zipper (scenegraph-zipper node)] + (filter #(contains-class? (.getStyleClass %) clazz) (flat-zipper zipper)))) + ;; ## Properties (defn find-property [obj prop] diff --git a/test/clojurefx/fxml_test.clj b/test/clojurefx/fxml_test.clj index 8ef4bc8..9f7d38e 100644 --- a/test/clojurefx/fxml_test.clj +++ b/test/clojurefx/fxml_test.clj @@ -4,38 +4,38 @@ [clojure.test :as t] [clojure.java.io :as io] [taoensso.timbre :as timbre])) -(timbre/refer-timbre) - -(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)) +;(timbre/refer-timbre) +; +;(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))