% % Washington Romanized Indic accent driver % % grmax grmax:=1; % when |grmax| is known, this file has been input numeric xxxpr; xxxpr:=0; pen penpixel; penpixel = pensquare; % Grave_accent is called with suffix, dummy_suffix e.g. % Grave_accent(2,q) % the accent is centered above 'suffix' 1 to 1.5 dot_sizes higher def Grave_accent (suffix $,@) = if serifs: pickup crisp.nib; x@_1+1.5curve=x$; x@_2=x$+1.5curve; if y$ < .9cap_height: y@_1=y$+if hefty: 1.5 fi dot_size+.5bar_height; y@_2=y$+if hefty: 1.5 fi dot_size; else: y@_1=y$+if hefty: 1.2 else: .8 fi dot_size+.4bar_height; y@_2=y$+if hefty: 1.2 else: .8 fi dot_size; fi numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(stem,theta); pos@_2(hair,theta); filldraw circ_stroke z@_1e--z@_2e; % diagonal else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0); x@_1l=x$-1.5u; x@_2r=x$+1.5u; y@_1=y$+1.5dot_size+2.5u; y@_2=y$+1.5dot_size; filldraw stroke z@_1e--z@_2e; fi % diagonal penlabels(@_1,@_2); enddef; % Acute_accent is called with suffix, and dummy_suffix % as in the Grave_accent call def Acute_accent (suffix $,@) = if serifs: pickup crisp.nib; x@_1=x$+1.5curve; x@_2=x$-1.5curve; if y$ < .9cap_height: y@_1=y$+ if hefty: 1.5 fi dot_size+.5bar_height; y@_2=y$+ if hefty: 1.5 fi dot_size; else: y@_1=y$+if hefty: 1.2 else: .8 fi dot_size+.4bar_height; y@_2=y$+if hefty: 1.2 else: .8 fi dot_size; fi % y@_2=y$+dot_size; numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(stem,theta); pos@_2(hair,theta); filldraw circ_stroke z@_1e--z@_2e; % diagonal else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0); x@_1r=x$+1.5u; x@_2l=x$-1.5u; y@_1=y$+1.5dot_size+2.5u; y@_2=y$+1.5dot_size; filldraw stroke z@_1e--z@_2e; fi % diagonal penlabels(@_1,@_2); enddef; numeric barwidth; barwidth=vround .2[vair,stem]; def baracute (suffix $,@) = if serifs: pickup crisp.nib; x@_1=x$+1.5curve; x@_2=x$-1.5curve; if y$ < .9cap_height: y@_1=2curve+y$+ if hefty: 1.5 fi dot_size+.5bar_height; y@_2=2curve+y$+ if hefty: 1.5 fi dot_size; else: y@_1=2curve+y$+ if hefty: 1.5 fi dot_size+.4bar_height; y@_2=2curve+y$+ if hefty: 1.5 fi dot_size; fi numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(stem,theta); pos@_2(hair,theta); filldraw circ_stroke z@_1e--z@_2e; % diagonal else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0); x@_1r=x$+1.5u; x@_2l=x$-1.5u; y@_1=2curve+y$+1.5dot_size+2.5u; y@_2=2curve+y$+1.5dot_size; filldraw stroke z@_1e--z@_2e; fi % diagonal pos@_99(barwidth,90); pos@_100(barwidth,90); bot y@_99l=bot y@_100l=y$+dot_size; x@_99=x$-.21body_height; x@_100=x$+.21body_height; filldraw stroke z@_99e--z@_100e; penlabels(@_1,@_2,@_99,@_100); enddef; % bar_accent % called with left-coord,right coord, dummy coord,accent_bar_height % e.g. bar_accent(3,6,q,.5(asc_height-bar_height)) % bar extends from x_left to x_right at height_h def bar_accent (suffix $,$$,@)(expr bH) = numeric macron_breadth#; macron_breadth#=.2[vair#,stem#]; numeric macron_breadth; macron_breadth:=Vround .2[vair,stem]; pickup if serifs: crisp.nib else: fine.nib fi; pos@1(macron_breadth,90); pos@2(macron_breadth,90); top y@1r=top y@2r=bH+o; lft x@1=x$; rt x@2=x$$; filldraw stroke z@1e--z@2e; % bar penlabels(@1,@2); enddef; % macron, fixed width macron, centered over $ and .4[x_height,asc_height] above % suffix passed should be a point at top center of main portion of char def Macron (suffix $,@) = numeric macron_breadth#; macron_breadth#=.2[vair#,stem#]; numeric macron_breadth; macron_breadth:=Vround .2[vair,stem]; pickup if serifs: crisp.nib else: fine.nib fi; pos@1(macron_breadth,90); pos@2(macron_breadth,90); y@1=y@2=y$+.4[x_height,asc_height]-x_height; if hefty: lft x@1=x$-.35w ; rt x@2=x$+.35w ; else: lft x@1=x$-3.25u; rt x@2=x$+3.25u; fi filldraw stroke z@1e--z@2e; % bar penlabels(@1,@2); enddef; % cross for l call with suffix of crossing point on stem def cross_for_l (suffix $,@) = pickup crisp.nib; x@_2-x@_1=max(4u,2.8u+stem); .5[x@_1,x@_2]=x$; y@_1-.75bar=y$-.75dot_size; y@_2+.75bar=y$+.75dot_size; numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(1.5bar,theta); pos@_2(1.5bar,theta); filldraw stroke z@_1e--z@_2e; % diagonal penlabels(1,2); enddef; % longer cross for l def cross_for_lz (suffix $,@) = pickup crisp.nib; x@_2-x@_1=max(6u,4.2u+stem); .5[x@_1,x@_2]=x$; y@_1-.75bar=y$-.75dot_size; y@_2+.75bar=y$+.75dot_size; numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(1.5bar,theta); pos@_2(1.5bar,theta); filldraw stroke z@_1e--z@_2e; % diagonal penlabels(1,2); enddef; % dot_sharp_values used by underdot def dot_sharp_values = numeric dot_diam#; dot_diam#=max(dot_size#,cap_curve#); numeric dot_top#; dot_top#=min(asc_height#,10/7x_height#+.5dot_diam#); enddef; % underdot draws a dot one dot-diameter below the baseline of an x-coordinate % specified in the call to underdot; the x-coordinate will ordinarily be % the low-center point of the character shape. The suffix only of the % x-coordinate is passed, along with a dummy suffix to use for point % plotting, e.g. % underdot(6,q); def underdot (suffix $,@) = dot_sharp_values; define_whole_blacker_pixels(dot_diam); pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90); x@_1=x@_2=x$; top y@_2r=-dot_diam; y@_1=.5[y@_2l,y@_2r]; dot(@_1,@_2); % dot penlabels(@_1,@_2); enddef; % overdot % calling specification is as in underdot def overdot (suffix $,@) = dot_sharp_values; define_whole_blacker_pixels(dot_diam); pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90); x@_1=x@_2=x$; top y@_2r=2dot_diam+y$; y@_1=.5[y@_2l,y@_2r]; dot(@_1,@_2); % dot penlabels(@_1,@_2); enddef; % umlaut % calling specification is as in underdot def umlaut (suffix $,@) = dot_sharp_values; define_whole_blacker_pixels(dot_diam); pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90); x@_1=x@_2=x$-1.25dot_diam; top y@_2r=2dot_diam+y$; y@_1=.5[y@_2l,y@_2r]; dot(@_1,@_2); % dot pos@_3(dot_diam,0); pos@_4(dot_diam,90); x@_3=x@_4=x$+1.25dot_diam; top y@_4r=2dot_diam+y$; y@_3=.5[y@_4l,y@_4r]; dot(@_3,@_4); % dot enddef; % calling specification is as in underdot def underumlaut (suffix $,@) = dot_sharp_values; define_whole_blacker_pixels(dot_diam); pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90); x@_1=x@_2=x$-1.75u; top y@_2r=y$-dot_diam; y@_1=.5[y@_2l,y@_2r]; dot(@_1,@_2); % dot pos@_3(dot_diam,0); pos@_4(dot_diam,90); x@_3=x@_4=x$+1.75u; top y@_4r=y$-dot_diam; y@_3=.5[y@_4l,y@_4r]; dot(@_3,@_4); % dot enddef; % glottal puts a comma/apostrophe with dot at specified location % called with suffix above spot to place glottal % glottal(2); def glottal(suffix $)= x95=x$; if hefty: y95=y$+2dot_size+comma_depth else: y95=y$+1.25dot_size+.75comma_depth fi; if hefty: comma(95,hacc,dot_size,.28u,comma_depth); % large comma else: comma(95,hacc,.75dot_size,.25u,.75comma_depth); fi % comma with increased jut enddef; % glotchek draws glottal and hachek above the specified x coordinate supplied % as a suffix def glotchek (suffix @) = if serifs: pickup crisp.nib; pos@_2'(.5[vair,curve],90); top y@_2'r=h; pos@_2(.5[vair,curve],90); x@_2=.5w; x@_1=w-x@_3=good.x 2.25u; top y@_1=top y@_3=h-.25dot_size; y@_1-y@_2=.5(y@_2'-x_height-.25dot_size); pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90); filldraw stroke z@_1e--z@_2e--z@_3e; % diagonals else: pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1=w-x@_3; pos@_2(stem,0); bot y@_2=vround(1/12[x_height,vround min(asc_height,2x_height)]+o)-.25dot_size; x@_2=.5w; top y@_1=top y@_3=h+o-.25dot_size; lft x@_1l=hround(rt x@_2r-3.25u-.5vair); z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l]; y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=w-x@_4l; filldraw z@_4l--z@_1l--z@_1r--z@_0--z@_3l--z@_3r--z@_4r--cycle; fi % diagonals x95-.5dot_size=hround(x@_2-.5dot_size); % y95=y@_2+.75comma_depth+.5dot_size; y95=body_height+dot_size; if hefty: comma(95,hacc,dot_size,.28u,.85comma_depth); % large comma else: comma(95,hacc,.75dot_size,.25u,.75comma_depth); fi % comma with increased jut penlabels(0,1,2,3,4); enddef; % hachek accent macro, give suffix of point above which to center it def hachekit (suffix $,@) = if serifs: pickup crisp.nib; pos@_2'(.5[vair,curve],90); bot y@_2'=y$+dot_size; pos@_2(.5[vair,curve],90); x@_2=x$; y@_2=y@_2'; x@_1+.21body_height=x@_2=x@_3-.21body_height; y@_1=y@_3=y@_2+.21body_height; % x@_1=w-x@_3=good.x 2.25u; top y@_1=top y@_3=h; y@_1-y@_2=.5(y@_2'-x_height); pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90); filldraw stroke z@_1e--z@_2e--z@_3e; % diagonals % show z@_1,z@_2,z@_3,z@_1r,z@_2r,z@_3r,z@_1l,z@_2l,z@_3l; else: pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1+.21body_height=x$=x@_2=x@_3-.21body_height; pos@_2(stem,0); bot y@_2=y$+dot_size; top y@_1=top y@_3=top y@_2+.21body_height; % lft x@_1l=hround(rt x@_2r-3.25u-.5vair); z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l]; y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=2x$-x@_4l; filldraw z@_4l--z@_1l--z@_1r--z@_0--z@_3l--z@_3r--z@_4r--cycle; fi % diagonals % show z@_0,z@_1,z@_2,z@_3,z@_1r,z@_2r,z@_3r,z@_1l,z@_2l,z@_3l; penlabels(0,1,2,3,4); enddef; def hatme (suffix $,@) = if serifs: pickup crisp.nib; pos@_2'(.5[vair,curve],90); top y@_2'=y$+ if hefty: 2 else: 1.5 fi dot_size+.21body_height; pos@_2(.5[vair,curve],90); x@_2=x$; y@_2=y@_2'; x@_1+.21body_height=x@_2=x@_3-.21body_height; y@_1=y@_3=y@_2-.21body_height; pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90); filldraw stroke z@_1e--z@_2e--z@_3e; % diagonals else: pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1+.21body_height=x$=x@_2=x@_3-.21body_height; pos@_2(stem,0); top y@_2=y$+dot_size+.21body_height; y@_1=y@_3=y@_2-.21body_height; z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l]; y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=2x$-x@_4l; filldraw z@_4l--z@_1l--z@_1r--z@_0--z@_3l--z@_3r--z@_4r--cycle; fi % diagonals penlabels(0,1,2,3,4); enddef; % glotchek a hachek with glottal accent def glotchekit (suffix $,@) = if serifs: pickup crisp.nib; pos@_2'(.5[vair,curve],90); bot y@_2'=y$+.75dot_size; pos@_2(.5[vair,curve],90); x@_2=x$; y@_2=y@_2'; x@_1+3u=x@_2=x@_3-3u; y@_1=y@_3=y@_2+3u; pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90); filldraw stroke z@_1e--z@_2e--z@_3e; % diagonals else: pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1+3u=x$=x@_2=x@_3-3u; pos@_2(stem,0); bot y@_2=y$+.75dot_size; top y@_1=top y@_3=top y@_2+3u; % lft x@_1l=hround(rt x@_2r-3.25u-.5vair); z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l]; y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=2x$-x@_4l; filldraw z@_4l--z@_1l--z@_1r--z@_0--z@_3l--z@_3r--z@_4r--cycle; fi % diagonals x95-.5dot_size=hround(x@_2-.5dot_size); y95=y@_2+.75comma_depth+dot_size; % y95=top y@_2 + dot_size; if hefty: comma(95,hacc,dot_size,.28u,.85comma_depth); % large comma else: comma(95,hacc,.75dot_size,.25u,.75comma_depth); fi % comma with increased jut enddef; def cedilla (suffix $,@)(expr cD_shift) = save @; forsuffixes $$=@,@_: transform $$; endfor if serifs: pickup crisp.nib; pos@_1(stem,0); pos@_2(stem,0); pos@_3(vair,90); pos@_4(stem,0); pos@_5(1.1vair,-90); pos@_6(vair,-180); x@_1=x@_2=x$; z@_3l=z@_2l; x@_4=x@_2+1.5u; x@_5=x@_3-1.5u; % bot y@_1=-o; top y@_1=0; bot y@_2=-vround 2/7(.875desc_depth)-o; y@_4=.5[y@_3,y@_5]; bot y@_5=-.875desc_depth-o; @ = identity shifted(0,cD_shift); for n = 1,2,3,4,5: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor filldraw stroke z@1e--z@2e; % stem filldraw stroke z@3e{right}...z@4e{down}...{left}z@5e; % hook else: pickup fine.nib; pos@_1(vair,0); top y@_1=-o-2; pos@_2(.5[vair,stem],0); bot y@_2=-.875desc_depth-o; x@_1=x$; x@_2=x@_1-1.25u; @ = identity shifted(0,cD_shift); for n = 1,2: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor filldraw stroke z@1e--z@2e; fi % diagonal % filldraw stroke z$e--z@1e; % fill gap penlabels(@1,@2,@3,@4,@5); enddef; def polhook (suffix $,@)(expr cD_shift) = save @; forsuffixes $$=@,@_: transform $$; endfor if serifs: pickup crisp.nib; pos@_1(stem,0); pos@_2(stem,0); pos@_3(vair,-90); pos@_4(stem,0); pos@_5(vair,90); x@_1=x@_2=x$; z@_3r=z@_2r; x@_4=x@_2-1.5u; x@_5=x@_3+.5u; top y@_1=0; bot y@_2=-vround 2/7(.875desc_depth)-o; % bot y@_1=-o; y@_4=.5[y@_3,y@_5]; bot y@_5=-.875desc_depth-o; @ = identity shifted(0,cD_shift); for n = 1,2,3,4,5: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor x@6=x@5+u+.25dot_size; y@6=y@5+.25dot_size; pos@6(hair,180); filldraw stroke z@1e--z@2e; % stem filldraw stroke z@3e{left}...z@4e{down}...{right}z@5e...z@6e; % hook else: pickup fine.nib; pos@_1(vair,0); top y@_1=-o-2; pos@_2(.5[vair,stem],0); bot y@_2=-.875desc_depth-o; x@_1=x$; x@_2=x@_1+1.25u; @ = identity shifted(0,cD_shift); for n = 1,2: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor filldraw stroke z@1e--z@2e; fi % diagonal % filldraw stroke z$e--z@1e; % fill gap penlabels(@1,@2,@3,@4,@5); enddef; % controls for font size changing %%% the following have to be put, suitably modified into parameter files %%% string myfontstyle, mynormalsize, mysmallsize; %%% %%% myfontstyle := "CMR"; %%% mynormalsize := "10"; %%% mysmallsize := "8"; def generate suffix t=enddef; %ignore generate on subsequent read-ins %of parameter files def shrinksize = scantokens ("input " & myfontstyle & mysmallsize ); mode_setup; font_setup; enddef; def resumesize = scantokens ("input " & myfontstyle & mynormalsize ); mode_setup; font_setup; enddef; % resumesize; normala_ht# := asc_height#; % define reverse adjust fit for use with rotated characters def r_adjust_fit(expr adjr,adjl) = adjust_fit(adjl,adjr); enddef; def tilde_accent (suffix $,@)(expr tY_shift) = save @; forsuffixes $$=@,@_: transform $$; endfor if serifs: numeric theta; theta=angle(1/6(6u-vair),1/4(asc_height-x_height)); pickup crisp.nib; numeric mid_width; mid_width=.4[vair,stem]; pos@_1(vair,theta+90); pos@_2(vair,theta+90); pos@_3(vair,theta+90); pos@_4(vair,theta+90); z@_2-z@_1=z@_4-z@_3=(mid_width-crisp)*dir theta; rt x@_4l-x$=x$-lft x@_1r=3u; top y@_4r=asc_height; bot y@_1l=vround(bot y@_1l+min(2/3[x_height,asc_height],y@_3l-.25vair)-top y@_1r); pair delta; ypart delta=3(y@_3l-y@_1l); delta=whatever*dir theta; @ = identity shifted(0,tY_shift); for n = 1,2,3,4: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor filldraw z@1l..controls(z@1l+delta)and(z@3l-delta)..z@3l..z@4l --z@4r..controls(z@4r-delta)and(z@2r+delta)..z@2r..z@1r--cycle; % stroke else: pickup fine.nib; pos@_1(vair,180); pos@_2(vair,90); pos@_3(.5[vair,slab],90); pos@_4(vair,90); pos@_5(vair,180); rt x@_5l-x$=x$-lft x@_1r=3u; x@_2-x@_1=x@_3-x@_2=x@_4-x@_3=x@_5-x@_4; bot y@_1=bot y@_4l=vround(.75[x_height,asc_height]-vair); top y@_2r=top y@_5=asc_height; y@_3=.5[y@_2,y@_4]; @ = identity shifted(0,tY_shift); for n = 1,2,3,4,5: forsuffixes e = l,,r: z@[n]e = z@_[n]e transformed @; endfor endfor filldraw stroke z@1e{up}...z@2e{right}..z@3e..{right}z@4e...{up}z@5e; fi % stroke penlabels(@1,@2,@3,@4,@5); enddef; def humlaut (suffix $,@) = x@_3-x@_1=x@_4-x@_2=hround 3u; y@_3=y@_1; y@_4=y@_2; if serifs: pickup crisp.nib; x@_3=hround(x$+2.5u); x@_2=hround(x$-2u); y@_1+.5stem=h+asc_height-x_height; y@_2=max(2/3[h+asc_height-x_height,h],h+o+hair); % if h > .9cap_height: y@_2:=.67[y@_1,y@_2]; fi % above line shortens & flattens humlaut marks numeric theta; theta=angle(z@_2-z@_1)+90; pos@_1(stem,theta); pos@_2(hair,theta); pos@_3(stem,theta); pos@_4(hair,theta); filldraw circ_stroke z@_1e--z@_2e; % left diagonal filldraw circ_stroke z@_3e--z@_4e; % right diagonal else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0); pos@_3(stem,0); pos@_4(vair,0); % rt x@_3r=hround(w-1.5u); lft x@_4l=hround(.5w+u-.5vair); x@_3=x@_4+u; x@_4=x$+1.5u; top y@_1=h+asc_height-x_height; bot y@_2=vround 2/3[h+asc_height-x_height,h]; filldraw stroke z@_1e--z@_2e; % left diagonal filldraw stroke z@_3e--z@_4e; fi % right diagonal % penlabels(1,2,3,4); enddef; % set output character height after a beginchar has been issued def sethtto(expr newht) = charht:=newht / hppp; enddef; def setwdto(expr newwd) = charwd:=newwd / hppp; enddef; def addht(expr inc_ht) = charht:= charht + (inc_ht / hppp); enddef; def addwd(expr inc_wd) = charwd:= charwd + (inc_wd / hppp); enddef; % flip rotates 180 degrees about the centerpoint whose suffix is passed def flip (suffix $) = picture V; transform t; y$:=y$*aspect_ratio; t=identity rotatedaround(z$,180) shifted(2y$*slant,0); V=currentpicture transformed t; currentpicture:=V; enddef; def invbreve (suffix $,@) = pickup crisp.nib; pos@_1(vair,-180); pos@_3(vair,0); bot y@_1=bot y@_3=y$+dot_size; lft x@_1r=hround(x$-2curve-.5vair); rt x@_3r=hround(x$+2curve+.5vair); numeric mid_thickness; mid_thickness=vround 1/3[vair,stem]; pos@_2(mid_thickness,-90); x@_2=x$; y@_2r= y@_1+2curve; filldraw stroke z@_1e{up}...z@_2e{right}...{down}z@_3e; % stroke penlabels(@_1,@_2,@_3); enddef; def ringdot (suffix $,@) = numeric rdcirc_hair,rdcirc_vair; rdcirc_hair=hround min(hair,u+.5); rdcirc_vair=vround min(vair,(asc_height-x_height)/6+.5); penpos@_1(rdcirc_vair,90); penpos@_3(rdcirc_vair,-90); penpos@_2(rdcirc_hair,180); penpos@_4(rdcirc_hair,0); x@_2r=hround(x$-.105body_height-.5rdcirc_hair); x@_4r=hround(x$+.105body_height+.5rdcirc_hair); x@_1=x@_3=x$; if y$ > bar_height: y@_1r=y$+dot_size+2rdcirc_vair+.105body_height; y@_2=y@_4=.5[y@_1,y@_3]; y@_3=y$+dot_size+rdcirc_vair; else: y@_1r=y$-dot_size; y@_2=y@_4=.5[y@_1,y@_3]; y@_3r=-d; fi penstroke pulled_arc.e(@_1,@_2) & pulled_arc.e(@_2,@_3) & pulled_arc.e(@_3,@_4) & pulled_arc.e(@_4,@_1) & cycle; % bowl enddef; numeric shrinkfactor; shrinkfactor=1; def slantswitch = slant:=-slant; currenttransform:= identity slanted slant yscaled aspect_ratio scaled granularity; enddef; %reverse slant so that mirror() will work def mirror (expr axis) = x._qa=x._qb=axis; y._qa=h; y._qb=0; picture V; transform MIRROR; MIRROR=identity reflectedabout(z._qa,z._qb); V=currentpicture transformed MIRROR; currentpicture:=V; slantswitch; %restore original slant enddef; def l_tail(suffix $,@) = x@_22=x$; x@_22r=x$r; x@_22l=x$l; bot y@_22=-1/3d; y@_22r=y@_22l=y@_22; filldraw stroke z$e--z@_22e; if serifs: pickup tiny.nib; pos@_55(vair,-90); pos@_66(hair,-180); pos@_77(flare,-180); x@_55=.5[x@_22,x@_66r]; bot y@_55r=-d-oo; y@_66-.5flare=-.88d; if monospace: lft x@_66r=x$-3.5u else: z@_66r=z@_77r; rt x@_77l=floor x$-2.5u fi; (x@_,y@_55r)=whatever[z@_55l,z@_22l]; x@_55r:=max(x@_,.5[x@_66r,x@_55]); filldraw stroke z@_22e{down}...z@_55e{left}; bulb(@_55,@_66,@_77); % arc and bulb else: pickup fine.nib; pos@_22'(stem',0); z@_22'=z@_22; pos@_66(.2[vair,stem'],-90); pos@_77(vair,-90); lft x@_77r=hround x$-2.5u; bot y@_77r=vround 5/6(-d-oo); (x@_,y@_77l)=whatever[z@_77r,(x$,h)]; x@_77l:=x@_; z@_55r=z@_22'r; (x@_22'l,y@_55l)=whatever[z@_77l,z@_55r]; x@_55l=x@_22'l; y@_55=y@_55r; x@_66r=.5[x@_77r,x@_55r]; x@_66l:=.5[x@_77l,x@_55l]; bot y@_66r=-d-oo; filldraw stroke z@_22'e..{down}z@_55e & super_arc.e(@_55,@_66) & z@_66e{left}..z@_77e; fi % arc and terminal enddef; def r_tail(suffix $,@) = pickup if serifs: tiny.nib else: fine.nib fi ; x@_22=x$; x@_22r=x$r; x@_22l=x$l; bot y@_22=-1/3d; y@_22r=y@_22l=y@_22; filldraw stroke z$e--z@_22e; if serifs: pickup tiny.nib; pos@_55(vair,90); pos@_66(hair,0); pos@_77(flare,0); x@_55=.5[x@_22,x@_66l]; bot y@_55l=-d-oo; y@_66-.5flare=-.88d; if monospace: rt x@_66r=x$+3.5u else: z@_66r=z@_77r; lft x@_77l=floor x$+2.5u fi; % (x@_,y@_55l)=whatever[z@_55r,z@_22l]; x@_55l:=max(x@_,.5[x@_66l,x@_55]); filldraw stroke z@_22e{down}...z@_55e{right}; z@_55'=z@_55; pos@_55'(vair,-90); bulb(@_55',@_66,@_77); % arc and bulb else: pickup fine.nib; pos@_22'(stem',0); z@_22'=z@_22; pos@_66(.2[vair,stem'],90); pos@_77(vair,90); rt x@_77r=hround x$+2.5u; bot y@_77l=vround 5/6(-d-oo); (x@_,y@_77r)=whatever[z@_77l,(x$,h)]; x@_77r:=x@_; z@_55l=z@_22'l; (x@_22'r,y@_55r)=whatever[z@_77r,z@_55l]; x@_55r=x@_22'r; y@_55=y@_55l; x@_66l=.5[x@_77l,x@_55l]; x@_66r:=.5[x@_77r,x@_55r]; bot y@_66l=-d-oo; filldraw stroke z@_77e..{left}z@_66e & super_arc.e(@_66,@_55) & z@_55e{up}..z@_22'e; fi % filldraw stroke z@_22'e..{down}z@_55e & super_arc.e(@_55,@_66) % & z@_66e{right}..z@_77e; fi % arc and terminal penlabels(@_22,@_55,@_66,@_77); enddef; def oef_stroke(suffix $,$$,@,left_serif,right_serif)(expr left_jut,right_jut)= % pickup tiny.nib; bot y$l=-d; pickup fine.nib; bot y$l=-d; if spike: y$r:=y$l+1.5stem; y$:=.5[y$l,y$r]; fi penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height; filldraw stroke z$e--z@0e; % stem % pickup fine.nib; pos@0'(x$r-x$l-(hround stem_corr)+tiny,180); pos@0'(x$r-x$l,180); z@0'=z@0; % y@0'=y@0; lft x@0'r=tiny.lft x$l; penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h]; pos@2(vair,90); top y@2r=h+oo; if serifs: x@2=.6[x@1,x$$r]; (x@,y@2r)=whatever[z@2l,z@1l]; x@2r:=min(x@,.5[x@2,x$$r]); pos@3(hair,0); bulb(@2,@3,$$); % bulb filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2); % arc if not spike: dish_serif($,@0,left_serif,1/3,left_jut,right_serif,1/3,right_jut); fi else: x@2=.6[x@1,x$$]; y@1l:=1/3[y@1l,y@2l]; filldraw stroke z@0'e--z@1e & super_arc.e(@1,@2) & term.e(@2,$$,right,.9,4); % arc and terminal fi penlabels(@0,@1,@2); enddef; def oeh_stroke(suffix $,@,@@,$$) = penpos$$(x@@r-x@@l,0); x$$=x@@-u; bot y$$=0; % y@@=1/3[bar_height,x_height]; y@@=bar_height; penpos$''(x$r-x$l,0); x$''=x$; y$''=1/8[bar_height,x_height]; filldraw stroke z$''e--z$e; % thicken the lower left stem penpos@0(min(rt x$r-lft x$l,thin_join)-fine,180); pickup fine.nib; rt x@0l=tiny.rt x$r; y@0=y$''; pos@1(vair,90); pos@@'(x@@r-x@@l+tiny,0); z@@'=z@@; x@1=.5[rt x@0l,rt x@@'r]; top y@1r=x_height+oo; (x@,y@1l)=whatever[z@1r,z@0l]; x@1l:=x@; % filldraw stroke z@0e{up}...{right}z@1e % &{{interim superness:=hein_super; super_arc.e(@1,@@')}}; % arch and right stem % pickup tiny.nib; filldraw stroke z@@e{down}...{-2,-1}z$$e; % right stem filldraw stroke z@0e{up}...{right}z@1e & pulled_super_arc.e(@1,@@)(.5superpull) & pulled_super_arc.e(@@,$$)(.5superpull); %arch and curved left stem labels(@0); penlabels(@1); enddef; def circ_coord(suffix $,$$) (expr len, ang) = x$ := x$$ + (len * cosd ang); y$ := y$$ - (len * aspect_ratio * cosd (ang + 90)); enddef; let cmbulb=bulb; % if a cmbase bulb is very close to its takeoff point (vertically) % path_l will be relatively flat at its intersection with path_r and % subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r--z$$r % may not lie entirely within the link contour (path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle) % this will result in a wedge from the intersectionpoint to z$$r not being filled. % % therefore we redefine def bulb(suffix $,$$,$$$) = z$$$r=z$$r; path_.l:=z$l{x$$r-x$r,0}...{0,y$$r-y$r}z$$l; filldraw path_.l--z$$r{0,y$r-y$$r}...{x$r-x$$r,0}z$r--cycle; % link path_.r:=z$$$l{0,y$r-y$$r}..z$$$r{0,y$$r-y$r}; % near-circle filldraw path_.r{0,y$$r-y$r}..{0,y$r-y$$r}cycle; % bulb in filleverything mode enddef; % end of file gram_max.mf