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 ;The shortest a line can be before nested savannahs will no longer be drawn
5 12687dd9 2023-08-04 jrmu (define MINDIST 0.5)
7 12687dd9 2023-08-04 jrmu (define (savannah-simplified start end radian)
8 12687dd9 2023-08-04 jrmu (savannah start end radian 'brown 10 0.5))
10 12687dd9 2023-08-04 jrmu ;savannah : posn posn radian symbol -> true
11 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (savannah start end radian color delta-dist delta-radian)
14 12687dd9 2023-08-04 jrmu (local ((define lower-radian (+ radian delta-radian))
15 12687dd9 2023-08-04 jrmu (define upper-radian (- radian delta-radian))
16 12687dd9 2023-08-04 jrmu (define lower-start (start-lower-savannah start end))
17 12687dd9 2023-08-04 jrmu (define upper-start (start-upper-savannah start end))
18 12687dd9 2023-08-04 jrmu (define new-dist (- (distance start end) delta-dist))
19 12687dd9 2023-08-04 jrmu (define lower-end (end-savannah lower-start lower-radian new-dist))
20 12687dd9 2023-08-04 jrmu (define upper-end (end-savannah upper-start upper-radian new-dist)))
22 12687dd9 2023-08-04 jrmu [(too-short? (distance start end)) true]
23 12687dd9 2023-08-04 jrmu [else (and (draw-solid-line start
26 12687dd9 2023-08-04 jrmu (savannah lower-start
28 12687dd9 2023-08-04 jrmu lower-radian
31 12687dd9 2023-08-04 jrmu delta-radian)
32 12687dd9 2023-08-04 jrmu (savannah upper-start
34 12687dd9 2023-08-04 jrmu upper-radian
37 12687dd9 2023-08-04 jrmu delta-radian))])))
39 12687dd9 2023-08-04 jrmu ;too-short? : number -> boolean
40 12687dd9 2023-08-04 jrmu ;Determine if the line is too short to be drawn further.
42 12687dd9 2023-08-04 jrmu (define (too-short? d)
43 12687dd9 2023-08-04 jrmu (< d MINDIST))
45 12687dd9 2023-08-04 jrmu ;distance : posn posn -> number
46 12687dd9 2023-08-04 jrmu ;Given p1, p2, determine the distance between two points.
48 12687dd9 2023-08-04 jrmu (define (distance p1 p2)
49 12687dd9 2023-08-04 jrmu (local ((define x1 (posn-x p1))
50 12687dd9 2023-08-04 jrmu (define x2 (posn-x p2))
51 12687dd9 2023-08-04 jrmu (define y1 (posn-y p1))
52 12687dd9 2023-08-04 jrmu (define y2 (posn-y p2)))
53 12687dd9 2023-08-04 jrmu (sqrt (+ (sqr (- x2 x1))
54 12687dd9 2023-08-04 jrmu (sqr (- y2 y1))))))
56 12687dd9 2023-08-04 jrmu ;start-lower-savannah : posn posn -> posn
57 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (start-lower-savannah start end)
60 12687dd9 2023-08-04 jrmu (savannah-tertile start end 1/3))
62 12687dd9 2023-08-04 jrmu ;start-upper-savannah : posn posn -> posn
63 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (start-upper-savannah start end)
66 12687dd9 2023-08-04 jrmu (savannah-tertile start end 2/3))
68 12687dd9 2023-08-04 jrmu ;savannah-tertile : posn posn number -> posn
69 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (savannah-tertile start end tertile)
71 12687dd9 2023-08-04 jrmu (local ((define x1 (posn-x start))
72 12687dd9 2023-08-04 jrmu (define x2 (posn-x end))
73 12687dd9 2023-08-04 jrmu (define y1 (posn-y start))
74 12687dd9 2023-08-04 jrmu (define y2 (posn-y end)))
75 12687dd9 2023-08-04 jrmu (make-posn (+ x1 (* (- x2 x1) tertile))
76 12687dd9 2023-08-04 jrmu (+ y1 (* (- y2 y1) tertile)))))
79 12687dd9 2023-08-04 jrmu ;end-savannah : posn radian number -> posn
80 12687dd9 2023-08-04 jrmu ;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 12687dd9 2023-08-04 jrmu (define (end-savannah aposn radian distance)
83 12687dd9 2023-08-04 jrmu (circle-pt radian aposn distance))
85 12687dd9 2023-08-04 jrmu ;;circle-pt : radian posn number -> posn
86 12687dd9 2023-08-04 jrmu ;;Given theta (in radians), find a position on the circle with center and radius as defined above.
88 12687dd9 2023-08-04 jrmu (define (circle-pt theta center radius)
89 12687dd9 2023-08-04 jrmu (make-posn (+ (posn-x center)
90 12687dd9 2023-08-04 jrmu (* radius (cos theta)))
91 12687dd9 2023-08-04 jrmu (- (posn-y center)
92 12687dd9 2023-08-04 jrmu (* radius (sin theta)))))
94 12687dd9 2023-08-04 jrmu (define (positive-posn? aposn)
95 12687dd9 2023-08-04 jrmu (and (positive? (posn-x aposn))
96 12687dd9 2023-08-04 jrmu (positive? (posn-y aposn))))
98 12687dd9 2023-08-04 jrmu (start 1000 1000)
99 12687dd9 2023-08-04 jrmu (savannah-simplified (make-posn 500 600) (make-posn 500 500) (/ pi 2))
102 12687dd9 2023-08-04 jrmu ;error when delta-dist is 30
