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.
6 
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)))
11     (cond 
12       [(too-small? a b c) true]
13       [else (and (draw-triangle (round-posn a-b)
14                                 (round-posn b-c)
15                                 (round-posn a-c) color)
16                  (sierpinski a a-b a-c color)
17                  (sierpinski b a-b b-c color)
18                  (sierpinski c a-c b-c color))])))
19 
20 ;round-posn : posn -> posn
21 ;Rounds a posn x to the nearest integer
22 
23 (define (round-posn p)
24   (make-posn (inexact->exact (round (posn-x p)))
25              (inexact->exact (round (posn-y p)))))
26 
27 ;draw-triangle : posn posn posn -> true
28 ;Draw the triangle that contains a, b, and c as vertices.
29 
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)))
34 
35 ;midpoint : posn posn -> posn
36 ;Given a, b, find the midpoint of the two posns.
37 
38 (define (midpoint a b)
39   (make-posn (/ (+ (posn-x a) (posn-x b)) 2)
40              (/ (+ (posn-y a) (posn-y b)) 2)))
41 
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.
44 
45 (define MINAREA 10)
46 
47 (define (too-small? a b c)
48   (< (area-of-triangle a b c) MINAREA))
49 
50 ;area-of-triangle : posn posn posn -> number
51 ;Given a, b, c, determine the area of the triangle. (uses Heron's formula)
52 
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
59              (- semiperimeter A)
60              (- semiperimeter B)
61              (- semiperimeter C)))))
62 
63 ;distance : posn posn -> number
64 ;Given p1, p2, determine the distance between two points.
65 
66 (define (distance p1 p2)
67   (sqrt (+ (sqr (- (posn-x p2) (posn-x p1)))
68            (sqr (- (posn-y p2) (posn-y p1))))))
69 
70 (define CENTER (make-posn 200 200))
71 (define RADIUS 200)
72 
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.
75 
76 (define (circle-pt angle-ratio)
77   (local ((define theta (* angle-ratio 2 pi)))
78     (make-posn (+ (posn-x CENTER)
79                   (* RADIUS (cos theta)))
80                (- (posn-y CENTER)
81                   (* RADIUS (sin theta))))))
82 
83 (define A (circle-pt 120/360))
84 (define B (circle-pt 240/360))
85 (define C (circle-pt 360/360))
86 
87 (define WIDTH 400)
88 (define HEIGHT 400)
89 (start WIDTH HEIGHT)
90 
91 (draw-circle CENTER RADIUS 'black)
92 (draw-solid-disk A 5 'green)
93 (draw-solid-disk B 5 'blue)
94 (draw-solid-disk C 5 'purple)
95 
96 #|
97 (define WIDTH 1000)
98 (define HEIGHT 1000)
99 
100 (define x1 (make-posn 0 (round (inexact->exact HEIGHT))))
101 (define x2 (make-posn (round (inexact->exact WIDTH))
102                       (round (inexact->exact HEIGHT))))
103 (define x3 (make-posn (round (inexact->exact (/ WIDTH 2)))
104                       (round (inexact->exact (* HEIGHT (- 1 (/ (sqrt 3)
105                                                                2)))))))
106 
107 (start WIDTH HEIGHT)
108 (sierpinski x1 x2 x3 'black)
109 
110 |#