Ant Simulation - Clojure on the BEAM

ants.cljc

(ns ants.core)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;   Copyright (c) 2008 Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
;   which can be found in the file CPL.TXT at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.

;dimensions of square world
(def dim 80)
;number of ants = nants-sqrt^2
(def nants-sqrt 7)
;number of places with food
(def food-places 35)
;range of amount of food at a place
(def food-range 100)
;scale factor for pheromone drawing
(def pher-scale 20.0)
;scale factor for food drawing
(def food-scale 30.0)
;evaporation rate
(def evap-rate 0.99)

(def animation-sleep-ms 100)
(def ant-sleep-ms 40)
(def evap-sleep-ms 1000)

(def running true)

(defrecord cell [food pher]) ;may also have :ant and :home

;world is a 2d vector of atoms to cells
(def world
     (apply vector
            (map (fn [_]
                   (apply vector (map (fn [_] (atom (cell. 0 0)))
                                      (range dim))))
                 (range dim))))

(defn place [[x y]]
  (-> world (nth (int x)) (nth (int y))))

(defrecord ant [dir]) ;may also have :food

(defn create-ant
  "create an ant at the location, returning an ant agent on the location"
  [loc dir]
  (let [p (place loc)
        a (ant. dir)]
    (swap! p assoc :ant a)
    (agent loc)))

(def home-off (quot dim 4))
(def home-range (range home-off (+ nants-sqrt home-off)))

(defn setup
  "places initial food and ants, returns seq of ant agents"
  []
  (dotimes [i food-places]
    (let [p (place [(rand-int dim) (rand-int dim)])]
      (swap! p assoc :food (rand-int food-range))))
  (doall
   (for [x home-range y home-range]
     (do
       (swap! (place [x y])
              assoc :home true)
       (create-ant [x y] (rand-int 8))))))

(defn bound
  "returns n wrapped into range 0-b"
  [b n]
    (let [n (rem n b)]
      (if (neg? n)
        (+ n b)
        n)))

(defn wrand
  "given a vector of slice sizes, returns the index of a slice given a
  random spin of a roulette wheel with compartments proportional to
  slices."
  [slices]
  (let [total (reduce + slices)
        r (rand total)]
    (loop [i 0 sum 0]
      (if (< r (+ (slices i) sum))
        i
        (recur (inc i) (+ (slices i) sum))))))

;dirs are 0-7, starting at north and going clockwise
;these are the deltas in order to move one step in given dir
(def dir-delta {0 [0 -1]
                1 [1 -1]
                2 [1 0]
                3 [1 1]
                4 [0 1]
                5 [-1 1]
                6 [-1 0]
                7 [-1 -1]})

(defn delta-loc
  "returns the location one step in the given dir. Note the world is a torus"
  [[x y] dir]
    (let [[dx dy] (dir-delta (bound 8 dir))]
      [(bound dim (+ x dx)) (bound dim (+ y dy))]))

