% Visible Speech, header file, with macros and everything.
% Input by Mark Shoulson, shoulson@ctr.columbia.edu.  Please do not sell
% this product, and please keep the header with it.  Please inform me
% if you modify this product in any way.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%
mode_setup;

15u#=1pt#;	% Looks pretty good.
loop_h#=loop_w#=100u#;	% seem to be square
vowel_asc#=30u#;
vowel_d#=30u#;
curve_overshoot#=0u#;	% zero, but maybe will change.
apex_overshoot#=4u#;
horiz_gap#=vert_gap#=50u#;	% appear equal.
sidebar#=10u#;
vowel_curl#=20u#;
curve#=20u#;
thin#=10u#;
fine#=7u#;
thick#=13u#;
lmodside#=3/4sidebar#;
rmodside#=sidebar#;
mod_height#=7/8loop_h#;
define_pixels(u,vowel_asc,vowel_d,loop_h,loop_w,curve_overshoot,
	apex_overshoot,vert_gap,horiz_gap,sidebar,vowel_curl,
	curve,thin,fine,thick,lmodside,rmodside,mod_height);

wide_spot=.5;	% widest point on loop, as ratio of other dim.
voice_length=.67;	% length of voicing line, as ratio.

pickup pencircle scaled fine; finepen:=savepen;
pickup pencircle scaled thin; thinpen:=savepen;
pickup pencircle scaled thick; thickpen:=savepen;
pickup pencircle scaled curve; curvepen:=savepen;
pickup penrazor scaled thick; hrazorpen:=savepen;
pickup penrazor scaled thick rotated 90; vrazorpen:=savepen;

path p;
path p[];
string rl;
rl="r";
string tb;
tb="t";
ccode=0;

vardef lside=(sidebar) enddef;
vardef rside=(w-sidebar) enddef;

def fix_width= if odd (rside-lside): w:=w+1 fi enddef;
def fix_height= if odd (h+d): h:=h+1 fi enddef;

% set string rl to "r" or "l" for gap on left or right.
def rtorlft=if rl="r": rt else: lft fi enddef;
def lftorrt=if rl="r": lft else: rt fi enddef;
def zorw=if rl="r": lside else: rside fi enddef;
def worz=if rl="r": rside else: lside fi enddef;
def vmorp=if rl="r": - else: + fi enddef;

def vlooppoints =
fix_height;
h-y1=y5;
y1-y5=vert_gap;
pickup thinpen;
rtorlft x1=worz;
rtorlft x5=worz;
x2=x4=wide_spot[zorw,worz];
top y2=h+curve_overshoot;
bot y4=-curve_overshoot;
pickup curvepen;
lftorrt x3=zorw vmorp curve_overshoot;
y3=.5h;
p:=z1..z2..z3{down}..z4..z5;
penpos1(thin,(angle direction 0 of p) vmorp 90);
penpos2(thin,90);
penpos3(curve,90 - vmorp 90);
penpos4(thin,270);
penpos5(thin,(angle direction 4 of p) vmorp 90);
enddef;

def simplevloop =
vlooppoints;
pickup thinpen;
draw z1..controls postcontrol 0 of p and precontrol 1 of p..z2;
draw z4..controls postcontrol 3 of p and precontrol 4 of p..z5;
cutoff (z1,180+angle direction 0 of p);
cutoff (z5,angle direction 4 of p);
penstroke z2e..z3e{down}..z4e;
labels(1,2,3,4,5);
enddef;

% set string tb to "t" or "b" for gap on top or bottom.
def toporbot=if tb="t": top else: bot fi enddef;
def botortop=if tb="t": bot else: top fi enddef;
def zorh=if tb="t": 0 else: h fi enddef;
def horz=if tb="t": h else: 0 fi enddef;
def hmorp=if tb="t": - else: + fi enddef;

def hlooppoints =
fix_width;
rside-x1=x5-lside;
x1-x5=horiz_gap;
pickup thinpen;
toporbot y1=horz;
toporbot y5=horz;
y2=y4=wide_spot[zorh,horz];
rt x2=rside+curve_overshoot;
lft x4=lside-curve_overshoot;
pickup curvepen;
botortop y3=zorh hmorp curve_overshoot;
x3=.5[lside,rside];
p:=z1..z2..z3{left}..z4..z5;
penpos1(thin,(angle direction 0 of p) hmorp 90);
penpos2(thin,0);
penpos3(curve,0 hmorp 90);
penpos4(thin,180);
penpos5(thin,(angle direction 4 of p) hmorp 90);
enddef;

def simplehloop =
hlooppoints;
pickup thinpen;
draw z1..controls postcontrol 0 of p and precontrol 1 of p..z2;
draw z4..controls postcontrol 3 of p and precontrol 4 of p..z5;
cutoff (z1,180+angle direction 0 of p);
cutoff (z5,angle direction 4 of p);
penstroke z2e..z3e{left}..z4e;
labels(1,2,3,4,5);
enddef;

