biomorph-designer.cljs

(ns biomorph.designer
  (:require
    [cljs.core.async :as async]
    [clojure.string :as str]
    [dommy.core :refer [insert-after! set-text! add-class! remove-class!]]
    [monet.canvas :refer [get-context begin-path close-path
                          clear-rect  quadratic-curve-to
                          stroke-style stroke-width stroke-cap
                          line-join move-to line-to stroke]]
    [enchilada :refer [canvas-size value-of]]
    [inkspot.color :as inkspot]
    [big-bang.core :refer [big-bang]]
    [big-bang.components :refer [slider]])
  (:require-macros
    [dommy.macros :refer [sel1 node]]))

(def directions [
  [ 0 -1]   ; North
  [ 1 -1]   ; North-East
  [ 1  0]   ; East
  [ 1  1]   ; South-East
  [ 0  1]   ; South
  [-1  1]   ; South-West
  [-1  0]   ; West
  [-1 -1]]) ; North-West

(def genes [:g0 :g1 :g2 :g3 :g4 :g5 :g6 :g7  ; order of these is important
            :red :green :blue
            :depth :width 
            :seg :sep])   

(def size (second (canvas-size)))

(defn random-value []
  (- 20 (rand-int 41)))

(defn random-gene []
  (zipmap
    genes
    (repeatedly random-value)))

(def initial-state (random-gene))

(defn handle-incoming-msg [event world-state]
  (merge world-state event))

; TODO - missing from monet
(defn stroke-join
  "Can be set, to change the line join style. Possible values (as string or keyword):
   bevel, round, and miter. Other values are ignored."
  [ctx join]
  (set! (.-lineJoin ctx) (name join))
  ctx)

(defn draw-branch [ctx gene x y tree-depth growth-direction max-segment-len]
  (let [dir (mod growth-direction (count directions))
        [dx dy] (nth directions dir)
        x-gene (nth genes (mod tree-depth 4))
        y-gene (nth genes (+ 4 (mod tree-depth 4)))
        i (+ x (Math/floor (* dx (Math/min (* tree-depth (gene x-gene)) max-segment-len))))
        j (+ y (Math/floor (* dy (Math/min (* tree-depth (gene y-gene)) max-segment-len))))

        red-scale   (mod (Math/floor (* (gene :red)    577)) 255)
        green-scale (mod (Math/floor (* (gene :green) 1297)) 255)
        blue-scale  (mod (Math/floor (* (gene :blue)  2089)) 255)

        color (inkspot/coerce [
                (mod (+ red-scale   (* tree-depth 97)) 255)
                (mod (+ green-scale (* tree-depth 97)) 255)
                (mod (+ blue-scale  (* tree-depth 97)) 255)
                0.7])

        width (Math/abs (inc (mod (* (gene :width) tree-depth) 5)))]

    (when (pos? tree-depth)
      (->
        ctx
        (draw-branch gene i j (dec tree-depth) (inc growth-direction) max-segment-len)
        (draw-branch gene i j (dec tree-depth) (dec growth-direction) max-segment-len)))

    (->
      ctx
      (begin-path)
      (stroke-style color)
      (stroke-width width)
      (move-to x y)
      (line-to i j)
      (close-path)
      (stroke))))

(defn render [{:keys [depth] :as world-state}]
  (let [gene world-state
        canvas (.getElementById js/document "cell-canvas")
        ctx (get-context canvas "2d")
        x (/ size 2)
        y (/ size 2)
        max-segment-len (Math/floor (/ size 2 8))
        tree-depth (inc (mod depth 10))
        growth-direction 0] ; North
    (->
      ctx
      (clear-rect {:x 0 :y 0 :w size :h size})
      (stroke-cap :round)
      (stroke-join :round))

    (loop [i (inc (mod (Math/abs (gene :seg)) 6))
           y' y] 
      (if (zero? i)
        ctx
        (do
          (draw-branch ctx gene x y' tree-depth growth-direction max-segment-len)
          (recur 
            (dec i)
            (+ y' 4 (gene :sep))))))))

(defn make-canvas [id size]
  [:div.cell
    [:canvas {:id (name id) :width size :height size}]])

(defn style [& styles ]
  [:style (str/join \newline styles)])

(defn make-controls [chan]
  [:div.controls
    (for [id genes]
      [:div
        (slider
          :id id
          :label-text (str (name id) ":")
          :min-value -20
          :max-value 20
          :initial-value (initial-state id)
          :send-channel chan)])
    [:div.links 
      [:span.permalink [:a {:href "#" :title "Generates a permalink for this Biomorph"} "Permalink"]]
      [:span.evolve    [:a {:href "#" :title "Evolves this Biomorph using cumulative selection"} "Evolve"]]
      [:span.random    [:a {:href "#" :title "Creates a new random Biomorph"} "Random"]]]])

(let [chan (async/chan)]

  (->>
    (sel1 :#canvas-area)
    (insert-after!
      (node
        [:div#app
          (style
            "div#app {margin: 20px 0; width:850px}"
            "#app .controls {float: right;}"
            "#app .cell {-moz-border-radius: 10px; -webkit-border-radius: 10px; border-radius: 10px;"
            "            border: 1px #333 solid; background-color: #222; margin: 20px 0 0 20px; width: 600px;}"
            "#app .slider {font-size: 14px; font-family: Helvetica,arial,freesans,clean,sans-serif; color: #666;"
            "              padding: 3px 10px 3px 10px; display: flex; border-top: 1px solid lightgray;"
            "              border-left: 1px solid lightgray; border-right: 1px solid lightgray;}"
            "#app .slider label {width: 50px; display: inline-block; text-align: right;}"
            "#app .links a {text-decoration: underline; font-family: sans-serif; margin-left: 15px;"
            "               font-size: 10pt; color: #4183C4; cursor: pointer;}"
            )
          (make-controls chan)
          (make-canvas :cell-canvas size)])))

  (big-bang
    :initial-state initial-state
    :receive-channel chan
    :on-receive handle-incoming-msg
    :to-draw render))