SICP/ex-2_44-52.scm

(display "\nex-2.44 - a picture language\n")

; One solution for 2.51
(define (below painter1 painter2)
  (let ((paint-top
         (transform-painter painter2
                            (make-vect 0.0 0.5)
                            (make-vect 1.0 0.5)
                            (make-vect 0.0 1.0)))
        (paint-bottom
         (transform-painter painter1
                            (make-vect 0.0 0.0)
                            (make-vect 1.0 0.0)
                            (make-vect 0.0 0.5))))
    (lambda (frame)
      (lambda (draw-line)
        ((paint-top frame) draw-line)
        ((paint-bottom frame) draw-line)))))

(define (beside painter1 painter2)
  (let ((split-point (make-vect 0.5 0.0)))
    (let ((paint-left
           (transform-painter painter1
                              (make-vect 0.0 0.0)
                              split-point
                              (make-vect 0.0 1.0)))
          (paint-right
           (transform-painter painter2
                              split-point
                              (make-vect 1.0 0.0)
                              (make-vect 0.5 1.0))))
      (lambda (frame)
        (lambda (draw-line)
          ((paint-left frame) draw-line)
          ((paint-right frame) draw-line))))))



(define (right-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (right-split painter (- n 1))))
        (beside painter (below smaller smaller)))))

(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))))))

(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
        (below painter (beside smaller smaller)))))


(display "\nex-2.45\n")

(define (split main-placer smaller-placer)
  (define (rec painter n)
    (if (= n 0)
      painter
      (let ((smaller (rec painter (- n 1))))
        (main-placer painter (smaller-placer smaller smaller)))))
  rec)

(define right-split (split beside below))
(define up-split (split below beside))

(display "\nex-2.46\n")

(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))))))

(define make-vect cons)
(define xcor-vect car)
(define ycor-vect cdr)

(define (add-vect v w)
  (make-vect (+ (xcor-vect v) (xcor-vect w))
             (+ (ycor-vect v) (ycor-vect w))))

(define (sub-vect v w)
  (make-vect (- (xcor-vect v) (xcor-vect w))
             (- (ycor-vect v) (ycor-vect w))))

(define (scale-vect s v)
  (make-vect (* s (xcor-vect v)) (* s (ycor-vect v))))

(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))))))

(display "\nex-2.47\n")

(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))

(define origin-frame car)
(define edge1-frame cadr)
(define edge2-frame caddr)

(define (make-frame origin edge1 edge2)
  (cons origin (cons edge1 edge2)))

(define origin-frame car)
(define edge1-frame cadr)
(define edge2-frame cddr)

(display "\nex-2.48\n")

(define (segments->painter segment-list)
  (lambda (frame)
    (lambda (draw-line)
      (for-each
       (lambda (segment)
         (draw-line
          ((frame-coord-map frame) (start-segment segment))
          ((frame-coord-map frame) (end-segment segment))))
       segment-list))))

(define make-segment list)
(define start-segment car)
(define end-segment cadr)

(display "\nex-2.49\n")

(define simple-frame (make-frame (make-vect 0  1080)
                                 (make-vect 1920 0)
                                 (make-vect 0  -1080)))

(define (make-line x1 y1 x2 y2)
  (make-segment (make-vect x1 y1) (make-vect x2 y2)))

(define painter-outline
  (segments->painter
    (list (make-line 0 0 0 1)
          (make-line 0 0 1 0)
          (make-line 1 0 1 1)
          (make-line 0 1 1 1))))

(define painter-x
  (segments->painter
    (list (make-line 0 0 1 1)
          (make-line 0 1 1 0))))

(define painter-diamond
  (segments->painter
    (list (make-line 0.5 0 0 0.5)
          (make-line 0.5 0 1 0.5)
          (make-line 0 0.5 0.5 1)
          (make-line 1 0.5 0.5 1))))

; from here: http://wiki.drewhess.com/wiki/SICP_exercise_2.49
(define painter-wave
  (segments->painter
    (list (make-line 0.4 0 0.5 0.33)
          (make-line 0.5 0.33 0.6 0.0)
          (make-line 0.25 0.0 0.33 0.5)
          (make-line 0.33 0.5 0.3 0.6)
          (make-line 0.3 0.6 0.1 0.4)
          (make-line 0.1 0.4 0.0 0.6)
          (make-line 0.0 0.6 0.0 0.8)
          (make-line 0.0 0.8 0.1 0.6)
          (make-line 0.1 0.6 0.33 0.65)
          (make-line 0.33 0.65 0.4 0.65)
          (make-line 0.4 0.65 0.35 0.8)
          (make-line 0.35 0.8 0.4 1.0)
          (make-line 0.4 1.0 0.6 1.0)
          (make-line 0.75 0.0 0.6 0.45)
          (make-line 0.6 0.45 1.0 0.15)
          (make-line 1.0 0.15 1.0 0.35)
          (make-line 1.0 0.35 0.8 0.65)
          (make-line 0.8 0.65 0.6 0.65)
          (make-line 0.6 0.65 0.65 0.8)
          (make-line 0.65 0.8 0.6 1.0))))

