December, 2013 |
What? We will be implementing a version of turtle
graphics for TeXmacs. For the uninitiated, turtle graphics is the
graphics mode of the
Why? Because it's fun!
How? We'll define a canvas widget and a set of
A word of caution: even though some editing has been
done, the code and text here were written without much planning in a
couple of micro-hackatons. Things work but (as always) might have been
done better. In particular our use of globals to store state and
relying on side effects is ugly and the source of
inconsistencies. Ideally
This is how things will work: all our procedures will produce
Our first building block is the point. Given two coordinates the procedure
We next define some state variables with the turtle's current position
and direction vector. The two first -axis, given in degrees
.
Finally, the convenience procedure
(define _zoom 0.1)
Scheme]
(define _posx 0)
Scheme]
(define _posy 0)
Scheme]
(define _ang 0)
Scheme]
(define (zoom zm)
(if (number? zm) (set! _zoom zm)))
Scheme]
(define (point x y)
; number->string is necessary for TeXmacs to understand
decimal numbers
‘(point ,(number->string (* x _zoom))
,(number->string (* y _zoom))))
Scheme]
(define (pos) (point _posx _posy))
Scheme]
The next procedure
painting along its way. As every other turtle of its kind, ours has a
pen it uses to paint the canvas. The turtle has its pen down by
default but we will see later how to change this. Finally,
(define (go where)
(let* ((xfinal (car where))
(yfinal (cadr where))
(ret ‘(line ,(pos) ,(point xfinal yfinal))))
(set! _posx xfinal)
(set! _posy yfinal)
ret))
Scheme]
(define home '(0 0))
Scheme]
Our turtle must turn too. We can tell it to with
(define (turn a)
(if (number? a)
(with b (modulo (+ _ang a) 360)
(set! _ang b)))
'())
Scheme]
(define (right a) (turn (* -1 a)))
Scheme]
(define (left a) (turn a))
Scheme]
(define (look where)
(if (number? where) (set! _ang (modulo where 360)))
'())
Scheme]
(define north 90)
Scheme]
(define south 270)
Scheme]
(define east 0)
Scheme]
(define west 180)
Scheme]
You might have noticed that we explictly return the empty list after
some procedures. This is because we will later be sending the output
of all our drawing and positioning routines to a procedure called
The commands units and the deviation
after some movement is of the order
. That is,
the turtle would have to walk more than
units
before we could notice any difference.
(define pi 3.14159265358979323846264338328)
Scheme]
(define eps 1e-15)
Scheme]
(define (_sin rad) (rationalize (sin rad) eps))
Scheme]
(define (_cos rad) (rationalize (cos rad) eps))
Scheme]
(define (forward dist)
(let* ((rad (/ (* _ang pi) 180))
(xdist (+ _posx (* dist (_cos rad))))
(ydist (+ _posy (* dist (_sin rad)))))
(go (list xdist ydist))))
Scheme]
(define (backward dist)
(forward (* -1 dist)))
Scheme]
Let's now write some extra routines for drawing figures. We start with
a rectangle using the TeXmacs graphics primitive
(define (rectangle n m)
(let ((p1 (pos))
(p2 (point (+ _posx n) _posy))
(p3 (point (+ _posx n) (+ _posy m)))
(p4 (point _posx (+ _posy m))))
‘(line ,p1 ,p2 ,p3 ,p4 ,p1)))
Scheme]
(define (circle r)
(let ((p1 (point (+ _posx r) _posy))
(p2 (point _posx (+ _posy r)))
(p3 (point (- _posx r) _posy)))
‘(carc ,p1 ,p2 ,p3)))
Scheme]
Let's try these out! First we need to build a TeXmacs
(define (plot l) (stree->tree l))
Scheme]
(plot (rectangle 1 2))
Scheme]
(plot (circle 1))
Scheme]
This is already looking good, but we need some color! We will now
define
(define (merge-with l par val subs)
(cond ((== (length l) 0) '())
((== (length l) 1) (append (list par val) l))
((== par (car l))
(if subs (set-car! (cdr l) val)) l)
(else
(let ((t (list (car l) (cadr l))))
(append t (merge-with (cddr l) par val subs))))))
Scheme]
(define (decorate l par val subs)
(cond ((or (nlist? l) (null? l)) '())
((list? (car l))
(append (list (decorate (car l) par val subs))
(decorate (cdr l) par val subs)))
((== (car l) 'with)
(append '(with) (merge-with (cdr l) par val subs)))
((or (== (car l) 'line) (== (car l) 'carc) (== (car l)
'point))
(append '(with) (merge-with (list l) par val
subs)))))
Scheme]
(define (fill fig bc)
(decorate fig "fill-color" bc #f))
Scheme]
(define (force-fill fig bc)
(decorate fig "fill-color" bc #t))
Scheme]
(define (colorize fig fc)
(decorate fig "color" fc #f))
Scheme]
(define (force-colorize fig fc)
(decorate fig "color" fc #t))
Scheme]
(define (width fig n)
(if (> n 0)
(decorate fig
"line-width"
(string-append (number->string n)
"ln")
#f)
'()))
Scheme]
(define (force-width fig n)
(if (> n 0)
(decorate fig
"line-width"
(string-append (number->string n)
"ln")
#t)
'()))
Scheme]
After some reverse-engineering of TeXmacs graphics we find how to change line styles as well. There seems to be no code number for the normal pen; as a consequence one cannot force this style.
(define (style fig n)
(cond ((== n 0) fig)
((== n 1) (decorate fig "dash-style"
"10" #f))
((== n 2) (decorate fig "dash-style"
"11100" #f))
((== n 3) (decorate fig "dash-style"
"1111010" #f))
(else '())))
Scheme]
(define (force-style n)
(cond ((== n 0) fig)
((== n 1) (decorate fig "dash-style"
"10" #t))
((== n 2) (decorate fig "dash-style"
"11100" #t))
((== n 3) (decorate fig "dash-style"
"1111010" #t))
(else '())))
Scheme]
We may finally test the colors:
(plot (fill (circle 2) "red"))
Scheme]
(plot (colorize (circle 2) "green"))
Scheme]
(plot (colorize (width (style (circle 4) 2) 2)
"purple"))
Scheme]
One last routine. Use it like all the others.
Scheme]
(define (text str)
‘(with "text-at-valign" "center"
"text-at-halign" "center"
(text-at ,str ,(pos))))
It is time now for formal introductions. Here is our artist:
(define show-turtle? #t)
Scheme]
(define (turtle x y ang sz)
(let ((points (map (lambda (t)
(go (list x y))
(look (+ ang t))
(forward sz)
(pos))
'(0 135 225 0))))
(go (list x y))
(append '(line) points)))
Scheme]
(define (show-turtle)
(set! show-turtle? #t)
(refresh-canvas))
Scheme]
(define (hide-turtle)
(set! show-turtle? #f)
(refresh-canvas))
Scheme]
As you can see, you may hide the turtle if it's bothering you or show
it again by using hide-turtle or show-turtle.
But notice those
Before we get into that we deal with a few more technicalities: first
we provide a way to tell the turtle not to draw while moving. As
announced this is done “moving the pen up”, which we
achieve enclosing any drawing instructions within a call to for each
for each
Finally we define the convenience routine
(define (up l)
(cons 'up (list l)))
Scheme]
(define (down l)
(cons 'down (list l)))
Scheme]
(define (simplify l i)
(cond ((or (null? l) (nlist? l)) '())
((nlist? (car l))
(cond ((== (car l) 'up) (simplify (cdr l) (+ i 1)))
((== (car l) 'down) (simplify (cdr l) (- i 1)))
(else (if (<= i 0) (list l) '()))))
(else (append (simplify (car l) i)
(simplify (cdr l) i)))))
Scheme]
(define (draw . l)
(if (nnull? l) (to-canvas (simplify l 0))))
Scheme]
We finally move on to the canvas and some nice drawings. This requires some magic to open a new viewer window which involves defining a widget and a few functions. A walkthrough of this code is left for another time.
(define _content '())
Scheme]
(define _bgcolor "#fdfdfd")
Scheme]
(define _canvas-zoom 100) ; Percentage
Scheme]
(define (_head)
(if show-turtle?
‘(colorize ,(turtle _posx _posy _ang (* 30 _zoom))
"dark green")
'()))
Scheme]
(define (canvas-scale)
(string-append (number->string (exact->inexact (/
_canvas-zoom 100)))
"cm"))
Scheme]
(define (logo-canvas-content content head)
‘(with "bg-color" ,_bgcolor
(document
(with
"gr-frame" (tuple "scale"
,(canvas-scale)
(tuple "0.5gw"
"0.5gh"))
"gr-geometry" (tuple "geometry"
"1par" "1par" "center")
(graphics "" ,@content ,@head)))))
Scheme]
(tm-define (refresh-canvas)
(refresh-now "logo-canvas"))
Scheme]
(tm-define (clear-canvas)
(set! _content '()))
Scheme]
(define (set-canvas-bg col)
(set! _bgcolor col)
(refresh-canvas))
Scheme]
(define (set-canvas-zoom s refresh-enum?)
(set! _canvas-zoom (min 400 (max 1 (string->number s))))
(refresh-canvas)
(if refresh-enum? (refresh-now
"logo-canvas-zoom")))
Scheme]
(tm-define (reset-canvas)
(go home)
(look north)
(clear-canvas)
(set-canvas-zoom "100" #t))
Scheme]
(define (save-canvas u)
(with file (url->unix u)
(if (!= (string-take-right file 3) ".ps")
(set! file (string-append file ".ps")))
(with t (stree->tree (logo-canvas-content _content
(_head)))
(print-snippet file t))))
Scheme]
(define (toggle-turtle show?)
(if show? (show-turtle) (hide-turtle))
(refresh-canvas))
Scheme]
(menu-bind canvas-background-color-menu
("Default" (set-canvas-bg "#fdfdfd"))
–-
(pick-background "" (set-canvas-bg answer))
–-
("Palette" (interactive-background
(lambda (col) (set-canvas-bg col)) '())))
Scheme]
(tm-widget (logo-canvas-extra) // ) ; placeholder for user
extension
Scheme]
(tm-widget (logo-canvas quit)
(resize ("400px" "800px"
"4000px") ("300px" "600px"
"4000px")
(vlist
(refreshable "logo-canvas"
(texmacs-output
(stree->tree (logo-canvas-content _content
(_head)))
'(style "generic")))
(hlist
///
(text "Background:") //
(=> (balloon (icon "tm_color.xpm")
"Change backround")
(link canvas-background-color-menu))
///
(text "Turtle:") //
(toggle (toggle-turtle answer) show-turtle?)
/// //
(text "Zoom (%):") //
(refreshable "logo-canvas-zoom"
(enum ((cut set-canvas-zoom <> #f) answer)
'("10" "20" "50"
"70" "80" "90" "100"
"150" "200" "400")
(number->string _canvas-zoom)
"4em"))
///
(dynamic (logo-canvas-extra))
>>>
(explicit-buttons
("Save" (choose-file save-canvas
"Save PostScript" "ps"))
///
("Reset" (reset-canvas)) ///
("Close" (quit)))))))
Scheme]
(tm-define (to-canvas l)
; Remember the drawing contract:
; Drawing functions such as turn that do not change _content
return '()
(cond ((nlist? l) (set! _content '()))
((== l '()))
((list? (car l)) (set! _content (append _content l)))
(else (set! _content (append _content (list l)))))
(refresh-now "logo-canvas"))
Scheme]
(tm-define (new-canvas . s)
(if (nnull? s) (set! s (car s)) (set! s "Turtle's
playground"))
(set! _content '())
(dialogue-window logo-canvas noop s))
Scheme]
The way one uses this is: first create a canvas with
We can finally test everything using
(new-canvas)
Scheme]
(to-canvas (fill (circle 2) "blue"))
Scheme]
We finally have all the tools to start crating some nice drawings. The
next function uses map to create a colorful petal.
Since on each step we want to draw two figures (a
(define (petal)
(map (lambda (x y)
(right x)
(list (colorize (forward 10) (string-append
"dark " y))
(colorize (circle 1) y)))
'(20 40 60 80 60 40)
'("red" "green" "blue"
"yellow" "orange" "magenta")))
Scheme]
(draw (petal))
Scheme]
Scheme]
With the next procedure
(define (reps fun count)
(if (and (number? count) (> count 0))
(append (fun) (reps fun (- count 1)))
'()))
Scheme]
(draw (reps petal 6))
Scheme]
Colors and iterations can turn every
(define (flip sz col)
(map (lambda (a b)
(right a)
(colorize (forward (* sz (sin (/ (* b pi) 180)))) col))
'(-30 90 -120 -90)
'(60 30 30 60)))
Scheme]
(define (biflip col1 col2 sz)
(append (flip sz col1) (flip sz col2)))
Scheme]
(define (flower col1 col2 sz)
(reps (lambda () (biflip col1 col2 sz)) 12))
Scheme]
(define (mosaic sz)
(map (lambda (col1 col2 sz)
(right 72)
(forward sz)
(flower col1 col2 sz))
'("blue" "red" "green"
"magenta" "yellow")
'("dark blue" "dark red" "dark
green" "dark magenta" "dark yellow")
'(10 10 10 10 10)))
Scheme]
(draw (mosaic 10))
Scheme]
Scheme]
Another time we'll draw some classics with our turtle.
These are left as exercise for the reader:
Replace turtle with ugly gnu with bulging eyes!
Compute the bounding box of any list to be able to stack/align arbitrary drawings.
Simplify the interface and maybe properly document it?
Create multiple canvases. Problem:
Improve the drawing window, add options, maybe add a gallery…