Preparatory changes
This commit is contained in:
parent
c26d449f66
commit
11d045a2cc
|
|
@ -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]
|
||||
|
|
|
|||
|
|
@ -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 []))
|
||||
|
|
|
|||
|
|
@ -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]))
|
||||
Loading…
Reference in New Issue