(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.core
  (:require [clojure.core.reducers :as r]
            [mw-engine.world :as world]
            [mw-engine.utils :refer [get-int-or-zero map-world]])
  (:gen-class))

(defn apply-rule
  ([world cell rule]
   (cond
     (ifn? rule) (apply-rule world cell rule nil)
     (seq? rule) (let [[afn src] rule] (apply-rule world cell afn src))))
  ([world cell rule source]
    (let [result (apply rule (list cell world))]
      (cond
        (and result source) (merge result {:rule source})
        true result))))

(defn- apply-rules
  [world cell rules]
  (cond (empty? rules) cell
    true (let [result (apply-rule world cell (first rules))]
           (cond result result
             true (apply-rules world cell (rest rules))))))

(defn- transform-cell
  [world cell rules]
  (try
    (merge
      (apply-rules world cell rules)
      {:generation (+ (get-int-or-zero cell :generation) 1)})
    (catch Exception e
      (merge cell {:error
                   (format "%s at generation %d when in state %s"
                           (.getMessage e)
                           (:generation cell)
                           (:state cell))
                   :stacktrace (map #(.toString %) (.getStackTrace e))
                   :state :error}))))

(defn transform-world
  [world rules]
  (map-world world transform-cell (list rules)))

(defn- transform-world-state
  [state]
  (let [world (transform-world (:world state) (:rules state))]
    ;;(world/print-world world)
    {:world world :rules (:rules state)}))

(defn run-world
  [world init-rules rules generations]
  (reduce (fn [world _iteration]
            (transform-world world rules))
        (transform-world world init-rules)
        (range generations)))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.display
  (:require [hiccup.core :refer [html]]
            mw-engine.utils
            mw-engine.world))

(defn format-css-class [state]
  "Format this `state`, assumed to be a keyword indicating a state in the
   world, into a CSS class"
  (subs (str state) 1))

(defn format-image-path
  [state]
  (format "img/tiles/%s.png" (format-css-class state)))

(defn format-mouseover [cell]
  (str cell))

(defn render-cell
  [cell]
  (let [state (:state cell)]
    [:td {:class (format-css-class state) :title (format-mouseover cell)}
     [:a {:href (format "inspect?x=%d&y=%d" (:x cell) (:y cell))}
      [:img {:alt (:state cell) :width 32 :height 32 :src (format-image-path state)}]]]))

(defn render-world-row
  [row]
  (apply vector (cons :tr (map render-cell row))))

(defn render-world-table
  [world]
  (apply vector
    (cons :table
      (map render-world-row world))))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.drainage
  (:require [mw-engine.core :refer [run-world]]
            [mw-engine.heightmap :as heightmap]
            [mw-engine.utils :refer [get-int-or-zero get-least-cell get-neighbours
                                     get-neighbours-with-property-value
                                     map-world]]))

(def ^:dynamic *sealevel* 10)

(declare flow)

(defn rainfall
  [gradient remaining map-width]
    (cond
      ;; if there's no rain left in the cloud, it can't fall;
      (zero? remaining)
      0
      (pos? gradient)
      ;; rain, on prevailing westerly wind, falls preferentially on rising ground;
      (int (rand gradient))
      ;; rain falls randomly across the width of the map...
      (zero? (int (rand map-width))) 1
      :else
      0))

(defn rain-row
  ([row]
   (rain-row row 1))
  ([row rain-probability]
   (rain-row row (count row) 0 (int (* (count row) rain-probability))))
  ([row map-width previous-altitude drops-in-cloud]
   (cond
     (empty? row) nil
     (pos? drops-in-cloud)
     (let [cell (first row)
           alt (or (:altitude cell) 0)
           rising (- alt previous-altitude)
           fall (rainfall rising drops-in-cloud map-width)]
       (cons
         (assoc cell :rainfall fall)
         (rain-row (rest row) map-width alt (- drops-in-cloud fall))))
     :else
     (map
       #(assoc % :rainfall 0)
       row))))

(defn rain-world
  [world]
  (map
    rain-row
    world))