;(defmacro dosync [& body]
;  `(sync nil ~@body))

;ant agent functions
;an ant agent tracks the location of an ant, and controls the behavior of
;the ant at that location

(defn turn
  "turns the ant at the location by the given amount"
  [loc amt]
  (let [p (place loc)
        ant (:ant @p)]
    (swap! p assoc :ant (assoc ant :dir (bound 8 (+ (:dir ant) amt)))))
  loc)

(defn move
  "moves the ant in the direction it is heading. Must be called in a
  transaction that has verified the way is clear"
  [loc]
     (let [oldp (place loc)
           ant (:ant @oldp)
           newloc (delta-loc loc (:dir ant))
           p (place newloc)]
         ;move the ant
       (swap! p assoc :ant ant)
       (swap! oldp dissoc :ant)
         ;leave pheromone trail
       (when-not (:home @oldp)
         (swap! oldp assoc :pher (inc (:pher @oldp))))
       newloc))

(defn take-food [loc]
  "Takes one food from current location. Must be called in a
  transaction that has verified there is food available"
  (let [p (place loc)
        ant (:ant @p)]
    (swap! p assoc
           :food (dec (:food @p))
           :ant (assoc ant :food true))
    loc))

(defn drop-food [loc]
  "Drops food at current location. Must be called in a
  transaction that has verified the ant has food"
  (let [p (place loc)
        ant (:ant @p)]
    (swap! p assoc
           :food (inc (:food @p))
           :ant (dissoc ant :food))
    loc))

(defn rank-by
  "returns a map of xs to their 1-based rank when sorted by keyfn"
  [keyfn xs]
  (let [sorted (sort-by (comp float keyfn) xs)]
    (reduce (fn [ret i] (assoc ret (nth sorted i) (inc i)))
            {} (range (count sorted)))))

(defn behave
  "the main function for the ant agent"
  [loc]
  (let [p (place loc)
        ant (:ant @p)
        ahead (place (delta-loc loc (:dir ant)))
        ahead-left (place (delta-loc loc (dec (:dir ant))))
        ahead-right (place (delta-loc loc (inc (:dir ant))))
        places [ahead ahead-left ahead-right]]
    (timer/sleep ant-sleep-ms)
    (when running
      (send-off *agent* #'behave))
    (if (:food ant)
                                        ;going home
      (cond
        (:home @p)
        (-> loc drop-food (turn 4))
        (and (:home @ahead) (not (:ant @ahead)))
        (move loc)
        :else
        (let [ranks (merge-with +
                                (rank-by (comp #(if (:home %) 1 0) deref) places)
                                (rank-by (comp :pher deref) places))]
          (([move #(turn % -1) #(turn % 1)]
            (wrand [(if (:ant @ahead) 0 (ranks ahead))
                    (ranks ahead-left) (ranks ahead-right)]))
           loc)))
                                        ;foraging
      (cond
        (and (pos? (:food @p)) (not (:home @p)))
        (-> loc take-food (turn 4))
        (and (pos? (:food @ahead)) (not (:home @ahead)) (not (:ant @ahead)))
        (move loc)
        :else
        (let [ranks (merge-with +
                                (rank-by (comp :food deref) places)
                                (rank-by (comp :pher deref) places))]
          (([move #(turn % -1) #(turn % 1)]
            (wrand [(if (:ant @ahead) 0 (ranks ahead))
                    (ranks ahead-left) (ranks ahead-right)]))
           loc))))))

(defn evaporate
  "causes all the pheromones to evaporate a bit"
  []
  (dorun
   (for [x (range dim) y (range dim)]
     (let [p (place [x y])]
       (swap! p assoc :pher (* evap-rate (:pher @p)))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; UI ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (import
;;  '(java.awt Color Graphics Dimension)
;;  '(java.awt.image BufferedImage)
;;  '(javax.swing JPanel JFrame))

;pixels per world cell
(def scale 5)

(defn color
  ([r g b]
   (color r g b 255))
  ([r g b a]
   #erl[r g b a]))

(defn fill-cell [dc x y brush pen colour]
  (wxBrush/setColour brush colour)
  (wxDC/setBrush dc brush)
  (wxDC/setPen dc pen)
  (wxDC/drawRectangle dc #erl[(* x scale) (* y scale) scale scale]))

(defn render-ant [dc ant x y state]
  (let [[hx hy tx ty] ({0 [2 0 2 4]
                        1 [4 0 0 4]
                        2 [4 2 0 2]
                        3 [4 4 0 0]
                        4 [2 4 2 0]
                        5 [0 4 4 0]
                        6 [0 2 4 2]
                        7 [0 0 4 4]}
                       (:dir ant))
        pen (if (:food ant) (:ant-with-food-pen state) (:ant-pen state))]
    (wxDC/setPen dc pen)
    (wxDC/drawLine dc
                   #erl[(+ hx (* x scale)) (+ hy (* y scale))]
                   #erl[(+ tx (* x scale)) (+ ty (* y scale))])))

(defn render-place [dc p x y state brush pen]
  (when (pos? (:pher p))
    (fill-cell dc x y brush pen
               (color 0x91 0xDC 0x47
                      (int (min 255 (* 255 (/ (:pher p) pher-scale)))))))
  (when (pos? (:food p))
    (fill-cell dc x y brush pen
               (color 0x85 0xB5 0xFE
                      (int (min 255 (* 255 (/ (:food p) food-scale)))))))
  (when-let [ant (:ant p)]
    (render-ant dc ant x y state)))

(def dim-px (* scale dim))

(defn render [state]
  (let [dc (:bitmap-dc state)
        brush (:cell-brush state)
        pen (:cell-pen state)
        v (apply vector (for [x (range dim) y (range dim)]
                          @(place [x y])))]
    (doto dc
      (wxDC/setPen pen)
      (wxDC/setBrush (:bg-brush state))
      (wxDC/drawRectangle #erl[0 0 dim-px dim-px]))
    (dorun
     (for [x (range dim) y (range dim)]
       (render-place dc (v (+ (* x dim) y)) x y state brush pen)))
    (doto dc
      (wxDC/setPen (:home-pen state))
      (wxDC/setBrush (:home-brush state))
      (wxDC/drawRectangle #erl[(* scale home-off) (* scale home-off)
                               (* scale nants-sqrt) (* scale nants-sqrt)]))))

(defn make-frame []
 (let [server (wx/new)
       frame (wxFrame/new server -1 "Ants Clojure/BEAM"
                          #erl(#erl[:size #erl[dim-px dim-px]]))
       panel (wxPanel/new frame 0 0 dim-px dim-px)]
  (wxWindow/fit frame)
  (wxWindow/setBackgroundStyle panel 2) ; flicker free
  (wxFrame/connect frame :close_window)
  (wxFrame/connect panel :paint #erl(:callback))
  (wxFrame/centre frame)
  (wxFrame/show frame)
  [frame panel]))

(defn* handle_info
  ([:refresh state]
   (wxFrame/refresh (:canvas state))
   #erl[:noreply state])
  ([_ state]
   #erl[:noreply state]))

(defn* handle_event
  [#erl[:wx _id _ #erl"" #erl[:wxClose :close_window]] state]
  (erlang/halt 0))

(defn handle_sync_event
  [wx obj state]
  (render state)
  (let [dc (wxPaintDC/new (:canvas state))]
    (wxDC/drawBitmap dc (:bitmap state) #erl[0 0])
    (wxPaintDC/destroy dc))
  :ok)

(defn animation [gui]
  (when running
    (send-off *agent* #'animation))
  (erlang/send gui :refresh)
  (timer/sleep animation-sleep-ms)
  gui)

(defn evaporation [x]
  (when running
    (send-off *agent* #'evaporation))
  (evaporate)
  (timer/sleep evap-sleep-ms)
  nil)

(defn init [_]
  (let [[frame canvas] (make-frame)
        bitmap (wxBitmap/new dim-px dim-px)
        state {:canvas canvas
               :bitmap bitmap
               :bitmap-dc (wxMemoryDC/new bitmap)
               :ant-pen (wxPen/new (color 0 0 0)
                                   #erl(#erl[:width 2]))
               :ant-with-food-pen (wxPen/new (color 0x58 0x81 0xF8)
                                             #erl(#erl[:width 2]))
               :bg-brush (wxBrush/new (color 238 238 238))
               :home-pen (wxPen/new (color 0x58 0x81 0xD8))
               :home-brush (wxBrush/new (color 221 221 221 0))
               :cell-brush (wxBrush/new (color 0 0 0))
               :cell-pen (wxPen/new (color 0 0 0 0)
                                    #erl(#erl[:width 0]))}]
    #erl[frame state]))

(defn start
  []
  (let [gui (wx_object/start :ants.core {} #erl())
        ants (setup)
        animator (agent (wx_object/get_pid gui))
        evaporator (agent nil)]
    (send-off animator animation)
    (dorun (map #(send-off % behave) ants))
    (send-off evaporator evaporation)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; use ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(ns ants)

(defn -main
  []
  (ants.core/start)
  (receive*))

ants2.clje

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Ant sim ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;   Copyright (c) 2008 Rich Hickey. All rights reserved.
;   The use and distribution terms for this software are covered by the
;   Common Public License 1.0 (http://opensource.org/licenses/cpl.php)
;   which can be found in the file CPL.TXT at the root of this distribution.
;   By using this software in any fashion, you are agreeing to be bound by
;   the terms of this license.
;   You must not remove this notice, or any other, from this software.
;
;   Original Clojure JVM code :- https://gist.github.com/michiakig/1093917
;   Video of the original code :- https://www.youtube.com/watch?v=dGVqrGmwOAw
;   Announcment :- https://groups.google.com/forum/#!msg/clojure/Zq76uzzkS8M/UzfXj9jKyw4J
;
;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜
;
;   Conversion to clojerl - Clojure running on the BEAM
;
;   Download from http://clojerl.org/ make and run with
;
;      bin/clje ants.clje
;
;   The code is ported directly. The only differences are:
;
;     1. the Clojure JVM code modelled Ants as threads, we use one process per Ant on the BEAM
;     2. Clojure updates state using STM and this wrapper:
;
;          (defmacro dosync [& body]
;            `(sync nil ~@body))
;
;        This allows updates to two agents in a transaction. We use optimistic locking.
;        A process may inspect the world and make a decision. If two ants come to the
;        same decision (pick up the same piece of food, or move to the same square) when
;        they come to action the decision they will send a message to the world process
;        which serializes the actions - the actions will then succeed or fail and the ant
;        will adjust acordingly. ie the first ant will get the food, the second will have
;        to re-evaulate their decision on their next turn.
;     3. render-place does not paint the pheremone trail - there are too many rectangles
;        per frame! However the code exists and can be uncommented.
;
;   (c) 2020 Devstopfix
;
;🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜🐜

