]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/ex2_49.clj
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / ex2_49.clj
1 (ns sicp.ex2_49
2   (:use [sicp [ch2_2 :only (segments->painter)]]
3         [clojure.test]))
4
5 ;;; Use segments->painter to define the following primitive painters:
6
7 ;;   a.  The painter that draws the outline of the designated frame.
8
9 (def o  (make-vect 0 0))
10 (def lr (make-vect 0 1))
11 (def ul (make-vect 1 0))
12 (def ur (make-vect 1 1))
13
14 (defn frame-outline [frame]
15   (let [s1 (make-segment o lr)
16         s2 (make-segment lr ur)
17         s3 (make-segment ur ul)
18         s4 (make-segment ul o)]
19     ((segments->painter (list s1 s2 s3 s4)) frame)))
20
21 ;; b The painter that draws an ``X'' by connecting opposite corners
22 ;;   of the frame.
23 (defn cross-segments [frame]
24   (let [s1 (make-segment ul lr)
25         s2 (make-segment o ur)]
26     ((segments->painter (list s1 s2)) frame)))
27
28 ;; c.  The painter that draws a diamond shape by connecting the midpoints
29 ;;     of the sides of the frame.
30 (defn connect [vs]
31   (let [new-list   (append vs (list (car vs)))
32         vect-pairs (partition 2 1 new-list)
33         segments   (map #(apply make-segment %) vect-pairs)]
34     segments))
35
36 (defn diamond-segments [frame]
37   (let [m1 (make-vect 0 0.5)
38         m2 (make-vect 0.5 1)
39         m3 (make-vect 1 0.5)
40         m4 (make-vect 0.5 0)]
41     ((segments->painter (connect (list m1 m2 m3 m4))) frame)))
42
43 ;; d. wave painter
44 (defn wave [frame]
45   (let [p01 (make-vect 0.40 1.00)
46         p02 (make-vect 0.60 1.00)
47         p03 (make-vect 0.00 0.80)
48         p04 (make-vect 0.35 0.80)
49         p05 (make-vect 0.65 0.80)
50         p06 (make-vect 0.00 0.60)
51         p07 (make-vect 0.30 0.60)
52         p08 (make-vect 0.40 0.60)
53         p09 (make-vect 0.60 0.60)
54         p10 (make-vect 0.70 0.60)
55         p11 (make-vect 0.20 0.55)
56         p12 (make-vect 0.30 0.55)
57         p13 (make-vect 0.35 0.50)
58         p14 (make-vect 0.65 0.50)
59         p15 (make-vect 0.20 0.45)
60         p16 (make-vect 1.00 0.40)
61         p17 (make-vect 0.50 0.20)
62         p18 (make-vect 1.00 0.20)
63         p19 (make-vect 0.25 0.00)
64         p20 (make-vect 0.40 0.00)
65         p21 (make-vect 0.60 0.00)
66         p22 (make-vect 0.75 0.00)]
67     ((segments->painter
68       (list (make-segment p01 p04)
69             (make-segment p04 p08)
70             (make-segment p08 p07)
71             (make-segment p07 p11)
72             (make-segment p11 p03)
73             (make-segment p06 p15)
74             (make-segment p15 p12)
75             (make-segment p12 p13)
76             (make-segment p13 p19)
77             (make-segment p20 p17)
78             (make-segment p17 p21)
79             (make-segment p22 p14)
80             (make-segment p14 p18)
81             (make-segment p16 p10)
82             (make-segment p10 p09)
83             (make-segment p09 p05)
84             (make-segment p05 p02))) frame)))