;;; File:
;;;   drawing.scm
;;; Author:
;;;   Samuel A. Rebelsky
;;; Version:
;;;   0.4 of 8 February 2007
;;; Summary:
;;;   Some procedures and examples to have fun with drawing.
;;; History:
;;;   At end.

; +----------------------+--------------------------------------------
; | Higher-Order Helpers |
; +----------------------+

;;; Procedure:
;;;   map
;;; Parameters:
;;;   proc, a procedure that takes one parameter and returns one value
;;;   lst, a list of values
;;; Purpose:
;;;   Builds a list by applying proc to each value in lst.
;;; Produces:
;;;   newlst, a list of values.
;;; Preconditions:
;;;   proc can be applied ot each value in lst.
;;; Postconditions:
;;;   (length newlst) = (length lst)
;;;   For each i, 0 <= i < (length lst)
;;;    (list-ref newlst i) = (proc (list-ref lst i ))
(define map
  (lambda (proc lst)
    (if (null? lst) null
        (cons (proc (car lst))
              (map proc (cdr lst))))))

;;; Procedure:
;;;   list-of?
;;; Parameters:
;;;   type?, a predicate
;;;   val, a Scheme value
;;; Purpose:
;;;   Verify that val is a list of values and that type? holds for each
;;;   value in the list.
;;; Produces:
;;;   is-list-of, a Boolean
;;; Postconditions:
;;;   If val is not a list, is-list-of is #f.
;;;   If (type? (list-ref val i)) is #f for some valid i, is-list-of is #f.
;;;   Otherwise, is-list-of is true.
(define list-of?
  (lambda (type? val)
    (or (null? val)
        (and (pair? val)
             (type? (car val))
             (list-of? type? (cdr val))))))

(define left-section
  (lambda (binproc left)
    (lambda (right)
      (binproc left right))))
(define l-s left-section)

(define right-section
  (lambda (binproc right)
    (lambda (left)
      (binproc left right))))
(define r-s right-section)

(define compose
  (letrec ((kernel (lambda (procs val)
                     (if (null? procs) val
                         ((car procs) (kernel (cdr procs) val))))))
    (lambda procs
      (lambda (val)
        (kernel procs val)))))

; +--------+----------------------------------------------------------
; | Points |
; +--------+

;;; Procedure:
;;;   point
;;; Parameters:
;;;   x, a real number
;;;   y, a real number
;;; Purpose:
;;;   Build the point (x,y)
;;; Produces:
;;;   pt, a point
;;; Postconditions:
;;;   (xcoord pt) = x
;;;   (ycoord pt) = y
(define point cons)

;;; Procedure:
;;;   xcoord
;;; Parameters:
;;;   pt, a point
;;; Purpose:
;;;   Extracts the x coordinate of a point.
;;; Produces:
;;;   x, a real number
;;; Preconditions:
;;;   pt was created with point.
;;; Postconditions:
;;;   (xcoord (point x y)) = x
(define xcoord car)

;;; Procedure:
;;;   ycoord
;;; Parameters:
;;;   pt, a point
;;; Purpose:
;;;   Extracts the y coordinate of a point.
;;; Produces:
;;;   y, a real number
;;; Preconditions:
;;;   pt was created with point.
;;; Postconditions:
;;;   (ycoord (point x y)) = y
(define ycoord cdr)

;;; Procedure:
;;;   point?
;;; Parameters:
;;;   val, a Scheme value
;;; Purpose:
;;;   Determine if val is a point, using our current representation.
;;; Produces:
;;;   is-point, a Boolean
;;; Postconditions:
;;;   If val seems to have been produced with point, then is-point is
;;;     true.
;;;   Otherwise, is-point is false.
(define point?
  (lambda (val)
    (and (pair? val)
         (real? (car val))
         (real? (cdr val)))))

;;; Procedure:
;;;   list-of-points?
;;; Parameters:
;;;   val, a Scheme value
;;; Purpose:
;;;   Determine if val is a list of points.
;;; Produces:
;;;   ok, a Boolean
(define list-of-points? (left-section list-of? point?))

;;; Procedure:
;;;   drawing?
;;; Parameters:
;;;   val, a Scheme value
;;; Purpose:
;;;   Determine if val is a drawing.
;;; Produces:
;;;   is-drawing, a Boolean
(define drawing? (left-section list-of? list-of-points?))