(defn flow-contributors
  [cell world]
  (filter #(map? %)
          (map
            (fn [n]
              (cond
                (= cell (get-least-cell (get-neighbours world n) :altitude)) n
                (and (= (:altitude cell) (:altitude n))
                     (> (or (:flow n) 0) (or (:flow cell) 0))) n))
            (get-neighbours-with-property-value
              world (:x cell) (:y cell) 1 :altitude
              (or (:altitude cell) 0) >=))))

(defn is-hollow
  [world cell]
  ;; quicker to count the elements of the list and compare equality of numbers
  ;; than recursive equality check on members, I think. But worth benchmarking.
  (let [neighbours (get-neighbours world cell)
        altitude (get-int-or-zero cell :altitude)]
    (= (count neighbours)
       (count (get-neighbours-with-property-value
                world (:x cell) (:y cell) 1 :altitude altitude >)))))

(defn flood-hollow
  ([world cell neighbours]
    (let [lowest (get-least-cell neighbours :altitude)]
      (merge cell {:state :water :altitude (:altitude lowest)})))
  ([world cell]
    (flood-hollow world cell (get-neighbours world cell))))

(defn flood-hollows
  [world]
  (map-world world
             #(if (is-hollow %1 %2) (flood-hollow %1 %2) %2)))

(def max-altitude 255)

(defn flow-nr
  [cell world]
  (if (= (- max-altitude (get-int-or-zero cell :generation))
         (get-int-or-zero cell :altitude))
    (merge cell
           {:flow (reduce +
                          (map
                            #(+ (get-int-or-zero % :rainfall)
                                (get-int-or-zero % :flow))
                            (flow-contributors cell world)))})))

(def flow
  (memoize
   (fn [cell world]
     (cond
      (not (nil? (:flow cell))) cell
      (<= (or (:altitude cell) 0) *sealevel*) cell
      true
      (merge cell
             {:flow (+ (:rainfall cell)
                       (apply +
                              (map (fn [neighbour] (:flow (flow neighbour world)))
                                   (flow-contributors cell world))))})))))

(defn flow-world-nr
  [world]
  (run-world world nil (list flow-nr) max-altitude))

(defn flow-world
  [world]
  (map-world (rain-world world) flow))

(defn explore-lake
  [world cell])

(defn is-lake?
  [world cell]
  (if
    ;; if it's already tagged as a lake, it's a lake
    (:lake cell) cell
    (let
      [outflow (min (map :altitude (get-neighbours world cell)))]
      (if-not
        (> (:altitude cell) outflow)
        (assoc cell :lake true)))))

(defn find-lakes
  [world])

(defn run-drainage
  [hmap]
  "Create a world from the heightmap `hmap`, rain on it, and then compute river
   flows."
  (flow-world (rain-world (flood-hollows (heightmap/apply-heightmap hmap)))))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.heightmap
  (:import [java.awt.image BufferedImage])
  (:require [fivetonine.collage.util :as collage :only [load-image]]
            [mikera.image.core :as imagez :only [filter-image get-pixels]]
            [mikera.image.filters :as filters]
            [mw-engine.utils :refer [abs get-int get-neighbours map-world]]
            [mw-engine.world :refer [make-world]]))

(defn tag-property
  ([world cell property heightmap]
    (tag-property cell property heightmap))
  ([cell property heightmap]
    (merge cell
           {property
            (+ (get-int cell property)
               (- 256
                  (abs
                    (mod
                      (.getRGB heightmap
                        (get-int cell :x)
                        (get-int cell :y)) 256))))})))

(defn tag-gradient
  [world cell]
  (let [heights (remove nil? (map :altitude (get-neighbours world cell)))
        highest (cond (empty? heights) 0 ;; shouldn't happen
                  true (apply max heights))
        lowest (cond (empty? heights) 0 ;; shouldn't
                 true (apply min heights))
        gradient (- highest lowest)]
    (merge cell {:gradient gradient})))

(defn tag-gradients
  [world]
  (map-world world tag-gradient))

(defn tag-altitude
  ([world cell heightmap]
    (tag-property cell :altitude heightmap))
  ([cell heightmap]
    (tag-property cell :altitude heightmap)))

