;;;
;;; curve.ss
;;; UVA CS200 Spring 2004
;;; Problem Set 2
;;;
;;; Version 1.0.2 - updated for Spring 2004
;;; Version 1.0.1 - original for Spring 2002
(require (lib "graphics.ss" "graphics")) ;;; Load the graphics library
;;;
;;; 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 (bit) (if bit 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-worker curve t step)
(if (<= t 1.0)
(begin
(window-draw-point (curve t))
(draw-curve-worker curve (+ t step) step))))
(define (draw-curve-points curve n)
(draw-curve-worker curve 0.0 (/ 1 n)))
(define (draw-colored-curve-connected curve n color)
(define (worker t step)
(if (<= (+ t step) 1.0)
(begin
(window-draw-colored-line (curve t) (curve (+ t step)) color)
(worker (+ t step) step))))
(worker 0.0 (/ 1 n)))
(define (draw-curve-connected curve n)
(draw-colored-curve-connected curve n (make-rgb 0.0 0.0 0.0)))
;;;
;;; 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 (mid-line-orig t)
(make-point t 0.5))
(define rgb-black (make-rgb 0.0 0.0 0.0))
;;;
;;; 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 (out-of-range val)
(or (< val 0.0) (> val 1.0)))
(define (warn-coordinate coord val)
(printf "Warning: point ~a coordinate is out of range [0.0, 1.0]: ~a"
coord val))
(define (window-draw-colored-line point0 point1 rgb)
(let ((x0 (x-of-point point0))
(y0 (y-of-point point0))
(x1 (x-of-point point1))
(y1 (y-of-point point1)))
(if (out-of-range x0) (warn-coordinate "x0" x0))
(if (out-of-range x1) (warn-coordinate "x1" x1))
(if (out-of-range y0) (warn-coordinate "y0" y0))
(if (out-of-range y1) (warn-coordinate "y1" y1))
((draw-line window)
(convert-posn (make-posn x0 y0))
(convert-posn (make-posn x1 y1))
rgb)))
(define (window-draw-line point0 point1)
(window-draw-colored-line point0 point1 rgb-black))
(define (window-draw-point point)
(let ((x (x-of-point point))
(y (y-of-point point)))
(if (out-of-range x) (warn-coordinate "x" x))
(if (out-of-range y) (warn-coordinate "y" y))
((draw-pixel window) (convert-posn (make-posn x y)))))
;;;
;;; 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)))
;;;
;;; These expressions set up a window for drawing on. Note that
;;; a new window is created every time this file is reloaded.
;;;
(define window-width 600) ;;; Display window width
(define window-height 600) ;;; Display window height
(close-graphics) ;;; Closes any existing graphics window
(open-graphics) ;;; Initializes graphics