; +---------+---------------------------------------------------------
; | Drawing |
; +---------+

;;; Procedure:
;;;   draw
;;; Parameters:
;;;   image, an image
;;;   drawing, a drawing
;;; Purpose:
;;;   Draws the drawing.
;;; Produces:
;;;   (nothing)
;;; Preconditions:
;;;   (none)
;;; Postconditions:
;;;   The drawing has been done in the current brush and color
(define draw
  (lambda (image drawing)
    (if (not (null? drawing))
        (begin
          (connect-the-dots image (car drawing))
          (draw image (cdr drawing))))))

;;; Procedure:
;;;   spiral
;;; Parameters:
;;;   n, the number of points to draw in the spiral (90  points are needed
;;;   for one loop).
;;; Purpose:
;;;   Generate a list of points for a spiral
;;; Produces:
;;;   spiral, a list of points
(define spiral
  (let ((scale (/ 3.14 45)))
    (lambda (n)
      (if (<= n 0)
          null
          (cons (point (* n (sin (* scale n)))
                       (* n (cos (* scale n))))
                (spiral (- n 1)))))))

;;; Procedure:
;;;   zig-zag
;;; Parameters:
;;;   n, the number of lines in the zig zag (at least 2)
;;; Purpose:
;;;   Generate a series of lines for an "interesting" zig-zag figure of
;;;   width approximately (20 + 2n) and height approximately 2n.
;;; Produces:
;;;   zig-zag-points, a list of points
(define zig-zag
  (lambda (n)
    (if (<= n 0)
        null
        (cons (point (if (even? n) (- 20 n) (+ 20 n))
                     (* 4 n))
              (zig-zag (- n 1))))))


; +-----------------------+-------------------------------------------
; | Image Transformations |
; +-----------------------+

;;; Procedure:
;;;   hscale
;;; Parameters:
;;;   amt, a real
;;;   pt, a point
;;; Purpose:
;;;   "Scales" the horizontal component of the point by the specified.
;;; Produces:
;;;   scaled, a point
;;; Postconditions:
;;;   (xcoord scaled) = (* (xcoord pt) amt)
;;;   (ycoord scaled) = (ycoord pt) 
(define hscale
  (lambda (amt pt)
    (point (* (xcoord pt) amt) (ycoord pt))))

;;; Procedure:
;;;   hscale-points 
;;; Parameters:
;;;   amt, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Horizontally scales the points by the specified amount.
;;; Produces:
;;;   scaled , a list of points
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref scaled i) = 
;;;       (hscale delta-x delta-y (list-ref points i))
(define hscale-points
  (lambda (amt points)
    (map (left-section hscale amt) points)))

;;; Procedure:
;;;   hscale-drawing
;;; Parameters:
;;;   amt, a real
;;;   drawing, a drawing (a list of lists of points)
;;; Purpose:
;;;   Horizontally scale the drawing by the specified amount.
;;; Produces:
;;;   scaled, a scaled version of the drawing
(define hscale-drawing
  (lambda (amt drawing)
    (map (left-section hscale-points amt) drawing)))

;;; Procedure:
;;;   htrans
;;; Parameters:
;;;   amt, a real number
;;;   pt, a point
;;; Purpose:
;;;   Translate pt horizontally by amt.
;;; Produces:
;;;   translated, a point
;;; Postconditions:
;;;   (xcoord translated) = (+ amt (xcoord pt))
;;;   (ycoord translated) = (ycoord translated)
(define htrans
  (lambda (amt pt)
    (point (+ amt (xcoord pt)) (ycoord pt))))

;;; Procedure:
;;;   htrans-points
;;; Parameters:
;;;   amt, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Translate all of the points horizontally by amt.
;;; Produces:
;;;   translated, a point.
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref translated i) = 
;;;       (htrans amt (list-ref points i))
(define htrans-points
  (lambda (amt points)
    (map (left-section htrans amt) points)))

