;; CS61A project 2 -- picture language
;; Benjamin Wu
;; cs61a-fq
;; Section 118

;--CONSTRUCTORS-----------------------------------------------------------
(define (make-vect x y)
  (cons x y))
  
(define (make-frame origin edge1 edge2)
  (list origin edge1 edge2))
  
;(define (make-frame origin edge1 edge2)
;  (cons (origin (cons edge1 edge2))))

(define (make-segment x1 y1 x2 y2)
  (cons (make-vect x1 y1)
	(make-vect x2 y2)))
	
;--SELECTORS--------------------------------------------------------------
(define (xcor-vect vect)
  (car vect))

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

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

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

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

; the selectors for the alternate frame constructor would be the same,
; with the exception of edge2-frame

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

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

(define (end-segment seg)
  (cdr seg))
  
;--VECTOR MATH PROCEDURES--------------------------------------------------
(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 c v)
  (make-vect (* c (xcor-vect v))
	     (* c (ycor-vect v))))
	    
;--PAINTERS-----------------------------------------------------------------
(define (outline-painter frame)
  ((segments->painter (list
		       (make-segment 0 0 0 1)
		       (make-segment 0 1 1 1)
		       (make-segment 1 1 1 0)
		       (make-segment 1 0 0 0))) frame))

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

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

(define (grid-painter frame)
  ((segments->painter (list
		       (make-segment 0.0000 0 0.0000 1) (make-segment 0 0.0000 1 0.0000)
		       (make-segment 0.0625 0 0.0625 1) (make-segment 0 0.0625 1 0.0625)
		       (make-segment 0.1250 0 0.125  1) (make-segment 0 0.1250 1 0.1250)
		       (make-segment 0.1875 0 0.1875 1) (make-segment 0 0.1875 1 0.1875)
		       (make-segment 0.2500 0 0.2500 1) (make-segment 0 0.2500 1 0.2500)
		       (make-segment 0.3125 0 0.3125 1) (make-segment 0 0.3125 1 0.3125)
		       (make-segment 0.3750 0 0.3750 1) (make-segment 0 0.3750 1 0.3750)
		       (make-segment 0.4375 0 0.4375 1) (make-segment 0 0.4375 1 0.4375)
		       (make-segment 0.5000 0 0.5000 1) (make-segment 0 0.5000 1 0.5000)
		       (make-segment 0.5625 0 0.5625 1) (make-segment 0 0.5625 1 0.5625)
		       (make-segment 0.6250 0 0.6250 1) (make-segment 0 0.6250 1 0.6250)
		       (make-segment 0.6875 0 0.6875 1) (make-segment 0 0.6875 1 0.6875)
		       (make-segment 0.7500 0 0.7500 1) (make-segment 0 0.7500 1 0.7500)
		       (make-segment 0.8125 0 0.8125 1) (make-segment 0 0.8125 1 0.8125)
		       (make-segment 0.8750 0 0.8750 1) (make-segment 0 0.8750 1 0.8750)
		       (make-segment 0.9375 0 0.9375 1) (make-segment 0 0.9375 1 0.9375)
		       (make-segment 1.0000 0 1.0000 1) (make-segment 0 1.0000 1 1.0000))) frame))		       

(define (wave-painter frame)
  ((segments->painter (list
		       ;head
		       (make-segment 0.4375 1 0.375 0.875)
		       (make-segment 0.375 0.875 0.4375 0.75)
		       (make-segment 0.5625 1 0.625 0.875)
		       (make-segment 0.625 0.875 0.5625 0.75)
		       ;left arm/shoulder
		       (make-segment 0.3125 0.75 0.4375 0.75)
		       (make-segment 0.3125 0.75 0.25 0.625)
		       (make-segment 0.25 0.625 0 0.875)
		       (make-segment 0 0.75 0.25 0.5)
		       (make-segment 0.25 0.5 0.3125 0.625)
		       ;right arm/shoulder
		       (make-segment 0.5625 0.75 0.6875 0.75)
		       (make-segment 0.6875 0.75 1 0.375)
		       (make-segment 1 0.25 0.6875 0.625)
		       ;left torso/leg
		       (make-segment 0.3125 0.625 0.375 0.5)
		       (make-segment 0.375 0.5 0.25 0)
		       (make-segment 0.375 0 0.5 0.5)
		       ;right torso/leg
		       (make-segment 0.5 0.5 0.625 0)
		       (make-segment 0.75 0 0.625 0.5)
		       (make-segment 0.625 0.5 0.6875 0.625))) frame))

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

