;;; Scheme Recursive Art Contest Entry ;;; ;;; Please do not include your name or personal info in this file. ;;; ;;; Title: cs61a student wakes up and gets out of bed only to find that the floor no longer exists and hasn't for quite some time such that he was up until that point as it were /falling asleep/ ;;; ;;; Description: ;;; and whilst falling thinks ;;; he: at least this is better ;;; than the scheme project (define pi 3.14159265258979) (define blue '(0.15294 0.99216 0.96078)) (define pink '(0.96863 0.39608 0.72157)) (define win '(1200 750)) (define rect '(400 800 250 500)) (define l-bg 1000000) (define l-fg 750) (define sub-bg 1000) (define sub-fg 31) ;;(define sub-fg2 35) (define (rgbl col) (rgb (cndr 0 col) (cndr 1 col) (cndr 2 col))) (define (cndr n lst) (if (= 0 n) (car lst) (cndr (- n 1) (cdr lst)))) (define (angle x y) (atan (/ y x))) (define (sq-dist x0 y0 x1 y1) (+ (expt (- x1 x0) 2) (expt (- y1 y0) 2))) (define (sq-dist-rim x y a0 a1 b0 b1) (expt (min (- x a0) (- a1 x) (- y b0) (- b1 y)) 2)) (define (dark sq-dist col bright) (let ((factor (/ bright sq-dist))) (if (> factor 1) col (list (* factor (cndr 0 col)) (* factor (cndr 1 col)) (* factor (cndr 2 col)))))) (define (sq-loop x0 y0 x1 y1 fn) (define (sq-loop-h xi yi x0 y0 x1 y1 fn) (fn xi yi) (if (<= yi y1) (if (< xi x1) (sq-loop-h (+ 1 xi) yi x0 y0 x1 y1 fn) (sq-loop-h x0 (+ 1 yi) x0 y0 x1 y1 fn) ) 'done)) (sq-loop-h x0 y0 x0 y0 x1 y1 fn)) (define (draw-bg x y col) (pixel x y (rgbl (dark (sq-dist (- sub-bg) (- sub-bg) x y) col l-bg)))) (define (draw-fg x y col) (pixel x y (rgbl (dark (sq-dist (- sub-bg) (- sub-bg) x y) (dark (sq-dist-rim x y (- (cndr 0 rect) sub-fg) (+ (cndr 1 rect) sub-fg) (- (cndr 2 rect) sub-fg) (+ (cndr 3 rect) sub-fg)) col l-fg) l-bg)))) (define (draw-pix x y) (if (and (< x (cndr 1 rect)) (> x (cndr 0 rect)) (< y (cndr 3 rect)) (> y (cndr 2 rect))) (define dr draw-fg) (define dr draw-bg)) (if (even? (floor (/ pi (angle x y)))) (dr x y blue) (dr x y pink))) (define (draw) (ht) (speed 0) (sq-loop 1 1 (cndr 0 win) (cndr 1 win) draw-pix) (exitonclick)) ; Please leave this last line alone. You may add additional procedures above ; this line. (draw)