;;; Scheme Recursive Art Contest Entry
;;;
;;; Please do not include your name or personal info in this file.
;;;
;;; Title: <Iterations of a Sierpinski Tetrahedron>
;;;
;;; Description:
;;;   <Infinitely detailed
;;;    fractal, yet surface area
;;;    = √3 s².>


(define r32 (sqrt 0.75))
(define r33 (/ (sqrt 3)))
(define r63 (/ (sqrt 6) 3))

; This is the "real Scheme" apply and map. But we lack variadic arguments, so I use Python primitives.

(define (transpose m)
 (apply-last map-zip list m)) ; (map-zip list m[0] m[1]...)

(define (dot a b) ; Check out this one weird notation! EE16A "inner" instructors hate it!
 (define ab (map-zip * a b))
 (apply + ab))

(define (mul A B)
 (define BT (transpose B))
 (map
  (lambda (arow)
   (map
    (lambda (bcol)
     (dot arow bcol))
    BT))
  A))

(define (lol A rows)
 (transpose (mul A (transpose rows))))

(define (getx pos) (car pos))
(define (gety pos) (getx (cdr pos)))
(define (getz pos) (gety (cdr pos)))
(define (getw pos) (getz (cdr pos)))
(define (xy pos) (list (getx pos) (gety pos)))

(define (enumerate-map f l)
 (define (inner f l i)
   (if (null? l)
    nil
    (cons (f (car l) i) (inner f (cdr l) (+ i 1)))))
 (inner f l 0))

(define (mix x y percent)
 (+ (* x (- 1 percent)) (* y percent)))

(define (curry* a)
 (lambda (b) (* a b)))

;(define (map2d pointf tris)
; (map
;  (lambda (tri)
;   (map pointf tri))
;  tris))


(define (trans dx dy dz)
 (list
  (list 1 0 0 dx)
  (list 0 1 0 dy)  ; y -=
  (list 0 0 1 dz)
  (list 0 0 0 1)))
; (print (trans 0 0 0))
(define (rotate dx)
 (define un (sqrt (- 1 (* dx dx))))
 (list
  (list un 0 (- dx) 0)
  (list 0 1 0 0)  ; y -=
  (list dx 0 un 0)
  (list 0 0 0 1)))

(define (perspective zoom)   ; xyz are screen dividing factors.
; (define nz (z))
 (list
  (list 1 0 0 0)
  (list 0 1 0 0)
  (list 0 0 1 0)
  (list 0 0 (/ zoom) 0)))
(define mirror
 '((1 0 0 0)
   (0 -1 0 0)
   (0 0 1 0)
   (0 0 0 1)))

(define (homo2pt pt)
 (let
  ((x (getx pt))
   (y (gety pt))
   (z (getz pt))
   (w (getw pt)))
  (list (/ x w) (/ y w) (/ z w))))

(define (pipeline proj shape)
 (define transformed (transpose (mul proj (transpose shape))))  ; ((x y z w)...)
 (define screen (map (lambda (xyzw) (xy (homo2pt xyzw))) transformed))
 screen)




(define (blit shape c)
 (define (uh ptr)
  (if (null? ptr)
   nil
   (begin
    (apply setposition (car ptr))
    (uh (cdr ptr)) )))

 (apply setposition (car shape))
 (fillcolor c)
 (pendown)
 (begin_fill)

 (uh shape)

 (end_fill)
 (penup)
)




(define (tetrahedron s dx dy dz)  ; Returns (4 (homogeneous)).
 (define pts (list
  (list 0 0 0 1)
  (list (* s 0.5) 0 (* s r32) 1)
  (list (* s -0.5) 0 (* s r32) 1)
  (list 0 (* s r63) (* s r33) 1) ))
 (transpose
  (mul (trans dx dy dz)
   (transpose pts))))


(define (sierpinski s dx dy dz) ; Returns (list of (three (homog))).
 (if (< s epsilon)
  (apply combos (tetrahedron s dx dy dz))
  (begin
   (define half (/ s 2))
   (define origins
     (lol
      (trans dx dy dz)
      (list
       (list (* half 0.5) 0 (* half r32) 1)
       (list (* half -0.5) 0 (* half r32) 1)
       (list 0 (* half r63) (* half r33) 1) )))
   (define tets
    (map
     (lambda (origin)
      (apply-last tetrahedron half (homo2pt origin)))
     origins))
   (define help
    (append
     (apply append (map (lambda (tet) (apply-last combos tet)) tets))
     (sierpinski (/ s 2) dx dy dz)))
   help)))
;
;   (append
;    (tetrahedron half )))))

(define (combos a b c d)
 (list
  (list b c d)
  (list a b c)
  (list a b d)
  (list a c d)
 ))

(define epsilon 2)

(define (draw)
 (speed 0)
 (penup)
 (no_pen)

 ; background color
 (blit '((-9001 -9001) (-9001 9001) (9001 9001) (9001 -9001)) '"#080808")
 (blit '((-9001 -9001) (-9001 0) (9001 0) (9001 -9001)) '"#181818")

 (define proj
  (reduce mul
   (list
    (perspective (screen_height))  ;90 fov
    (trans 30 -40 180)
    (rotate 0.2))))
 (define tris (sierpinski 200   0 0 0))
 (define ntri (length tris))

 (define screen
  (enumerate-map
   (lambda (tri i)
    (define screen (pipeline proj tri))
    (define inverted (pipeline (mul proj mirror) tri))
    (define percent (/ i ntri))
    ; color = f(i/ntri)
    (define r (rand 0.05 (mix 0 0.2 percent)))
    (define g (rand 0.05 (mix 0.2 0.6 percent)))
    (define b (rand 0.15 (mix 0.4 0.8 percent)))
    (blit screen (rgb r g b))
    (blit inverted (apply rgb (map (curry* 0.3) (list r g b))))
    screen)
   tris))

; (print screen)
; (blit '((-1 -1) (-1 1) (1 1)) '"black")

 (hideturtle)
 (exitonclick))

(draw)