zilti
/
clojurefx
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Restructured code. Improved 'compile'. Added more wrappers.

This commit is contained in:
Daniel Ziltener 2015-01-16 21:26:46 +00:00
parent c10b14359b
commit 94968a61aa
5 changed files with 200 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
README.md
View File

@ -9,11 +9,11 @@ This is in a very early state, so there isn't much yet, except one thing.
### Declarative UI programming
```clojure
(compile [:VBox {:id "TopLevelVBox"
:children [:Label {:text "Hi!"}
:Label {:text "I'm ClojureFX!"}
:HBox {:id "HorizontalBox"
:children [:Button {:text "Alright."}]}]}])
(compile [VBox {:id "TopLevelVBox"
:children [Label {:text "Hi!"}
Label {:text "I'm ClojureFX!"}
HBox {:id "HorizontalBox"
:children [Button {:text "Alright."}]}]}])
```
## TODO

9
build.boot
View File

@ -3,6 +3,7 @@
:dependencies '[[org.clojure/clojure "1.7.0-alpha4"]
[com.taoensso/timbre "3.3.1" :exclusions [com.taoensso/carmine]]
[org.clojure/core.typed "0.2.77"]
[clojure-jsr-223 "0.1.0"]
[boot-deps "0.1.2" :scope "test"]
[midje "1.6.3" :scope "test"]
@ -12,14 +13,14 @@
(require '[zilti.boot-midje :refer [midje]]
'[zilti.boot-typed :refer [typed]])
(def +version+ "0.0.1-SNAPSHOT")
(def +version+ "0.0.5-SNAPSHOT")
(task-options!
pom {:project 'ClojureFX
pom {:project 'clojurefx
:version +version+
:description "A Clojure JavaFX wrapper."
:url "https://bitbucket.com/zilti/ClojureFX"
:scm {:url "https://bitbucket.com/zilti/ClojureFX"}
:url "https://bitbucket.com/zilti/clojurefx"
:scm {:url "https://bitbucket.com/zilti/clojurefx"}
:license {:name "GNU Lesser General Public License 3.0"
:url "http://www.gnu.org/licenses/lgpl-3.0.txt"}}
midje {:test-paths #{"test"}

131
src/clojurefx/clojurefx.clj
View File

@ -4,17 +4,46 @@
[clojure.core.typed.unsafe :refer [ignore-with-unchecked-cast]]
[taoensso.timbre :as timbre]
[clojure.java.io :as io]
[clojurefx.protocols :refer :all]))
[clojurefx.protocols :refer :all]
[clojure.java.io :refer :all]))
(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
;; ## Threading helpers
(defn run-later*"
Simple wrapper for Platform/runLater. You should use run-later.
" [f]
(javafx.application.Platform/runLater f))
(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)))
(tc-ignore (timbre/refer-timbre))
(import (javafx.scene.control Label TextField TextArea CheckBox ComboBox Menu MenuItem MenuBar
MenuButton ContextMenu ToolBar SplitPane ScrollPane Accordion
TitledPane TabPane Tab TableColumnBase Labeled)
(javafx.scene Node)
(javafx.scene Node Scene Parent)
(javafx.scene.layout Pane VBox)
(javafx.stage Stage)
(javafx.collections FXCollections ObservableList)
(javafx.css Styleable)
(java.util Collection))
;; TODO This belongs elsewhere.
@ -68,18 +97,9 @@
(tc-ignore
(extend-protocol FXId
Node
(get-id [this] (.getId ^Node this))
(set-id! [this id] (tc-assert String id) (.setId ^Node this ^String id) this)
Tab
(get-id [this] (.getId ^Tab this))
(set-id! [this id] (tc-assert String id) (.setId ^Tab this ^String id) this)
TableColumnBase
(get-id [this] (.getId ^TableColumnBase this))
(set-id! [this id] (tc-assert String id) (.setId ^TableColumnBase this ^String id) this)
MenuItem
(get-id [this] (.getId ^MenuItem this))
(set-id! [this id] (tc-assert String id) (.setId ^MenuItem this ^String id) this)))
Styleable
(get-id [this] (.getId ^Styleable this))
(set-id! [this id] (tc-assert String id) (.setId ^Styleable this ^String id) this)))
(tc-ignore
(extend-protocol FXParent
@ -132,58 +152,39 @@
(get-graphic [this] (.getGraphic ^Menu this))
(set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic))))
(tc-ignore
(extend-protocol clojure.lang.IObj
Node
(meta [this] (.getUserData ^Node this))
(withMeta [this metadata] (.setUserData ^Node this metadata) this)
MenuItem
(meta [this] (.getUserData ^MenuItem this))
(withMeta [this metadata] (.setUserData ^MenuItem this metadata) this)))
;; TODO Code below probably also belongs somewhere else
(def getter first)
(def setter second)
(extend-protocol FXStyleSetter
Node
(set-style! [this style] (.setStyle ^Node this ^String style) this)
MenuItem
(set-style! [this style] (.setStyle ^MenuItem this ^String style) this))
(def translation-map
(atom {:text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue})
:value (with-meta [#'get-value #'set-value!] {:argument Object :parent FXValue})
:id (with-meta [#'get-id #'set-id!] {:argument String :parent FXId})
:graphic (with-meta [#'get-graphic #'set-graphic!] {:argument Node :parent FXGraphic})
:content (with-meta [#'get-content #'set-content!] {:argument Node :parent FXContainer})
:children (with-meta [#'get-subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent})}))
(extend-type Styleable
FXStyleable
(get-css-meta [this] (.getCssMetaData ^Styleable this))
(get-pseudo-class-styles [this] (.getPseudoClassStyles ^Styleable this))
(get-style [this] (.getStyle ^Styleable this))
(get-style-classes [this] (.getStyleClass ^Styleable this))
(set-style-classes! [this classes] (.setAll ^ObservableList (.getStyleClass ^Styleable this) classes) this)
(get-styleable-parent [this] (.getStyleableParent ^Styleable this))
(get-type-selector [this] (.getTypeSelector ^Styleable this)))
(declare compile-o-matic)
(ann build-node [Any (Map Keyword Any) -> Any])
(defn build-node [object props]
(debug "build-node:" object props)
(let [obj (eval `(new ~object))]
(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))
(when (nil? translation)
(throw (Exception. (str "Property" k "not available in translation map."))))
;; (when-not ((pred-substitute argument) v)
;; (throw (Exception. (str "Input type" v "is not compatible with expected type for" k))))
;; (when-not ((pred-substitute parent) obj)
;; (throw (Exception. (str "Property" k "not available for class" (class obj)))))
((setter translation) obj v)))
obj))
(extend-type Stage
FXStage
(get-title [this] (.getTitle ^Stage this))
(set-title! [this title] (.setTitle ^Stage this ^String title))
(get-scene [this] (.getScene ^Stage this))
(set-scene! [this scene] (.setScene ^Stage this ^Scene scene)))
(ann resolv-o-matic [(U String Keyword Symbol Class) -> Class])
(defn resolv-o-matic [thing]
(cond
(symbol? thing) (ns-resolve (the-ns 'clojurefx.clojurefx) thing)
(keyword? thing) (recur (name thing))
(string? thing) (recur (symbol thing))
:else thing))
(ann compile [(Vec Any) -> Any])
(defn compile [[obj params & other]]
(assert (map? params))
(let [obj (build-node (resolv-o-matic obj) params)]
(if (empty? other)
obj
(flatten (conj (list obj) (compile other))))))
(ann compile-o-matic [Any -> Any])
(defn compile-o-matic [thing]
(if (instance? java.util.List thing)
(if (and (not (coll? (first thing))) (map? (second thing)))
(compile thing)
thing)
thing))
(extend-type Scene
FXScene
(get-root [this] (.getRoot ^Scene this))
(set-root! [this root] (.setRoot ^Scene this ^Parent root) this))

92
src/clojurefx/factory.clj Normal file
View File

@ -0,0 +1,92 @@
(ns clojurefx.factory
(:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send compile])
(:require [clojure.core.typed :refer :all]
[clojure.core.typed.unsafe :refer [ignore-with-unckecked-cast]]
[taoensso.timbre :as timbre]
[clojure.java.io :as io]
[clojurefx.clojurefx :refer :all]
[clojurefx.protocols :refer :all]))
(tc-ignore (timbre/refer-timbre))
;;## FXMLLoader
(defn load-fxml [filename :- String] :- javafx.scene.Node
(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 {:text (with-meta [#'get-value #'set-value!] {:argument String :parent FXValue})
:value (with-meta [#'get-value #'set-value!] {:argument Object :parent FXValue})
:id (with-meta [#'get-id #'set-id!] {:argument String :parent FXId})
:graphic (with-meta [#'get-graphic #'set-graphic!] {:argument Node :parent FXGraphic})
:content (with-meta [#'get-content #'set-content!] {:argument Node :parent FXContainer})
:children (with-meta [#'get-subnodes #'set-subnodes!] {:argument java.util.List :parent FXParent})
:title (with-meta [#'get-title #'set-title!] {:argument String :parent FXStage})
:scene (with-meta [#'get-scene #'set-scene!] {:argument Scene :parent FXStage})
:root (with-meta [#'get-root #'set-root!] {:argument Parent :parent FXScene})}))
(def mandatory-constructor-args
(atom {javafx.scene.Scene [:root]}))
(declare compile-o-matic)
(ann apply-props-to-node [Any (Map Keyword Any) -> Any])
(defn apply-props-to-node [node props]
(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))
(when (nil? translation)
(throw (Exception. (str "Property" k "not available in translation map."))))
;; (when-not ((pred-substitute argument) v)
;; (throw (Exception. (str "Input type" v "is not compatible with expected type for" k))))
;; (when-not ((pred-substitute parent) node)
;; (throw (Exception. (str "Property" k "not available for class" (class node)))))
((setter translation) node v)))
node)
(ann build-node [Any (Map Keyword Any) -> Any])
(defn build-node [object props]
(debug "build-node:" object props)
(let [mandatory (get mandatory-constructor-args object)
form `(~object new)]
(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))))
(ann resolv-o-matic [(U String Keyword Symbol Class) -> Class])
(defn resolv-o-matic [thing]
(cond
(symbol? thing) (ns-resolve (the-ns 'clojurefx.clojurefx) thing)
(keyword? thing) (recur (name thing))
(string? thing) (recur (symbol thing))
:else thing))
(ann compile [(Vec Any) -> Any])
(defn compile [[obj params & other]]
(assert (map? params))
(let [obj (build-node (resolv-o-matic obj) params)]
(if (empty? other)
obj
(flatten (conj (list obj) (compile other))))))
(ann compile-o-matic [Any -> Any])
(defn compile-o-matic [thing]
(if (instance? java.util.List thing)
(if (and (not (coll? (first thing))) (map? (second thing)))
(compile thing)
thing)
thing))

32
src/clojurefx/protocols.clj
View File

@ -35,3 +35,35 @@
FXGraphic
(get-graphic [this :- A] :- B)
(set-graphic! [this :- A graphic :- B] :- A))
(defprotocol [[A :variance :covariant :< javafx.css.Styleable]
[B :variance :covariant :< javafx.css.Styleable]]
FXStyleable
"http://download.java.net/jdk8/jfxdocs/javafx/css/Styleable.html"
(get-css-meta [this :- A] :- (java.util.List javafx.css.CssMetaData)) ;; TODO
(get-pseudo-class-styles [this :- A] :- (javafx.collections.ObservableSet javafx.css.PseudoClass))
(get-style [this :- A] :- String)
(get-style-classes [this :- A] :- (javafx.collections.ObservableList String))
(set-style-classes! [this :- A classes :- java.util.Collection] :- A)
(get-styleable-parent [this :- A] :- (U nil B))
(get-type-selector [this :- A] :- String))
(defprotocol [[A :variance :covariant]]
FXStyleSetter
(set-style! [this :- A style :- String] :- A))
(defalias FXStyled (U FXStyleable FXStyleSetter))
(defprotocol [[A :variance :covariant :< javafx.stage.Stage]
[B :variance :covariant :< javafx.scene.Scene]]
FXStage
(get-title [this :- A] :- String)
(set-title! [this :- A title :- String] :- A)
(get-scene [this :- A] :- B)
(set-scene! [this :- A scene :- B] :- A))
(defprotocol [[A :variance :covariant :< javafx.scene.Scene]
[B :variance :covariant :< javafx.scene.Parent]]
FXScene
(get-root [this :- A] :- B)
(set-root! [this :- A root :- B] :- A))