;;;
;;; curve.ss
;;; UVA CS200 Spring 2002
;;; Problem Set 2
;;;

;;; Version 1.0.1 - PS2
;;; Version 1.0.2 - modified for PS3:
;;;                    o removed window making
;;;                    o added make-line
;;;                    o added connect-ends
;;;                    o added find-leftmost-point, etc.

(require-library "graphics.ss" "graphics") ;;; Load the graphics library
(require-library "trace.ss")

;;;
;;; Constants
;;;

(define window-width 600)  ;;; Display window width
(define window-height 600) ;;; Display window height

;;; Angles

(define pi/4 (atan 1 1))
(define pi (* 4 pi/4))
(define -pi (- pi))
(define 2pi (* 2 pi))

;;;
;;; Points
;;;

(define (make-point x y) (cons x y))

(define (x-of-point point) (car point))
(define (y-of-point point) (cdr point))

(define (show-point point)
  (list (x-of-point point) (y-of-point point)))

(define (square x)
  (* x x))

(define (point-distance p1 p2)
  (sqrt 
   (+ (square (- (x-of-point p1)
		 (x-of-point p2)))
      (square (- (y-of-point p1)
		 (y-of-point p2))))))

;;;
;;; Drawing a curve
;;;

(define (draw-curve-points curve n)
  (define (worker t step)
    (if (<= t 1.0)
	(begin
	  (window-draw-point (curve t))
	  (worker (+ t step) step))))
  (worker 0.0 (/ 1 n)))

(define (draw-curve-connected curve n)
  (define (worker t step)
    (if (<= t 1.0)
	(begin
	  (window-draw-line (curve t) (curve (+ t step)))
	  (worker (+ t step) step))))
  (worker 0.0 (/ 1 n)))

;;;
;;; Some simple curves
;;;

(define (mid-line t)
   (make-point t 0.5))

(define (unit-circle t)
  (make-point (sin (* 2pi t))
	      (cos (* 2pi t))))

(define (unit-line t)
  (make-point t 0.0))

(define (make-horizontal-line distance)
  (lambda (t)
    (make-point (* distance t) 0.0)))

(define (make-vertical-line distance)
  (lambda (t)
    (make-point 0.0 (* distance t))))

(define (mid-line-orig t)
  (make-point t 0.5))

;;;
;;; Functions for transforming curves into new curves.
;;;

(define (translate curve x y)
  (lambda (t)
    (let ((ct (curve t)))
      (make-point
       (+ x (x-of-point ct))
       (+ y (y-of-point ct))))))

(define (rotate-ccw curve)
  (lambda (t)
    (let ((ct (curve t)))
      (make-point
       (- (y-of-point ct))
       (x-of-point ct)))))

(define (flip-vertically curve)
  (lambda (t)
    (make-point
     (* -1 (x-of-point (curve t)))
     (y-of-point (curve t)))))

(define (shrink curve scale)
  (lambda (t)
    (make-point
     (* scale (x-of-point (curve t)))
     (* scale (y-of-point (curve t))))))

(define (first-half curve)
  (lambda (t)
    (curve (/ t 2))))

(define (compose f g)
   (lambda (x) (f (g x))))

(define (n-times f n)
  (if (=  n 0) 
      (lambda (x) x)
      (compose f (n-times f (- n 1)))))

(define rotate-cw 
  (compose rotate-ccw flip-vertically))

(define (degrees-to-radians degrees)
  (/ (* degrees pi) 180))


;;; These definitions are the fast versions using let from PS2.

;;;
;;; rotate-around-origin counterclockwise by theta degrees
;;; (No need to worry about the geometry math for this.)
;;;

(define (rotate-around-origin curve theta)
  (let ((cth (cos (degrees-to-radians theta)))
        (sth (sin (degrees-to-radians theta))))
    (lambda (t)
      (let* ((ct (curve t))
	     (x (x-of-point ct))
	     (y (y-of-point ct)))
	(make-point
	 (- (* cth x) (* sth y))
	 (+ (* sth x) (* cth y)))))))

