49 sucked

4 files changed, 159 insertions, 51 deletions

diff --git a/coding-exercises/2/46.rkt b/coding-exercises/2/46.rkt
index 4016ef7..91fad04 100644
--- a/coding-exercises/2/46.rkt
+++ b/coding-exercises/2/46.rkt
@@ -1,27 +1,27 @@
 #lang racket
-(require "../../shared/lists.rkt")
-
-(define (make-vect x y)
-  (cons x y))
-(define (xcor-vect v)
-  (car v))
-(define (ycor-vect v)
-  (cdr v))
-
-(define (add-vect . v)
-  (make-vect 
-    (fold-right + 0 (map xcor-vect v))
-    (fold-right + 0 (map ycor-vect v))))
-(define (sub-vect . v)
-  (let ((xcors (map xcor-vect v))
-        (ycors (map ycor-vect v)))
-   (make-vect
-     (- (car xcors) (fold-right + 0 (cdr xcors)))
-     (- (car ycors) (fold-right + 0 (cdr ycors))))))
-(define (scale-vect s v)
-  (make-vect (* s (xcor-vect v))
-             (* s (ycor-vect v))))
-
+;; (require "../../shared/lists.rkt")
+;; 
+;; (define (make-vect x y)
+;;   (cons x y))
+;; (define (xcor-vect v)
+;;   (car v))
+;; (define (ycor-vect v)
+;;   (cdr v))
+;; 
+;; (define (add-vect . v)
+;;   (make-vect 
+;;     (fold-right + 0 (map xcor-vect v))
+;;     (fold-right + 0 (map ycor-vect v))))
+;; (define (sub-vect . v)
+;;   (let ((xcors (map xcor-vect v))
+;;         (ycors (map ycor-vect v)))
+;;    (make-vect
+;;      (- (car xcors) (fold-right + 0 (cdr xcors)))
+;;      (- (car ycors) (fold-right + 0 (cdr ycors))))))
+;; (define (scale-vect s v)
+;;   (make-vect (* s (xcor-vect v))
+;;              (* s (ycor-vect v))))
+(require "../../shared/pict.rkt")
 (define test-vec (make-vect 1 2))
 (define test-vec2 (make-vect 3 4))
 ((lambda ()
diff --git a/coding-exercises/2/49.rkt b/coding-exercises/2/49.rkt
index 688364a..9ee7fe9 100644
--- a/coding-exercises/2/49.rkt
+++ b/coding-exercises/2/49.rkt
@@ -1,21 +1,109 @@
 #lang racket
-(require (only-in sicp-pict 
-                  paint 
-                  segments->painter))
 (require "../../shared/pict.rkt")
+(require "../../shared/lists.rkt")
 
 (define (outline frame)
-  (display frame)
-  (let ((corner 
-          (add-vect 
+  (let ((corner
+          (add-vect
             (edge1-frame frame)
             (edge2-frame frame)))
         (origin (origin-frame frame))
         (e1 (edge1-frame frame))
         (e2 (edge2-frame frame)))
-    (segments->painter 
-      (list (make-segment origin e1)
-            (make-segment e1 corner)
-            (make-segment corner e2)
-            (make-segment e2 origin)))))
+    ((segments->painter
+       (list (make-segment origin e1)
+             (make-segment e1 corner)
+             (make-segment corner e2)
+             (make-segment e2 origin))) frame)))
 (paint outline)
+
+(define (x frame)
+  ((segments->painter
+     (list (make-segment (origin-frame frame)
+                         (add-vect
+                           (edge1-frame frame)
+                           (edge2-frame frame)))
+           (make-segment (edge1-frame frame)
+                         (edge2-frame frame))))
+   frame))
+(paint x)
+
+(define (midpoint-segment s)
+  (let ((start (start-segment s))
+        (end (end-segment s)))
+    (let ((midpoint
+            (make-vect
+              (/ (+ (xcor-vect end) (xcor-vect start)) 2)
+              (/ (+ (ycor-vect end) (ycor-vect start)) 2))))
+      midpoint)))
+
+(define (enumerate-corners frame)
+  (list
+    (origin-frame frame)
+    (edge1-frame frame)
+    (add-vect
+      (edge1-frame frame)
+      (edge2-frame frame))
+    (edge2-frame frame)))
+
+(define (close-line line-points)
+  (append line-points (list (car line-points))))
+
+(define (enumerate-segments frame)
+  (map
+    (lambda (pair)
+      (make-segment (car pair) (cadr pair)))
+    (enumerate-windows
+      (close-line (enumerate-corners frame))
+      2)))
+
+(define (line-points->segments points)
+  (map
+   (lambda (pair)
+     (make-segment (car pair) (cadr pair)))
+   (enumerate-windows
+     points
+     2)))
+
+(define (diamond frame)
+  ((segments->painter
+     (line-points->segments
+       (close-line
+         (map
+           midpoint-segment
+           (enumerate-segments frame)))))
+   frame))
+(paint diamond)
+
+(define (wave frame)
+  (let ((wave-points
+          (list
+            (make-vect 0.24 0)
+            (make-vect 0.37 0.5)
+            (make-vect 0.3 0.6)
+            (make-vect 0.15 0.5)
+            (make-vect 0 0.7)
+            (make-vect 0 0.85)
+            (make-vect 0.15 0.65)
+            (make-vect 0.35 0.7)
+            (make-vect 0.4 0.7)
+            (make-vect 0.3 0.85)
+            (make-vect 0.36 1)
+            (make-vect 0.57 1)
+            (make-vect 0.62 0.855)
+            (make-vect 0.55 0.7)
+            (make-vect 0.65 0.7)
+            (make-vect 1 0.35)
+            (make-vect 1 0.25)
+            (make-vect 0.55 0.52)
+            (make-vect 0.7 0)
+            (make-vect 0.55 0)
+            (make-vect 0.45 0.4)
+            (make-vect 0.34 0))))
+    ((segments->painter
+               (append
+                 (enumerate-segments frame)
+                 (line-points->segments
+                  (close-line
+                    wave-points)))) frame)))
+(paint wave)
diff --git a/shared/lists.rkt b/shared/lists.rkt
index b721623..f8d96d0 100644
--- a/shared/lists.rkt
+++ b/shared/lists.rkt
@@ -4,7 +4,8 @@
          fold-right
          fold-left
          flatmap
-         enumerate-interval)
+         enumerate-interval
+         enumerate-windows)
 (define (append list1 list2)
   (if (null? list1)
     list2
@@ -68,3 +69,27 @@
            (enumerate-interval 1 (- i 1))))
     (enumerate-interval 1 n)))
 
