https://soegaard.github.io/blog/metapict/

The Metapict Blog
Jens Axel Sogaard, jensaxel@soegaard.net
Contents

 1. 1 Introduction
 2. 2 Arrows
 3. 3 Regular polygons
 4. 4 Venn Diagrams
 5. 5 Simple Block Diagrams - Passes in Racket

Index
1. Introduction
This blog features small programs using Metapict to draw figures and
images. Write to Jens Axel Sogaard 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 have 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))
    [pict]


The default 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))
    [pict_2]


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))
    [pict_3]


The unit used by

ahlength

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

(px x)

to compute how large \(x\) pixels are 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))
    [pict_4]


Now, let's look closer at the default arrow head:

    > (ahlength (px 100))
    > (draw-arrow (curve (pt 0 0) -- (pt 1 0)))
    [pict_5]


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))
    [pict_6]


If you have two arrows pointing to the same point, and you feel the
overlap of the two arrow heads is two 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))
    [pict_7]


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))
    [pict_8]


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))
    [pict_9]


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)))
    [pict_10]


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)))
    [pict_11]


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))
    [pict_12]


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"))
    [pict_13]


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)))
    [pict_14]


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))
    [pict_15]


Here

(cosd d)

and

(sind d)

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

(pt@d r th)

will return the point \(P\) that that a distance \(r\) from the origo
\(O(0,0)\) and the angle between the \(x\)-axis and \(P\) will be \(th
\) 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))
    [pict_16]


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))
    [pict_17]


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, einstead 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))
    [pict_18]


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)
    [pict_19]


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))
    [pict_20]


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 are non-zero, then the point will be filled.
If we alter the orientation of the curve

c2

(the second circle) the points in intersection of the two disks will
have a zero sum - 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
    ))
    [pict_21]


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))
    [pict_22]


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))
    [pict_23]


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)
    [pict_24]


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)
    [pict_25]


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)))))
    [pict_26]


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)))
    [pict_27]


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)
    [pict_28]


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 place the next nodes relative to the node at
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)
    [pict_29]


Better, but we need some distance between neighbouring 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)
    [pict_30]


As 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 the inner
separation. This can be done with

#:inner-separation amount

when the node is created. However we need to set this for all out
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)
    [pict_31]


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)
    [pict_32]


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 setting the arrow head length with

ahlength

. The second problem is that the default gap size between labels and
edges are 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)
    [pict_33]


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)
    [pict_34]


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)
    [pict_35]


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
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
harpoon-down 2
harpoon-up 2
hook-head 2
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