1 ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 ;; about the language level of this file in a form that our tools can easily process.
3 #reader(lib "htdp-intermediate-lambda-reader.ss" "lang")((modname |27.1|) (read-case-sensitive #t) (teachpacks ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #f #t none #f ((lib "draw.ss" "teachpack" "htdp") (lib "arrow.ss" "teachpack" "htdp") (lib "gui.ss" "teachpack" "htdp")))))
4 ;; sierpinski : posn posn posn symbol -> true
5 ;; Given a, b, and c (posns), draw the triangle specified by the 3 posns and color and then use generative recursion to draw the nested triangles. Return true once the triangles become too small to draw.
7 (define (sierpinski a b c color)
8 (local ((define a-b (midpoint a b))
9 (define a-c (midpoint a c))
10 (define b-c (midpoint b c)))
12 [(too-small? a b c) true]
13 [else (and (draw-triangle (round-posn a)
16 (sierpinski a a-b a-c color)
17 (sierpinski b a-b b-c color)
18 (sierpinski c a-c b-c color))])))
20 ;round-posn : posn -> posn
21 ;Rounds a posn x to the nearest integer
23 (define (round-posn p)
24 (make-posn (inexact->exact (round (posn-x p)))
25 (inexact->exact (round (posn-y p)))))
27 ;draw-triangle : posn posn posn -> true
28 ;Draw the triangle that contains a, b, and c as vertices.
30 (define (draw-triangle a b c color)
31 (and (draw-solid-line a b color)
32 (draw-solid-line b c color)
33 (draw-solid-line c a color)))
35 ;midpoint : posn posn -> posn
36 ;Given a, b, find the midpoint of the two posns.
38 (define (midpoint a b)
39 (make-posn (/ (+ (posn-x a) (posn-x b)) 2)
40 (/ (+ (posn-y a) (posn-y b)) 2)))
42 ;too-small? : posn posn posn -> boolean
43 ;Given a, b, c, determine if the triangle is too small. A triangle is too small if the area of the given triangle is less than MINAREA.
47 (define (too-small? a b c)
48 (< (area-of-triangle a b c) MINAREA))
50 ;area-of-triangle : posn posn posn -> number
51 ;Given a, b, c, determine the area of the triangle. (uses Heron's formula)
53 (define (area-of-triangle a b c)
54 (local ((define A (distance b c))
55 (define B (distance a c))
56 (define C (distance a b))
57 (define semiperimeter (/ (+ A B C) 2)))
58 (sqrt (* semiperimeter
61 (- semiperimeter C)))))
63 ;distance : posn posn -> number
64 ;Given p1, p2, determine the distance between two points.
66 (define (distance p1 p2)
67 (sqrt (+ (sqr (- (posn-x p2) (posn-x p1)))
68 (sqr (- (posn-y p2) (posn-y p1))))))
70 (define CENTER (make-posn 200 200))
73 ;;circle-pt : number -> posn
74 ;;Given angle-ratio (ie, 120/360, 240/360, 360/360), find a position on the circle with CENTER and RADIUS as defined above.
76 (define (circle-pt angle-ratio)
77 (local ((define theta (* angle-ratio 2 pi)))
78 (make-posn (+ (posn-x CENTER)
79 (* RADIUS (cos theta)))
81 (* RADIUS (sin theta))))))
83 (define A (circle-pt 120/360))
84 (define B (circle-pt 240/360))
85 (define C (circle-pt 360/360))
94 (draw-circle CENTER RADIUS 'black)
95 (draw-solid-disk A 5 'green)
96 (draw-solid-disk B 5 'blue)
97 (draw-solid-disk C 5 'purple)
103 (define x1 (make-posn 0 (round (inexact->exact HEIGHT))))
104 (define x2 (make-posn (round (inexact->exact WIDTH))
105 (round (inexact->exact HEIGHT))))
106 (define x3 (make-posn (round (inexact->exact (/ WIDTH 2)))
107 (round (inexact->exact (* HEIGHT (- 1 (/ (sqrt 3)
111 (sierpinski x1 x2 x3 'black)