The Metapict Blog
Jens Axel Søgaard, jensaxel@soegaard.net
1. Introduction
This blog features small programs using Metapict to draw figures and images. Write to Jens Axel Søgaard at jensaxel@soegaard.net with comments and wishes for new topics.
2. Arrows
First let’s work on images of size 200x200 and let us keep the default user window which has an \(x\)-range from -1 and 1 and an \(y\)-range from -1 to 1.
> (require metapict (only-in math/base pi))
> (set-curve-pict-size 200 200)
Given a curve

c

, the form

draw-arrow

is used to draw the curve and arrow head(s). Let’s define some curves we can turn into arrows. Here

(arc C A B)

draws a circular arc from \(A\) to \(B\) with center \(C\).
> (define c1 (curve (pt 0  0) -- (pt   1   1)))
> (define c2 (curve (pt -1 1) -- (pt  -0.5 0.5)))
> (define c3 (arc (pt 0 0) (pt -1 0) (pt 1 0)))
> (draw (draw-arrow c1)
        (draw-arrow c2)
        (draw-double-arrow c3))

The default behavior is to draw an arrow head at the end of the curve. Use

draw-double-arrow

to draw arrow heads at both at the beginning and end of the curve.
The discussion below goes into detail with the shape of the default arrow head, but let’s demonstrate that there are alternative arrow heads available.
> (draw (draw-arrow c1 #:head arrow-head
                       #:tail line-head)
        (draw-arrow c2 #:head harpoon-up
                       #:tail harpoon-down)
        (draw-arrow c3 #:head hook-head
                       #:tail reverse-hook-head))

Here “ah” is short for “arrow head”. Several parameters affect the size and shape of the default arrow head. The most important is

ahlength

which holds the length of the arrowhead.
> (define (my-arrow len c)
    (parameterize ([ahlength len])
      (draw-arrow c)))
> (draw (my-arrow 0.04 c1)
        (my-arrow 0.08 c2)
        (my-arrow 0.16 c3))

The unit used by

ahlength

is user coordinates. This can at times be inconvenient, so you can use

(px x)

to compute the size of \(x\) pixels expressed in user coordinates.
> (define (my-arrow len c)
    (parameterize ([ahlength len])
      (draw-arrow c)))
> (draw (my-arrow (px  4) c1)
        (my-arrow (px  8) c2)
        (my-arrow (px 16) c3))

Now, let’s look closer at the default arrow head:
> (ahlength (px 100))
> (draw-arrow (curve (pt 0 0) -- (pt 1 0)))

The default value for the parameter

ahangle

is 45 (degrees).
Let’s try different values for the parameter

ahangle

. And to make room for several arrow heads, we will reduce the pict size.
> (set-curve-pict-size 100 100)
> (ahlength (px 50))
> (define (head angle)
    (ahangle angle)
    (draw-arrow (curve (pt 0 0) -- (pt 1 0))))
> (beside (head 20) (head 30) (head 40) (head 50) (head 60))

If you have two arrows pointing to the same point, and you feel the overlap of the two arrow heads is too large, consider using a smaller value for

ahangle

.
The parameter

ahflankangle

controls the “flank angle”. The default is 10 (degrees).
> (ahangle 45)
> (define (head angle)
    (ahflankangle angle)
    (draw-arrow (curve (pt 0 0) -- (pt 1 0))))
> (beside (head 5) (head 10) (head 15) (head 20) (head 25))

The parameter

ahtailcurvature

controls the “tail curvature”. The default is 2.
> (ahflankangle 10)
> (define (head curvature)
    (ahtailcurvature curvature)
    (draw-arrow (curve (pt 0 0) -- (pt 1 0))))
> (beside (head 2) (head 4) (head 8) (head 16) (head 32))

Finally, the parameter

ahratio

controls the size of the indentation relative to the length of the arrow head. The default value is 0.9.
> (ahtailcurvature 2)
> (define (head ratio)
    (ahratio ratio)
    (draw-arrow (curve (pt 0 0) -- (pt 1 0))))
> (beside (head 1) (head 0.9) (head 0.8) (head 0.7) (head 0.6))

We can get a boring, standard arrow head like this:
> (ahflankangle 0)
> (ahtailcurvature 0)
> (ahratio 1)
> (draw-arrow (curve (pt 0 0) -- (pt 1 0)))

Let’s set our parameters back to the default:
> (ahlength (px 4))
> (ahangle 45)
> (ahflankangle 10)
> (ahtailcurvature 2)
> (ahratio 0.89)
> (draw-arrow (curve (pt 0 0) -- (pt 1 0)))

The parameters are convenient to use to set the appearance of all arrows in a figure. If you need special values for a few arrows, then pass the settings as keyword arguments.
> (draw (draw-arrow        c1 #:length        (px 8))
        (draw-arrow        c2 #:length-ratio  1)
        (draw-double-arrow c3 #:head-angle    30))

Apropos options, let’s play with colors and filling of the arrow heads.
> (ahlength (px 8))
> (draw (draw-arrow c1 #:color "red")
        (draw-arrow c2 #:fill-head #f)
        (draw-arrow c3
                #:stem-color "blue"
                #:head-color "cyan"
                #:head-outline-color "darkgreen"))

3. Regular polygons
In this example we will see several ways of drawing regular polygons.
We begin by importing

metapict

and setting the “curve pict size”.
> (require metapict)
> (set-curve-pict-size 100 100)
When a curve is drawn by

draw

, the curve is drawn on a pict with this size. Let’s draw a little test curve to see this.
> (define (point col p)
    (color col (penwidth 8 (draw p))))
> (draw (point "red"    (pt -1  0))
        (point "violet" (pt  1  1))
        (point "blue"   (pt  0 -1))
        (curve (pt -1 0) -- (pt 1 1) -- (pt 0 -1)))

We see that the default user coordinates has an \(x\)-range \[\text{from } x_\text{min}=-1 \text{ to } x_\text{max}=1, \]and an \(y\)-range given by \[\text{from } y_\text{min}=-1 \text{ to } y_\text{max}=1. \]We will stick with this default window for now.
We can manually draw a regular polygon with \(n=3\) sides:
> (draw (color "gray" (draw (circle 1)))
        (curve    (pt 1 0)
               -- (pt (cosd 120) (sind 120))
               -- (pt (cosd 240) (sind 240))
               -- cycle))

Here

(cosd d)

and

(sind d)

computes the cosine and sine respectively to \(d\) degrees.
The function call

(pt@d r θ)

will return the point \(P\) that a distance \(r\) from the origin \(O(0,0);\) the angle between the \(x\)-axis and \(P\) will be \(θ\) degrees. The

d

in

pt@d

stands for degrees.
Using this function, we can write our example as:
> (draw (color "gray" (draw (circle 1)))
        (curve    (pt@d 1   0)
               -- (pt@d 1 120)
               -- (pt@d 1 240)
               -- cycle))

In a similar fashion we can draw a regular polygon with \(n=4\) sides:
> (draw (color "gray" (draw (circle 1)))
        (curve    (pt@d 1   0)
               -- (pt@d 1  90)
               -- (pt@d 1 180)
               -- (pt@d 1 270)
               -- cycle))

We begin to see a pattern. The points on the regular polygon with \(n\) sides can be computed like this:
> (define (regular-points n)
    (def d (/ 360 n))
    (for/list ([i n])
      (pt@d 1 (* i d))))
In order to draw the polygon, we need to add the path connector

--

between each point – and append

-- cycle

. Since

curve

is a macro, we can’t apply

curve

to our path description, instead we use the function version named

curve*

.
> (require racket/list)
> (define (regular n)
    (def ps   (regular-points n))
    (def path (append (add-between ps --)
                      (list -- cycle)))
    (curve* path))
And we can now draw a regular polygon with \(n=6\) sides:
> (draw (regular 6))

4. Venn Diagrams
In this section we are drawing Venn diagrams.
First we will set the size of the image and the window in user coordinates.
> (require metapict)
> (set-curve-pict-size 200 200)
> (def  x  10)
> (def -x (- x))
> (curve-pict-window (window -x x -x x))
Let’s begin by drawing two circles with radius 5.
> (def r 5)
> (def s (/ r 1.8))
> (def c1 (circle (pt (- s) 0) r))
> (def c2 (circle (pt    s  0) r))
> (draw c1 c2)

Now let’s pick some nice colors: The call

(color-med f color1 color2)

interpolates between the two colors.
> (def red  (color-med 0.2 "red"  "black"))
> (def blue (color-med 0.2 "blue" "black"))
> (def mag  (color-med 0.5 "red"  "blue"))
Let’s also pick a font:
> (def font (make-similar-font (new-font)
                               #:size 15
                               #:face "Arial"))
We are now ready to tackle the problem of filling the inside of both circles. The function

fill

is used to fill a curve. The pen is used for outlines and the brush is used for areas. Setting

brushcolor

will fill the inside with a solid color.
> (beside (draw (brushcolor red  (fill c1))    c1 c2)
          (draw (brushcolor blue (fill    c2)) c1 c2)
          (draw (brushcolor mag  (fill c1 c2)) c1 c2))

The rule used to determine whether a point \(P\) is in the interior:
Given a point \(P\), consider a ray from \(P\) towards infinity. For each intersection between the ray and the curve(s), determine whether the curve crosses right-to-left or left-to-right. Each right-to-left crossing counts as +1 and each left-to-right crossing as -1. If the total sum of the counts is non-zero, then the point will be filled.
If we alter the orientation of the curve

c2

(the second circle) then the points in the intersection of the two disks will sum to zero - so they won’t be filled.
We use

curve-reverse

to reverse the orientation of a curve.
> (def rev curve-reverse)
> (beside (draw (brushcolor red  (fill      c1  (rev c2)))  c1 c2)
          (draw (brushcolor blue (fill (rev c1)      c2))   c1 c2))

We want to fill the part of

c1

that lies outside

c2

with red. Now too much is filled. If we clip out the left part, we have what we need. We introduce two rectangles

left

and

right

.
> (def left  (rectangle (pt -x -x) (pt 0 x)))
> (def right (rectangle (pt  0 -x) (pt x x)))
> (beside (draw (brushcolor red  (fill      c1  (rev c2)))  c1 c2 left)
          (draw (brushcolor blue (fill (rev c1)      c2))   c1 c2 right))

The function

(clipped curve pict)

clips the part of the pict that is inside the curve.
> (def left  (rectangle (pt -x -x) (pt 0 x)))
> (def right (rectangle (pt  0 -x) (pt x x)))
> (beside (draw (clipped left  (brushcolor red  (fill      c1  (rev c2))))  c1 c2)
          (draw (clipped right (brushcolor blue (fill (rev c1)      c2)))   c1 c2))

Note that we could have used

(def left c1)

and

(def right c2)

for the clipping instead.
Anyways, combining these two parts we get:
> (draw (clipped left  (brushcolor red
                                   (fill c1 (rev c2))))
        (clipped right (brushcolor blue
                                   (fill (rev c1) c2)))
        c1 c2)

If we fill the entire figure with magenta first, and then draw these two parts on top, we get:
> (draw (brushcolor mag (fill c1 c2))
        (clipped left  (brushcolor red
                                   (fill c1 (rev c2))))
        (clipped right (brushcolor blue
                                   (fill (rev c1) c2)))
        c1 c2)

Let’s end the example by adding labels to the figure.
> (text-color "white"
    (with-font font
      (draw (brushcolor mag (fill c1 c2))
            (clipped left  (brushcolor red
                                       (fill c1 (rev c2))))
            (clipped right (brushcolor blue
                                       (fill (rev c1) c2)))
            c1 c2
            (label-cnt "A"     (pt (- r) 0))
            (label-cnt "B"     (pt    r  0))
            (label-cnt "A ∩ B" (pt    0  0)))))

Let’s try and the same with three circles.
> (require metapict racket/list)
> (set-curve-pict-size 35 35)
> (def  x  10)
> (def -x (- x))
> (curve-pict-window (window -x x -x x))
> (def red   (color-med 0.2 "red"   "white"))
> (def blue  (color-med 0.2 "blue"  "white"))
> (def green (color-med 0.2 "green" "white"))
> (def gray  (color+ (color* 0.33 red) (color+ (color* 0.33 green) (color* 0.33 blue))))
> (def mag   (color-med 0.5 "red"  "blue"))
> (def rg    (color-med 0.5 "red"  "green"))
> (def bg    (color-med 0.5 "blue" "green"))
> (def r 5)
> (def s (/ r 1.8))
> (def c1 (circle (pt (- s) 0)        r))
> (def c2 (circle (pt    s  0)        r))
> (def c3 (circle (pt    0  (* -1 r)) r))
> (def rev curve-reverse)
> (def r1 (rev c1))
> (def r2 (rev c2))
> (def r3 (rev c3))
> (define diagrams
    (for*/list ([Mag   (list mag   "white")]
                [Rg    (list rg    "white")]
                [Bg    (list bg    "white")]
                [Red   (list red   "white")]
                [Blue  (list blue  "white")]
                [Green (list green "white")]
                [Gray  (list gray  "white")])
      (draw (clipped c1 (clipped c2 (brushcolor Mag (fill c1 c2))))
            (clipped c1 (clipped c3 (brushcolor Rg  (fill c1 c3))))
            (clipped c2 (clipped c3 (brushcolor Bg  (fill c2 c3))))
            (clipped c1 (brushcolor Red   (fill c1 r2 r3)))
            (clipped c2 (brushcolor Blue  (fill c2 r1 r3)))
            (clipped c3 (brushcolor Green (fill c3 r1 r2)))
            (clipped c1 (clipped c2 (clipped c3 (brushcolor Gray (fill c1)))))
            c1 c2 c3)))
> (define (rows xs)
    (if (empty? xs)
        '()
        (cons (take xs 16)
              (rows (drop xs 16)))))
> (apply beside (apply map above (rows diagrams)))

5. Simple Block Diagrams - Passes in Racket
In this example, we will take the following diagram of the passes in Racket and turn it into a block diagram. \[\begin{align} \textrm{Source} & \xrightarrow{\texttt{read}} \textrm{Syntax Object} \\\\ & \xrightarrow{\texttt{expand}} \textrm{Syntax Object} \\\\ & \xrightarrow{\texttt{compile}} \textrm{Compiled Expression}\\\\ & \xrightarrow{\texttt{eval}} \end{align} \] Let’s make a 800 by 100 picture and set the user coordinates of the window to an \(x\)-range from 0 to 800 and the \(y\)-range from -50 to 50. With this choice we can use \(y=0\) for center position of our nodes.
> (require metapict)
> (set-curve-pict-size 800 50)
> (curve-pict-window (window 0 800 -25 25))
The block diagram consists of a number of nodes connected by arrows. We will need nodes for “Source”, “Syntax Object”, “Syntax Object” and “Compiled Expression”.
> (def n1 (rectangle-node "Source"              #:at (pt 100 0)))
> (def n2 (rectangle-node "Syntax Object"       #:at (pt 200 0)))
> (def n3 (rectangle-node "Syntax Object"       #:at (pt 300 0)))
> (def n4 (rectangle-node "Compiled Expression" #:at (pt 400 0)))
> (draw n1 n2 n3 n4)

You can use

#:below

,

#:above

,

#:right-of

and

#:left-of

to place nodes.
This doesn’t look too good – the nodes are drawn on top of each other. Instead of manually placing all nodes, let’s just place the first node and then place each following node relative to the node on its left.
> (def n1 (rectangle-node "Source"              #:at (pt 100 0)))
> (def n2 (rectangle-node "Syntax Object"       #:right-of n1))
> (def n3 (rectangle-node "Syntax Object"       #:right-of n2))
> (def n4 (rectangle-node "Compiled Expression" #:right-of n3))
> (draw n1 n2 n3 n4)

Better, but we need some distance between neighboring nodes.
> (current-neighbour-distance 70)
> (def n1 (rectangle-node "Source"              #:at (pt 100 0)))
> (def n2 (rectangle-node "Syntax Object"       #:right-of n1))
> (def n3 (rectangle-node "Syntax Object"       #:right-of n2))
> (def n4 (rectangle-node "Compiled Expression" #:right-of n3))
> (draw n1 n2 n3 n4)

By default the rectangular path of a rectangle node is drawn with no separation between the path and its contents. This looks cramped, when the contents is a text, so we need to increase that inner separation. This can be done with

#:inner-separation amount

when the node is created. However we need to set this for all our nodes, so instead we set the parameter

current-inner-separation

.
> (current-neighbour-distance 70)
> (current-inner-separation    3)
> (def n1 (rectangle-node "Source"              #:at (pt 50 0)))
> (def n2 (rectangle-node "Syntax Object"       #:right-of n1))
> (def n3 (rectangle-node "Syntax Object"       #:right-of n2))
> (def n4 (rectangle-node "Compiled Expression" #:right-of n3))
> (draw n1 n2 n3 n4)

It is now time to add edges between the nodes.
> (def e1 (edge n1 n2 #:label "read"))
> (def e2 (edge n2 n3 #:label "expand"))
> (def e3 (edge n3 n4 #:label "compile"))
> (draw n1 n2 n3 n4
        e1 e2 e3)

To set set the label gap size for a single edge, you can use the keyword arguement

#:label-gap

.
We see at least two problems: the arrow head size is so small, we can’t see it – and the labels are placed on top of the edges. The first problem is fixed by setting the arrow head length with

ahlength

. The second problem is that the default gap size between labels and edges is too small, so we set the parameter

current-label-gap

.
> (ahlength (px 4))
> (current-label-gap (px 4))
> (def e1 (edge n1 n2 #:label "read"))
> (def e2 (edge n2 n3 #:label "expand"))
> (def e3 (edge n3 n4 #:label "compile"))
> (draw n1 n2 n3 n4
        e1 e2 e3)

The astute reader has noticed that we are missing the last edge. The last edge needs an end node, so we make an “invisible” node (a text node that shows the empty string).
> (def n5 (text-node "" #:right-of n4))
> (def e4 (edge n4 n5 #:label "eval"))
> (draw n1 n2 n3 n4
        e1 e2 e3 e4)

The full example is:
> (require metapict)
> (set-curve-pict-size 800 50)
> (curve-pict-window (window 0 800 -25 25))
> (ahlength (px 4))
> (current-label-gap (px 4))
> (current-neighbour-distance 70)
> (current-inner-separation    3)
> (def n1 (rectangle-node "Source"              #:at (pt 50 0)))
> (def n2 (rectangle-node "Syntax Object"       #:right-of n1))
> (def n3 (rectangle-node "Syntax Object"       #:right-of n2))
> (def n4 (rectangle-node "Compiled Expression" #:right-of n3))
> (def n5 (text-node "" #:right-of n4))
> (def e1 (edge n1 n2 #:label "read"))
> (def e2 (edge n2 n3 #:label "expand"))
> (def e3 (edge n3 n4 #:label "compile"))
> (def e4 (edge n4 n5 #:label "eval"))
> (draw n1 n2 n3 n4
        e1 e2 e3 e4)

6. Clock
In this section, we will draw an analog clock with a clock face and hands.
Let’s begin with a circle centered in \((0,0)\) and an outer radius \(R=100\).
> (require metapict)
> (set-curve-pict-size 610 210)
> (curve-pict-window (window -305 305 -105 105))
> (def R 100)
> (penwidth 4 (draw (circle R)))

Along this circle we will make a mark for every 12 minutes. The hour marks will be slightly larger. When arguments are named \(d\), they will be in degrees. To make later drawings simpler, we let \(d\) denote the angle measured from 12 \(o'clock\) in clock-wise direction. The helper function

point

computes the point on the outer that corresponds to a clock angle \(d\).
> (def (clock-angle-to-standard-angle d)
    (- 90 d))
> (def (point radius d)
    (pt@d radius (clock-angle-to-standard-angle d)))
> (def (hour-mark d)
    (draw (curve (point R d) -- (point (- R 10) d))))
> (def (12-minute-mark d)
    (draw (curve (point R d) -- (point (- R 5) d))))
> (def minutes-in-half-day (* 12 60))
> (def minute-angle     (/ 360 minutes-in-half-day))
> (def 12-minute-angle  (* 12 minute-angle))
> (def hour-angle       (* 60 minute-angle))
> (draw (penwidth 4 (draw (circle R)))
        (for/draw ([d (in-range 0 360 12-minute-angle)])
          (if (zero? (remainder d hour-angle))
              (hour-mark d)
              (12-minute-mark d))))

Now we need to add the numbers.
> (require racket/format)
> (def (hour-label d)
    (def hours (/ d hour-angle))
    (~a (if (zero? hours) 12 hours)))
> (draw (penwidth 4 (draw (circle R)))
        (for/draw ([d (in-range 0 360 12-minute-angle)])
          (if (zero? (remainder d hour-angle))
              (draw (hour-mark d)
                    (label-cnt (hour-label d) (point (- R 20) d)))
              (12-minute-mark d))))

Finally, let’s add the hands.
> (ahlength 16)
> (def (hour-hand hours)
    (def d (* hours hour-angle))
    (penwidth 4 (draw-arrow (curve (pt 0 0) -- (point (- R 60) d)))))
> (def (minute-hand minutes)
    (def d (* minutes minute-angle))
    (penwidth 2 (draw-arrow (curve (pt 0 0) -- (point (- R 28) d)))))
> (draw (penwidth 4 (draw (circle R)))
        (for/draw ([d (in-range 0 360 12-minute-angle)])
          (if (zero? (remainder d hour-angle))
              (draw (hour-mark d)
                    (label-cnt (hour-label d) (point (- R 20) d)))
              (12-minute-mark d)))
        (hour-hand 2)
        (minute-hand 30))

Index
ahangle 2
ahflankangle 2
ahlength 2
ahratio 2
ahtailcurvature 2
arrow-head 2
Arrows 2
block diagram 5
brushcolor 4
circle 4
clipped 4
clock 6
color-med 4
cosd 3
curve* 3
curve-reverse 4
diagram, block 5
diagram, Venn 4
draw-arrow 2
draw-double-arrow 2
edge 5
fill 4
hand 6
harpoon-down 2
harpoon-up 2
hook-head 2
label-cnt 6
line-head 2
make-similar-font 4
new-font 4
node 5
polygon, regular 3
pt@d 3
regular polygon 3
reverse-hook-head 2
set-curve-pict-size 2
sind 3
Venn diagram 4