;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; NAME:        graphics3D-lib.scm
;;
;; DESCRIPTION: 3D Graphic Library Routines
;;
;; AUTHOR:      Dan Garcia, Ph.D.  -  University of California at Berkeley
;;              Copyright (C) Dan Garcia, 2001. All rights reserved.
;;
;; DATE:        2001-10-13
;;
;; COMMENTS:    I'm a little lax about the Abstraction Violation between
;;              vectors and points; basically I consider them to have the
;;              same rep so I use them interchangably.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DATATYPE: POINT (P3)
;; Constructors: mP3 "make new Point P"
;; Selectors:      x "get x-coord from P"
;;                 y "get y-coord from P"
;;                 z "get z-coord from P"
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (x P)       (car  P))
(define (y P)       (cadr P))
(define (z P)       (caddr P))
(define (mP3 x y z) (list x y z))
(define mV mP3) ;; Make-vector (use mP3)

;;;;;;;;;;;;
;; CONSTANTS
;;;;;;;;;;;;

;; Colors

(define *Color_red*    1)
(define *Color_green*  2)
(define *Color_blue*   3)
(define *Color_yellow* 4)
(define *Color_purple* 5)
(define *Color_cyan*   6)
(define *Color_white*  7)

;; Scene borders

(define *L* -100) ;; Left
(define *R*  100) ;; Right
(define *D* -100) ;; Down
(define *U*  100) ;; Up
(define *B* -100) ;; Bottom
(define *T*  100) ;; Top

;; Scene borders (middle)
(define *NW* (mP3 *L* *U* 0))
(define *N*  (mP3  0  *U* 0))
(define *NE* (mP3 *R* *U* 0))
(define *W*  (mP3 *L*  0  0))
(define *C*  (mP3  0   0  0))
(define *E*  (mP3 *R*  0  0))
(define *SW* (mP3 *L* *D* 0))
(define *S*  (mP3  0  *D* 0))
(define *SE* (mP3 *R* *D* 0))

;; Scene border (Top)
(define *TNW* (mP3 *L* *U* *T*))
(define *TN*  (mP3  0  *U* *T*))
(define *TNE* (mP3 *R* *U* *T*))
(define *TW*  (mP3 *L*  0  *T*))
(define *TC*  (mP3  0   0  *T*))
(define *TE*  (mP3 *R*  0  *T*))
(define *TSW* (mP3 *L* *D* *T*))
(define *TS*  (mP3  0  *D* *T*))
(define *TSE* (mP3 *R* *D* *T*))

;; Scene border (bottom)
(define *BNW* (mP3 *L* *U* *B*))
(define *BN*  (mP3  0  *U* *B*))
(define *BNE* (mP3 *R* *U* *B*))
(define *BW*  (mP3 *L*  0  *B*))
(define *BC*  (mP3  0   0  *B*))
(define *BE*  (mP3 *R*  0  *B*))
(define *BSW* (mP3 *L* *D* *B*))
(define *BS*  (mP3  0  *D* *B*))
(define *BSE* (mP3 *R* *D* *B*))

;; Heaven (very high above everyone)
(define *Pydir_Heaven* (mP3 0 1000000000 0))
(define *Pnegz_Heaven* (mP3 0 0 -1000000000))

;; Window widths and height and largest radius circle
;; based at the origin

(define *Width*  (- *R* *L*))
(define *Height* (- *U* *D*))
(define *Depth*  (- *T* *B*))
(define *Half-Height* (/ *Height* 2))
(define *Half-Width*  (/ *Width*  2))
(define *Half-Depth*  (/ *Depth*  2))
(define *Radius* (min *Half-Height* *Half-Width* *Half-Depth*))

;; For animating fractals

(define *unit-step* 1)

;; Numerical constants we'll use often

(define *sqrt3*   (sqrt 3))
(define *sqrt3/2* (/ *sqrt3* 2))
(define *PI* 3.14159265)

;; The *file-port* is where we output our draw-line calls.

(define *file-port* (current-output-port))

;;;;;;;;;;;;;;;;
;; ColorLevel
;; Input: n [int] "level of recursion"
;; Returns: Different color to be used in Rotater for each n
;;   Input: 0, 1, 2, 3, 4, 5, 6, 7, 8, ...
;;  Output: 7, 1, 2, 3, 4, 5, 6, 7, 1, ... 
;;;;;;;;;;;;;;;;

