gistfile1.clj

(ns world.gen)

(defn rrange [mn mx]
  (+ (* (rand)
        (- mx mn))
     mn))

(defn printmatrix [matrix]
  (print(reduce str(for [x matrix] (str (reduce str(for [y x]  (if (= y nil)0 1))) "\n")))) matrix)

(defn wrap [v mx]
  (if (< v 0)
    (wrap (+ mx v) mx)
    (mod v mx)))

(defn seedmap [width height featuresize scale]
  "Generate a width*height 2D map seeded with 2*scale random values at an interval of featuresize."
  (vec (map (fn [x]
        (vec (map (fn [y]
              (if (and (= (wrap x featuresize) 0) (= (wrap y featuresize) 0))
               (rrange 0 (* scale 2))
               nil))
         (range height))))
   (range width))))

(defn sample [matrix x y width height]
  "Gets a sample at x,y from the matrix (wraps around)."
  (nth (nth matrix (wrap x width)) (wrap y height)))

(defn setsample [matrix x y width height value]
  (assoc matrix (wrap x width) (assoc (nth matrix (wrap x width)) (wrap y height) value)))

(defn square [matrix x y width height size value]
  "Makes a matrix with a square sample at x,y"
  (let [size2 (/ size 2)
        a (sample matrix (- x size2) (- y size2) width height)
        b (sample matrix (+ x size2) (+ y size2) width height)
        c (sample matrix (- x size2) (+ y size2) width height)
        d (sample matrix (+ x size2) (+ y size2) width height)]
   (setsample matrix x y width height (+ (/ (+ a b c d) 4) value))))

(defn diamond [matrix x y width height size value]
  "Makes a matrix with a diamond sample at x,y"
  (let [size2 (/ size 2)
        a (sample matrix x (- y size2) width height)
        b (sample matrix (+ x size2) y width height)
        c (sample matrix x (+ y size2) width height)
        d (sample matrix (- x size2) y width height)]
   (setsample matrix x y width height (+ (/ (+ a b c d) 4) value))))

(defn sampleall [matrix width height size scale startx starty func]
  (let [size2 (/ size 2)]
   (loop [mtx matrix
          x startx]
    (if (< x (+ width startx))
     (recur
     ; For each x sample, compute all y samples in that column
      (loop [mty mtx
             y starty]
       (if (< y (+ height starty))
        (recur
         (func mty x y width height size (rrange (- scale) scale))
         (+ y size))
        mty))
      (+ x size) )
    mtx))))

(defn sampleround [matrix width height size scale]
  (let [size2 (/ size 2)]
   (sampleall
    (sampleall matrix width height size scale size2 size2
     (fn [mt x y w h s v] (square mt x y w h s v)))
    width height size scale 0 0
    (fn [mt x y w h s v] (diamond
                          (diamond mt (+ x (/ s 2)) y width height s v)
                          x (+ y (/ s 2)) width height s v)))))

(defn normalize [dmap]
  (let [ maxv (apply max (flatten dmap))
         minv (apply min (flatten dmap)) ]
    (vec (map (fn [x] (vec (map (fn [y] (/ (- y minv) (- maxv minv))) x))) dmap))))

(defn diamondsquare [width height featuresize scale scalefactor]
  "Format: vec< vec< double > > width*height"
  (loop [matrix (seedmap width height featuresize scale)
         fs featuresize
         sc scale]
   (if (> fs 1)
    (recur (sampleround matrix width height fs sc) (/ fs 2) (/ sc scalefactor))
    (normalize matrix))))


(println (diamondsquare 16 16 4 1 2) )
;(printmatrix (seedmap 16 16 4 1))