;-- split
(define (split loc1 loc2)
  (lambda (painter n)
    (if (= n 0)
	painter
	(let ((smaller ((split loc1 loc2) painter (- n 1))))
	  (loc1 painter (loc2 smaller smaller))))))
	  
;--PAINTER TRANSFORMERS------------------------------------------------------
(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)
  (let ((split-point (make-vect 0 0.5)))
    (let ((paint-bottom
	   (transform-painter painter1
			      (make-vect 0 0)
			      (make-vect 1 0)
			      split-point))
	  (paint-top
	   (transform-painter painter2
			      split-point
			      (make-vect 1 0.5)
			      (make-vect 0 1))))
      (lambda (frame)
	(paint-bottom frame)
	(paint-top frame)))))

(define (below2 painter1 painter2)
   (rotate90 (beside (rotate270 painter1) (rotate270 painter2))))
   
;--MODIFIED PROCEDURES (2.52)--------------------------------------------------
(define (wave-painter2 frame)
  ;adds a smile
  ((segments->painter (list
		       ;head
		       (make-segment 0.4375 1 0.375 0.875)
		       (make-segment 0.375 0.875 0.4375 0.75)
		       (make-segment 0.5625 1 0.625 0.875)
		       (make-segment 0.625 0.875 0.5625 0.75)
		       ;left arm/shoulder
		       (make-segment 0.3125 0.75 0.4375 0.75)
		       (make-segment 0.3125 0.75 0.25 0.625)
		       (make-segment 0.25 0.625 0 0.875)
		       (make-segment 0 0.75 0.25 0.5)
		       (make-segment 0.25 0.5 0.3125 0.625)
		       ;right arm/shoulder
		       (make-segment 0.5625 0.75 0.6875 0.75)
		       (make-segment 0.6875 0.75 1 0.375)
		       (make-segment 1 0.25 0.6875 0.625)
		       ;left torso/leg
		       (make-segment 0.3125 0.625 0.375 0.5)
		       (make-segment 0.375 0.5 0.25 0)
		       (make-segment 0.375 0 0.5 0.5)
		       ;right torso/leg
		       (make-segment 0.5 0.5 0.625 0)
		       (make-segment 0.75 0 0.625 0.5)
		       (make-segment 0.625 0.5 0.6875 0.625)
		       ;smile
		       (make-segment 0.4375 0.84375 0.46875 0.8125)
		       (make-segment 0.46875 0.8125 0.53125 0.8125)
		       (make-segment 0.53125 0.8125 0.5625 0.84375))) frame))
		       
(define (corner-split2 painter n)
  ;uses one copy of up-split/right-split instead of two
  (if (= n 0)
      painter
      (let ((up (up-split painter (- n 1)))
	    (right (right-split painter (- n 1))))
	(let ((corner (corner-split painter (- n 1))))
	  (beside (below painter up)
		  (below right corner))))))
		  
(define (square-limit2 painter n)
  ;flips each subimage horizontally
  (let ((combine4 (square-of-four flip-horiz identity rotate180 flip-vert)))
    (combine4 (corner-split (flip-horiz painter) n))))

;--the rest of this isn't my code----------------------------------------------
		       

(define (flipped-pairs painter)
  (let ((painter2 (beside painter (flip-vert painter))))
    (below painter2 painter2)))

(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 (square-limit painter n)
  (let ((quarter (corner-split painter n)))
    (let ((half (beside (flip-horiz quarter) quarter)))
      (below (flip-vert half) half))))

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

(define (flipped-pairs painter)
  (let ((combine4 (square-of-four identity flip-vert
				  identity flip-vert)))
    (combine4 painter)))

;; or

; (define flipped-pairs
;   (square-of-four identity flip-vert identity flip-vert))

(define (square-limit painter n)
  (let ((combine4 (square-of-four flip-horiz identity
				  rotate180 flip-vert)))
    (combine4 (corner-split painter 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 (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)))

(define (draw-line v1 v2)
  (penup)
  (setxy (- (* (xcor-vect v1) 200) 100)
	 (- (* (ycor-vect v1) 200) 100))
  (pendown)
  (setxy (- (* (xcor-vect v2) 200) 100)
	 (- (* (ycor-vect v2) 200) 100)))

(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)
		     (make-vect 1.0 1.0)
		     (make-vect 0.0 0.0)))

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

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

(define (squash-inwards painter)
  (transform-painter painter
		     (make-vect 0.0 0.0)
		     (make-vect 0.65 0.35)
		     (make-vect 0.35 0.65)))

(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)
	(paint-left frame)
	(paint-right frame)))))

(define full-frame (make-frame (make-vect -0.5 -0.5)
			       (make-vect 2 0)
			       (make-vect 0 2)))