(defn apply-heightmap
  ([world imagepath]
    (let [heightmap (imagez/filter-image
                      (filters/grayscale)
                      (collage/load-image imagepath))]
      (map-world
        (map-world world tag-altitude (list heightmap))
        tag-gradient)))
   ([imagepath]
    (let [heightmap (imagez/filter-image
                      (filters/grayscale)
                      (collage/load-image imagepath))
          world (make-world (.getWidth heightmap) (.getHeight heightmap))]
      (map-world
        (map-world world tag-altitude (list heightmap))
        tag-gradient))))

(defn apply-valuemap
  [world imagepath property]
    (let [heightmap (imagez/filter-image
                      (filters/grayscale)
                      (collage/load-image imagepath))]
      (map-world world tag-property (list property heightmap))))

(ns ^{:doc 
       :author "Simon Brooke"}
  mw-engine.natural-rules
  (:require [mw-engine.utils :refer :all]
        [mw-engine.world :refer :all]))

(def treeline 150)

(def waterline 10)

(def snowline 200)

(def lightning-probability 500)

(def vegetation-rules
  (list
    ;; Randomly, birds plant tree seeds into grassland.
    (fn [cell world] (cond (and (= (:state cell) :grassland)(< (rand 10) 1))(merge cell {:state :heath})))
    ;; heath below the treeline grows gradually into forest, providing browsing pressure is not to high
    (fn [cell world]
      (cond (and
              (= (:state cell) :heath)
              ;; browsing limit really ought to vary with soil fertility, but...
              (< (+ (get-int cell :deer)(get-int cell :sheep)) 6)
              (< (get-int cell :altitude) treeline))
        (merge cell {:state :scrub})))
    (fn [cell world] (cond (= (:state cell) :scrub) (merge cell {:state :forest})))
    ;; Forest on fertile land grows to climax
    (fn [cell world]
      (cond
        (and
          (= (:state cell) :forest)
          (> (get-int cell :fertility) 10))
        (merge cell {:state :climax})))
    ;; Climax forest occasionally catches fire (e.g. lightning strikes)
    (fn [cell world] (cond (and (= (:state cell) :climax)(< (rand lightning-probability) 1)) (merge cell {:state :fire})))
    ;; Climax forest neighbouring fires is likely to catch fire
    (fn [cell world]
      (cond
        (and (= (:state cell) :climax)
             (< (rand 3) 1)
             (not (empty? (get-neighbours-with-state world (:x cell) (:y cell) 1 :fire))))
        (merge cell {:state :fire})))
    ;; After fire we get waste
    (fn [cell world] (cond (= (:state cell) :fire) (merge cell {:state :waste})))
    ;; And after waste we get pioneer species; if there's a woodland seed
    ;; source, it's going to be heath, otherwise grassland.
    (fn [cell world]
      (cond
        (and (= (:state cell) :waste)
             (not
               (empty?
                 (flatten
                   (list
                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :scrub)
                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :forest)
                     (get-neighbours-with-state world (:x cell) (:y cell) 1 :climax))))))
        (merge cell {:state :heath})))
    (fn [cell world]
      (cond (= (:state cell) :waste)
        (merge cell {:state :grassland})))
    ;; Forest increases soil fertility
    (fn [cell world]
      (cond (member? (:state cell) '(:forest :climax))
        (merge cell {:fertility (+ (get-int cell :fertility) 1)})))))

(def herbivore-rules
  (list
    ;; if there are too many deer for the fertility of the area to sustain,
    ;; some die or move on.
    (fn [cell world]
      (cond (> (get-int cell :deer) (get-int cell :fertility))
        (merge cell {:deer (get-int cell :fertility)})))
    ;; deer arrive occasionally at the edge of the map.
    (fn [cell world]
      (cond (and (< (count (get-neighbours world cell)) 8)
                 (< (rand 50) 1)
                 (> (get-int cell :fertility) 0)
                 (= (get-int cell :deer) 0))
        (merge cell {:deer 2})))
    ;; deer gradually spread through the world by breeding or migrating.
    (fn [cell world]
      (let [n (apply + (map #(get-int % :deer) (get-neighbours world cell)))]
        (cond (and
                (> (get-int cell :fertility) 0)
                (= (get-int cell :deer) 0)
                (>= n 2))
          (merge cell {:deer (int (/ n 2))}))))
    ;; deer breed.
    (fn [cell world]
      (cond
        (>= (get-int cell :deer) 2)
        (merge cell {:deer (int (* (:deer cell) 2))})))))

  (def predator-rules
    (list
     ;; wolves eat deer
     (fn [cell world]
      (cond
       (>= (get-int cell :wolves) 1)
       (merge cell {:deer (max 0 (- (get-int cell :deer) (get-int cell :wolves)))})))
;;      ;; not more than eight wolves in a pack, for now (hack because wolves are not dying)
;;      (fn [cell world]
;;        (cond (> (get-int cell :wolves) 8) (merge cell {:wolves 8})))
    ;; if there are not enough deer to sustain the get-int of wolves,
    ;; some wolves die or move on. (doesn't seem to be working?)
    (fn [cell world]
       (cond (> (get-int cell :wolves) (get-int cell :deer))
         (merge cell {:wolves 0})))
    ;; wolves arrive occasionally at the edge of the map.
    (fn [cell world]
      (cond (and (< (count (get-neighbours world cell)) 8)
                 (< (rand 50) 1)
                 (not (= (:state cell) :water))
                 (= (get-int cell :wolves) 0))
        (merge cell {:wolves 2})))
    ;; wolves gradually spread through the world by breeding or migrating.
    (fn [cell world]
      (let [n (apply + (map #(get-int % :wolves) (get-neighbours world cell)))]
        (cond (and
                (not (= (:state cell) :water))
                (= (get-int cell :wolves) 0)
                (>= n 2))
          (merge cell {:wolves 2}))))
    ;; wolves breed.
    (fn [cell world]
      (cond
        (>= (get-int cell :wolves) 2)
        (merge cell {:wolves (int (* (:wolves cell) 2))})))))

  (def init-rules
    (list
     ;; below the waterline, we have water.
     (fn [cell world]
       (cond (and (= (:state cell) :new) (< (get-int cell :altitude) waterline)) (merge cell {:state :water})))
     ;; above the snowline, we have snow.
     (fn [cell world]
       (cond (and (= (:state cell) :new) (> (get-int cell :altitude) snowline)) (merge cell {:state :snow})))
     ;; in between, we have a wasteland.
     (fn [cell world] (cond (= (:state cell) :new) (merge cell {:state :grassland})))))

(def natural-rules (flatten
                    (list
                     vegetation-rules
                     herbivore-rules
                     predator-rules)))

(ns ^{:doc 
      :author "Simon Brooke"}
  mw-engine.utils
  (:require
    [clojure.math.combinatorics :as combo]))

(defn abs
  [n]
  (if (neg? n) (- 0 n) n))

(defn member?
  [elt col] (some #(= elt %) col))

(defn get-int-or-zero
  [map property]
  (let [value (map property)]
    (if (integer? value) value 0)))

(defn init-generation
  [world cell]
  (merge cell {:generation (get-int-or-zero cell :generation)}))

(defn in-bounds
  [world x y]
  (and (>= x 0)(>= y 0)(< y (count world))(< x (count (first world)))))

(defn map-world-n-n
  ([world function]
    (map-world-n-n world function nil))
  ([world function additional-args]
    (into []
           (map (fn [row]
                    (into [] (map
                             #(apply function
                                     (cons world (cons % additional-args)))
                             row)))
                  world))))

(defn map-world-p-p
  ([world function]
    (map-world-p-p world function nil))
  ([world function additional-args]
    (into []
           (pmap (fn [row]
                    (into [] (pmap
                             #(apply function
                                     (cons world (cons % additional-args)))
                             row)))
                  world))))

(defn map-world
  ([world function]
    (map-world world function nil))
  ([world function additional-args]
    (into []
           (pmap (fn [row]
                    (into [] (map
                             #(apply function
                                     (cons world (cons % additional-args)))
                             row)))
                  world))))

(defn get-cell
  [world x y]
  (cond (in-bounds world x y)
    (nth (nth world y) x)))

(defn get-int
  [map key]
  (cond (map? map)
    (let [v (map key)]
      (cond (and v (integer? v)) v
            true 0))
        true (throw (Exception. "No map passed?"))))

(defn population
  [cell species]
  (get-int cell species))

(def memo-get-neighbours
  (memoize
   (fn [world x y depth]
     (remove nil?
             (map #(get-cell world (first %) (first (rest %)))
                  (remove #(= % (list x y))
                          (combo/cartesian-product
                            (range (- x depth) (+ x depth 1))
                            (range (- y depth) (+ y depth 1)))))))))

(defn get-neighbours
    ([world x y depth]
      (remove nil?
             (map #(get-cell world (first %) (first (rest %)))
                  (remove #(= % (list x y))
                          (combo/cartesian-product
                            (range (- x depth) (+ x depth 1))
                            (range (- y depth) (+ y depth 1)))))))
    ([world cell depth]
      (memo-get-neighbours world (:x cell) (:y cell) depth))
    ([world cell]
      (get-neighbours world cell 1)))

(defn get-neighbours-with-property-value
  ([world x y depth property value op]
    (filter
      #(eval
         (list op
               (or (get % property) (get-int % property))
               value))
      (get-neighbours world x y depth)))
  ([world x y depth property value]
    (get-neighbours-with-property-value world x y depth property value =))
  ([world cell depth property value]
    (get-neighbours-with-property-value world (:x cell) (:y cell) depth
                                        property value))
  ([world cell property value]
    (get-neighbours-with-property-value world cell 1
                                        property value)))

(defn get-neighbours-with-state
  ([world x y depth state]
    (filter #(= (:state %) state) (get-neighbours world x y depth)))
  ([world cell depth state]
    (get-neighbours-with-state world (:x cell) (:y cell) depth state))
  ([world cell state]
    (get-neighbours-with-state world cell 1 state)))

(defn get-least-cell
  ([cells property default]
  (cond
   (empty? cells) nil
   true (let [downstream (get-least-cell (rest cells) property default)]
          (cond (<
                 (or (property (first cells)) default)
                 (or (property downstream) default)) (first cells)
                true downstream))))
  ([cells property]
   (get-least-cell cells property (Integer/MAX_VALUE))))

(defn- set-cell-property
  [cell x y property value]
  (cond
    (and (= x (:x cell)) (= y (:y cell)))
    (merge cell {property value :rule "Set by user"})
    true
    cell))

(defn set-property
  ([world cell property value]
    (set-property world (:x cell) (:y cell) property value))
  ([world x y property value]
    (apply
      vector ;; we want a vector of vectors, not a list of lists, for efficiency
      (map
        (fn [row]
          (apply
            vector
            (map #(set-cell-property % x y property value)
                 row)))
        world))))

(defn merge-cell
  [world cell]
  (if (in-bounds world (:x cell) (:y cell))
    (map-world world
               #(if
                  (and
                    (= (:x cell)(:x %2))
                    (= (:y cell)(:y %2)))
                  (merge %2 cell)
                  %2))
    world))

(ns ^{:doc 
       :author "Simon Brooke"}
  mw-engine.world
	(:require [clojure.string :as string :only [join]]
            [mw-engine.utils :refer [population]]))

(defn- make-cell
  [x y]
  {:x x :y y :state :new})

(defn- make-world-row
  [index width height]
  (cond (= index width) nil
    true (cons (make-cell index height)
               (make-world-row (inc index) width height))))

(defn- make-world-rows
  [index width height]
  (cond (= index height) nil
    true (cons (apply vector (make-world-row 0 width index))
               (make-world-rows (inc index) width height))))

(defn make-world
  [width height]
  (apply vector (make-world-rows 0 width height)))

(defn truncate-state
  [cell limit]
  (let [s (:state cell)]
    (cond (> (count (str s)) limit) (subs s 0 limit)
      true s)))

(defn format-cell
  [cell]
  (format "%10s(%2d/%2d)"
          (truncate-state cell 10)
          (population cell :deer)
          (population cell :wolves)))

(defn- format-world-row
  [row]
  (string/join (map format-cell row)))

(defn print-world
  [world]
  (println)
  (dorun
    (map
      #(println
         (format-world-row %))
      world))
  nil)