├── .gitignore ├── README.textile ├── example.clj └── jackdaw.clj /.gitignore: -------------------------------------------------------------------------------- 1 | *.sw? 2 | -------------------------------------------------------------------------------- /README.textile: -------------------------------------------------------------------------------- 1 | Jackdaw is a simple API for creating graphical applications with Clojure. 2 | 3 | Except it's not yet because graphics in Java is like drawing blood out of a stone. 4 | 5 | 6 | Todo: 7 | 8 | * Define box model (based on HTML like Shoes) 9 | * Figure out basic algorithm for positioning and drawing, and so it can be reused by various block-level elements 10 | * Flows should position sets of items horizontally 11 | * Stacks should position them vertically 12 | 13 | At the moment, only stacks with padding work. Block-level items like text and buttons should be positioned based on size then padding and margin 14 | -------------------------------------------------------------------------------- /example.clj: -------------------------------------------------------------------------------- 1 | (use 'jackdaw) 2 | 3 | ; this is almost how the API should be, 4 | ; the drawing functions will need optional parameters 5 | ; for inline styles 6 | 7 | ; todo - the default padding should be applied to the children 8 | (app "Jackdaw API Example" { :width 800, :height 600, :padding 10 } 9 | (rect 5 5 785 65) 10 | (para "From:") 11 | (para "Alex") 12 | (flow 13 | (para "Subject:") 14 | (para "An example from the Clojure documentation")) 15 | (stack 10 16 | (para "Namespaces") 17 | (para "The Namespace system maintains global maps of symbols to Var objects (see Namespaces). If a def expression does not find an interned entry in the current namespace for the symbol being def-ed, it creates one, otherwise it uses the existing Var. This find-or-create process is called interning. This means that, unless they have been unmap-ed, Var objects are stable references and need not be looked up every time. It also means that namespaces constitute a global environment in which, as described in Evaluation, the compiler attempts to resolve all free symbols as Vars") 18 | (para "Regards,") 19 | (para "Alex"))) 20 | 21 | ;(app "Jackdaw API Example" { :width 800, :height 600 } 22 | ; (fill 0 0 0 ) 23 | ; (rect 10 250 100 100) 24 | ; (flow) 25 | ; (para "hello") 26 | ; (para "my name is alex") 27 | ; (stack) 28 | ; (para "hello") 29 | ; (stack (padding 10 100 10 10)) 30 | ; (para "The Namespace system maintains global maps of symbols to Var objects (see Namespaces). If a def expression does not find an interned entry in the current namespace for the symbol being def-ed, it creates one, otherwise it uses the existing Var. This find-or-create process is called interning. This means that, unless they have been unmap-ed, Var objects are stable references and need not be looked up every time. It also means that namespaces constitute a global environment in which, as described in Evaluation, the compiler attempts to resolve all free symbols as Vars") 31 | ; (stack) 32 | ; (para "good bye")) 33 | 34 | ;(app "Jackdaw API Example" { :width 800, :height 600 } 35 | ; (stack) 36 | ; (fill 200 100 100) 37 | ; (rect 10 10 100 100) 38 | ; (stroke 255 10 55) 39 | ; (rect 120 10 100 100) 40 | ; (fill 100 100 200) 41 | ; (oval 20 120 100 100) 42 | ; (fill 25 25 100) 43 | ; (para "The Namespace system maintains global maps of symbols to Var objects (see Namespaces). If a def expression does not find an interned entry in the current namespace for the symbol being def-ed, it creates one, otherwise it uses the existing Var. This find-or-create process is called interning. This means that, unless they have been unmap-ed, Var objects are stable references and need not be looked up every time. It also means that namespaces constitute a global environment in which, as described in Evaluation, the compiler attempts to resolve all free symbols as Vars")) 44 | -------------------------------------------------------------------------------- /jackdaw.clj: -------------------------------------------------------------------------------- 1 | (ns jackdaw 2 | (:import (javax.swing JFrame JTextField JLabel JButton JOptionPane JPanel) 3 | (java.awt GridLayout BasicStroke Rectangle Font) 4 | (java.awt.geom Point2D) 5 | (java.awt.font LineBreakMeasurer FontRenderContext) 6 | (java.text AttributedString) 7 | (java.awt.font TextAttribute) 8 | (java.awt RenderingHints Toolkit GraphicsEnvironment Graphics2D Color))) 9 | 10 | ; Config management 11 | (def app-defaults 12 | { :name "Jackdaw" 13 | :width 300 14 | :height 300 15 | :commands [] 16 | :stroke-color (Color. 0 0 0) 17 | :fill-color (Color. 255 255 255) }) 18 | 19 | (def fill-color) 20 | 21 | (def config (ref app-defaults)) 22 | 23 | (defn set-config [vals] 24 | (dosync (ref-set config (merge @config vals)))) 25 | 26 | (defn add-cmd [seq] 27 | (set-config { :commands (merge (@config :commands) seq) })) 28 | 29 | (defn current-style [] 30 | { :fill-color (@config :fill-color), 31 | :stroke-color (@config :stroke-color) }) 32 | 33 | (defn current-font-style [] 34 | { :color (@config :stroke-color), 35 | :size 17 36 | :font "Helvetica" }) 37 | 38 | ; Drawing structs 39 | (defstruct shape-2d :type :x :y :width :height :style) 40 | (defstruct text :type :x :y :style :body) 41 | (defstruct box :top :right :bottom :left ) 42 | (defstruct layout :type :x :y :width :height :margin :padding) 43 | 44 | (defn padding 45 | ([x] (struct box x x x x)) 46 | ([x y] (struct box y x y x)) 47 | ([top right bottom left] (struct box top right bottom left))) 48 | 49 | ; Layouts 50 | (defn default-box 51 | ([] (struct box 10 10 10 10)) 52 | ([key options] 53 | (or 54 | (cond 55 | (contains? options :padding) (padding (options :padding)) 56 | (contains? options :margin) (padding (options :margin))) 57 | (default-box)))) 58 | 59 | (def zero-box (struct box 0 0 0 0)) 60 | 61 | (defn default-flow [options] 62 | (ref (struct layout ::Flow 0 10 (options :width) (options :height) (default-box :margin options) (default-box :padding options)))) 63 | 64 | (defn add-layouts [old new] 65 | (struct layout (:type new) 66 | (:x new) 67 | (+ (:y old) (:y new) (:bottom (:margin old)) (:top (:margin new)) (:top (:padding new)) (:bottom (:padding old))) 68 | (:width new) (:height new) (:margin new) (:padding new))) 69 | 70 | (defn add-height-to-layout [l height] 71 | (struct layout (:type l) 72 | (:x l) 73 | height 74 | (:width l) (:height l) (:margin l) (:padding l))) 75 | 76 | (defmulti apply-layout (fn [l key box] (:type l))) 77 | 78 | (defmethod apply-layout ::jackdaw/Stack [l key box] 79 | (cond 80 | (= key :width) (- (l :width) ((l :padding) :right) ((l :padding) :left)) 81 | (= key :next_x) (l :x) 82 | (= key :next_y) (+ (box :y) ((l :padding) :bottom) (box :height)) 83 | (= key :start_x) (+ ((l :padding) :left) (l :x)) 84 | (= key :start_y) (+ ((l :padding) :top) (l :y)))) 85 | 86 | (defmethod apply-layout ::jackdaw/Flow [l key box] 87 | (cond 88 | (= key :width) (- (l :width) ((l :padding) :right) ((l :padding) :left)) 89 | (= key :next_x) (+ (:x box) ((l :padding) :right) (box :width)) 90 | (= key :next_y) (l :y) 91 | (= key :start_x) (+ ((l :padding) :left) (l :x)) 92 | (= key :start_y) (+ ((l :padding) :top) (l :y)))) 93 | 94 | (defn update-layout [l box] 95 | (dosync (ref-set l (assoc @l :x (apply-layout @l :next_x box)))) 96 | (dosync (ref-set l (assoc @l :y (apply-layout @l :next_y box))))) 97 | 98 | (defn add-layout 99 | ([type] (add-cmd (struct layout type 0 0 (@config :width) (@config :height) (default-box) (default-box)))) 100 | ([type padding-args] 101 | (add-cmd 102 | (struct layout ::Stack 0 0 103 | (@config :width) (@config :height) (default-box) (apply padding (seq padding-args)))))) 104 | 105 | ; Drawing 106 | (defmulti draw (fn [object g l] (:type object))) 107 | 108 | (defmethod draw ::jackdaw/Rect [r g l] 109 | (doto g 110 | (.setColor ((r :style) :fill-color)) 111 | (.fillRect (r :x) (r :y) (r :width) (r :height)) 112 | (.setColor ((r :style) :stroke-color)) 113 | (.drawRect (r :x) (r :y) (r :width) (r :height))) 114 | l) 115 | 116 | (defmethod draw ::jackdaw/Oval [e g l] 117 | (doto g 118 | (.setColor ((e :style) :fill-color)) 119 | (.fillOval (e :x) (e :y) (e :width) (e :height)) 120 | (.setColor ((e :style) :stroke-color)) 121 | (.drawOval (e :x) (e :y) (e :width) (e :height))) 122 | l) 123 | 124 | (defmethod draw ::jackdaw/Para [t g l] 125 | (let [current-layout (ref l)] 126 | (doto g 127 | (.setRenderingHint (. RenderingHints KEY_ANTIALIASING) 128 | (. RenderingHints VALUE_ANTIALIAS_ON))) 129 | (let [body (AttributedString. (t :body))] 130 | (doto body 131 | (.addAttribute (.. TextAttribute FONT) 132 | (Font. ((t :style) :font) (. Font PLAIN) ((t :style) :size))) 133 | (.addAttribute (.. TextAttribute SIZE) ((t :style) :size)) 134 | (.addAttribute (.. TextAttribute FOREGROUND) ((t :style) :color))) 135 | (let [width (apply-layout @current-layout :width {}) 136 | x (apply-layout @current-layout :start_x {}) 137 | start_y (apply-layout @current-layout :start_y {}) 138 | measure (LineBreakMeasurer. 139 | (.. body getIterator) 140 | (.. g getFontRenderContext))] 141 | (loop [text-layout (.. measure (nextLayout width)) 142 | position (.. measure getPosition) 143 | y start_y] 144 | (. text-layout draw g x y) 145 | (if (zero? (- (.length (t :body)) position)) 146 | (update-layout current-layout { 147 | :x x, 148 | :y y, 149 | :width (.. text-layout getBounds getWidth), 150 | :height (.. text-layout getBounds getHeight) }) 151 | (recur 152 | (.. measure (nextLayout width)) 153 | (.. measure getPosition) 154 | (+ y (. text-layout getAscent) (. text-layout getDescent) (. text-layout getLeading))))))) 155 | @current-layout)) 156 | 157 | (defn draw-all [l] 158 | (let [current-layout l 159 | r (doto (proxy [JPanel] [] (paint [g] 160 | (doall (for [cmd (@config :commands)] 161 | (if (some #{(cmd :type)} [::jackdaw/Stack ::jackdaw/Flow]) 162 | (dosync (ref-set current-layout (add-layouts @current-layout cmd))) 163 | (dosync (ref-set current-layout (draw cmd g @current-layout)))))))))] 164 | (doto (@config :active-frame) 165 | (.add r) 166 | (.setVisible true)))) 167 | 168 | ; Windowing 169 | (defn create-window [name width height] 170 | (set-config { :width width }) 171 | (set-config { :height height }) 172 | (set-config { :active-frame (JFrame. name) }) 173 | (doto (config :active-frame) 174 | (.setLayout (GridLayout. 1 1)) 175 | (.setSize width height) 176 | (.setResizable false))) 177 | 178 | ; Interface 179 | (defmacro app [name options & cmds] 180 | `(do (create-window ~name (~options :width) (~options :height)) ~@cmds (draw-all (default-flow ~options)))) 181 | 182 | (defn fill [r g b] 183 | (set-config { :fill-color (Color. r g b) })) 184 | 185 | (defn stroke [r g b] 186 | (set-config { :stroke-color (Color. r g b) })) 187 | 188 | (defn rect [x y width height] 189 | (add-cmd (struct shape-2d ::Rect x y width height (current-style)))) 190 | 191 | (defn oval [x y width height] 192 | (add-cmd (struct shape-2d ::Oval x y width height (current-style)))) 193 | 194 | (defn para [body] 195 | (add-cmd (struct text ::Para 10 300 (current-font-style) body))) 196 | 197 | (defmacro flow [& cmds] 198 | (let [options (vec (filter integer? cmds)) 199 | cmds (filter #(not (integer? %)) cmds)] 200 | (if (empty? options) 201 | `(do (add-layout ::Flow) ~@cmds) 202 | `(do (add-layout ::Flow ~options) ~@cmds)))) 203 | 204 | (defmacro stack [& cmds] 205 | (let [options (vec (filter integer? cmds)) 206 | cmds (filter #(not (integer? %)) cmds)] 207 | (if (empty? options) 208 | `(do (add-layout ::Stack) ~@cmds) 209 | `(do (add-layout ::Stack ~options) ~@cmds)))) 210 | --------------------------------------------------------------------------------