drunkard.clj

(ns drunkard)

; Actor
(defprotocol Actor
  (actor-action [this world]))

(defn actor-update [actor world]
  (assoc-in world [:actors (:id actor)] actor))

(defn actor-move [actor world x y]
  (assoc-in world [:actors (:id actor) :pos]
                  {:x x, :y y}))

(defn actor-at? [actor x y]
  (let [{:keys [pos]} actor]
    (and (= (:x pos) x)
         (= (:y pos) y))))

(defn actor-can-move? [actor world x y]
  "Defines boundaries for actors"
  (and (>= x 0) (>= y 0)
       (< x (:width world)) (< y (:height world))))

; World
(defrecord World [actors width height])

(defn world-at [world x y]
  (filter (fn [[id actor]]
            (actor-at? actor x y))
          (:actors world)))

(defn world-step [world]
  "Makes a step in the world. Returns a new world state."
  (loop [world world
         actors-seq (:actors world)]
    (if (empty? actors-seq)
         world
         (let [[id actor] (first actors-seq)]
              ; executing action for each actor.
              (recur (actor-action actor world)
                     (rest actors-seq))))))

(defn world-create [width height]
  (World. (hash-map) width height))

(defn world-add-actor [world id actor]
  (assoc-in world [:actors id] (assoc actor :id id)))

(defn world-actor-neighbors [world actor]
  (let [{:keys [x, y]} (:pos actor)]
    (vals (world-at world x y))))

; Column
(defrecord Column [pos]
  Actor
  (actor-action [this world] world)) ; no action for a column.

(defn column-create [x y] (Column. {:x x :y y}))
(defn column? [actor] (instance? Column actor))

; Drunkard
(def drunkard-stuck-turns 5) ; Number of turns

(defn- drunkard-gen-move [x y]
  (let [move (rand-int 4)]
    (case move
          0 [(inc x) y]
          1 [(dec x) y]
          2 [x (inc y)]
          3 [x (dec y)])))

(defn- drunkard-move-random [actor world]
  (let [{:keys [x, y]} (:pos actor)]
    (loop [[nx ny] (drunkard-gen-move x y)]
      ; trying to move to random position
      (if-not (actor-can-move? actor world nx ny)
        (recur (drunkard-gen-move x y))
        (actor-move actor world nx ny)))))

(defn drunkard-stuck [actor world]
  (actor-update (assoc actor :stuck-turns drunkard-stuck-turns)
                world))

(defn drunkard-try-sober [actor world]
  (let [stuck-turns (:stuck-turns actor)]
    (actor-update
      (assoc actor :stuck-turns (dec stuck-turns))
      world)))

(defn drunkard-move [actor world]
  (let [new-world (drunkard-move-random actor world)
        new-actor (get-in new-world [:actors (:id actor)])
        neighbors (world-actor-neighbors new-world new-actor)]
    (if (some column? neighbors)
       (drunkard-stuck new-actor new-world) ; if the drunkard has bumped into a column - change its state.
       new-world)))                         ; otherwise, just return the world where drunkard is moved.

(defn- drunkard-stuck? [actor]
  (> (:stuck-turns actor) 0))

(defrecord Drunkard [pos stuck-turns]
  Actor
  (actor-action [this world]
    (if (drunkard-stuck? this)
      (drunkard-try-sober this world)
      (drunkard-move this world))))

(defn drunkard-create [x y]
  (Drunkard. {:x x :y y} 0))

(defn drunkard? [actor]
  (instance? Drunkard actor))

; Tavern
(defn tavern? [cell] false)

; Game funcs
(defn- game-init-column [world]
  (column-create
    (quot (:width world) 2) ; x = quotient of width / 2
    (quot (:height world) 2)))

(defn game-init-state [world]
  "Initialize initial game state in the world."
  (-> world
    (world-add-actor :column (game-init-column world))
    (world-add-actor :drunkard (drunkard-create 0 0))))

(defn game-start [world turns step-fn]
  (loop [world world
         turns-counter turns]
    (if-not (zero? turns-counter)
      (do (step-fn world)           ; calling the step callback
          (recur (world-step world) ; recursively looping & counting
                 (dec turns-counter))))))

; Console
(defn console-repr-actor [actor]
  "An actor representation for the console."
  (cond
    (drunkard? actor) "D"
    (column? actor) "C"
    (tavern? actor) "T"
    :else "."))

(defn console-world-draw [world]
  (do (doseq [y (range (:height world))]
        (doseq [x (range (:width world))]
          (let [[actor-id actor] (first (world-at world x y))]
            (print (console-repr-actor actor))))
        (print "\n"))
      (print "\n")))

(defn -main [& args]
  (let [turns 200
        world (game-init-state (world-create 15 15))]
    (game-start world turns console-world-draw)))