1 12687dd9 2023-08-04 jrmu ;; The first three lines of this file were inserted by DrScheme. They record metadata
2 12687dd9 2023-08-04 jrmu ;; about the language level of this file in a form that our tools can easily process.
3 12687dd9 2023-08-04 jrmu #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 12687dd9 2023-08-04 jrmu (define-struct triangle (a b c color))
6 12687dd9 2023-08-04 jrmu ;A triangle is a structure
7 12687dd9 2023-08-04 jrmu ;(make-triangle a b c co)
8 12687dd9 2023-08-04 jrmu ;where a, b, c are posns, and co is a symbol.
10 12687dd9 2023-08-04 jrmu ;sierpinski-list : (listof triangle) -> true
11 12687dd9 2023-08-04 jrmu ;;Given alot, draw the triangles using sierpinski. Return true once the triangles become too small to draw.
13 12687dd9 2023-08-04 jrmu (define (sierpinski-list alot)
14 12687dd9 2023-08-04 jrmu (andmap (lambda (x) (sierpinski (triangle-a x)
15 12687dd9 2023-08-04 jrmu (triangle-b x)
16 12687dd9 2023-08-04 jrmu (triangle-c x)
17 12687dd9 2023-08-04 jrmu (triangle-color x)))
20 12687dd9 2023-08-04 jrmu ;; sierpinski : posn posn posn symbol -> true
21 12687dd9 2023-08-04 jrmu ;; 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.
23 12687dd9 2023-08-04 jrmu (define (sierpinski a b c color)
24 12687dd9 2023-08-04 jrmu (local ((define a-b (midpoint a b))
25 12687dd9 2023-08-04 jrmu (define a-c (midpoint a c))
26 12687dd9 2023-08-04 jrmu (define b-c (midpoint b c)))
28 12687dd9 2023-08-04 jrmu [(too-small? a b c) true]
29 12687dd9 2023-08-04 jrmu [else (and (draw-triangle (round-posn a)
30 12687dd9 2023-08-04 jrmu (round-posn b)
31 12687dd9 2023-08-04 jrmu (round-posn c) color)
32 12687dd9 2023-08-04 jrmu (sierpinski a a-b a-c color)
33 12687dd9 2023-08-04 jrmu (sierpinski b a-b b-c color)
34 12687dd9 2023-08-04 jrmu (sierpinski c a-c b-c color))])))
36 12687dd9 2023-08-04 jrmu ;round-posn : posn -> posn
37 12687dd9 2023-08-04 jrmu ;Rounds a posn x to the nearest integer
39 12687dd9 2023-08-04 jrmu (define (round-posn p)
40 12687dd9 2023-08-04 jrmu (make-posn (round-number (posn-x p))
41 12687dd9 2023-08-04 jrmu (round-number (posn-y p))))
43 12687dd9 2023-08-04 jrmu ;round-number : inexact number -> exact number
44 12687dd9 2023-08-04 jrmu ;Returns x as an exact number rounded to the nearest integer
45 12687dd9 2023-08-04 jrmu (define (round-number x)
46 12687dd9 2023-08-04 jrmu (round (inexact->exact x)))
48 12687dd9 2023-08-04 jrmu ;draw-triangle : posn posn posn -> true
49 12687dd9 2023-08-04 jrmu ;Draw the triangle that contains a, b, and c as vertices.
51 12687dd9 2023-08-04 jrmu (define (draw-triangle a b c color)
52 12687dd9 2023-08-04 jrmu (and (draw-solid-line a b color)
53 12687dd9 2023-08-04 jrmu (draw-solid-line b c color)
54 12687dd9 2023-08-04 jrmu (draw-solid-line c a color)))
56 12687dd9 2023-08-04 jrmu ;midpoint : posn posn -> posn
57 12687dd9 2023-08-04 jrmu ;Given a, b, find the midpoint of the two posns.
59 12687dd9 2023-08-04 jrmu (define (midpoint a b)
60 12687dd9 2023-08-04 jrmu (make-posn (/ (+ (posn-x a) (posn-x b)) 2)
61 12687dd9 2023-08-04 jrmu (/ (+ (posn-y a) (posn-y b)) 2)))
63 12687dd9 2023-08-04 jrmu ;too-small? : posn posn posn -> boolean
64 12687dd9 2023-08-04 jrmu ;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.
66 12687dd9 2023-08-04 jrmu (define MINAREA 5)
68 12687dd9 2023-08-04 jrmu (define (too-small? a b c)
69 12687dd9 2023-08-04 jrmu (< (area-of-triangle a b c) MINAREA))
71 12687dd9 2023-08-04 jrmu ;area-of-triangle : posn posn posn -> number
72 12687dd9 2023-08-04 jrmu ;Given a, b, c, determine the area of the triangle. (uses Heron's formula). (sp stands for semiperimeter)
74 12687dd9 2023-08-04 jrmu (define (area-of-triangle a b c)
75 12687dd9 2023-08-04 jrmu (local ((define A (distance b c))
76 12687dd9 2023-08-04 jrmu (define B (distance a c))
77 12687dd9 2023-08-04 jrmu (define C (distance a b))
78 12687dd9 2023-08-04 jrmu (define sp (/ (+ A B C) 2)))
82 12687dd9 2023-08-04 jrmu (- sp C)))))
84 12687dd9 2023-08-04 jrmu ;distance : posn posn -> number
85 12687dd9 2023-08-04 jrmu ;Given p1, p2, determine the distance between two points.
87 12687dd9 2023-08-04 jrmu (define (distance p1 p2)
88 12687dd9 2023-08-04 jrmu (sqrt (+ (sqr (- (posn-x p2) (posn-x p1)))
89 12687dd9 2023-08-04 jrmu (sqr (- (posn-y p2) (posn-y p1))))))
91 12687dd9 2023-08-04 jrmu ;;circle-pt : number posn number -> posn
92 12687dd9 2023-08-04 jrmu ;;Given angle-ratio (ie, 120/360, 240/360, 360/360), find a position on the circle with center and radius as defined above.
94 12687dd9 2023-08-04 jrmu (define (circle-pt angle-ratio center radius)
95 12687dd9 2023-08-04 jrmu (local ((define theta (* angle-ratio 2 pi)))
96 12687dd9 2023-08-04 jrmu (make-posn (+ (posn-x center)
97 12687dd9 2023-08-04 jrmu (* radius (cos theta)))
98 12687dd9 2023-08-04 jrmu (- (posn-y center)
99 12687dd9 2023-08-04 jrmu (* radius (sin theta))))))
101 12687dd9 2023-08-04 jrmu (define WIDTH 1000)
102 12687dd9 2023-08-04 jrmu (define HEIGHT 1000)
104 12687dd9 2023-08-04 jrmu (define triangle3 (list (make-triangle (make-posn 0 300)
105 12687dd9 2023-08-04 jrmu (make-posn 400 300)
106 12687dd9 2023-08-04 jrmu (make-posn 200 0)
108 12687dd9 2023-08-04 jrmu (make-triangle (make-posn 0 800)
109 12687dd9 2023-08-04 jrmu (make-posn 400 800)
110 12687dd9 2023-08-04 jrmu (make-posn 200 500)
112 12687dd9 2023-08-04 jrmu (make-triangle (make-posn 400 600)
113 12687dd9 2023-08-04 jrmu (make-posn 1000 600)
114 12687dd9 2023-08-04 jrmu (make-posn 700 300)
116 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
117 12687dd9 2023-08-04 jrmu (sierpinski-list triangle3)
119 12687dd9 2023-08-04 jrmu ;;Obsoleted code
123 12687dd9 2023-08-04 jrmu (define CENTER (make-posn 200 200))
124 12687dd9 2023-08-04 jrmu (define RADIUS 200)
126 12687dd9 2023-08-04 jrmu ;;circle-pt : number -> posn
127 12687dd9 2023-08-04 jrmu ;;Given angle-ratio (ie, 120/360, 240/360, 360/360), find a position on the circle with CENTER and RADIUS as defined above.
129 12687dd9 2023-08-04 jrmu (define (circle-pt angle-ratio)
130 12687dd9 2023-08-04 jrmu (local ((define theta (* angle-ratio 2 pi)))
131 12687dd9 2023-08-04 jrmu (make-posn (+ (posn-x CENTER)
132 12687dd9 2023-08-04 jrmu (* RADIUS (cos theta)))
133 12687dd9 2023-08-04 jrmu (- (posn-y CENTER)
134 12687dd9 2023-08-04 jrmu (* RADIUS (sin theta))))))
136 12687dd9 2023-08-04 jrmu (define A (circle-pt 120/360))
137 12687dd9 2023-08-04 jrmu (define B (circle-pt 240/360))
138 12687dd9 2023-08-04 jrmu (define C (circle-pt 360/360))
140 12687dd9 2023-08-04 jrmu (define WIDTH 400)
141 12687dd9 2023-08-04 jrmu (define HEIGHT 400)
142 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
146 12687dd9 2023-08-04 jrmu (draw-circle CENTER RADIUS 'black)
147 12687dd9 2023-08-04 jrmu (draw-solid-disk A 5 'green)
148 12687dd9 2023-08-04 jrmu (draw-solid-disk B 5 'blue)
149 12687dd9 2023-08-04 jrmu (draw-solid-disk C 5 'purple)
151 12687dd9 2023-08-04 jrmu (define WIDTH 1000)
152 12687dd9 2023-08-04 jrmu (define HEIGHT 1000)
154 12687dd9 2023-08-04 jrmu (define x1 (make-posn 0 (round-number HEIGHT)))
155 12687dd9 2023-08-04 jrmu (define x2 (make-posn (round-number WIDTH)
156 12687dd9 2023-08-04 jrmu (round-number HEIGHT)))
157 12687dd9 2023-08-04 jrmu (define x3 (make-posn (round-number (/ WIDTH 2))
158 12687dd9 2023-08-04 jrmu (round-number (* HEIGHT
159 12687dd9 2023-08-04 jrmu (- 1 (/ (sqrt 3) 2))))))
161 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
162 12687dd9 2023-08-04 jrmu (sierpinski x1 x2 x3 'black)
164 12687dd9 2023-08-04 jrmu (build-list 3 (lambda (x) (circle-pt (* x 120/360)
165 12687dd9 2023-08-04 jrmu (make-posn 400 400)
