;;; Scheme Recursive Art Contest Entry ;;; ;;; Please do not include your name or personal info in this file. ;;; ;;; Title: Pane/Pain ;;; ;;; Description: ;;; Stained glass pass no pass ;;; Broken rainbow of my dreams ;;; window panes of pain (define (draw) (define LIMIT 10) ; limit is the smallest distance between points for recursion (define (make-posn a b) (lambda (v) (if v a b))) (define (mid x y) (/ (+ x y) 2)) (define (mid2 w x y z) (/ (+ x y z w) 4)) (define (colorfunction x) (cond ((= (modulo x 5) 0) "red") ((= (modulo x 5) 1) "orange") ((= (modulo x 5) 2) "yellow") ((= (modulo x 5) 3) "green") (else "violet"))) (define (mid-point a-posn b-posn) (make-posn (mid (a-posn true) (b-posn true)) (mid (a-posn false) (b-posn false)))) (define (center-point a-posn b-posn c-posn d-posn) (make-posn (mid2 (a-posn true) (b-posn true) (c-posn true) (d-posn true)) (mid2 (a-posn false) (b-posn false) (c-posn false) (d-posn false)))) (define (too-small? a b c d) (and (< (abs (- (a true) (b true))) LIMIT) (< (abs (- (a true) (c true))) LIMIT) (< (abs (- (c true) (b true))) LIMIT) (< (abs (- (a true) (d true))) LIMIT) (< (abs (- (b true) (d true))) LIMIT) (< (abs (- (c true) (d true))) LIMIT) (< (abs (- (a false) (b false))) LIMIT) (< (abs (- (a false) (c false))) LIMIT) (< (abs (- (c false) (b false))) LIMIT) (< (abs (- (a false) (d false))) LIMIT) (< (abs (- (b false) (d false))) LIMIT) (< (abs (- (c false) (d false))) LIMIT))) (define (draw-solid-line a b) (penup) (goto (a true) (a false)) (pendown) (goto (b true) (b false)) (penup)) (define (draw-square a b c d) (begin_fill) (color "black") (draw-solid-line a b) (draw-solid-line b c) (draw-solid-line c d) (draw-solid-line d a) (color (colorfunction (* (d true) (* (b false) (* (d false) (* (c false) (* (c true) (* (a false) (* (b true ) (a true)))))))))) (end_fill) ) (define (rug a b c d) (cond [(too-small? a b c d) true] [else (and (draw-square a b c d) (rug a (mid-point a (mid-point a b)) (center-point a b c d) (mid-point a (mid-point a d))) (rug (mid-point a (mid-point a b)) (center-point a b c d) (mid-point b (mid-point a b)) (mid-point a b)) (rug b (mid-point b (mid-point a b)) (center-point a b c d) (mid-point b (mid-point b c))) (rug (mid-point b (mid-point c b)) (center-point a b c d) (mid-point c (mid-point b c)) (mid-point b c)) (rug c (mid-point c (mid-point b c)) (center-point a b c d) (mid-point c (mid-point c d))) (rug (mid-point c (mid-point c d)) (center-point a b c d) (mid-point d (mid-point d c)) (mid-point d c)) (rug d (mid-point d (mid-point a d)) (center-point a b c d) (mid-point d (mid-point c d))) (rug (mid-point a (mid-point d a)) (center-point a b c d) (mid-point d (mid-point a d)) (mid-point a d)) )])) (rug (make-posn -300 -300) (make-posn 300 -300) (make-posn 300 300) (make-posn -300 300)) (exitonclick)) ; Please leave this last line alone. You may add additional procedures above ; this line. (draw)