def vsqig =
transform vsqigtrans;
(lside,0) transformed vsqigtrans = (rside,h);
(lside,h) transformed vsqigtrans = (rside,0);
(rside,0) transformed vsqigtrans = (lside,h);
pickup thinpen;
rt x.taga=rside;
rt x.tagb=rside;
top y.taga=h;
top y.tagb=y.taga - 1/2(h-vert_gap);
draw (z.taga--z.tagb)
	if rl="r": else: rotatedaround(.5[(lside,0),(rside,h)],180) fi;
pickup pencircle scaled .5[fine,thin];
bot y.s.3=0;
1.5*(y.s.3-y.s.2)=y.s.2-y.s.1=y.s.1-y.tagb;
x.s.3=x.s.1+thin;
x.s.2=x.taga+thin;
x.s.1=x.taga-2fine;
draw (z.tagb..z.s.1..z.s.2..z.s.3)
	if rl="r": else: rotatedaround(.5[(lside,0),(rside,h)],180) fi;
labels(taga,tagb,s.1,s.2,s.3)
enddef;

def hsqig =
transform hsqigtrans;
(lside,0) transformed hsqigtrans = (rside,h);
(lside,h) transformed hsqigtrans = (rside,0);
(rside,0) transformed hsqigtrans = (lside,h);
pickup thinpen;
top y.taga=h;
top y.tagb=h;
lft x.taga=lside;
lft x.tagb=x.taga + 1/2(rside-lside-horiz_gap);
draw (z.taga--z.tagb)
	if tb="t": else: rotatedaround(.5[(lside,0),(rside,h)],180) fi;
pickup pencircle scaled .5[fine,thin];
rt x.s.3=rside+fine;
1.5*(x.s.3-x.s.2)=x.s.2-x.s.1=x.s.1-x.tagb;
y.s.3=y.s.1+thin;
y.s.2=y.taga+thin;
y.s.1=y.taga-2fine;
draw (z.tagb..z.s.1..z.s.2..z.s.3)
	if tb="t": else: rotatedaround(.5[(lside,0),(rside,h)],180) fi;
labels(taga,tagb,s.1,s.2,s.3)
enddef;

def vcurlpoints =
  x1.1=x1.2=x5.1=x5.2=x1 vmorp thin;
  lasty:=ypart point infinity of p;
  y1.1=y1 + 1.5thin;
  y1.2=y1 - .5thin;
  y5.1=lasty - 1.5thin;
  y5.2=lasty + .5thin;
enddef;

def vcurl =
  vcurlpoints;
  pickup thinpen;
  cutdraw z1.1{z1-z2}..z1..z1.2..tension 2 and 1..{vmorp right}z2;
  cutdraw z5.1{point infinity of p-(point ((length p)-1) of p)}..
     point infinity of p..z5.2
     ..tension 2 and 1..{vmorp right}(point ((length p)-1) of p);
  cullit;
enddef;

def hcurlpoints =
  y1.1=y1.2=y5.1=y5.2=y1 hmorp thin;
  lastx:=xpart point infinity of p;
  x1.1=x1 + 1.7thin;
  x1.2=x1 - .5thin;
  x5.1=lastx - 1.7thin;
  x5.2=lastx + .5thin;
enddef;

def hcurl =
  hcurlpoints;
  pickup thinpen;
  cutdraw z1.1{z1-z2}..z1..z1.2..tension 2 and 1..{hmorp up}z2;
  cutdraw z5.1{point infinity of p-(point ((length p)-1) of p)}..
     point infinity of p..z5.2
     ..tension 2 and 1..{hmorp up}(point ((length p)-1) of p);
  cullit;
enddef;

def begloopchar(expr code) =
beginchar(code,loop_w#+2sidebar#,loop_h#,0u#); enddef;

def autoloopchar = begloopchar(incr ccode) enddef;

def vvoice =
  z.larynx=if known x7: z4 vmorp (1/2curve,0) else: z3 fi;
  y.voice=y.larynx;
  x.voice=voice_length[if rl="r": lside,rside else: rside,lside fi];
  pickup vrazorpen;
  draw z.voice--z.larynx;
enddef;

def hvoice =
  z.larynx=if known x7: z4 hmorp (0,1/2curve) else: z3 fi;
  x.voice=x.larynx;
  y.voice=voice_length[if tb="t": 0,h else: h,0 fi];
  pickup hrazorpen;
  draw z.voice--z.larynx;
enddef;

vardef upward(expr x) =
  ypart direction 1 of (z1{curl 5}..(x,y2)..z3{down}..z4) > 0
enddef;

def vdintpoints =
h-y1=y7;
y1-y7=vert_gap;
pickup thinpen;
rtorlft x1=worz;
rtorlft x7=worz;
x2=x6;
top y2=h+curve_overshoot;
bot y6=-curve_overshoot;
pickup curvepen;
lftorrt x3=zorw vmorp curve_overshoot;
x5=x3;
y3-y5=.5h;
y5=1/4h;
lftorrt x4=(zorw - vmorp 1.2curve) vmorp curve_overshoot;
y4=.5h;
x2=solve upward(x1,x3);
p:=z1{curl 5}..z2..z3{down}..z4&
   z4..z5{down}..z6..{curl 5}z7;
penpos1(thin,(angle direction 0 of p) vmorp 90);
penpos2(thin,90);
penpos3(curve,90 - vmorp 90);
penpos4(curve,90 - vmorp 90);
penpos5(curve,90 - vmorp 90);
penpos6(thin,270);
penpos7(thin,(angle direction 6 of p) vmorp 90);
enddef;


vardef rightward(expr y) =
  xpart direction 1 of (z1{curl 5}..(x2,y)..z3{left}..z4) > 0
enddef;

def hdintpoints =
rside-x1=x7-lside;
x1-x7=horiz_gap;
pickup thinpen;
toporbot y1=horz;
toporbot y7=horz;
y2=y6;
rt x2=rside+curve_overshoot;
lft x6=lside-curve_overshoot;
pickup curvepen;
botortop y3=zorh hmorp curve_overshoot;
y5=y3;
x3-x5=.5(rside-lside);
x5=1/4[lside,rside];
botortop y4=(zorh - hmorp 1.2curve) hmorp curve_overshoot;
x4=.5[lside,rside];
y2=solve rightward(y1,y3);
p:=z1{curl 5}..z2..z3{left}..z4&
   z4..z5{left}..z6..{curl 5}z7;
penpos1(thin,(angle direction 0 of p) - hmorp 90);
penpos2(thin,0);
penpos3(curve,0 hmorp 90);
penpos4(curve,0 hmorp 90);
penpos5(curve,0 hmorp 90);
penpos6(thin,180);
penpos7(thin,(angle direction 6 of p) - hmorp 90);
enddef;

def vclose=
  pickup thinpen;
  top rtorlft z.one=(worz,h);
  bot rtorlft z.two=(worz,0);
  draw z.one--z.two;
enddef;

def hclose=
  pickup thinpen;
  lft toporbot z.one=(lside,horz);
  rt toporbot z.two=(rside,horz);
  draw z.one--z.two;
enddef;

def bothvloop = for t="r","l": for u=1,2: enddef;

def bothhloop = for t="t","b": for u=1,2: enddef;


full_serif=curve;    % *half* the width of a full-sized serif.
slab=fine;
curl_w=3/2curve;

pickup penrazor scaled slab rotated 90; serifpen:=savepen;

def serifize(expr y) =
  pickup serifpen;
  draw (x.stem-full_serif,y)--(x.stem+full_serif,y);
enddef;

def roundingbar =
  serifize(1/2[-d,h]) enddef;

def vowelstem =
  pickup hrazorpen;
  draw (x.stem,0)--(x.stem,loop_h);
enddef;

curl_top=3/8curl_w;

def widecurl(expr pt,ud,rl) =
  % ud and rl are 1 or -1 for up and right or down and left, resp.
  begingroup save x; save y;
  z1=pt;
  % allow for top or bot...
  z2=pt+(curl_top*rl,if ud>0: vowel_asc - else: -vowel_d + fi 1/2thin);
  % allow for lft or rt...
  z3=pt+(curl_w*rl-1/2thin*rl,0);
%  penpos1(thick,90-ud*90);
%  penpos2(thin,-90*rl);
%  penstroke z1e{up*ud}..z2e{right*rl};
  pickup pencircle xscaled thick yscaled thin;
  draw z1{up*ud}..z2{right*rl};
  pickup thinpen;
  draw z2{right*rl}..{down*ud}z3;
  cullit;
  cutoff(z3,270*ud);
  endgroup;
enddef;

def closebulb(expr pt,ud,rl) = 
  begingroup save x; save y;
%  pickup pencircle scaled 1u;
  z1=pt-(rl*1/2thick,0);
%  z2=pt+(curl_top*rl,if ud>0: vowel_asc else: -vowel_d fi);
%  z3=pt+(curl_w*rl,fine*ud);
%  z4=z2+(-rl*1/4fine,-ud*fine);
%  z5=z1+(rl*thick,0);
%  draw z1{up*ud}..{rl*right}z2..{ud*down}z3..{ud*up}z4&
%	z4..{ud*down}z5;
%  labels(1,2,3,4,5);
  p1:=fullcircle scaled curve shifted 
	(pt + (rl*(curl_w-1/2curve),
		(if ud>0: vowel_asc - else: -vowel_d + fi 1/2curve)));
  fill p1;
  z2=point if ud>0: 2 else: 6 fi of p1;
  z3=z1+(rl*thick,0);
  z4=point if rl>0: 4 else: 0 fi of p1;
  fill z1{ud*up}..{rl*right}z2--z4..z3{ud*down}--cycle;
  endgroup;
enddef;

vardef llside=(3/4lmodside) enddef;	% modifiers and breath glide
				  	% are shifted left.
vardef rrside=(w-rmodside) enddef; 

pickup penrazor scaled 2/3fine rotated 90; smallserifpen:=savepen;

def width_serif(expr ht)= draw (lside,ht)--(rside,ht) enddef;

%%%%%%%%%%%
font_slant 0;
font_normal_space 70u#;
font_normal_stretch 15u#;
font_normal_shrink 10u#;
font_x_height loop_h#;
font_quad loop_w#;
font_extra_space 0;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

input viscons;
input visvowels;
input visglides;
input vismods;