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 (define-struct triangle (a b c color))
5 ;
6 ;A triangle is a structure
7 ;(make-triangle a b c co)
8 ;where a, b, c are posns, and co is a symbol.
9 
10 ;sierpinski-list : (listof triangle) -> true
11 ;;Given alot, draw the triangles using sierpinski.  Return true once the triangles become too small to draw.
12 
13 (define (sierpinski-list alot)
14   (andmap (lambda (x) (sierpinski (triangle-a x)
15                                   (triangle-b x)
16                                   (triangle-c x)
17                                   (triangle-color x)))
18           alot))
19 
20 ;; sierpinski : posn posn posn symbol -> true
21 ;; 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.
22 
23 (define (sierpinski a b c color)
24   (local ((define a-b (midpoint a b))
25           (define a-c (midpoint a c))
26           (define b-c (midpoint b c)))
27     (cond 
28       [(too-small? a b c) true]
29       [else (and (draw-triangle (round-posn a)
30                                 (round-posn b)
31                                 (round-posn c) color)
32                  (sierpinski a a-b a-c color)
33                  (sierpinski b a-b b-c color)
34                  (sierpinski c a-c b-c color))])))
35 
36 ;round-posn : posn -> posn
37 ;Rounds a posn x to the nearest integer
38 
39 (define (round-posn p)
40   (make-posn (round-number (posn-x p))
41              (round-number (posn-y p))))
42 
43 ;round-number : inexact number -> exact number
44 ;Returns x as an exact number rounded to the nearest integer
45 (define (round-number x)
46   (round (inexact->exact x)))
47 
48 ;draw-triangle : posn posn posn -> true
49 ;Draw the triangle that contains a, b, and c as vertices.
50 
51 (define (draw-triangle a b c color)
52   (and (draw-solid-line a b color)
53        (draw-solid-line b c color)
54        (draw-solid-line c a color)))
55 
56 ;midpoint : posn posn -> posn
57 ;Given a, b, find the midpoint of the two posns.
58 
59 (define (midpoint a b)
60   (make-posn (/ (+ (posn-x a) (posn-x b)) 2)
61              (/ (+ (posn-y a) (posn-y b)) 2)))
62 
63 ;too-small? : posn posn posn -> boolean
64 ;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.
65 
66 (define MINAREA 5)
67 
68 (define (too-small? a b c)
69   (< (area-of-triangle a b c) MINAREA))
70 
71 ;area-of-triangle : posn posn posn -> number
72 ;Given a, b, c, determine the area of the triangle. (uses Heron's formula).  (sp stands for semiperimeter)
73 
74 (define (area-of-triangle a b c)
75   (local ((define A (distance b c))
76           (define B (distance a c))
77           (define C (distance a b))
78           (define sp (/ (+ A B C) 2)))
79     (sqrt (* sp
80              (- sp A)
81              (- sp B)
82              (- sp C)))))
83 
84 ;distance : posn posn -> number
85 ;Given p1, p2, determine the distance between two points.
86 
87 (define (distance p1 p2)
88   (sqrt (+ (sqr (- (posn-x p2) (posn-x p1)))
89            (sqr (- (posn-y p2) (posn-y p1))))))
90 
91 ;;circle-pt : number posn number -> posn
92 ;;Given angle-ratio (ie, 120/360, 240/360, 360/360), find a position on the circle with center and radius as defined above.
93 
94 (define (circle-pt angle-ratio center radius)
95   (local ((define theta (* angle-ratio 2 pi)))
96     (make-posn (+ (posn-x center)
97                   (* radius (cos theta)))
98                (- (posn-y center)
99                   (* radius (sin theta))))))
100 
101 (define WIDTH 1000)
102 (define HEIGHT 1000)
103 
104 (define triangle3 (list (make-triangle (make-posn 0 300)
105                                        (make-posn 400 300)
106                                        (make-posn 200 0)
107                                        'black)
108                         (make-triangle (make-posn 0 800)
109                                        (make-posn 400 800)
110                                        (make-posn 200 500)
111                                        'green)
112                         (make-triangle (make-posn 400 600)
113                                        (make-posn 1000 600)
114                                        (make-posn 700 300)
115                                        'purple)))
116 (start WIDTH HEIGHT)
117 (sierpinski-list triangle3)
118 
119 ;;Obsoleted code
120 
121 #|
122 
123 (define CENTER (make-posn 200 200))
124 (define RADIUS 200)
125 
126 ;;circle-pt : number -> posn
127 ;;Given angle-ratio (ie, 120/360, 240/360, 360/360), find a position on the circle with CENTER and RADIUS as defined above.
128 
129 (define (circle-pt angle-ratio)
130   (local ((define theta (* angle-ratio 2 pi)))
131     (make-posn (+ (posn-x CENTER)
132                   (* RADIUS (cos theta)))
133                (- (posn-y CENTER)
134                   (* RADIUS (sin theta))))))
135 
136 (define A (circle-pt 120/360))
137 (define B (circle-pt 240/360))
138 (define C (circle-pt 360/360))
139 
140 (define WIDTH 400)
141 (define HEIGHT 400)
142 (start WIDTH HEIGHT)
143 
144 
145 
146 (draw-circle CENTER RADIUS 'black)
147 (draw-solid-disk A 5 'green)
148 (draw-solid-disk B 5 'blue)
149 (draw-solid-disk C 5 'purple)
150 
151 (define WIDTH 1000)
152 (define HEIGHT 1000)
153 
154 (define x1 (make-posn 0 (round-number HEIGHT)))
155 (define x2 (make-posn (round-number WIDTH)
156                       (round-number HEIGHT)))
157 (define x3 (make-posn (round-number (/ WIDTH 2))
158                       (round-number (* HEIGHT
159                                        (- 1 (/ (sqrt 3) 2))))))
160 
161 (start WIDTH HEIGHT)
162 (sierpinski x1 x2 x3 'black)
163 
164 (build-list 3 (lambda (x) (circle-pt (* x 120/360)
165                                      (make-posn 400 400)
166                                      300)))
167 
168 |#