225 lines
7.3 KiB
Clojure
225 lines
7.3 KiB
Clojure
(ns tittle)
|
|
|
|
(def turtle (atom {:theta 0 :x 0 :y 0 :pen :up :nib 3 :ink "blue"}))
|
|
|
|
(defn log-turtle!
|
|
"Prints the state of the turtle to the browser console."
|
|
[]
|
|
(.log js/console
|
|
(apply str
|
|
(cons "Turtle: "
|
|
(map #(str % " " (@turtle %) "; ") (keys @turtle))))))
|
|
|
|
(log-turtle!)
|
|
|
|
(def playing-field (.getElementById js/document "playing-field"))
|
|
|
|
(defn- not-a-number!
|
|
[n]
|
|
(throw (js/Error. (str "not a number: " n))))
|
|
|
|
(defn number-or-error!
|
|
"If `n` is a number, return it, else throw an exception."
|
|
[n]
|
|
(cond (.isNaN js/Number n) (not-a-number! n)
|
|
(number? n) n
|
|
:else (not-a-number! n)))
|
|
|
|
(defn sanitise-angle
|
|
"Take this `angle`, and return a number between 0 and 360 that represents
|
|
it as an angular measurement."
|
|
[angle]
|
|
(let [a (abs angle)
|
|
p (pos? angle)
|
|
v (cond (.isNaN js/Number a) 0
|
|
(< a 0.5) 0
|
|
(<= a 360) a
|
|
:else (loop [r a]
|
|
(if (<= r 360) r
|
|
(recur (- r 360)))))
|
|
v' (if p v (- 360 v))]
|
|
(.log js/console (str "(sanitise-angle " angle ") -> " v'))
|
|
v'))
|
|
|
|
(defn turn!
|
|
"Turn the turtle clockwise by this `angle`, expressed in degrees with
|
|
respect to the X axis. If `angle` is not a number, throw an exception."
|
|
[angle]
|
|
(if (number? angle)
|
|
(swap! turtle assoc :theta
|
|
(sanitise-angle
|
|
(+ (:theta @turtle) angle)))
|
|
(not-a-number! angle))
|
|
(.info js/console (str "(turn! " angle
|
|
") :: :theta now " (:theta @turtle)))
|
|
(log-turtle!))
|
|
|
|
(defn turn-to!
|
|
"Turn the turtle to face `angle`, expressed in degrees with respect to the
|
|
X axis. If `angle` is not a number, throw an exception."
|
|
[angle]
|
|
(if (number? angle)
|
|
(swap! turtle assoc :theta (sanitise-angle angle))
|
|
(not-a-number! angle))
|
|
(.info js/console (str "(turn-to! " angle
|
|
") :: :theta now " (:theta @turtle))))
|
|
|
|
(defn pen-down!
|
|
"Put the turtle's pen down."
|
|
[]
|
|
(.info js/console "pen-down!")
|
|
(swap! turtle assoc :pen :down))
|
|
|
|
(defn pen-up!
|
|
"Lift the turtle's pen up"
|
|
[]
|
|
(.info js/console "pen-up!")
|
|
(swap! turtle assoc :pen :up))
|
|
|
|
(defn pen-down?
|
|
"Return `true` if the turtle's pen is down, else `false`."
|
|
[]
|
|
(let [v (= (@turtle :pen) :down)]
|
|
(.info js/console "(pen-down?) =>" v)
|
|
v))
|
|
|
|
(defn pen-up?
|
|
"Return `true` if the turtle's pen is not down, else `false`."
|
|
[]
|
|
(not (pen-down?)))
|
|
|
|
(defn move-to!
|
|
"Move the turtle absolutely to the coordinates `x`, `y`. If the
|
|
pen is down, create a line element."
|
|
[x y]
|
|
(.info js/console (str "(move-to! " x " " y ")"))
|
|
(when (map number-or-error! [x y])
|
|
(let [x' (:x @turtle)
|
|
y' (:y @turtle)]
|
|
(when (pen-down?)
|
|
(let [elt (.createElementNS js/document "http://www.w3.org/2000/svg" "line")
|
|
id (gensym "line")]
|
|
(.setAttribute elt "id" id)
|
|
(.setAttribute elt "x1" x')
|
|
(.setAttribute elt "y1" y')
|
|
(.setAttribute elt "x2" x)
|
|
(.setAttribute elt "y2" y)
|
|
(.setAttribute elt "stroke" (or (:ink @turtle) "blue"))
|
|
(.setAttribute elt "stroke-width" (or (:nib @turtle) 3))
|
|
(.appendChild playing-field elt)))
|
|
(swap! turtle assoc :x x :y y))))
|
|
|
|
(def ^:const pi 3.141592653589793)
|
|
|
|
(defn degrees->radians
|
|
"Return the equivalent, in radians, of this `angle` espressed in degrees"
|
|
[angle]
|
|
(let [v (when (number-or-error! angle)
|
|
(* angle (/ pi 180)))]
|
|
(.log js/console (str "(degrees->radians " angle ") => " v))
|
|
v))
|
|
|
|
(defn radians->degrees
|
|
"Return the equivalent, in degrees, of this `angle` espressed in radians"
|
|
[angle]
|
|
(let [v (when (number-or-error! angle)
|
|
(/ (* angle 180) pi))]
|
|
(.log js/console (str "(radians->degrees " angle ") => " v))
|
|
v))
|
|
|
|
(defn sin
|
|
"Return the sine of this `angle`, considered to be expressed in degrees."
|
|
[angle]
|
|
(.sin js/Math (degrees->radians angle)))
|
|
|
|
(defn cos
|
|
"Return the cosine of this `angle`, considered to be expressed in degrees."
|
|
[angle]
|
|
(.cos js/Math (degrees->radians angle)))
|
|
|
|
(defn move!
|
|
"Move the turtle forward on its current heading by `distance` units."
|
|
[distance]
|
|
(.info js/console (str "(move! " distance ")"))
|
|
(move-to! (+ (:x @turtle) (* distance (sin (:theta @turtle))))
|
|
(+ (:y @turtle) (* distance (cos (:theta @turtle))))))
|
|
|
|
(defn set-ink!
|
|
"Set the ink with which the turtle draws to this `colour`, which
|
|
should be a string representation of a colour known to CSS."
|
|
[colour]
|
|
(.log js/console (str "(set-ink! " colour ")"))
|
|
(when (string? colour)
|
|
(swap! turtle assoc :ink colour)))
|
|
|
|
(defn set-nib!
|
|
"Set the nib (width) of the pen to this `n`, which should be a number."
|
|
[n]
|
|
(when (number-or-error! n)
|
|
(swap! turtle assoc :nib n)))
|
|
|
|
(defn draw-tree!
|
|
"Draw a tree. This is a fairly crude tree-drawing algorithm;
|
|
there's lots of ways it can be improved, consider it a place
|
|
to start. Parameters (all numeric) as follows:
|
|
|
|
`length`: the length of the current segment of the tree;
|
|
`left-branch`: the amount to turn left, with respect to the
|
|
parent segment, to draw a left branch, in degrees;
|
|
`right-branch`: the amount to turn right, with respect to the
|
|
parent segment, to draw a right branch, in degrees;
|
|
`curvature`: the amount to turn to draw the next segment of
|
|
the current stem, in degrees;
|
|
`branch-fraction`: the length of a branch segment, as a
|
|
proportion of the length of its parent segment;
|
|
`trunk-fraction`: the length of the next segment of a stem,
|
|
as a proportion of the length of its parent segment;
|
|
`depth`: the maximum depth of recursion to allow."
|
|
[length left-branch right-branch curvature branch-fraction trunk-fraction depth]
|
|
(log-turtle!)
|
|
(when (> depth 0)
|
|
(pen-down!)
|
|
(set-ink! (if (<= depth 2) "green" "brown"))
|
|
(move! length)
|
|
(turn! curvature)
|
|
(draw-tree! (* length trunk-fraction)
|
|
(* left-branch branch-fraction)
|
|
(* right-branch branch-fraction)
|
|
curvature
|
|
branch-fraction
|
|
trunk-fraction
|
|
(dec depth))
|
|
(turn! (- 0 (+ curvature left-branch)))
|
|
(draw-tree! (* length trunk-fraction)
|
|
left-branch
|
|
right-branch
|
|
curvature
|
|
branch-fraction
|
|
trunk-fraction
|
|
(dec depth))
|
|
(turn! (+ left-branch right-branch))
|
|
(draw-tree! (* length trunk-fraction)
|
|
left-branch
|
|
right-branch
|
|
curvature
|
|
branch-fraction
|
|
trunk-fraction
|
|
(dec depth))
|
|
(turn! (- 0 right-branch))
|
|
(pen-up!)
|
|
(move! (- 0 length))))
|
|
|
|
(defn draw-polygon!
|
|
"Draw a regular polygon, with this number of `sides`, each of
|
|
this `side-length`."
|
|
[sides side-length]
|
|
(when {<= 3 sides 360}
|
|
(let [angle (/ 360 sides)]
|
|
(pen-down!)
|
|
(loop [side 0]
|
|
(turn! angle)
|
|
(move! side-length)
|
|
(when (< side sides)
|
|
(recur (inc side))))
|
|
(pen-up!))))
|