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

;;; Version 1.0.1

(require (lib "graphics.ss" "graphics")) ;;; Load the graphics library
(require (lib "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) (lambda (select) (if select x y)))
(define (x-of-point point) (point #t))
(define (y-of-point point) (point #f))

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

;;;
;;; 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))

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

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

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

(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 rotate-cw (compose rotate-ccw flip-vertically))

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

;;;
;;; 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 ((x (x-of-point (curve t)))
	    (y (y-of-point (curve t))))
	(make-point
	 (- (* cth x) (* sth y))
	 (+ (* sth x) (* cth y)))))))

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

(define (scale-x-y curve x-scale y-scale)
  (lambda (t)
    (make-point (* x-scale (x-of-point (curve t)))
		(* y-scale (y-of-point (curve t))))))
   
(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)
  (scale-x-y (translate curve (- xlo) (- ylo))
	     (/ 1 (- xhi xlo))
	     (/ 1 (- yhi ylo))))

;;;
;;; 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)))))

;;;
;;; Gosper Curves
;;;

(define (gosperize curve)
  (let ((scaled-curve 
	 (scale-x-y curve (/ (sqrt 2) 2) (/ (sqrt 2) 2))))
    (connect-rigidly (rotate-around-origin scaled-curve 45)
		     (translate
		      (rotate-around-origin scaled-curve -45)
		      .5 .5))))

;;;
;;; gosper-curve produces the gosper curve of level given by its parameter
;;;

(define (gosper-curve level)
  ((n-times gosperize level) unit-line))

(define (show-connected-gosper level)
  (draw-curve-connected 
   (squeeze-rectangular-portion (gosper-curve level) -.5 1.5 -.5 1.5)
   1000))

;;;
;;; Window procedures
;;;

(define (make-window width height name) (open-viewport name width height))
(define (close-window window) (close-viewport window))
(define (clear-window) ((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-to-position point)
  (check-valid-point point)
  (make-posn (* (x-of-point point) window-width)
	     (- window-height (* window-height (y-of-point point)))))

;;; Passed values are in the unit (0.0, 0.0) - (1.0, 1.0) coordinate system.

;;; This procedure just prints a warning if a point is out of range
(define (check-valid-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))))

(define (window-draw-point point)
  ((draw-pixel window) (convert-to-position point)))

;;; Draw a line on window from (x0, y0) to (x1, y1)

(define (window-draw-line point0 point1)
  ((draw-line window)            ;;; evaluates to function for drawing on window
   (convert-to-position point0)
   (convert-to-position point1)))

;;;
;;; Set up a graphics window
;;;

(close-graphics)
(open-graphics) 

;;; This window is hard coded into the drawing routines, so we don't need to remember
;;; to pass it.  Everytime this code is loaded, a new window will be created.

(define window (make-window window-width window-height "CS 200 Curves"))