1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
open Mlpost
open Command
open Box
open Num
module Forms = struct
let circle = draw (circle (empty ~height:(bp 5.) ~width:(bp 5.) ()))
let rect = draw (rect (empty ~height:(bp 5.) ~width:(bp 5.) ()))
let round_rect = draw (round_rect (empty ~height:(bp 5.) ~width:(bp 5.) ()))
let ellipse = draw (ellipse (empty ~width:(bp 5.) ()))
let patatoid = draw (patatoid (empty ~height:(bp 5.) ~width:(bp 10.) ()))
let tex = draw (tex "text")
end
let brect = Box.rect (empty ~height:(bp 5.) ~width:(bp 5.) ())
module Dirs = struct
let dot p =
Command.draw ~pen:(Pen.scale (bp 4.) Pen.circle) (Path.pathp [ p ])
let ctr = seq [ draw brect; dot (ctr brect) ]
let north = seq [ draw brect; dot (north brect) ]
let south = seq [ draw brect; dot (south brect) ]
let west = seq [ draw brect; dot (west brect) ]
let east = seq [ draw brect; dot (east brect) ]
let north_west = seq [ draw brect; dot (north_west brect) ]
let south_west = seq [ draw brect; dot (south_west brect) ]
let north_east = seq [ draw brect; dot (north_east brect) ]
let south_east = seq [ draw brect; dot (south_east brect) ]
end
let cpic c = Box.pic ~stroke:None (Picture.make c)
module Size = struct
open Arrow
let head = head_triangle_full
let kind = add_foot ~head (add_head ~head (add_line empty))
let dbl_arrow =
let ar =
Arrow.point_to_point ~kind Point.origin (Point.pt (bp 10., Num.zero))
in
cpic ar
let width = Box.draw (Box.vbox [ brect; dbl_arrow ])
let height = Box.draw (Box.hbox [ Box.rotate 90. dbl_arrow; brect ])
end
module Move = struct
let fnstex s = Picture.tex (Format.sprintf "{\\footnotesize %s}" s)
let shift =
let pt = Point.pt (bp 40., bp 25.) in
let vec =
cpic
(seq
[
Arrow.point_to_point Point.origin pt;
Command.dotlabel ~pos:`Top (fnstex "pt") pt;
Command.dotlabel ~pos:`Bot (fnstex "(0,0)") Point.origin;
])
in
let b = brect in
let b' = Box.shift pt b in
let shift =
cpic
(seq
[
Box.draw b;
Box.draw b';
Arrow.point_to_point (Box.ctr b) (Box.ctr b');
])
in
Box.draw (Box.hbox [ vec; shift ])
let center =
let pt = Point.pt (bp 40., bp 25.) in
let vec =
seq
[
Arrow.point_to_point Point.origin pt;
Command.dotlabel ~pos:`Top (fnstex "pt") pt;
]
in
let b = brect in
let b' = Box.center pt b in
seq [ vec; Box.draw b; Box.draw b' ]
end
module Align = struct
let dist = 20.
let p1 = Point.p (-.dist, dist)
let p2 = Point.sub Point.origin p1
let mkb s = round_rect (tex s)
let a, b, c =
let a = mkb "A" and borig = mkb "B" and corig = mkb "C" in
let b = shift p1 borig in
let c = shift p2 corig in
(a, b, c)
let all = [ a; b; c ]
let orig = group all
let sidebyside l =
let b = group l in
let s = hbox ~padding:(Num.bp 50.) [ orig; b ] in
seq
[
draw s;
Helpers.box_arrow ~sep:(Num.bp 20.) ~within:s ~pen:Pen.circle
~color:Color.red orig b;
]
let origfig = draw orig
let halign = sidebyside (halign Num.zero all)
let hplace = sidebyside (hplace all)
let hbox = sidebyside (hbox_list all)
end
let _ = Metapost.emit "circle" Forms.circle
let _ = Metapost.emit "rect" Forms.rect
let _ = Metapost.emit "round_rect" Forms.round_rect
let _ = Metapost.emit "ellipse" Forms.ellipse
let _ = Metapost.emit "patatoid" Forms.patatoid
let _ = Metapost.emit "tex" Forms.tex
let _ = Metapost.emit "ctr" Dirs.ctr
let _ = Metapost.emit "north" Dirs.north
let _ = Metapost.emit "south" Dirs.south
let _ = Metapost.emit "west" Dirs.west
let _ = Metapost.emit "east" Dirs.east
let _ = Metapost.emit "north_west" Dirs.north_west
let _ = Metapost.emit "south_west" Dirs.south_west
let _ = Metapost.emit "north_east" Dirs.north_east
let _ = Metapost.emit "south_east" Dirs.south_east
let _ = Metapost.emit "width" Size.width
let _ = Metapost.emit "height" Size.height
let _ = Metapost.emit "shift" Move.shift
let _ = Metapost.emit "center" Move.center
let _ = Metapost.emit "halign" Align.halign
let _ = Metapost.emit "hplace" Align.hplace
let _ = Metapost.emit "hbox" Align.hbox
|
