(use srfi-1 srfi-4 srfi-69 engine-bindings posix)
(declare (unit terrain-generation))

;Bijection between natural pairs and naturals
;Used to resolve coordinates into a deterministic
;random number for terrain generation
(define (cantor x y)
	(+ (quotient
			(* (+ x y)
				 (+ x y 1))
		 	2)
		 y))

;Bijection between integers and naturals
(define (z->n x)
	(if (positive? x)
		(* 2 x)
		(- (* -2 x) 1)))

;Bijection between integer pairs and naturals
;What we really need to seed the rng
(define (z2->n x y)
	(cantor (z->n x) (z->n y)))

(define (divides? a b) (= (modulo b a) 0))

;assumes x and y are between 0 and 1
;a3  a4
;  xy
;a1  a2
(define (interpolate x y f00 f10 f01 f11)
	(let ((xp (- 1 x))
				(yp (- 1 y)))
		(+ (* f00 xp yp)
			 (* f10 x  yp)
			 (* f01 xp y )
			 (* f11 x  y ))))


(define (fixedpoints x y minnum maxnum num aseed)
	(xoroshiro_randomize (z2->n x y) aseed)
	(map (lambda (x) (+ minnum (xoroshiro_random maxnum))) (make-list num)))


(define (octaves-i x y minnum maxnum aseed)
	(define (iter xp yp ct)
		(if (and (even? xp) (even? yp) (< ct 4))
				(iter (/ xp 2) (/ yp 2) (+ ct 1))
				(fixedpoints x y minnum maxnum ct aseed)))
	(if (and (divides? 8 x) (divides? 8 y))
			(iter (/ x 8) (/ y 8) 1)
			'()))

(define (octaves x y aseed)
	(map (lambda (x) (/ x 1024)) (octaves-i x y 0 1024 aseed)))

(define (perlin-layer x y i aseed)
	(let ((j (* 4 (expt 2 i))))
		(let ((xl (* j (quotient x j)))
					(xh (* j (+ 1 (quotient x j))))
					(yl (* j (quotient y j)))
					(yh (* j (+ 1 (quotient y j)))))
			(let ((xp (/ (- x xl) j))
						(yp (/ (- y yl) j)))
				(interpolate xp yp
					(list-ref (octaves xl yl aseed) (- i 1))
					(list-ref (octaves xh yl aseed) (- i 1))
					(list-ref (octaves xl yh aseed) (- i 1))
					(list-ref (octaves xh yh aseed) (- i 1)))))))

(define (perlin x y aseed)
	(* (+ (/ (perlin-layer x y 1 aseed) 2)
				(/ (perlin-layer x y 2 aseed) 4)
				(/ (perlin-layer x y 3 aseed) 8)
				(/ (perlin-layer x y 4 aseed) 16))
		 16/15))
(define (construct-boring x-len y-len z-len)
	(define (loop x y z)
		(if (= y y-len)
			(begin (set! y 0) (set! x (+ x 1))))
		(if (= x x-len)
			(begin (set! x 0) (set! z (+ z 1))))
		(if (= z z-len)
			(diorama_end)
			(begin
				(diorama_add
					(if (< y 2)
						(hash-table-ref block-table 'stone)
						(hash-table-ref block-table 'grass)))
				(loop x (+ y 1) z))))
	(diorama_begin x-len y-len z-len)
	(list
		'diorama
		"boring"
		(loop 0 0 0)))

(define (make-perlinworld aseed)
	(define (loop x y z result)
		(if (= y 128)
			(begin (set! y 0) (set! x (+ x 1))))
		(if (= x 16)
			(begin (set! x 0) (set! z (+ z 1))))
		(if (= z 16)
			(reverse result)
			(let ((height (* 128 (perlin x z aseed))))
				(loop x (+ 1 y) z (cons (if (< y height) grass-block air) result)))))
		(make_finiteworld "perlinworld" (loop 0 0 0 '()) 16 128 16 16 16 16))