--- /dev/null
+#lang racket/load
+;#lang planet neil/sicp
+(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))
+;(require (planet neil/sicp:1:13))
+
+(define (identity x) x)
+
+(define (flipped-pairs painter)
+ (let ((painter2 (beside painter (flip-vert painter))))
+ (below painter2 painter2)))
+
+(paint (flipped-pairs einstein))
+
+(define (right-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (right-split painter (- n 1))))
+ (beside painter (below smaller smaller)))))
+
+(paint (right-split einstein 2))
+
+(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))))
+ (below (beside painter bottom-right)
+ (beside top-left corner))))))
+
+(define (square-limit painter n)
+ (let ((corner (corner-split painter n)))
+ (let ((half (beside (flip-horiz corner) corner)))
+ (below (flip-vert half) half))))
+
+;; ex 2.44
+(define (up-split painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller (up-split painter (- n 1))))
+ (below painter (beside smaller smaller)))))
+
+(paint (up-split einstein 2))
+
+;; higher order operations
+(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 (flipped-pairs2 painter)
+ (let ((combine4 (square-of-four identity flip-vert
+ identity flip-vert)))
+ (combine4 painter)))
+
+(paint (flipped-pairs2 einstein))
+
+;; square-limit in terms of square-of-four
+(define (square-limit2 painter n)
+ (let ((square (square-of-four flip-horiz identity
+ rotate180 flip-vert)))
+ (square (corner-split painter n))))
+
+(paint (square-limit2 einstein 1))
+
+;; ex 2.45
+(define (split op1 op2)
+ (lambda (painter n)
+ (if (= n 0)
+ painter
+ (let ((smaller ((split op1 op2) painter (- n 1))))
+ (op1 painter (op2 smaller smaller))))))
+
+(define usplit (split below beside))
+(define rsplit (split beside below))
+
+;; ex 2.46
+;; A vector running from origin to (x,y) can be represented by a cons cell
+(define (make-vect x y) (cons x y))
+(define (xcor-vect v) (car v))
+(define (ycor-vect v) (cdr v))
+
+;; vector operations
+(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))))
+
+;; ex 2.47
+;; a
+(define (make-frame1 origin edge1 edge2)
+ (list origin edge1 edge2))
+
+(define (origin-frame1 frame)
+ (car frame))
+
+(define (edge1-frame1 frame)
+ (car (cdr frame)))
+
+(define (edge2-frame1 frame)
+ (car (cdr (cdr frame))))
+
+;; b
+(define (make-frame2 origin edge1 edge2)
+ (cons origin (cons edge1 edge2)))
+
+(define (origin-frame2 frame)
+ (car frame))
+
+(define (edge1-frame2 frame)
+ (car (cdr frame)))
+
+(define (edge2-frame2 frame)
+ (cdr (cdr frame)))
+
+;; for now use option a.
+(define origin-frame origin-frame1)
+(define edge1-frame edge1-frame1)
+(define edge2-frame edge2-frame1)
+
+;;; frames
+(define (frame-coord-map frame)
+ (lambda (v)
+ (add-vect (origin-frame frame)
+ (add-vect (scale-vect (xcor-vect v) (edge1-frame frame))
+ (scale-vect (ycor-vect v) (edge2-frame frame))))))
+
+;; ex 2.48
+(define (make-segment v1 v2) (cons v1 v2))
+(define (start-segment segment) (car segment))
+(define (end-segment segment) (cdr segment))
+
+;; ex 2.49
+;; a. The painter that draws the outline of the designated frame.
+(define one 0.99)
+(define zero 0)
+
+(define (outline frame)
+ ((segments->painter (list (make-segment (make-vect zero zero) (make-vect one zero))
+ (make-segment (make-vect one zero) (make-vect one one))
+ (make-segment (make-vect one one) (make-vect zero one))
+ (make-segment (make-vect zero one) (make-vect zero zero))))
+ frame))
+
+;; b. The painter that draws an ``X'' by connecting opposite corners of the frame.
+(define (x-connect frame)
+ ((segments->painter (list (make-segment (make-vect zero zero) (make-vect one one))
+ (make-segment (make-vect zero one) (make-vect one zero))))
+ frame))
+
+;; c. The painter that draws a diamond shape by connecting the midpoints of the
+;; sides of the frame.
+(define (diamond frame)
+ (let ((v1 (make-vect 0.5 0))
+ (v2 (make-vect 0.999 0.5))
+ (v3 (make-vect 0.5 0.999))
+ (v4 (make-vect 0 0.5)))
+ ((segments->painter (list (make-segment v1 v2)
+ (make-segment v2 v3)
+ (make-segment v3 v4)
+ (make-segment v4 v1)))
+ frame)))
+
+;; d. The wave painter.
+(define (waveman frame)
+ (let ((p1 (make-vect 0.25 0))
+ (p2 (make-vect 0.4 0.4))
+ (p3 (make-vect 0.25 0.5))
+ (p4 (make-vect 0.15 0.4))
+ (p5 (make-vect 0 0.7))
+ (p6 (make-vect 0 0.8))
+ (p7 (make-vect 0.15 0.55))
+ (p8 (make-vect 0.25 0.6))
+ (p9 (make-vect 0.4 0.6))
+ (p10 (make-vect 0.35 0.75))
+ (p11 (make-vect 0.4 0.9))
+ (p12 (make-vect 0.6 0.9))
+ (p13 (make-vect 0.65 0.75))
+ (p14 (make-vect 0.6 0.6))
+ (p15 (make-vect 0.8 0.6))
+ (p16 (make-vect 0.999 0.25))
+ (p17 (make-vect 0.999 0.1))
+ (p18 (make-vect 0.6 0.4))
+ (p19 (make-vect 0.75 0))
+ (p20 (make-vect 0.65 0))
+ (p21 (make-vect 0.5 0.2))
+ (p22 (make-vect 0.35 0)))
+ (let ((s1 (make-vect p1 p2))
+ (s2 (make-vect p2 p3))
+ (s3 (make-vect p3 p4))
+ (s4 (make-vect p4 p5))
+ (s5 (make-vect p6 p7))
+ (s6 (make-vect p7 p8))
+ (s7 (make-vect p8 p9))
+ (s8 (make-vect p9 p10))
+ (s9 (make-vect p10 p11))
+ (s10 (make-vect p12 p13))
+ (s11 (make-vect p13 p14))
+ (s12 (make-vect p14 p15))
+ (s13 (make-vect p15 p16))
+ (s14 (make-vect p17 p18))
+ (s15 (make-vect p18 p19))
+ (s16 (make-vect p20 p21))
+ (s17 (make-vect p21 p22)))
+ ((segments->painter (list s1 s2 s3 s4 s5 s6 s7 s8 s9 s10 s11 s12 s13 s14 s15 s16 s17))
+ frame))))
+
+
\ No newline at end of file
projects / sicp.git / commitdiff