Preparatory changes

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,17 +29,31 @@
 
 ;; ## Threading helpers
 
-(defmacro run-later "Simple wrapper for Platform/runLater." [& body]
+(defn run-later*"
-  `(javafx.application.Platform/runLater (fn [] ~@body)))
+  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."
+(defmacro run-later [& body]
-  [& body]
+  `(run-later* (fn [] ~@body)))
-  `(if (javafx.application.Platform/isFxApplicationThread)
+
-     (apply (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 (fn [] ~@body) (catch Throwable e e))))
+      (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.
   " [input]
@@ -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]

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)
 
@@ -31,6 +32,15 @@
          :content     (with-meta [#'content #'set-content!] {:argument Node :parent FXContainer})
          ;;; 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})
          ;;; FXOnAction
@@ -39,35 +49,50 @@
          :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
+(def constructor-args
-  (atom {javafx.scene.Scene [:root]}))
+  (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."))))
+        (error (str "Property" k "not available in translation map."))
-      ((setter translation) node v)))
+        ;;(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]
+      (->> (reduce (fn [form mandatory]
-                   (if-let [entry (get props mandatory)]
+                     (if-let [entry (compile-o-matic (get props mandatory))]
                        (cons entry form)
-                     form)) form mandatory)
+                       form)) form cargs)
            reverse
            eval)
-     (apply dissoc props mandatory))))
+      (apply dissoc props cargs))))
 
 (defn compile
   ([args] (compile args []))

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]))