5
def print_penpos (suffix $) =
7
"z" & str$ & "l = (" & decimal x.$.l & ", " &decimal y.$.l & ");"
8
& " z" & str$ & "r = (" & decimal x.$.r & ", " & decimal y.$.r & ");";
6
proofrulethickness 1pt#;
7
makegrid(0pt,0pt for i:=-5pt step 1pt until 5pt: ,i endfor)
8
(0pt,0pt for i:=-5pt step 1pt until 5pt: ,i endfor);
9
proofrulethickness .1pt#;
10
makegrid(0pt,0pt for i:=-4.8pt step .2pt until 4.8pt: ,i endfor)
11
(0pt,0pt for i:=-4.8pt step .2pt until 4.8pt: ,i endfor);
14
proofrulethickness 1pt#;
17
(0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor)
18
(0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor);
20
proofrulethickness .1pt#;
23
(0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor)
24
(0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor);
16
30
tracingequations := tracingonline := 1;
20
def draw_staff(expr first, last, offset)=
22
pickup pencircle scaled stafflinethickness;
23
for i:= first step 1 until last:
24
draw (- staff_space, (i + offset) * staff_space) .. (4 staff_space,( i+ offset)* staff_space);
30
% draw the outline of the stafflines. For fine tuning.
31
def draw_staff_outline(expr first, last, offset)=
35
pickup pencircle scaled 2;
36
for i:= first step 1 until last:
37
p := (- staff_space, (i + offset) * staff_space) .. (4 staff_space,( i+ offset)* staff_space);
39
draw p shifted (0, .5 stafflinethickness);
40
draw p shifted (0, -.5 stafflinethickness);
50
def scaledabout(expr point, scale) =
34
def draw_staff (expr first, last, offset) =
36
pickup pencircle scaled stafflinethickness;
38
for i := first step 1 until last:
40
(i + offset) * staff_space_rounded)
42
(i + offset) * staff_space_rounded);
49
% Draw the outline of the stafflines. For fine tuning.
52
def draw_staff_outline (expr first, last, offset) =
57
pickup pencircle scaled 2;
59
for i := first step 1 until last:
61
(i + offset) * staff_space_rounded)
63
(i + offset) * staff_space_rounded);
65
draw p shifted (0, .5 stafflinethickness);
66
draw p shifted (0, -.5 stafflinethickness);
76
def scaledabout (expr point, scale) =
51
77
shifted -point scaled scale shifted point
56
% make a local (restored after endgroup) copy of t_var
82
% make a local (restored after endgroup) copy of t_var
58
def local_copy(text type, t_var)=
85
def local_copy (text type, t_var) =
61
88
copy_temp := t_var;
69
96
% Urgh! Want to do parametric types
72
def del_picture_stack=
99
def del_picture_stack =
73
100
save save_picture_stack, picture_stack_idx;
76
105
% better versions of Taupin/Egler savepic cmds
79
def make_picture_stack =
80
% override previous stack.
108
def make_picture_stack =
109
% override previous stack
81
110
del_picture_stack;
82
111
picture save_picture_stack[];
83
112
numeric picture_stack_idx;
84
113
picture_stack_idx := 0;
85
def push_picture(expr p) =
86
save_picture_stack[picture_stack_idx] := p ;
115
def push_picture (expr p) =
116
save_picture_stack[picture_stack_idx] := p;
87
117
picture_stack_idx := picture_stack_idx + 1;
89
def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
120
def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
90
121
def top_picture = save_picture_stack[picture_stack_idx] enddef;
94
126
% save/restore pens
95
127
% why can't I delete individual pens?
96
130
def make_pen_stack =
98
132
pen save_pen_stack[];
99
133
numeric pen_stack_idx;
100
134
pen_stack_idx := 0;
101
def push_pen(expr p) =
102
save_pen_stack[pen_stack_idx] := p ;
103
pen_stack_idx := pen_stack_idx +1;
135
def push_pen (expr p) =
136
save_pen_stack[pen_stack_idx] := p;
137
pen_stack_idx := pen_stack_idx + 1;
105
def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
139
def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
106
140
def top_pen = save_pen_stack[pen_stack_idx] enddef;
109
145
save save_pen_stack, pen_stack_idx;
116
153
def soft_penstroke text t =
117
forsuffixes e = l,r: path_.e:=t; endfor
121
fill path_.l .. tension1.5 .. reverse path_.r .. tension1.5 .. cycle
154
forsuffixes e = l, r:
162
..tension1.5.. reverse path_.r
163
..tension1.5.. cycle;
168
def soft_start_penstroke text t =
169
forsuffixes e = l, r:
178
..tension1.5.. cycle;
183
def soft_end_penstroke text t =
184
forsuffixes e = l, r:
192
..tension1.5.. reverse path_.r
127
% make a round path segment going from P to Q. 2*A is the angle that the
199
% Make a round path segment going from P to Q. 2*A is the angle that the
128
200
% path should take.
131
def simple_serif(expr p,q, a)=
132
p{dir(angle(q-p) -a)} .. q{ - dir(angle(p -q) + a)}
203
def simple_serif (expr p, q, a) =
204
p{dir (angle (q - p) - a)}
205
.. q{-dir (angle (p - q) + a)}
137
% draw an axis aligned block making sure that edges are on pixels.
210
% Draw an axis aligned block making sure that edges are on pixels.
140
213
def draw_rounded_block (expr bottom_left, top_right, roundness) =
142
round = floor min(roundness,xpart (top_right-bottom_left),
143
ypart (top_right-bottom_left));
146
pickup pencircle scaled round;
150
z2+(round/2,round/2) = top_right;
151
z4-(round/2,round/2) = bottom_left;
156
fill bot z1 .. rt z1 --- rt z2 .. top z2 ---
157
top z3 .. lft z3 --- lft z4 .. bot z4 --- cycle;
163
def draw_block (expr bottom_left, top_right) =
164
draw_rounded_block (bottom_left, top_right, blot_diameter);
167
def draw_square_block (expr bottom_left, top_right) =
218
% Originally, there was `floor' instead of `round', but this is
219
% not correct because pens use `round' also.
220
size = round min (roundness,
221
xpart (top_right - bottom_left),
222
ypart (top_right - bottom_left));
224
z2 + (size / 2, size / 2) = top_right;
225
z4 - (size / 2, size / 2) = bottom_left;
231
pickup pencircle scaled size;
246
def draw_block (expr bottom_left, top_right) =
247
draw_rounded_block (bottom_left, top_right, blot_diameter);
251
def draw_square_block (expr bottom_left, top_right) =
169
254
x1 = xpart bottom_left;
170
255
y1 = ypart bottom_left;
171
256
x2 = xpart top_right;
172
257
y2 = ypart top_right;
175
fill (x1,y1) --- (x2,y1) --- (x2,y2) --- (x1,y2) --- cycle;
179
def draw_gridline (expr bottom_left,top_right,thickness) =
180
draw_rounded_block (bottom_left-(thickness/2,thickness/2),
181
top_right+(thickness/2,thickness/2),
186
def draw_brush(expr a,w,b,v) =
189
penpos3(w,angle(z2-z1)+90);
190
penpos4(w,angle(z2-z1));
191
penpos5(v,angle(z1-z2)+90);
192
penpos6(v,angle(z1-z2));
267
def draw_gridline (expr bottom_left, top_right, thickness) =
268
draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
269
top_right + (thickness / 2, thickness / 2),
274
def draw_brush (expr a, w, b, v) =
196
fill z3r{z3r-z5l}..z4l..{z5r-z3l}z3l..z5r{z5r-z3l}..z6l..{z3r-z5l}z5l..cycle;
282
penpos3 (w, angle (z2 - z1) + 90);
283
penpos4 (w, angle (z2 - z1));
284
penpos5 (v, angle (z1 - z2) + 90);
285
penpos6 (v, angle (z1 - z2));
298
% Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
299
% Take superness = sqrt(2)/2 to get a circle segment.
301
% See Knuth, p. 267 and p.126.
202
% make a superellipsoid segment going from FROM to TO, with SUPERNESS.
203
% Take superness = sqrt(2)/2 to get a circle segment
205
% see Knuth, p. 267 and p.126
206
def super_curvelet(expr from, to, superness, dir) =
303
def super_curvelet (expr from, to, superness, dir) =
208
(superness [xpart to, xpart from], superness [ypart from,ypart to]){to - from}
305
(superness [xpart to, xpart from],
306
superness [ypart from, ypart to]){to - from}
210
(superness [xpart from, xpart to], superness [ypart to,ypart from]){to - from}
308
(superness [xpart from, xpart to],
309
superness [ypart to, ypart from]){to - from}
216
315
% Bulb with smooth inside curve.
218
% alpha = start direction.
219
% beta = which side to turn to.
317
% alpha = start direction
318
% beta = which side to turn to
220
319
% flare = diameter of the bulb
221
320
% line = diameter of line attachment
222
321
% direction = is ink on left or right side (1 or -1)
224
def flare_path(expr pos,alpha,beta,line,flare, direction) =
323
% Note that `currentpen' must be set correctly -- only circular pens
324
% are supported properly.
326
def flare_path (expr pos, alpha, beta, line, flare, direction) =
330
thick = pen_top + pen_bot;
227
penpos1(line,180+beta+alpha);
229
penpos2(flare,180+beta+alpha);
231
penpos3(flare,0+alpha);
232
z3l=z1r+(1/2+0.43)*flare*dir(alpha+beta) ;
235
z4=z2r- line * dir(alpha);
334
penpos1' (line - thick, 180 + beta + alpha);
337
penpos2' (flare - thick, 180 + beta + alpha);
340
penpos3' (flare - thick, 0 + alpha);
341
rt x3'l = hround (x1'r
342
+ (1/2 + 0.43) * flare * xpart dir (alpha + beta));
343
bot y2'l = vround (y1'r
344
+ (1 + 0.43) * flare * ypart dir (alpha + beta));
346
rt x4' = x2'r - line * xpart dir (alpha);
347
y4' = y2'r - line * ypart dir (alpha);
349
penlabels (1', 2', 3', 4');
241
p:=z1r{dir(alpha)}..z3r{dir(180+alpha-beta)}..z2l{dir(alpha+180)}
242
..z3l{dir(180+alpha+beta)}..tension t
243
..z4{dir(180+alpha+beta)}..z1l{dir(alpha+180)};
255
def brush(expr a,w,b,v) =
355
p := z1'r{dir (alpha)}
356
.. z3'r{dir (180 + alpha - beta)}
357
.. z2'l{dir (alpha + 180)}
358
.. z3'l{dir (180 + alpha + beta)}
359
..tension t.. z4'{dir (180 + alpha + beta)}
360
.. z1'l{dir (alpha + 180)};
371
def brush (expr a, w, b, v) =
373
draw_brush (a, w, b, v);
374
penlabels (3, 4, 5, 6);
263
380
% Draw a (rest) crook, starting at thickness STEM in point A,
264
% ending a ball W to the left, diameter BALLDIAM
265
% ypart of the center of the ball is BALLDIAM/4 lower than ypart A
381
% ending a ball W to the left, diameter BALLDIAM.
382
% ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
267
def balled_crook(expr a, w, balldiam, stem) =
385
def balled_crook (expr a, w, balldiam, stem) =
270
penpos1(balldiam/2,-90);
271
penpos2(balldiam/2,0);
272
penpos3(balldiam/2,90);
273
penpos4(balldiam/2,180);
274
x4r=xpart a-w; y3r=ypart a+balldiam/4;
278
x5=x4r+9/8balldiam; y5r=y1r;
280
x6l=xpart a; y6l=ypart a;
281
penstroke z1e..z2e..z3e..z4e..z1e..z5e{right}..z6e;
282
penlabels(1,2,3,4,5,6);
389
penpos1 (balldiam / 2, -90);
390
penpos2 (balldiam / 2, 0);
391
penpos3 (balldiam / 2, 90);
392
penpos4 (balldiam / 2, 180);
395
y3r = ypart a + balldiam / 4;
396
x1l = x2l = x3l = x4l;
397
y1l = y2l = y3l = y4l;
400
x5 = x4r + 9/8 balldiam;
415
penlabels (1, 2, 3, 4, 5, 6);
287
420
def y_mirror_char =
288
421
currentpicture := currentpicture yscaled -1;
289
set_char_box(charbp, charwd, charht, chardp);
423
set_char_box (charbp, charwd, charht, chardp);
293
427
def xy_mirror_char =
294
428
currentpicture := currentpicture scaled -1;
295
set_char_box(charwd, charbp, charht, chardp);
430
set_char_box (charwd, charbp, charht, chardp);
300
% center_factor: typically .5, the larger, the larger the radius of the bulb
435
% center_factor: typically .5; the larger, the larger the radius of the bulb
301
436
% radius factor: how much the bulb curves inward
303
def draw_bulb(expr turndir, zl, zr, bulb_rad, radius_factor)=
439
def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
446
ang = angle (zr - zl);
310
448
% don't get near infinity
311
%z0 = zr + bulb_rad * (zl-zr)/length(zr -zl);
312
z0 = zr + bulb_rad /length(zr -zl) * (zl-zr);
316
z1 = z0 + radius_factor* rad * dir(ang + turndir* 100);
317
z2 = z0 + rad * dir(ang + turndir*300);
319
fill zr{dir (ang + turndir* 90)} .. z1 .. z2 -- cycle;
449
% z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
450
z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
454
z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
455
z2' = z0' + rad * dir (ang + turndir * 300);
459
pat = zr{dir (ang + turndir * 90)}
464
% avoid grazing outlines
465
fill subpath (0, 2.5) of pat
475
% To get symmetry at low resolutions we need to shift some points and
476
% paths, but not if mf2pt1 is used.
480
vardef hfloor primary x = x enddef;
481
vardef vfloor primary y = y enddef;
482
vardef hceiling primary x = x enddef;
483
vardef vceiling primary y = y enddef;
485
vardef hfloor primary x = floor x enddef;
486
vardef vfloor primary y = (floor y.o_)_o_ enddef;
487
vardef hceiling primary x = ceiling x enddef;
488
vardef vceiling primary y = (ceiling y.o_)_o_ enddef;
added
removed
mf/feta-macros.mf
