(ns mw-engine.core
  (:use mw-engine.utils)
  (:require [mw-engine.world :as world]))

(defn apply-rule 
  ([world cell rule]
   (cond
     (ifn? rule) (apply-rule cell world rule nil)
     (seq? rule) (let [[afn src] rule] (apply-rule cell world afn src))))
  ([cell world 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 (+ (or (:generation cell) 0) 1)})
    (catch Exception e 
      (merge cell {:error 
                   (format "%s at generation %d when in state %s"
                           (.getMessage e)
                           (:generation cell)
                           (:state cell))
                   :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]
  (let [state {:world (transform-world world init-rules) :rules rules}]
    (take generations (iterate transform-world-state state))))

(ns mw-engine.heightmap
  (:import [java.awt.image BufferedImage])
  (:use mw-engine.utils
        mw-engine.world
        [mikera.image.core :only [load-image filter-image get-pixels]]
        [mikera.image.filters]))

(defn- abs 
  [n]
  (cond (< n 0) (- 0 n) true n))

(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-altitude cell heightmap))
  ([cell heightmap]
    (merge cell
           {:altitude
            (+ (get-int cell :altitude)
               (- 256
                  (abs
                    (mod
                      (.getRGB heightmap
                        (get-int cell :x)
                        (get-int cell :y)) 256))))})))

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

(ns mw-engine.manifest)

(def manifest {
             :build-signature {
                               :build-signture-version "0.1.2-SNAPSHOT"
                               :build-signature-user "unset"
                               :build-signature-email "unset"
                               :build-signature-timestamp "unset"
             ;; NOTE: it's important that the closing brace not be on the same
             ;; line as the build-signature fields, because of how the buildall 
             ;; script constructs the build signature.
             }
             })

(ns mw-engine.natural-rules
  (:use mw-engine.utils
        mw-engine.world))

(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 mw-engine.utils
  (:require [clojure.math.combinatorics :as combo]))

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

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

(defn map-world 
  ([world function]
    (map-world world function nil))
  ([world function additional-args]
    (apply vector ;; vectors are more efficient for scanning, which we do a lot.
         (for [row world]
           (apply vector 
                  (map #(apply function (cons world (cons % additional-args))) 
                       row))))))

(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))

(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] 
      "Get the neighbours to distance depth of this cell in this world.
      * `world` a world, as described in world.clj;
      * `cell` a cell within that world;
      * `depth` an integer representing the distance from [x,y] that
        should be searched."
      (get-neighbours world (:x cell) (:y cell) depth))
    ([world cell]
      "Get the immediate neighbours of this cell in this world
      * `world` a world, as described in world.clj;
      * `cell` a cell within that world."
      (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- 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))))

(ns mw-engine.version
  (:gen-class))

(defn get-implementation-version 
  [namespace-class]
  (.getImplementationVersion (.getPackage namespace-class)))

(defn -main []
  (get-implementation-version (eval 'mw-engine.version)))

(ns mw-engine.world
  (:use mw-engine.utils))

(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 (+ index 1) width height))))

(defn- make-world-rows [index width height]
  "Make the (remaining) rows in a world of this width and height, from this
   index.
  * `index` y coordinate of the next row to be created;
  * `width` total width of the matrix, in cells;
  * `height` total height of the matrix, in cells."
  (cond (= index height) nil
    true (cons (apply vector (make-world-row 0 width index))
               (make-world-rows (+ index 1) 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 (.toString s)) 10) (subs s 0 10)
      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]
  (apply str
         (map format-cell row)))

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