Blob


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 ;The shortest a line can be before nested savannahs will no longer be drawn
5 (define MINDIST 0.5)
7 (define (savannah-simplified start end radian)
8 (savannah start end radian 'brown 10 0.5))
10 ;savannah : posn posn radian symbol -> true
11 ;Given start, end, angle, and color, draw a savannah tree until the lines are too short, then return true. The savannah is drawn by drawing the first line then drawing two more smaller savannahs on the first line. savannah must necessarily terminate because each savannah is smaller than the next and the distance between start and end will shrink until it is too short to be drawn. When this occurs, the generative recursion returns true. The first line is divided into three tertiles, with a lower savannah and an upper savannah. delta-dist indicates how much the line shrinks in each recursion, and delta-radian indicates the angle by which each nested savannah branches from its parent savannah.
13 (define (savannah start end radian color delta-dist delta-radian)
14 (local ((define lower-radian (+ radian delta-radian))
15 (define upper-radian (- radian delta-radian))
16 (define lower-start (start-lower-savannah start end))
17 (define upper-start (start-upper-savannah start end))
18 (define new-dist (- (distance start end) delta-dist))
19 (define lower-end (end-savannah lower-start lower-radian new-dist))
20 (define upper-end (end-savannah upper-start upper-radian new-dist)))
21 (cond
22 [(too-short? (distance start end)) true]
23 [else (and (draw-solid-line start
24 end
25 color)
26 (savannah lower-start
27 lower-end
28 lower-radian
29 color
30 delta-dist
31 delta-radian)
32 (savannah upper-start
33 upper-end
34 upper-radian
35 color
36 delta-dist
37 delta-radian))])))
39 ;too-short? : number -> boolean
40 ;Determine if the line is too short to be drawn further.
42 (define (too-short? d)
43 (< d MINDIST))
45 ;distance : posn posn -> number
46 ;Given p1, p2, determine the distance between two points.
48 (define (distance p1 p2)
49 (local ((define x1 (posn-x p1))
50 (define x2 (posn-x p2))
51 (define y1 (posn-y p1))
52 (define y2 (posn-y p2)))
53 (sqrt (+ (sqr (- x2 x1))
54 (sqr (- y2 y1))))))
56 ;start-lower-savannah : posn posn -> posn
57 ;Given start and end, determine the start posn of the lower savannah. Calls on savannah-tertile. The lower savannah is the bottom 1/3 tertile, hence 1/3 is used as an argument.
59 (define (start-lower-savannah start end)
60 (savannah-tertile start end 1/3))
62 ;start-upper-savannah : posn posn -> posn
63 ;Given start and end, determine the start posn of the upper savannah. Calls on savannah-tertile. The upper savannah is the bottom 2/3 tertile, hence 2/3 is used as an argument.
65 (define (start-upper-savannah start end)
66 (savannah-tertile start end 2/3))
68 ;savannah-tertile : posn posn number -> posn
69 ;Determines the start point of a savannah tree given start and end and tertile, which indicates in which bottom tertile the savannah lies (the lower savannah is the bottom 1/3, the upper savannah is the bottom 2/3).
70 (define (savannah-tertile start end tertile)
71 (local ((define x1 (posn-x start))
72 (define x2 (posn-x end))
73 (define y1 (posn-y start))
74 (define y2 (posn-y end)))
75 (make-posn (+ x1 (* (- x2 x1) tertile))
76 (+ y1 (* (- y2 y1) tertile)))))
79 ;end-savannah : posn radian number -> posn
80 ;Given aposn, radian, and distance, determine the end posn of any savannah by calling on circle-pt, which uses trigonometry to determine where the end-point lies.
82 (define (end-savannah aposn radian distance)
83 (circle-pt radian aposn distance))
85 ;;circle-pt : radian posn number -> posn
86 ;;Given theta (in radians), find a position on the circle with center and radius as defined above.
88 (define (circle-pt theta center radius)
89 (make-posn (+ (posn-x center)
90 (* radius (cos theta)))
91 (- (posn-y center)
92 (* radius (sin theta)))))
94 (define (positive-posn? aposn)
95 (and (positive? (posn-x aposn))
96 (positive? (posn-y aposn))))
98 (start 1000 1000)
99 (savannah-simplified (make-posn 500 600) (make-posn 500 500) (/ pi 2))
102 ;error when delta-dist is 30