fixup

1 files changed, 88 insertions, 3 deletions

diff --git a/shared/pict.rkt b/shared/pict.rkt
index 6eb2e19..aa46f3c 100644
--- a/shared/pict.rkt
+++ b/shared/pict.rkt
@@ -15,9 +15,23 @@
   start-segment
   end-segment
   paint
-  segments->painter)
-(require sicp-pict)
-(require "lists.rkt")
+  segments->painter
+  transform-painter
+  beside
+  einstein
+  flip-horiz
+  flip-vert
+  <-rotate180
+  <-rotate270
+  enumerate-corners
+  enumerate-segments
+  close-line
+  line-points->segments
+  up-split
+  right-split
+  below
+  square-of-four)
+(require sicp-pict "lists.rkt")
 
 (define (xcor-vect v)
   (vector-xcor v))
@@ -54,3 +68,74 @@
   (segment-start s))
 (define (end-segment s)
   (segment-end s))
+
+(define (flip-horiz painter)
+  (transform-painter
+    painter
+    (make-vect 1 0)
+    (make-vect 0 0)
+    (make-vect 1 1)))
+
+(define (flip-vert painter)
+  (transform-painter
+   painter
+   (make-vect 0 1)
+   (make-vect 1 1)
+   (make-vect 0 0)))
+
+(define (<-rotate180 painter)
+  (flip-horiz (flip-vert painter)))
+(define (<-rotate270 painter)
+  (transform-painter
+   painter
+   (make-vect 0 1)
+   (make-vect 0 0)
+   (make-vect 1 1)))
+
+
+(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 (right-split painter n)
+  (if (= n 0)
+    painter
+    (let ((smaller (right-split painter (- n 1))))
+      (beside smaller (below smaller smaller)))))
+
+(define (up-split painter n)
+  (if (= n 0)
+    painter
+    (let ((smaller (up-split painter (- n 1))))
+      (below smaller (beside smaller smaller)))))
+
+(define (square-of-four tl tr bl br)
+  (lambda (painter)
+    (let ((t (beside (tl painter) (tr painter)))
+          (b (beside (bl painter) (br painter))))
+      (below b t))))