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 ;; sierpinski : posn posn posn symbol -> true
5 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.
7 12687dd9 2023-08-04 jrmu (define (sierpinski a b c color)
8 12687dd9 2023-08-04 jrmu (local ((define a-b (midpoint a b))
9 12687dd9 2023-08-04 jrmu (define a-c (midpoint a c))
10 12687dd9 2023-08-04 jrmu (define b-c (midpoint b c)))
12 12687dd9 2023-08-04 jrmu [(too-small? a b c) true]
13 12687dd9 2023-08-04 jrmu [else (and (draw-triangle (round-posn a-b)
14 12687dd9 2023-08-04 jrmu (round-posn b-c)
15 12687dd9 2023-08-04 jrmu (round-posn a-c) color)
16 12687dd9 2023-08-04 jrmu (sierpinski a a-b a-c color)
17 12687dd9 2023-08-04 jrmu (sierpinski b a-b b-c color)
18 12687dd9 2023-08-04 jrmu (sierpinski c a-c b-c color))])))
20 12687dd9 2023-08-04 jrmu ;round-posn : posn -> posn
21 12687dd9 2023-08-04 jrmu ;Rounds a posn x to the nearest integer
23 12687dd9 2023-08-04 jrmu (define (round-posn p)
24 12687dd9 2023-08-04 jrmu (make-posn (inexact->exact (round (posn-x p)))
25 12687dd9 2023-08-04 jrmu (inexact->exact (round (posn-y p)))))
27 12687dd9 2023-08-04 jrmu ;draw-triangle : posn posn posn -> true
28 12687dd9 2023-08-04 jrmu ;Draw the triangle that contains a, b, and c as vertices.
30 12687dd9 2023-08-04 jrmu (define (draw-triangle a b c color)
31 12687dd9 2023-08-04 jrmu (and (draw-solid-line a b color)
32 12687dd9 2023-08-04 jrmu (draw-solid-line b c color)
33 12687dd9 2023-08-04 jrmu (draw-solid-line c a color)))
35 12687dd9 2023-08-04 jrmu ;midpoint : posn posn -> posn
36 12687dd9 2023-08-04 jrmu ;Given a, b, find the midpoint of the two posns.
38 12687dd9 2023-08-04 jrmu (define (midpoint a b)
39 12687dd9 2023-08-04 jrmu (make-posn (/ (+ (posn-x a) (posn-x b)) 2)
40 12687dd9 2023-08-04 jrmu (/ (+ (posn-y a) (posn-y b)) 2)))
42 12687dd9 2023-08-04 jrmu ;too-small? : posn posn posn -> boolean
43 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.
45 12687dd9 2023-08-04 jrmu (define MINAREA 10)
47 12687dd9 2023-08-04 jrmu (define (too-small? a b c)
48 12687dd9 2023-08-04 jrmu (< (area-of-triangle a b c) MINAREA))
50 12687dd9 2023-08-04 jrmu ;area-of-triangle : posn posn posn -> number
51 12687dd9 2023-08-04 jrmu ;Given a, b, c, determine the area of the triangle. (uses Heron's formula)
53 12687dd9 2023-08-04 jrmu (define (area-of-triangle a b c)
54 12687dd9 2023-08-04 jrmu (local ((define A (distance b c))
55 12687dd9 2023-08-04 jrmu (define B (distance a c))
56 12687dd9 2023-08-04 jrmu (define C (distance a b))
57 12687dd9 2023-08-04 jrmu (define semiperimeter (/ (+ A B C) 2)))
58 12687dd9 2023-08-04 jrmu (sqrt (* semiperimeter
59 12687dd9 2023-08-04 jrmu (- semiperimeter A)
60 12687dd9 2023-08-04 jrmu (- semiperimeter B)
61 12687dd9 2023-08-04 jrmu (- semiperimeter C)))))
63 12687dd9 2023-08-04 jrmu ;distance : posn posn -> number
64 12687dd9 2023-08-04 jrmu ;Given p1, p2, determine the distance between two points.
66 12687dd9 2023-08-04 jrmu (define (distance p1 p2)
67 12687dd9 2023-08-04 jrmu (sqrt (+ (sqr (- (posn-x p2) (posn-x p1)))
68 12687dd9 2023-08-04 jrmu (sqr (- (posn-y p2) (posn-y p1))))))
70 12687dd9 2023-08-04 jrmu (define CENTER (make-posn 200 200))
71 12687dd9 2023-08-04 jrmu (define RADIUS 200)
73 12687dd9 2023-08-04 jrmu ;;circle-pt : number -> posn
74 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.
76 12687dd9 2023-08-04 jrmu (define (circle-pt angle-ratio)
77 12687dd9 2023-08-04 jrmu (local ((define theta (* angle-ratio 2 pi)))
78 12687dd9 2023-08-04 jrmu (make-posn (+ (posn-x CENTER)
79 12687dd9 2023-08-04 jrmu (* RADIUS (cos theta)))
80 12687dd9 2023-08-04 jrmu (- (posn-y CENTER)
81 12687dd9 2023-08-04 jrmu (* RADIUS (sin theta))))))
83 12687dd9 2023-08-04 jrmu (define A (circle-pt 120/360))
84 12687dd9 2023-08-04 jrmu (define B (circle-pt 240/360))
85 12687dd9 2023-08-04 jrmu (define C (circle-pt 360/360))
87 12687dd9 2023-08-04 jrmu (define WIDTH 400)
88 12687dd9 2023-08-04 jrmu (define HEIGHT 400)
89 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
91 12687dd9 2023-08-04 jrmu (draw-circle CENTER RADIUS 'black)
92 12687dd9 2023-08-04 jrmu (draw-solid-disk A 5 'green)
93 12687dd9 2023-08-04 jrmu (draw-solid-disk B 5 'blue)
94 12687dd9 2023-08-04 jrmu (draw-solid-disk C 5 'purple)
97 12687dd9 2023-08-04 jrmu (define WIDTH 1000)
98 12687dd9 2023-08-04 jrmu (define HEIGHT 1000)
100 12687dd9 2023-08-04 jrmu (define x1 (make-posn 0 (round (inexact->exact HEIGHT))))
101 12687dd9 2023-08-04 jrmu (define x2 (make-posn (round (inexact->exact WIDTH))
102 12687dd9 2023-08-04 jrmu (round (inexact->exact HEIGHT))))
103 12687dd9 2023-08-04 jrmu (define x3 (make-posn (round (inexact->exact (/ WIDTH 2)))
104 12687dd9 2023-08-04 jrmu (round (inexact->exact (* HEIGHT (- 1 (/ (sqrt 3)
107 12687dd9 2023-08-04 jrmu (start WIDTH HEIGHT)
108 12687dd9 2023-08-04 jrmu (sierpinski x1 x2 x3 'black)