(load "shared/lib-draw.scm")

(draw-to-py (painter-diamond simple-frame) "draw-wave")

(display "\nex-2.50\n")

(define (transform-painter painter origin corner1 corner2)
  (lambda (frame)
    (let ((m (frame-coord-map frame)))
      (let ((new-origin (m origin)))
        (painter
         (make-frame new-origin
                     (sub-vect (m corner1) new-origin)
                     (sub-vect (m corner2) new-origin)))))))

(define (flip-vert painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)   ; new origin
                     (make-vect 1.0 1.0)   ; new end of edge1
                     (make-vect 0.0 0.0))) ; new end of edge2

(draw-to-py ((flip-vert painter-wave) simple-frame) "draw-wave-flipped")

(define (shrink-to-upper-right painter)
  (transform-painter painter
                     (make-vect 0.5 0.5)
                     (make-vect 1.0 0.5)
                     (make-vect 0.5 1.0)))

(draw-to-py ((shrink-to-upper-right painter-wave) simple-frame) "draw-wave-shrinked")

(define (rotate90 painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 0.0)))

(draw-to-py ((rotate90 painter-wave) simple-frame) "draw-wave-rotated")

(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1.0 0.0)   ; new origin
                     (make-vect 0.0 0.0)   ; new end of edge1
                     (make-vect 1.0 1.0))) ; new end of edge2

(define (rotate180 painter)
  (transform-painter painter
                     (make-vect 1.0 1.0)
                     (make-vect 0.0 1.0)
                     (make-vect 1.0 0.0)))

; both works of course
(define (rotate270 painter)
  (rotate90 (rotate90 (rotate90 painter))))

(define (rotate270 painter)
  (transform-painter painter
                     (make-vect 0.0 1.0)
                     (make-vect 0.0 0.0)
                     (make-vect 1.0 1.0)))

(draw-to-py ((beside painter-wave painter-diamond) simple-frame) "draw-wave-beside-diamond")

(display "\nex-2.51\n")

; First implementation is at the beginning of this file.
(draw-to-py ((below painter-x painter-diamond) simple-frame) "draw-x-below-diamond-1")

(define (below painter1 painter2)
  (rotate270 (beside (rotate90 painter2) (rotate90 painter1))))

(draw-to-py ((below painter-x painter-diamond) simple-frame) "draw-x-below-diamond-2")


(display "\nex-2.52\n")

; a.
(define painter-wave-smile
  (segments->painter
    (list (make-line 0.4 0 0.5 0.33)
          (make-line 0.5 0.33 0.6 0.0)
          (make-line 0.25 0.0 0.33 0.5)
          (make-line 0.33 0.5 0.3 0.6)
          (make-line 0.3 0.6 0.1 0.4)
          (make-line 0.1 0.4 0.0 0.6)
          (make-line 0.0 0.6 0.0 0.8)
          (make-line 0.0 0.8 0.1 0.6)
          (make-line 0.1 0.6 0.33 0.65)
          (make-line 0.33 0.65 0.4 0.65)
          (make-line 0.4 0.65 0.35 0.8)
          (make-line 0.43 0.87 0.46 0.87) ; left eye
          (make-line 0.54 0.87 0.57 0.87) ; right eye
          (make-line 0.45 0.75 0.55 0.75) ; smile
          (make-line 0.35 0.8 0.4 1.0)
          (make-line 0.4 1.0 0.6 1.0)
          (make-line 0.75 0.0 0.6 0.45)
          (make-line 0.6 0.45 1.0 0.15)
          (make-line 1.0 0.15 1.0 0.35)
          (make-line 1.0 0.35 0.8 0.65)
          (make-line 0.8 0.65 0.6 0.65)
          (make-line 0.6 0.65 0.65 0.8)
          (make-line 0.65 0.8 0.6 1.0))))

(draw-to-py (painter-wave-smile simple-frame) "draw-wave-smile")

; b.
(define (corner-split-adapted 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-adapted painter (- n 1))))
          (beside (below painter top-left)
                  (below bottom-right corner))))))

(draw-to-py ((corner-split-adapted painter-wave 3) simple-frame) "draw-corner-split-3")

; c. didn't do anything here
(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))))