#lang scheme/gui
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lee-turtles.ss
;; Lee Spector, lspector@hampshire.edu, 20091026
;; 
;; This file implements a small turtle graphics system that was designed to 
;; support exercises in list manipulation. It includes an evaluation function
;; called do-turtles that takes a list of turtle graphics calls and evaluates
;; each of them, producing a drawing in the graphics window. This makes it 
;; convenient to write procedures that manipulate lists of calls to produce
;; more complex lists of calls that can then be passed to do-turtle to create
;; the drawing.
;;
;; After the core definitions (first of the graphics window basics, and then
;; of the turtle graphics code) are some examples of fractal turtle graphics
;; procedures that DO NOT use the technique of producing lists of calls and then
;; passing them to do-turtle -- rather, they draw directly to the window as side
;; effects of their execution. This demonstrates the power of turtle graphics
;; and serves as the basis for exercise #15.
;;
;; After the list of examples is a list of suggested exercises involving list
;; manipulation and do-turtle.
;;
;; User procedures:
;; Graphic window basics:
;;   (show-window) -- shows the window
;;   (clear) -- clears the drawing
;; Turtle graphics calls:
;;   (init-turtle) -- initializes the turtle's position, orientation, etc.
;;   (forward distance) -- moves forward, drawing if the pen is down
;;   (back distance) -- moves back, drawing if the pen is down
;;   (right degrees) -- rotates the turtle right
;;   (left degrees) -- rotates the turtle left
;;   (penup) -- lifts the pen, so it won't draw
;;   (pendown) -- lowers the pen, so it will draw
;;   (setxy x y) -- moves the turtle to location x, y
;;   (setpc r g b a) -- set pen color; 1st 3 args are 0-255 while 4th is 0.0-1.0
;;   (setw w) -- set pen line width
;;   (do-turtle calls) -- execute a list of turtle graphics calls
;; Examples:
;;   (tree trunk-length) -- draws a fractal tree
;;   (fern size) -- draws a fractal fern
;;   (color-frond) -- draws a colorful fractal plant-like design

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; graphic window basics, cribbed from better-draw.ss

(define width 500)
(define height 500)

(define frame (new frame% (label "Drawing Window")
                   (width width)
                   (height height)))

(define bm (make-object bitmap% width height))

(define canvas
  (new canvas% (parent frame)
       (paint-callback (lambda (canvas dc)
                         (send dc draw-bitmap bm 0 0)))))

