Created
March 13, 2015 07:21
-
-
Save lokedhs/d5348c4a221e1436000b to your computer and use it in GitHub Desktop.
Simplex noise generator
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun make-simplex-noise-generator () | |
(flet ((dot-prod (g x y) | |
(declare (optimize (speed 3) (safety 1)) | |
(type (simple-vector 3) g) | |
(type double-float x y)) | |
(+ (* (the (double-float -1d0 1d0) (aref g 0)) x) | |
(* (the (double-float -1d0 1d0) (aref g 1)) y)))) | |
(let ((grad3 #(#(1d0 1d0 0d0) #(-1d0 1d0 0d0) #(1d0 -1d0 0d0) #(-1d0 -1d0 0d0) | |
#(1d0 0d0 1d0) #(-1d0 0d0 1d0) #(1d0 0d0 -1d0) #(-1d0 0d0 -1d0) | |
#(0d0 1d0 1d0) #(0d0 -1d0 1d0) #(0d0 1d0 -1d0) #(0d0 -1d0 -1d0))) | |
(p (make-array 256 :element-type '(integer 0 255)))) | |
(map-into p #'(lambda () (random 256))) | |
#'(lambda (xin yin) | |
(declare (optimize (speed 3) (safety 1))) | |
(check-type xin double-float) | |
(check-type yin double-float) | |
(let* ((f2 (* 0.5d0 (1- (sqrt 3d0)))) | |
(s (* (+ xin yin) f2)) | |
(i (truncate (the (double-float -1000d0 1000d0) (+ xin s)))) | |
(j (truncate (the (double-float -1000d0 1000d0) (+ yin s)))) | |
(g2 (/ (- 3 (sqrt 3d0)) 6)) | |
(tz (* (+ i j) g2)) | |
(x0u (- i tz)) | |
(y0u (- j tz)) | |
(x0 (- xin x0u)) | |
(y0 (- yin y0u)) | |
;; Determine simplex | |
(i1 (if (> x0 y0) 1 0)) | |
(j1 (if (> x0 y0) 0 1)) | |
(x1 (+ (- x0 i1) g2)) | |
(y1 (+ (- y0 j1) g2)) | |
(x2 (+ (1- x0) (* g2 2))) | |
(y2 (+ (1- y0) (* g2 2))) | |
;; Hashed gradient | |
(ii (logand i 255)) | |
(jj (logand j 255)) | |
(gi0 (mod (aref p (mod (+ ii (aref p jj)) 256)) 12)) | |
(gi1 (mod (aref p (mod (+ ii i1 (aref p (mod (+ jj j1) 256))) 256)) 12)) | |
(gi2 (mod (aref p (mod (+ ii 1 (aref p (mod (+ jj 1) 256))) 256)) 12)) | |
;; Corner contribution | |
(t0 (- 0.5d0 (* x0 x0) (* y0 y0))) | |
(n0 (if (minusp t0) | |
0d0 | |
(let ((t0n (* t0 t0))) | |
(* t0n t0n (dot-prod (aref grad3 gi0) x0 y0))))) | |
(t1 (- 0.5d0 (* x1 x1) (* y1 y1))) | |
(n1 (if (minusp t1) | |
0d0 | |
(let ((t1n (* t1 t1))) | |
(* t1n t1n (dot-prod (aref grad3 gi1) x1 y1))))) | |
(t2 (- 0.5d0 (* x2 x2) (* y2 y2))) | |
(n2 (if (minusp t2) | |
0d0 | |
(let ((t2n (* t2 t2))) | |
(* t2n t2n (dot-prod (aref grad3 gi2) x2 y2)))))) | |
(* 70 (+ n0 n1 n2))))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment