% % debugging % def print_penpos (suffix $) = message "z" & str$ & "l = (" & decimal x.$.l & ", " &decimal y.$.l & ");" & " z" & str$ & "r = (" & decimal x.$.r & ", " & decimal y.$.r & ");"; enddef; def test_grid = if test > 1: proofrulethickness 1pt#; makegrid (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor) (0pt, 0pt for i := -5pt step 1pt until 5pt: , i endfor); proofrulethickness .1pt#; makegrid (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor) (0pt, 0pt for i := -4.8pt step .2pt until 4.8pt: , i endfor); fi; enddef; def treq = tracingequations := tracingonline := 1; enddef; def draw_staff (expr first, last, offset) = if test <> 0: pickup pencircle scaled stafflinethickness; for i := first step 1 until last: draw (-staff_space, (i + offset) * staff_space) .. (4 staff_space, (i + offset) * staff_space); endfor; fi; enddef; % % Draw the outline of the stafflines. For fine tuning. % def draw_staff_outline (expr first, last, offset) = if test <> 0: save p; path p; pickup pencircle scaled 2; for i := first step 1 until last: p := (-staff_space, (i + offset) * staff_space) .. (4 staff_space, (i + offset) * staff_space); draw p shifted (0, .5 stafflinethickness); draw p shifted (0, -.5 stafflinethickness); endfor; fi; enddef; % % Transformations % def scaledabout (expr point, scale) = shifted -point scaled scale shifted point enddef; % % make a local (restored after endgroup) copy of t_var % def local_copy (text type, t_var) = save copy_temp; type copy_temp; copy_temp := t_var; save t_var; type t_var; t_var := copy_temp; enddef; % % Urgh! Want to do parametric types % def del_picture_stack = save save_picture_stack, picture_stack_idx; enddef; % % better versions of Taupin/Egler savepic cmds % def make_picture_stack = % override previous stack del_picture_stack; picture save_picture_stack[]; numeric picture_stack_idx; picture_stack_idx := 0; def push_picture (expr p) = save_picture_stack[picture_stack_idx] := p; picture_stack_idx := picture_stack_idx + 1; enddef; def pop_picture = save_picture_stack[decr picture_stack_idx] enddef; def top_picture = save_picture_stack[picture_stack_idx] enddef; enddef; % % save/restore pens % why can't I delete individual pens? % def make_pen_stack = del_pen_stack; pen save_pen_stack[]; numeric pen_stack_idx; pen_stack_idx := 0; def push_pen (expr p) = save_pen_stack[pen_stack_idx] := p; pen_stack_idx := pen_stack_idx + 1; enddef; def pop_pen = save_pen_stack[decr pen_stack_idx] enddef; def top_pen = save_pen_stack[pen_stack_idx] enddef; enddef; def del_pen_stack= save save_pen_stack, pen_stack_idx; enddef; % % drawing % def soft_penstroke text t = forsuffixes e = l, r: path_.e := t; endfor; if cycle path_.l: cyclestroke_; else: fill path_.l ..tension1.5.. reverse path_.r ..tension1.5.. cycle; fi; enddef; % % Make a round path segment going from P to Q. 2*A is the angle that the % path should take. % def simple_serif (expr p, q, a) = p{dir (angle (q - p) - a)} .. q{-dir (angle (p - q) + a)} enddef; % % Draw an axis aligned block making sure that edges are on pixels. % def draw_rounded_block (expr bottom_left, top_right, roundness) = begingroup; save round; save x, y; round = floor min (roundness, xpart (top_right - bottom_left), ypart (top_right - bottom_left)); pickup pencircle scaled round; z2 + (round / 2, round / 2) = top_right; z4 - (round / 2, round / 2) = bottom_left; y3 = y2; y4 = y1; x2 = x1; x4 = x3; fill bot z1 .. rt z1 --- rt z2 .. top z2 --- top z3 .. lft z3 --- lft z4 .. bot z4 --- cycle; endgroup; enddef; def draw_block (expr bottom_left, top_right) = draw_rounded_block (bottom_left, top_right, blot_diameter); enddef; def draw_square_block (expr bottom_left, top_right) = save x, y; x1 = xpart bottom_left; y1 = ypart bottom_left; x2 = xpart top_right; y2 = ypart top_right; fill (x1, y1) --- (x2, y1) --- (x2, y2) --- (x1, y2) --- cycle; enddef; def draw_gridline (expr bottom_left, top_right, thickness) = draw_rounded_block (bottom_left - (thickness / 2, thickness / 2), top_right + (thickness / 2, thickness / 2), thickness); enddef; def draw_brush (expr a, w, b, v) = save x, y; z1 = a; z2 = b; z3 = z4 = z1; z5 = z6 = z2; penpos3 (w, angle (z2 - z1) + 90); penpos4 (w, angle (z2 - z1)); penpos5 (v, angle (z1 - z2) + 90); penpos6 (v, angle (z1 - z2)); fill z3r{z3r - z5l} .. z4l .. {z5r - z3l}z3l .. z5r{z5r - z3l} .. z6l .. {z3r - z5l}z5l .. cycle; enddef; % % Make a superellipsoid segment going from FROM to TO, with SUPERNESS. % Take superness = sqrt(2)/2 to get a circle segment. % % See Knuth, p. 267 and p.126. def super_curvelet (expr from, to, superness, dir) = if dir = 1: (superness [xpart to, xpart from], superness [ypart from, ypart to]){to - from} else: (superness [xpart from, xpart to], superness [ypart to, ypart from]){to - from} fi enddef; % % Bulb with smooth inside curve. % % alpha = start direction % beta = which side to turn to % flare = diameter of the bulb % line = diameter of line attachment % direction = is ink on left or right side (1 or -1) % def flare_path (expr pos, alpha, beta, line, flare, direction) = begingroup; clearxy; penpos1 (line, 180 + beta + alpha); z1r = pos; penpos2 (flare, 180 + beta + alpha); z2 = z3; penpos3 (flare, 0 + alpha); z3l = z1r + (1/2 + 0.43) * flare * dir (alpha + beta); z4 = z2r - line * dir (alpha); penlabels (1, 2, 3, 4); save t, p; t = 0.833; path p; p := z1r{dir (alpha)} .. z3r{dir (180 + alpha - beta)} .. z2l{dir (alpha + 180)} .. z3l{dir (180 + alpha + beta)} ..tension t.. z4{dir (180 + alpha + beta)} .. z1l{dir (alpha + 180)}; if direction <> 1: p := reverse p; fi; p endgroup enddef; def brush (expr a, w, b, v) = begingroup; draw_brush (a, w, b, v); penlabels (3, 4, 5, 6); endgroup; enddef; % % Draw a (rest) crook, starting at thickness STEM in point A, % ending a ball W to the left, diameter BALLDIAM. % ypart of the center of the ball is BALLDIAM/4 lower than ypart A. % def balled_crook (expr a, w, balldiam, stem) = begingroup; save x, y; penpos1 (balldiam / 2, -90); penpos2 (balldiam / 2, 0); penpos3 (balldiam / 2, 90); penpos4 (balldiam / 2, 180); x4r = xpart a - w; y3r = ypart a + balldiam / 4; x1l = x2l = x3l = x4l; y1l = y2l = y3l = y4l; penpos5 (stem, 250); x5 = x4r + 9/8 balldiam; y5r = y1r; penpos6 (stem, 260); x6l = xpart a; y6l = ypart a; penstroke z1e .. z2e .. z3e .. z4e .. z1e .. z5e{right} .. z6e; penlabels (1, 2, 3, 4, 5, 6); endgroup; enddef; def y_mirror_char = currentpicture := currentpicture yscaled -1; set_char_box (charbp, charwd, charht, chardp); enddef; def xy_mirror_char = currentpicture := currentpicture scaled -1; set_char_box (charwd, charbp, charht, chardp); enddef; % % center_factor: typically .5; the larger, the larger the radius of the bulb % radius factor: how much the bulb curves inward % def draw_bulb (expr turndir, zl, zr, bulb_rad, radius_factor)= begingroup; save rad, ang; clearxy; ang = angle (zr - zl); % don't get near infinity % z0 = zr + bulb_rad * (zl - zr) / length (zr - zl); z0' = zr + bulb_rad / length (zr - zl) * (zl - zr); rad = bulb_rad; z1' = z0' + radius_factor* rad * dir (ang + turndir * 100); z2' = z0' + rad * dir (ang + turndir * 300); labels (0', 1', 2'); fill zr{dir (ang + turndir * 90)} .. z1' .. z2' -- cycle; endgroup enddef; pi := 3.14159;