;;; Procedure:
;;;   htrans-drawing
;;; Parameters:
;;;   amt, a real number
;;;   drawing, a list of lists of points
;;; Purpose:
;;;   Translate the drawing horizontally by amt.
;;; Produces:
;;;   translated, a drawing.
(define htrans-drawing
  (lambda (amt drawing)
    (map (left-section htrans-points amt) drawing)))

;;; Procedure:
;;;   scale
;;; Parameters:
;;;   amt, a real
;;;   pt, a point
;;; Purpose:
;;;   "Scales" the point by the specified amount.  Think of a point as
;;;   representing a vector from the origin to the point; that vector
;;;   has been scaled.
;;; Produces:
;;;   scaled, a point
;;; Postconditions:
;;;   (xcoord scaled) = (* (xcoord pt) amt)
;;;   (ycoord scaled) = (* (ycoord pt) amt)
(define scale
  (lambda (amt pt)
    (point (* (xcoord pt) amt) (* (ycoord pt) amt))))

;;; Procedure:
;;;   scale-points 
;;; Parameters:
;;;   amt, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Scale all of the points by the specified amount.
;;; Produces:
;;;   scaled , a list of points
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref scaled i) = (scale delta-x delta-y (list-ref points i))
(define scale-points
  (lambda (amt points)
    (map (left-section scale amt) points)))

;;; Procedure:
;;;   scale-drawing
;;; Parameters:
;;;   amt, a real
;;;   drawing, a drawing (a list of lists of points)
;;; Purpose:
;;;   Scale the drawing by the specified amount.
;;; Produces:
;;;   scaled, a scaled version of the drawing
(define scale-drawing
  (lambda (amt drawing)
    (map (left-section scale-points amt) drawing)))

;;; Procedure:
;;;   vary
;;; Parameters:
;;;   amt, the amount of variance
;;;   pt, a point
;;; Purpose:
;;;   Vary the x and y coordinate of pt by a random amount.
;;; Produces:
;;;   varied, a point
;;; Postconditions:
;;;   (<= (- (xcoord pt) amt) (xcoord varied) (+ (xcoord pt) amt))
;;;   (<= (- (ycoord pt) amt) (ycoord varied) (+ (ycoord pt) amt))
;;;   Each point that meets those requirements is equally likely.
(define vary
  (lambda (amt pt)
    (point (+ (- (xcoord pt) amt) (random (+ 1 (* 2 amt))))
           (+ (- (ycoord pt) amt) (random (+ 1 (* 2 amt)))))))

;;; Procedure:
;;;   vary-points
;;; Parameters:
;;;   amt, the amount of variance
;;;   points, a list of points
;;; Purpose:
;;;   Vary each point
;;; Produces:
;;;   varied, a sequence of points.
(define vary-points
  (lambda (amt points)
    (map (left-section vary amt) points)))

;;; Procedure:
;;;   vary-drawing
;;; Parameters:
;;;   amt, an integer
;;;   drawing, a drawing (a list of lists of points)
;;; Purpose:
;;;   Vary the drawing by the specified amount.
;;; Produces:
;;;   varied, a randomly modified version of the drawing.
(define vary-drawing
  (lambda (amt drawing)
    (map (left-section vary-points amt) drawing)))

;;; Procedure:
;;;   vscale
;;; Parameters:
;;;   amt, a real
;;;   pt, a point
;;; Purpose:
;;;   "Scales" the vertical component of the point by the specified.
;;; Produces:
;;;   scaled, a point
;;; Postconditions:
;;;   (xcoord scaled) = (xcoord pt) 
;;;   (ycoord scaled) = (* (ycoord pt) amt)
(define vscale
  (lambda (amt pt)
    (point (xcoord pt) (* (ycoord pt) amt) )))

;;; Procedure:
;;;   vscale-points 
;;; Parameters:
;;;   amt, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Vertically scales the points by the specified amount.
;;; Produces:
;;;   scaled , a list of points
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref scaled i) = 
;;;       (vscale delta-x delta-y (list-ref points i))
(define vscale-points
  (lambda (amt points)
    (map (left-section vscale amt) points)))

;;; Procedure:
;;;   vscale-drawing
;;; Parameters:
;;;   amt, a real
;;;   drawing, a drawing (a list of lists of points)
;;; Purpose:
;;;   Vertically scale the drawing by the specified amount.
;;; Produces:
;;;   scaled, a scaled version of the drawing
(define vscale-drawing
  (lambda (amt drawing)
    (map (left-section vscale-points amt) drawing)))

