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