mf/xgreggen.mf

   1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   2 %  this is xgreggen.mf (c)
   3 %
   4 %  Version T.63 [October 96]
   5 %
   6
   7 nhw#:=1.2*nhh#;
   8
   9 thin#:=1/50designsize;
  10 med#:=1/33designsize;
  11 thick#:=1/16designsize;
  12
  13 thinwidth := 0.125pt;
  14 beamht#:=0.48nhh#;
  15 %gregwidth#:=0.5*sqrt(2)*nhh#;
  16 gregwidth#:=0.6*nhh#;
  17 smallgreg:=0.5;
  18
  19 define_pixels(nhh,nhw,beamht,gregwidth);
  20 define_blacker_pixels(thin,med,thick);
  21
  22 pair ne,se,sw,nw; %northeast,southeast,southwest,northwest
  23 ne = up+right; se = down+right; sw = down+left; nw = up+left;
  24
  25 font_x_height nhh#;
  26 font_quad nhw#;
  27
  28 pair pone, ptwo;
  29 transform t;
  30 path p;
  31
  32 hlthick=.2pt;
  33 lthick=.4pt;
  34
  35 greglangle:=18; gregrlangle:=180+greglangle;
  36 greguangle:=26; gregruangle:=180+greguangle;
  37 orisuangle:=40; orisruangle:=180+orisuangle;
  38
  39 diamwidth:=.96 gregwidth; greg_min_diam:=gregwidth-diamwidth;
  40 diamheight:=1.33 gregwidth;
  41 deminutae:=0.6; gregwidth_dem:=gregwidth*deminutae;
  42 aucta_fact:=0.33gregwidth;
  43 shave:=.3gregwidth;
  44
  45 pen line_pen, med_pen, coda_pen, thin_pen;
  46 med_pen:= pencircle scaled med;
  47 line_pen:= pencircle scaled lthick;
  48 coda_pen:= pencircle xscaled 1.25thick yscaled max(1,.75med);
  49 thin_pen:= pencircle scaled max(1,.25pt);
  50
  51 picture save_pic, elem_pic;
  52
  53 %%%%%%%%%%%%%%%
  54 % basic def's %
  55 %%%%%%%%%%%%%%%
  56
  57 def savepic = save_pic:= currentpicture enddef;
  58 def save_elempic = elem_pic:= currentpicture enddef;
  59 def callpic = currentpicture:= save_pic enddef;
  60
  61 def mirror (expr pone, ptwo) =
  62   currentpicture:=currentpicture reflectedabout(round(pone),round(ptwo))
  63 enddef;
  64
  65 def add_mirror (expr pone, ptwo) =
  66   addto currentpicture also currentpicture
  67         reflectedabout (round(pone), round(ptwo))
  68 enddef;
  69
  70 def call_mirror (expr pone, ptwo) = callpic; mirror (pone, ptwo) enddef;
  71
  72 def add_shift (expr pone, ptwo) =
  73   addto currentpicture also currentpicture shifted (pone, ptwo)
  74 enddef;
  75
  76 def call_add_shift (expr pone, ptwo) =
  77   callpic; add_shift (pone, ptwo)
  78 enddef;
  79
  80 def add_elempic (expr pone, ptwo) =
  81   addto currentpicture also elem_pic shifted (pone, ptwo)
  82 enddef;
  83
  84 def call_add_save_elempic (expr pone, ptwo) =
  85   callpic; add_elempic(pone, ptwo); savepic
  86 enddef;
  87
  88 def shift_pic (expr pone, ptwo) =
  89   currentpicture:=currentpicture shifted (round(pone),round(ptwo))
  90 enddef;
  91
  92 def fill_circle (expr diameter, zshift) =
  93   fill fullcircle scaled diameter shifted zshift
  94 enddef;
  95
  96 def fill_square (expr xwidth, ywidth, zshift) =
  97   fill unitsquare xscaled xwidth yscaled ywidth shifted zshift
  98 enddef;
  99
 100 %
 101
 102 % eobasicdefs ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 103
 104 %%%%%%%
 105 message ("<noteheads>");
 106 %%%%%%%
 107
 108 NHW=nhw+hlthick;
 109
 110 beginchar(0, gregwidth#, .5nhh#, .5nhh#); "dummy square";
 111 endchar;
 112
 113 beginchar(18, smallgreg*gregwidth#, .5nhh#, .5nhh#); "small dummy square";
 114 endchar;
 115
 116
 117 beginchar(1, 0, .5nhh#, .5nhh#); "filled diamond";
 118  x1:=0.5greg_min_diam+hlthick; x3=gregwidth-x1; x2=x4=0.5gregwidth;
 119  y1=y3=0; y2=-y4=0.5diamheight;
 120  pickup pencircle scaled lthick;
 121  fill z1--z2--z3--z4--cycle;
 122  draw z1--z2--z3--z4--cycle;
 123  penlabels (1,2,3,4);
 124 endchar;
 125
 126 beginchar(2, 0, .5nhh#, .5nhh#); "filled diamond aucta";
 127  x1:=0.5greg_min_diam+hlthick; x3=gregwidth-x1; x2=x4=0.5gregwidth;
 128  y1=y3=0; y2=-y4=0.5diamheight;
 129  x5=x1+hlthick; y5=1.5y4;
 130  pickup pencircle scaled lthick;
 131  fill z1--z2--z3{sw+down}..{left+0.3up}z5--z5{right}..z4--cycle;
 132  draw z1--z2--z3{sw+down}..{left+0.3up}z5--z5{right}..z4--cycle;
 133  penlabels (1,2,3,4,5);
 134 endchar;
 135
 136 beginchar(3, 0, .5nhh#, .5nhh#); "apostropha";
 137  x1:=0.5greg_min_diam+hlthick; x3=gregwidth-x1; x2=x4+0.1gregwidth=0.5gregwidth;
 138  y1=y3=0; y2=0.5gregwidth+0.5greg_min_diam-hlthick;
 139  y4=-y2-0.2gregwidth;
 140  pickup pencircle scaled lthick;
 141  fill z1--z2--z3{left+1.5down}..{left+0.6down}z4--z4{right+2up}..{left+0.1up}cycle;
 142  draw z1--z2--z3{left+1.5down}..{left+0.6down}z4--z4{right+2up}..{left+0.1up}cycle;
 143  penlabels (1,2,3,4);
 144 endchar;
 145
 146 beginchar(4, 0, .5nhh#, .5nhh#); "filled diamond deminutae";
 147  x1:=0.5greg_min_diam*deminutae+hlthick;
 148  x3=gregwidth_dem-x1; x2=x4=0.5gregwidth_dem;
 149  y1=y3=0; y2=-y4=0.5diamheight*deminutae;
 150  pickup pencircle scaled lthick;
 151  fill z1--z2--z3--z4--cycle;
 152  draw z1--z2--z3--z4--cycle;
 153  penlabels (1,2,3,4);
 154 endchar;
 155
 156 beginchar(5, 0, .5nhh#, .5nhh#); "gregorian punctum";
 157   x1=x4=hlthick; x2=x3=gregwidth+hlthick; y1=y2=-y3=-y4=.5gregwidth-hlthick;
 158   pickup pencircle scaled lthick;
 159   fill z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 160   draw z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 161   shift_pic(0,-hlthick);
 162   savepic;
 163  penlabels (1,2,3,4);
 164 endchar;
 165
 166 beginchar(13, 0, .5nhh#, .5nhh#); "mirrored gregorian punctum";
 167   callpic;
 168   mirror(origin, right);
 169 endchar;
 170
 171 beginchar(6, 0, .5nhh#, .5nhh#); "gregorian virga left";
 172   callpic;
 173   fill_square (lthick, 1.5nhh,(0, -1.5nhh));
 174 endchar;
 175
 176 beginchar(7, 0, .5nhh#, .5nhh#); "gregorian virga right";
 177   callpic;
 178   fill_square (lthick, 1.5nhh,(gregwidth, -1.5nhh));
 179 endchar;
 180
 181 beginchar(8, 0, .5nhh#, .5nhh#); "gregorian punctum aucta down";
 182   x1=x4=hlthick; x2=x3=gregwidth+hlthick;
 183   y1=y2+aucta_fact=-y3-aucta_fact=-y4=.5gregwidth-hlthick;
 184   pickup pencircle scaled lthick;
 185   fill z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 186   draw z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 187   shift_pic(0,-hlthick);
 188   savepic;
 189  penlabels (1,2,3,4);
 190 endchar;
 191
 192 beginchar(9, 0, .5nhh#, .5nhh#); "gregorian punctum aucta up";
 193 callpic;
 194 mirror(origin,right);
 195 endchar;
 196
 197 beginchar(10, 0, .5nhh#, .5nhh#); "oriscus";
 198   x1=x4=hlthick; x2=x3=gregwidth+hlthick; y1=y2=-y3=-y4=.5gregwidth-hlthick;
 199   pickup pencircle scaled lthick;
 200   fill z1{dir orisuangle}..{dir orisuangle}z2--z3{dir orisruangle}..{dir orisruangle}z4--cycle;
 201   draw z1{dir orisuangle}..{dir orisuangle}z2--z3{dir orisruangle}..{dir orisruangle}z4--cycle;
 202  penlabels (1,2,3,4);
 203 endchar;
 204
 205 beginchar(11, 0, .5nhh#, .5nhh#); "apostropha aucta";
 206  x1:=0.5greg_min_diam+hlthick; x3=gregwidth-x1; x2=x4=0.5gregwidth;
 207  y1=y3=0; y2=0.5gregwidth+0.5greg_min_diam-hlthick;
 208  y4=-y2-0.2gregwidth; y5=y4; x5=x1;
 209  pickup pencircle scaled lthick;
 210  fill z1--z2--z3{left+1.5down}..{left+0.6down}z4..z5--z5{right}..{left+0.1up}cycle;
 211  draw z1--z2--z3{left+1.5down}..{left+0.6down}z4..z5--z5{right}..{left+0.1up}cycle;
 212  penlabels (1,2,3,4,5);
 213 endchar;
 214
 215 beginchar(12, 0, .5nhh#, .5nhh#); "small gregorian punctum";
 216   x1=x4=hlthick; x2=x3=smallgreg*gregwidth+hlthick;
 217   y1=y2=-y3=-y4=.5smallgreg*gregwidth-hlthick;
 218   pickup pencircle scaled lthick;
 219   fill z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 220   draw z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 221   shift_pic(0,-hlthick);
 222   savepic;
 223 endchar;
 224
 225 beginchar(14, 0, .5nhh#, .5nhh#); "mirrored small gregorian punctum";
 226   callpic;
 227   mirror(origin, right);
 228 endchar;
 229
 230 beginchar(15, gregwidth#, .5nhh#, .5nhh#); "podatus bottom";
 231   fill_square(gregwidth+lthick, gregwidth, (0, -0.5gregwidth));
 232 endchar;
 233
 234 beginchar(16, gregwidth#, .5nhh#, .5nhh#); "small podatus bottom";
 235   fill_square(gregwidth+lthick, gregwidth-shave, (0, -0.5gregwidth));
 236 endchar;
 237
 238 beginchar(17, 0, .5nhh#, .5nhh#); "gregorian punctum shaved bottom";
 239   x1=x4=hlthick; x2=x3=gregwidth+hlthick; y1=y2=-y3+shave=-y4+shave=.5gregwidth-hlthick;
 240   pickup pencircle scaled lthick;
 241   fill z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 242   draw z1{dir greguangle}..z2--z3..{dir gregrlangle}z4--cycle;
 243   shift_pic(0,-hlthick);
 244   savepic;
 245  penlabels (1,2,3,4);
 246 endchar;
 247
 248 def square (expr mw)=
 249   fill_square (sqrt(2)*.5mw, max(1,thin), origin) rotated -45;
 250   fill_square (sqrt(2)*.5mw, .15nhw, (0,-.15nhw)) rotated 45;
 251   save_elempic;
 252   mirror (origin,up);
 253   mirror (origin,left);
 254   shift_pic (mw+.5,0);
 255   add_elempic(0,0);
 256 %  mirror (origin,right);% I've seen this too, somewhere ...
 257 enddef;
 258
 259 beginchar(118, 0, .5nhh#, .5nhh#); "deep porrectus";
 260   x1=x4=0; x2=x3=3*gregwidth+lthick;
 261   y1=-y4=.5gregwidth-lthick; y2=y1-2nhh; y3=y4-2nhh;
 262   z5=z1+(0,0.3gregwidth);
 263   fill z5..{right+0.4down}z2--z3{left+0.4up}..z4--cycle; shift_pic(0,hlthick);
 264   fill_square (med, 1.5nhh,(0, -2nhh));
 265  penlabels (1,2,3,4,5);
 266 endchar;
 267
 268 beginchar(119, 0, .5nhh#, .5nhh#); "low porrectus";
 269   x1=x4=0; x2=x3=3*gregwidth+lthick;
 270   y1=-y4=.5gregwidth-lthick; y2=y1-1.5nhh; y3=y4-1.5nhh;
 271   z5=z1+(0,0.2gregwidth);
 272   fill z1..{right+0.4down}z2--z3{left+0.4up}..z4--cycle; shift_pic(0,hlthick);
 273   fill_square (med, 1.5nhh,(0, -2nhh));
 274  penlabels (1,2,3,4,5);
 275 endchar;
 276
 277 beginchar(120, 0, .5nhh#, .5nhh#); "porrectus";
 278   x1=x4=0; x2=x3=3*gregwidth+lthick;
 279   y1=-y4=.5gregwidth-lthick; y2=y1-nhh; y3=y4-nhh;
 280   z5=z1+(0,0.1gregwidth);
 281   fill z5..{right}z2--z3{left}..z4--cycle; shift_pic(0,hlthick);
 282   fill_square (med, 1.5nhh,(0, -1.5nhh));
 283  penlabels (1,2,3,4,5);
 284 endchar;
 285
 286 beginchar(121, 0, .5nhh#, .5nhh#); "soft porrectus";
 287   x1=x4=0; x2=x3=3*gregwidth+lthick;
 288   y1=-y4=.5gregwidth-lthick; y2=y1-0.5nhh; y3=y4-0.5nhh;
 289   z5=z1+(0,0.1gregwidth);
 290   fill z5..{right}z2--z3{left}..z4--cycle; shift_pic(0,hlthick);
 291   fill_square (med, 1.5nhh,(0, -1.5nhh));
 292  penlabels (1,2,3,4,5);
 293 endchar;
 294
 295 def quilisma(expr ymidtop, ymidbot) =
 296   ydiff:=0.15gregwidth;
 297   qdecalage:=.2*gregwidth;
 298   ydepth:=0.25gregwidth;
 299   x1=x14=-qdecalage+hlthick;
 300   x7=x8=gregwidth+hlthick;
 301   y1+ydiff-0.5ydepth=ymidtop=y7-ydiff-0.5ydepth;
 302   y14+ydiff-0.5ydepth=ymidbot=y8-ydiff-0.5ydepth;
 303   3x3=2x1+x7; 3x5=x1+2x7;
 304   3y3=2y1+y7; 3y5=y1+2y7;
 305   2x2=x1+x3; 2x4=x3+x5; 2x6=x5+x7;
 306   2y2=y1+y3-2ydepth; 2y4=y3+y5-2ydepth; 2y6=y5+y7-2ydepth;
 307   3x12=2x14+x8; 3x10=x14+2x8;
 308   3y12=2y14+y8; 3y10=y14+2y8;
 309   2x13=x14+x12; 2x11=x12+x10; 2x9=x10+x8;
 310   2y13=y14+y12-2ydepth; 2y11=y12+y10-2ydepth; 2y9=y10+y8-2ydepth;
 311
 312   pickup line_pen;
 313
 314
 315   draw z1{down+0.1right}..z2..z3..z4..z5..z6..{up+0.1right}z7--z8{down}..z9..z10..z11..z12..z13..{up+0.1left}z14--cycle;
 316   fill z1{down+0.1right}..z2..z3..z4..z5..z6..{up+0.1right}z7--z8{down}..z9..z10..z11..z12..z13..{up+0.1left}z14--cycle;
 317   shift_pic(0,-hlthick);
 318 enddef;
 319
 320 beginchar(125, 0, .5nhh#, .5nhh#); "quilisma";
 321   quilisma(0.5gregwidth-hlthick, -0.5gregwidth+hlthick);
 322 endchar;
 323
 324 beginchar(126, 0, .5nhh#, .5nhh#); "bottom quilisma";
 325   quilisma(0.5gregwidth-hlthick-0.8shave, -0.5gregwidth+hlthick);
 326 endchar;
 327
 328 %%%%%%%
 329 message ("<clefs>");
 330 %%%%%%%
 331 keygregwidth:=0.5*sqrt(2)*nhw;
 332
 333 beginchar(98, 8/3nhw#, 3.25nhh#, 0); "gregorian C clef";
 334   x1=x4=0; x2=x3=keygregwidth; y1=y2=-y3=-y4=.5keygregwidth-lthick;
 335   fill z1{dir 15}..z2--z3{dir 165}..z4--cycle;
 336   save_elempic;
 337   pickup med_pen; draw bot rt z1..{down}(-.01nhw,-.5nhh);
 338   shift_pic(nhw,2.5nhh);
 339   add_mirror ((0,2nhh),(1,2nhh));
 340   savepic;
 341   shift_pic (0,-2nhh);
 342 endchar;
 343
 344 beginchar(122, 8/3nhw#, 4.25nhh#, 0); "gregorian F clef";
 345   callpic;
 346   add_elempic (.1nhw+0.5med,2nhh);
 347   fill_square (med, 1.5nhh, (.75nhw,.8nhh));
 348   shift_pic (1/3nhw,-2nhh);
 349 endchar;
 350
 351 end