%{{{ dk.mf -- Top-level driver for Ditko, the STOMPING SCENE logo font
% dk.mf 1.1.2 92/02/17
% Copyright (C) 1990, 1991 Damian Cugley
% - pdc Tue. 25 Sept. 1990

% This is a "folded" file - likes starting % {{{ or % }}} indicate
% start and end of sections.  (I use a folding editor.)

boolean testing; testing := unknown mode;

%{{{  Print version info
string font_version_string; 
font_version_string = "1.2 <pdc 92/02/17>";

if tracingtitles > 0:
    message "Ditko version " & font_version_string;
    message "Copyright (C) 1990 Damian Cugley";
fi
%}}}
%{{{  Macros
%{{{   Utility macros

vardef isalpha_p primary c =
    save ch; ch = byte c;
    (ch > 64) and (ch < 91) or (ch > 96) and (ch < 123)
enddef;

vardef isupper_p primary c =			  % must already be alpha
    byte c < 96
enddef;

vardef isdigit_p primary c =
    save ch; ch = byte c;
    (ch > 47) and (ch < 58)
enddef;

def islower_p primary c = not isupper_p c enddef;
%}}}
%{{{   Macros to start characters with

let Beginchar = beginchar;
let elif = elseif;

def beginchar(expr code, wd_u, ht, dp, lr, rr) = 
    Beginchar(code, wd_u * u# + (lr + rr)*space#, ht, dp);
    if isalpha_p(code): 
        if islower_p(code): 
    	    "variant letter " & char(byte code - 32); 
    	else: 
    	    "letter " & code;
    	fi
    elif isdigit_p(code):
    	"figure " & code;
    fi
    save l, r;
    l = hround(lr * space# * hppp); r = w - hround(rr * space# * hppp);
    pickup round_pen;
enddef;

def stdchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, cap_ht#, 0v#, lr, rr)
enddef;

def tallchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, body_ht#, 0v#, lr, rr)
enddef;

def dipchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, cap_ht#, dip_dp#, lr, rr)
enddef;

def talldipchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, body_ht#, dip_dp#, lr, rr)
enddef;

def Dipchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, cap_ht#, body_dp#, lr, rr)
enddef;

def Talldipchar(expr code, wd_u, lr, rr) = 
    beginchar(code, wd_u, body_ht#, body_dp#, lr, rr)
enddef;

def change_width =		% maybe something more sophisticated later
    if l < (w - r): 
    	r := r + 1;
    else: 
    	l := l - 1;
    fi
enddef;

def ifcode suffix $ = if known code$ enddef;%}}}
%{{{   Alter the way the bbox is drawn

def makebox(text rule) =
    for y = 0, body_ht, -body_dp, cap_ht, axis:
    	rule((l,y)t_, (r,y)t_); 
    endfor
    for x = l, r: rule((x, -body_dp)t_, (x, body_ht)t_); endfor
    for x = 0, w: rule((x, -dip_dp)t_, (x, dip_dp)t_); endfor
				% indicate "reference points"
    if charic <> 0:
    	rule((r + charic*pt, h o_), (r + chatic*pt, 1/2h o_));
    fi
enddef;



%}}}
%{{{   Bits of kit
%{{{     Nomenclature

% z h - point where curve has horiz tangent
% z v - vertical tangent
% z j - joins stem etc.
% z f - foot

%}}}     Nomenclature
%{{{     Curves

vardef curve_qtr_path(expr zh, zv) =
    zh{(xpart zv - xpart zh, 0)}
    	... superosity[(xpart zh, ypart zv), (xpart zv, ypart zh)] {zv - zh}
    	... zv{(0, ypart zv - ypart zh)}
enddef;

vardef curve_vhalf_path(expr zh, zv, zhh) =
    curve_qtr_path(zh, zv) & reverse curve_qtr_path(zhh, zv)
enddef;

vardef curve_hhalf_path(expr zv, zh, zvv) =
    reverse curve_qtr_path(zh, zv) & curve_qtr_path(zh, zvv)
enddef;

vardef curve_cycle(expr zv, zh, zvv, zhh) =
    curve_vhalf_path(zh, zv, zhh) & curve_vhalf_path(zhh, zvv, zh) & cycle
enddef;
%}}}     Curves
%{{{     "i" stuff - also "j" and lefthand stems

vardef istem_pts@#(expr leftx, topy, boty) =
    lft x@#jut = leftx; lft x@#top = lft x@#bot = hround(leftx + jut);
    top y@#jut = top y@#top = topy;
    bot y@#bot = boty;
    labels(@#jut, @#top, @#bot);
enddef;

%  Add a "tail" to the bottom of an existing istem:
vardef jtail_attach@#(suffix $$) =
    z@#e = (lft x$$bot - jut, -d) + pen_adj;      % end of tail
    z@#j = (rt x$$bot, baseline) - pen_adj;	  % where tail joins stem
    bot rt z@#bot' = z@#c;			  % z@#bot' is new end of stem
    z@#c = z@#j + whatever * (z@#j - z@#e) rotated -90;
    x@#c = rt x$$bot;
    penlabels(@#e, @#j, @#c, @#bot')
enddef;

%  draw these with the square pen:
vardef istem_path@# = z@#jut -- z@#top -- z@#bot enddef;
vardef jstem_path@# = z@#jut -- z@#top -- z@#bot' enddef;

%  cutdraw this with the round pen:
vardef jtail_path@# = z@#e -- z@#j enddef;
%}}}
%{{{     "n" bowl - also makes "h" 

vardef nbowl_pts@#(expr leftx, rightx) =
    z@#f = (r - nindent, baseline - 1/4penw); % foot
    y@#v = 1/2h; y@#j = njoin; 
    rt x@#v = r; lft x@#j = leftx;
    top y@#h = cap_ht + o; x@#h = 1/2[x@#j,x@#v];	% top of arch
    labels(@#j, @#h, @#v, @#f)
enddef;

vardef njoin_path@# =
     z@#j{(z@#h - z@#j) yscaled 2} ... {(z@#h - z@#j) yscaled 0}z@#h
enddef;

vardef nbowl_path@# =
    njoin_path@# &  curve_qtr_path(z@#h,z@#v) .. z@#f
enddef;
%}}}
%{{{     "c" curve - also makes "G", "E" etc.

vardef cbowl_pts@#(expr leftx, rightx) =
    x@#1 = x@#5 = rightx - xpart pen_adj;	
    x@#2 = x@#4 = 0.55[leftx,rightx];
    lft x@#3 = leftx - o;
    cap_ht - y@#1 = baseline + y@#5 = cgap;
    top y@#2 = cap_ht + o; bot y@#4 = baseline - o;
    y@#3 = 1/2[y@#2,y@#4];
    labels(@#1, @#2, @#3, @#4, @#5)
enddef;

vardef cbowl_path@# =
    z@#1 ... curve_vhalf_path(z@#2,z@#3,z@#4) ... z@#5
enddef;
%}}}
%{{{     "p" bowl - also for "B", "R", "D"

vardef pbowl_pts@#(expr leftx, rightx, midy) =
    lft x@#j = leftx; x@#e = hround(leftx + penw + 1/2u);
    rt x@#v = rightx; 
    x@#h = x@#hh = 0.45[x@#j, x@#v];
    top y@#h = cap_ht + o; y@#e = midy + 1/2v; 
    y@#hh = midy; y@#j = njoin;
    y@#v = 0.5[y@#h, y@#hh];
    labels(@#j, @#h, @#v, @#hh, @#e)
enddef;

vardef pbowl_path@# = 
    z@#j ... curve_vhalf_path(z@#h, z@#v, z@#hh) .. z@#e 
enddef;

vardef pbowl_draw@# = 
    draw z@#j ... curve_vhalf_path(z@#h, z@#v, z@#hh) .. z@#e;
    cutoff(z@#e, 180);
enddef;
%}}}
%{{{     "u" bowl

%  Adapted from "n" -- pdc Tue.  5 Nov. 1991

vardef ubowl_pts@#(expr leftx, rightx) =
    z@#t = (leftx + nindent, cap_ht + 1/4penh);
    y@#v = 1/2h; y@#j = cap_ht -  njoin; 
    lft x@#v = leftx; rt x@#j = rightx;
    bot y@#h = baseline - o; x@#h = 1/2[x@#j,x@#v];
    top y@#jut1 = top y@#jut2 = cap_ht;
    %%%%    lft x@#jut1 = leftx; rt x@#jut2 = rt x@#t;
    labels(@#j, @#h, @#v, @#t, @#jut1, @#jut2)
enddef;

vardef ujoin_path@# =
     z@#j{(z@#h - z@#j) yscaled 2} ... {(z@#h - z@#j) yscaled 0}z@#h
enddef;

vardef ubowl_path@# =
    ujoin_path@# &  curve_qtr_path(z@#h,z@#v) .. z@#t
enddef;

%vardef ujut_path@# = 
%    z@#jut1 -- z@#jut2
%enddef;

%}}}
%}}}   Bits of kit
%}}}  Macros
%{{{  Setting up
%{{{   Ensure that |weight| etc. have been given values
def set_default(suffix $)(expr v) =
    if unknown $: $ = v; fi
enddef;

set_default(weight, 1);
set_default(hratio, 1);
set_default(slant,  0);

%}}}
%{{{   Set various "ad-hoc" parameters

v# = 1/18designsize; 
u# = v# * hratio;

body_ht#    = 14v#;		% height of letters that go up
cap_ht#	    = 12v#;		% height of most letters
shoulder_ht#= 10v#;		% height of `0'
axis#	    = 1/2[body_ht#, -body_dp#];
dip_dp#	    = 2v#;		% dip of most letters that dip
body_dp#    = 4v#;		% dip of letters that dip a lot

agap#	    = 4u#;		% amount arch of "a" indented
ajut#	    = 3.5u#;		% amount arch hanges over (>= jut#)
cgap#	    = 2.5v#;		% amount ends of "c" curl in
nindent#    = 2.5u#;		% indent of foot of "n" etc.
njoin#	    = 9u#;		% attatchment point for "n" etc to stem
jut#	    = 2u#;		% amount serifs stick out

penw# 	    = 2v# * weight;
penh# 	    = penw#;		% might change this later
o#  	    = 1/6v#;		% overshoot

space#	    = 1v#;		% standard sidebar

superosity  = 3/4;		% bit squarer than ellipses
%}}}
%{{{   Convert to device units & create pens

mode_setup;
define_pixels(u, v, body_ht, body_dp, axis, cgap, nindent, njoin, space);
define_whole_pixels(jut, agap, ajut);
define_whole_vertical_pixels(shoulder_ht, cap_ht, dip_dp);
define_whole_blacker_pixels(penw);
define_whole_vertical_blacker_pixels(penh);
define_corrected_pixels(o);

baseline = 0pt;

pickup pensquare xscaled penw yscaled penh; square_pen = savepen;
pickup pencircle xscaled penw yscaled penh; round_pen = savepen;
				% for doing cutdraw operations

pair pen_adj; pen_adj = 1 / (2*sqrt2) * (penw, penh);

currenttransform := identity slanted slant
    yscaled aspect_ratio 
    scaled granularity;

%  If the result of asll that is the identity, economize on time somwhat:
if currenttransform = identity: 
    let t_ = relax
else: 
    def t_ = transformed currenttransform enddef 
fi;
%}}}
%}}}
%{{{  Input program files

%  Allocate ligatures in 128..255:
numeric next_lig; next_lig = 127;		  % one less than min code
def set_codes text t =
    forsuffixes $$$ = t:
    	code$$$ = incr next_lig;
    endfor
enddef;

set_codes short_dash, long_dash, left_quote, right_quote, german_quote;
input dkpunct

input dksym

set_codes ll, oo;
input dkalpha	% first pass - all uppercase
if not testing: \input dkalpha fi
    % second pass - lowercase with variants uppercase
%input dkfigs
%}}}
%{{{  Ligtable

ifcode.short_dash:
    ligtable "-": "-" =: code.short_dash;
    ligtable code.short_dash: "-" =: code.long_dash;
fi

ifcode.left_quote:
    ligtable "`": "`" =: code.left_quote;
    ligtable "'": "'" =: code.right_quote;
fi

ifcode.german_quote:
    ligtable ",": "," =: code.german_quote;
fi

% Letters

def tkern = "t" kern -(6u# - 1/2penw#) + 1/2space# enddef;

ligtable "a": "A": tkern
    ifcode.ae: , "e" =: code.ae fi
;

ifcode.ee:
    ligtable "e": "e" =: code.ee;
fi

ligtable "l": "L": tkern
    ifcode.ll: , "l" =: code.ll fi
;

ifcode.oo:
    ligtable "o": "o" =: code.oo;
fi

ligtable "r": "R": "e" kern -u# ;

ligtable "u": "U": 
    "l" kern -1/2jut#, "L" kern -1/2jut#,   
    "r" kern -1/2jut#, "R" kern -1/2jut#;

ligtable "v": "V": "e" kern -u#;
%}}}  ligtable
%{{{  Font metric info

font_identifier	    = jobname;
font_coding_scheme  = "Font-specific";
font_slant  	    = slant;
font_normal_space   = 6u#;
font_normal_stretch = 4u#;
font_normal_shrink  = 2u#;
fotn_x_height	    = cap_ht#;
font_quad   	    = 18u#;
font_extra_space    = 4u#;


%}}}
%}}} dk.mf

%Local variables:
%fold-folded-p: t
%End: