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:
39 draw (-staff_space, (i + offset) * staff_space)
40 .. (4 staff_space, (i + offset) * staff_space);
47 % Draw the outline of the stafflines. For fine tuning.
50 def draw_staff_outline (expr first, last, offset) =
55 pickup pencircle scaled 2;
57 for i := first step 1 until last:
58 p := (-staff_space, (i + offset) * staff_space)
59 .. (4 staff_space, (i + offset) * staff_space);
61 draw p shifted (0, .5 stafflinethickness);
62 draw p shifted (0, -.5 stafflinethickness);
72 def scaledabout (expr point, scale) =
73 shifted -point scaled scale shifted point
78 % make a local (restored after endgroup) copy of t_var
81 def local_copy (text type, t_var) =
92 % Urgh! Want to do parametric types
95 def del_picture_stack =
96 save save_picture_stack, picture_stack_idx;
101 % better versions of Taupin/Egler savepic cmds
104 def make_picture_stack =
105 % override previous stack
107 picture save_picture_stack[];
108 numeric picture_stack_idx;
109 picture_stack_idx := 0;
111 def push_picture (expr p) =
112 save_picture_stack[picture_stack_idx] := p;
113 picture_stack_idx := picture_stack_idx + 1;
116 def pop_picture = save_picture_stack[decr picture_stack_idx] enddef;
117 def top_picture = save_picture_stack[picture_stack_idx] enddef;
123 % why can't I delete individual pens?
128 pen save_pen_stack[];
129 numeric pen_stack_idx;
131 def push_pen (expr p) =
132 save_pen_stack[pen_stack_idx] := p;
133 pen_stack_idx := pen_stack_idx + 1;
135 def pop_pen = save_pen_stack[decr pen_stack_idx] enddef;
136 def top_pen = save_pen_stack[pen_stack_idx] enddef;
141 save save_pen_stack, pen_stack_idx;
149 def soft_penstroke text t =
150 forsuffixes e = l, r:
158 ..tension1.5.. reverse path_.r
159 ..tension1.5.. cycle;
165 % Make a round path segment going from P to Q. 2*A is the angle that the
169 def simple_serif (expr p, q, a) =
170 p{dir (angle (q - p) - a)}
171 .. q{-dir (angle (p - q) + a)}
176 % Draw an axis aligned block making sure that edges are on pixels.
179 def draw_rounded_block (expr bottom_left, top_right, roundness) =
184 round = floor min (roundness,
185 xpart (top_right - bottom_left),
186 ypart (top_right - bottom_left));
188 pickup pencircle scaled round;
190 z2 + (round / 2, round / 2) = top_right;
191 z4 - (round / 2, round / 2) = bottom_left;
210 def draw_block (expr bottom_left, top_right) =
211 draw_rounded_block (bottom_left, top_right, blot_diameter);
215 def draw_square_block (expr bottom_left, top_right) =
218 x1 = xpart bottom_left;
219 y1 = ypart bottom_left;
220 x2 = xpart top_right;
221 y2 = ypart top_right;
231 def draw_gridline (expr bottom_left, top_right, thickness) =
232 draw_rounded_block (bottom_left - (thickness / 2, thickness / 2),
233 top_right + (thickness / 2, thickness / 2),
238 def draw_brush (expr a, w, b, v) =
246 penpos3 (w, angle (z2 - z1) + 90);
247 penpos4 (w, angle (z2 - z1));
248 penpos5 (v, angle (z1 - z2) + 90);
249 penpos6 (v, angle (z1 - z2));
262 % Make a superellipsoid segment going from FROM to TO, with SUPERNESS.
263 % Take superness = sqrt(2)/2 to get a circle segment.
265 % See Knuth, p. 267 and p.126.
267 def super_curvelet (expr from, to, superness, dir) =
269 (superness [xpart to, xpart from],
270 superness [ypart from, ypart to]){to - from}
272 (superness [xpart from, xpart to],
273 superness [ypart to, ypart from]){to - from}
279 % Bulb with smooth inside curve.
281 % alpha = start direction
282 % beta = which side to turn to
283 % flare = diameter of the bulb
284 % line = diameter of line attachment
285 % direction = is ink on left or right side (1 or -1)
288 def flare_path (expr pos, alpha, beta, line, flare, direction) =
292 penpos1 (line, 180 + beta + alpha);
295 penpos2 (flare, 180 + beta + alpha);
298 penpos3 (flare, 0 + alpha);
299 z3l = z1r + (1/2 + 0.43) * flare * dir (alpha + beta);
301 z4 = z2r - line * dir (alpha);
303 penlabels (1, 2, 3, 4);
309 p := z1r{dir (alpha)}
310 .. z3r{dir (180 + alpha - beta)}
311 .. z2l{dir (alpha + 180)}
312 .. z3l{dir (180 + alpha + beta)}
313 ..tension t.. z4{dir (180 + alpha + beta)}
314 .. z1l{dir (alpha + 180)};
325 def brush (expr a, w, b, v) =
327 draw_brush (a, w, b, v);
328 penlabels (3, 4, 5, 6);
334 % Draw a (rest) crook, starting at thickness STEM in point A,
335 % ending a ball W to the left, diameter BALLDIAM.
336 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A.
339 def balled_crook (expr a, w, balldiam, stem) =
343 penpos1 (balldiam / 2, -90);
344 penpos2 (balldiam / 2, 0);
345 penpos3 (balldiam / 2, 90);
346 penpos4 (balldiam / 2, 180);
349 y3r = ypart a + balldiam / 4;
350 x1l = x2l = x3l = x4l;
351 y1l = y2l = y3l = y4l;
354 x5 = x4r + 9/8 balldiam;
369 penlabels (1, 2, 3, 4, 5, 6);
375 currentpicture := currentpicture yscaled -1;
377 set_char_box (charbp, charwd, charht, chardp);
382 currentpicture := currentpicture scaled -1;
384 set_char_box (charwd, charbp, charht, chardp);
389 % center_factor: typically .5; the larger, the larger the radius of the bulb
390 % radius factor: how much the bulb curves inward
393 def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)=
399 ang = angle (zr - zl);
401 % don't get near infinity
402 % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl);
403 z0' = zr + bulb_rad / length (zr - zl) * (zl - zr);
407 z1' = z0' + radius_factor* rad * dir (ang + turndir * 100);
408 z2' = z0' + rad * dir (ang + turndir * 300);
412 fill zr{dir (ang + turndir * 90)}