(define (color-level n)
  (let ((ans (modulo n 7)))
    (if (= 0 ans) 7 ans)))

;;;;;;;;;;;;;;;;
;; draw-pointP3
;; Input: P [P3] "Point"; color [int] "color"
;; Side-Effect: Position pen at point P with color
;;;;;;;;;;;;;;;;

(define (plot-pointP3 P color)
  ;; (position-pen (x P) (y P) (z P))
  (show-line (list (+ (x P) 0.0) 
                   (+ (y P) 0.0)
                   (+ (z P) 0.0)
                   (- color)) *file-port*)
  ) 

;;;;;;;;;;;;;;;;
;; position-penP3
;; Input: P [P3] "Starting point"
;; Side-Effect: Position pen at point P
;;;;;;;;;;;;;;;;

(define (position-penP3 P)
  ;; (position-pen (x P) (y P) (z P))
  (show-line (list (+ (x P) 0.0)
                   (+ (y P) 0.0)
                   (+ (z P) 0.0) 
                   0) *file-port*)
  ) 

;;;;;;;;;;;;;
;; draw-lineP
;; Input: P1 [P3] "Starting point"; P2 [P3] "Ending point"; color [int] "color"
;; Side-Effect: Draw line from P1 to P2 with color
;;;;;;;;;;;;;

(define (draw-lineP3 P1 P2 color)
  (position-penP3 P1)
  (draw-line-toP3 P2 color))

;;;;;;;;;;;;;;;;
;; draw-line-toP3
;; Input: P [P3] "Ending point"; color [int] "color"
;; Side-Effect: Draw line from current-pen to P
;;;;;;;;;;;;;;;;

(define (draw-line-toP3 P color)
  ;(draw-line-to (x P) (y P) (z P))
  (show-line (list (+ (x P) 0.0) 
                   (+ (y P) 0.0)
                   (+ (z P) 0.0)
                   color) *file-port*)
  )

;;;;;;;;;;;;;;;;
;; draw-poly-lineP3
;; Input: color [int] "color"; allPs [list-of-P3] "List of points"
;; Side-Effect: Draw poly-line from first point thru last point
;;;;;;;;;;;;;;;;

(define (draw-poly-lineP3 color . allPs)
  (define (helper Ps)
    (if (null? Ps)
        'done
        (begin
         (draw-line-toP3 (car Ps) color)
         (helper (cdr Ps)))))
  (position-penP3 (car allPs))
  (helper (cdr allPs)))

;;;;;;;
;; negP3
;; Input: P [P3] "point"
;; Returns: Point which is the negation of P, i.e., -P
;;;;;;;

(define (negP3 P)
  (mP3 (- (x P))
       (- (y P))
       (- (z P))))

;;;;;;;
;; addP3
;; Input: P1 [P3] "first point"; P2 [P] "second point"
;; Returns: Point sum of P1 and P2, i.e., P1+P2
;;;;;;;

(define (addP3 P1 P2)
  (mP3 (+ (x P1) (x P2))
       (+ (y P1) (y P2))
       (+ (z P1) (z P2))))

;;;;;;;
;; subP3
;; Input: P1 [P3] "first point"; P2 [P3] "second point"
;; Returns: Point difference of P1 and P2, i.e., P1-P2
;;;;;;;

(define (subP3 P1 P2)
  (addP3 P1 (negP3 P2)))

;;;;;;;;;
;; scaleP3
;; Input: c [int] "scale factor"; P [P3] "point"
;; Returns: Point which is scale of P by c
;;;;;;;;;

(define (scaleP3 c P)
  (mP3 (* c (x P))
       (* c (y P))
       (* c (z P))))

;;;;;;;
;; avgP3
;; Input: P1 [P3] "first point"; P2 [P3] "second point"
;; Returns: Point which is average of P1 and P2
;;;;;;;

(define (avgP3 P1 P2)
  (scaleP3 1/2 (addP3 P1 P2)))

;;;;;;;;;
;; square
;; Input: n [int] "number"
;; Returns: number squared
;;;;;;;;;

(define (square n) (* n n))

;;;;;;;;;
;; length3
;; Input: P1 [P3] "first point"; P2 [P3] "second point"
;; Returns: distance from P1 to P2
;;;;;;;;;

(define (length3 P1 P2)
  (let ((v (subP3 P2 P1)))
    (sqrt (+ (square (x v))
             (square (y v))
             (square (z v))))))

