Tree.clj

(ns net.n01se.Tree
  (:import (java.awt Point Graphics Frame Color)
           (java.awt.geom AffineTransform))
  (:gen-class
     :extends java.applet.Applet))

;--- recursive fractal drawing framework ---

; define min and max points for the logical stage
(def minpoint (doto (Point.) (.setLocation 0 0)))
(def maxpoint (doto (Point.) (.setLocation 1000 1000)))

; number of agents to run concurrently
(def agent-count 4)

(defmacro branch
  "Applies one of the (optionally weighted) choices to the given
  affine transform t"
  [t & choices]
  (let [weights (reduce #(conj % (+ (peek %) (Double. (name (:tag ^%2 :1)))))
                        [0] choices)
        total-weight (peek weights)]
  `(let [maxp# (.transform ~t maxpoint (Point.))]
     (if (= maxp# (.transform ~t minpoint (Point.)))
       maxp#
       (condp > (* (rand) ~total-weight)
         ~@(mapcat list (rest weights) choices))))))

(defn draw
  "Agent action for drawing single point in the given window w using
  the draw function func.  Sense to itself forever."
  [_ #^Frame w func]
  (let [t (AffineTransform.)]
    (.translate t 300 650)
    (.scale t 0.5 -0.5)
    (let [#^Point p (func t)]
      (doto (.getGraphics w)
        (.setColor (if (zero? (rand-int 80)) Color/WHITE (Color. 0 50 0)))
        (.fillRect (.x p) (.y p) 1 1)))
    (send *agent* draw w func)))

(defn monitor-agents
  "Report errors from any of the drawing agents. (Doesn't do much good
  in an applet"
  [agents]
  (Thread/sleep 1000)
  (doseq [agt agents, err (agent-errors agt)]
    (.printStackTrace err)
    (clear-agent-errors agt))
  (send-off *agent* monitor-agents)
  agents)

(defn make-drawing
  "Launch drawing agents for this given drawing func using the
  graphics context of the given window"
  [window func]
  (send-off (agent (map #(send (agent %) draw window func)
                        (range agent-count)))
            monitor-agents))


;--- specific shape definitions ---

(defn polygon
  "Return a function that draws a regular polygon with the given
  number of sides"
  ([sides] (polygon sides 0.6 0.6))
  ([sides x-scale y-scale]
    (fn [#^AffineTransform t]
      (branch t
        (recur (doto t (.scale x-scale y-scale) (.translate 0 500)
                       (.rotate (* (rand-int sides) (/ 6.28 sides)))))))))

(defn star
  "Draw a five-sided star out of triangles"
  [#^AffineTransform t]
  (let [sides 5]
    (branch t
      ((polygon 3 0.7 0.7)
         (doto t
           (.scale 0.5 0.5)
           (.rotate (* (rand-int sides) (/ 6.28 sides)))
           (.scale 0.7 1) (.translate 0 -100))))))

(defn tree
  "Draw a pine tree"
  [#^AffineTransform t]
  (branch t
    (recur (doto t (.scale 0.5 0.5) (.translate 0 500) (.rotate 2)))
    (recur (doto t (.scale 0.5 0.5) (.translate 0 500) (.rotate -2)))
    #^:3 (recur (doto t (.scale 0.8 0.8) (.translate 0 300)))))

(defn star-tree
  "Draw a tree with a star on top"
  [#^AffineTransform t]
  (branch t
    #^:50 (tree (doto t (.translate 0 -100)))
    (star (doto t (.translate 0 1100) (.scale 0.2 0.2)))))


;--- applet-specific support ---

(defn -start
  "Applet entrypoint.  Start drawing"
  [this]
  (make-drawing this star-tree))