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

Some extends and fully working declarative scenegraph creation. 

FXValue, FXId, FXParent, FXGraphic and FXContainer provide functionality to get and set values, ids, children, graphics and content.
Declarative structures can be created and compiled into JavaFX scenegraphs, similar to Hiccup.
This commit is contained in:
Daniel Ziltener 2015-01-16 03:27:37 +00:00
parent 17ea235279
commit c10b14359b
6 changed files with 285 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
.projectile Normal file
View File

12
README.md
View File

@ -4,7 +4,17 @@ A Clojure wrapper to make working with [JavaFX](http://download.java.net/jdk8/jf
## Features
Nothing yet, but if you give me some time... :)
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."}]}]}])
```
## TODO

35
build.boot
View File

@ -0,0 +1,35 @@
;-*- mode: Clojure;-*-
(set-env! :resource-paths #{"src" "java"}
: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"]
[boot-deps "0.1.2" :scope "test"]
[midje "1.6.3" :scope "test"]
[zilti/boot-midje "0.1.1" :scope "test"]
[zilti/boot-typed "0.1.0" :scope "test"]])
(require '[zilti.boot-midje :refer [midje]]
'[zilti.boot-typed :refer [typed]])
(def +version+ "0.0.1-SNAPSHOT")
(task-options!
pom {:project 'ClojureFX
:version +version+
:description "A Clojure JavaFX wrapper."
: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"}
:autotest true}
typed {:namespaces #{'clojurefx.blargh}}
repl {:server true})
(deftask develop
[]
(comp (repl)
(midje)
(watch)
(typed)))

189
src/clojurefx/clojurefx.clj Normal file
View File

@ -0,0 +1,189 @@
(ns clojurefx.clojurefx
(: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-unchecked-cast]]
[taoensso.timbre :as timbre]
[clojure.java.io :as io]
[clojurefx.protocols :refer :all]))
(defonce force-toolkit-init (javafx.embed.swing.JFXPanel.))
(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.layout Pane VBox)
(javafx.collections FXCollections ObservableList)
(java.util Collection))
;; TODO This belongs elsewhere.
(tc-ignore
(defn load-fxml [filename]
(.load (javafx.fxml.FXMLLoader.) (-> filename io/resource io/input-stream))))
;; TODO Use pred-substitute for tc-assert
(defn tc-assert [clazz :- Class value :- Any & [message :- String]]
(try (assert (instance? clazz value))
(catch AssertionError e (tc-ignore (error (if message message "") e)
(error "Expected:" clazz "Actual:" (type value))
(throw e)))))
(ann pred-substitute [Class -> (Fn [Any -> Boolean])])
(defn pred-substitute [clazz]
(clojure.core.typed/pred* (quote clazz) 'clojurefx.clojurefx
(fn [arg] (boolean (instance? clazz arg)))))
(tc-ignore
(extend-protocol FXValue
Label
(get-value [this] (.getText ^Label this))
(set-value! [this value] (tc-assert String value) (.setText ^Label this ^String value) this)
TextField
(get-value [this] (.getText ^TextField this))
(set-value! [this value] (tc-assert String value) (.setText ^TextField this ^String value) this)
TextArea
(get-value [this] (.getText ^TextArea this))
(set-value! [this value] (tc-assert String value) (.setText ^TextArea this ^String value) this)
CheckBox
(get-value [this] (.isSelected ^CheckBox this))
(set-value! [this value] (tc-assert Boolean value) (.setSelected ^CheckBox this ^Boolean value) this)
ComboBox
(get-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)
(tc-ignore (.select ^javafx.scene.control.SingleSelectionModel sel-model item)))) this)
Menu
(get-value [this] (.getText ^Menu this))
(set-value! [this value] (tc-assert String value) (.setText ^Menu this ^String value) this)
MenuItem
(get-value [this] (.getText ^MenuItem this))
(set-value! [this value] (tc-assert String value) (.setText ^MenuItem this ^String value) this)))
(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)))
(tc-ignore
(extend-protocol FXParent
Pane
(get-subnodes [this] (.getChildren ^Pane this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getChildren ^Pane this) ^Collection nodes) this)
TabPane
(get-subnodes [this] (.getTabs ^TabPane this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getTabs ^TabPane this) ^Collection nodes) this)
MenuBar
(get-subnodes [this] (.getMenus ^MenuBar this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getMenus ^MenuBar this) ^Collection nodes) this)
Menu
(get-subnodes [this] (.getItems ^Menu this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^Menu this) ^Collection nodes) this)
MenuButton
(get-subnodes [this] (.getItems ^MenuButton this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^MenuButton this) ^Collection nodes) this)
ContextMenu
(get-subnodes [this] (.getItems ^ContextMenu this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^ContextMenu this) ^Collection nodes) this)
ToolBar
(get-subnodes [this] (.getItems ^ToolBar this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^ToolBar this) ^Collection nodes) this)
SplitPane
(get-subnodes [this] (.getItems ^SplitPane this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getItems ^SplitPane this) ^Collection nodes) this)
Accordion
(get-subnodes [this] (.getPanes ^Accordion this))
(set-subnodes! [this nodes] (.setAll ^ObservableList (.getPanes ^Accordion this) ^Collection nodes) this)))
(tc-ignore
(extend-protocol FXContainer
Tab
(get-content [this] (.getContent ^Tab this))
(set-content! [this node] (.setContent ^Tab this ^Node node) this)
TitledPane
(get-content [this] (.getContent ^TitledPane this))
(set-content! [this node] (.setContent ^TitledPane this ^Node node) this)
ScrollPane
(get-content [this] (.getContent ^ScrollPane this))
(set-content! [this node] (.setContent ^ScrollPane this ^Node node) this)))
(tc-ignore
(extend-protocol FXGraphic
Labeled
(get-graphic [this] (.getGraphic ^Labeled this))
(set-graphic! [this graphic] (.setGraphic ^Labeled this ^Node graphic))
MenuItem
(get-graphic [this] (.getGraphic ^Menu this))
(set-graphic! [this graphic] (.setGraphic ^Menu this ^Node graphic))))
;; TODO Code below probably also belongs somewhere else
(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})}))
(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))
(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))

37
src/clojurefx/protocols.clj Normal file
View File

@ -0,0 +1,37 @@
(ns clojurefx.protocols
(:refer-clojure :exclude [atom doseq let fn defn ref dotimes defprotocol loop for send])
(:require [clojure.core.typed :refer :all]))
(declare-protocols FXValue FXId FXParent)
(defprotocol [[A :variance :covariant]
[B :variance :covariant]]
FXValue
(get-value [this :- A] :- B)
(set-value! [this :- A value :- B] :- A))
(defprotocol [[A :variance :covariant]
[x :variance :covariant]]
FXId
(get-id [this :- A] :- (U nil String))
(set-id! [this :- A id :- String] :- A))
(defalias FXElement (U FXValue FXId))
(defprotocol [[A :variance :covariant]
[B :variance :covariant]]
FXParent
"The ClojureFX extension to javafx.scene.Parent."
(get-subnodes [this :- A] :- B)
(set-subnodes! [this :- A nodes :- B] :- A))
(defprotocol [[A :variance :covariant]
[B :variance :covariant]]
FXContainer
(get-content [this :- A] :- B)
(set-content! [this :- A node :- B] :- A))
(defprotocol [[A :variance :covariant]
[B :variance :covariant :< javafx.scene.Node]]
FXGraphic
(get-graphic [this :- A] :- B)
(set-graphic! [this :- A graphic :- B] :- A))

13
test/clojurefx/clojurefx_test.clj Normal file
View File

@ -0,0 +1,13 @@
(ns clojurefx.clojurefx-test
(:refer-clojure :exclude [compile])
(:use midje.sweet
clojurefx.clojurefx))
(def example-hierarchy
[:VBox {:id "VBox"
:children [:Label {:text "Hi JavaFX!"}
:Label {:text "Hi Clojure!"}]}])
(fact "This compiles."
(resolv-o-matic :Label) => javafx.scene.control.Label
(type (compile example-hierarchy)) => javafx.scene.layout.VBox)