1 files changed, 90 insertions, 0 deletions
diff --git a/sicp/pict.rkt b/sicp/pict.rkt
new file mode 100644
index 0000000..ca52e4e
--- /dev/null
+++ b/sicp/pict.rkt
@@ -0,0 +1,90 @@
+#lang sicp
+(#%require sicp-pict)
+
+(define (flipped-pairs painter)
+  (let ((painter2 (beside painter (flip-vert painter))))
+    (below painter2 painter2)))
+
+(define (right-spilt painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (right-spilt painter (dec n))))
+        (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+  (if (= n 0)
+      painter
+      (let ((smaller (up-split painter (dec n))))
+        (below painter (beside smaller smaller)))))
+
+(define (corner-spilt painter n)
+  (if (= n 0)
+      painter
+      (let ((up (up-split painter (dec n)))
+            (right (right-spilt painter (dec n))))
+        (let ((top-left (beside up up))
+              (bottom-right (below right right))
+              (corner (corner-spilt painter (dec n))))
+          (beside (below painter top-left)
+                  (below bottom-right corner))))))
+
+(define (square-limit painter n)
+  (let ((quarter (corner-spilt painter n)))
+    (let ((half (beside (flip-horiz quarter) quarter)))
+      (below (flip-vert half) half))))
+
+(define (square-of-four tl tr bl br)
+  (lambda (painter)
+    (let ((top (beside (tl painter) (tr painter)))
+          (bottom (beside (bl painter) (br painter))))
+      (below bottom top))))
+
+(define (split children-parent children)
+  (lambda (parent n)
+    (if (= n 0)
+        parent
+        (let ((child ((split children-parent children) parent (dec n))))
+          (children-parent parent (children child child))))))
+
+(define make-vect cons)
+(define xcor-vect car)
+(define ycor-vect cdr)
+(define (add-vect v1 v2)
+  (make-vect (+ (xcor-vect v1) (xcor-vect v2))
+             (+ (ycor-vect v1) (ycor-vect v2))))
+(define (sub-vect v1 v2)
+  (make-vect (- (xcor-vect v1) (xcor-vect v2))
+             (- (ycor-vect v1) (ycor-vect v2))))
+(define (scale-vect s v)
+  (make-vect (* s (xcor-vect v))
+             (* s (ycor-vect v))))
+
+(define (make-frame origin edge1 edge2)
+  (cons origin (cons edge1 edge2)))
+(define origin-frame car)
+(define edge1-frame cadr)
+(define edge2-frame cddr)
+
+(define (outline frame)
+  (segments->painter (list (make-segment (make-vect 0 0)
+                                         (make-vect 1 0))
+                           (make-segment (make-vect 1 0)
+                                         (make-vect 1 1))
+                           (make-segment (make-vect 1 1)
+                                         (make-vect 0 1))
+                           (make-segment (make-vect 0 1)
+                                         (make-vect 0 0)))))
+(define (xxx frame)
+  (segments->painter (list (make-segment (make-vect 0 0)
+                                         (make-vect 1 1))
+                           (make-segment (make-vect 1 0)
+                                         (make-vect 0 1)))))
+(define (diamond frame)
+  (segments->painter (list (make-segment (make-vect 0.5 0.0)
+                                         (make-vect 1.0 0.5))
+                           (make-segment (make-vect 1.0 0.5)
+                                         (make-vect 0.5 1.0))
+                           (make-segment (make-vect 0.5 1.0)
+                                         (make-vect 0.0 0.5))
+                           (make-segment (make-vect 0.0 0.5)
+                                         (make-vect 0.5 0.0)))))