;;;;;;;;;
;; magnitude3
;; Input: v [vector] "vector"
;; Returns: magnitude of vector
;;;;;;;;;

(define (magnitude3 v)
  (sqrt (+ (square (x v))
           (square (y v))
           (square (z v)))))

;;;;;;;;;
;; normalize3
;; Input: v [vector] "vector"
;; Returns: vector normalized
;;;;;;;;;

(define (normalize3 v)
  (scaleP3 (/ (magnitude3 v)) v))

;;;;;;;;;
;; orthog-length3
;; Input: P1 [P3] "first point"; P2 [P3] "second point"
;; Returns: orthogonal length of P1 to P2
;;;;;;;;;

(define (orthog-length3 P1 P2)
  (let ((v (subP P2 P1)))
    (max (abs (x v))
         (abs (y v))
         (abs (z v)))))

;;;;;;;
;; cross-productP3
;; Input: v1 [P3] "first point"; v2 [P3] "second point"
;; Returns: v1 x v2 (cross-product)
;; v1x v1y v1z
;; v2x v2y v2z
;;  x   y   z
;; (v1y * v2z - v1z * v2y , v1z * v2x - v1x * v2z , v1x * v2y - v1y * v2x)
;;;;;;;

(define (cross-productP3 v1 v2)
  (mV (- (* (y v1) (z v2))
         (* (z v1) (y v2)))
      (- (* (z v1) (x v2))
         (* (x v1) (z v2)))
      (- (* (x v1) (y v2))
         (* (y v1) (x v2)))))

;;;;;;;;;;
;; rotz-90P3
;; Input: P [P3] "point"
;; Returns: Point which is P rotated about origin about z by 90 degrees
;;;;;;;;;;

(define (rotz-90P3 P)
  (mP3 (y P)
       (- (x P))
       (z P)))

;;;;;;;;
;; coord3
;; Input: Porigin [P3] "point simulating origin"
;;        Pz      [P3] "point simulating the point [0,0,1]"
;;        Pydir   [P3] "point NOT collinear with (Porigin,Pz) in y-direction"
;;        v       [V3] "Vector input"
;; Returns: Point which is the result of thinking of v
;;          in the new coordinate system defined by Porigin
;;          as the origin and Pz as 1 unit down the z axis in left-handed coods.
;;          Pydir is just any point NOT collinear with (Porigin,Pz) line,
;;          which is used to orient the new x,y,z axis. Then we use v as
;;          a vector in the new coordinate system and return the new point.
;;
;; This is a VERY powerful function, allowing you to 
;; define new points with almost no need for any 
;; standard graphics geometry (dot product, etc)
;;
;; Example: (avgP3 P1 P2) == (coord3 P1 P2 P3 (mV 0 0 .5))
;;;;;;;;

(define (coord3 Porigin Pz Pydir v)
  (let* ((vZ        (subP3 Pz Porigin))
         (vZlength  (length3 Pz Porigin))
         (vZnorm    (scaleP3 (/ vZlength) vZ))
         (vYdir     (subP3 Pydir Porigin))
         (vYdirnorm (normalize3 vYdir))
         (vX        (cross-productP3 vYdirnorm vZnorm))
         (vXnorm    (normalize3 vX))
         (vYnorm    (cross-productP3 vZnorm vXnorm)))
    ;; For debugging
    ;(show-line vZ)
    ;(show-line (list vZlength))
    ;(show-line vZnorm)
    ;(show-line vYdir)
    ;(show-line vYdirnorm)
    ;(show-line vX)
    ;(show-line vXnorm)
    ;(show-line vYnorm)
    (addP3 Porigin
           (addP3 (scaleP3 (* vZlength (x v)) vXnorm)
                  (addP3 (scaleP3 (* vZlength (y v)) vYnorm)
                         (scaleP3 (* vZlength (z v)) vZnorm))))))

;;;;;;;;;;
;; lin-interp
;; Input: x0 [float] "starting value"
;;        x1 [float] "ending value"
;;         t [int] "parameter"
;; Returns: Value (scalar) which is a linear combination of
;;          x0 and x1 using the standard formula:
;;          x(t) = x0 (1-t) + x1 (t)
;;          I.e., x(0) = x0, x(1) = x1, x(1/2)=(x0+x1)/2
;;
;; This is a VERY powerful function, allowing you to 
;; linearly interpolate between values x0 and x1
;; for animation.
;;
;; Example: (/ (+ x0 x1) 2) == (lin-interpP x0 x1 1/2)
;;;;;;;;

(define (lin-interp x0 x1 t)
  (+ (* (- 1 t) x0)
     (*      t  x1)))
  
;;;;;;;;;;
;; lin-interpP3
;; Input: P0 [P3] "starting point"
;;        P1 [P3] "ending point"
;;         t [int] "parameter"
;; Returns: Point which is a linear combination of
;;          P0 and P1 using the standard formula:
;;          P(t) = P0 (1-t) + P1 (t)
;;          I.e., P(0) = P0, P(1) = P1, P(1/2)=(P0+P1)/2
;;
;; This is a VERY powerful function, allowing you to 
;; linearly interpolate between points P0 and P1
;; for animation.
;;
;; Example: (avgP3 P0 P1) == (lin-interpP3 P0 P1 1/2)
;;;;;;;;

(define (lin-interpP3 P0 P1 t)
  (addP3 (scaleP3 (- 1 t) P0)
         (scaleP3 t P1)))

;;;;;;;;;;;;;;;
;; draw-squareP3
;; Input: Porigin [P3] "point simulating origin"
;;        Pz      [P3] "point simulating the point [0,0,1]"
;;        Pydir   [P3] "point NOT collinear with (Porigin,Pz) in y-direction"
;;        v       [V3] "Vector input"
;;        color   [int] "color"
;; Side-Effect: Draw square radius 2 centered around Porigin toward Pz
;;;;;;;;;;;;;;;

(define (draw-squareP3 Porigin Pz Pydir color)
  (draw-poly-lineP3 color
                    (coord3 Porigin Pz Pydir (mV  1  1 0))
                    (coord3 Porigin Pz Pydir (mV -1  1 0))
                    (coord3 Porigin Pz Pydir (mV -1 -1 0))
                    (coord3 Porigin Pz Pydir (mV  1 -1 0))
                    (coord3 Porigin Pz Pydir (mV  1  1 0))))

;;;;;;;;;;;;;;;
;; draw-cubeP3
;; Input: Porigin [P3] "point simulating origin"
;;        Pz      [P3] "point simulating the point [0,0,1]"
;;        Pydir   [P3] "point NOT collinear with (Porigin,Pz) in y-direction"
;;        color   [int] "color"
;; Side-Effect: Draw cube radius (Pz-Porigin) around Porigin toward Pz
;;;;;;;;;;;;;;;

(define (draw-cubeP3 Porigin Pz Pydir color)
  (let ((Pfront (coord3 Porigin Pz Pydir (mV 0 0 -1)))
        )
    (draw-squareP3 Pfront Porigin Pydir color)
    (draw-squareP3 Pz Porigin Pydir color)
    (draw-lineP3 (coord3 Porigin Pz Pydir (mV -1 -1 -1))
                 (coord3 Porigin Pz Pydir (mV -1 -1  1)) color)
    (draw-lineP3 (coord3 Porigin Pz Pydir (mV  1 -1 -1))
                 (coord3 Porigin Pz Pydir (mV  1 -1  1)) color)
    (draw-lineP3 (coord3 Porigin Pz Pydir (mV -1  1 -1))
                 (coord3 Porigin Pz Pydir (mV -1  1  1)) color)
    (draw-lineP3 (coord3 Porigin Pz Pydir (mV  1  1 -1))
                 (coord3 Porigin Pz Pydir (mV  1  1  1)) color)
    ))
                 
;;;;;;;;;;;;
;; draw-arcP3
;; Input: Porigin [P3] "point simulating origin"
;;        Pz      [P3] "point simulating the point [0,0,1]"
;;        Pydir   [P3] "point NOT collinear with (Porigin,Pz) in y-direction"
;;        degrees [int] "degrees of arc"; sides [int] "arc samples"
;;        color   [int] "color"
;; Side-Effect: Draw arc centered at Porigin with diameter
;;              (Pz-Porigin) in the x-y plane with angle = degrees
;;;;;;;;;;;;

(define (draw-arcP3 Porigin Pz Pydir degrees sides color)
  (position-penP3 (coord3 Porigin Pz Pydir (mV 0 1 0)))
  (let ((tincr (/ (* degrees (/ *PI* 180)) sides)))
    (define (draw-arc-lines seg t)
      (if (= seg 0)
          'done
          (begin
           (draw-line-toP3 
             (coord3 Porigin Pz Pydir (mV (- (sin t)) (cos t) 0))
             color)
           (draw-arc-lines (- seg 1) (+ t tincr)))))
    (draw-arc-lines sides tincr)))
                 
