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)))