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 & ");";
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);
30 tracingequations := tracingonline := 1;
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) =
77 shifted -point scaled scale shifted point
82 % make a local (restored after endgroup) copy of t_var
85 def local_copy (text type, t_var) =
96 % Urgh! Want to do parametric types
99 def del_picture_stack =
100 save save_picture_stack, picture_stack_idx;
105 % better versions of Taupin/Egler savepic cmds
108 def make_picture_stack =
109 % override previous stack
111 picture save_picture_stack[];
112 numeric picture_stack_idx;
113 picture_stack_idx := 0;
115 def push_picture (expr p) =
116 save_picture_stack[picture_stack_idx] := p;
117 picture_stack_idx := picture_stack_idx + 1;
120 def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
121 def top_picture = save_picture_stack[picture_stack_idx] enddef;
127 % why can't I delete individual pens?
132 pen save_pen_stack[];
133 numeric pen_stack_idx;
135 def push_pen (expr p) =
136 save_pen_stack[pen_stack_idx] := p;
137 pen_stack_idx := pen_stack_idx + 1;
139 def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
140 def top_pen = save_pen_stack[pen_stack_idx] enddef;
145 save save_pen_stack, pen_stack_idx;
153 def soft_penstroke text t =
154 forsuffixes e = l, r:
162 ..tension1.5.. reverse path_.r
163 ..tension1.5.. cycle;
169 % Make a round path segment going from P to Q. 2*A is the angle that the
173 def simple_serif (expr p, q, a) =
174 p{dir (angle (q - p) - a)}
175 .. q{-dir (angle (p - q) + a)}
180 % Draw an axis aligned block making sure that edges are on pixels.
183 def draw_rounded_block (expr bottom_left, top_right, roundness) =
188 % Originally, there was `floor' instead of `round', but this is
189 % not correct because pens use `round' also.
190 size = round min (roundness,
191 xpart (top_right - bottom_left),
192 ypart (top_right - bottom_left));
194 z2 + (size / 2, size / 2) = top_right;
195 z4 - (size / 2, size / 2) = bottom_left;
201 pickup pencircle scaled size;
216 def draw_block (expr bottom_left, top_right) =
217 draw_rounded_block (bottom_left, top_right, blot_diameter);
221 def draw_square_block (expr bottom_left, top_right) =
224 x1 = xpart bottom_left;
225 y1 = ypart bottom_left;
226 x2 = xpart top_right;
227 y2 = ypart top_right;
237 def draw_gridline (expr bottom_left, top_right, thickness) =
238 draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
239 top_right + (thickness / 2, thickness / 2),
244 def draw_brush (expr a, w, b, v) =
252 penpos3 (w, angle (z2 - z1) + 90);
253 penpos4 (w, angle (z2 - z1));
254 penpos5 (v, angle (z1 - z2) + 90);
255 penpos6 (v, angle (z1 - z2));
268 % Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
269 % Take superness = sqrt(2)/2 to get a circle segment.
271 % See Knuth, p. 267 and p.126.
273 def super_curvelet (expr from, to, superness, dir) =
275 (superness [xpart to, xpart from],
276 superness [ypart from, ypart to]){to - from}
278 (superness [xpart from, xpart to],
279 superness [ypart to, ypart from]){to - from}
285 % Bulb with smooth inside curve.
287 % alpha = start direction
288 % beta = which side to turn to
289 % flare = diameter of the bulb
290 % line = diameter of line attachment
291 % direction = is ink on left or right side (1 or -1)
293 % Note that `currentpen' must be set correctly -- only circular pens
294 % are supported properly.
296 def flare_path (expr pos, alpha, beta, line, flare, direction) =
300 thick = pen_top + pen_bot;
304 penpos1' (line - thick, 180 + beta + alpha);
307 penpos2' (flare - thick, 180 + beta + alpha);
310 penpos3' (flare - thick, 0 + alpha);
311 rt x3'l = hround (x1'r
312 + (1/2 + 0.43) * flare * xpart dir (alpha + beta));
313 bot y2'l = vround (y1'r
314 + (1 + 0.43) * flare * ypart dir (alpha + beta));
316 rt x4' = x2'r - line * xpart dir (alpha);
317 y4' = y2'r - line * ypart dir (alpha);
319 penlabels (1', 2', 3', 4');
325 p := z1'r{dir (alpha)}
326 .. z3'r{dir (180 + alpha - beta)}
327 .. z2'l{dir (alpha + 180)}
328 .. z3'l{dir (180 + alpha + beta)}
329 ..tension t.. z4'{dir (180 + alpha + beta)}
330 .. z1'l{dir (alpha + 180)};
341 def brush (expr a, w, b, v) =
343 draw_brush (a, w, b, v);
344 penlabels (3, 4, 5, 6);
350 % Draw a (rest) crook, starting at thickness STEM in point A,
351 % ending a ball W to the left, diameter BALLDIAM.
352 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
355 def balled_crook (expr a, w, balldiam, stem) =
359 penpos1 (balldiam / 2, -90);
360 penpos2 (balldiam / 2, 0);
361 penpos3 (balldiam / 2, 90);
362 penpos4 (balldiam / 2, 180);
365 y3r = ypart a + balldiam / 4;
366 x1l = x2l = x3l = x4l;
367 y1l = y2l = y3l = y4l;
370 x5 = x4r + 9/8 balldiam;
385 penlabels (1, 2, 3, 4, 5, 6);
391 currentpicture := currentpicture yscaled -1;
393 set_char_box (charbp, charwd, charht, chardp);
398 currentpicture := currentpicture scaled -1;
400 set_char_box (charwd, charbp, charht, chardp);
405 % center_factor: typically .5; the larger, the larger the radius of the bulb
406 % radius factor: how much the bulb curves inward
409 def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
415 ang = angle (zr - zl);
417 % don't get near infinity
418 % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
419 z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
423 z1' = z0' + radius_factor * rad * dir (ang + turndir * 100);
424 z2' = z0' + rad * dir (ang + turndir * 300);
428 fill zr{dir (ang + turndir * 90)}
440 % To get symmetry at low resolutions we need to shift some points and
441 % paths, but not if mf2pt1 is used.
445 vardef hfloor primary x = x enddef;
446 vardef vfloor primary y = y enddef;
447 vardef hceiling primary x = x enddef;
448 vardef vceiling primary y = y enddef;
450 vardef hfloor primary x = floor x enddef;
451 vardef vfloor primary y = (floor y.o_)_o_ enddef;
452 vardef hceiling primary x = ceiling x enddef;
453 vardef vceiling primary y = (ceiling y.o_)_o_ enddef;