sicp-2.2.4

#lang racket
(require (planet "sicp.ss" ("soegaard" "sicp.plt" 2 1)))

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

(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 (make-vect x y)
   (cons x y))

(define (xcor-vect v)
   (car v))

(define (ycor-vect v)
   (cdr v))

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

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

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

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

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
  (cadr frame))

(define (edge2-frame frame)
  (caddr frame))

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

(define (origin-frame frame)
  (car frame))

(define (edge1-frame frame)
  (cadr frame))

(define (edge2-frame frame)
  (cddr frame))

(define (make-segment u v)
  (cons u v))

(define (start-segment segment)
  (car segment))

(define (end-segment segment)
  (cdr segment))

(define (draw-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)))
    frame)))

(define (draw-X frame)
  ((segments->painter
    (list (make-segment (make-vect 0 0)
                        (make-vect 1 1))
          (make-segment (make-vect 1 0)
                        (make-vect 0 1))))
   frame))

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

(define (flip-horiz painter)
  (transform-painter painter
                     (make-vect 1 0)
                     (make-vect 0 0)
                     (make-vect 1 1)))

(define (rotate180 painter)
  (transform-painter painter
                     (make-vect 1 1)
                     (make-vect 0 1)
                     (make-vect 1 0)))

(define (rotate270 painter)
  (transform-painter painter
                     (make-vect 0 1)
                     (make-vect 0 0)
                     (make-vect 1 1)))

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