+(define (enumerate-windows seq n)
+  (define (setup-n-window)
+    (define (rec i things)
+      (if (> i n)
+        (list '() things)
+        (let ((setup (rec (+ i 1)
+                          (cdr things))))
+          (cons (cons (car things) (car setup))
+                (cdr setup)))))
+    (rec 1 seq))
+  (define (shift-window w item)
+    (append (cdr w) (list item)))
+  (define (iter result window things)
+    (if (null? things)
+      (cons window result)
+      (iter (cons window result)
+            (shift-window window (car things))
+            (cdr things))))
+  (let ((setup (setup-n-window)))
+    (iter '() (car setup) (cadr setup))))
+
+(enumerate-windows
+  (enumerate-interval 1 4)
+  2)
diff --git a/shared/pict.rkt b/shared/pict.rkt
index 7c7a74e..6eb2e19 100644
--- a/shared/pict.rkt
+++ b/shared/pict.rkt
@@ -7,26 +7,25 @@
   sub-vect
   scale-vect
   test-vect
-  make-frame
   origin-frame
   edge1-frame
   edge2-frame
   test-frame
   make-segment
   start-segment
-  end-segment)
+  end-segment
+  paint
+  segments->painter)
 (require sicp-pict)
 (require "lists.rkt")
 
-(define (make-vect x y)
-  (cons x y))
 (define (xcor-vect v)
-  (car v))
+  (vector-xcor v))
 (define (ycor-vect v)
-  (cdr v))
+  (vector-ycor v))
 
 (define (add-vect . v)
-  (make-vect 
+  (make-vect
     (fold-right + 0 (map xcor-vect v))
     (fold-right + 0 (map ycor-vect v))))
 (define (sub-vect . v)
@@ -40,22 +39,18 @@
              (* s (ycor-vect v))))
 (define test-vect (make-vect 1 2))
 
-(define (make-frame origin edge1 edge2)
-  (list origin edge1 edge2))
 (define (origin-frame frame)
-  (car frame))
+  (frame-origin frame))
 (define (edge1-frame frame)
-  (cadr frame))
+  (frame-edge1 frame))
 (define (edge2-frame frame)
-  (caddr frame))
+  (frame-edge2 frame))
 (define test-frame (make-frame
                      (make-vect 1 2)
                      (make-vect 2 4)
                      (make-vect 3 6)))
 
-(define (make-segment start end)
-  (cons start end))
 (define (start-segment s)
-  (car s))
+  (segment-start s))
 (define (end-segment s)
-  (cdr s))
+  (segment-end s))