mf/feta-macros.mf

   1 %
   2 % debugging
   3 %
   4 def test_grid =
   5 if test>1:
   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);
  12 fi
  13         enddef;
  14
  15 def treq =
  16         tracingequations := tracingonline := 1;
  17 enddef;
  18
  19
  20 def draw_staff(expr first, last, offset)=
  21         pickup pencircle scaled stafflinethickness;
  22         for i:= first step 1 until last:
  23                 draw (- staff_space, (i + offset) * staff_space) .. (4 staff_space,( i+ offset)* staff_space);
  24         endfor
  25         enddef;
  26
  27
  28 %
  29 % Transforms
  30 %
  31
  32 def scaledabout(expr point, scale) =
  33         shifted -point scaled scale shifted point
  34 enddef;
  35
  36
  37 %
  38 % make a local (restored after endgroup) copy of t_var
  39 %
  40 def local_copy(text type, t_var)=
  41         save copy_temp;
  42         type copy_temp;
  43         copy_temp := t_var;
  44         save t_var;
  45         type t_var;
  46         t_var := copy_temp;
  47 enddef;
  48
  49
  50 %
  51 % Urgh! Want to do parametric types
  52 %
  53
  54 def del_picture_stack=
  55         save save_picture_stack, picture_stack_idx;
  56 enddef;
  57
  58 % better versions of Taupin/Egler savepic cmds
  59 %
  60 %
  61 def make_picture_stack =
  62         % override previous stack.
  63         del_picture_stack;
  64         picture save_picture_stack[];
  65         numeric picture_stack_idx;
  66         picture_stack_idx := 0;
  67         def push_picture(expr p) =
  68                 save_picture_stack[picture_stack_idx] := p ;
  69                 picture_stack_idx := picture_stack_idx + 1;
  70         enddef;
  71         def pop_picture =  save_picture_stack[decr picture_stack_idx] enddef;
  72         def top_picture = save_picture_stack[picture_stack_idx] enddef;
  73 enddef;
  74
  75
  76 % save/restore pens
  77 % why can't I delete individual pens?
  78 def make_pen_stack =
  79         del_pen_stack;
  80         pen save_pen_stack[];
  81         numeric pen_stack_idx;
  82         pen_stack_idx := 0;
  83         def push_pen(expr p) =
  84                 save_pen_stack[pen_stack_idx] := p ;
  85                 pen_stack_idx := pen_stack_idx +1;
  86         enddef;
  87         def pop_pen =  save_pen_stack[decr pen_stack_idx] enddef;
  88         def top_pen = save_pen_stack[pen_stack_idx] enddef;
  89 enddef;
  90 def del_pen_stack=
  91         save save_pen_stack, pen_stack_idx;
  92 enddef;
  93
  94 %
  95 % drawing
  96 %
  97
  98 def soft_penstroke text t =
  99         forsuffixes e = l,r: path_.e:=t; endfor
 100         if cycle path_.l:
 101           cyclestroke_
 102         else:
 103           fill path_.l .. tension1.5 .. reverse path_.r .. tension1.5 .. cycle
 104         fi
 105 enddef;
 106
 107
 108 %
 109 % make a round path segment going from P to Q. 2*A is the angle that the
 110 % path should take.
 111 %
 112
 113 def simple_serif(expr p,q, a)=
 114         p{dir(angle(q-p) -a)} .. q{ - dir(angle(p -q) + a)}
 115 enddef;
 116 %
 117
 118 % a: x diameter
 119 % b: y diameter
 120 % err_x: drift of y axis at top
 121 % err_y: drift of x axis at right
 122 def distorted_ellipse(expr a,b,err_y,err_x,super) =
 123         superellipse((a,err_x),(-err_y,b),(-a,-err_x),(err_y,-b),super);
 124         enddef;
 125
 126
 127
 128 %
 129 % draw an axis aligned block making sure that edges are on pixels.
 130 %
 131
 132 def draw_rounded_block (expr bottom_left, top_right, roundness) =
 133        save round;
 134        round = floor min(roundness,xpart (top_right-bottom_left),
 135                                    ypart (top_right-bottom_left));
 136
 137
 138        pickup pencircle scaled round;
 139
 140         begingroup;
 141         save x,y;
 142        z2+(round/2,round/2) = top_right;
 143        z4-(round/2,round/2) = bottom_left;
 144         y3 = y2;
 145         y4 = y1;
 146         x2 = x1;
 147         x4 = x3;
 148        fill bot z1 .. rt z1 --- rt z2 .. top z2 ---
 149             top z3 .. lft z3 --- lft z4 .. bot z4 --- cycle;
 150         endgroup;
 151         enddef;
 152
 153
 154
 155  def draw_block (expr bottom_left, top_right) =
 156        draw_rounded_block (bottom_left, top_right, blot_diameter);
 157        enddef;
 158
 159  def draw_gridline (expr bottom_left,top_right,thickness) =
 160        draw_rounded_block (bottom_left-(thickness/2,thickness/2),
 161                            top_right+(thickness/2,thickness/2),
 162                            thickness);
 163        enddef;
 164
 165
 166 def draw_brush(expr a,w,b,v) =
 167         save x,y;
 168         z1=a; z2=b;
 169         penpos3(w,angle(z2-z1)+90);
 170         penpos4(w,angle(z2-z1));
 171         penpos5(v,angle(z1-z2)+90);
 172         penpos6(v,angle(z1-z2));
 173         z3 = z4 = z1;
 174         z5 = z6 = z2;
 175
 176         fill z3r{z3r-z5l}..z4l..{z5r-z3l}z3l..z5r{z5r-z3l}..z6l..{z3r-z5l}z5l..cycle;
 177 enddef;
 178
 179
 180
 181 %
 182 % make a superellipsoid segment going from FROM to TO, with SUPERNESS.
 183 % Take superness = sqrt(2)/2 to get a circle segment
 184 %
 185 % see Knuth, p. 267 and p.126
 186 def super_curvelet(expr from, to, superness, dir) =
 187         if dir = 1:
 188          (superness [xpart to, xpart from], superness [ypart from,ypart to]){to - from}
 189         else:
 190          (superness [xpart from, xpart to], superness [ypart  to,ypart from]){to - from}
 191         fi
 192 enddef;
 193
 194
 195 %
 196 % Bulb with smooth inside curve.
 197 %
 198 % alpha = start direction.
 199 % beta = which side to turn to.
 200 % flare = diameter of the bulb
 201 % line = diameter of line attachment
 202 % direction = is ink on left or right side (1 or -1)
 203 %
 204 def flare_path(expr pos,alpha,beta,line,flare, direction) =
 205         begingroup;
 206         clearxy;
 207         penpos1(line,180+beta+alpha);
 208         z1r=pos;
 209         penpos2(flare,180+beta+alpha);
 210         z2=z3;
 211         penpos3(flare,0+alpha);
 212         z3l=z1r+(1/2+0.43)*flare*dir(alpha+beta) ;
 213         save taille;
 214         taille = 0.0;
 215         z4=z2r-  line * dir(alpha);
 216         penlabels(1,2,3,4);
 217         pickup pencircle;
 218         save t; t=0.833;
 219         save p;
 220         path p;
 221         p:=z1r{dir(alpha)}..z3r{dir(180+alpha-beta)}..z2l{dir(alpha+180)}
 222                 ..z3l{dir(180+alpha+beta)}..tension t
 223                 ..z4{dir(180+alpha+beta)}..z1l{dir(alpha+180)};
 224
 225         if direction = 1:
 226                 p
 227         else:
 228                 reverse p
 229         fi
 230         endgroup
 231         enddef;
 232
 233 def flare_path_t(expr pos,alpha,beta,line, flare, bulb, direction) =
 234         begingroup;
 235         clearxy;
 236         penpos1(line, 180+beta+alpha);
 237         z1r=pos;
 238         penpos2(bulb, 180+beta+alpha);
 239         z2=z3;
 240         penpos3(bulb, 0+alpha);
 241         save taille,roundness;
 242
 243         taille = -0.5;
 244         roundness = 0.5;
 245         z3r = z1  + flare * (dir (alpha) + dir (alpha +beta));
 246         z4=  z2r - taille * line * dir(alpha)
 247                 + roundness * line *dir (alpha - beta)
 248                 ;
 249
 250         penlabels(1,2,3,4);
 251         pickup pencircle;
 252         save t; t=0.833;
 253         save p;
 254         path p;
 255         p:=z1r{dir(alpha)}..z3r{dir(180+alpha-beta)}..z2l{dir(alpha+180)}
 256                 ..z3l{dir(180+alpha+beta)}..tension t
 257                 ..z4{dir(180+alpha+beta)}
 258                 ..z1l{dir(alpha+180)};
 259
 260         if direction = 1:
 261                 p
 262         else:
 263                 reverse p
 264         fi
 265         endgroup
 266         enddef;
 267
 268
 269 def brush(expr a,w,b,v) =
 270         begingroup;
 271         draw_brush(a,w,b,v);
 272         penlabels(3,4,5,6);
 273         endgroup;
 274 enddef;
 275
 276 %
 277 % Draw a (rest) crook, starting at thickness STEM in point A,
 278 % ending a ball W to the left, diameter BALLDIAM
 279 % ypart of the center of the ball is BALLDIAM/4 lower than ypart A
 280 %
 281 def balled_crook(expr a, w, balldiam, stem) =
 282 begingroup;
 283         save x,y;
 284         penpos1(balldiam/2,-90);
 285         penpos2(balldiam/2,0);
 286         penpos3(balldiam/2,90);
 287         penpos4(balldiam/2,180);
 288         x4r=xpart a-w; y3r=ypart a+balldiam/4;
 289         x1l=x2l=x3l=x4l;
 290         y1l=y2l=y3l=y4l;
 291         penpos5(stem,250);
 292         x5=x4r+9/8balldiam; y5r=y1r;
 293         penpos6(stem,260);
 294         x6l=xpart a; y6l=ypart a;
 295         penstroke z1e..z2e..z3e..z4e..z1e..z5e{right}..z6e;
 296         penlabels(1,2,3,4,5,6);
 297 endgroup;
 298 enddef;
 299
 300
 301 def y_mirror_char =
 302         currentpicture := currentpicture yscaled -1;
 303         set_char_box(charbp, charwd, charht, chardp);
 304 enddef;
 305
 306
 307 def xy_mirror_char =
 308         currentpicture := currentpicture scaled -1;
 309         set_char_box(charwd, charbp, charht, chardp);
 310 enddef;
 311
 312
 313 %
 314 % center_factor: typically .5, the larger, the larger the radius of the bulb
 315 % radius factor: how much the bulb curves inward
 316 %
 317 def draw_bulb(expr turndir, zl, zr, bulb_rad, radius_factor)=
 318         begingroup;
 319         clearxy;
 320         save rad, ang;
 321
 322         ang = angle(zr-zl);
 323
 324         % don't get near infinity
 325         %z0 = zr + bulb_rad * (zl-zr)/length(zr -zl);
 326         z0 = zr + bulb_rad /length(zr -zl) * (zl-zr);
 327
 328         rad =  bulb_rad;
 329
 330         z1 = z0 + radius_factor* rad * dir(ang + turndir* 100);
 331         z2 = z0 + rad * dir(ang  + turndir*300);
 332         labels(0,1,2);
 333         fill zr{dir (ang + turndir* 90)} .. z1 .. z2 -- cycle;
 334
 335         endgroup
 336 enddef;