Skip to content

Instantly share code, notes, and snippets.

@rm-hull
Created July 5, 2015 23:46
Show Gist options
  • Save rm-hull/3282809b5c10d0497129 to your computer and use it in GitHub Desktop.
Save rm-hull/3282809b5c10d0497129 to your computer and use it in GitHub Desktop.
; 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)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment