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