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.

README.md

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

build.boot

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

src/clojurefx/clojurefx.clj

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

src/clojurefx/protocols.clj

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

test/clojurefx/clojurefx_test.clj

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