;;; Scheme Recursive Art Contest Entry ;;; ;;; Please do not include your name or personal info in this file. ;;; ;;; Title: Two fractals ;;; ;;; Description: ;;; Set recursive depth ;;; To something grand and wiser ;;; Fractal waving suns (define (caar lst) (car (car lst))) (define (cadr lst) (car (cdr lst))) (define (caddr lst) (cadr (cdr lst))) (define (cadddr lst) (caddr (cdr lst))) (define (caddddr lst) (cadddr (cdr lst))) (define (cadddddr lst) (caddddr (cdr lst))) (define (map2 fn lst result) (if (null? lst) result (map2 fn (cdr lst) (append result (list (fn (car lst))))))) (define (map fn lst) (map2 fn lst nil)) (define (min a b) (if (< a b) a b) ) (define (angle length orient ) (rt (* orient 90)) (fd length) ) (define (encode_angle length orient1 ) (* length orient)) (define (decode val) (cond ((< val 0) (angle (* -1 val) -1 ) ) ((> val 0 ) (angle val 1)) ) ) (define rad2 0.70710678118) (define nrad2 -0.70710678118) (define (dragonize base) (define (dragonate base position) (cond ((> (car base) 0 ) ; a right turn was made (cond ((> 0 position) ; horizontal (if (null? (cdr base)) (cons (* rad2 (car base)) (cons (* nrad2 (car base)) nil) ) (cons (* rad2 (car base)) (cons (* nrad2 (car base)) (dragonate (cdr base) (* -1 position)))) ) ) ((< 0 position) ; vertical (if (null? (cdr base)) (cons (* rad2 (car base)) (cons (* rad2 (car base)) nil) ) (cons (* rad2 (car base)) (cons (* rad2 (car base)) (dragonate (cdr base) (* -1 position) )))) ) ) ) ((< (car base) 0) (cond ((> 0 position) ; a left turn was made (if (null? (cdr base)) (cons (* rad2 (car base)) (cons (* rad2 (car base)) nil) ) (cons (* rad2 (car base)) (cons (* rad2 (car base)) (dragonate (cdr base) (* -1 position) ))) ) ) ((< 0 position) (if (null? (cdr base)) (cons (* rad2 (car base)) (cons (* nrad2 (car base)) nil) ) (cons (* rad2 (car base)) (cons (* nrad2 (car base)) (dragonate (cdr base) (* -1 position))))) ) )) )) (dragonate base -1) ) (define (fire dragon) (cond ((null? (cdr dragon)) (decode (car dragon))) (else (decode (car dragon)) (fire (cdr dragon))) ) ) (define hatchling (cons 100 nil) ) (define (reset) (pu) (setpos 0 0) (seth 0) (pd)) (define (blue_eyes base heads) (cond ((> heads 0) (blue_eyes (dragonize base) (- heads 1) ) ) (else (dragonize base)) )) (define (man_test x y) (cond (( < (+ (* x x) (* y y)) 4) #f) (else #t ) )) (define (maneratex x y) (+ (- (* x x) (* y y)) x) ) (define (maneratey x y) (+ (* 2 (* x y)) y) ) (define (man_color xcor ycor depth) (cond ((zero? depth) (dot 4 "black")) ((man_test xcor ycor) (cond ((= depth 5) (dot 4 "red")) ((= depth 4) (dot 4 "orange")) ((= depth 3) (dot 4 "yellow")) ((= depth 2) (dot 4 "green3")) ((= depth 1) (dot 4 "blue")) )) (else (man_color (maneratex xcor ycor) (maneratey xcor ycor) (- depth 1) ) ) )) (define (pixelate topx botx boty xcor ycor rl) (cond ((< ycor boty) nil) ((> xcor topx) ((man_color xcor ycor 5) (rt 90) (fd 4) (rt 90) (fd 4) (man_color (- xcor 0.03) (- ycor 0.03) 5) (pixelate topx botx boty (- xcor 0.03) (- ycor 0.03) -0.03 ) )) ((< xcor botx) ((man_color xcor ycor 5) (lt 90) (fd 4) (lt 90) (fd 4) (man_color (+ xcor 0.03) (- ycor 0.03) 5) (pixelate topx botx boty (+ xcor 0.03) (- ycor 0.03) 0.03) )) (else (fd 4) (man_color (+ rl xcor) ycor 5) (pixelate topx botx boty (+ rl xcor) ycor rl) ) )) (define (draw) (speed 10) (pu) (setpos -200 0) (rt -45) (pd) (color "purple") (fire (blue_eyes hatchling 8)) (color "blue") (fire (blue_eyes hatchling 8)) (color "green") (fire (blue_eyes hatchling 8)) (color "green3") (fire (blue_eyes hatchling 8)) (color "yellow") (fire (blue_eyes hatchling 8)) (color "orange") (fire (blue_eyes hatchling 8)) (color "red") (fire (blue_eyes hatchling 8)) ;(reset) (pu) (setpos -375 300) (pixelate 3 -3 -2 -3 1.2 0.03) (reset) (pu) (setpos -300 -100) (pd) (exitonclick)) ; Please leave this last line alone. You may add additional procedures above ; this line. All Scheme tokens in this file (including the one below) count ; toward the token limit. (draw)