;;;;;;;;;;;;
;; draw-cube-arcP3
;; Input: Porigin [P3] "point simulating origin"
;;        Pz      [P3] "point simulating the point [0,0,1]"
;;        Pydir   [P3] "point NOT collinear with (Porigin,Pz) in y-direction"
;;        degrees [int] "degrees of arc"; sides [int] "arc samples"
;;        color   [int] "color"
;; Side-Effect: Draw cube made with circles centered at Porigin with diameter
;;              (Pz-Porigin) in the x-y plane with angle = degrees
;;;;;;;;;;;;

(define (draw-cube-arcP3 Porigin Pz Pydir sides color)
  (let ((Pfront  (coord3 Porigin Pz Pydir (mV 0 0 -1)))
        (Pleft   (coord3 Porigin Pz Pydir (mV -1 0 0)))
        (Pright  (coord3 Porigin Pz Pydir (mV 1 0  0)))
        (Ptop    (coord3 Porigin Pz Pydir (mV 0 -1 0)))
        (Pbottom (coord3 Porigin Pz Pydir (mV 0  1 0)))
        )
    (draw-arcP3 Pfront Porigin Pydir 360 sides color)
    (draw-arcP3 Pz Porigin Pydir 360 sides color)
    (draw-arcP3 Pleft Porigin Pydir 360 sides color)
    (draw-arcP3 Pright Porigin Pydir 360 sides color)
    (draw-arcP3 Ptop Porigin Pz 360 sides color)
    (draw-arcP3 Pbottom Porigin Pfront 360 sides color)
    ))
  
;;;;;;;;;;;;;;;
;; write-rotater
;;       Input: file [string] "file to save the rotater file in"
;;              draw-proc [lambda] "proc takes n, draws fractal at level n"
;;              level [int] level at which we're going to draw the fractal
;;              rotater-name [string] "Name of 3D geometry for Info"
;;              date [string] "Date"
;;              name [string] "Author's name + email"
;;              www [string] "Author's www address"
;; Side-Effect: Write rotater file with fractal at level
;;     Example: (write-rotater "foo.rot" my-draw-proc 7 "Foo3D" 
;;                             "2001-10-10"
;;                             "Joe Graphics (joe@uclink.berkeley.edu)"
;;                             "http://www.myhostname.com/~joe")
;; 
;; NB: If your my-draw-proc crashes halfway through writing your file,
;;     you need to close it manually! Evaluate this to do exactly that:
;;
;; (close-output-port *file-port*)
;;;;;;;;;;;;;;;

(define (write-rotater file draw-proc level rotater-name date name www)

  (show-line (se "write-rotater v.1.0 (by Dan Garcia)"))
  (newline)
  
  (cond ((equal? "" file) ;; Are we writing a file or just output to screen?
         (set! *file-port* (current-output-port)))     ;; Output to screen
        (else
         (show-line (se "...if you crash mid-way through writing a file, you MUST close it with:"))
         (show-line (se "(close-output-port *file-port*)"))
         (newline)
         (set! *file-port* (open-output-file file))    ;; Open the file
         (display "Writing ")
         (display file)
         (display "...")))
                  
  ;; Write the header
  (display   "# "                                                *file-port*)
  (show-line (se rotater-name)                                   *file-port*)
  (show-line '("# ")                                             *file-port*)
  (display   "# "                                                *file-port*)
  (show-line (se date)                                           *file-port*)
  (display   "# by "                                             *file-port*)
  (show-line (se name)                                           *file-port*)
  (display   "# "                                                *file-port*)
  (show-line (se www)                                            *file-port*)
  (show-line '("# ")                                             *file-port*)
  (show-line '("# (c) 2001 University of California, Berkeley")  *file-port*)
  (show-line '("# UC Berkeley Undergraduate Graphics Group")     *file-port*)
  (show-line 
    '("# led by Dan Garcia, Ph.D. (ddgarcia@cs.berkeley.edu)")   *file-port*)
  (show-line '("# http://www.cs.berkeley.edu/~ddgarcia/")        *file-port*)
  (newline                                                       *file-port*)

  ;; draw the 3D rotater file!
  (draw-proc level)  
  
  (cond ((not (equal? "" file))  ;; If we're just testing the output to screen
         ;; Close the file
         (close-output-port *file-port*)
         ))
        
  
  ;; Nice closing message
  'done!)