#lang racket/base

; Noise library
; A noise is a vector whose values are between -1.0 and 1.0
(require
  racket/list)

(provide
  make-noise
  noise-value
  noise-gradient-value
  noise-fractal-value
  noise-gradient-fractal-value)

; Structure
(struct s-noise
  (dimensions ; number of dimensions of the noise
   nb-samples ; number of samples along a dimension
   samples ; vector of samples
   ))

; Create a random noise
(define (make-noise dimensions nb-samples)
  (s-noise
    dimensions
    nb-samples
    (build-vector
      (expt nb-samples dimensions)
      (lambda (i)
        (- (* 2.0 (random)) 1.0)))))

; Get the value of a noise at a given coordinate
; Note: the coordinates must be integral
; 1 dimension
(define (1d-noise-value ns x)
  (vector-ref (s-noise-samples ns) (modulo x (s-noise-nb-samples ns))))
; 2 dimensions
(define (2d-noise-value ns x y)
  (define nb-samples (s-noise-nb-samples ns))
  (vector-ref
    (s-noise-samples ns)
    (+ (modulo x nb-samples)
       (* nb-samples (modulo y nb-samples)))))
; 3 dimensions
(define (3d-noise-value ns x y z)
  (define nb-samples (s-noise-nb-samples ns))
  (vector-ref
    (s-noise-samples ns)
    (+ (modulo x nb-samples)
       (* nb-samples (modulo y nb-samples))
       (* nb-samples nb-samples (modulo z nb-samples)))))
; For any dimension
(define (nd-noise-value ns . coords)
  (define dim-coords (length coords))
  (define dim-noise (s-noise-dimensions ns))
  (define nb-samples (s-noise-nb-samples ns))
  (define point
    (cond
      ((eq? dim-coords dim-noise) coords)
      ((< dim-noise dim-coords) (take coords dim-noise))
      (#t (append coords (make-list (- dim-noise dim-coords) 0)))
      ))
  (define index
    (foldl
      (lambda (coord dim res)
        (+ res (* (modulo coord nb-samples) (expt nb-samples dim))))
      0
      point
      (build-list dim-noise values)))
  (vector-ref (s-noise-samples ns) index))
;
(define (noise-value ns . coords)
  (define dim (length coords))
  (cond
    ((eq? dim 1) (1d-noise-value ns (car coords)))
    ((eq? dim 2) (2d-noise-value ns (car coords) (cadr coords)))
    ((eq? dim 3) (3d-noise-value ns (car coords) (cadr coords) (caddr coords)))
    (#t (apply nd-noise-value ns coords))))

; Gradient noise
; The idea is to scale the coordinates by the number of samples and interpolate the value between 2^n adjacent samples (n is the number of dimensions)

; Interpolation
(define (lerp t A B)
  (+ A (* t (- B A))))
; Smooth interpolation
(define (smoothstep t A B)
  (lerp (* t t (- 3 (* 2 t))) A B))

; 1d gradient noise
(define (1d-gradient-noise ns x)
  (define nb-samples (s-noise-nb-samples ns))
  (define xx (quotient x nb-samples))
  (define tx (/ (remainder x nb-samples) nb-samples))
  (smoothstep
    tx
    (1d-noise-value ns xx)
    (1d-noise-value ns (+ xx 1))))
; 2d gradient noise
(define (2d-gradient-noise ns x y)
  (define nb-samples (s-noise-nb-samples ns))
  (define xx (quotient x nb-samples))
  (define yy (quotient y nb-samples))
  (define tx (/ (remainder x nb-samples) nb-samples))
  (define ty (/ (remainder y nb-samples) nb-samples))
  (smoothstep
    tx
    (smoothstep
      ty
      (2d-noise-value ns xx yy)
      (2d-noise-value ns xx (+ yy 1)))
    (smoothstep
      ty
      (2d-noise-value ns (+ xx 1) yy)
      (2d-noise-value ns (+ xx 1) (+ yy 1)))))
; 3d gradient noise
(define (3d-gradient-noise ns x y z)
  (define nb-samples (s-noise-nb-samples ns))
  (define xx (quotient x nb-samples))
  (define yy (quotient y nb-samples))
  (define zz (quotient z nb-samples))
  (define tx (/ (remainder x nb-samples) nb-samples))
  (define ty (/ (remainder y nb-samples) nb-samples))
  (define tz (/ (remainder z nb-samples) nb-samples))
  (smoothstep
    tx
    (smoothstep
      ty
      (smoothstep
        tz
        (3d-noise-value ns xx yy zz)
        (3d-noise-value ns xx yy (+ zz 1)))
      (smoothstep
        tz
        (3d-noise-value ns xx (+ yy 1) zz)
        (3d-noise-value ns xx (+ yy 1) (+ zz 1))))
    (smoothstep
      ty
      (smoothstep
        tz
        (3d-noise-value ns (+ xx 1) yy zz)
        (3d-noise-value ns (+ xx 1) yy (+ zz 1)))
      (smoothstep
        tz
        (3d-noise-value ns (+ xx 1) (+ yy 1) zz)
        (3d-noise-value ns (+ xx 1) (+ yy 1) (+ zz 1))))))
; N-dimensional gradient noise
(define (nd-gradient-noise ns unchecked-coords checked-coords)
  (cond
    ((null? unchecked-coords)
     (apply nd-noise-value ns (reverse checked-coords)))
    (#t
      (define x (car unchecked-coords))
      (define nb-samples (s-noise-nb-samples ns))
      (define xx (quotient x nb-samples))
      (define tx (/ (remainder x nb-samples) nb-samples))
      (smoothstep
        tx
        (nd-gradient-noise ns (cdr unchecked-coords) (cons xx checked-coords))
        (nd-gradient-noise ns (cdr unchecked-coords) (cons (+ 1 xx) checked-coords))))
    ))
; Noise gradient
(define (noise-gradient-value ns . coords)
  (define dim (length coords))
  (cond
    ((eq? dim 1) (1d-gradient-noise ns (car coords)))
    ((eq? dim 2) (2d-gradient-noise ns (car coords) (cadr coords)))
    ((eq? dim 3) (3d-gradient-noise ns (car coords) (cadr coords) (caddr coords)))
    (#t
      (nd-gradient-noise ns coords '()))
    ))

; Fractal noise
; The idea of fractal noises is to sum several frequencies of the noise
; It takes two parameters: octaves is the number of frequencies to sum, persistance is a scaling value of higher frequencies
(define (noise-fractal-value ns octaves persistance . coords)
  (foldl
    (lambda (i res)
      (+ res
         (* (expt persistance i)
            (apply
              noise-value
              ns
              (map
                (lambda (x) (* (+ i 1) x))
                coords)))))
    0
    (build-list octaves values)))

; Same as above, but use the noise-gradient-value instead of the noise-value
(define (noise-gradient-fractal-value ns octaves persistance . coords)
  (foldl
    (lambda (i res)
      (+ res
         (* (expt persistance i)
            (apply
              noise-gradient-value
              ns
              (map
                (lambda (x) (* (+ i 1) x))
                coords)))))
    0
    (build-list octaves values)))
