Fundamentals of Computer Science I: Media Computing (CS151.01 2008S)

Laboratory: Project Ideas


Summary: In this laboratory, you will explore the three new approaches to making images that were covered in the corresponding reading.

Warning! Some of these procedures use image-iterate!, which is not yet in all released versions of DrFu. If you want to use that procedure (which works somewhat like image-compute-pixels!), add this code to your library.

Preparation

a. Create a new 200x200 image called canvas.

b. Add the various procedures given at the end of this lab to your definitions pane.

Exercises on Color Trees

Exercise 1: Color Tree Basics

a. What effect do you expect the following instruction to have?

> (render-color-tree! color-blue canvas 0 0 200 200)

b. Check your answer experimentally.

c. What effect do you expect the following instruction to have?

> (render-color-tree! (cons color-black color-red) canvas 0 0 200 200)

d. Check your answer experimentally.

e. What effect do you expect the following instruction to have?

> (render-color-tree! (cons color-red color-black) canvas 50 50 100 100)

f. Check your answer experimentally.

g. What effect do you expect the following instruction to have?

> (render-color-tree! (cons (cons color-green color-yellow) color-orange) canvas 0 0 200 200)

h. Check your answer experimentally.

i. Create one or two color trees of your own and render them.

Exercise 2: An Alternate Implementation

a. Compare new-render-color-tree! to render-color-tree!. What do you see as the primary difference?

b. Redo all but the last step from Exercise 1, using new-render-color-tree! in place of render-color-tree!.

c. What do you expect the result of the following command to be?

> (new-render-color-tree! (cons (cons (cons color-black color-green) color-yellow) color-orange) canvas 0 0 200 200)

d. Check your answer experimentally.

Exercise 3: A Simple Series of Images

Look at the code for series-1.

a. What do you expect (series-1 5 100 100) to produce?

b. Check your answer experimentally.

c. What do you expect (series-1 42 100 100) to produce?

d. Check your answer experimentally.

e. Do you expect (series-1 43 100 100) to be similar or very different? How do you expect it to differ?

f. Check your answer experimentally.

g. How do you expect (series-1 43 500 500) to differ?

h. Check your answer experimentally.

i. How do you expect (series-1 43 800 100) to relate to the previous two images?

j. Check your answer experimentally.

Exercise 4: From Rectangles to Ovals

Replace image-select-rectangle! in new-render-color-tree! with image-select-ellipse!.

Try the last few examples from the previous exercise.

Exercises on Fractals

Exercise 5: Simple Fractal Activities

a. Use fractal-rectangle! to draw a 200x200 blue rectangle on canvas, using a recursion level of 0.

b. Use fractal-rectangle! to draw a 200x200 red rectangle using a recursion level of 1. (Don't be surprised if it looks pretty boring.)

c. Use fractal-rectangle! to draw a 200x200 green rectangle using a recursion level of 2. (Again, don't be surprised if it's boring.)

d. After those three exercises, you are probably ready to do something a bit more interesting. Here's a modified version of fractal-rectangle! in which we've changed the recursive calls for the top-middle, left-middle, right-middle, and bottom-middle subrectangles so that they use the complement of the color.

(define fractal-rectangle!
  (lambda (image color left top right bottom level)
    (cond
      ; Base case: We're at a level in which we just draw the rectangle.
      ((= level 0)
       (context-set-fgcolor! color)
       (image-select-rectangle! image selection-replace
                                left top 
                                (- right left)
                                (- bottom top))
       (image-fill! image)
       (image-select-nothing! image)
       (context-update-displays!))
      ; Recursive case: Break the rectangle into a few parts and recurse
      ; on each.
      (else
       (let* ((midcol1 (round (+ left (/ (- right left) 3))))
              (midcol2 (round (- right (/ (- right left) 3))))
              (midrow1 (round (+ top (/ (- bottom top) 3))))
              (midrow2 (round (- bottom (/ (- bottom top) 3)))))
         ; First row of squares
         (fractal-rectangle! image 
                             color
                             left top 
                             midcol1 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-complement color)
                             midcol1 top 
                             midcol2 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 top 
                             right midrow1
                             (- level 1))
         ; Second row of squares
         (fractal-rectangle! image 
                             (rgb-complement color)
                             left midrow1
                             midcol1 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol1 midrow1
                             midcol2 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-complement color)
                             midcol2 midrow1
                             right midrow2
                             (- level 1))
         ; Third row of squares
         (fractal-rectangle! image 
                             color
                             left midrow2
                             midcol1 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-complement color)
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )))))

Put this new version at the end of your definitions pane. (Scheme always uses the last definition.)

Use this procedure to draw a 200x200 rectangle fractal with black as the initial color and a recursion level of 1. Once you've done that, try it with a recursion level of 2.

e. Predict what will happen if you draw a 200x200 rectangle with yellow as the initial color and a recursion level of 3. Check your prediction experimentally.

f. Here is a procedure that averages two RGB colors.

(define rgb-average
  (lambda (c1 c2)
    (rgb-new (quotient (+ (rgb-red c1) (rgb-red c2)) 2)
             (quotient (+ (rgb-green c1) (rgb-green c2)) 2)
             (quotient (+ (rgb-blue c1) (rgb-blue c2)) 2))))

And here is a rewritten fractal-rectangle! that averages the colors in the top-middle, left-middle, right-middle, and bottom-middle subrectangles with black and the colors in the other five subrectangles with white.

(define fractal-rectangle!
  (lambda (image color left top right bottom level)
    (cond
      ; Base case: We're at a level in which we just draw the rectangle.
      ((= level 0)
       (context-set-fgcolor! color)
       (image-select-rectangle! image selection-replace
                                left top 
                                (- right left)
                                (- bottom top))
       (image-fill! image)
       (image-select-nothing! image)
       (context-update-displays!))
      ; Recursive case: Break the rectangle into a few parts and recurse
      ; on each.
      (else
       (let* ((midcol1 (round (+ left (/ (- right left) 3))))
              (midcol2 (round (- right (/ (- right left) 3))))
              (midrow1 (round (+ top (/ (- bottom top) 3))))
              (midrow2 (round (- bottom (/ (- bottom top) 3)))))
         ; First row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             left top 
                             midcol1 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol1 top 
                             midcol2 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol2 top 
                             right midrow1
                             (- level 1))
         ; Second row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             left midrow1
                             midcol1 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol1 midrow1
                             midcol2 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol2 midrow1
                             right midrow2
                             (- level 1))
         ; Third row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             left midrow2
                             midcol1 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )))))

g. What do you expect to have happen if we draw a 200x200 level-2 fractal rectangle whose initial color is blue? Check your answer experimentally.

h. What do you expect to have happen if we draw a 200x200 level-3 fractal rectangle whose initial color is green? Check your answer experimentally.

i. Let's change the computation of the intermediate boundaries so that midcol1 is 1/4 of the way across, midcol2 is 1/2 of the way across, midrow1 is 1/4 of the way down, and midrow2 is 1/2 of the way down. Add the following to the end of your definitions pane.

(define fractal-rectangle!
  (lambda (image color left top right bottom level)
    (cond
      ; Base case: We're at a level in which we just draw the rectangle.
      ((= level 0)
       (context-set-fgcolor! color)
       (image-select-rectangle! image selection-replace
                                left top 
                                (- right left)
                                (- bottom top))
       (image-fill! image)
       (image-select-nothing! image)
       (context-update-displays!))
      ; Recursive case: Break the rectangle into a few parts and recurse
      ; on each.
      (else
       (let* ((midcol1 (round (+ left (/ (- right left) 4))))
              (midcol2 (round (+ midcol1 (/ (- right left) 4))))
              (midrow1 (round (+ top (/ (- bottom top) 4))))
              (midrow2 (round (+ midrow1 (/ (- bottom top) 4)))))
         ; First row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             left top 
                             midcol1 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol1 top 
                             midcol2 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol2 top 
                             right midrow1
                             (- level 1))
         ; Second row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             left midrow1
                             midcol1 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol1 midrow1
                             midcol2 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol2 midrow1
                             right midrow2
                             (- level 1))
         ; Third row of squares
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             left midrow2
                             midcol1 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-black)
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             (rgb-average color color-white)
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )))))

