palmiters-protozoa.cljs

; Based on pp161-176 of "The Magic Machine" by A.K.Dewdney
(ns enchilada.palmiters-protozoa
  (:require
    [big-bang.core :refer [big-bang]]
    [big-bang.components :refer [dropdown slider color-picker]]
    [enchilada :refer [ctx canvas canvas-size proxy-request]]
    [monet.canvas :refer [circle fill fill-style
                          text text-align
                          stroke-style stroke stroke-width
                          line-to move-to begin-path close-path
                          clear-rect save restore translate rotate scale]]
    [jayq.core :refer [show]]))

(def width 200)
(def height 150)
(def scale-factor 4)
(def two-pi (* Math/PI 2))
(def moves {
     :x [0 2 2 0 -2 -2]
     :y [2 1 -1 -2 -1 1]})

(defn generate-bug []
  {
   :x (int (* width (Math/random)))
   :y (int (* height (Math/random)))
   :fuel 40
   :time 0
   :dir (int (* 5 (Math/random)))
   :genes (vec (repeatedly 6 #(int (- (* 10 (Math/random)) 5))))})

(defn next-direction [bug]
  (let [total (->>
                (:genes bug)
                (map #(Math/pow 2 %))
                (reduce +))
        partitions (->>
                     (:genes bug)
                     (map #(/ (Math/pow 2 %) total))
                     (reductions +))
        r (Math/random)
        turn (count (take-while #(> r %) partitions))]
    (mod (+ (:dir bug) turn) 6)))

(defn update-direction [bug]
  (assoc bug :dir (next-direction bug)))

(defn update-position [bug co-ord]
  (update-in bug [co-ord] + (get-in moves [co-ord (:dir bug)])))

(defn wrap-position [bug co-ord limit]
  (update-in bug [co-ord] #(mod % limit)))

(defn add-fuel [bug delta]
  (update-in bug [:fuel] + delta))

(defn update-time [bug]
  (update-in bug [:time] inc))

(defn bugs-move [bugs]
  (let [move (fn [bug]
               (->
                 bug
                 (update-direction)
                 (update-position :x)
                 (update-position :y)
                 (wrap-position :x width)
                 (wrap-position :y height)
                 (add-fuel -1)
                 (update-time)))]
    (mapv move bugs)))

(defn bug-eats-bacteria? [bug bacteria]
  (let [ax (dec (:x bug))
        bx (inc (:x bug))
        ay (dec (:y bug))
        by (inc (:y bug))]
  (for [[idx bacterium] (map vector (range (count bacteria)) bacteria)
        :when (and
                (<= ax (:x bacterium) bx)
                (<= ay (:y bacterium) by))]
    idx)))

(defn remove-element [vec idx]
  (let [lst (peek vec)]
    (->
      vec
      (assoc idx lst)
      (pop))))

(defn bugs-eat [world-state]
  (loop [i    0
         world-state world-state]
    (if (>= i (count (:bugs world-state)))
      world-state
      (recur
        (inc i)
        (if-let [b (first (bug-eats-bacteria? (get-in world-state [:bugs i]) (:bacteria world-state)))]
          (->
            world-state
            (update-in [:bacteria] remove-element b)
            (update-in [:bugs i] add-fuel +40))
          world-state)))))


(defn mutate [bug delta]
  (let [r (Math/floor (* 6 (Math/random)))]
    (->
      bug
      (update-in [:fuel] / 2)
      (update-in [:genes r] + delta)
      (assoc :time 0))))

(defn bugs-reproduce [bugs]
  (loop [i 0
         bugs bugs]
    (if (>= i (count bugs))
      bugs
      (let [bug (bugs i)]
        (recur
          (inc i)
          (if (and (>= (:fuel bug) 1000) (>= (:time bug) 800))
            (->
              bugs
              (remove-element i)
              (conj (mutate bug +1))
              (conj (mutate bug -1)))
            bugs))))))

(defn bugs-die [bugs]
  (filterv #(pos? (:fuel %)) bugs))

(defn generate-bacteria []
  {
   :x (inc (int (* (- width 2) (Math/random))))
   :y (inc (int (* (- height 2) (Math/random))))})

(defn replenish-bacteria [bacteria]
  ;(if (> (Math/random) 0.8)
    (conj bacteria (generate-bacteria))
   ; bacteria)
   )

(def initial-state
  {
   :time 0
   :bugs (vec (repeatedly 10 generate-bug))
   :bacteria (vec (repeatedly 100 generate-bacteria))})

(defn update-state [event world-state]
  (if (empty? (:bugs world-state))
    world-state
    (->
      world-state
      (update-in [:time] inc)
      (bugs-eat)
      (update-in [:bugs] bugs-move)
      (update-in [:bacteria] replenish-bacteria)
      (update-in [:bugs] bugs-reproduce)
      (update-in [:bugs] bugs-die))))

(def pi-over-2 (/ Math/PI 2))
(def pi-over-3 (/ Math/PI 3))

(defn draw-bugs [ctx bugs size]
  (let [nsize (- size)]
  (->
    ctx
    (stroke-width 0.5)
    (stroke-style :darkcyan)
    (fill-style :lightcyan))
  (doseq [bug bugs
         ; :let [theta (* (:dir bug) pi-over-3)]
         ]
    (->
      ctx
      (save)
      (translate (:x bug) (:y bug))
      ;(rotate theta)
      (begin-path)
      (line-to nsize nsize)
      (line-to nsize size)
      (line-to size size)
      (line-to size nsize)
      (close-path)
      (fill)
      (stroke)
      (restore)))
  ctx))

(defn draw-bacteria[ctx bacteria size]
  (-> ctx (fill-style :magenta))
  (doseq [bact bacteria]
    (-> ctx
      (circle {:x (:x bact) :y (:y bact) :r size})
      (fill)))
  ctx)

(defn game-over [ctx world-state]
  (if (seq (:bugs world-state))
    ctx
    (->
      ctx
      (fill-style :black)
      (text-align :center)
      (text {:text "Game over: all the bugs died." :x (/ width 2) :y (/ height 2)})
      (text {:text "Press F5 to start again." :x (/ width 2) :y (+ (/ height 2) 10)}))))

(defn stats [ctx world-state]
  (->
    ctx
    (fill-style :black)
    (text-align :right)
    (text {:x 800 :y 10
           :text (str
                   "Bugs: " (count (:bugs world-state))
                   "  Bacteria: " (count (:bacteria world-state))
                   "  Time: " (:time world-state))})))

(defn render-system [world-state]
  (->
    ctx
    (save)
    (scale scale-factor scale-factor)
    (clear-rect {:x 0 :y 0 :w width :h height})
    (draw-bacteria (:bacteria world-state) 1)
    (draw-bugs (:bugs world-state) 1.5)
    (game-over world-state)
    (restore)
    (stats world-state)))

(show canvas)

(big-bang
  :initial-state initial-state
  :on-tick update-state
  :to-draw render-system)