Switch to reflection.
This commit is contained in:
parent
d971a87391
commit
78af498658
5 changed files with 76 additions and 517 deletions
|
@ -1,5 +1,6 @@
|
||||||
(defproject clojurefx "0.0.16"
|
(defproject clojurefx "0.0.16"
|
||||||
:dependencies [[org.clojure/clojure "1.8.0"]
|
:dependencies [[org.clojure/clojure "1.8.0"]
|
||||||
|
[swiss-arrows "1.0.0"]
|
||||||
[com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
|
[com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
|
||||||
[clojure-jsr-223 "0.1.0"]]
|
[clojure-jsr-223 "0.1.0"]]
|
||||||
:profiles {:uberjar {:aot :all}}
|
:profiles {:uberjar {:aot :all}}
|
||||||
|
|
|
@ -1,26 +0,0 @@
|
||||||
package clojurefx;
|
|
||||||
|
|
||||||
import clojure.java.api.Clojure;
|
|
||||||
import clojure.lang.IFn;
|
|
||||||
import javafx.application.Application;
|
|
||||||
import javafx.stage.Stage;
|
|
||||||
|
|
||||||
/**
|
|
||||||
* Created by zilti on 07.01.2017.
|
|
||||||
*/
|
|
||||||
public class AppWrap extends Application {
|
|
||||||
|
|
||||||
private String ns, fn;
|
|
||||||
|
|
||||||
public AppWrap(String ns, String fn) {
|
|
||||||
super();
|
|
||||||
this.ns = ns;
|
|
||||||
this.fn = fn;
|
|
||||||
}
|
|
||||||
|
|
||||||
@Override
|
|
||||||
public void start(Stage stage) throws Exception {
|
|
||||||
IFn handler = Clojure.var(ns, fn);
|
|
||||||
handler.invoke(stage);
|
|
||||||
}
|
|
||||||
}
|
|
|
@ -2,7 +2,10 @@
|
||||||
(:require [taoensso.timbre :as timbre]
|
(:require [taoensso.timbre :as timbre]
|
||||||
[clojure.java.io :as io]
|
[clojure.java.io :as io]
|
||||||
[clojure.zip :as zip]
|
[clojure.zip :as zip]
|
||||||
[clojurefx.protocols :as p])
|
[clojure.reflect :as reflect]
|
||||||
|
[clojure.string :as str]
|
||||||
|
[clojurefx.protocols :as p]
|
||||||
|
[swiss.arrows :refer :all])
|
||||||
(:import (javafx.scene.layout Region)
|
(:import (javafx.scene.layout Region)
|
||||||
(javafx.scene.shape Rectangle)))
|
(javafx.scene.shape Rectangle)))
|
||||||
|
|
||||||
|
@ -11,21 +14,26 @@
|
||||||
|
|
||||||
(timbre/refer-timbre)
|
(timbre/refer-timbre)
|
||||||
|
|
||||||
(import '(clojurefx AppWrap)
|
;; (import '(clojurefx AppWrap)
|
||||||
'(javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
|
;; '(javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
|
||||||
MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
|
;; MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
|
||||||
TitledPane TabPane Tab TableColumnBase Labeled ButtonBase)
|
;; TitledPane TabPane Tab TableColumnBase Labeled ButtonBase)
|
||||||
'(javafx.scene Node Scene Parent)
|
;; '(javafx.scene Node Scene Parent)
|
||||||
'(javafx.scene.layout Pane VBox)
|
;; '(javafx.scene.layout Pane VBox)
|
||||||
'(javafx.stage Stage)
|
;; '(javafx.stage Stage)
|
||||||
'(javafx.collections FXCollections ObservableList)
|
;; '(javafx.collections FXCollections ObservableList)
|
||||||
'(javafx.css Styleable)
|
;; '(javafx.css Styleable)
|
||||||
'(javafx.event Event ActionEvent EventTarget)
|
;; '(javafx.event Event ActionEvent EventTarget)
|
||||||
'(java.util Collection))
|
;; '(java.util Collection))
|
||||||
|
|
||||||
(defn gen-stage! [nspc fun]
|
;; ## Data
|
||||||
(let [appwrap (AppWrap. nspc fun)]
|
|
||||||
(.launch appwrap nil)))
|
(def constructor-args
|
||||||
|
(atom {javafx.scene.Scene {:root javafx.scene.Parent}
|
||||||
|
javafx.stage.Stage {:style javafx.stage.StageStyle}}))
|
||||||
|
|
||||||
|
(defn camelcase [kebabcase]
|
||||||
|
)
|
||||||
|
|
||||||
;; ## Threading helpers
|
;; ## Threading helpers
|
||||||
|
|
||||||
|
@ -66,227 +74,75 @@
|
||||||
check (type check)]
|
check (type check)]
|
||||||
(reduce #(or %1 (isa? check %2)) false impls)))
|
(reduce #(or %1 (isa? check %2)) false impls)))
|
||||||
|
|
||||||
;;## Shadows
|
;; ## FXMLLoader
|
||||||
|
|
||||||
(extend-protocol p/FXMeta
|
(defn load-fxml [filename]
|
||||||
clojure.lang.IObj
|
(let [loader (new javafx.fxml.FXMLLoader)]
|
||||||
(meta [this] (clojure.core/meta this))
|
(.setLocation loader (io/resource ""))
|
||||||
(with-meta [this metadata] (clojure.core/with-meta this metadata))
|
(.load loader (-> filename io/resource io/input-stream))))
|
||||||
Node
|
|
||||||
(meta [this] (.getUserData ^Node this))
|
|
||||||
(with-meta [this metadata] (.setUserData ^Node this metadata) this)
|
|
||||||
MenuItem
|
|
||||||
(meta [this] (.getUserData ^MenuItem this))
|
|
||||||
(with-meta [this metadata] (.setUserData ^MenuItem this metadata) this))
|
|
||||||
|
|
||||||
;;## Standard
|
;; ## Constructors
|
||||||
|
|
||||||
(extend-protocol p/FXValue
|
(defn find-constructor [clazz cargs]
|
||||||
Labeled
|
(->> (reflect/reflect clazz)
|
||||||
(value [this] (.getText ^Label this))
|
:members
|
||||||
(set-value! [this value] (.setText ^Label this ^String value) this)
|
(filter #(= clojure.reflect.Constructor (class %)))
|
||||||
TextField
|
(filter #(= cargs (:parameter-types %)))
|
||||||
(value [this] (.getText ^TextField this))
|
first))
|
||||||
(set-value! [this value] (.setText ^TextField this ^String value) this)
|
|
||||||
TextArea
|
|
||||||
(value [this] (.getText ^TextArea this))
|
|
||||||
(set-value! [this value] (.setText ^TextArea this ^String value) this)
|
|
||||||
CheckBox
|
|
||||||
(value [this] (.isSelected ^CheckBox this))
|
|
||||||
(set-value! [this value] (.setSelected ^CheckBox this ^Boolean value) this)
|
|
||||||
ComboBox
|
|
||||||
(value [this] (let [selection-model (.getSelectionModel ^ComboBox this)
|
|
||||||
_ (assert (not (nil? selection-model)))
|
|
||||||
index (.getSelectedIndex ^javafx.scene.control.SingleSelectionModel selection-model)]
|
|
||||||
(if (>= index 0)
|
|
||||||
(nth (.getItems ^ComboBox this) index)
|
|
||||||
(.getSelectedItem ^javafx.scene.control.SingleSelectionModel selection-model))))
|
|
||||||
(set-value! [this value] (let [sel-model (.getSelectionModel ^ComboBox this)
|
|
||||||
item (first (filter #(= value %) (.getItems ^ComboBox this)))]
|
|
||||||
(if-not (nil? item)
|
|
||||||
(.select ^javafx.scene.control.SingleSelectionModel sel-model item))) this)
|
|
||||||
Menu
|
|
||||||
(value [this] (.getText ^Menu this))
|
|
||||||
(set-value! [this value] (.setText ^Menu this ^String value) this)
|
|
||||||
MenuItem
|
|
||||||
(value [this] (.getText ^MenuItem this))
|
|
||||||
(set-value! [this value] (.setText ^MenuItem this ^String value) this))
|
|
||||||
|
|
||||||
(extend-protocol p/FXId
|
(defn invoke-constructor [clazz args]
|
||||||
Styleable
|
(clojure.lang.Reflector/invokeConstructor clazz (into-array args)))
|
||||||
(id [this] (.getId ^Styleable this))
|
|
||||||
(set-id! [this id] (.setId ^Styleable this ^String id) this))
|
|
||||||
|
|
||||||
(extend-protocol p/FXParent
|
;; ## Properties
|
||||||
Pane
|
|
||||||
(subnodes [this] (.getChildren ^Pane this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getChildren ^Pane this) (collize nodes)) this)
|
|
||||||
TabPane
|
|
||||||
(subnodes [this] (.getTabs ^TabPane this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getTabs ^TabPane this) (collize nodes)) this)
|
|
||||||
MenuBar
|
|
||||||
(subnodes [this] (.getMenus ^MenuBar this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getMenus ^MenuBar this) (collize nodes)) this)
|
|
||||||
Menu
|
|
||||||
(subnodes [this] (.getItems ^Menu this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^Menu this) nodes) (collize this))
|
|
||||||
MenuButton
|
|
||||||
(subnodes [this] (.getItems ^MenuButton this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^MenuButton this) (collize nodes)) this)
|
|
||||||
ContextMenu
|
|
||||||
(subnodes [this] (.getItems ^ContextMenu this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^ContextMenu this) (collize nodes)) this)
|
|
||||||
ToolBar
|
|
||||||
(subnodes [this] (.getItems ^ToolBar this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^ToolBar this) (collize nodes)) this)
|
|
||||||
SplitPane
|
|
||||||
(subnodes [this] (.getItems ^SplitPane this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^SplitPane this) (collize nodes)) this)
|
|
||||||
Accordion
|
|
||||||
(subnodes [this] (.getPanes ^Accordion this))
|
|
||||||
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getPanes ^Accordion this) (collize nodes)) this))
|
|
||||||
|
|
||||||
(extend-protocol p/FXRegion
|
(defn find-property [obj prop]
|
||||||
Region
|
(clojure.lang.Reflector/invokeInstanceMethod obj prop []))
|
||||||
(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
|
(defn get-property-value
|
||||||
Tab
|
([obj prop]
|
||||||
(content [this] (.getContent ^Tab this))
|
(.getValue (find-property obj (name prop)))))
|
||||||
(set-content! [this node] (.setContent ^Tab this ^Node node) this)
|
|
||||||
TitledPane
|
|
||||||
(content [this] (.getContent ^TitledPane this))
|
|
||||||
(set-content! [this node] (.setContent ^TitledPane this ^Node node) this)
|
|
||||||
ScrollPane
|
|
||||||
(content [this] (.getContent ^ScrollPane this))
|
|
||||||
(set-content! [this node] (.setContent ^ScrollPane this ^Node node) this))
|
|
||||||
|
|
||||||
(extend-protocol p/FXGraphic
|
(defn set-property-value
|
||||||
Labeled
|
([obj prop val]
|
||||||
(graphic [this] (.getGraphic ^Labeled this))
|
(.setValue (find-property obj (name prop)) val)))
|
||||||
(set-graphic! [this graphic] (.setGraphic ^Labeled this ^Node graphic))
|
|
||||||
MenuItem
|
|
||||||
(graphic [this] (.getGraphic ^Menu this))
|
|
||||||
(set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic)))
|
|
||||||
|
|
||||||
(extend-protocol p/FXStyleSetter
|
;; ## In-code scenegraph
|
||||||
Node
|
|
||||||
(set-style! [this style] (.setStyle ^Node this ^String style) this)
|
|
||||||
MenuItem
|
|
||||||
(set-style! [this style] (.setStyle ^MenuItem this ^String style) this))
|
|
||||||
|
|
||||||
(extend-type Styleable
|
(declare compile-o-matic)
|
||||||
p/FXStyleable
|
(defn- apply-props-to-node [nodeobj propmap]
|
||||||
(css-meta [this] (.getCssMetaData ^Styleable this))
|
(doseq [[k v] propmap]
|
||||||
(pseudo-class-styles [this] (.getPseudoClassStyles ^Styleable this))
|
(set-property-value nodeobj k v))
|
||||||
(style [this] (.getStyle ^Styleable this))
|
nodeobj)
|
||||||
(style-classes [this] (.getStyleClass ^Styleable this))
|
|
||||||
(set-style-classes! [this classes] (.setAll ^ObservableList (.getStyleClass ^Styleable this) classes) this)
|
|
||||||
(styleable-parent [this] (.getStyleableParent ^Styleable this))
|
|
||||||
(type-selector [this] (.getTypeSelector ^Styleable this)))
|
|
||||||
|
|
||||||
(declare bind-event)
|
(defn- propmap-splitter [clazz propmap]
|
||||||
(extend-protocol p/FXOnAction
|
(let [constructor-args (get @constructor-args clazz)]
|
||||||
ButtonBase
|
[(map propmap constructor-args) (apply dissoc propmap constructor-args)]))
|
||||||
(action [this] (.getOnAction ^ButtonBase this))
|
|
||||||
(set-action! [this action] (.setOnAction ^ButtonBase this (bind-event action)) this)
|
|
||||||
(fire! [this] (.fire this))
|
|
||||||
MenuItem
|
|
||||||
(action [this] (.getOnAction ^MenuItem this))
|
|
||||||
(set-action! [this action] (.setOnAction ^ButtonBase this (bind-event action)) this)
|
|
||||||
(fire! [this] (.fire this)))
|
|
||||||
|
|
||||||
;;## Special Types
|
(defn- build-node [clazz propmap]
|
||||||
|
(let [[cargs props] (propmap-splitter clazz propmap)
|
||||||
|
nodeobj (invoke-constructor clazz cargs)]
|
||||||
|
(apply-props-to-node nodeobj props)
|
||||||
|
nodeobj))
|
||||||
|
|
||||||
;;### javafx.event
|
(defn compile
|
||||||
|
([args] (run-now (compile args [])))
|
||||||
|
([[obj & other] accu]
|
||||||
|
(cond
|
||||||
|
(nil? obj) accu
|
||||||
|
(and (empty? other) (empty? accu)) obj
|
||||||
|
(and (empty? (rest other)) (empty? accu)) (build-node obj (first other))
|
||||||
|
(class? obj) (recur (rest other) (conj accu (build-node obj (first other))))
|
||||||
|
:else (recur other (conj accu obj)))))
|
||||||
|
|
||||||
(extend-type Event
|
(defn compile-o-matic [thing]
|
||||||
p/FXEvent
|
(if (instance? java.util.List thing)
|
||||||
(source [this] (.getSource ^Event this))
|
(if (and (not (coll? (first thing))) (map? (second thing)))
|
||||||
(consume! [this] (.consume ^Event this) this)
|
(compile thing)
|
||||||
(copy [this new-src new-target] (.copy ^Event this new-src new-target))
|
thing)
|
||||||
(event-type [this] (.getEventType this))
|
thing))
|
||||||
(target [this] (.getTarget this))
|
|
||||||
(consumed? [this] (.isConsumed this)))
|
|
||||||
|
|
||||||
;;### javafx.stage
|
|
||||||
|
|
||||||
(extend-type Stage
|
|
||||||
p/FXStage
|
|
||||||
(title [this] (.getTitle ^Stage this))
|
|
||||||
(set-title! [this title] (.setTitle ^Stage this ^String title))
|
|
||||||
(scene [this] (.getScene ^Stage this))
|
|
||||||
(set-scene! [this scene] (.setScene ^Stage this ^Scene scene)))
|
|
||||||
|
|
||||||
;;### javafx.scene
|
|
||||||
|
|
||||||
(extend-type Scene
|
|
||||||
p/FXScene
|
|
||||||
(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
|
;;## Event handling helper
|
||||||
(defn bind-event
|
(defn bind-event
|
||||||
[handler]
|
[handler]
|
||||||
(reify javafx.event.EventHandler
|
(reify javafx.event.EventHandler
|
||||||
(handle [_ event] (handler event))))
|
(handle [_ event] (handler event))))
|
||||||
|
|
||||||
;;## IdMapper
|
|
||||||
(defn fxzipper [root]
|
|
||||||
(zip/zipper (fn branch? [node]
|
|
||||||
(or (pred-protocol p/FXParent node) (pred-protocol p/FXContainer node)))
|
|
||||||
(fn children [node]
|
|
||||||
(if (pred-protocol p/FXParent node)
|
|
||||||
(into [] (p/subnodes node))
|
|
||||||
[(p/content node)]))
|
|
||||||
(fn make-node [node children]
|
|
||||||
(if (pred-protocol p/FXParent node)
|
|
||||||
(p/set-subnodes! node children)
|
|
||||||
(p/set-content! node children)))
|
|
||||||
root))
|
|
||||||
|
|
||||||
(defn get-node-by-id [graph id]
|
|
||||||
(loop [zipper (fxzipper graph)]
|
|
||||||
(cond (zip/end? zipper) nil
|
|
||||||
(= (p/id (zip/node zipper)) (name id)) (zip/node zipper)
|
|
||||||
:else (recur (zip/next zipper)))))
|
|
||||||
|
|
||||||
(defn get-id-map [graph]
|
|
||||||
(loop [zipper (fxzipper graph)
|
|
||||||
ids {}]
|
|
||||||
(if (zip/end? zipper)
|
|
||||||
ids
|
|
||||||
(recur (zip/next zipper)
|
|
||||||
(assoc ids (keyword (p/id (zip/node zipper))) (zip/node zipper))))))
|
|
||||||
|
|
|
@ -1,144 +0,0 @@
|
||||||
(ns clojurefx.factory
|
|
||||||
(:require [taoensso.timbre :as timbre]
|
|
||||||
[clojure.java.io :as io]
|
|
||||||
[clojure.reflect :as reflect]
|
|
||||||
[clojurefx.clojurefx :as fx]
|
|
||||||
[clojurefx.protocols :refer :all])
|
|
||||||
(:import (javafx.scene Scene Node Parent)
|
|
||||||
(javafx.scene.layout Region)
|
|
||||||
(clojure.reflect Constructor)))
|
|
||||||
|
|
||||||
(timbre/refer-timbre)
|
|
||||||
|
|
||||||
;;## FXMLLoader
|
|
||||||
|
|
||||||
(defn load-fxml [filename]
|
|
||||||
(let [loader (new javafx.fxml.FXMLLoader)]
|
|
||||||
(.setLocation loader (io/resource ""))
|
|
||||||
(.load loader (-> filename io/resource io/input-stream))))
|
|
||||||
|
|
||||||
;;## VectorBuilder
|
|
||||||
|
|
||||||
(def getter first)
|
|
||||||
(def setter second)
|
|
||||||
|
|
||||||
(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})
|
|
||||||
;;; FXId
|
|
||||||
:id (with-meta [#'id #'set-id!] {:argument String :parent FXId})
|
|
||||||
;;; FXGraphic
|
|
||||||
:graphic (with-meta [#'graphic #'set-graphic!] {:argument Node :parent FXGraphic})
|
|
||||||
;;; FXContainer
|
|
||||||
: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
|
|
||||||
: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})
|
|
||||||
;;; 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 constructor-args
|
|
||||||
(atom {javafx.scene.Scene [(with-meta :root {:type javafx.scene.Parent})]
|
|
||||||
javafx.stage.Stage [(with-meta :style {:type javafx.stage.StageStyle})]}))
|
|
||||||
|
|
||||||
(defn find-constructor [clazz cargs]
|
|
||||||
(->> (reflect/reflect clazz)
|
|
||||||
(filter #(= Constructor (class %)))
|
|
||||||
(map :parameter-types)
|
|
||||||
(filter #(= cargs %))
|
|
||||||
first))
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
(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)]
|
|
||||||
(debug "Key:" k "Value:" v " " (type v) "Translation:" translation)
|
|
||||||
(when (nil? translation)
|
|
||||||
(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 [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 (compile-o-matic (get props mandatory))]
|
|
||||||
(cons entry form)
|
|
||||||
form)) form cargs)
|
|
||||||
reverse
|
|
||||||
eval)
|
|
||||||
(apply dissoc props cargs))))
|
|
||||||
|
|
||||||
(defn compile
|
|
||||||
([args] (compile args []))
|
|
||||||
([[obj & other] accu]
|
|
||||||
(cond
|
|
||||||
(nil? obj) accu
|
|
||||||
(and (empty? other) (empty? accu)) obj
|
|
||||||
(and (empty? (rest other)) (empty? accu)) (build-node obj (first other))
|
|
||||||
(class? obj) (recur (rest other) (conj accu (build-node obj (first other))))
|
|
||||||
:else (recur other (conj accu obj)))))
|
|
||||||
|
|
||||||
(defn compile-o-matic [thing]
|
|
||||||
(if (instance? java.util.List thing)
|
|
||||||
(if (and (not (coll? (first thing))) (map? (second thing)))
|
|
||||||
(compile thing)
|
|
||||||
thing)
|
|
||||||
thing))
|
|
||||||
|
|
||||||
(comment
|
|
||||||
(import (javafx.scene.layout VBox)
|
|
||||||
(javafx.scene.control Button ScrollPane Label))
|
|
||||||
|
|
||||||
(def example-graph
|
|
||||||
[VBox {:id "topBox"
|
|
||||||
:children [Button {:id "button"
|
|
||||||
:text "Close"}
|
|
||||||
ScrollPane {:content [Label {:id "label"
|
|
||||||
:text "This rocks."}]}]}])
|
|
||||||
|
|
||||||
(def example-graph2
|
|
||||||
[VBox {:id "topBox"
|
|
||||||
:children [Button {:id "button"
|
|
||||||
:text "Close"}
|
|
||||||
(new javafx.scene.control.Label "Precompiled")
|
|
||||||
Button {:id "button2"
|
|
||||||
:text "OK"}
|
|
||||||
ScrollPane {:content [Label {:id "label"
|
|
||||||
:text "This rocks."}]}]}]))
|
|
|
@ -1,128 +0,0 @@
|
||||||
(ns clojurefx.protocols)
|
|
||||||
|
|
||||||
;;## Shadows
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXMeta
|
|
||||||
(meta [this])
|
|
||||||
(with-meta [this metadata]))
|
|
||||||
|
|
||||||
;;## Standard
|
|
||||||
|
|
||||||
;; (declare-protocols FXValue FXId FXParent)
|
|
||||||
(defprotocol
|
|
||||||
FXValue
|
|
||||||
(value [this])
|
|
||||||
(set-value! [this value]))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXId
|
|
||||||
(id [this])
|
|
||||||
(set-id! [this id]))
|
|
||||||
|
|
||||||
;; (defalias FXElement (U FXValue FXId))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXParent
|
|
||||||
"The ClojureFX extension to javafx.scene.Parent."
|
|
||||||
(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])
|
|
||||||
(set-content! [this node]))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXGraphic
|
|
||||||
(graphic [this])
|
|
||||||
(set-graphic! [this graphic]))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXStyleable
|
|
||||||
"http://download.java.net/jdk8/jfxdocs/javafx/css/Styleable.html"
|
|
||||||
(css-meta [this]) ;; TODO
|
|
||||||
(pseudo-class-styles [this])
|
|
||||||
(style [this])
|
|
||||||
(style-classes [this])
|
|
||||||
(set-style-classes! [this classes])
|
|
||||||
(styleable-parent [this])
|
|
||||||
(type-selector [this]))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXStyleSetter
|
|
||||||
(set-style! [this style]))
|
|
||||||
|
|
||||||
;; (defalias FXStyled (U FXStyleable FXStyleSetter))
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXOnAction
|
|
||||||
(action [this])
|
|
||||||
(set-action! [this action])
|
|
||||||
(fire! [this]))
|
|
||||||
|
|
||||||
;;## Special Types
|
|
||||||
|
|
||||||
;;### javafx.event
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXEvent
|
|
||||||
(source [this])
|
|
||||||
(consume! [this])
|
|
||||||
(copy [this newSource newTarget])
|
|
||||||
(event-type [this])
|
|
||||||
(target [this])
|
|
||||||
(consumed? [this]))
|
|
||||||
|
|
||||||
;;### javafx.stage
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
FXStage
|
|
||||||
(title [this])
|
|
||||||
(set-title! [this title])
|
|
||||||
(scene [this])
|
|
||||||
(set-scene! [this scene]))
|
|
||||||
|
|
||||||
;;### javafx.scene
|
|
||||||
|
|
||||||
(defprotocol
|
|
||||||
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 a new issue