Programming Praxis

We choose PostScript as our output device, but our use of PostScript will be primitive: a very brief initialization, an even briefer termination, and only moveto lineto commands in between. We will keep track ourselves of the turtle state — the current x-position and y-position, the current heading, and whether the pen is up or down — because it is hard to get such information back from PostScript to the controlling Scheme script. Here’s the initialization:

(define (clearscreen)
  (set! xpos 0)
  (set! ypos 0)
  (set! pen? #t)
  (set! head 0)
  (send "%!")
  (send "initgraphics")
  (send "newpath 306 396 moveto")
  (send "currentpoint translate")
  (send "0 setgray 2 setlinewidth"))

We reset Scheme’s turtle coordinates then send five initialization commands: %! identifies the output as PostScript, initgraphics initializes PostScript to accept graphics commands, newpath 306 396 moveto starts a new drawing and moves the PostScript turtle to the center of an 8%half;-by-11 page, currentpoint translate resets the current PostScript turtle to the point 0,0 so it is the same as the Scheme turtle, and 0 setgray 2 setlinewidth sets a black pen with width 2. There is no scale command, so a turtle step will be PostScript’s default measure of 1/72 of an inch.

The penup and pendown commands are trivial; the global variable pen? is #t when the pen is down:

(define (penup) (set! pen? #f))
(define (pendown) (set! pen? #t))

The most complicated commands are forward and back. We compute new coordinates using trigonometry (one degree, which is the measure used by the turtle, is equal to 0.017453292519943295 radians, which is the measure used by the Scheme sin and cos functions), write a PostScript command using either lineto or moveto depending on whether the pen is down or up, and reset the global turtle position:

(define (forward n)
  (let ((newx (inexact->exact (round
          (+ xpos (* n (sin (* head 0.017453292519943295)))))))
        (newy (inexact->exact (round
          (+ ypos (* n (cos (* head 0.017453292519943295))))))))
    (send newx newy (if pen? "lineto" "moveto"))
    (set! xpos newx) (set! ypos newy)))

(define (back n)
  (let ((newx (inexact->exact (round
          (- xpos (* n (sin (* head 0.017453292519943295)))))))
        (newy (inexact->exact (round
          (- ypos (* n (cos (* head 0.017453292519943295))))))))
    (send newx newy (if pen? "lineto" "moveto"))
    (set! xpos newx) (set! ypos newy)))

Left and right are simpler; they merely reset the global turtle heading, wrapping around at 360 degrees:

(define (left n) (set! head (modulo (- head n) 360)))
(define (right n) (set! head (modulo (+ head n) 360)))

Setpos and setheading reset the global turtle state; setpos also moves the PostScript turtle, drawing a line if the pen is down.

(define (setpos x y)
  (send x y (if pen? "lineto" "moveto"))
  (set! xpos x) (set! ypos y))
(define (setheading n) (set! head n))

Pos and heading return the appropriate values from the global turtle state; done performs the very brief termination:

(define (pos) (values xpos ypos))
(define (heading) head)

(define (done) (send "stroke showpage"))

Finally, we use the send command to write output:

(define (send x . xs)
  (cond ((null? xs) (display x) (newline))
  (else (display x) (display " ") (apply send xs))))

And that’s it. As a demonstration of the library, here is the tree function from Harvey’s book, and the commands to draw the tree shown on the previous page:

(define (tree size)
  (cond ((< size 5) (forward size) (back size))
  (else (forward (/ size 3))
        (left 30) (tree (* size 2/3)) (right 30)
        (back (/ size 3))
        (forward (/ size 2))
        (right 25) (tree (/ size 2)) (left 25)
        (back (/ size 2))
        (forward (* size 5/6))
        (right 25) (tree (/ size 2)) (left 25)
        (back (* size 5/6)))))

(with-output-to-file "tree.ps"
  (lambda ()
    (clearscreen)
    (penup)
    (back 300)
    (pendown)
    (tree 400)
    (done)))

You can run the program at http://programmingpraxis.codepad.org/cX7wPlQa.

Pages: 1 2