diff --git a/src/clojurefx/clojurefx.clj b/src/clojurefx/clojurefx.clj index 47111cb..96b55f7 100644 --- a/src/clojurefx/clojurefx.clj +++ b/src/clojurefx/clojurefx.clj @@ -2,7 +2,9 @@ (:require [taoensso.timbre :as timbre] [clojure.java.io :as io] [clojure.zip :as zip] - [clojurefx.protocols :as p])) + [clojurefx.protocols :as p]) + (:import (javafx.scene.layout Region) + (javafx.scene.shape Rectangle))) ;; Fuck you, whoever made that API design. (defonce force-toolkit-init (javafx.embed.swing.JFXPanel.)) @@ -27,16 +29,30 @@ ;; ## Threading helpers -(defmacro run-later "Simple wrapper for Platform/runLater." [& body] - `(javafx.application.Platform/runLater (fn [] ~@body))) +(defn run-later*" + Simple wrapper for Platform/runLater. You should use run-later. + " [f] + (assert (instance? Runnable f)) + (javafx.application.Platform/runLater f) + nil) -(defmacro run-now "Runs the code on the FX application thread and waits until the return value is delivered." - [& body] - `(if (javafx.application.Platform/isFxApplicationThread) - (apply (fn [] ~@body) []) - (let [result (promise)] - (run-later (deliver result (try (fn [] ~@body) (catch Throwable e e)))) - @result))) +(defmacro run-later [& body] + `(run-later* (fn [] ~@body))) + +(defn run-now* " + A modification of run-later waiting for the running method to return. You should use run-now. + " [f] + (if (javafx.application.Platform/isFxApplicationThread) + (apply f []) + (let [result (promise)] + (run-later + (deliver result (try (f) (catch Throwable e e)))) + @result))) + +(defmacro run-now " + Runs the code on the FX application thread and waits until the return value is delivered. + " [& body] + `(run-now* (fn [] ~@body))) (defn collize " Turns the input into a collection, if it isn't already. @@ -130,6 +146,23 @@ (subnodes [this] (.getPanes ^Accordion this)) (set-subnodes! [this nodes] (.setAll ^ObservableList (.getPanes ^Accordion this) (collize nodes)) this)) +(extend-protocol p/FXRegion + Region + (width [this] (.getWidth ^Region this)) + (min-width [this] (.getMinWidth ^Region this)) + (set-min-width! [this width] (.setMinWidth ^Region this ^double width)) + (max-width [this] (.getMaxWidth ^Region this)) + (set-max-width! [this width] (.setMaxWidth ^Region this ^double width)) + (pref-width [this] (.getPrefWidth ^Region this)) + (set-pref-width! [this width] (.setPrefWidth ^Region this ^double width)) + (height [this] (.getHeight ^Region this)) + (min-height [this] (.getMinHeight ^Region this)) + (set-min-height [this height] (.setMinHeight ^Region this ^double height)) + (max-height [this] (.getMaxHeight ^Region this)) + (set-max-height [this height] (.setMaxHeight ^Region this ^double height)) + (pref-height [this] (.getPrefHeight ^Region this)) + (set-pref-height! [this height] (.setPrefHeight ^Region this ^double height))) + (extend-protocol p/FXContainer Tab (content [this] (.getContent ^Tab this)) @@ -205,6 +238,25 @@ (root [this] (.getRoot ^Scene this)) (set-root! [this root] (.setRoot ^Scene this ^Parent root) this)) +;;## Shapes + +;;### Rectangle + +(extend-type Rectangle + p/FXRectangle + (arc-height [this] (.getArcHeight ^Rectangle this)) + (set-arc-height! [this height] (.setArcHeight ^Rectangle this ^double height)) + (arc-width [this] (.getArcWidth ^Rectangle this)) + (set-arc-width! [this width] (.setArcWidth ^Rectangle this ^double width)) + (height [this] (.getHeight ^Rectangle this)) + (set-height! [this height] (.setHeight ^Rectangle this ^double height)) + (width [this] (.getWidth ^Rectangle this)) + (set-width! [this width] (.setWidth ^Rectangle this ^double width)) + (x [this] (.getX ^Rectangle this)) + (set-x! [this x] (.setX ^Rectangle this ^double x)) + (y [this] (.getY ^Rectangle this)) + (set-y! [this y] (.setY ^Rectangle this ^double y))) + ;;## Event handling helper (defn bind-event [handler] diff --git a/src/clojurefx/factory.clj b/src/clojurefx/factory.clj index 4d4c160..57596d8 100644 --- a/src/clojurefx/factory.clj +++ b/src/clojurefx/factory.clj @@ -3,7 +3,8 @@ [clojure.java.io :as io] [clojurefx.clojurefx :as fx] [clojurefx.protocols :refer :all]) - (:import (javafx.scene Scene Node Parent))) + (:import (javafx.scene Scene Node Parent) + (javafx.scene.layout Region))) (timbre/refer-timbre) @@ -21,53 +22,77 @@ (def translation-map (atom {;;; FXValue - :text (with-meta [#'value #'set-value!] {:argument String :parent FXValue}) - :value (with-meta [#'value #'set-value!] {:argument Object :parent FXValue}) + :text (with-meta [#'value #'set-value!] {:argument String :parent FXValue}) + :value (with-meta [#'value #'set-value!] {:argument Object :parent FXValue}) ;;; FXId - :id (with-meta [#'id #'set-id!] {:argument String :parent FXId}) + :id (with-meta [#'id #'set-id!] {:argument String :parent FXId}) ;;; FXGraphic - :graphic (with-meta [#'graphic #'set-graphic!] {:argument Node :parent FXGraphic}) + :graphic (with-meta [#'graphic #'set-graphic!] {:argument Node :parent FXGraphic}) ;;; FXContainer - :content (with-meta [#'content #'set-content!] {:argument Node :parent FXContainer}) + :content (with-meta [#'content #'set-content!] {:argument Node :parent FXContainer}) ;;; FXParent - :children (with-meta [#'subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent}) + :children (with-meta [#'subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent}) + ;;; FXRegion + ;; :width (with-meta [#'width] {:argument Region :parent FXRegion}) + :min-width (with-meta [#'min-width #'set-min-width!] {:argument Region :parent FXRegion}) + :max-width (with-meta [#'max-width #'set-max-width!] {:argument Region :parent FXRegion}) + :pref-width (with-meta [#'pref-width #'set-pref-width!] {:argument Region :parent FXRegion}) + ;; :height (with-meta [#'height] {:argument Region :parent FXRegion}) + :min-height (with-meta [#'min-height #'set-min-height!] {:argument Region :parent FXRegion}) + :max-height (with-meta [#'max-height #'set-max-height!] {:argument Region :parent FXRegion}) + :pref-height (with-meta [#'pref-height #'set-pref-height!] {:argument Region :parent FXRegion}) ;;; FXStyleSetter / FXStyleable - :style (with-meta [#'style #'set-style!] {:argument String :parent FXStyleable}) + :style (with-meta [#'style #'set-style!] {:argument String :parent FXStyleable}) ;;; FXOnAction - :action (with-meta [#'action #'set-action!] {:argument clojure.lang.IFn :parent FXOnAction}) + :action (with-meta [#'action #'set-action!] {:argument clojure.lang.IFn :parent FXOnAction}) ;;; FXStage - :title (with-meta [#'title #'set-title!] {:argument String :parent FXStage}) - :scene (with-meta [#'scene #'set-scene!] {:argument Scene :parent FXStage}) + :title (with-meta [#'title #'set-title!] {:argument String :parent FXStage}) + :scene (with-meta [#'scene #'set-scene!] {:argument Scene :parent FXStage}) ;;; FXScene - :root (with-meta [#'root #'set-root!] {:argument Parent :parent FXScene})})) + :root (with-meta [#'root #'set-root!] {:argument Parent :parent FXScene}) + ;;; FXRectangle + :arc-height (with-meta [#'arc-height #'set-arc-height!] {:argument Double :parent FXRectangle}) + :arc-width (with-meta [#'arc-width #'set-arc-width!] {:argument Double :parent FXRectangle}) + :height (with-meta [#'height #'set-width!] {:argument Double :parent FXRectangle}) + :width (with-meta [#'height #'set-height!] {:argument Double :parent FXRectangle}) + :x (with-meta [#'x #'set-x!] {:argument Double :parent FXRectangle}) + :y (with-meta [#'y #'set-y!] {:argument Double :parent FXRectangle}) + })) -(def mandatory-constructor-args - (atom {javafx.scene.Scene [:root]})) +(def constructor-args + (atom {javafx.scene.Scene [:root] + javafx.stage.Stage [:style]})) (declare compile-o-matic) (defn apply-props-to-node [node props] + (debug "Applying" (count props) "properties to" node) (doseq [[k v] props] (let [translation (get @translation-map k) {:keys [argument parent]} (meta translation) v (compile-o-matic v)] - (trace "Key:" k " " (type k) "Value:" v " " (type v)) + (debug "Key:" k "Value:" v " " (type v) "Translation:" translation) (when (nil? translation) - (throw (Exception. (str "Property" k "not available in translation map.")))) - ((setter translation) node v))) + (error (str "Property" k "not available in translation map.")) + ;;(throw (Exception. (str "Property" k "not available in translation map."))) + ) + (try ((setter translation) node v) + (catch Exception e (error e))))) + (debug "Done applying properties for" node) node) (defn build-node [object props] (debug "build-node:" object props) - (let [mandatory (get mandatory-constructor-args object) + (let [cargs (get @constructor-args object) form `(~object new)] + (debug "Constructor args for" (class object) ":" cargs "->" props) (apply-props-to-node - (-> (reduce (fn [form mandatory] - (if-let [entry (get props mandatory)] - (cons entry form) - form)) form mandatory) - reverse - eval) - (apply dissoc props mandatory)))) + (->> (reduce (fn [form mandatory] + (if-let [entry (compile-o-matic (get props mandatory))] + (cons entry form) + form)) form cargs) + reverse + eval) + (apply dissoc props cargs)))) (defn compile ([args] (compile args [])) diff --git a/src/clojurefx/protocols.clj b/src/clojurefx/protocols.clj index 663f20c..cbccfcc 100644 --- a/src/clojurefx/protocols.clj +++ b/src/clojurefx/protocols.clj @@ -28,6 +28,24 @@ (subnodes [this]) (set-subnodes! [this nodes])) +(defprotocol + FXRegion + "The ClojureFX extension to javafx.scene.layout.Region." + (width [this]) + (min-width [this]) + (set-min-width! [this width]) + (max-width [this]) + (set-max-width! [this width]) + (pref-width [this]) + (set-pref-width! [this width]) + (height [this]) + (min-height [this]) + (set-min-height! [this height]) + (max-height [this]) + (set-max-height! [this height]) + (pref-height [this]) + (set-pref-height! [this height])) + (defprotocol FXContainer (content [this]) @@ -89,3 +107,22 @@ FXScene (root [this]) (set-root! [this root])) + +;;## Shapes + +;;### Rectangle + +(defprotocol + FXRectangle + (arc-height [this]) + (set-arc-height! [this height]) + (arc-width [this]) + (set-arc-width! [this width]) + (height [this]) + (set-height! [this height]) + (width [this]) + (set-width! [this width]) + (x [this]) + (set-x! [this x]) + (y [this]) + (set-y! [this y])) \ No newline at end of file