zilti/clojurefx
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Switch to reflection.

Browse source
This commit is contained in:
none@none 2017-01-14 18:27:41 +00:00
parent d971a87391
commit 78af498658
5 changed files with 76 additions and 517 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
project.clj
View file

@ -1,5 +1,6 @@
(defproject clojurefx "0.0.16"
:dependencies [[org.clojure/clojure "1.8.0"]
[swiss-arrows "1.0.0"]
[com.taoensso/timbre "4.7.4" :exclusions [com.taoensso/carmine]]
[clojure-jsr-223 "0.1.0"]]
:profiles {:uberjar {:aot :all}}

26
src/clojurefx/AppWrap.java
View file

@ -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);
}
}

294
src/clojurefx/clojurefx.clj
View file

@ -2,7 +2,10 @@
(:require [taoensso.timbre :as timbre]
[clojure.java.io :as io]
[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)
(javafx.scene.shape Rectangle)))
@ -11,21 +14,26 @@
(timbre/refer-timbre)
(import '(clojurefx AppWrap)
'(javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
TitledPane TabPane Tab TableColumnBase Labeled ButtonBase)
'(javafx.scene Node Scene Parent)
'(javafx.scene.layout Pane VBox)
'(javafx.stage Stage)
'(javafx.collections FXCollections ObservableList)
'(javafx.css Styleable)
'(javafx.event Event ActionEvent EventTarget)
'(java.util Collection))
;; (import '(clojurefx AppWrap)
;; '(javafx.scene.control Labeled Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
;; MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
;; TitledPane TabPane Tab TableColumnBase Labeled ButtonBase)
;; '(javafx.scene Node Scene Parent)
;; '(javafx.scene.layout Pane VBox)
;; '(javafx.stage Stage)
;; '(javafx.collections FXCollections ObservableList)
;; '(javafx.css Styleable)
;; '(javafx.event Event ActionEvent EventTarget)
;; '(java.util Collection))
(defn gen-stage! [nspc fun]
(let [appwrap (AppWrap. nspc fun)]
(.launch appwrap nil)))
;; ## Data
(def constructor-args
(atom {javafx.scene.Scene {:root javafx.scene.Parent}
javafx.stage.Stage {:style javafx.stage.StageStyle}}))
(defn camelcase [kebabcase]
)
;; ## Threading helpers
@ -66,227 +74,75 @@
check (type check)]
(reduce #(or %1 (isa? check %2)) false impls)))
;;## Shadows
;; ## FXMLLoader
(extend-protocol p/FXMeta
clojure.lang.IObj
(meta [this] (clojure.core/meta this))
(with-meta [this metadata] (clojure.core/with-meta this metadata))
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))
(defn load-fxml [filename]
(let [loader (new javafx.fxml.FXMLLoader)]
(.setLocation loader (io/resource ""))
(.load loader (-> filename io/resource io/input-stream))))
;;## Standard
;; ## Constructors
(extend-protocol p/FXValue
Labeled
(value [this] (.getText ^Label this))
(set-value! [this value] (.setText ^Label this ^String value) this)
TextField
(value [this] (.getText ^TextField this))
(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))
(defn find-constructor [clazz cargs]
(->> (reflect/reflect clazz)
:members
(filter #(= clojure.reflect.Constructor (class %)))
(filter #(= cargs (:parameter-types %)))
first))
(extend-protocol p/FXId
Styleable
(id [this] (.getId ^Styleable this))
(set-id! [this id] (.setId ^Styleable this ^String id) this))
(defn invoke-constructor [clazz args]
(clojure.lang.Reflector/invokeConstructor clazz (into-array args)))
(extend-protocol p/FXParent
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))
;; ## Properties
(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)))
(defn find-property [obj prop]
(clojure.lang.Reflector/invokeInstanceMethod obj prop []))
(extend-protocol p/FXContainer
Tab
(content [this] (.getContent ^Tab this))
(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))
(defn get-property-value
([obj prop]
(.getValue (find-property obj (name prop)))))
(extend-protocol p/FXGraphic
Labeled
(graphic [this] (.getGraphic ^Labeled this))
(set-graphic! [this graphic] (.setGraphic ^Labeled this ^Node graphic))
MenuItem
(graphic [this] (.getGraphic ^Menu this))
(set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic)))
(defn set-property-value
([obj prop val]
(.setValue (find-property obj (name prop)) val)))
(extend-protocol p/FXStyleSetter
Node
(set-style! [this style] (.setStyle ^Node this ^String style) this)
MenuItem
(set-style! [this style] (.setStyle ^MenuItem this ^String style) this))
;; ## In-code scenegraph
(extend-type Styleable
p/FXStyleable
(css-meta [this] (.getCssMetaData ^Styleable this))
(pseudo-class-styles [this] (.getPseudoClassStyles ^Styleable this))
(style [this] (.getStyle ^Styleable this))
(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 compile-o-matic)
(defn- apply-props-to-node [nodeobj propmap]
(doseq [[k v] propmap]
(set-property-value nodeobj k v))
nodeobj)
(declare bind-event)
(extend-protocol p/FXOnAction
ButtonBase
(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)))
(defn- propmap-splitter [clazz propmap]
(let [constructor-args (get @constructor-args clazz)]
[(map propmap constructor-args) (apply dissoc propmap constructor-args)]))
;;## 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
p/FXEvent
(source [this] (.getSource ^Event this))
(consume! [this] (.consume ^Event this) this)
(copy [this new-src new-target] (.copy ^Event this new-src new-target))
(event-type [this] (.getEventType this))
(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)))
(defn compile-o-matic [thing]
(if (instance? java.util.List thing)
(if (and (not (coll? (first thing))) (map? (second thing)))
(compile thing)
thing)
thing))
;;## Event handling helper
(defn bind-event
[handler]
(reify javafx.event.EventHandler
(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))))))

144
src/clojurefx/factory.clj
View file

@ -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."}]}]}]))

128
src/clojurefx/protocols.clj
View file

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