;;; Procedure:
;;;   vtrans
;;; Parameters:
;;;   amt, a real number
;;;   pt, a point
;;; Purpose:
;;;   Translate pt vertically by amt.
;;; Produces:
;;;   translated, a point
;;; Postconditions:
;;;   (xcoord translated) = (xcoord translated)
;;;   (ycoord translated) = (+ amt (ycoord pt))
(define vtrans
  (lambda (amt pt)
    (point (xcoord pt) (+ amt (ycoord pt)))))

;;; Procedure:
;;;   vtrans-points
;;; Parameters:
;;;   amt, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Translate all of the points vertically by amt.
;;; Produces:
;;;   translated, a point.
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref translated i) = 
;;;       (vtrans amt (list-ref points i))
(define vtrans-points
  (lambda (amt points)
    (map (left-section vtrans amt) points)))

;;; Procedure:
;;;   vtrans-drawing
;;; Parameters:
;;;   amt, a real number
;;;   drawing, a list of lists of points
;;; Purpose:
;;;   Translate the drawing vertically by amt.
;;; Produces:
;;;   translated, a drawing.
(define vtrans-drawing
  (lambda (amt drawing)
    (map (left-section vtrans-points amt) drawing)))


; +----------+--------------------------------------------------------
; | Examples |
; +----------+

(define tree (list (point 15 30) (point 18 14) (point 5 18) (point 8 8) (point 20 0) (point 30 2) (point 35 19) (point 23 16) (point 23 30)))


; +------------+------------------------------------------------------
; | Deprecated |
; +------------+

;;; Procedure:
;;;   translate
;;; Parameters:
;;;   delta-x, an integer
;;;   delta-y, an integer
;;;   pt, a point
;;; Purpose:
;;;   Translates the point by the specified amount.
;;; Produces:
;;;   translated, a point
;;; Postconditions:
;;;   (xcoord translated) = (+ (xcoord pt) delta-x)
;;;   (ycoord translated) = (+ (ycoord pt) delta-y)
(define translate
  (lambda (delta-x delta-y pt)
    (point (+ (xcoord pt) delta-x) (+ (ycoord pt) delta-y))))

;;; Procedure:
;;;   translate-points
;;; Parameters:
;;;   delta-x, a real number
;;;   delta-y, a real number
;;;   points, a list of points
;;; Purpose:
;;;   Translate all of the points by the specified amount.
;;; Produces:
;;;   translated, a list of points
;;; Postconditions:
;;;   For each i, 0 <= i < (length  points)
;;;     (list-ref translated i) = 
;;;       (translate delta-x delta-y (list-ref points i))
(define translate-points
  (lambda (delta-x delta-y points)
    (map (lambda (pt) (translate delta-x delta-y pt)) points)))

;;; Procedure:
;;;   translate-drawing
;;; Parameters:
;;;   delta-x, a real
;;;   delta-y, a real
;;;   drawing, a drawing (a list of lists of points)
;;; Purpose:
;;;   Translate the drawing by the specified amount.
;;; Produces:
;;;   translated, a translated version of the drawing
(define translate-drawing
  (lambda (delta-x delta-y drawing)
    (if (null? drawing) null
        (cons (translate-points delta-x delta-y (car drawing))
              (translate delta-x delta-y (cdr drawing))))))

; +---------+---------------------------------------------------------
; | History |
; +---------+

; Monday, 30 October 2006 (v 0.1) [Samuel A. Rebelsky]
; * Created.

; Tuesday, 31 October 2006 (v 0.2) [Samuel A. Rebelsky]
; * Added type predicates.
; * Revised examples somewhat.
; * Added list-of?
; * Added zig-zag and spiral.
; * Rearranged code slightly.

; Tuesday, 31 October 2006 (v 0.3) [Samuel A. Rebelsky]
; * Changed the form of the various scale procedures to take only 
;   one parameter.
; * Add hscale and vscale (and variants).
; * Added htrans and vtrans (and variants).

; Thusday, 8 February 2007 (v 0.4) [Samuel A. Rebelsky]
; * Renamed lots of procedures.