j. What do you expect to have happen if we draw a 200x200 level-2 fractal rectangle whose initial color is red? Check your answer experimentally. What about a level-3 fractal?

k. Change the computation of the intermediate boundaries so that midcol1 is 1/4 of the way across, midcol2 is 3/4 of the way across, midrow1 is 1/4 of the way down, and midrow2 is 3/4 of the way down.

l. Draw one final level-3 fractal.

Exercises on Genetic Art

Exercise 6: Visualizing Files

While we are unlikely to use file-visualize in the project, it's probably worth playing with it once or twice to see its effect.

a. Use file-visualize to visualize /usr/bin/vi, a simple text editor.

> (file-visualize "/usr/bin/vi" 50 50)

b. Use file-visualize on a file of your choice.

c. What effect do you expect if we use a 100x100 image? A 500x500 image?

d. Check your answers experimentally.

Exercise 7: Visualizing With Grids

Here's a simple palette.

(define sample-palette (vector color-black color-white color-grey color-blue))

a. Using this palette and image-file->grid!, visualize the same two files that you tried in the previous exercise, using a 50x50 image size and a 10x10 grid.

b. What effect do you expect if we continue to use a 10x10 grid, but expand to a 100x100 image? A 500x500 image?

c. Check your answers experimentally.

d. What effect do you expect if we continue to use a 500x500 image, but expand to a 20x10 grid? A 10x20 grid?

e. Check your answers experimentally.

Exercise 8: Another Series of Images

Consider the code for series-2.

a. What colors (palette) do you expect it to use if n is 42?

b. How many columns do you expect in the grid if n is 42?

c. How many rows do you expect in the grid if n is 42?

d. Check your previous three answers experimentally.

e. How do each of those answers change if n is 43? 49?

f. Check your answers experimentally.

g. [This is definitely a math problem, so you can skip it if you wish.] Is there another n that gives the same palette, columns, and rows as 42? If so, find one (or think about how you might find one). If not, explain why not. Is there one less than 1000 that uses the same file?

Exercise 9: Teaching Turtles to Draw

a. Using file-instruct-turtle and a file of your choice, draw a picture. (You should probably use at least 100 “commands”.)

b. Try changing a few of the letters in the lists at the beginning of the definition and see the effects of those changes.

Notes

The point of 8.g is to suggest that coming up with four “parameters” to your image, one of which has five values, one of which has seven values, one of which has nine values, and one of which has eleven values gives you many more than 1000 different images. As importantly, you can easily turn any number between 0 and 1000 to a set of those values by using modulo.

Useful Procedures

; +-------------+---------------------------------------------------------------
; | Color Trees |
; +-------------+

;;; Procedure:
;;;   render-color-tree!
;;; Parameters:
;;;   ctree, a tree of colors
;;;   image, an image 
;;;   left, an integer
;;;   top, an integer
;;;   width, an integer
;;;   height, an integer
;;; Purpose:
;;;   Render the tree into the portion of the image bounded at
;;;   the left by left, at the top by top, and with the specified
;;;   width and height.
;;; Produces:
;;;   [Nothing; Called for the side effect.]
;;; Preconditions:
;;;   [The usual]
;;; Postconditions:
;;;   The tree has now been rendered.
(define render-color-tree!
  (lambda (ctree image left top width height)
    (cond
      ((pair? ctree)
       (render-color-tree! (car ctree) image 
                                       left top 
                                       (/ width 2) height)
       (render-color-tree! (cdr ctree) image
                                       (+ left (/ width 2)) top
                                       (/ width 2) height))
      (else
       (image-select-rectangle! image selection-replace
                                left top width height)
       (context-set-fgcolor! ctree)
       (image-fill! image)
       (context-update-displays!)
       (image-select-nothing! image)))))

