Naive Perlin noise implementation



(this space intentionally left almost blank)
(ns ^:figwheel-always noise.core

Perlin Noise (naive & slow implementation)


Perlin noise is "pseudo-random" noise, which gives it a more organic look than truly random noise, because the noise function will be similar for two nearby points. This is accomplished by placing a grid on a coordinate plane and associating random vectors with each intersection point on the grid. For each point in the plane, its value is a function of the dot product between a set of vectors from the points to each corner of its bounding box, and the pseudorandom gradients associated with those corners.

generate 8 random gradients

(def gradients
  (vec (take 8 (repeatedly (fn []
                             (let [x (rand)
                                   y (rand)
                                   mult (if (> (rand) (rand)) 1.0 -1.0)
                                   mult2 (if (> (rand) (rand)) 1.0 -1.0)]
                               [(* x mult) (* y mult2)]))))))

find the gradient associated with a corner of a grid cell. This stands in for the hash function in the real implementation, and the purpose is to map data of arbitrary size to data of fixed size (our 8 random gradients). I think this, along with the dot function, account for the slowness. The theoretical explanations all involve the dot product but I don't understand how it's implemented in most real implentations, including Ken Perlin's Java reference implementation.

(defn get-gradient 
  [[a b]]
  (let [ndx (int (mod (+ a b) 7))]
    (get gradients ndx)))

for a given point, find the corners of the bounding box (grid cell) it is contained within

(defn get-corners
  [x y]
  (let [nw [(- x (mod x 100)) (- y (mod y 100))]
        [x y] nw
        ne [(+ 100 x) y]
        sw [x (+ 100 y)]
        se [(+ 100 x) (+ 100 y)]]
    [nw ne sw se]))

vector dot product

(defn dot
  [X Y]
  (reduce + (map * X Y)))

linear interpolation function

(defn lerp
  [t a b]
  (+ a (* t (- b a))))
(defn ease
  (- (* 3 (.pow js/Math t 2))
     (* 2 (.pow js/Math t 3))))

find the gradients of each corner of the bounding box

(defn corner-gradients
  [x y]
  (map get-gradient (get-corners x y)))

find the vectors from the point to the bounding box corners

(defn corner-to-point-vectors
  [x y]
  (map (fn [[cx cy]] [(- x cx) (- y cy)])
       (get-corners x y)))

compute the 'influences' of the corner gradients, by taking the dot product of the corner gradient and the vector from the point to that corner

(defn influences
  [x y]
  (let [gs (corner-gradients x y)
        vs (corner-to-point-vectors x y)]
    (map dot gs vs)))

compute the noise function value for a given pixel

(defn noise
  [x y]
  (let [
        ;;situate the point within a unit square
        rel-x (/ x 100)
        rel-y (/ y 100)
        ;;find the coordinates within the unit square
        frac-x (mod rel-x 1)
        frac-y (mod rel-y 1)
        ;;exaggerate proximity to corner
        Sx (ease frac-x)
        Sy (ease frac-y)
        ;;compute influences of corner gradients
        [nw ne sw se] ((fn []
                         (influences x y)))
        ;;linearly interpolate between the exaggerated point the "influenced" point
        a (lerp Sx nw ne)
        b (lerp Sx sw se)
        z (lerp Sy a b)]
    ;;I forgot why this was needed :(
    (.abs js/Math (/ z 10))))

drawing related stuff

multiplication by 40 is just so the gradients are visible on the drawn grid

(defn xPlusGrad [x y]
  (+ x (* 40 (first (get-gradient [x y])))))
(defn yPlusGrad [x y]
  (+ y (* 40 (second  (get-gradient [x y])))))

helper function to draw a stroke on the canvas

(defn stroke
  [ctx {:keys [startx starty endx endy]}]
  (.beginPath ctx)
  (.moveTo ctx startx starty)
  (.lineTo ctx endx endy)
  (.stroke ctx))

draw the grid which shows the corner vectors and vectors to corners for an example point

(defn drawGrid
  (let [canvas (.getElementById js/document "surface")
        ctx (.getContext canvas "2d")]
    (set! (.-strokeStyle ctx) "blue")
    ;; crisper lines on the canvas
    (.translate ctx 0.5 0.5)
    (doseq [n (range 100 500 100)]
      (stroke ctx
              { :startx 100 :starty n
                :endx 400 :endy n })
      (stroke ctx
              { :startx n :starty 100
                :endx n :endy 400 }))))

draw the corner gradients on the example grid

(defn drawGradients
  (let [canvas (.getElementById js/document "surface")
        ctx (.getContext canvas "2d")]
    (set! (.-strokeStyle ctx) "red")
    (doseq [x (range 100 500 100)]
      (doseq [y (range 100 500 100)]
        (stroke ctx
                {:startx x :starty y
                 :endx (xPlusGrad x y) :endy (yPlusGrad x y) })))))

draw the example point on the grid

(defn drawPoint
  (let [canvas (.getElementById js/document "surface")
        ctx (.getContext canvas "2d")]
    (set! (.-strokeStyle ctx) "green")
    (.fillRect ctx 221 139 3 3)))

draw the vectors from the point to the corners of its bounding box

(defn drawPointVectors
  (let [canvas (.getElementById js/document "surface")
        ctx (.getContext canvas "2d")
        x 221
        y 139]
    (set! (.-strokeStyle ctx) "pink")
    (doseq [[cx cy] (get-corners x y)]
      (stroke ctx
              {:startx cx :starty cy
               :endx x :endy y }))))

draw a canvas with the noise function computed for each pixel

(defn drawNoiseCanvas
  (let [canvas (.getElementById js/document "noise")
        ctx (.getContext canvas "2d")]
    (doseq [x (range 100 400)
            y (range 100 400)
            :let [n  (int (* 256 (noise x y)))
                  color (str "rgb(" n "," n "," n ")")]]
      (set! (.-fillStyle ctx) color)
      (.fillRect ctx x y 1 1))))