; Problem Set 4 Solutions
;   by Michael Allen

; ============
;  Exercise 1
; ============

; 1. Box and pointer diagram for
(make-frame (make-vect .1 .1)
	    (make-vect .9 .2)
	    (make-vect .2 .9))
;   |
;   V
; ---------  ---------  ---------  ---------
; |   |   +->|   |   +->|   |   +->|   | / |
; --|------  --|------  --|------  --|------
;   V          V          V          V
; 'frame     ---------  ---------  ---------
;            |0.1|0.1|  |0.9|0.2|  |0.2|0.9|
;            ---------  ---------  ---------

; 2. A new implementation for the frame abstraction

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

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

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

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

; Nothing else in the code would have to be changed
; because this is a data abstraction.

; 3. It might be useful to include the symbol 'frame
; as part of the representation to make it easier to
; determine if a particular piece of data is meant to
; be a frame or not.

; ============
;  Exercise 2
; ============

(paint g1 (procedure->painter (lambda (x y) (* x y))))
; Solid black field.

(paint g2 (procedure->painter (lambda (x y) (* 255 x y))))
; Shaded hyperbolas with dark in the lower right and white
; in the upper left.

(paint g3 (procedure->painter (lambda (x y) (* 255 x))))
; Shaded from dark on the left to light on the right.

; ============
;  Exercise 3
; ============

; CAPTAIN-ABSTRACTION is a line-drawing of an "A"
(define captain-abstraction
  (let ((v1 (make-vect 0 0))
	(v2 (make-vect .25 .5))
	(v3 (make-vect .5 1))
	(v4 (make-vect .75 .5))
	(v5 (make-vect 1 0)))
    (segments->painter
     (list (make-segment v1 v3)
	   (make-segment v3 v5)
	   (make-segment v2 v4)))))

(paint g1 captain-abstraction)

; ============
;  Exercise 4
; ============

; BELOW places painter1 below painter2
(define (below p1 p2)
  (superpose
   ((transform-painter (make-vect 0 0)
		       (make-vect 1 0)
		       (make-vect 0 .5))
    p1)
   ((transform-painter (make-vect 0 .5)
		       (make-vect 1 .5)
		       (make-vect 0 1))
    p2)))

(paint g2 (below captain-abstraction captain-abstraction))
   
; ============
;  Exercise 5
; ============

; Paint a transformed captain-abstraction
(paint g3 ((transform-painter (make-vect .1 .9)
			      (make-vect 1.5 1)
			      (make-vect .2 0)) captain-abstraction))

; This transformation flips the captain upside down,
; stretches him to the right, and rotates him
; counterclockwise a little bit.

; ============
;  Exercise 6
; ============

; GRAY128 is just a plain gray painter
(define gray128 (number->painter 128))
(paint g1 gray128)

; CIRCLES is a circular shading pattern
(define circles (procedure->painter 
		 (lambda (x y) 
		   (* (+ (square (- x .5))
			 (square (- y .5))) 512))))
(paint g2 circles)

; TRIANGLES draws two triangles on the screen
(define triangles
  (let ((v1 (make-vect .1 .8))
	(v2 (make-vect .1 .1))
	(v3 (make-vect .8 .1))
	(v4 (make-vect .2 .9))
	(v5 (make-vect .9 .9))
	(v6 (make-vect .9 .2)))
    (segments->painter
     (list
      (make-segment v1 v2)
      (make-segment v2 v3)
      (make-segment v3 v1)
      (make-segment v4 v5)
      (make-segment v5 v6)
      (make-segment v6 v4)))))

(paint g3 triangles)


; EINSTEIN is a cool guy
(define einstein (load-painter "einstein"))
; Note: You need the einstein.pgm file for this to work.
; If you don't have it, comment this line out.

(paint g1 einstein)

; ============
;  Exercise 7
; ============

; Some ways to play with the pictures
(paint g2 (beside (below triangles triangles) (below triangles triangles)))
(paint g3 (superpose circles captain-abstraction))

; ============
;  Exercise 8
; ============

; DIAMOND transforms the painter into a diamond pattern
(define (diamond painter)
  ((transform-painter (make-vect 0 .5)
		      (make-vect .5 0)
		      (make-vect .5 1)) painter))
(paint g1 (diamond circles))

; ============
;  Exercise 9
; ============

; NON-SQUARE-DIAMOND creates procedures for making diamonds of various shapes
(define (non-square-diamond y x1 x2)
  (lambda (painter)
    ((transform-painter (make-vect 0 y)
			(make-vect x1 0)
			(make-vect x2 1)) painter)))

(define non-square-diamond1 (non-square-diamond 0.2 0.1 0.9))
(paint g2 (non-square-diamond1 circles))

; Another nifty picture

(define non-square-diamond2 (non-square-diamond 0.8 0.9 0.1))
(paint g3 (superpose (non-square-diamond1 circles) (non-square-diamond2 triangles)))

; =============
;  Exercise 10
; =============

; UP-SPLIT recursively splits the picture upwards
; Analogous to right-split
(define (up-split painter n)
  (if (= n 0)
      painter
      (let ((smaller (up-split painter (- n 1))))
	(below painter (beside smaller smaller)))))

(paint g1 (up-split circles 3))

; =============
;  Exercise 11
; =============

; KEEP-COMBINING is a higher order function for recursively
; applying a combiner to a painter.
(define (keep-combining combine-2)
  (lambda (painter n)
    ((repeated
      (lambda (x) (combine-2 painter x))
      n)
     painter)))

; NEW-RIGHT-SPLIT can be written with KEEP-COMBINING
(define new-right-split
  (keep-combining
   (lambda (p1 p2)
     (beside p1 (below p2 p2)))))

(paint g2 (new-right-split circles 3))

; NEW-UP-SPLIT can also
(define new-up-split
  (keep-combining
   (lambda (p1 p2)
     (below p1 (beside p2 p2)))))

(paint g3 (new-up-split circles 3))

; =============
;  Exercise 12
; =============

; Some pretty recursive pictures made with KEEP-COMBINING

(define crowd
  (keep-combining (lambda (p1 p2)
		    (below (beside p2 p2)
			   (beside p2 p2)))))
(paint g1 (crowd triangles 3))

(define corner
  (keep-combining (lambda (p1 p2)
		    (below p1 (beside p1 p2)))))
(paint g2 (corner circles 3))

; =============
;  Exercise 13
; =============

; There are lots of things you can do for this question.

; THREE lays out the painters in the four quadrants
; with the upper-right quadrant left empty.
(define (three p1 p2 p3)
  (below
   (beside p2 p3)
   ((transform-painter (make-vect 0 0)
		       (make-vect .5 0)
		       (make-vect 0 1)) p1)))

; STAIRS creates a pretty stair pattern using THREE.
(define (stairs p)
  ((keep-combining (lambda (p1 p2) (three p2 p1 p2))) p 3))

(paint g3 (stairs triangles))