(define dc (make-object bitmap-dc% bm))
(send dc clear)
(send dc set-pen (make-object pen% "BLACK" 1 'transparent)) ;; No pen
(send dc set-smoothing 'smoothed)

(define show-window
  (lambda ()
    (send frame show #t)))

(define line
  (lambda (x1 y1 x2 y2 width r g b a)
    (let ((pen (make-object pen% "BLACK" width 'solid)))
      (send pen set-color r g b)
      (send dc set-pen pen)
      (send dc set-alpha a)
      (send dc draw-line x1 y1 x2 y2)
      (send canvas refresh))
    (send dc set-pen (make-object pen% "BLACK" 1 'transparent))))

(define clear
  (lambda ()
    (send dc set-brush (make-object brush% (make-object color% 255 255 255) 'opaque))
    (send dc set-alpha 1.0)
    (send dc draw-rectangle 0 0 width height)
    (send canvas refresh)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; turtle graphics code

(define x-position (/ width 2))
(define y-position (- height 50))
(define angle -90)
(define pen-down #t)
(define line-width 1)
(define red 0)
(define green 0)
(define blue 0)
(define alpha 1.0)

(define init-turtle
  (lambda ()
    (set! x-position (/ width 2))
    (set! y-position (- height 50))
    (set! angle -90)
    (set! pen-down #t)
    (set! line-width 1)
    (set! red 0)
    (set! green 0)
    (set! blue 0)
    (set! alpha 1.0)))

(define degrees->radians
  (lambda (degrees)
    (* 2 pi (/ degrees 360.0))))

;; (* 2 (degrees->radians 90)) ;; should = pi

(define forward
  (lambda (distance)
    (let ((initial-x-position x-position)
          (initial-y-position y-position))
      (set! x-position 
            (+ x-position (* distance (cos (degrees->radians angle)))))
      (set! y-position 
            (+ y-position (* distance (sin (degrees->radians angle)))))
      (when pen-down
        (line initial-x-position initial-y-position
              x-position y-position
              line-width red green blue alpha)))))

(define back
  (lambda (distance)
    (let ((initial-x-position x-position)
          (initial-y-position y-position))
      (set! x-position 
            (- x-position (* distance (cos (degrees->radians angle)))))
      (set! y-position 
            (- y-position (* distance (sin (degrees->radians angle)))))
      (when pen-down
        (line initial-x-position initial-y-position
              x-position y-position
              line-width red green blue alpha)))))

(define right 
  (lambda (degrees)
    (set! angle (+ angle degrees))
    (when (>= angle 360)
      (set! angle (- angle 360)))))

(define left 
  (lambda (degrees)
    (set! angle (- angle degrees))
    (when (< angle 0)
      (set! angle (+ angle 360)))))

(define penup
  (lambda ()
    (set! pen-down #f)))

(define pendown
  (lambda ()
    (set! pen-down #t)))

(define setxy
  (lambda (x y)
    (set! x-position x)
    (set! y-position y)))

(define setpc
  (lambda (r g b a)
    (set! red r)
    (set! green g)
    (set! blue b)
    (set! alpha a)))

(define setw
  (lambda (w)
    (set! line-width w)))

;; namespace definition, for use in calls to eval
(define-namespace-anchor turtle)
(define turtle-namespace (namespace-anchor->namespace turtle))

(define do-turtle 
  (lambda (calls)
    (for-each (lambda (call)
                (eval call turtle-namespace))
              calls)))

;(show-window)
;(init-turtle)
;(do-turtle '((forward 100) (left 45) (forward 50)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; example fractal turtle graphics procedures

(define tree
  (lambda (trunk-length)
    (unless (< trunk-length 5)
      (forward trunk-length)
      (right 30)
      (tree (* trunk-length 0.75))
      (left 60)
      (tree (* trunk-length 0.75))
      (right 30)
      (back trunk-length))))

;(show-window)
;(init-turtle)
;(tree 100)

(define fern 
  (lambda (size)
    (unless (< size 5)
      (forward (/ size 25))
      (left 80)
      (fern (* size 0.3))
      (right 82)
      (forward (/ size 25))
      (right 80)
      (fern (* size 0.3))
      (left 78)
      (fern (* size 0.9))
      (left 2)
      (back (/ size 25))
      (left 2)
      (back (/ size 25)))))

;(show-window)
;(init-turtle)
;(fern 600)

(define color-frond
  (lambda (size level)
    (when (> level 0)
      (setpc (random 256) (random 256) (random 256) 1.0)
      (forward size)
      (right 75)
      (color-frond (/ size 1.5) (- level 1))
      (left 90)
      (color-frond (/ size 1.5) (- level 1))
      (right 15)
      (back size))))

;(show-window)
;(init-turtle)
;(color-frond 100 12)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; exercises
#|

These exercises are intended to develop list manipulation skills, so they all
involve producing and manipulating lists of calls that will later be passed
to do-turtle to produce drawings. You should not write any procedures for these
exercises that actually CALL the turtle graphics procedures.

For the following exercises "a list of turtle graphics calls" means
a list containing only the following calls: forward, back, left, right,
penup, pendown, setpc, setw. Note in particular that this list does not include
setxy (which will make some of the exercises impossible), and neither does it include
the fractal procedures defined above.

1. Write a procedure called square that takes an integer "side-length"
and returns a list of turtle graphics calls that can be passed to
do-turtle to produce a square with each side being of length side-length.
Test it using do-turtle.

2. Write a procedure called myShape that takes whatever arguments you want
and returns a list of turtle graphics calls that can be passed to do-turtle
to produce an interesting shape. Try it.

3. Write a procedure called double-size that takes a list of turtle graphics
calls and returns another list of turtle graphics calls that does the same
thing but twice as big. Try it on square and myShape.

4. Write a procedure called go-back-from that takes a list of turtle graphics
calls and returns a list of turtle graphics calls that "undoes" the movements
made by the original calls, but without changing the drawing. That is, it should
return the turtle to the original position and orientation.

5. Write a procedure called multi-size that takes a list of turtle graphics calls
and a positive integer n and returns a list of turtle graphics calls that,
when passed to do-turtle, produces the given drawing at multiple sizes, 
starting with the original size and going up to n. Each drawing should start 
at the same position, and with the turtle in the same orientation. Try it on
square and myShape.

6. Write a procedure called clover that takes a list of turtle graphics calls
and returns a list of turtle graphics calls that will produce the original
drawing 4 times, all starting at the same position but at 4 different orientations
separated by 90 degrees. Try it on square and myShape.

7. Write a procedure called flower that is like clover but takes an additional
argument, a positive integer n, and produces a flower with n petals rather than 4. 
Each petal should be an instance of the original drawing passed to flower. Try it on
square and myshape.

8. Write a procedure called sunflower that combines multi-size and flower to produce
nested flowers of multiple sizes with the same center.

9. Write a procedure called colorize that takes a list of turtle graphics calls and
returns a list of turtle graphics calls with random color changes added before
each new line is drawn.

10. Write a procedure called fade that takes a list of turtle graphics calls and
returns the same list of calls but with all setpc calls changed to have half
the alpha value. Make it add an initial setpc (to black) if it doesn't initially
contain any calls to setpc.

11. Write a procedure called thicken that takes a list of turtle graphics calls
and returns the same list of calls but with all setw calls changed to have double
the alpha value. Make it add an initial setw (to 1) if it doesn't initially contain
any calls to setw.

12. Write a procedure called replace-call that takes a list of turtle graphics
calls and two individual calls called "this" and "that", and returns a list of calls
that is identical to the input except that all instances of this are changed into
that.

13. Write a procedure called replace-with-many that takes a list of turtle graphics
calls, and individual call called "this", and a list of calls called "those", and
returns a list of calls that is identical to the input except that all instances of 
this are replaced with these. (Be sure there aren't extra parentheses, or do-turtle
won't be happy.)

14. Combine myShape, flower, sunflower, colorize, fade, thicken, replace-call,
replace-with-many, etc., to produce something really cool!

15. Rewrite some of the recursive turtle graphics examples above (e.g. fern)
to produce a list of primitive turtle graphics calls that can be passed to do-turtle,
instead of drawing to the window directly.

|#