Please vote for your favorite entry in this semester's 61A Recursion Exposition contest.
The winner should exemplify the principles of elegance, beauty, and abstraction that are
prized in the Berkeley computer science curriculum. As an academic community, we should strive
to recognize and reward merit and achievement.
(Voting form is located after all images)
Eligible entries contain at most 256 tokens of Scheme, not including comments or delimiters.
A fragile snowflake Stands eternally against An engulfing flame
(speed 0)
(bgcolor "black")
(ht)
(forward 30)
(left 90)
(forward 400)
(setheading 0)
(define (drawer r g b num_repeated in_angle out_angle mag size rr gg bb divisor divider factor) ; overarching draw function
(define num 70)
(define (repeat k fn) ; repeats functions, literally the most useful function ever
(if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(define (re-caller times num in_angle rr gg bb size) ; create smaller shapes
(cond
((<= times 0))
(else
(right (/ in_angle num))
(repeat mag (lambda () (forward size) (lt (* (/ 35 divider) in_angle)))) ;creates the smaller shapes
(re-caller (- times 1) num in_angle rr gg bb size))))
(define (checker r g b in_angle rr gg bb size) ; this fucntion "checks" the master_func
(cond
((< (- g gg) 0)) ; these test for when the color is "illegal" I left a few tests out because my images don't involve them
((> (- g gg) 1)
(master_func r g b in_angle rr 0 (- 0.05) size))
((> (- b bb) 1))
((< (- size factor) 0)) ; makes sure the size doesn't get too big/ too small
(else
(master_func r g b in_angle rr gg bb size))))
(define (master_func r g b in_angle rr gg bb size) ;this is just used to save space, loops stuff
(color (eval(rgb r g b)))
(re-caller (/ num (/ 35 divisor)) num in_angle rr gg bb (- size factor))
(checker (- r rr) (- g gg) (- b bb) in_angle rr gg bb (- size factor)))
; these color "capturing" calls are placed here because this is dictates the larger shapes, rather than each individual line
(repeat num_repeated (lambda () (right out_angle) (checker r g b in_angle rr gg bb size))) ; creates the LARGER shape, ie hexagon
)
(define (draw) ; I only have this function because calling (exitonclick) is easier. Waste of tokens but oh well :p
(left 4.5)
(drawer 0.59 0.89 0.99 11 60 120 3 175 0.03 0.045 0 1 1 1) ;ice
(penup)
(setheading 90)
(forward 425)
(setheading 180)
(backward 280)
(setheading 0)
(left 3)
(pendown)
(drawer 0.99 0 0 1 97 96.85 5 550 0 (- 0.05) 0 3 2 10) ;fire
(exitonclick))
(draw)
Recursive CS Three half circles per unit Sadly failed lightweight
(define (half-circle sides r right? completed) (define s (+ sides completed)) (if (= sides 0) nil (begin (fd (* 1.57 (/ r s))) (if right? (rt (/ 180 s)) (lt (/ 180 s)) ) (half-circle (- sides 1) r right? (+ completed 1)) ) ) ) (define (cs resolution radius) (pendown) (lt 90) (define r2 (* radius .5)) (half-circle resolution radius True 0) (penup) (fd r2) (lt 180) (pendown) (half-circle resolution r2 False 0) (half-circle resolution r2 True 0) (penup) (fd r2) (rt 90) ) (define (repeat resolution r depth s x y) (setpos x y) (cs resolution r) (define r1 (* r .5)) (define r3 (* r .85)) (define r4 (* r .25)) (define d1 (- depth 1)) (if (= depth 0) (penup) (let ( (dir2 (lambda () (repeat resolution r1 d1 3 x (+ y r)))) (dir1 (lambda () (repeat resolution r1 d1 4 (- x r3) (+ y r4)))) (dir3 (lambda () (repeat resolution r1 d1 2 x (- y r1)))) (dir4 (lambda () (repeat resolution r1 d1 1 (+ x r3) (+ y r4)))) ) (cond ((= s 1) (dir2) (dir4) (dir3) ) ((= s 2) (dir4) (dir1) (dir3) ) ((= s 4) (dir2) (dir1) (dir3) ) ((= s 3) (dir1) (dir2) (dir4) ) (else 0) ) ) ) ) (penup) (repeat 12 200 4 3 0 -150)
Nebulously formed Hidden symbols and bizarre beauty Frames modern art.
(define (polygon num-sides s d) (cond ((= num-sides 0) 0) (else (fd s) (rt d) (polygon (- num-sides 1) (+ s 1) d))) ) (polygon 90 1 118) (polygon 40 9 20) (polygon 20 5 90) (define (curves size amount) (cond ((= amount 0) (fd size)) (else (curves size (- amount 1)) (rt 90) (curves size (- amount 1)) (lt 90)))) (curves 1.1 10) (define (new count sides) (cond ((= count 40) 0) (else (fd sides) (rt 90) (new (+ 1 count) (+ 2 sides)))))) (new 0 2)
Christmas time is here! ...But it's also Hannukah! Snowflakes, David stars!
(define (repeat k fn)
(if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(define (hexagon fn)
(repeat 6 (lambda () (fn) (lt 60))))
(define (shape d k)
(hexagon (lambda ()
(if (= k 1) (fd d) (side d k)))))
(define (side d k)
(shape (/ d 3) (- k 1))
(penup)
(fd d)
(pendown))
(define (draw)
(shape 300 5))
(draw)
I’m failing this class and yet I just spent like nine hours making this thing
(define (cadr z) (car (cdr z)) ) (define radius .01) (define size 240) (define (newton z) (let ((denom (+ (expt (car z) 4) (expt (cadr z) 4) (* 2 (expt (car z) 2) (expt (cadr z) 2))) )) (if (= denom 0) (list 0 0) (list (/ (+ (* 2 (car z)) (/ (- (expt (car z) 2) (expt (cadr z) 2)) denom) ) 3) (/ (- (* 2 (cadr z)) (/ (* 2 (car z) (cadr z)) denom) ) 3) )))) (define (convto z d) (let ((next (newton z)) ) (cond ((< (+ (abs (- (car z) (car next))) (abs (- (cadr z) (cadr next)))) radius) (cond ((> (car z) 0) (list 'a d)) ((> (cadr z) 0) (list 'b d)) (else (list 'c d)) )) ((> d 29) (list 'd d)) (else (convto next (+ d 1))) ))) (define (drawpoint p) (let ((out (convto (list (* 1.2 (/ (car p) size)) (* 1.2 (/ (cadr p) size))) 0))) (let ((col (/ (cadr out) 30)) (x (car out))) (cond ((eq? x 'a) (color (rgb col col 1))) ((eq? x 'b) (color (rgb col 1 col))) ((eq? x 'c) (color (rgb 1 col col))) ((eq? x 'd) (color (rgb col col col))) ) ) ) (pu) (goto (car p) (cadr p)) (pd) (fd 0) (pu) ) (define (drawcolumn p) (drawpoint p) (if (= size (cadr p)) '() (drawcolumn (list (car p) (+ (cadr p) 1)))) ) (define (columniter x) (drawcolumn (list x (- size))) (if (= size x) '() (columniter (+ x 1)))) (define (draw) (columniter (- size) )) (draw)
The mission of man: To boldly go where No human has gone before
(define (draw)
(begin
(bgcolor (rgb 0 0 0))
(speed 0)
(define (draw-star-line dist min)
(begin
(define rando (random 0))
(define line-length (* dist rando))
(define variance (* rando (/ line-length 2)))
(define type (randomint 1 4))
(define accent (+ .5 (/ (random 0) 2)))
(cond
( (= type 1) (color (rgb 1 1 accent)) ) ; yellow
( (= type 2) (color (rgb 1 accent accent)) ) ; red
( (= type 3) (color (rgb accent accent 1)) ) ; blue
( else (color (rgb 1 1 1)) )
)
(forward variance)
(pd)
(forward (+ line-length min))
(pu)
(left 180)
(forward (+ (+ line-length min) variance))
)
)
(define (circle-recurse radius offset cells star-dist min-dist func location)
(if (>= location cells)
nil
(begin
(define angle (+ (* 360 (/ location cells)) offset))
(setheading (- 90 angle))
(goto (* radius (cos (radians angle))) (* radius (sin (radians angle))))
(func star-dist min-dist)
(goto 0 0)
(circle-recurse radius offset cells star-dist min-dist func (+ location 1))
)
)
)
(define (draw-ship)
(begin
(color (rgb .5 .5 .5))
(pu)
(goto 0 -330)
(setheading 270)
(pd)
(pensize 300)
(circle 1000)
(pu)
(goto 0 330)
(setheading 90)
(pd)
(circle 1000)
(pu)
(color (rgb .9 .9 .9))
(goto 0 -370)
(setheading 270)
(pd)
(circle 1000)
(pu)
(goto 0 370)
(setheading 90)
(pd)
(circle 1000)
(pu)
(color (rgb .5 .5 .5))
(pensize 30)
(setheading 0)
(goto 200 -200)
(pd)
(forward 400)
(pu)
(goto -200 -200)
(pd)
(forward 400)
)
)
(circle-recurse 10 (* 10 (random 0)) 39 150 50 draw-star-line 0)
(circle-recurse 50 (* 10 (random 0)) 75 500 50 draw-star-line 0)
(draw-ship)
(hideturtle)
(exitonclick)
)
)
(draw)
Raindrops drift apart, Recalling warmer days spent Under a clear sky.
(define phi (/ (+ 1 (sqrt 5)) 2))
(define (raindrops curr next turn colors)
(begin
(color (car colors))
(fd (/ curr 2))
(turn 108)
(fd (* phi curr))
(penup)
(turn 162)
(fd (sqrt (- (expt (* curr phi) 2) (expt (/ curr 2) 2))))
(turn 90)
(pendown)
(if (null? (cdr colors))
nil
(raindrops next (+ curr next) turn (cdr colors)))))
(define colors '("#ffffff" "#ebf0fa" "#ebf0fa" "#d6e0f5" "#c2d1f0" "#adc2eb" "#99b3e6"
"#85a3e0" "#7094db" "#5c85d6" "#4775d1" "#3366cc" "#2e5cb8" "#2952a3"
"#24478f" "#1f3d7a" "#193366" "#142952"))
(speed 0)
(bgcolor "black")
(penup)
(setposition (* -1 (/ (screen_width) 2)) (/ (screen_height) 2))
(setheading 180)
(pendown)
(raindrops 1 1 lt colors)
(penup)
(setposition (* -1 (/ (screen_width) 2)) (/ (screen_height) 2))
(setheading 90)
(pendown)
(raindrops 1 1 rt colors)
6 cups recursion 1 bucket post-midterm tears A final GO BEARS!
(define (repeat k fn) (if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(define (fd-turn length)
(fd length)
(rt 90)
)
(define (square length)
(pendown)
(begin_fill)
(repeat 4 (lambda() (fd length)(rt 90)))
(end_fill)
(penup)
)
(define (squares length count)
(cond ((> length 79) (color "red"))
((> length 55) (color "yellow"))
((> length 39) (color "orange"))
((> length 27) (color "#663300"))
((> length 19) (color "red"))
((> length 14) (color "yellow"))
((> length 9) (color "orange"))
((> length 7) (color "#663300"))
(else (color "red"))
)
(define new-len (/ length (sqrt 2)))
(square length)
(fd length) ; 'setup move'
(lt 45)
(if (= count 0) nil (squares new-len(- count 1)))
(rt 90)
(fd new-len)
(if (= count 0) nil (squares new-len (- count 1)))
(bk new-len) ; 'undo the 'setup move'
(lt 45)
(bk length)
)
(define loc (list "red" "yellow" "orange" "#663300" "red" "yellow" "orange" "#663300" "red"))
(define (draw)
; setup to fit on the screen
(bgcolor "black")
(define size 80)
(penup)
(speed 100)
(setpos -40 -50)
; begin!
(define (layers function size depth color-list)
(cond
((= depth 1) (hideturtle))
(else (
(color (car color-list))
(squares size depth)
(fd size)
(rt 90)
(fd size)
(rt 90)
(squares size depth)
(layers squares size (- depth 1) (cdr color-list))
)
)
))
(layers squares size 8 loc)
)
(draw)
That's the end, you see. Before then, I must tell you: The cake is a lie.
(speed 0)
(define (n-flake-custom fn scale sides)
(define (counter i)
(if (> i 0)
(begin
(fn scale)
(setheading (* (- i sides) (/ 360 sides)))
(left (/ 360 sides))
(counter (- i 1))
)
)
)
(counter sides)
)
(define (aperture-part factor)
(penup)
(forward (* 156 factor))
(right 90)
(forward (* 13.5 factor))
(pendown)
(begin_fill)
(left 145.6)
(forward (* 141.74 factor))
(left 58)
(circle (* (/ 512 2) factor) 41.4)
(left 125.5)
(forward (* 252.23 factor))
(end_fill)
(right 10.5)
(penup)
(right 90)
(forward (* 156 factor))
(right 90)
(forward (* 13.5 factor))
(right 90)
)
(define base 1.618)
(define (exp-fn x)
(+ (- (expt base (- x))) 1)
)
(define threshold 0.01)
(define shrinking-factor 1.75)
(define (shrink-in scale rt gt bt)
(if (> scale threshold)
(begin
(color (rgb (exp-fn rt) (exp-fn gt) (exp-fn bt)))
(n-flake-custom aperture-part scale 8)
(shrink-in (/ scale shrinking-factor) (+ rt 1) (+ gt 1) (+ bt 1))
)
(hideturtle)
)
)
(shrink-in (/ (screen_height) 600) .1 0 1)
(draw)
See lots of circles All over the lovely grid What color are they?
(define (draw)
; *YOUR CODE HERE*
; define constants
(define startX -300)
(define startY -350)
(define step 65)
(define startVal 5)
(define width 740)
(define height 740)
(define gray (rgb (/ 100 255) (/ 100 255) (/ 100 255)))
(define white (rgb (/ 255 255) (/ 255 255) (/ 255 255)))
(define pen_size 10)
; Helper functions
;-------------------
;
; translate pos
(define (trans_goto x y) (goto (+ startX x) (+ startY y) ))
; for loop
(define (for_loop start end step fn)
(if (>= start end)
nil
(begin (fn start) (for_loop (+ start step) end step fn))
)
)
; nested for loop (2 levels of nesting)
(define (for_loop_i start end step i fn)
(if (>= start end)
nil
(begin (fn i start) (for_loop_i (+ start step) end step i fn))
)
)
; draws vertical line
(define (vline x)
(penup)
(trans_goto x 0)
(pendown)
(trans_goto x height)
)
; draws horizontal line
(define (hline y)
(penup)
(trans_goto 0 y)
(pendown)
(trans_goto width y)
)
; draws circle at (i, j)
(define (draw_circle i j)
(penup)
(trans_goto (+ i 3) (- j 0) )
(pendown)
(begin_fill)
(circle 3)
(end_fill)
)
(define (draw_vcircles i)
(for_loop_i startVal height step i draw_circle)
)
; pensize color/fill color
(pencolor gray)
(fillcolor white)
(pensize pen_size)
(bgcolor (rgb 0 0 0))
; make grid
(for_loop startVal width step hline)
(for_loop startVal width step vline)
; circles
(color (rgb 1 1 1))
(for_loop startVal width step draw_vcircles)
(exitonclick))
(speed 0)
(hideturtle)
(draw)
Jumpman Jumpman Jump Man them boys up to something. Oh look, a rainbow.
(define (repeat k fn) (if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(repeat 2 (lambda ()
(bgcolor "black")
(color "white")
(repeat 9 (lambda () (circle 420 40)
(goto 0 0)))
(seth 60)
))
(define (cr size times n)
(cond ((eq? times 0))
(else (right (/ 360 n)) (circle size) (cr size (- times 1) n ))))
(seth 0)
(speed 99)
(define (loopy r1 r2 col)
(define loop r1)
(bgcolor "black")
(define rad r2)
(color col)
(cr rad loop loop)
)
(loopy 140 150 "red")
(loopy 120 130 "orange")
(loopy 100 110 "yellow")
(loopy 80 90 "green")
(loopy 60 70 "blue")
(loopy 40 50 "indigo")
(loopy 20 30 "violet")
(exitonclick))
(define (olympics)
(define (gold_medal_winners)
(print "John DeNero”)))
(define (repeat n mycolor myshade fn)
(if (> n 1) (begin (fn mycolor) (repeat (- n 1) mycolor myshade fn)) (fn myshade)))
(define (smallhex mycolor flag)
(pendown)
(color mycolor)
(if (equal? flag True) (begin_fill))
(forward 50)(right 120)(forward 50)(right 60)(forward 50)(right 120)(forward 50)
(if (equal? flag True) (end_fill))
(penup)
(left 60))
(define (bighex length width mycolor flag)
(color mycolor)
(if (equal? flag True) (begin_fill))
(pendown)
(forward length)(right 60)(forward length)(right 120)(forward width)(right 60)(forward width)(left 60)(forward width)(right 60)(forward width)
(if (equal? flag True) (end_fill))
(penup)
(right 120)(forward length)(right 60)(forward length)(right 60))
(define (ring colorone colortwo)
(repeat 3 colorone colortwo (lambda (x) (bighex 100 50 x True)))
(right 60)(forward 100)(right 120)
(repeat 3 colorone colortwo (lambda (x) (smallhex x True)))
(right 60)(forward 100)(right 120)
(repeat 3 "black" "black" (lambda (x) (bighex 100 50 x False)))
(right 60)(forward 100)(right 120)
(repeat 3 "black" "black" (lambda (x) (smallhex x False)))
(right 60)(forward 100)(left 120)(forward 100)(left 60)(forward 100)(left 60))
(define (draw)
(hideturtle)(speed 0)
(penup)(left 90)(forward 300)(right 90)
(ring "#0085c7" "#006496")(ring "#242424" "#171717")(ring "#df0024" "#a1001a")
(left 90)(forward (* 5 (sqrt 7500)))(left 90)(forward 150)(right 180)
(ring "#f4c300" "#be9800")(ring "#009f3d" "#087b39")
(exitonclick))
(draw)
Diamonds in the sky Nested inside each other Like Scheme procedures
(define (draw-line angle side-length)
(left angle)
(forward side-length)
(backward side-length)
(right angle) )
(define (draw-triangle height)
(forward height)
(backward height)
(define (helper i end)
(if (not (eq? i end))
(let ((height-interval (/ height 5)))
(let ((bottom (* i height-interval))
(side (- height (* height-interval (- i 1)))) )
(let ((hypot (sqrt (+ (expt bottom 2) (expt side 2))))
(angle (degrees (atan (/ bottom side)))) )
(draw-line angle hypot) ))
(begin
(forward height-interval)
(helper (+ i 1) end) ))))
(helper 1 6)
(draw-line 90 height) )
(define (draw-diamond height)
(pendown)
(define (construct-triangles height)
(draw-triangle (/ height 2))
(left 90)
(forward (/ height 2))
(left 180) )
(construct-triangles height)
(construct-triangles height)
(construct-triangles height)
(construct-triangles height)
(penup) )
(define (draw-group length iteration)
(if (< iteration 5)
(begin
(right 90)
(draw-diamond length)
(left 90)
(forward length)
(right 90)
(draw-diamond length)
(forward length)
(draw-diamond length)
(right 90)
(forward length)
(left 90)
(draw-diamond length)
(let ((new-length (+ (- (/ length 2) (/ 20 iteration)) iteration)))
(left 180)
(forward (- (* (/ new-length 2) (sin (degrees 45))) (/ new-length 20)))
(right 90)
(forward (- (/ length 20) (/ length 100)))
(left 45)
(draw-group new-length (+ iteration 1)) ))))
(define (draw)
(color "#0477cb")
(draw-group 300 1)
(hideturtle)
(exitonclick) )
(bgcolor "#090909")
(penup)
(setpos -300 -150)
(speed 0)
(draw)
When I do CS This always seems to happen 5th one burnt this year
(define (repeat k fn)
(if (> k 0)
(begin (fn) (repeat (- k 1) fn))
'done))
(define (screen)
(penup)
(goto -200 100)
(pendown)
(forward 100)
(right 90)
(forward 200)
(right 90)
(forward 100)
(right 90)
(forward 200)
(right 90)
(penup)
(goto -190 110)
(pendown)
(forward 80)
(right 90)
(forward 180)
(right 90)
(forward 80)
(right 90)
(forward 180)
(right 90)
(penup)
(goto -200 100)
(right 90)
)
(define (keyboard n)
(pendown)
(right 45)
(forward n)
(left 45)
(forward 200)
(left 135)
(forward n)
(penup)
(right 135)
)
(define (code m n levels)
(goto m n)
(pendown)
(if (> levels 1)
(begin (repeat 1 (lambda () (forward 150) (penup)))
(code m (- n 25) (- levels 1))))
(penup)
)
(define (fire)
(pendown)
(left 45)
(forward 50)
(right 45)
(forward 100)
(right 135)
(forward 45)
(left 90)
(forward 45)
(right 90)
(forward 45)
(left 90)
(forward 45)
(right 90)
(forward 45)
(left 90)
(forward 45)
(right 90)
(forward 45)
(left 90)
(forward 45)
(right 135)
(forward 97)
(right 45)
(forward 55)
(right 45)
(forward 180)
(penup)
)
(screen)
(keyboard 100)
(code -175 175 4)
(left 90)
(goto -190 110)
(fire)
(goto 0 0)
Shahrazad, all your stories seem so different, yet sound the same to me.
(define (law_of_cosines a b gamma) (sqrt (- (+ (* a a) (* b b)) (* (* (* 2 a) b) (cos (radians gamma)))))) (define (draw n scale color_scale persp_angle side_length red green blue) (if (> n 0) (begin (speed 0) ; UTILITY FUNCTIONS (define (go) (forward side_length)) ; go forward by the length of one side (define (fillcolor_deep_sky_blue scale) ; set the fill color to "deep sky blue" scaled by SCALE (fillcolor (rgb (* scale red) (* scale green) (* scale blue)))) ; draw the ceiling (define persp_angle_complement (- 180 persp_angle)) (pendown) (fillcolor_deep_sky_blue 0.9) (begin_fill) (right persp_angle_complement) (go) (right (* 2 persp_angle)) (go) (right (- 180 (* 2 persp_angle))) (go) (right (* 2 persp_angle)) (go) (end_fill) ; draw the left wall (backward side_length) (setheading 180) (fillcolor_deep_sky_blue 1) (begin_fill) (go) (define lower_left (position)) ; save position of the lower-left corner (left persp_angle) (go) (left persp_angle_complement) (go) (end_fill) ; draw the right wall (backward side_length) (right persp_angle) (fillcolor_deep_sky_blue 0.8) (begin_fill) (go) (left persp_angle) (go) (left persp_angle_complement) (go) (end_fill) (backward side_length) ; draw the dome (define ceil_diagonal (law_of_cosines side_length side_length (* 2 persp_angle))) (define radius (* 0.4 ceil_diagonal)) (setheading 270) (penup) (forward (* 0.1 ceil_diagonal)) (pendown) (right 90) (fillcolor (rgb 0.855 0.647 0.125)) (begin_fill) (circle radius 180) (left 90) (define beta (- 90 (degrees (atan 3)))) (right beta) (circle (sqrt (* 10 (* radius radius))) (* 2 beta)) (end_fill) ; go to the right smaller dome (penup) (setheading 90) (forward (* 0.1 ceil_diagonal)) (right 90) (forward (* 0.5 side_length)) (setheading 0) ; draw the right child (draw (- n 1) scale color_scale persp_angle (* scale side_length) (* color_scale red) (* color_scale green) (* color_scale blue)) ; draw the left child (penup) (setposition (car lower_left) (car (cdr lower_left))) (forward (* scale side_length)) (draw (- n 1) scale color_scale persp_angle (* scale side_length) (* color_scale red) (* color_scale green) (* color_scale blue)) ) nil )) (setposition 0 100) (draw 7 0.5 0.7 65 150 0 0.749 1) (hideturtle)
With blood, sweat and tears, you trudged through this course with pain. Now, your colors show.
(define (helper1 n firstn type) (if (not (equal? n (/ firstn 2))) (begin (pendown) (if (equal? type 2) (penup)) (fd n) (if (equal? type 2) (pendown)) (fd n) (rt 90) (if (equal? type 1) (penup)) (fd n) (rt 90) (helper2 (- n 2) firstn type) ))) (define (helper2 n firstn type) (if (not (equal? n (/ firstn 2))) (begin (pendown) (cond ((equal? type 1) (penup)) ((equal? type 0) (penup)) ((equal? type 2) (penup)) ((equal? type 6) (penup))) (fd n) (cond ((equal? type 2) (pendown)) ((equal? type 6) (pendown))) (fd n) (if (equal? type 0) (pendown)) (rt 90) (if (equal? type 3) (penup)) (fd n) (rt 90) (helper1 (- n 2) firstn type) ))) (bgcolor "black") (penup) (ht) (speed 0) (setpos -400 -100) (color "red") (helper1 100 100 0) (penup) (color "orange") (setpos -250 -100) (rt 180) (helper1 100 100 2) (penup) (color "yellow") (setpos 0 -100) (rt 180) (helper1 100 100 6) (penup) (color "green") (setpos 150 -100) (rt 180) (helper1 100 100 1) (penup) (color "blue") (setpos 250 -100) (rt 180) (helper1 100 100 3) (penup) (pixelsize 3) (color "purple") (setpos -225 0) (rt 270) (pendown) (fd 50) (penup) (fd 200) (pendown) (fd 50) (penup) (fd 200) (pendown) (fd 50) (exitonclick)
(speed 10)
(define (repeat k fn)
(if (> k 1)
(begin (fn) (repeat (- k 1) fn))
(fn)))
(define (hexagon d)
(color "red")
(begin_fill)
(repeat 6 (lambda () (fd d) (lt 60)))
(end_fill))
(define (spiral d k)
(if (= k 1)
(begin
(fd (* .25 d)) (begin_fill) (lt 60) (fd (* .15 d)) (rt 45) (fd (* .2 d))
(rt 135) (fd (* .15 d)) (rt 45) (fd (* .2 d)) (lt 165) (end_fill)
(fd (* .75 d))(hexagon (/ d 5))
(color "#a52a2a") (lt 30) (fd (/ d 4)) (lt 80) (fd (/ d 6))
(lt 80) (fd (/ d 6)) (lt 90) (fd (/ d 7)) (lt 120) (fd (/ d 8))
(penup)(lt 18.92050725)(bk (* .2245733876 d))(rt 58.92050725)(pendown)
(repeat 6 (lambda () (fd (/ d 5)) (lt 60)))
(color "#006400"))
(begin (leg d k) (spiral d 1))))
(define (leg d k)
(spiral (* .825 d) (- k 1))
(penup)
(lt 180)
(fd (* .5 d))
(lt 110)
(pendown))
(bgcolor "#71C671")
(color "#006400")
(spiral 1000 20)
(ht)
Recursive quadtrees create beautiful image of rather tall man.
These falling fractals Impossible yet here, So quiet, so cold
(define (shp l d) (pendown) (cond ((= d 0) (fd l)) (else (draw l d)) ) ) (define (draw l d) (shp (/ l 3) (- d 1)) (lt 60) (shp (/ l 3) (- d 1)) (rt 120) (shp (/ l 3) (- d 1)) (lt 60) (shp (/ l 3) (- d 1)) ) (define (sn l d s) (cond ((= 0 s) (penup)) (else (shp l d) (rt 72) (sn l d (- s 1))) ) ) (define (circ s dp hd n) (cond ((not (= 0 dp)) (color (cc n)) (sn s hd 5) (right 30) (fd (/ s 2.5)) (if (= (modulo dp 2) 0) (circ (/ s 1.75) (- dp 1) (- hd 1) (- n 1)) (circ (/ s 1.75) (- dp 1) hd (- n 1)) ) ) ) ) (bg "#000000") (hideturtle) (speed 0) (penup) (goto -220 -180) (circ 350 9 4 7)
Rainbow galaxies A Recursive Collision Take Astro C10
(define (spiral n times r g b)
(cond ((< n times)
(cond ; Set the rgb color
((and (> r b) (= g 0) (< b 0.98)) (define b (+ b 0.02)))
((and (> r 0.05) (= g 0)) (define r (- r 0.02)))
((and (< g 0.98) (< r .1)) (define g (+ g 0.02)) (define r 0))
((> b 0.05) (define b (- b 0.02)))
((< r 0.98) (define r (+ r 0.02)) (define b 0))
((> g 0.05) (define g (- g 0.02)))
(else (define g 0)))
(color (rgb r g b))
(fd (* .83 n))
(rt 89)
(spiral (+ n 1) times r g b))))
(define (draw)
(hideturtle)
(bgcolor (rgb 0 0 0))
(speed 0)
(spiral 1 386 1 0 0)
(spiral 1 299 0 1 0)
(spiral 1 150 0 0 1)
(spiral 1 100 1 0 0))
(draw)
The brilliance of your visage reflects the beauty of your soul, a dazzle of pristine perfection.
(define (draw)
; BEGIN Question 21
(define (bow)
(penup)
(fd 100)
(lt 90)
(fd 200)
(pendown)
(define v 20)
(define i 360)
(define a 20)
(define (angle i v a)
(cond ((> i 0)
(begin (seth i)
(circle v)
(penup)
(fd a)
(pendown)
(angle (- i 15) v a)))))
(define (smaller i)
(penup)
(fd 50)
(pendown)
(define v 40)
(define i 360)
(define a 16)
(angle i v a)
(penup)
(lt 100)
(fd 15)
(pendown))
(color "red")
(smaller i)
(color "green")
(smaller i)
(color "yellow")
(lt 80)
(fd 12)
(smaller i)
(color "purple")
(lt 145)
(fd 30)
(smaller i)
(color "orange")
(lt 208)
(fd 40)
(smaller i)
(penup)
(fd 100)
(lt 52)
(pendown)
(color "black")
(circle 200)
(penup)
(fd 10)
(rt 245)
(pendown)
(begin_fill)
(circle 35)
(end_fill))
(define (create num)
(cond ((= 0 num))
(else (begin
(rt 25)
(fd 100)
(lt 15)
(fd 150)
(lt 20)
(fd 160)
(penup)
(lt 180)
(fd 160)
(rt 20)
(fd 150)
(rt 15)
(fd 100)
(rt 90)
(fd 5)
(rt 90)
(pendown)
(lt 25)
(create (- num 1))))))
(bow)
(penup)
(lt 270)
(fd 400)
(rt 180)
(pendown)
(create 17)
(penup)
(rt 13)
(fd 350)
(rt 90)
(pendown)
(circle 210 85)
(penup)
(circle 210 274)
(lt 60)
(fd 7)
(rt 130)
(fd 60)
(lt 90)
(fd 130)
(pendown)
(begin_fill)
(circle 10)
(penup)
(lt 12)
(fd 115)
(pendown)
(circle 10)
(end_fill)
(penup)
(rt 100)
(fd 30)
(rt 80)
(fd 51)
(lt 90)
(pendown)
(fd 30)
(lt 90)
(fd 25)
(penup)
(fd -55)
(rt 90)
(fd 60)
(pendown)
(color "red")
(circle 40 180)
(hideturtle)
(exitonclick))
(draw)
Eligible entries contain at most 2048 tokens of Scheme, not including comments or delimiters.
Winter is coming... Colder than my frozen soul after midterm two.
(define (cadr x) (car (cdr x)))
(define (caddr x) (car (cdr (cdr x))))
(define (min x y) (if (> x y) y x))
(define (max x y) (if (> x y) x y))
(define white (list 1 1 1))
(define black (list 0 0 0))
(define std-brown (list 0.549 0.392 0.196))
(define std-green (list 0.157 0.706 0.235)) ; 40 180 60
(define cloud-white (list 1 1 1))
(define snow-white (list 0.980 0.992 0.996))
(define cyan-leaf (list 0.451 0.988 0.941))
(define burgundy (list 0.482 0.0157 0.341))
(define dk-brown (list 0.271 0.149 0.0275))
(define cyan-grass (list 0.149 0.949 0.749))
(define light-ocean (list 0.251 0.498 0.906))
(define shadow-brown (list 0.2 0.36 0.7))
(define shadow-leaf (list 0.3 0.46 0.8))
(define dark-ocean (list 0.106 0.267 0.533))
(define sun-orange (list 0.984 0.635 0.094))
(define (truncate colar)
; takes a color list and truncates values so that it is legal
(list (min 1 (car colar)) (min 1 (cadr colar)) (min 1 (caddr colar)))
)
(define (branch-rgb color depth homogeneity)
; greater homogeneity = less gradient. Set to ~10
; greater depth = darker
(define (scale x)
(min 1 (/ x (/ (+ depth homogeneity) homogeneity))))
(list (scale (car color)) (scale (cadr color)) (scale (caddr color)))
)
(define (branch-color colar)
(let ((colar (truncate colar)))
(rgb (car colar) (cadr colar) (caddr colar))))
(define (random-color colar seed homogeneity)
; homogeneity from 0 to 1, takes a list color, returns a RGB color
(branch-color (list
(variation (car colar) homogeneity seed)
(variation (cadr colar) homogeneity seed)
(variation (caddr colar) homogeneity seed))
)
)
(define (random low high seed)
; pseudo-random number generation by linear congruence
(let ((a 22695477) (c 1) (m (expt 2 8)))
(+ low (* (/ (modulo (+ c (* a seed)) m) m) (- high low)))
)
)
(define (next-seed seed) (floor (random 0 22695477 seed)))
(define (variation value degree seed)
(random (* (- 1 degree) value) (* (+ 1 degree) value) seed)
)
(define (variation-fixed value amount seed)
(random (- value amount) (+ value amount) seed)
)
(define (willow colar leaf-colar leaf-angle thickness x y root-len root-ang right-scale right-ang mid-scale left-scale left-ang depth)
(width thickness)
(rt root-ang)
(pu)
(setpos x y)
(pd)
(define (willow-leaf scale angle length seed)
(define this-angle (heading))
(define this-width (* scale thickness))
(width 1)
(seth (variation-fixed angle 2 seed))
(fd length) (bk length)
(seth this-angle)
(width this-width)
)
(define (recurse-branch scale depth seed)
(define (apply-recursion)
(define this-width (* scale thickness))
(define this-color (branch-color (branch-rgb colar depth 5)))
(width this-width)
(color this-color)
(fd (* 0.6 scale root-len))
(rt right-ang) (recurse-branch (* scale right-scale) (- depth 1) (next-seed seed)) (lt right-ang)
(bk (* 0.6 scale root-len))
(fd (* 0.8 scale root-len))
(lt left-ang) (recurse-branch (* scale left-scale) (- depth 1) (next-seed (* 3 seed))) (rt left-ang)
(bk (* 0.8 scale root-len))
(fd (* scale root-len))
(recurse-branch (* scale mid-scale) (- depth 1) (next-seed (* 5 seed)))
(bk (* scale root-len))
(width this-width) (color this-color)
)
(define this-color colar)
(if (< depth 5) (color (random-color leaf-colar seed 0.5)))
(if (= depth 0) (begin (if (= (modulo seed 12) 0) (willow-leaf scale leaf-angle (* 1.25 root-len) seed)))
(begin (define colar this-color) (apply-recursion)))
)
(recurse-branch 1 depth 283179)
(lt root-ang)
)
(define sqrt-2 (sqrt 2))
(define (cloud colar x y root-ang size depth angle)
(rt root-ang)
(pu)
(setpos x y)
(pd)
(define (recurse-cloud size depth angle seed)
(cond
((= depth 0) (begin
(color (random-color colar seed 0.1))
(width (variation 15 0.6 seed))
(fd size)))
(else
(rt angle)
(recurse-cloud (/ size sqrt-2) (- depth 1) 45 (next-seed (* seed 3)))
(lt (* angle 2))
(recurse-cloud (/ size sqrt-2) (- depth 1) (- 45) (next-seed (* seed 5)))
(rt angle))))
(recurse-cloud size depth angle 432513))
(define (fern size)
(if (> size 3) (begin
(fd (/ size 20)) (lt 80) (fern (* 0.3 size)) (rt 82)
(fd (/ size 20)) (rt 80) (fern (* 0.3 size)) (lt 78)
(fern (* 0.9 size))
(lt 2) (fd (/ size -20)) (lt 2) (fd (/ size -20))
))
)
(define (grass colar height length wideness root-angle angle-var density scatter)
; default depth 8
; density = blades per 100 pixels length
(define max-depth 8)
(define this-y (ycor))
(rt root-angle)
(define (blade height wideness angle depth)
(if (> depth 0) (begin
(width wideness)
(rt (/ angle max-depth)) (fd (/ height max-depth))
(blade height (* wideness 0.82) angle (- depth 1))
(bk (/ height max-depth)) (lt (/ angle max-depth))))
)
(define (draw-grass deflection count height-seed angle-seed)
(if (> count 0) (begin
(color (random-color colar height-seed 0.4)) ; updated based on random
(pu) (fd deflection) (pd)
(blade
(variation height 0.25 height-seed)
(variation wideness 0.3 height-seed)
(variation-fixed 0 angle-var angle-seed)
max-depth)
(pu) (bk deflection) (rt 90) (fd (/ 100 density)) (lt 90) (pd)
(draw-grass (variation-fixed 0 scatter angle-seed) (- count 1)
(next-seed height-seed) (next-seed (* 3 angle-seed)))))
)
(draw-grass 0 (* density (/ length 100)) 84371 48750)
(lt root-angle)
)
(define (moveto x y)
(pu) (setpos x y) (pd)
)
(define (reset)
(moveto 0 0)
(seth 0)
)
(define (gradient color1 color2 start-y end-y)
; colors as lists
; asserts that end-y > start-y
(define y-length (- end-y start-y))
(define r-diff (/ (- (car color2) (car color1)) y-length))
(define g-diff (/ (- (cadr color2) (cadr color1)) y-length))
(define b-diff (/ (- (caddr color2) (caddr color1)) y-length))
(reset) (rt 90) (width 1)
(define (paint y colar)
(if (< y end-y) (begin
;(let (
; (r-inc (+ (car color1) (/ (- (car color2) (car color1)) y-length)))
;
; ))
(moveto -360 y) (color (branch-color colar))
(fd 720)
(paint (+ y 1) (list (+ (car colar) r-diff)
(+ (cadr colar) g-diff)
(+ (caddr colar) b-diff)))
))
)
(paint start-y color1)
)
(define sun (list 0 0))
(define black (list 0 0 0))
(define resolution 5)
(define size (min (floor (/ 1920 resolution)) (floor (/ 1920 resolution))))
(define w 360)
(define height 337.5)
(define (make-bgcolor-sky x y)
(if (< y (cadr sun)) black
(begin
(define start-color (list (- 0.957 (* 0.001295 y)) (- 0.980 (* 0.0006 y)) (+ 0.345 (* 0.00055 y))))
(define x-dif (abs (- x (car sun))))
(list (- (car start-color) (* 0.000206 x-dif)) (- (cadr start-color) (* 0.0010 x-dif)) (+ (caddr start-color) (* 0.00065 x-dif)))
)
)
)
(define (make-bgcolor-ocean x y)
(if (> y (cadr sun)) black
(begin
(define start-color (list 0.957 0.980 0.345))
(define x-dif (abs (- x (car sun))))
(define processed-color (list (max 0 (- (car start-color) (* 0.00200 x-dif)))
(- (cadr start-color) (* 0.00133 x-dif))
(+ (caddr start-color) (* 0.00181 x-dif))))
(list (min 1 (+ (car processed-color) (* (/ (* y y) (* 337.5 337.5)) 0.106)))
(- (cadr processed-color) (* (/ (* y y) (* 337.5 337.5)) 0.235))
(max 0 (- (caddr processed-color) (* (/ (* y y) (* 337.5 337.5)) 0.400))))
)
)
)
(define (draw-pixel size couleur x y)
(pu)
(goto x y)
(color (rgb (car couleur) (cadr couleur) (caddr couleur)))
(pd)
(begin_fill)
(fd size)
(rt 90)
(fd size)
(rt 90)
(fd size)
(rt 90)
(fd size)
(rt 90)
(end_fill)
)
(define (render-sky)
(paint-sky size
(lambda (x y)
(define color (make-bgcolor-sky x y))
(draw-pixel resolution color x y)
)
)
)
(define (render-ocean)
(paint-ocean size
(lambda (x y)
(define color (make-bgcolor-ocean x y))
(draw-pixel resolution color x y)
)
)
)
(define (paint-sky size procedure)
(define (pixellate x y)
(if (>= y height) nil
(if (>= x w)
(pixellate -360 (+ y resolution))
(begin (procedure x y) (pixellate (+ x resolution) y))
)
)
)
(pixellate -360 0)
)
(define (paint-ocean size procedure)
(define (pixellate x y)
(if (<= y (- 0 height)) nil
(if (>= x w)
(pixellate -360 (- y resolution))
(begin (procedure x y) (pixellate (+ x resolution) y))
)
)
)
(pixellate -360 -5)
)
(define (draw)
(render-sky)
(render-ocean)
(reset)
(grass white 120 300 1 90 0 15 300) (reset)
(color (branch-color snow-white)) (moveto 80 -337.5) (lt 50) (begin_fill) (circle 600 180) (end_fill) (reset)
; (cloud colar x y root-ang size depth angle)
(cloud snow-white -250 -470 0 160 10 45)
(cloud snow-white -200 -470 0 180 10 45)
(cloud snow-white -120 -430 0 190 10 45)
(cloud snow-white 0 -450 0 180 10 45)
(cloud snow-white 80 -440 0 170 10 45)
(reset)
;(willow colar leaf-colar leaf-angle thickness x y root-len root-ang right-scale right-ang mid-scale left-scale left-ang depth)
(willow dk-brown cyan-leaf 180 22 -200 -250 120 9 0.69 25 0.60 0.72 30 7) (reset)
(cloud snow-white -225 -265 -80 30 10 45) (reset)
(willow dk-brown cyan-leaf 180 30 540 -450 300 -8 0.72 27 0.59 0.68 32 8) (reset)
(moveto 30 0) (width 1) (color (branch-color sun-orange)) (begin_fill) (circle 30 180) (end_fill) (hideturtle)
)
(speed 0)
(tracer 0 0)
(draw)
(update)
(done) ; must be the LAST statement in the file
Throw a pokéball? How else will you catch em' all-- Hey! Want to battle!
(pixelsize 2)
(define num_reflections 2)
(define width (screen_width))
(define height (screen_height))
(define (cadr l) (car (cdr l)))
(define (cddr l) (cdr (cdr l)))
(define (caddr l) (car (cddr l)))
(define (caar l) (car (car l)))
(define for (mu (body i) (if (< i 1) (eval body) (begin (eval body) (for body (- i 1))))))
(define (min x y) (if (< x y) x y))
(define (max x y) (if (< x y) y x))
(define (min_first l) (if (null? l) '((100000000000 ())) (begin
(define m (min_first (cdr l)))
(if (< (caar l) (caar m)) l
m))))
(define (filter_first l condition) (if (null? l) nil
(if (condition (caar l)) (cons (car l) (filter_first (cdr l) condition))
(filter_first (cdr l) condition))))
(define (combine p1 p2) (if (null? p1) nil (cons (list (car p1) (car p2)) (combine (cdr p1) (cdr p2)))))
(define (map f l) (if (null? l) nil (cons (f (car l)) (map f (cdr l)))))
(define (add a b) (list (+ (car a) (car b)) (+ (cadr a) (cadr b)) (+ (caddr a) (caddr b))))
(define (subtract a b) (list (- (car a) (car b)) (- (cadr a) (cadr b)) (- (caddr a) (caddr b))))
(define (dot a b) (+ (* (car a) (car b)) (* (cadr a) (cadr b)) (* (caddr a) (caddr b))))
(define (scale a c) (list (* (car a) c) (* (cadr a) c) (* (caddr a) c)))
(define (normalize a) (scale a (/ 1 (sqrt (dot a a)))))
(define (magnitude v) (sqrt (dot v v)))
(define camera '(0 1 0))
(define light '(0 1 0.5))
(define black '(0 0 0))
(define white '(1 1 1))
(define red '(1 0 0))
(define green '(0 1 0))
(define blue '(0 0 1))
(define yellow (add red green))
(define ambient 0.15)
(define shapes '(; x y z
; Pokeball
(20 (0 0 50) ''wr)
(25 (40 20 30) '(find Venusaur))
(25 (-40 20 30) '(find Charizard))
(25 (40 -29 30) '(find Blastoise))
(25 (-40 -25 30) '(find Pikachu))
))
(define Venusaur '(
(15 (40 20 30) '(0.059 1 0.1666)) ; Green sphere
(8 (40 35 30) '(0.94117647 0.50196078 0.50196078)) ; (240, 128, 128) light pink
(8 (35 35 30) '(0.94117647 0.50196078 0.50196078)) ; (240, 128, 128) light pink
(8 (45 35 30) '(0.94117647 0.50196078 0.50196078)) ; (240, 128, 128) light pink
;(12 (40 35 29) '(0.545098 0.270588 0.0745098)) ; brown (139 69 19)
(9 (46 19 37) black) ; eyes
(9 (34 19 25) black)
))
(define Charizard '(
(15 (-40 20 30) '(1 0.6470588 0)) ; Orange sphere
(10 (-32 24 25) '(0.125490196 0.6 0.8)) ; wings
(10 (-48 24 25) '(0.125490196 0.8 0.6)) ; wings
;(4 (-10 12 32) yellow) ; fire
;(3 (-8 10.5 32) white)
(3 (-37 24 25) black) ; eyes
(3 (-29 17 30) black)
))
(define Blastoise '(
(15 (40 -29 30) '(0.2745 0.5098 0.7058)) ; Blue sphere 70-130-180
(9 (32 -29 30) '(0.9 0.72 0.64)) ; tan belly ~255-250-205
(5 (38 -19 25) '(0.933 0.933 0.878)) ; cannons 238-238-224
(4 (40 -19 27) '(0.933 0.933 0.878))
(2 (30 -19 25) black) ; eyes
(2 (44 -19 27) black)
))
(define Pikachu '(
(15 (-40 -29 30) yellow) ; Yellow sphere
(7 (-45 -22 20) red) ; cheek pouch
(7 (-40 -29 45) red)
;(5 (-27.5 -29 37.5) black) ; eyes
;(3 (-40 -29 30) black)
))
(define front '(0 0 30))
(define (render) (let ((size (min width height)))
(for
'(let ((x i)) (for
'(let ((y i)
(color (scale (trace_ray camera (normalize (list (- (/ x size) 0.5) (- (/ i size) 0.5) 1)) num_reflections shapes) 0.95)))
(pixel x y (rgb (car color) (cadr color) (caddr color))))
size)) size)))
(define (trace_ray source direction depth shape_list)
(if (= depth num_reflections) (define shape_list (list (car shapes))))
(define distances (map (lambda (shape) (intersect_sphere source direction shape 0.01)) shape_list))
(define hits (filter_first (combine distances shape_list) (lambda (d) (not (null? d)))))
(if (null? hits) black
(begin (define pair (min_first hits))
(define shape (cdr (cadr (car pair))))
(define color (eval (cadr shape)))
(if (eq? (car color) 'find) (trace_ray source direction depth (eval (cadr color)))
(begin
(define distance (caar pair))
(define center (car shape))
(define surface (add source (scale direction distance)))
(if (eq? color ''wr) (define color (find_color center source surface)))
(illumination surface center color direction depth))))))
(define (find_color center source surface)
(define locator (subtract center (add source surface)))
(define y (cadr locator))
(define from_front (magnitude (subtract front locator)))
(cond
((< from_front 10.5) white)
((< from_front 11) black)
(else (if (> y 1) white (if (< y -1) red black))))
)
(define (illumination surface center color direction depth)
(define to_surface (normalize (subtract surface center)))
(define to_light (normalize (subtract light surface)))
(define intensity (max ambient (dot to_light to_surface)))
(define direct (scale color intensity))
(if (= depth 1) direct
(begin (define cosine (dot direction to_surface))
(define bounce (subtract direction (scale to_surface (* 2 cosine))))
(define reflected (trace_ray surface bounce (- depth 1) shapes))
(mix direct reflected (+ 0.3 (* 0.7 (expt intensity 30)))))))
(define (mix a b r) (add (scale a r) (scale b (- 1 r))))
(define (intersect_sphere source direction sphere min_distance)
(define radius (car sphere))
(define center (cadr sphere))
(define v (subtract source center))
(define b (- (dot v direction)))
(define v2 (dot v v)) (define r2 (* radius radius)) (define d2 (+ (* b b) (- v2) r2))
(if (> d2 0)
(if (> (- b (sqrt d2)) min_distance) (- b (sqrt d2))
(if (> (+ b (sqrt d2)) min_distance) (+ b (sqrt d2)) nil)) nil))
(ht)
(render)
(exitonclick)
(define camera '(0 1 0))
(define light '(2 2 0))
(define black '(0 0 0))
(define (cadr x) (car (cdr x)))
(define (caddr x) (car (cdr (cdr x))))
(define min_distance 0.01)
(define block 1)
(define size (/ (screen_height) block))
(pixelsize 1)
(define (left-spheres x)
(cond
((= x 0) '())
(else (cons (list 1 (list 2 1 (+ x 3)) (list 0 0 1)) (left-spheres (- x 1))))))
(define (right-spheres x)
(cond
((= x 0) '())
(else (cons (list 1 (list -2 1 (+ x 3)) (list 0 0 1)) (right-spheres (- x 1))))))
(define spheres (append (append (left-spheres 5) (right-spheres 5))
'((500 (0 -500 0) (1 1 0))
(500 (0 502 0) (1 1 0)))))
(define (add a b)
(if (null? a)
'()
(cons (+ (car a) (car b)) (add (cdr a) (cdr b)))))
(define (subtract a b)
(add a (scale b -1)))
(define (dot a b)
(if (null? a)
0
(+ (* (car a) (car b)) (dot (cdr a) (cdr b)))))
(define (scale a k)
(if (null? a)
'()
(cons (* k (car a)) (scale (cdr a) k))))
(define (normalize a)
(let ((mag (sqrt (dot a a))))
(scale a (/ 1 mag))))
(define (create-color color-list)
(rgb (car color-list) (cadr color-list) (caddr color-list)))
(define (map fn lst)
(if (null? lst)
'()
(cons (fn (car lst)) (map fn (cdr lst)))))
(define (filter fn lst)
(cond
((null? lst) '())
((fn (car lst)) (cons (car lst) (filter fn (cdr lst))))
(else (filter fn (cdr lst)))))
(define (join lst1 lst2)
(if (null? lst1)
'()
(cons (list (car lst1) (car lst2)) (join (cdr lst1) (cdr lst2)))))
(define (min fn lst)
(cond
((null? (cdr lst)) (car lst))
((< (fn (car lst)) (fn (min fn (cdr lst)))) (car lst))
(else (min fn (cdr lst)))))
(define (mix a b r)
(add (scale a r) (scale b (- 1 r))))
(define (trace-ray source direction depth)
;(display "In Trace ray\n")
(begin
(define distances
(map (lambda (sphere) (intersect source direction sphere)) spheres))
;(display distances)
;(display "\n")
(define hits
(filter (lambda (x) (> (car x) 0)) (join distances spheres)))
;(display hits)
(if (null? hits)
black
(begin
(define object (min (lambda (x) (car x)) hits))
(define distance (car object))
(define sphere (cadr object))
(define center (cadr sphere))
(define color (caddr sphere))
(define surface (add source (scale direction distance)))
(illumination surface center color direction depth)))))
(define (illumination surface center color direction depth)
;(display "In illumination\n")
(begin
(define to_surface (normalize (subtract surface center)))
(define to_light (normalize (subtract light surface)))
(define intensity (if (> 0.2 (dot to_light to_surface))
0.2
(dot to_light to_surface)))
(define direct (scale color intensity))
(if (= depth 1)
direct
(begin
(define cosine (dot direction to_surface))
(define bounce (subtract direction (scale to_surface (* 2 cosine))))
(define reflected (trace-ray surface bounce (- depth 1)))
(mix direct reflected (+ 0.5 (* (expt intensity 30) 0.5)))))))
(define (intersect source direction sphere)
;(display "In intersect\n")
;(display sphere)
(begin
(define radius (car sphere))
(define center (cadr sphere))
(define v (subtract source center))
(define b (* -1 (dot v direction)))
(define d2 (+ (* radius radius) (- (* b b) (dot v v))))
(if (<= d2 0)
0
(let ((d (list (- b (sqrt d2)) (+ b (sqrt d2)))))
(cond
((< min_distance (car d)) (car d))
((< min_distance (cadr d)) (cadr d))
(else 0))))))
(define (render)
;(display "Inside render")
(define (helperx x)
(print "Column rendered")
(define (helpery y)
(if (> y 0)
(begin
(pixel x y (create-color (scale
(trace-ray camera (normalize
(list (- (/ x size) 0.5)
(- (/ y size) 0.5) 1)) 4)
0.95)))
(helpery (- y 1)))))
(if (> x 0)
(begin
(helpery size)
(helperx (- x 1)))))
(helperx size))
(print "Ready to Render")
(render)
(exitonclick)
I don't know turtle graphics, much; it doesn't matter I only know Hello World.
(define (draw) (pu) (left 90) (forward 300) (right 90) (pd) (forward 100) (forward -50) (right 90) (forward 30) (forward 10) (left 90) (forward 50) (left 180) (forward 50) (pu) (forward 50) (pu) (pd) (forward -50) (pu) (forward 50) (right 90) (left 90) (left 90) (forward 20) (forward 20) (pd) (forward 20) (forward -20) (forward -10) (left 90) (forward 50) (right 90) (pu) (forward 50) (forward -30) (forward -20) (forward 300) (forward -300) (forward -30) (forward 30) (forward 30) (pd) (forward -30) (right 90) (forward 25) (left 90) (forward 30) (left 90) (forward 25) (pu) (right 90) (forward 20) (forward 20) (left 90) (pd) (forward 50) (forward -50) (forward -50) (pu) (left 90) (left 90) (left 90) (forward 30) (left 90) (forward 50) (pd) (forward 50) (forward -50) (forward -50) (pu) (right 90) (forward 30) (left 90) (pd) (forward 50) (right 90) (forward 30) (right 90) (forward 50) (right 90) (forward 30) (pu) (right 90) (right 90) (forward 30) (forward 30) (forward 30) (forward 30) (left 90) (pd) (forward 50) (forward 50) (left 90) (left 90) (forward 50) (forward 50) (left 90) (forward 30) (left 90) (forward 50) (forward -50) (right 90) (forward 30) (left 90) (forward 100) (forward -50) (right 90) (pu) (forward 30) (pd) (forward 30) (right 90) (forward 50) (right 90) (forward 30) (right 90) (forward 50) (right 90) (pu) (forward 30) (forward 30) (pd) (forward 30) (forward -30) (pu) (left 90) (pd) (forward -50) (pu) (forward 50) (forward 2) (forward 2) (pu) (ht) (st) (pd) (forward 2) (ht) (forward -2) (forward -2) (forward -2) (st) (right 90) (pu) (forward 30) (forward 30) (right -90) (forward 50) (pd) (forward -50) (forward -50) (pu) (right -90) (right -90) (right -90) (forward 30) (pd) (forward 30) (right -90) (forward 100) (forward -50) (right -90) (forward 30) (right -90) (forward 50) (pu) (ht) (exitonclick)) (draw)
grrr grrrr grrr grr grrr grrr grrr that’s bear language for vote for me. I’m grrrrreat
(define (draw-square n)
(fd n)
(lt 90)
(fd n)
(lt 90)
(fd n)
(lt 90)
(fd n))
(define (draw)
(speed 0)
(bgcolor "black")
(define (draw-it length iterations angle)
(cond ((eq? iterations 0))
(else (right (/ 90 angle)) (draw-square length) (draw-it length (- iterations 1) angle))))
(define colors '("red" "orange" "yellow" "green" "cyan" "blue" "purple" "violet" "purple" "blue" "cyan" "green" "yellow" "orange"))
(define (iter-colors colors)
(cond ((null? colors))
(else (color (car colors)) (draw-it 200 (/ 280 14) 280) (iter-colors (cdr colors)))))
(iter-colors colors)
(pu)
(rt 90)
(fd 170)
(lt 90)
(fd 15)
(rt 180)
(pd)
(color "light goldenrod")
(define (repeat k fn)
(if (> k 0)
(begin (fn) (repeat (- k 1) fn))
'done))
(define (star len angle)
(repeat 36 (lambda () (begin_fill) (repeat 5 (lambda () (fd 10) (rt 144) (fd 10) (lt 72)))
(end_fill) (pu) (fd len) (pd) (rt angle))))
(star 30 10)
(pu)
(bk 60)
(rt 90)
(fd 160)
(pd)
(bear)
(exitonclick)
)
(define (bear)
(speed 0)
(color "SaddleBrown")
(begin_fill) (circle 75) (end_fill)
(pu) (fd 82.5) (lt 90) (fd 12.5) (pd)
(begin_fill) (circle 37.5) (end_fill)
(pu) (fd 136) (pd)
(begin_fill) (circle 37.5) (end_fill)
(pu) (bk 19) (lt 90) (fd 75) (pd)
(color "white") (begin_fill) (circle 15) (end_fill)
(pu) (fd 4.5) (lt 90) (fd 13.5) (pd)
(color "black") (begin_fill) (circle 4.5) (end_fill)
(pu) (fd 90) (lt 90) (fd 6) (pd)
(color "white") (begin_fill) (circle 15) (end_fill)
(pu) (fd 4.5) (lt 90) (fd 13.5) (pd)
(color "black") (begin_fill) (circle 4.5) (end_fill)
(pu) (fd 40.5) (lt 90) (fd 37.5) (pd)
(begin_fill) (circle 6) (end_fill)
(pu) (rt 180) (fd 90) (rt 90) (pd)
(begin_fill) (color "light goldenrod") (circle 22.5) (end_fill)
(pu) (rt 90) (fd 10.5) (lt 90) (fd 22.5) (rt 180) (pd)
(begin_fill) (color "navy blue") (fd 45) (rt 80) (fd 30) (rt 100) (fd 55.5) (rt 100) (fd 30) (end_fill)
(pu) (rt 180) (fd 54) (lt 90) (fd 31.5) (pd)
(begin_fill) (circle 3) (end_fill)
)
(draw)
(define (bar dis col n sun)
(cond ((<= dis 0) (penup))
(else (begin
(speed 0)
(color (col n))
(circle dis)
(if (= sun 0)
(begin
(left 90)
(fd 0.35)
(right 90)
(fd 0.2)
)
(begin
(left 90)
(fd 0.25)
(right 90)
))
(bar (- dis 0.25) col (+ n 0.5) sun)
)))
)
(define (background w h)
(color "black")
(goto (- (/ w 2)) (- (/ h 2)))
(begin_fill)
(seth 90)
(fd h)
(right 90)
(fd w)
(right 90)
(fd h)
(right 90)
(fd w)
(end_fill)
)
(define (makeCol ri gi bi)
(define (col n)
(if (= n 0)
(rgb 0.1 0.1 0.1)
(rgb (+ 0.1 (* n ri)) (+ 0.1 (* n gi)) (+ 0.1 (* n bi))) )
)
col
)
(define (planets n xpos ypos rad sign)
(cond
((= n -1) (define (colo n)
(cond
((> 40 n) (rgb (* n 0.02) (* n 0.0005) 0))
((> 80 n) (rgb 0.8 (+ 0.02 (* (- n 40) 0.015)) 0))
((= n 60) (rgb 0.8 0.8 0))
(else (rgb (- 0.8 (* n 0.0003)) (- 0.8 (* n 0.0015)) 0)))
))
((= n 0) (define (colo) (makeCol 0.007 0.007 0.007)))
((= n 1) (define (colo) (makeCol 0.009 0.003 0.001)))
((= n 2) (define (colo) (makeCol 0 0.003 0.01)))
((= n 3) (define (colo) (makeCol 0.01 0.003 0.002)))
((= n 4) (define (colo) (makeCol 0.008 0.006 0.003)))
((= n 5) (define (colo) (makeCol 0.006 0.004 0.001)))
((= n 6) (define (colo) (makeCol 0 0.004 0.008)))
((= n 7) (define (colo) (makeCol 0.003 0.004 0.009)))
)
(penup)
(goto xpos ypos)
(pendown)
(if (= n -1) (bar rad colo 0 1)
(bar rad (colo) 0 0) )
(cond
((= n -1) (planets (+ n 1) -70 -170 15 1))
((= n 3) (planets (+ n 1) (+ xPos 120) (+ yPos 120) (* rad 1.5) (* -1 sign)))
(else (planets (+ n 1) (+ xPos 40 rad) (+ yPos 40 rad) (+ rad (* sign 5)) sign))
)
)
(speed 0)
(background 1200 1200)
(planets -1 -200 -100 200 1)
'Twas a bear and tree fought they did in outerspace Go Bears master race!
(define (move-right x) (setheading 90) (forward x)) (define (at_index s i) (if (= i 0) (car s) (at_index (cdr s) (- i 1)) ) ) (define (len s) (define (helper s i) (if (null? s) i (helper (cdr s) (+ i 1)) ) ) (helper s 0) ) (define window_width (screen_width)) ;so they can be treated as variables instead of calling the functions everytime (define window_height (screen_height)) (define (escape_depth px py) (define x_normalization 1.8) (define y_normalization 1) (define x_scaled (- (/ (* (- 1 (- x_normalization)) (- px (/ (- window_width) 2))) (- (/ window_width 2) (/ (- window_width) 2)) ) x_normalization)) ; x coordinated normalized to mandelbrot domain (define y_scaled (- (/ (* (- 1 (- y_normalization)) (- py (/ (- window_height) 2))) (- (/ window_height 2) (/ (- window_height) 2)) ) y_normalization)) ; y coordinated normalized to mandelbrot domain (define (for_iter depth max_depth x y x_temp) (cond ((and (< depth max_depth) (< [+ (* x x) (* y y)] 4)) (define x_temp (+ (- (* x x) (* y y)) x_scaled)) (define y (+ (* 2 x y) y_scaled)) (define x x_temp) (for_iter (+ depth 1) max_depth x y x_temp) ) (else depth) ) ) (for_iter 0 5000 0 0 0) ) (define (depth_row x y) (define (iter i window_width row x) (cond ((< i window_width) (define row (append row (list (escape_depth x y)))) (iter (+ i 1) window_width row (+ x 1)) ) (else row) ) ) (iter 0 window_width '() x) ) (define (render_mandelbrot) (define x_0 (/ (- window_width) 2)) (define y_0 (/ window_height 2)) (define x x_0) (define y y_0) (define (iter y y_0) (cond ((> y (- y_0)) (define row (depth_row x y)) (define (iter_2 i pallet) (cond ((< i (len row)) (define j i) (define (iter_3 j) (if (and [< j (len row)] [= (at_index row j) (at_index row i)]) (iter_3 (+ j 1)) j ) ) (define j (iter_3 j)) (define pallet (append pallet [list (list (at_index row i) (- j i))])) (if (> j i) (define i j) (define i (+ i 1)) ) (iter_2 i pallet) ) (else pallet) ) ) (define pallet (iter_2 0 '())) (define (for_iter i pallet) (cond ((< i (len pallet)) (define offset (* 255 (- 1 (/ (log (+ [* (/ [at_index (at_index pallet i) 0] 1000) 255] 1)) (log 256) ) ) ) ) (define offset (quotient offset 1)) ; truncation (define r (- 255 offset)) (cond ((> r 255) (define r 230) (define g 230) (define b 230) ) (else (define r 0) (define g 0) (define b (- 255 offset)) ) ) (color (rgb (/ r 255) (/ g 255) (/ b 255))) (pendown) (move-right (at_index (at_index pallet i) 1)) (penup) (for_iter (+ i 1) pallet) ) (else nil) ) ) (for_iter 0 pallet) (define y (- y 1)) (setposition x y) (iter y y_0) ) ) (else nil) ) (iter y y_0) ) (speed 0) (penup) (setposition (/ (- window_width) 2) (/ window_height 2)) (pendown) (define (draw) (render_mandelbrot) (setposition (/ window_width 13) (/ window_height 45)) (addshape) (shape) (stamp) (exitonclick)) (draw)
(def (this_is_recur
sive) ("turtles made with turtles")
(this_is_recursive))
(define (draw)
; *YOUR CODE HERE*
(color "green")
(define (repeat k fn)
(if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(define (hex fn)
(repeat 6 (lambda () (fn) (lt 60))))
(define (triangle s)
(repeat 3 (lambda () (fd s) (lt 120))))
(define (shell d k)
(hex (lambda ()
(if (= k 1) (fd d) (leg d k)))))
(define (leg d k)
(shell (/ d 2) (- k 1))
(penup)
(fd d)
(pendown))
(define (head r)
(circle r) )
(define (flipper x y d)
(begin_fill)
(pu)
(goto x y)
(pd)
(seth d)
(color "green")
(begin_fill)
(circle 30 -30)
(circle 100 -50)
(circle 200 -10)
(circle 5 -150)
(goto x y)
(end_fill))
(define (rev_flipper x y d)
(begin_fill)
(pu)
(goto x y)
(pd)
(seth d)
(color "green")
(begin_fill)
(circle 30 30)
(circle 100 50)
(circle 200 10)
(circle 5 150)
(goto x y)
(end_fill))
(define (head x y)
(pu)
(goto (- x 100) y)
(pd)
(color "#ace600")
(begin_fill)
(seth -40)
(fd 85)
(seth 40)
(fd 85)
(seth 90)
(circle 65.1 180)
(end_fill)
(color "black")
(pu)
(goto (- x 76.2) y)
(pd)
(begin_fill)
(circle 15 360)
(end_fill)
(pu)
(goto x y)
(pd)
(begin_fill)
(circle 15 360)
(end_fill)
(color "white")
(pu)
(goto (- x 74.2) (+ y 5))
(pd)
(begin_fill)
(circle 6 360)
(end_fill)
(pu)
(goto (+ x 1) (+ y 5))
(pd)
(begin_fill)
(circle 6 360)
(end_fill)
(ht))
(color "green")
(seth 90)
(pu)
(goto -35 0)
(pd)
(begin_fill)
(circle 500 10)
(circle 100 -60)
(end_fill)
(flipper -100 -50 50)
(flipper -100 -130 90)
(rev_flipper 0 -50 -50)
(rev_flipper 0 -130 -90)
(head -15 -200)
(pu)
(goto -100 -173.2)
(seth 0)
(pd)
(color "#663200")
(begin_fill)
(shell 100 2)
(end_fill)
(color "black")
(shell 100 2)
(exitonclick))
(draw)
I wished to draw a bear, but that required effort this happened instead
(speed 0) (width 1.5) (pencolor "#FDB515") (fillcolor "#004080") (ht) (define (cadr s) (car (cdr s))) (define (setp x) (setposition (car x) (cadr x)) ) (define (coolsquare a b c d p x bool) (if (not (= x 60)) (begin (begin_fill) (draw a b c) (setp d) (setp a) (end_fill) (coolsquare (changeco a b p) (changeco b c p) (changeco c d p) (changeco d a p) p (+ x 1) (- 1 bool)) )) ) (define (draw a b c) (penup) (setp a) (pendown) (setp b) (setp c) ) (define (changeco a b p) (cons (+ (* (car a) p) (* (car b) (- 1 p))) (cons (+ (* (cadr a) p) (* (cadr b) (- 1 p))) nil)) ) (define (cooltri a b c p x bool) (if (not (= x 27)) (begin (begin_fill) (draw a b c) (setp a) (end_fill) (cooltri (changeco a b p) (changeco b c p) (changeco c a p) p (+ x 1) (- 1 bool)) )) ) (define (fun1 l a b c) (define h (calcshift a b)) (define g (calcshift a c)) (define (fun2 z m) (if (< m 4) (begin (define w (shift z (list (* m 300) (* l -300)))) (cooltri w (shift w h) (shift w g) .9 1 1) (fun2 z (+ m 1)))) ) (fun2 a 0) (if (< l 2) (fun1 (+ l 1) a b c)) ) (define (fun3 l a b c d) (define h (calcshift a b)) (define g (calcshift a c)) (define f (calcshift a d)) (define (fun4 z m) (if (< m 4) (begin (define w (shift z (list (* m 300) (* l -300)))) (coolsquare w (shift w h) (shift w g) (shift w f) .93 1 1) (fun4 z (+ m 1)))) ) (fun4 a 0) (if (< l 2) (fun3 (+ l 1) a b c d)) ) (define (shift a b) (list (+ (car a) (car b)) (+ (cadr a) (cadr b)))) (define (calcshift a b) (list (- (car b) (car a)) (- (cadr b) (cadr a)))) (fun3 0 '(-450 200) '(-300 350) '(-150 200) '(-300 50)) (fun1 0 '(-450 200) '(-450 350) '(-300 350)) (fun1 0 '(-450 200) '(-450 50) '(-300 50)) (fun1 0 '(-150 200) '(-150 350) '(-300 350)) (fun1 0 '(-300 50) '(-150 200) '(-150 50)))
spheres, planes, reflections Cal's colors, tail recursion put in pot and stir
(define (min a b) (if (> a b) b a))
(define (max a b) (if (> a b) a b))
(define (clamp val) (max 0 (min 1 val)))
(define (convert-color clr)
(rgb (clamp (car clr)) (clamp (cadr clr)) (clamp (caddr clr))))
(define (x v) (car v))
(define (y v) (cadr v))
(define (z v) (caddr v))
(define (dot a b) (+ (* (x a) (x b)) (* (y a) (y b)) (* (z a) (z b))))
(define (cross a b)
(list (- (* (z a) (y b)) (* (y a) (z b)))
(- (* (x a) (z b)) (* (z a) (x b)))
(- (* (y a) (x b)) (* (x a) (y b)))))
(define (addv a b) (list (+ (x a) (x b)) (+ (y a) (y b)) (+ (z a) (z b))))
(define (subv a b) (addv a (scale b (- 1))))
(define (scale a k) (list (* (x a) k) (* (y a) k) (* (z a) k)))
(define (norm a) (scale a (/ 1 (sqrt (dot a a)))))
(define (mix a b r) (addv (scale a r) (scale b (- 1 r))))
(define (illuminate-sphere sphere direction surface depth)
(define center (cadr sphere))
(define color (caddr sphere))
(define type color)
(if (eq? type 'mirror)
(define color '(1 1 1)))
(define to_surface (norm (subv surface center)))
(define to_light (norm (subv light surface)))
(define intensity (max ambient (dot (norm to_light) (norm to_surface))))
(if (not (null? (get-hits spheres surface to_light))) (define intensity ambient))
(define direct (scale color intensity))
(if (and (<= depth 1) (not (eq? type 'mirror)))
direct
(begin
(define cosine (dot direction to_surface))
(define bounce (subv direction (scale to_surface (* 2 cosine))))
(define reflected (trace-ray surface bounce (- depth 1)))
(if (eq? type 'mirror)
reflected
(mix direct reflected (+ 0.7 (* 0.3 (expt intensity 300))))))))
(define (illuminate-plane plane direction surface depth)
(define origin (car plane))
(define u1 (cadr plane))
(define u2 (caddr plane))
(define normal (cross u1 u2))
(define to_light (norm (subv light surface)))
(define intensity (max ambient (dot to_light normal)))
(if (not (null? (get-hits spheres surface to_light))) (define intensity ambient))
(define offset (subv surface origin))
(define px (dot u1 offset))
(define py (dot u2 offset))
(if (< px 0) (- px 1))
(if (< py 0) (- py 1))
(define color '(0.9 0.9 0.9))
(if (or (and (< (abs (modulo px 2)) 1) (< (abs (modulo py 2)) 1))
(and (>= (abs (modulo px 2)) 1) (>= (abs (modulo py 2)) 1)))
(define color '(0.5 0.5 0.5)))
(scale color intensity))
(define (intersect-sphere sphere source direction)
(define radius (car sphere))
(define center (cadr sphere))
(define v (subv source center))
(define b (- (dot v direction)))
(define v2 (dot v v))
(define r2 (* radius radius))
(define d2 (+ (- (* b b) v2) r2))
(if (< d2 0)
nil
(begin
(define d (- b (sqrt d2)))
(if (> d min_distance)
(list d)
(begin
(define d (+ b (sqrt d2)))
(if (> d min_distance)
(list d)
nil))))))
(define (intersect-plane plane source direction)
(define normal (cross (cadr plane) (caddr plane)))
(if (< (abs (dot direction normal)) min_distance)
nil
(begin
(define h (/ (dot (subv (car plane) source) normal) (dot direction normal)))
(if (>= h 0) (list h) nil))))
(define (scene-object data intersect-fn illuminate-fn) (append data (list intersect-fn) (list illuminate-fn)))
(define (sphere data) (scene-object data intersect-sphere illuminate-sphere))
(define (plane data) (scene-object data intersect-plane illuminate-plane))
(define (intersect object source direction)
((car (cdddr object)) object source direction))
(define (illuminate object direction surface depth)
((car (cddddr object)) object direction surface depth))
(define min_distance 0.01)
(define (get-hits objects source direction)
(if (null? objects)
nil
(begin
(define object (car objects))
(define hit (intersect object source direction))
(if (not (null? hit))
(cons (cons (car hit) (list object)) (get-hits (cdr objects) source direction))
(get-hits (cdr objects) source direction)))))
(define (get-nearest lst)
(cond
((null? (cdr lst)) (car lst))
((< (car (car lst)) (car (get-nearest (cdr lst)))) (car lst))
(else (get-nearest (cdr lst)))))
(define (trace-ray source direction depth)
(define hits (get-hits (append spheres planes) source direction))
(if (null? hits)
black
(begin
(define nearest (get-nearest hits))
(define distance (car nearest))
(define object (cadr nearest))
(define surface (addv source (scale direction distance)))
(illuminate object direction surface depth))))
(define camera '(0 1 -4.5))
(define light '(2 3 0))
(define ambient 0.2)
(define black '(0 0 0))
(define spheres
(list
(sphere '(1 (0 1 2) mirror))
(sphere '(1 (2.1 1 2) (0.03137 0.12157 0.39216)))
(sphere '(1 (-2.1 1 2) (0.98824 0.70196 0.14902)))
)
)
(define planes
(list
(plane (list '(0 0 10) (norm '(1 0 -1)) (norm '(1 0 1))))
(plane (list '(0 1 10) (norm '(0 -1 0)) (norm '(1 0 -1))))
(plane (list '(0 0 10) (norm '(-1 0 -1)) (norm '(0 -1 0))))
)
)
(define (draw)
(bgcolor "black")
(define block 1)
(pixelsize block)
(define size (min (screen_width) (screen_height)))
(define (draw-pixel x y)
(define direction (norm (list (- (/ x size) 0.5) (- (/ y size) 0.5) 1)))
(define color (scale (trace-ray camera direction 4) 0.95))
(pixel x y (convert-color color))
(cond
((< (+ 1 y) size) (draw-pixel x (+ 1 y)))
((< (+ 1 x) size) (draw-pixel (+ 1 x) 0))))
(draw-pixel 0 0)
(exitonclick))
(draw)
East, south, west, and north Wood, Fire, Metal, Water, Earth! Find the hidden face.
(define (map fn lst)
;; Map unary function FN to each element of LST.
(if (null? lst)
nil
(cons (fn (car lst)) (map fn (cdr lst)))))
(define (filter pred lst)
;; Filter LST using PRED function.
(cond ((null? lst) nil)
((pred (car lst)) (cons (car lst) (filter pred (cdr lst))))
(else (filter pred (cdr lst)))))
(define (combine fn s t)
;; Apply binary function FN to each pair of elements of S and T.
(if (null? s)
nil
(cons (fn (car s) (car t)) (combine fn (cdr s) (cdr t)))))
(define (reduce lst fn start)
;; Reduce LST using FN with initial value START
(if (null? lst)
start
(reduce (cdr lst) fn (fn start (car lst)))))
(define (zip s t)
;; Return a list of pair from each corresponding element of S and T.
(if (null? s)
nil
(cons (cons (car s) (car t)) (zip (cdr s) (cdr t)))))
(define (vector x y z)
;; Construct a new vector (X, Y, Z).
(list x y z))
(define (vx v)
;; Return x-coordinate of V
(car v))
(define (vy v)
;; Return y-coordinate of V
(car (cdr v)))
(define (vz v)
;; Return z-coordinate of V
(car (cdr (cdr v))))
(define (scale v c)
;; Scale each element of V by C
(map (lambda (x) (* x c)) v))
(define (norm v)
;; Return the norm of V
(let ((x (vx v))
(y (vy v))
(z (vz v)))
(sqrt (+ (* x x) (* y y) (* z z)))))
(define (normalize v)
;; Normalize V
(scale v (/ 1 (norm v))))
(define (add a b)
;; Return A + B
(combine (lambda (x y) (+ x y)) a b))
(define (subtract a b)
;; Return A - B
(combine (lambda (x y) (- x y)) a b))
(define (dot a b)
;; Return the inner product of A and B
(reduce (combine (lambda (x y) (* x y)) a b)
(lambda (x y) (+ x y))
0))
(define (sphere radius center color)
;; Construct a new sphere with RADIUS (number), CENTER (vector), and COLOR (vector).
(vector radius center color))
(define (sra s)
;; Return the radius of sphere S.
(vx s))
(define (sce s)
;; Return the center of sphere S.
(vy s))
(define (sco s)
;; Return the color of sphere S.
(vz s))
(define (trace source direction depth)
;; Trace from SOURCE following DIRECTION with reflection DEPTH.
(define distances (map (lambda (s) (intersect source direction s)) spheres))
(define hits (filter (lambda (p) (car p)) (zip distances spheres)))
(if (equal? (length hits) 0)
background
(begin (define target (closest hits))
(define surface (add source (scale direction (car target))))
(illumination surface (sce (cdr target)) (sco (cdr target)) direction depth))))
(define (intersect source direction sphere)
;; Return the distance from SOURCE to SPHERE following DIRECTION.
(define v (subtract source (sce sphere)))
(define b_ (dot v direction))
(define c (- (expt (norm v) 2) (expt (sra sphere) 2)))
(define delta_ (- (expt b_ 2) c))
(if (< delta_ 0)
False
(let ((sqDelta_ (sqrt delta_))
(minusB_ (- b_)))
(cond ((> (- minusB_ sqDelta_) 0.01) (- minusB_ sqDelta_))
((> (+ minusB_ sqDelta_) 0.01) (+ minusB_ sqDelta_))
(else False)))))
(define (illumination surface center color direction depth)
;; Return the color at SURFACE knowing CENTER and COLOR of the sphere,
;; with original DIRECTION and reflection DEPTH.
(define toSurface (normalize (subtract surface center)))
(define toLight (normalize (subtract light surface)))
(define intensity (dot toSurface toLight))
(if (> intensity 0)
(begin (define distances (map (lambda (s) (intersect surface toLight s)) spheres))
(define inRange (norm (subtract light surface)))
(define obstacles (filter (lambda (d) (and d (< d inRange))) distances))
(if (> (length obstacles) 0) (define intensity 0))))
(define intensity (max intensity ambient))
(define direct (scale color intensity))
(if (equal? depth 1)
direct
(begin (define projected (dot direction toSurface))
(define bounce (subtract direction (scale toSurface (* 2 projected))))
(define reflected (trace surface bounce (- depth 1)))
(mix direct reflected (+ 0.5 (* 0.5 (expt intensity 30)))))))
(define (mix a b r)
;; Mix colors A and B with ratio R.
(add (scale a r) (scale b (- 1 r))))
(define (closest lst)
;; Return the closest pair (distance, sphere) in LST.
(define (helper s min)
(cond ((null? s) min)
((< (car (car s)) (car min)) (helper (cdr s) (car s)))
(else (helper (cdr s) min))))
(helper lst (cons 1000000 nil)))
(define (max a b)
;; Return max(a, b).
(if (>= a b) a b))
(define width (screen_width))
(define height (screen_height))
(define (render)
;; Main function to render image
(define shiftX (quotient width 2))
(define shiftY (quotient height 2))
(define shiftZ (+ shiftX shiftY))
(define (col x)
(if (< x shiftX)
(begin (define (row y)
(if (< y shiftY)
(begin (define direction (normalize (vector x y shiftZ)))
(define traceColor (trace camera direction 4))
(goto x y)
(tdot 1 (rgb (vx traceColor) (vy traceColor) (vz traceColor)))
(row (+ y 1)))))
(row (+ (- shiftY) 1))
(col (+ x 1)))))
(col (+ (- shiftX) 1)))
(define camera (vector 0 0 0))
(define light (vector 0 1 0))
(define background (vector 0 0 0))
(define ambient 0.2)
(define spheres (list (sphere 2.5 (vector 0 0 15) (vector 1 1 0))
(sphere 2 (vector 0 5 18) (vector 0 0 0))
(sphere 2 (vector 0 -5 18) (vector 1 0 0))
(sphere 2 (vector -5 0 18) (vector 1 1 1))
(sphere 2 (vector 5 0 18) (vector 0 1 0))
(sphere 500 (vector 0 0 600) (vector 0 0 1))))
(define pi 3.1415926535)
(define (rad deg)
;; Convert DEG to radian.
(/ (* deg pi) 180))
(define (belt lst angle)
;; Add new item at ANGLE to LST.
(if (>= angle 360)
lst
(begin (define r 6)
(define x (* r (cos (rad angle))))
(define y (* r (sin (rad angle))))
(define sph (sphere 0.5 (vector x y 18) (vector 0 1 1)))
(belt (cons sph lst) (+ angle 30)))))
(define spheres (append spheres (belt nil 0)))
(penup)
(hideturtle)
(speed 0)
(render)
Forbidden blossom, Inextinguishable flame-- Far away from me.
(define (repeat k fn) (if (> k 0)
(begin (fn) (repeat (- k 1) fn))
nil))
(define (circ len) (repeat 15 (lambda () (pu) (fd len) (pd) (repeat 15 (lambda () (fd (/ len 5)) (rt 48))) (rt 48))))
(define (check_color r g b)
(if (or (> r 0.9) (> g 0.9) (> b 0.9) (< r 0) (< g 0) (< b 0)) (color(rgb 0 0 0))
(color (rgb (+ r 0.1) (+ g 0.1) (+ b 0.1)))))
(define (flower k len r g b)
(check_color r g b)
(if (> k 0) (begin
(begin_fill)
(circ len)
(end_fill)
(rt 90)
(pu)
(fd (* len 0.5))
(pd)
(lt 90)
(flower (- k 1) (- len 25) (+ r 0.1) (+ g 0.05) (+ b r))
)
nil))
(flower 4 150 0 0.1 0.05)
(pu)
(goto 500 200)
(flower 4 120 0 0.03 0.1)
(pu)
(goto -150 150)
(rt 90)
(flower 4 190 0.2 0.01 0)
(pu)
(goto 400 -300)
(flower 4 100 0.1 0.1 0.1)
(pu)
(goto -500 25)
(flower 4 140 0.02 0.5 0)
(pu)
(goto 400 -170)
(lt 120)
(flower 4 115 0.3 0.01 0.2)
(pu)
(goto -600 -200)
(rt 25)
(flower 4 125 0.1 0.06 0.4)
(pu)
(goto -100 200)
(flower 4 100 0.2 0.04 0.2)
(pu)
(goto 460 -200)
(flower 4 130 0.4 0.01 0.02)
(pu)
(goto -200 100)
(flower 4 115 0 0.05 0.6)
(pu)
(goto -260 -100)
(lt 180)
(flower 4 140 0.2 0.04 0.1)
(pu)
(goto -150 260)
(rt 90)
(flower 4 120 0.3 0.07 0)
(pu)
(goto -180 220)
(flower 4 100 0.2 0.1 0)
(pu)
(goto 400 200)
(lt 90)
(flower 4 140 0.01 0.6 0.02)
(pu)
(goto -500 0)
(rt 90)
(flower 4 115 0.01 0.05 0.3)
(pu)
(goto 375 -240)
(flower 4 150 0.02 0.05 0.4)
(pu)
(goto -550 275)
(flower 4 125 0.3 0.01 0.04)
(pu)
(goto 170 -350)
(lt 180)
(flower 4 135 0.02 0.4 0.1)
(pu)
(goto 475 300)
(rt 60)
(flower 4 140 0.1 0.4 0.04)
(pu)
(goto -570 -350)
(rt 120)
(flower 4 100 0.1 0.2 0.6)
(pu)
(goto 10 -200)
(lt 180)
(flower 4 120 0.2 0.06 0.02)
(pu)
(goto 580 -300)
(lt 180)
(flower 4 110 0.01 0.5 0.2)
(pu)
(goto 0 0)
(flower 4 120 0.3 0.02 0.6)
(pu)
(goto 300 -200)
(rt 45)
(flower 4 110 0.2 0.6 0.01)
(pu)
(lt 45)
(goto 150 -150)
(flower 4 100 0.08 0.4 0.01)
(pu)
(goto 550 -350)
(rt 60)
(flower 4 130 0.4 0.2 0.07)
(pu)
(goto -200 120)
(lt 90)
(flower 4 100 0.5 0.01 0.02)
(pu)
(goto -200 -360)
(flower 4 120 0.02 0.04 0.01)
(pu)
(goto -400 200)
(rt 30)
(flower 4 140 0.2 0.05 0.01)
(pu)
(goto 550 250)
(lt 120)
(flower 4 110 0.01 0.02 0.5)
Deep inside the void Searching for a glimpse of light High above our skies.
(define canvas_size 300)
(define pixel_size 1)
(define (vector x y z) (list x y z))
(define pi 3.14159265358979323)
(define (cadr x) (car (cdr x)))
(define (caddr x) (car (cdr (cdr x))))
(define (magnitude v) (sqrt (dot v v)))
(define (scale v x) (list (* (car v) x) (* (cadr v) x) ( * (caddr v) x)))
(define (normalize v) (scale v (/ 1 (magnitude v))))
(define (dot v w) (+ (* (car w)(car v))(* (cadr w)(cadr v))(* (caddr w)(caddr v))))
(define (add v w) (list (+ (car v) (car w))(+ (cadr v) (cadr w))(+ (caddr v) (caddr w))))
(define (negate v) (scale v -1))
(define (sub v w) (add v (negate w)))
(define (position x y z) (vector x y z))
(define camera1 (position 0 0 0))
(define (map proc items)
(if (null? items)
nil
(cons (proc (car items)) (map proc (cdr items)))
)
)
(define (color-abstraction r g b) (list r g b))
(define (list-to-rgb color-abstraction)
(define adjusted (map (lambda (x) (if (<= x 1) x 1)) color-abstraction))
(rgb (car adjusted) (cadr adjusted) (caddr adjusted))
)
(define (light-source position intensity) (list position intensity))
(define light-source1 (light-source (position -10 0 5) 1))
(define (make-sphere radius center color-abstraction) (list radius center color-abstraction))
(define s1 (make-sphere 3 (position 0 0 -10) (color-abstraction 0.4 0.4 1)))
(define s2 (make-sphere 5 (position 200 -150 -500) (color-abstraction 1 1 1)))
(define s3 (make-sphere 5 (position -200 150 -500) (color-abstraction 1 1 1)))
(define s4 (make-sphere 5 (position 250 200 -500) (color-abstraction 1 1 1)))
(define s5 (make-sphere 5 (position -100 -200 -500) (color-abstraction 1 1 1)))
(define objects (list s1 s2 s3 s4 s5))
(define (sphere-radius sphere) (car sphere))
(define (sphere-center sphere) (cadr sphere))
(define (sphere-color-abstraction sphere) (caddr sphere))
(define (square x) (* x x))
(define (get-v camera sphere)
(sub camera (sphere-center sphere))
)
(define (get-b camera sphere direction)
(- (dot (get-v camera sphere) direction))
)
(define (discriminant b v radius)
(- (square b) (- (dot v v) (square radius)))
)
(define (quadratic-plus b v radius)
(- b (sqrt (discriminant b v radius)))
)
(define (quadratic-minus b v radius)
(+ b (sqrt (discriminant b v radius)))
)
(define (get-closest-object camera direction min-t max-t object-hit objects-list)
(if (null? objects-list)
(cons max-t object-hit)
(begin
(define s (car objects-list))
(define v (get-v camera s))
(define pos (sphere-center s))
(define b (get-b camera s direction))
(define discr (discriminant b v (sphere-radius s)))
(define radius (sphere-radius s))
(if (> discr 0)
(begin
(define sol1 (quadratic-plus b v radius))
(define sol2 (quadratic-minus b v radius))
(if (and (> sol1 min-t) (< sol1 max-t))
(begin
(define max-t sol1)
(define object-hit s)
)
)
(if (and (> sol2 min-t) (< sol2 max-t))
(begin
(define max-t sol2)
(define object-hit s)
)
)
(get-closest-object camera direction min-t max-t object-hit (cdr objects-list))
)
(get-closest-object camera direction min-t max-t object-hit (cdr objects-list))
)
)
)
)
(define (max x y)
(if (> x y)
x
y
)
)
(define (get-lighting sphere distance v normal)
(define surface (add (scale v distance) camera1))
(define light-vector (normalize (sub (car light-source1) surface)))
(if (not (= 1 (length (get-closest-object surface light-vector 0.001 10000 nil objects))))
0.05
(begin
(define coefficient (+ (diffuse light-vector normal) (specular light-vector v normal)))
(* (cadr light-source1) coefficient)
)
)
)
(define (diffuse l normal)
(max 0.0 (dot l normal))
)
(define (specular l v normal)
(define answer (expt (max 0.0 (dot (reflect l normal) v)) 0.5))
answer
)
(define (reflect v n)
(sub v (scale n (* 2 (dot (negate v) n))))
)
(define (trace-ray camera direction depth)
(if (= depth 0)
(color-abstraction 0 0 0)
)
(define result (get-closest-object camera direction 0.001 1000000 nil objects))
(if (= 1 (length result))
(color-abstraction 0 0 0)
(begin
(define surf (add (scale direction (car result)) camera))
(define norm (normalize (sub surf (sphere-center (cdr result)))))
(define illum (get-lighting (cdr result) (car result) direction norm))
(scale (sphere-color-abstraction (cdr result)) illum)
)
)
)
(define (get-pixel-color-abstraction x y camera)
(define direction (normalize (vector (/ x canvas_size) (/ y canvas_size) -1)))
(trace-ray camera direction 2)
)
(define max-range (/ canvas_size 2))
(define min-range (- (/ canvas_size 2)))
(define (render camera)
(penup)
(fd (/ canvas_size 2))
(rt 90)
(fd (/ canvas_size 2))
(lt 90)
(pendown)
(bgcolor (rgb 0 0 0))
(define (iterate-in-y-axis current-y stepsize max-y)
(define (iterate-in-x-axis current-x stepsize max-x)
(if (> current-x max-x)
nil
(begin
(color (list-to-rgb (get-pixel-color-abstraction current-y current-x camera)))
(fd pixel_size)
(iterate-in-x-axis (+ current-x pixel_size) stepsize max-x)
)
)
)
(if (> current-y max-y)
nil
(begin
(penup)
(lt 90)
(fd pixel_size)
(rt 90)
(bk (+ canvas_size pixel_size))
(pendown)
(iterate-in-x-axis min-range pixel_size max-range)
(iterate-in-y-axis (+ current-y stepsize) stepsize max-y)
)
)
)
(iterate-in-y-axis min-range pixel_size max-range)
(penup)
(rt 90)
(fd (/ canvas_size 2))
(rt 90)
(fd (/ canvas_size 2))
(rt 180)
)
(define (repeat fn i)
(if (= 1 i)
(fn)
(begin
(fn)
(repeat fn (- i 1))
)
)
)
(define (law-of-cos-angle s1 s2 s3)
(* (/ 180 pi) (acos (/ (+ (square s1) (square s2) (- (square s3))) (* 2 s1 s2 ))))
)
(define (law-of-cos-side s1 s2 a1)
(sqrt (- (+ (square s1) (square s2)) (* 2 s1 s2 (cos (* (/ pi 180) a1)))))
)
(define (square x) (* x x))
(define (interior edges)
(- 180 (/ (* 180 (- edges 2)) edges))
)
(define (sp-r d k edges ratio)
(define (filled-spiral-boundaries-ratio d k edges)
(if (< k 0)
nil
(begin
(define a (* ratio d))
(define b (* (- 1 ratio) d))
(define x (law-of-cos-side a b (- 180 (interior edges))))
(define tau (law-of-cos-angle b x a))
(define a2 (- 180 tau (- 180 (interior edges))))
(lt tau)
(fd (* x ratio))
(filled-spiral-boundaries-ratio x (- k 1) edges)
(fd (* x (- 1 ratio)))
(lt a2)
(bk a)
(rt (interior edges))
(bk b)
)
)
)
(filled-spiral-boundaries-ratio d k edges)
)
(define (sp-cfr-cost-saving d k ratio)
(color (get-random-color))
(define (filled-spiral-iter-sr d k iterator)
(if (< iterator 1)
nil
(begin
(begin_fill)
(sp-r d k 7 ratio)
(end_fill)
(color (rgb 0 0 0))
(sp-r d k 7 ratio)
(fd (* d (- 1 ratio)))
(lt (interior 7))
(fd (* d ratio))
(color (get-random-color))
(filled-spiral-iter-sr d k (- iterator 1))
)
)
)
(filled-spiral-iter-sr d k 7)
(color (rgb 0 0 0))
(bk (* d ratio))
)
(define (get-random-color)
(rgb 0.15 0.15 0.15)
)
(define (frame)
(bgcolor (rgb 0 0 0))
(penup)
(rt 90)
(fd 525)
(rt 90)
(fd 200)
(lt 180)
(pendown)
(sp-cfr-cost-saving 500 25 0.1)
)
(define (draw)
(speed 0)
(render camera1)
(frame)
(exitonclick))
(draw)