(define new-render-color-tree!
  (lambda (ctree image left top width height)
    (let kernel ((ctree ctree)
                 (hsplit? #t)
                 (left left)
                 (top top)
                 (width width)
                 (height height))
      (cond
        ; If it's too small, just stop.
        ((or (<= width 0.5) (<= height 0.5)))
        ((and (pair? ctree) hsplit?)
         (kernel (car ctree) (not hsplit?) 
                 left top 
                 (/ width 2) height)
         (kernel (cdr ctree) (not hsplit?)
                 (+ left (/ width 2)) top
                 (/ width 2) height))
        ((pair? ctree) ; NOT hsplit?
         (kernel (car ctree) (not hsplit?) 
                 left top 
                 width (/ height 2))
         (kernel (cdr ctree) (not hsplit?)
                 left (+ top (/ height 2))
                 width (/ height 2)))
        (else
         (image-select-rectangle! image selection-replace
                                  left top (round width) (round height))
         (context-set-fgcolor! ctree)
         (image-fill! image)
         (context-update-displays!)
         (image-select-nothing! image))))))

;;; Procedure:
;;;   number->color-tree
;;; Parameters:
;;;   n, an exact integer
;;; Purpose:
;;;   Create an "interesting" color tree whose content depends only
;;;   on n.  Ideally, different values of n would give different 
;;;   color trees.
;;; Produces:
;;;   ctree, a color tree
;;; Preconditions:
;;;   n >= 0
;;; Postconditions:
;;;   If x != y, then (number->color-tree x) is unlikely to be the same as
;;;   (number->color-tree y)
(define number->color-tree
  ; These are the colors used to build the tree
  (let* ((colors (vector (rgb-new 255 0 0) (rgb-new 204 0 0) (rgb-new 153 0 0)
                         (rgb-new 255 0 102) (rgb-new 204 0 102) (rgb-new 153 0 102)
                         (rgb-new 255 0 204) (rgb-new 204 0 204) (rgb-new 153 0 204)))
         (num-colors (vector-length colors)))
    (lambda (n)
      (let ((action (remainder n 10)))
        (cond
          ; For small numbers, we simply grab them from the color tree.
          ((< n num-colors)
           (vector-ref colors n))
          ((< action 2)
           (cons (number->color-tree (inexact->exact (round (* 0.4 n))))
                 (number->color-tree (inexact->exact (round (* 0.6 n))))))
          ((< action 4)
           (cons (number->color-tree (inexact->exact (round (* 0.6 n))))
                 (number->color-tree (inexact->exact (round (* 0.4 n))))))
          ((< action 6)
           (cons (number->color-tree (inexact->exact (round (* 0.25 n))))
                 (number->color-tree (inexact->exact (round (* 0.75 n))))))
          ((< action 8)
           (cons (number->color-tree (inexact->exact (round (* 0.75 n))))
                 (number->color-tree (inexact->exact (round (* 0.25 n))))))
          ((< action 9)
           (cons (vector-ref colors (remainder n num-colors))
                 (number->color-tree (inexact->exact (round (* 0.5 n))))))
          (else
           (cons (number->color-tree (inexact->exact (round (* 0.5 n))))
                 (vector-ref colors (remainder n num-colors)))))))))

(define series-1
  (lambda (n width height)
    (let* ((ctree (number->color-tree n))
           (canvas (image-new width height)))
      (image-show canvas)
      (new-render-color-tree! ctree canvas 0 0 width height)
      canvas)))


; +----------+------------------------------------------------------------------
; | Fractals |
; +----------+

;;; Procedure:
;;;   fractal-rectangle!
;;; Parameters:
;;;   image, an image
;;;   color, the desired color of the rectangle
;;;   left, the left edge of the rectangle
;;;   top, the top edge of the rectangle
;;;   width, the width of the rectangle
;;;   height, the height of the rectangle
;;;   level, the level of recursion
;;; Purpose:
;;;   Draw a "fractal" version of the rectangle by
;;;   breaking the rectangle up into subrectangles,
;;;   and recursively drawing some of those rectangles
;;;   (potentially in different colors).  When does
;;;   recursion stop?  When the level of recursion is 0.
;;; Produces:
;;;   [Nothing; Called for the side effect]

(define fractal-rectangle!
  (lambda (image color left top right bottom level)
    (cond
      ; Base case: We're at a level in which we just draw the rectangle.
      ((= level 0)
       (context-set-fgcolor! color)
       (image-select-rectangle! image selection-replace
                                left top 
                                (- right left)
                                (- bottom top))
       (image-fill! image)
       (image-select-nothing! image)
       (context-update-displays!))
      ; Recursive case: Break the rectangle into a few parts and recurse
      ; on each.
      (else
       (let* ((midcol1 (round (+ left (/ (- right left) 3))))
              (midcol2 (round (- right (/ (- right left) 3))))
              (midrow1 (round (+ top (/ (- bottom top) 3))))
              (midrow2 (round (- bottom (/ (- bottom top) 3)))))
         ; First row of squares
         (fractal-rectangle! image 
                             color
                             left top 
                             midcol1 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol1 top 
                             midcol2 midrow1
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 top 
                             right midrow1
                             (- level 1))
         ; Second row of squares
         (fractal-rectangle! image 
                             color
                             left midrow1
                             midcol1 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol1 midrow1
                             midcol2 midrow2
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow1
                             right midrow2
                             (- level 1))
         ; Third row of squares
         (fractal-rectangle! image 
                             color
                             left midrow2
                             midcol1 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol1 midrow2
                             midcol2 bottom
                             (- level 1))
         (fractal-rectangle! image 
                             color
                             midcol2 midrow2
                             right bottom
                             (- level 1))
         )))))


; +-------------------------------+---------------------------------------------
; | Repurposing Files/Genetic Art |
; +-------------------------------+

;;; Procedure:
;;;   file-visualize
;;; Parameters:
;;;   filename, a string
;;;   width, an integer
;;;   height, an integer
;;; Purpose:
;;;   Create a new width-by-height image, filling in the pixels by
;;;   interpreting the contents of the file as colors.
;;; Produces:
;;;   image, a new image.
;;; Preconditions:
;;;   filename names a file.
;;;   That file contains at least width*height*3 characters.
;;; Postconditions:
;;;   image represents the contents of the file.
(define file-visualize
  (let ((color-read (lambda (port)
                      (let ((r (read-char port))
                            (g (read-char port))
                            (b (read-char port)))
                        (if (eof-object? b)
                            color-transparent
                            (rgb-new (modulo (char->integer r) 256)
                                     (modulo (char->integer g) 256)
                                     (modulo (char->integer b) 256)))))))
    (lambda (filename width height)
      (let ((image (image-new width height))
            (port (open-input-file filename)))
        (if (not port)
            (throw "Invalid file name: " filename))
        (image-show image)
        (image-iterate! image 
                        (lambda (c r)
                          (color-read port)))
        (close-input-port port)
        image))))

;;; Procedure:
;;;   image-file->grid!
;;; Parameters:
;;;   image, an image
;;;   filename, a string
;;;   palette, a vector of colors
;;;   hcells, an integer
;;;   vcells, an integer
;;; Purpose:
;;;   Create a hcells-by-vcells grid of colors on image, computing the 
;;;   colors in the grid from palette and the given file.
;;; Produces:
;;;   [Nothing; called for the side effects.]
;;; Preconditions:
;;;   filename names a valid file.
;;;   image is an open image
;;;   hcells > 0
;;;   vcells > 0
(define image-file->grid!
  (lambda (image filename palette hcells vcells)
    (let* ((source (open-input-file filename))
           (palette-size (vector-length palette))
           (width (image-width image))
           (height (image-height image))
           (hoffset (/ width hcells))
           (voffset (/ height vcells)))
      (if (not source)
          (throw "Invalid file name; " filename))
      (let kernel ((col 0)
                   (row 0))
        (cond
          ((or (eof-object? (peek-char source)) (>= row height))
           (close-input-port source)
           (image-select-nothing! image)
           (context-update-displays!)
           image)
          ((>= col width)
           (kernel 0 (+ row voffset)))
          (else
           (image-select-rectangle! image selection-replace
                                    col row hoffset voffset)
           (context-set-fgcolor! (vector-ref palette 
                                             (remainder (char->integer (read-char source))
                                                        palette-size)))
           (image-fill! image)
           (kernel (+ col hoffset) row)))))))

(define series-2
  (let ((palettes (vector (vector color-black color-white color-grey)
                          (vector (rgb-new 255 0 0) (rgb-new 0 0 0) (rgb-new 51 0 0)
                                  (rgb-new 102 0 0) (rgb-new 153 0 0) (rgb-new 204 0))
                          (vector (rgb-new 0 0 0) (rgb-new 128 0 0) (rgb-new 255 0 0)
                                  (rgb-new 0 0 128) (rgb-new 128 0 128) (rgb-new 255 0 128)
                                  (rgb-new 0 0 255) (rgb-new 128 0 255) (rgb-new 255 0 255))
                          (vector color-black color-white color-grey color-red)
                          (vector (rgb-new 0 0 0) (rgb-new 51 51 0) (rgb-new 102 102 0)
                                  (rgb-new 153 153 0) (rgb-new 204 204 0) (rgb-new 255 255 0))
                          (vector (rgb-new 104 104 0) (rgb-new 104 104 51)
                                  (rgb-new 104 104 102) (rgb-new 104 104 153)
                                  (rgb-new 104 104 204) (rgb-new 104 104 255))
                          (vector (rgb-new 0 0 0) (rgb-new 104 104 104)
                                  (rgb-new 255 0 0) (rgb-new 104 0 0)
                                  (rgb-new 153 0 0) (rgb-new 153 153 153))))
        (files (vector "/usr/bin/vi"
                       "/usr/bin/emacs"
                       "/etc/aliases"
                       "/bin/bash"
                       "/etc/passwd")))
    (lambda (n width height)
      (let ((image (image-new width height)))
        (image-show image)
        (image-file->grid! image
                           (vector-ref files (modulo n (vector-length files)))
                           (vector-ref palettes (modulo n (vector-length palettes)))
                           (+ 2 (modulo n 9))
                           (+ 2 (modulo n 11)))
        image))))

;;; Procedure:
;;;   file-instruct-turtle
;;; Parameters:
;;;   file, a string that names a file
;;;   image, an image
;;;   n, the number of instructions to take from the file
;;; Purpose:
;;;   Interpret the file (loosely) as a sequence of instructions to
;;;   a turtle that is placed on the image.
;;; Produces:
;;;   [Nothing; called for the side effect]
;;; Preconditions:
;;;   file names a file available for reading.
;;;   turtle exists and is associated with some image.
;;;   n > 0.
;;;   file contains at least 2*n characters.
;;; Postconditions:
;;;   Um, something has happened to the image.
(define file-instruct-turtle
  (let* (; Choose the pens we want to use
         (pens (vector "Circle Fuzzy (03)" "Circle Fuzzy (05)" "Circle Fuzzy (07)"
                       "Circle Fuzzy (09)" "Circle Fuzzy (11)" "Circle Fuzzy (13)"
                       "Circle Fuzzy (15)" "Circle Fuzzy (17)"))
         (numpens (vector-length pens))
         ; Set some initial values
         (initial-color (rgb-new 0 0 255))
         (initial-pen (quotient numpens 2))
         ; Letters for different actions
         (advance-chars (list #\a #\b #\c #\d #\e #\space))
         (turn-chars (list #\f #\g #\h #\i #\j #\o #\u #\y #\. #\newline))
         (darker-chars (list #\l #\m))
         (lighter-chars (list #\n #\p))
         (smaller-chars (list #\q #\r))
         (larger-chars (list #\s))
         (teleport-chars (list #\t))
         ; A helpful function when we may have EOF
         (char2int (lambda (ch) (if (eof-object? ch) 0 (char->integer ch)))))
    (lambda (filename image n)
      ; Open the file
      (let ((port (open-input-file filename)))
        (if (not port)
            (throw "No such file: " filename))
        ; Create the turtle and set some basic values
        (let ((turtle (turtle-new image))
              (midcol (quotient (image-width image) 2))
              (midrow (quotient (image-height image) 2)))
          ; Move the turtle somewhere easy to track and set it to it's initial
          ; values
          (turtle-teleport! turtle midcol midrow)
          (turtle-set-color! turtle initial-color)
          (turtle-set-brush! turtle (vector-ref pens initial-pen))
          ; Okay, let's read those instructions.  We'll keep track of the remaining
          ; number of instructions, the current turtle color, and the current turtle
          ; pen.
          (let kernel ((remaining n)
                       (color initial-color)
                       (pen initial-pen))
            ; Read the next character.
            (let* ((ch (read-char port)))
              (display "[") (write ch) (display "]: ")
              (cond
                ; If we reached the end of the file, or run out of commands, stop.
                ((or (eof-object? ch) (= remaining 0))
                 (close-input-port port)
                 image)
                ; Sometimes we advance
                ((member ch advance-chars)
                 (let ((distance (* 3 (quotient (char2int (read-char port)) 10))))
                   (display "Advancing ") (display distance) (newline)
                   (turtle-forward! turtle distance)
                   (kernel (- remaining 1) color pen)))
                ; Sometimes we turn
                ((member ch turn-chars)
                 (let ((angle (* 30 (- (modulo (char2int (read-char port)) 9) 3))))
                   (display "Turning ") (display angle) (newline)
                   (turtle-turn! turtle angle)
                   (kernel (- remaining 1) color pen)))
                ; Sometimes we teleport back to the middle
                ((member ch teleport-chars)
                 (display "Home!") (newline)
                 (turtle-teleport! turtle midcol midrow)
                 (kernel (- remaining 1) color pen))
                ; Sometimes we make the color darker
                ((member ch darker-chars)
                 (let ((newcolor (rgb-darker color)))
                   (display "Darker") (newline)
                   (turtle-set-color! turtle newcolor)
                   (kernel (- remaining 1) newcolor pen)))
                ; Sometimes we make the color lighter
                ((member ch lighter-chars)
                 (let ((newcolor (rgb-lighter color)))
                   (display "Lighter") (newline)
                   (turtle-set-color! turtle newcolor)
                   (kernel (- remaining 1) newcolor pen)))
                ; Sometimes we use a larger pen
                ((member ch larger-chars)
                 (let ((newpen (min (+ pen 1) (- numpens 1))))
                   (display "Bigger") (newline)
                   (turtle-set-brush! turtle (vector-ref pens newpen))
                   (kernel (- remaining 1) color newpen)))
                ; Sometimes we use a smaller pen
                ((member ch smaller-chars)
                 (let ((newpen (max (- pen 1) 0)))
                   (display "Smaller") (newline)
                   (turtle-set-brush! turtle (vector-ref pens newpen))
                   (kernel (- remaining 1) color newpen)))
                ; Sometimes nothing works.
                (else
                 (display "Skipping") (newline)
                 (kernel (- remaining 1) color pen))))))))))

Creative Commons License

Samuel A. Rebelsky, rebelsky@grinnell.edu

Copyright (c) 2007-8 Janet Davis, Matthew Kluber, and Samuel A. Rebelsky. (Selected materials copyright by John David Stone and Henry Walker and used by permission.)

This material is based upon work partially supported by the National Science Foundation under Grant No. CCLI-0633090. Any opinions, findings, and conclusions or recommendations expressed in this material are those of the author(s) and do not necessarily reflect the views of the National Science Foundation.

This work is licensed under a Creative Commons Attribution-NonCommercial 2.5 License. To view a copy of this license, visit http://creativecommons.org/licenses/by-nc/2.5/ or send a letter to Creative Commons, 543 Howard Street, 5th Floor, San Francisco, California, 94105, USA.