diamond-square.clj

(ns diamond-square
  (:require [clojure.string :as str]))

(defn average-of-coords
  "Calculate the average of a number of cells in a 2D doubles array.
Wraps around if coordinates are out of bounds."
  [^"[[D" arr coords]
  (let [|arr| (dec (alength arr))
        ;; use modulo to make the grid tiling
        coords (map (fn [[i j]] [(mod i |arr|) (mod j |arr|)]) coords)]
    (->> (for [[i j] coords] (aget ^doubles (aget  arr i) j))
         (reduce +)
         (* (/ 1.0 (count coords))))))

(defn average-of-diamond
"Relative coordinates in a square of width `len` for diamond coordinates,
e.g. the edges of the square."
  [len]
  [[0 0] [0 len] [len 0] [len len]])

(defn average-of-square
"Relative coordingates in a square of width `len` for square coordinates,
e.g. the locations in the middle of the four edges."
  [len]
  (let [half-len (/ len 2)]
    [[half-len  0]
     [half-len  len]
     [0         half-len]
     [len       half-len]]))

(defn set-center!
  "Set an entry in the middle of a square region of a 2D doubles array
to the average of the coordinates given by `relative-coords-fn` plus random noise."
  [arr x y len relative-coords-fn] 
  (let [half-len (/ len 2)
        coords (map (fn [[dx dy]] [(+ x dx) (+ y dy)]) (relative-coords-fn len))
        avg (average-of-coords arr coords)
        noise (* (Math/signum (- (rand) 0.5)) (rand len))]
    (aset-double ^doubles (aget ^"[[D" arr (+ x half-len))
                 (+ y half-len)
                 (+ noise avg))))


(defn step!
  "One step of the diamond-square algorithm."
  [arr x y len]
  (when (> len 1)
    (let [grid-size (dec (alength ^"[[D" arr))
          hl (/ len 2)]
      (doseq [x (range 0 grid-size len), y (range 0 grid-size len)]
        (set-center! arr x y len average-of-diamond))
      (doseq [x (range 0 grid-size len), y (range (- hl) grid-size len)]
        (set-center! arr x y len average-of-square))
      (doseq [x (range (- hl) grid-size len), y (range 0 grid-size len)]
        (set-center! arr x y len average-of-square))
      (recur arr x y (/ len 2)))))


(defn create-height-map
"Create a new height map using the diamond-square algorithm. Creates a 2D doubles array
of width 2^`power`+1. The height map is tiling, meaning it can be seamlessly
tiled horizontally and vertically."
  [power]
  (let [len (bit-shift-left 1 power)
        arr (make-array Double/TYPE (inc len) (inc len))]
    ; random values for the corners
    (doseq [x [0 len] y [0 len]]
      (aset-double arr x y (rand len)))
    (step! arr 0 0 len)    
    arr))


(defn cut-last-row-and-column
  "remove last column/row to make the dimensions pleasing powers of two :)"
  [arr]
  (butlast (mapv butlast arr)))


(defn tile-horizontally [arr]
  (for [row arr] (concat row row)))


(defn tile-vertically [arr]
  (concat arr arr))


(defn write-graymap-file
"Write height map as PGM file."
  [filename arr]  
  (let [values (apply concat arr)
        [mi ma] (apply (juxt min max) values)
        span (- ma mi)
        header (format "P2\n%d %d\n255\n" (count arr) (count (first arr)))
        body (map #(int (* 255 (/ (- % mi) span))) values)]
    (spit filename (str header (str/join " " body)))))

(comment
  (->> 8
       create-height-map
       cut-last-row-and-column
       tile-horizontally
       tile-vertically
       (write-graymap-file "d:/test.pgm")
       time)
  )