(ns ants)

;dimensions of square world
(def dim 80)
;number of ants = nants-sqrt^2
(def nants-sqrt 7)
;number of places with food
(def food-places 35)
;range of amount of food at a place
(def food-range 100)
(def home-off (quot dim 4))
;evaporation rate
(def evap-rate 0.99)

(def animation-sleep-ms 100) ; 5 fps
(def ant-sleep-ms 40) ; 25 fps
(def evap-sleep-ms 1000)

(ns ants.sim (:use ants))

(defrecord cell [food pher home]) ; may also have ant

(defn new-world [dim]
     (apply vector
            (map (fn [_]
                   (apply vector (map (fn [_] (cell. 0 0 false))
                                      (range dim))))
                 (range dim))))

(defn evaporate [cell] (update cell :pher * evap-rate))

(defn world-fn
  [world]
  (receive*

   #erl [:place pid loc]
   (let [[x y] loc
         cell (-> world (nth x) (nth y))]
     (erlang/send pid #erl[:cell cell])
     (recur world))

   #erl [:drop-food loc]
   (let [[x y] loc]
     (recur (update-in world [x y] update :food inc)))

   #erl [:move-ant pid ant from to]
   (let [[x1 y1] from [x2 y2] to]
     (if (-> world (nth x2) (nth y2) (:ant))
       (do
         (erlang/send pid #erl[:moved false])
         (recur world))
       (do
         (erlang/send pid #erl[:moved true])
         (-> world
             (update-in [x1 y1] update :pher inc)
             (update-in [x1 y1] dissoc :ant)
             (update-in [x2 y2] assoc :ant (select-keys ant [:dir :food]))
             (recur)))))

   #erl [:take-food pid loc]
   (let [[x y] loc]
     (let [available-food (-> world (nth x) (nth y) (:food))]
       (if (pos? available-food)
         (do
           (erlang/send pid #erl[:taken true])
           (recur (update-in world [x y] update :food dec)))
         (do
           (erlang/send pid #erl[:taken false])
           (recur world)))))

   :snapshot
   (do
     (erlang/send :graphics #erl[:world world])
     (recur world))

   :evaporate
   (let [map-vec (comp vec map)]
     (recur (map-vec (partial map-vec evaporate) world)))))

(defn place [loc]
  (erlang/send :world #erl[:place (erlang/self) loc])
  (receive* #erl[:cell cell] cell))

(def home-range (range home-off (+ nants-sqrt home-off)))
(defn home-places [] (for [x home-range y home-range] [x y]))

(defn make-home [world]
 (reduce
  (fn [world loc]
    (-> world
      (update-in loc assoc :home true)
      (update-in loc assoc :ant {:dir (rand-int 4)})))
  world
  (home-places)))

(defn make-food [world]
 (reduce
  (fn [world n]
   (let [loc [(rand-int dim) (rand-int dim)]
         f (-> food-range (rand-int) (inc))]
   (update-in world loc assoc :food f)))
   world
   (range food-places)))

(defn setup [] (-> dim (new-world) (make-home) (make-food)))

;dirs are 0-7, starting at north and going clockwise
;these are the deltas in order to move one step in given dir
(def dir-delta {0 [0 -1]
                1 [1 -1]
                2 [1 0]
                3 [1 1]
                4 [0 1]
                5 [-1 1]
                6 [-1 0]
                7 [-1 -1]})

(def dir-count (count dir-delta))

(defn bound
  "returns n wrapped into range 0-b"
  [b n]
    (let [n (rem n b)]
      (if (neg? n)
        (+ n b)
        n)))

(defn wrand
  "given a vector of slice sizes, returns the index of a slice given a
  random spin of a roulette wheel with compartments proportional to
  slices."
  [slices]
  (let [total (reduce + slices)
        r (rand total)]
    (loop [i 0 sum 0]
      (if (< r (+ (slices i) sum))
        i
        (recur (inc i) (+ (slices i) sum))))))

(defn delta-loc
  "returns the location one step in the given dir. Note the world is a torus"
  [[x y] dir]
    (let [[dx dy] (dir-delta (bound dir-count dir))]
      [(bound dim (+ x dx)) (bound dim (+ y dy))]))

(defn rank-by
  "returns a map of xs to their 1-based rank when sorted by keyfn"
  [keyfn xs]
  (let [sorted (sort-by (comp float keyfn) xs)]
    (reduce (fn [ret i] (assoc ret (nth sorted i) (inc i)))
            {} (range (count sorted)))))

; Ant process tracks the location of an ant, and controls the behavior of
; the ant at that location

(defrecord ant [loc dir]) ; may also have food

(defn take-food [loc]
  (erlang/send :world #erl[:take-food (erlang/self) loc])
  (receive* #erl[:taken f] f))

(defn move-ant [ant from to]
  (erlang/send :world #erl[:move-ant (erlang/self) ant from to])
  (receive* #erl[:moved b] b))

(defn ant-place [ant dir-delta]
  "Find a place that an ant could move to"
  (-> (:loc ant)
    (delta-loc (dir-delta (:dir ant)))
    (place)))

(defn turn [ant amt]
 (let [dir (bound dir-count (+ (:dir ant) amt))]
  (assoc ant :dir dir)))

(defn turn-about [ant] (turn ant (quot dir-count 2)))

(defn try-move-ant [ant]
  (let [loc-ahead (delta-loc (:loc ant) (:dir ant))]
    (if (move-ant ant (:loc ant) loc-ahead)
      (assoc ant :loc loc-ahead)
      ant)))

(defn behave [ant]
  (let [loc (:loc ant)
        p (place loc)
        ahead (ant-place ant identity)
        ahead-left (ant-place ant dec)
        ahead-right (ant-place ant inc)
        places [ahead ahead-left ahead-right]]
    (if (:food ant)
      ; going home
      (cond
        (:home p)
          (do
            (erlang/send :world #erl[:drop-food loc])
            (dissoc ant :food))

        (and (:home ahead) (not (:ant ahead)))
          (try-move-ant ant)

        :else
          (let [ranks (merge-with +
                        (rank-by #(if (:home %) 1 0) places)
                        (rank-by :pher places))]
          (([try-move-ant #(turn % -1) #(turn % 1)]
            (wrand [(if (:ant ahead) 0 (ranks ahead))
                    (ranks ahead-left) (ranks ahead-right)]))
           ant)))

      ; foraging
      (cond
       ; found food in the wild?
       (and (pos? (:food p)) (not (:home p)))
         (if (take-food loc)
           (-> ant
             (assoc :food true)
             (turn-about))
           ant)

       (and (pos? (:food ahead)) (not (:home ahead)) (not (:ant ahead)))
          (try-move-ant ant)

      :else ; wander
      (let [ranks (merge-with +
                              (rank-by :food places)
                              (rank-by :pher places))]
        (([try-move-ant #(turn % -1) #(turn % 1)]
          (wrand [(if (:ant ahead) 0 (ranks ahead)) (ranks ahead-left) (ranks ahead-right)]))
         ant))))))

(defn ant-fn
  [state]
  (timer/sleep ant-sleep-ms)
  (recur (behave state)))

(defn evaporator-fn
  []
  (timer/sleep evap-sleep-ms)
  (erlang/send :world :evaporate)
  (recur))

(defn run []
  (let [pid (erlang/spawn #(world-fn (setup)))]
    (erlang/register :world pid)
    (erlang/spawn #(evaporator-fn))
    (doseq [loc (home-places)]
      (let [a (ant. loc (rand-int dir-count))]
        (erlang/spawn #(ant-fn a))))))

(ns ants.graphics (:use ants))

(def title "Ants Clojure/BEAM")
;scale factor for pheromone drawing
; 20.0 is the default,
; nil disables paitning)
(def pher-scale 20.0) ; 20.0
;scale factor for food drawing
(def food-scale 30.0)
;pixels per world cell
(def scale 5)
(def grid-px (* dim scale))

(defn fill-cell [dc x y brush pen]
  (wxDC/setBrush dc brush)
  (wxDC/setPen dc pen)
  (wxDC/drawRectangle dc #erl[(* x scale) (* y scale) scale scale]))

(def s2 (quot scale 2))
(def s4 (dec scale))
(defn render-ant [dc ant x y state]
  (let [[hx hy tx ty] ({0 [s2  0 s2 s4]
                        1 [s4  0  0 s4]
                        2 [s4 s2  0 s2]
                        3 [s4 s4  0  0]
                        4 [s2 s4 s2  0]
                        5 [ 0 s4 s4  0]
                        6 [ 0 s2 s4 s2]
                        7 [ 0  0 s4 s4]}
                       (:dir ant))
       pen (if (:food ant) (:ant-with-food-pen state) (:ant-pen state))]
  (wxDC/setPen dc pen)
  (wxDC/drawLine dc #erl[(+ hx (* x scale)) (+ hy (* y scale))]
                    #erl[(+ tx (* x scale)) (+ ty (* y scale))])))

(defn render-food [dc p x y brush pen]
  (let [alpha (int (min 255 (* 255 (/ (:food p) food-scale))))
        colour #erl[0x8F 0xB5 0xFE alpha]]
    (wxBrush/setColour brush colour)
    (fill-cell dc x y brush pen)))

(defn render-pher [dc p x y brush pen]
  (let [alpha (int (min 255 (* 255 (/ (:pher p) pher-scale))))
        colour #erl[0x91 0xDC 0x47 alpha]]
    (wxBrush/setColour brush colour)
    (fill-cell dc x y brush pen)))

(defn render-place [dc p x y state brush pen]
 (when (and pher-scale (pos? (:pher p))) (render-pher dc p x y brush pen))
 (when (pos? (:food p)) (render-food dc p x y brush pen))
 (when-let [ant (:ant p)] (render-ant dc ant x y state)))

(defn render-bg [dc brush pen]
  (wxDC/setPen dc pen)
  (wxDC/setBrush dc brush)
  (wxDC/drawRectangle dc #erl[0 0 grid-px grid-px]))

(defn render-home [dc brush]
 (let [x (* home-off scale) y x
       w (* nants-sqrt scale) h w
       pen (wxPen/new #erl[0x58 0x81 0xD8])]
       (wxDC/setPen dc pen)
       (wxDC/setBrush dc brush)
       (wxDC/drawRectangle dc #erl[x y w h])
       (wxPen/destroy pen)))

(defn render [state]
  (let [dc (:bitmap-dc state)
        brush (:cell-brush state)
        pen (:cell-pen state)]
    (render-bg dc (:bg-brush state) pen)
    (doseq [[x row] (map-indexed vector (:world state))]
      (doseq [[y cell] (map-indexed vector row)]
        (render-place dc cell x y state brush pen)))
    (render-home dc (:home-brush state))))

(defn make-frame []
 (let [server (wx/new)
       frame (wxFrame/new server -1 title #erl( #erl[:size #erl[grid-px grid-px]]))
       panel (wxPanel/new frame 0 0 grid-px grid-px)]
  (wxWindow/fit frame)
  (wxWindow/setBackgroundStyle panel 2) ; flicker free
  (wxFrame/connect frame :close_window)
  (wxFrame/connect panel :paint #erl(:callback))
  (wxFrame/centre frame)
  (wxFrame/show frame)
  [frame panel]))

(defn* handle_info
  ([#erl[:world world] state]
   (render state)
   (wxFrame/refresh (:canvas state))
   #erl[:noreply (assoc state :world world)])
  ([_ state]
   #erl[:noreply state]))

(defn* handle_event
  [#erl[:wx id #erl[:wx_ref r :wxFrame f] #erl"" #erl[:wxClose :close_window]]
   state]
  (erlang/halt 0)
  #erl[:stop :closed state])

(defn handle_sync_event
  [wx obj state]
  (let [dc (wxPaintDC/new (:canvas state))]
    (wxDC/drawBitmap dc (:bitmap state) #erl[0 0])
    (wxPaintDC/destroy dc))
  :ok)

(defn snapshot-fn
  []
  (timer/sleep ants/animation-sleep-ms)
  (erlang/send :world :snapshot)
  (recur))

(defn fat-pen [r g b]
  (let [pen (wxPen/new #erl[r g b])]
    (wxPen/setWidth pen 2)
    pen))

; Run simulation and graphics until the user closes the window

(defn init [_]
  (let [[frame canvas] (make-frame)
        bitmap (wxBitmap/new grid-px grid-px)
        state {:canvas canvas
               :bitmap bitmap
               :bitmap-dc (wxMemoryDC/new bitmap)
               :ant-pen (fat-pen 0 0 0)
               :ant-with-food-pen (fat-pen 0x58 0x81 0xF8)
               :bg-brush (wxBrush/new #erl[238 238 238])
               :border-pen (wxPen/new #erl[238 238 238])
               :home-brush (wxBrush/new #erl[221 221 221 0])
               :cell-brush (wxBrush/new #erl[0 0 0])
               :cell-pen (wxPen/new #erl[0 0 0 0] #erl(#erl[:width 0]))
               :world []}]
    (erlang/register :graphics (erlang/self))
    (erlang/spawn #(snapshot-fn))
    #erl[frame state]))

(ns ants2)

(defn -main
  []
  (ants.sim/run)
  (wx_object/start :ants.graphics {} #erl())
  (receive*))