;;;
;;; Scale a curve
;;;

(define (scale-x-y curve x-scale y-scale)
  (lambda (t)
    (let ((ct (curve t)))
      (make-point (* x-scale (x-of-point ct))
		  (* y-scale (y-of-point ct))))))

;;; scale symmetrically
 
(define (scale curve s)
  (scale-x-y curve s s))

;;; squeeze-rectangular-portion translates and scales a curve
;;; so the portion of the curve in the rectangle
;;; with corners xlo xhi ylo yhi will appear in a display window
;;; which has x, y coordinates from 0 to 1.

(define (squeeze-rectangular-portion curve xlo xhi ylo yhi)
  (translate
   (scale-x-y
    (translate curve (- xlo) (- ylo))
    (* .9 (/ 1 (- xhi xlo)))
    (* .9 (/ 1 (- yhi ylo))))
   0.05 0.05))

;;;
;;; put-in-standard-position transforms a curve so that it starts at
;;; (0,0) ends at (1,0).
;;;
;;; A curve is put-in-standard-position by rigidly translating it so its
;;; start point is at the origin, then rotating it about the origin to put
;;; its endpoint on the x axis, then scaling it to put the endpoint at (1,0).

(define (put-in-standard-position curve)
  (let* ((start-point (curve 0 (color-of-point curve)))
         (curve-started-at-origin
          (((translate (- (x-of-point start-point))
		       (- (y-of-point start-point)))
	    curve)))
         (new-end-point (curve-started-at-origin 1))
         (theta (atan (y-of-point new-end-point) (x-of-point new-end-point)))
         (curve-ended-at-x-axis
          ((rotate-around-origin (- theta)) curve-started-at-origin))
         (end-point-on-x-axis (x-of-point (curve-ended-at-x-axis 1))))
    ((scale (/ 1 end-point-on-x-axis)) curve-ended-at-x-axis)))

;;;
;;; connect-rigidly makes a curve consisting of curve1 followed by curve2.
;;;

(define (connect-rigidly curve1 curve2)
  (lambda (t)
      (if (< t (/ 1 2))
          (curve1 (* 2 t))
          (curve2 (- (* 2 t) 1)))))

;;;
;;; connect-ends
;;;

(define (connect-ends curve1 curve2)
  (lambda (t)
    (if (< t (/ 1 2))
	(curve1 (* 2 t))
	((translate curve2 
		   (x-of-point (curve1 1)) (y-of-point (curve1 1))) (- (* 2 t) 1)))))

(define (get-nth list n)
  (if (= n 0)
      (car list)
      (get-nth (cdr list) (- n 1))))

;;;
;;; Divide t evenly among a list of curves
;;;

(define (connect-curves-evenly curvelist)
  (lambda (t)
    (let 
	((which-curve
	  (if (>= t 1.0)
	      (- (length curvelist) 1)
	      (inexact->exact (floor (* t (length curvelist)))))))
      ((get-nth curvelist which-curve)
       (* (length curvelist)
	  (- t (* (/ 1 (length curvelist)) which-curve)))))))

;;;
;;; window functions
;;;

(define (make-window width height name)
  (open-viewport name width height))

(define (close-window window)
  (close-viewport window))

(define (graphics-clear)
  ((clear-viewport window)))

;;;
;;; We need to convert a position in a (0.0, 0.0) - (1.0, 1.0) coordinate
;;; system to a position in a (0, window-height) - (window-width, 0) coordinate
;;; system.  Note that the Viewport coordinates are upside down.
;;;

(define (convert-posn posn)
  (make-posn (* (posn-x posn) window-width)
	     (- window-height (* window-height (posn-y posn)))))

;;; Draw a line on window from (x0, y0) to (x1, y1)
;;; Passed values are in the unit (0.0, 0.0) - (1.0, 1.0) coordinate system.

(define (window-draw-line point0 point1)
  (let ((x0 (x-of-point point0))
	(y0 (y-of-point point0))
	(x1 (x-of-point point1))
	(y1 (y-of-point point1)))
    (if (or (< x0 0.0) (> x0 1.0))
	(printf "Warning: point x0 coordinate is out of range (should be between 0.0 and 1.0): ~a~n" x0))
    (if (or (< y0 0.0) (> y0 1.0)) 
	(printf "Warning: point y0 coordinate is out of range (should be between 0.0 and 1.0): ~a~n" y0))
    (if (or (< x1 0.0) (> x1 1.0))
	(printf "Warning: point x1 coordinate is out of range (should be between 0.0 and 1.0): ~a~n" x1))
    (if (or (< y1 0.0) (> y1 1.0)) 
	(printf "Warning: point y1 coordinate is out of range (should be between 0.0 and 1.0): ~a~n" y1))
    ((draw-line window)                     ;;; evaluates to function for drawing on window
     (convert-posn (make-posn x0 y0))       ;;; convert the (x0, y0) position to the viewport coordinates
     (convert-posn (make-posn x1 y1)))))    ;;; convert the (x1, y1) position to the viewport coordinates

(define (window-draw-point point)
  (let ((x (x-of-point point))
	(y (y-of-point point)))
    (if (or (< x 0.0) (> x 1.0))
	(printf "Warning: point x coordinate is out of range (should be between 0.0 and 1.0): ~a~n" x))
    (if (or (< y 0.0) (> y 1.0)) 
	(printf "Warning: point y coordinate is out of range (should be between 0.0 and 1.0): ~a~n" y))
    ((draw-pixel window) (convert-posn (make-posn x y)))))

;;; These procedures find the extents of a curve, so we can scale it to the window:

(define (find-extreme-point curve point-selector comparison n)
  (define (worker t best-so-far step)
    (if (> t 1.0)
	;; check 1.0
	(if (comparison (point-selector (curve 1.0)) best-so-far)
	    (begin
	      (point-selector (curve 1.0)))
	    best-so-far)
	(if (or (not best-so-far) (comparison (point-selector (curve t)) best-so-far))
	    (worker (+ t step) (point-selector (curve t)) step)
	    (worker (+ t step) best-so-far step))))
  (worker 0.0 #f (/ 1 n)))

(define (find-leftmost-point curve n)
  (find-extreme-point curve x-of-point < n))

(define (find-rightmost-point curve n)
  (find-extreme-point curve x-of-point > n))

(define (find-lowest-point curve n)
  (find-extreme-point curve y-of-point < n))

(define (find-highest-point curve n)
  (find-extreme-point curve y-of-point > n))

;;; We add and subtract the .1's to make it not go quite to the edge of the window.
;;; (Perhaps these should scale instead...)

(define num-points 1000)

(define (position-curve curve startx starty)
  (let ((tcurve (translate curve startx starty)))
    (let ((xlo (find-leftmost-point tcurve num-points))
	  (xhi (find-rightmost-point tcurve num-points))
	  (ylo (find-lowest-point tcurve num-points))
	  (yhi (find-highest-point tcurve num-points)))
      (let ((xlowscale (if (< xlo 0.01) 
			   (/ (- startx 0.01)
			      (- startx xlo))
			   1.0))
	    (xhighscale (if (> xhi 0.99) 
			    (/ (- 0.99 startx)
			       (- xhi startx))
			    1.0))
	    (ylowscale   (if (< ylo 0.01) 
			     (/ (- starty 0.01)
				(- ylo starty))
			     1.0))
	    (yhighscale   (if (> yhi 0.99) 
			      (/ (- 0.99 starty)
				 (- yhi starty))
			      1.0)))
	(let
	    ((minscale  (min xlowscale xhighscale ylowscale yhighscale)))
	  (translate (scale-x-y curve minscale minscale) startx starty))))))