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 %
  21 % Transforms
  22 %
  23
  24 def scaledabout(expr point, scale) =
  25         shifted -point scaled scale shifted point
  26 enddef;
  27
  28
  29 %
  30 % make a local (restored after endgroup) copy of t_var
  31 %
  32 def local_copy(text type, t_var)=
  33         save copy_temp;
  34         type copy_temp;
  35         copy_temp := t_var;
  36         save t_var;
  37         type t_var;
  38         t_var := copy_temp;
  39 enddef;
  40
  41
  42 %
  43 % Urgh! Want to do parametric types
  44 %
  45
  46 def del_picture_stack=
  47         save save_picture_stack, picture_stack_idx;
  48 enddef;
  49
  50 % better versions of Taupin/Egler savepic cmds
  51 %
  52 %
  53 def make_picture_stack =
  54         % override previous stack.
  55         del_picture_stack;
  56         picture save_picture_stack[];
  57         numeric picture_stack_idx;
  58         picture_stack_idx := 0;
  59         def push_picture(expr p) =
  60                 save_picture_stack[picture_stack_idx] := p ;
  61                 picture_stack_idx := picture_stack_idx + 1;
  62         enddef;
  63         def pop_picture =  save_picture_stack[decr picture_stack_idx] enddef;
  64         def top_picture = save_picture_stack[picture_stack_idx] enddef;
  65 enddef;
  66
  67
  68 % save/restore pens
  69 % why can't I delete individual pens?
  70 def make_pen_stack =
  71         del_pen_stack;
  72         pen save_pen_stack[];
  73         numeric pen_stack_idx;
  74         pen_stack_idx := 0;
  75         def push_pen(expr p) =
  76                 save_pen_stack[pen_stack_idx] := p ;
  77                 pen_stack_idx := pen_stack_idx +1;
  78         enddef;
  79         def pop_pen =  save_pen_stack[decr pen_stack_idx] enddef;
  80         def top_pen = save_pen_stack[pen_stack_idx] enddef;
  81 enddef;
  82 def del_pen_stack=
  83         save save_pen_stack, pen_stack_idx;
  84 enddef;
  85
  86 %
  87 % drawing
  88 %
  89
  90 def simple_serif(expr p,q, a)=
  91         p{dir(angle(q-p) -a)} .. q{ - dir(angle(p -q) + a)}
  92 enddef;
  93 %
  94
  95 % a: x diameter
  96 % b: y diameter
  97 % err_x: drift of y axis at top
  98 % err_y: drift of x axis at right
  99 def distorted_ellipse(expr a,b,err_y,err_x,super) =
 100         superellipse((a,err_x),(-err_y,b),(-a,-err_x),(err_y,-b),super);
 101         enddef;
 102
 103 def draw_brush(expr a,w,b,v) =
 104         save x,y;
 105         z1=a; z2=b;
 106         penpos3(w,angle(z2-z1)+90);
 107         penpos4(w,angle(z2-z1));
 108         penpos5(v,angle(z1-z2)+90);
 109         penpos6(v,angle(z1-z2));
 110         z3 = z4 = z1;
 111         z5 = z6 = z2;
 112
 113         fill z3r{z3r-z5l}..z4l..{z5r-z3l}z3l..z5r{z5r-z3l}..z6l..{z3r-z5l}z5l..cycle;
 114 enddef;
 115
 116 def brush(expr a,w,b,v) =
 117         begingroup;
 118         draw_brush(a,w,b,v);
 119         penlabels(3,4,5,6);
 120         endgroup;
 121 enddef;
 122
 123 %
 124 %
 125 %
 126 def balled_crook(expr a, w, balldiam, stem) =
 127 begingroup;
 128         save x,y;
 129         penpos1(balldiam/2,-90);
 130         penpos2(balldiam/2,0);
 131         penpos3(balldiam/2,90);
 132         penpos4(balldiam/2,180);
 133         x4r=xpart a-w; y3r=ypart a+balldiam/4;
 134         x1l=x2l=x3l=x4l;
 135         y1l=y2l=y3l=y4l;
 136         penpos5(stem,250);
 137         x5=x4r+9/8balldiam; y5r=y1r;
 138         penpos6(stem,260);
 139         x6l=xpart a; y6l=ypart a;
 140         penstroke z1e..z2e..z3e..z4e..z1e..z5e{right}..z6e;
 141         penlabels(1,2,3,4,5,6);
 142 endgroup;
 143 enddef;
 144
 145 def y_mirror_char =
 146         currentpicture := currentpicture yscaled -1;
 147         set_char_box(charbp, charwd, charht, chardp);
 148 enddef;
 149
 150
 151 def xy_mirror_char =
 152         currentpicture := currentpicture scaled -1;
 153         set_char_box(charwd, charbp, charht, chardp);
 154 enddef;
 155
 156
 157 %
 158 % center_factor: typically .5, the larger, the larger the radius of the bulb
 159 % radius factor: how much the bulb curves inward
 160 %
 161 def draw_bulb(expr turndir, zl, zr, bulb_rad, radius_factor)=
 162         begingroup;
 163         clearxy;
 164         save rad, ang;
 165
 166         ang = angle(zr-zl);
 167         z0 = zr + bulb_rad * (zl-zr)/length(zr -zl);
 168         rad =  bulb_rad;
 169
 170         z1 = z0 + radius_factor* rad * dir(ang + turndir* 100);
 171         z2 = z0 + rad * dir(ang  + turndir*300);
 172         labels(0,1,2);
 173         fill zr{dir (ang + turndir* 90)} .. z1 .. z2 -- cycle;
 174
 175         endgroup
 176 enddef;