Permalink
Browse files

picture language

  • Loading branch information...
1 parent 6380993 commit c3defb92ec1dafd6cdd0f3fe7e900df618b609a8 @sarabander committed Aug 22, 2011
Showing with 353 additions and 0 deletions.
  1. +17 −0 2.2/2.44.scm
  2. +28 −0 2.2/2.45.scm
  3. +25 −0 2.2/2.46.scm
  4. +32 −0 2.2/2.47.scm
  5. +8 −0 2.2/2.48.scm
  6. +55 −0 2.2/2.49.scm
  7. +39 −0 2.2/2.50.scm
  8. +39 −0 2.2/2.51.scm
  9. +110 −0 2.2/2.52.scm
View
@@ -0,0 +1,17 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+(define (right-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (right-split painter (- n 1))))
+ (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (up-split painter (- n 1))))
+ (below painter (beside smaller smaller)))))
+
+;; Paint something
+(paint (right-split einstein 4))
+(paint (up-split einstein 4))
View
@@ -0,0 +1,28 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+;; Original splits
+(define (right-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (right-split painter (- n 1))))
+ (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (up-split painter (- n 1))))
+ (below painter (beside smaller smaller)))))
+
+;; More general split
+(define (split f1 f2)
+ (lambda (painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller ((split f1 f2) painter (- n 1))))
+ (f1 painter (f2 smaller smaller))))))
+
+(define right-split (split beside below))
+(define up-split (split below beside))
+
+(paint (right-split einstein 4))
+(paint (up-split einstein 4))
View
@@ -0,0 +1,25 @@
+
+(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))))
+
+;; Tests
+(scale-vect 3 (add-vect (make-vect 3 4)
+ (make-vect 2 -6)))
+
+(sub-vect (make-vect 3 4)
+ (make-vect 2 -6))
View
@@ -0,0 +1,32 @@
+
+;; 1st implementation
+(define (make-frame origin edge1 edge2)
+ (list origin edge1 edge2))
+
+(define origin-frame car)
+
+(define edge1-frame cadr)
+
+(define edge2-frame caddr)
+
+;; Quick test
+(define frame1 (make-frame 'o 'e1 'e2))
+(origin-frame frame1)
+(edge1-frame frame1)
+(edge2-frame frame1)
+
+;; 2nd implementation
+(define (make-frame origin edge1 edge2)
+ (cons origin (cons edge1 edge2)))
+
+(define origin-frame car)
+
+(define edge1-frame cadr)
+
+(define edge2-frame cddr)
+
+;; Quick test
+(define frame1 (make-frame 10 20 30))
+(origin-frame frame1)
+(edge1-frame frame1)
+(edge2-frame frame1)
View
@@ -0,0 +1,8 @@
+
+;; start and end are vectors
+(define (make-segment start end)
+ (cons start end))
+
+(define start-segment car)
+
+(define end-segment cdr)
View
@@ -0,0 +1,55 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+;(define (segments->painter segment-list)
+; (lambda (frame)
+; (for-each
+; (lambda (segment)
+; (draw-line
+; ((frame-coord-map frame) (start-segment segment))
+; ((frame-coord-map frame) (end-segment segment))))
+; segment-list)))
+
+;; a.
+(define outlinelist (list (make-segment (make-vect 0 0) (make-vect 0 0.99))
+ (make-segment (make-vect 0 0.99) (make-vect 0.99 0.99))
+ (make-segment (make-vect 0.99 0.99) (make-vect 0.99 0))
+ (make-segment (make-vect 0.99 0) (make-vect 0 0))))
+
+(define outline (segments->painter outlinelist))
+(paint outline)
+
+;; b.
+(define xlist (list (make-segment (make-vect 0 0) (make-vect 1 1))
+ (make-segment (make-vect 1 0) (make-vect 0 1))))
+
+(define x (segments->painter xlist))
+(paint x)
+
+;; c.
+(define diamondlist (list (make-segment (make-vect 0.5 0) (make-vect 0 0.5))
+ (make-segment (make-vect 0 0.5) (make-vect 0.5 0.99))
+ (make-segment (make-vect 0.5 0.99) (make-vect 0.99 0.5))
+ (make-segment (make-vect 0.99 0.5) (make-vect 0.5 0))))
+
+(define diamond (segments->painter diamondlist))
+(paint diamond)
+
+;; d.
+(define wavelist (list (make-segment (make-vect 0.2 0) (make-vect 0.4 0.5))
+ (make-segment (make-vect 0.4 0.5) (make-vect 0.2 0.5))
+ (make-segment (make-vect 0.2 0.5) (make-vect 0 0.7))
+ (make-segment (make-vect 0 0.9) (make-vect 0.2 0.7))
+ (make-segment (make-vect 0.2 0.7) (make-vect 0.4 0.7))
+ (make-segment (make-vect 0.4 0.7) (make-vect 0.35 0.8))
+ (make-segment (make-vect 0.35 0.8) (make-vect 0.4 1))
+ (make-segment (make-vect 0.6 0.99) (make-vect 0.65 0.8))
+ (make-segment (make-vect 0.65 0.8) (make-vect 0.6 0.7))
+ (make-segment (make-vect 0.6 0.7) (make-vect 0.7 0.7))
+ (make-segment (make-vect 0.7 0.7) (make-vect 0.99 0.5))
+ (make-segment (make-vect 0.99 0.3) (make-vect 0.6 0.5))
+ (make-segment (make-vect 0.6 0.5) (make-vect 0.8 0))
+ (make-segment (make-vect 0.6 0) (make-vect 0.5 0.3))
+ (make-segment (make-vect 0.5 0.3) (make-vect 0.4 0))))
+
+(define wave (segments->painter wavelist))
+(paint wave)
View
@@ -0,0 +1,39 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+;; Modified to use the transform-painter from hend.scm (in sicp.plt)
+(define (beside painter1 painter2)
+ (let ((split-point (make-vect 0.5 0.0)))
+ (let ((paint-left
+ (transform-painter (make-vect 0.0 0.0)
+ split-point
+ (make-vect 0.0 1.0)))
+ (paint-right
+ (transform-painter split-point
+ (make-vect 1.0 0.0)
+ (make-vect 0.5 1.0))))
+ (superpose
+ (paint-left painter1)
+ (paint-right painter2)))))
+
+(paint (beside einstein einstein))
+
+(define flip-horiz
+ (transform-painter (make-vect 1 0)
+ (make-vect 0 0)
+ (make-vect 1 1)))
+
+(paint (flip-horiz einstein))
+
+(define rotate180
+ (transform-painter (make-vect 1 1)
+ (make-vect 0 1)
+ (make-vect 1 0)))
+
+(paint (rotate180 einstein))
+
+(define rotate270
+ (transform-painter (make-vect 0 1)
+ (make-vect 0 0)
+ (make-vect 1 1)))
+
+(paint (rotate270 einstein))
View
@@ -0,0 +1,39 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+;; First version
+(define (below painter1 painter2)
+ (let ((split-point (make-vect 0 0.5)))
+ (let ((paint-top
+ (transform-painter split-point
+ (make-vect 1.0 0.5)
+ (make-vect 0.0 1.0)))
+ (paint-bottom
+ (transform-painter (make-vect 0.0 0.0)
+ (make-vect 1.0 0.0)
+ split-point)))
+ (superpose
+ (paint-top painter2)
+ (paint-bottom painter1)))))
+
+(paint (below gray einstein))
+
+;; Second version
+(define (below painter1 painter2)
+ (rotate270 (rotate180 (beside (rotate270 painter1)
+ (rotate270 painter2)))))
+
+(define (beside painter1 painter2)
+ (let ((split-point (make-vect 0.5 0.0)))
+ (let ((paint-left
+ (transform-painter (make-vect 0.0 0.0)
+ split-point
+ (make-vect 0.0 1.0)))
+ (paint-right
+ (transform-painter split-point
+ (make-vect 1.0 0.0)
+ (make-vect 0.5 1.0))))
+ (superpose
+ (paint-left painter1)
+ (paint-right painter2)))))
+
+(paint (below gray einstein))
View
@@ -0,0 +1,110 @@
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+
+;; a.
+;; Make legs larger, add fingers
+(define wavelist (list (make-segment (make-vect 0.1 0) (make-vect 0.4 0.55))
+ (make-segment (make-vect 0.4 0.55) (make-vect 0.2 0.5))
+ (make-segment (make-vect 0.2 0.5) (make-vect 0 0.7))
+ (make-segment (make-vect 0 0.9) (make-vect 0.2 0.7))
+ (make-segment (make-vect 0.2 0.7) (make-vect 0.4 0.7))
+ (make-segment (make-vect 0.4 0.7) (make-vect 0.35 0.8))
+ (make-segment (make-vect 0.35 0.8) (make-vect 0.4 1))
+ (make-segment (make-vect 0.6 0.99) (make-vect 0.65 0.8))
+ (make-segment (make-vect 0.65 0.8) (make-vect 0.6 0.7))
+ (make-segment (make-vect 0.6 0.7) (make-vect 0.7 0.7))
+ (make-segment (make-vect 0.7 0.7) (make-vect 0.99 0.5))
+ (make-segment (make-vect 0.99 0.3) (make-vect 0.6 0.55))
+ (make-segment (make-vect 0.6 0.55) (make-vect 0.9 0))
+ (make-segment (make-vect 0.6 0) (make-vect 0.5 0.3))
+ (make-segment (make-vect 0.5 0.3) (make-vect 0.4 0))
+ (make-segment (make-vect 1 0.35) (make-vect 0.9 0.40))
+ (make-segment (make-vect 1 0.41) (make-vect 0.9 0.46))
+ (make-segment (make-vect 1 0.46) (make-vect 0.9 0.51))
+ (make-segment (make-vect 0 0.75) (make-vect 0.1 0.65))
+ (make-segment (make-vect 0 0.80) (make-vect 0.1 0.70))
+ (make-segment (make-vect 0 0.85) (make-vect 0.1 0.75))))
+
+(define wave (segments->painter wavelist))
+(paint wave)
+
+;; b.
+;; Make changes in corner-split
+(define (right-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (right-split painter (- n 1))))
+ (beside painter (below smaller smaller)))))
+
+(define (up-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (up-split painter (- n 1))))
+ (below painter (beside smaller smaller)))))
+
+;; Original
+(define (corner-split painter n)
+ (if (= n 0)
+ painter
+ (let ((up (up-split painter (- n 1)))
+ (right (right-split painter (- n 1))))
+ (let ((top-left (beside up up))
+ (bottom-right (below right right))
+ (corner (corner-split painter (- n 1))))
+ (beside (below painter top-left)
+ (below bottom-right corner))))))
+
+(paint (corner-split wave 4))
+
+;; Changed
+(define (corner-split painter n)
+ (if (= n 0)
+ painter
+ (let ((up (up-split painter (- n 1)))
+ (right (right-split painter (- n 1))))
+ (let ((top-left up)
+ (bottom-right right)
+ (corner (corner-split painter (- n 1))))
+ (beside (below painter top-left)
+ (below bottom-right corner))))))
+
+(paint (corner-split wave 4))
+
+;; c.
+(define (corner-split painter n)
+ (if (= n 0)
+ painter
+ (let ((up (up-split painter (- n 1)))
+ (right (right-split painter (- n 1))))
+ (let ((top-left (beside up up))
+ (bottom-right (below right right))
+ (corner (corner-split painter (- n 1))))
+ (beside (below painter top-left)
+ (below bottom-right corner))))))
+
+;; Original
+(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 (square-limit painter n)
+ (let ((combine4 (square-of-four flip-horiz identity
+ rotate180 flip-vert)))
+ (combine4 (corner-split painter n))))
+
+(paint (square-limit einstein 4))
+
+;; Change position of squares
+(define (square-of-four br bl tr tl)
+ (lambda (painter)
+ (let ((top (beside (tl painter) (tr painter)))
+ (bottom (beside (bl painter) (br painter))))
+ (below bottom top))))
+
+(define (square-limit painter n)
+ (let ((combine4 (square-of-four flip-horiz identity
+ rotate180 flip-vert)))
+ (combine4 (corner-split painter n))))
+
+(paint (square-limit einstein 4))

0 comments on commit c3defb9

Please sign in to comment.