mf/feta-accordion.mf

   1 % -*- Fundamental -*-
   2
   3 fet_begingroup ("accordion");
   4
   5
   6 %
   7 % These dimensions are the same for all register symbols.
   8 % The different symbols should calculate their other dimensions from them.
   9 %
  10
  11 accreg_dot_size# := .5 staff_space#;
  12 accreg_linethickness# := 1.3 stafflinethickness#;
  13 accreg_lh# := 1.0 staff_space#;
  14
  15 define_pixels (accreg_dot_size, accreg_linethickness, accreg_lh);
  16
  17
  18 fet_beginchar ("accDiscant", "accDiscant")
  19         save r, pat, lh, lt;
  20         path pat;
  21
  22         r# = 3/2 accreg_lh#;
  23         define_pixels (r);
  24
  25         set_char_box (r# + accreg_linethickness# / 2,
  26                       r# + accreg_linethickness# / 2,
  27                       0, 2 r# + 0.7 accreg_linethickness#);
  28
  29         lh = vround (2/3 r);
  30         lt = vround (0.7 accreg_linethickness);
  31
  32         h := 3 lh + lt;
  33         b := w := (3 lh + hround accreg_linethickness) / 2;
  34
  35         penpos1 (hround accreg_linethickness, 0);
  36         penpos2 (lt, 90);
  37         penpos3 (hround accreg_linethickness, 180);
  38         penpos4 (lt, 270);
  39
  40         z1r = (w, h / 2);
  41         z2r = (0, h);
  42         z3r = (-b, h / 2);
  43         z4r = (0, 0);
  44
  45         penlabels (1, 2, 3, 4);
  46
  47         % mf doesn't handle pixel dropouts in outline objects, so we use
  48         % `draw' if not called by mpost
  49         if known miterlimit:
  50                 penstroke z1e
  51                           .. z2e
  52                           .. z3e
  53                           .. z4e
  54                           .. cycle;
  55         else:
  56                 pickup pencircle xscaled accreg_linethickness yscaled lt;
  57                 draw z1
  58                      .. z2
  59                      .. z3
  60                      .. z4
  61                      .. cycle;
  62         fi;
  63
  64         pat := z4{right}
  65                .. z1{up}
  66                .. {left}z2;
  67
  68         pickup penrazor scaled lt rotated 90;
  69
  70         top z5 = pat intersectionpoint ((0, lh + lt) -- (w, lh + lt));
  71         z6 = z5 xscaled -1;
  72         bot z7 = pat intersectionpoint ((0, 2 lh) -- (w, 2 lh));
  73         z8 = z7 xscaled -1;
  74
  75         labels (5, 6, 7, 8);
  76
  77         draw z5
  78              -- z6;
  79         draw z7
  80              -- z8;
  81 fet_endchar;
  82
  83
  84 fet_beginchar ("accDot", "accDot")
  85         set_char_box (accreg_dot_size# / 2, accreg_dot_size# / 2,
  86                       accreg_dot_size# / 2, accreg_dot_size# / 2);
  87
  88         pickup pencircle scaled accreg_dot_size;
  89
  90         rt x0 = hround (accreg_dot_size / 2);
  91         top y0 = vround (accreg_dot_size / 2);
  92
  93         drawdot z0;
  94 fet_endchar;
  95
  96
  97 fet_beginchar ("accFreebase", "accFreebase")
  98         save r, lh, lt;
  99
 100         r# = accreg_lh#;
 101         define_pixels (r);
 102
 103         set_char_box (r# + accreg_linethickness# / 2,
 104                       r# + accreg_linethickness# / 2,
 105                       0, 2 r# + 0.7 accreg_linethickness#);
 106
 107         lh = vround r;
 108         lt = vround (0.7 accreg_linethickness);
 109
 110         h := 2 lh + lt;
 111         b := w := (2 lh + hround accreg_linethickness) / 2;
 112
 113         penpos1 (hround accreg_linethickness, 0);
 114         penpos2 (lt, 90);
 115         penpos3 (accreg_linethickness, 180);
 116         penpos4 (lt, 270);
 117
 118         z1r = (w, h / 2);
 119         z2r = (0, h);
 120         z3r = (-b, h / 2);
 121         z4r = (0, 0);
 122
 123         penlabels (1, 2, 3, 4);
 124
 125         % mf doesn't handle pixel dropouts in outline objects, so we use
 126         % `draw' if not called by mpost
 127         if known miterlimit:
 128                 penstroke z1e
 129                           .. z2e
 130                           .. z3e
 131                           .. z4e
 132                           .. cycle;
 133         else:
 134                 pickup pencircle xscaled accreg_linethickness yscaled lt;
 135                 draw z1
 136                      .. z2
 137                      .. z3
 138                      .. z4
 139                      .. cycle;
 140         fi;
 141
 142         pickup penrazor scaled lt rotated 90;
 143
 144         draw z1
 145              -- z3;
 146 fet_endchar;
 147
 148
 149 fet_beginchar ("accStdbase", "accStdbase")
 150         save r, p, lh, lt;
 151         path pat;
 152
 153         r# = 2 accreg_lh#;
 154         define_pixels (r);
 155
 156         set_char_box (r# + accreg_linethickness# / 2,
 157                       r# + accreg_linethickness# / 2,
 158                       0, 2 r# + 0.7 accreg_linethickness#);
 159
 160         lh = vround (1/2 r);
 161         lt = vround (0.7 accreg_linethickness);
 162
 163         h := 4 lh + lt;
 164         b := w := (4 lh + hround accreg_linethickness) / 2;
 165
 166         penpos1 (hround accreg_linethickness, 0);
 167         penpos2 (lt, 90);
 168         penpos3 (hround accreg_linethickness, 180);
 169         penpos4 (lt, 270);
 170
 171         z1r = (w, h / 2);
 172         z2r = (0, h);
 173         z3r = (-b, h / 2);
 174         z4r = (0, 0);
 175
 176         penlabels (1, 2, 3, 4);
 177
 178         % mf doesn't handle pixel dropouts in outline objects, so we use
 179         % `draw' if not called by mpost
 180         if known miterlimit:
 181                 penstroke z1e
 182                           .. z2e
 183                           .. z3e
 184                           .. z4e
 185                           .. cycle;
 186         else:
 187                 pickup pencircle xscaled accreg_linethickness yscaled lt;
 188                 draw z1
 189                      .. z2
 190                      .. z3
 191                      .. z4
 192                      .. cycle;
 193         fi;
 194
 195         pat := z4{right}
 196                .. z1{up}
 197                .. {left}z2;
 198
 199         pickup penrazor scaled lt rotated 90;
 200
 201         top z5 = pat intersectionpoint ((0, lh + lt) -- (w, lh + lt));
 202         z6 = z5 xscaled -1;
 203         bot z7 = pat intersectionpoint ((0, 3 lh) -- (w, 3 lh));
 204         z8 = z7 xscaled -1;
 205
 206         labels (5, 6, 7, 8);
 207
 208         draw z1
 209              -- z3;
 210         draw z5
 211              -- z6;
 212         draw z7
 213              -- z8;
 214 fet_endchar;
 215
 216
 217 fet_beginchar ("accBayanbase", "accBayanbase")
 218         save lh, lt;
 219
 220         lh = vround accreg_lh;
 221         lt = vround accreg_linethickness;
 222
 223         set_char_box (accreg_lh# + accreg_linethickness# / 2,
 224                       accreg_lh# + accreg_linethickness# / 2,
 225                       0, 3 accreg_lh# + accreg_linethickness#);
 226
 227         h := 3 lh + lt;
 228
 229         draw_rounded_block ((-w, 0), (-w + lt, h), lt);
 230         draw_rounded_block ((w - lt, 0), (w, h), lt);
 231
 232         pickup penrazor scaled lt rotated 90;
 233
 234         bot z1 = (-w + lt / 2, 0);
 235         bot z2 = (-w + lt / 2, lh);
 236         bot z3 = (-w + lt / 2, 2 lh);
 237         bot z4 = (-w + lt / 2, 3 lh);
 238
 239         bot z5 = (w - lt / 2, 0);
 240         bot z6 = (w - lt / 2, lh);
 241         bot z7 = (w - lt / 2, 2 lh);
 242         bot z8 = (w - lt / 2, 3 lh);
 243
 244         draw z1
 245              -- z5;
 246         draw z2
 247              -- z6;
 248         draw z3
 249              -- z7;
 250         draw z4
 251              -- z8;
 252 fet_endchar;
 253
 254
 255 def def_B (expr w, h) =
 256         pickup pencircle scaled 0.15 linethickness;
 257
 258         penpos10 (thin, -90);
 259         penpos11 (thin, -90);
 260         penpos12 (thick, 0);
 261         penpos13 (thin, 90);
 262         penpos14 (thin, 90);
 263
 264         penpos15 (thick, 180);
 265         penpos16 (thin, -90);
 266         penpos17 (thin, -90);
 267         penpos18 (thick, 0);
 268         penpos19 (thick, 0);
 269
 270         z10 = (0, 0);
 271         z11 = (cOne * w, 0);
 272         z12 = (w, .5 mb * h);
 273         z13 = (cTwo * w, mb * h);
 274         z14 = (2 thick, mb * h);
 275         z15 = (.94 w, h - .5 mt * h);
 276         z16 = z13 + (0, mt * h);
 277         z17 = (0, h);
 278         z18 = (1.5 thick, 0);
 279         z19 = (1.5 thick, h);
 280 enddef;
 281
 282
 283 def def_S (expr w, h) =
 284         pickup pencircle scaled 0.03 linethickness;
 285
 286         penpos1 (thin, 180);
 287         penpos2 (thin, -90);
 288         penpos3 (thick, 0);
 289         penpos4 (.5 thick, 90);
 290         penpos5 (thick, 0);
 291         penpos6 (thin, -90);
 292         penpos7 (thin, 180);
 293         penpos8 (thin, 180);
 294         penpos9 (thin, 0);
 295
 296         z1 = (0, hs);
 297         z2 = (w / 2, 0);
 298         z3 = (w - .5 thick, .5 mb * h);
 299         z4 = (w / 2, mb * h);
 300         z5 = (.5 thick, h - .5 mt * h);
 301         z6 = (w / 2, h);
 302         z7 = (w, h - hs);
 303         z8 = (0, y2r);
 304         z9 = (w, y6l);
 305
 306         path bue, bueoverst;
 307
 308         bue := z2{left}
 309                .. z1{up};
 310
 311         t := xpart (bue intersectiontimes (z8l -- z7l));
 312
 313         bueoverst := z6{right}
 314                      .. z7{down};
 315 enddef;
 316
 317
 318 def def_some_vars =
 319         save hs, mb, mt, thin, thick, height, width, cOne, cTwo;
 320         save bx, hx;
 321
 322         width = .8 (4 staff_space);
 323         height = 2.4 staff_space;
 324         % URG.  smaller sizes should be wider and fatter
 325         % thin = 0.05 staff_space;
 326         % thick = 0.2 staff_space;
 327
 328         4 hx + bx = 1.15;
 329         10 hx + bx = 1;
 330         fatten := designsize * hx + bx * 1.2;
 331         thick := 0.2 staff_space * fatten;
 332
 333         % urg: mustn't ever go thinner than blot!
 334         thin# := blot_diameter#;
 335         define_pixels (thin);
 336
 337         hs = 0.4 staff_space;
 338         mb = .53;
 339         mt = .47;
 340         cOne = 0.65;
 341         cTwo = 0.60;
 342 enddef;
 343
 344
 345 fet_beginchar ("accOldEE", "accOldEE")
 346         save r, pp, ir, lh, lt, stroke_width;
 347
 348         r# = staff_space#;
 349         define_pixels (r);
 350
 351         lr = .4 staff_space - linethickness;
 352         ir = .6 staff_space;
 353         stroke_width = .05 staff_space + .5 linethickness;
 354
 355         set_char_box (r# + accreg_linethickness# / 2,
 356                       r# + accreg_linethickness# / 2,
 357                       0, 2 r# + 0.7 accreg_linethickness#);
 358
 359         z1 = (0, 0);
 360         z2 = (0, ir);
 361
 362         penpos1 (blot_diameter, 0);
 363         penpos2 (stroke_width + blot_diameter, 0);
 364
 365         pickup pencircle scaled (lr + blot_diameter);
 366
 367         for pp := 0 step 45 until 360:
 368                 drawdot (0, 0) shifted (ir * (dir pp));
 369
 370                 penstroke (z1e
 371                            -- z2e) rotated pp;
 372         endfor;
 373
 374         pickup pencircle scaled lr;
 375
 376         drawdot (0, 0);
 377
 378         currentpicture := currentpicture shifted (0, h / 2);
 379
 380         lh = vround (2 r);
 381         lt = vround (0.7 accreg_linethickness);
 382
 383         h := lh + lt;
 384         b := w := (lh + hround accreg_linethickness) / 2;
 385
 386         penpos3 (hround accreg_linethickness, 0);
 387         penpos4 (lt, 90);
 388         penpos5 (hround accreg_linethickness, 180);
 389         penpos6 (lt, 270);
 390
 391         z3r = (w, h / 2);
 392         z4r = (0, h);
 393         z5r = (-b, h / 2);
 394         z6r = (0, 0);
 395
 396         % penlabels (1, 2, 3, 4, 5, 6);
 397
 398         % mf doesn't handle pixel dropouts in outline objects, so we use
 399         % `draw' if not called by mpost
 400         if known miterlimit:
 401                 penstroke z3e
 402                           .. z4e
 403                           .. z5e
 404                           .. z6e
 405                           .. cycle;
 406         else:
 407                 pickup pencircle xscaled accreg_linethickness yscaled lt;
 408                 draw z3
 409                      .. z4
 410                      .. z5
 411                      .. z6
 412                      .. cycle;
 413         fi;
 414
 415 fet_endchar;
 416
 417
 418 fet_endgroup ("accordion");