// M M F O N T S -- make the Master Maker font file
// catalog number ???
//
get "ix.dfs"
get "scan.dfs"
// outgoing procedures
external
[
MMFonts
]
// outgoing statics
//external
// [
// ]
//static
// [
// ]
// incoming procedures
//external
// [
// ]
// incoming statics
external
[
//PLAYOUT
PlayOutFont
//PREPRESS
PrePressWindowInit
WindowRead
WindowWrite
WindowGetPosition
WindowSetPosition
WindowWriteBlock
WindowReadBlock
WindowClose
GetPosRelative
ReadIX
DecodeFace
Scream
//OS
Zero; SetBlock; MoveBlock
//CONVERT
Cos
//UTIL
FSGetX
FSPut
MulDiv
//SCAN
ReadCom
TypeForm
StrEq
ScanInit
ScanSet
ScanCh
ScanClose
//FLOAT
DPAD; DPSB; DPCop
]
// internal statics
static
[
out //Stream for output file
familylist //Main list
fontlist //List of all fonts to process
fw //File of widths
]
// File-wide structure and manifest declarations.
structure IName:
[
@IXN //PREPRESS name
next word //link
Styles word //list of IWidths for various faces
Sizes word //list of ISize entries
]
structure IWidth:
[
@IX //PREPRESS entry from SPLINEWIDTHS
next word //link
]
structure ISize:
[
Siz word //Micas
Rotation word //minutes....
Fonts word //List of IAlto entries for this size,
next word //link
]
structure IAlto:
[
@IX //Entry from .AC file.
FileName word 20 //.AC file name
glyphspot word 2 //place to install final resting position
next word //link for ISize.Fonts
Fontlistnext word //link for all fonts
trantab word //Pointer to character translation table
]
structure VariantHeader:
[
Height word
Rotation word
FakeBold bit
FakeItalic bit
PointSize bit 14
Face word
]
structure PressWidthInfo:
[
Face word
Ascent word
Descent word
Min byte
Max byte
blank bit 15
Fixed bit
MWidth word
]
structure GlyphDescription:
[
GlyphRecord word
GlyphWordLength word
Soffset word
Boffset word
AxisPermutation bit 2
blank bit 14
]
structure AltoWidthInfo:
[
blank bit 13
Corrections bit
FixedX bit
FixedY bit
XWidth word
YWidth word
]
structure GLYPH:
[
Balign byte
Salign byte
Bwcount bit 6
Scount bit 10
]
// Procedures
//GlyphRotations:
// 0 => just AxisPermutation=0
// 1 => just 0,1
// 2 => 0,1,2,3
let MMFonts(switch) be
[
let GlyphRotations=selecton switch into
[
case $2: 1
case $4: 2
default: 0
]
familylist=0
fontlist=0
PrepareLists() //Go make data structure for each thing.
out=PrePressWindowInit("MasterMaker.Fonts")
WindowWrite(out,0) //will be count of families
let nFamilies=0
let f=familylist //Now go through them:
while f do
[
if f>>IName.Styles ne 0 & f>>IName.Sizes ne 0 then
[Good
nFamilies=nFamilies+1
let lenpos=vec 1
let countpos=vec 1
WindowGetPosition(out,lenpos)
WindowWrite(out,0) //Will be length of family stuff
WindowWriteBlock(out,lv f>>IXN.Name,10)
TypeForm("Family: ",lv f>>IXN.Name,0)
let st=f>>IName.Styles //Write all spline width tables
WindowGetPosition(out,countpos)
WindowWrite(out,0)
let nFaces=0
let writtenmask=0
while st do
[
writtenmask=WritePressWidthInfo(st,writtenmask)
nFaces=nFaces+1
st=st>>IWidth.next
]
if writtenmask ne #17 then Scream("It seems that a face is missing!")
WriteAtPos(out,countpos,nFaces)
WindowGetPosition(out,countpos)
WindowWrite(out,0)
let nVariants=0
st=f>>IName.Styles //For making width corrections
let s=f>>IName.Sizes
while s do
[ //Put out all faces of a particular size
// and rotation
let fo=s>>ISize.Fonts
TypeForm(" Size:",10,s>>ISize.Siz)
TypeForm(" Basic rotation:",10,s>>ISize.Rotation,0)
let foh=fo
while foh do
[
let fot=foh>>IAlto.next
while fot do
[
if foh>>IAlto.face eq fot>>IAlto.face then
Scream("You have two character fonts with the same face.")
fot=fot>>IAlto.next
]
foh=foh>>IAlto.next
]
unless WriteVariant(0,fo,st,GlyphRotations) //MRR
then Scream("No MRR face for this size.")
WriteVariant(1,fo,st,GlyphRotations) //MIR or fake
WriteVariant(2,fo,st,GlyphRotations) //BRR or fake
WriteVariant(3,fo,st,GlyphRotations) //BIR or fake
nVariants=nVariants+4
while fo do
[
unless (lv fo>>IAlto.glyphspot)!1 then
[
WriteVariant(fo>>IAlto.face,fo,st,GlyphRotations)
nVariants=nVariants+1
]
fo=fo>>IAlto.next
]
s=s>>ISize.next
]
WriteAtPos(out,countpos,nVariants)
let thispos=vec 1
WindowGetPosition(out,thispos)
DPSB(thispos,lenpos)
let len=thispos!1
WriteAtPos(out,lenpos,len)
]Good
f=f>>IName.next
]
WriteAtPos(out,(table [ 0;0 ] ),nFamilies)
let RotI=(table [ 0;1;2;3;-1 ])
if GlyphRotations eq 0 then RotI!1=-1
if GlyphRotations eq 1 then RotI!2=-1
let font=fontlist
while font do
[
if (lv font>>IAlto.glyphspot)!1 ne 0 then
for i=0 to 3 do //For all glyph rotations
[
if RotI!i ls 0 then break
let v=vec (size GlyphDescription/16)
Zero(v,size GlyphDescription/16)
let rec=MoveToRecord(out) //Move to an even record spot
v>>GlyphDescription.GlyphRecord=rec
WriteFONT(font,RotI!i,v) //Go do it!
let temp=vec 1
WindowGetPosition(out,temp)
WindowSetPosition(out,lv font>>IAlto.glyphspot)
WindowWriteBlock(out,v,size GlyphDescription/16)
WindowGetPosition(out,lv font>>IAlto.glyphspot) //for next rotn
WindowSetPosition(out,temp) //Back to where we were
]
font=font>>IAlto.Fontlistnext
]
//Now pare down the output file if needed.
WindowClose(out,-1) //Truncate!
WindowClose(fw)
]
and
//Read command line, and prepare the data structure that represents
// all the fonts we are to include
PrepareLists() be
[
let prev=nil
let this=nil
let filestr=vec 20
let swvec= vec 4
unless ReadCom(filestr) then Scream("No SplineWidths file.")
fw=PrePressWindowInit(filestr,false) //Open it for reading
[ let v=vec IXLMax
ReadIX(fw,v)
if v>>IX.Type eq IXTypeEnd then break
if v>>IX.Type eq IXTypeName then
[
let p=FSGetX(size IName/16)
MoveBlock(p,v,size IXN/16)
p>>IName.next=familylist
familylist=p
p>>IName.Styles=0
p>>IName.Sizes=0
]
if v>>IX.Type eq IXTypeWidths & v>>IX.siz eq 0 then
[
let p=FSGetX(size IWidth/16)
MoveBlock(p,v,size IX/16)
let cn=v>>IX.fam
let q=familylist
while q do
[
if q>>IXN.Code eq cn then
[ //Found family; sort into styles
prev=(lv q>>IName.Styles)-(offset IWidth.next/16)
[
this=prev>>IWidth.next
if this eq 0 % FaceCompareGe(this>>IWidth.face,p>>IWidth.face)
then break
prev=this
] repeat
p>>IWidth.next=this
prev>>IWidth.next=p
break
]
q=q>>IName.next
]
if q eq 0 then Scream("Width table with no family.")
]
] repeat
//Now read all parts of all other files, looking for IXTypeChars entries...
let trantab=0
while ReadCom(filestr,swvec) do
[
if swvec!0 eq 1 & swvec!1 eq $M then
[
trantab=ReadTranTab(filestr)
loop
]
let sw=PrePressWindowInit(filestr,false)
let p=familylist
while p do
[
p>>IXN.Code=-1 //Will not compare
p=p>>IName.next
]
let v=vec IXLMax
[
ReadIX(sw,v)
if v>>IX.Type eq IXTypeEnd then break
if v>>IX.Type eq IXTypeName then
[
p=familylist
while p do
[
if StrEq(lv p>>IXN.Name,lv v>>IXN.Name) then
p>>IXN.Code=v>>IXN.Code
p=p>>IName.next
]
]
if v>>IX.Type eq IXTypeChars then
[
p=familylist
while p do
[
if p>>IXN.Code eq v>>IX.fam then break
p=p>>IName.next
]
if p eq 0 then Scream("Family not in widths file")
prev=(lv p>>IName.Sizes)-(offset ISize.next/16)
[
this=prev>>ISize.next
if this eq 0 % this>>ISize.Siz gr v>>IX.siz %
(this>>ISize.Siz eq v>>IX.siz &
this>>ISize.Rotation ge v>>IX.rotation) then break
prev=this
] repeat
if this eq 0 % this>>ISize.Rotation ne v>>IX.rotation %
this>>ISize.Siz ne v>>IX.siz then
[
let t=FSGetX(size ISize/16)
t>>ISize.Siz=v>>IX.siz
t>>ISize.Rotation=v>>IX.rotation
t>>ISize.Fonts=0
t>>ISize.next=this
prev>>ISize.next=t
this=t
]
let n=FSGetX(size IAlto/16)
n>>IAlto.next=this>>ISize.Fonts
this>>ISize.Fonts=n
@(lv n>>IAlto.glyphspot)=0
MoveBlock(n,v,size IX/16)
MoveBlock(lv n>>IAlto.FileName,filestr,size IAlto.FileName/16)
n>>IAlto.trantab=trantab
n>>IAlto.Fontlistnext=fontlist
fontlist=n
]
] repeat
WindowClose(sw)
trantab=0
] //While ReadCom
]
and
//Read translation table (for dummy fonts, etc.)
// WARNING: it is essential that the actual font have the same beginning
// char code and ending char code as the translation table!!!!!
ReadTranTab(file) = valof
[
let s=FSGetX(256);
for i=0 to 255 do s!i=i //Default=identity mapping
let scsf=vec SCANIlen
if ScanInit(scsf,file) then
[
ScanSet(scsf)
[ //Repeat loop
let v=vec 1
for i=0 to 1 do
[
[
let c=ScanCh()
if c eq EOF then [ ScanClose(); resultis s ]
test c eq $# then
[
let oct=0
[
let c=ScanCh()
if c ls $0 % c gr $7 then break
oct=(oct lshift 3)+c
] repeat
v!i=oct
break
]
or
if c ne $*N & c ne #40 then
[
v!i=c
break
]
] repeat
] //for i=0 to 1
s!(v!0)=v!1 //Set translation table
] repeat //Repeat
] //Scaninit
]
and
//Given an IWidth entry, write the PressWidthInfo structure on the file.
WritePressWidthInfo(style,mask) = valof
[
let v=vec (size PressWidthInfo/16)
Zero(v,size PressWidthInfo/16)
v>>PressWidthInfo.Face=style>>IX.face
WindowSetPosition(fw,lv style>>IX.sa)
let w=vec size WTB/16
WindowReadBlock(fw,w,size WTB/16)
let off=-w>>WTB.YB //probably neg
if off ls 0 then off=0
let hig=w>>WTB.YH+w>>WTB.YB
v>>PressWidthInfo.Ascent=hig
v>>PressWidthInfo.Descent=off
let Min=style>>IX.bc
let Max=style>>IX.ec
v>>PressWidthInfo.Min=Min
v>>PressWidthInfo.Max=Max
unless w>>WTB.YWidthFixed then Scream("Y width not fixed")
if w>>WTB.XWidthFixed then
[
v>>PressWidthInfo.Fixed=true
v>>PressWidthInfo.MWidth=WindowRead(fw)
]
WindowWriteBlock(out,v,size PressWidthInfo/16)
unless w>>WTB.XWidthFixed then
[
for i=Min to Max do WindowWrite(out,WindowRead(fw))
]
let nm=selecton v>>PressWidthInfo.Face into [
case 0: 1 //MRR
case 1: 2 //MIR
case 2: 4 //BRR
case 3: 8 //BIR
default: 0 ]
resultis (mask%nm)
]
and
//Write a variant entry corresponding to the face facecode.
// If this face does not appear on fontlist (IAlto structures), then
// "fake" it. styles is a list of IWidth entries that may be needed for
// calculating corrections!
WriteVariant(facecode,fontlist,styles,GlyphRots) =valof
[
let font=nil
let f=fontlist
let fake=true
while f do
[
let fc=f>>IAlto.face
if fc eq 0 then font=f //MRR font
if fc eq facecode then [ font=f; fake=false; break ]
f=f>>IAlto.next
]
//Now font is a pointer to the best possible match. Fake is true if
// we are to fake it.
let w,s,e=nil,nil,nil
DecodeFace(facecode,lv w,lv s,lv e)
TypeForm(" Face ",w,s,e)
if fake then TypeForm(" [fake]*N")
let bold=(w eq $B)
let italic=(s eq $I)
let v=vec (size VariantHeader/16)
Zero(v,(size VariantHeader/16))
v>>VariantHeader.Height=font>>IAlto.siz
v>>VariantHeader.Rotation=font>>IAlto.rotation
v>>VariantHeader.Face=facecode
if fake & italic then v>>VariantHeader.FakeItalic=true
if fake & bold then v>>VariantHeader.FakeBold=true
v>>VariantHeader.PointSize=MulDiv(font>>IAlto.siz+17,18,635)
//Now find the entry in styles that corresponds to the face we are writing.
until styles eq 0 % styles>>IWidth.face eq font>>IAlto.face do
styles=styles>>IWidth.next
if styles eq 0 then Scream("No widths for an alto font")
let Min=font>>IX.bc
let Max=font>>IX.ec
if styles>>IX.bc ne Min % styles>>IX.ec ne Max then
Scream("Min and Max do not match!")
WindowWriteBlock(out,v,size VariantHeader/16)
if fake then resultis false
let nGlyphDescriptions=selecton GlyphRots into [
case 0: 1
case 1: 2
case 2: 4 ]
TypeForm(" -- ",10,nGlyphDescriptions," axis rotations*N")
WindowWrite(out,nGlyphDescriptions)
WindowGetPosition(out,lv font>>IAlto.glyphspot)
for i=1 to nGlyphDescriptions do
WindowWriteBlock(out,v,(size GlyphDescription/16))
WriteAltoWidthInfo(font,styles,Min,Max)
resultis true
]
and
WriteAltoWidthInfo(font,style,Min,Max) be
[
let mincorrection=1000
let maxcorrection=-1000
let fixedx=true; let fixedy=true
let fixedxval=0; let fixedyval=0
let justwidths=true
let bb=vec 4
let bufx=vec 256
let bufy=vec 256
CalculateWidths(style,fw,font>>IX.siz,font>>IX.rotation,
bb,bufx,bufy,256)
let altox=vec 256
let altoy=vec 256
let c=PrePressWindowInit(lv font>>IAlto.FileName,false)
WindowSetPosition(c,lv font>>IX.sa)
for i=Min to Max do
[
let v=vec size CharWidth/16
WindowReadBlock(c,v,size CharWidth/16)
altox!i=-1
if v>>CharWidth.H eq HNonExCode then loop
let wx=(lv v>>CharWidth.WX)!0
let wy=(lv v>>CharWidth.WY)!0
altox!i=wx
altoy!i=wy
let correctx=wx-bufx!i
let correcty=wy-bufy!i
if wx ls 0 % wy ls 0 then Scream("Widths")
if wx gr 15 % wy gr 15 then justwidths=false
if correctx gr maxcorrection then maxcorrection=correctx
if correctx ls mincorrection then mincorrection=correctx
if correcty gr maxcorrection then maxcorrection=correcty
if correcty ls mincorrection then mincorrection=correcty
test fixedxval eq 0 then fixedxval=wx or
if fixedxval ne wx then fixedx=false
test fixedyval eq 0 then fixedyval=wy or
if fixedyval ne wy then fixedy=false
]
WindowClose(c)
let v=vec size AltoWidthInfo/16
Zero(v,size AltoWidthInfo/16)
if fixedx then
[
v>>AltoWidthInfo.FixedX=true
v>>AltoWidthInfo.XWidth=fixedxval
if fixedy then justwidths=-1
]
if fixedy then
[
v>>AltoWidthInfo.FixedY=true
v>>AltoWidthInfo.YWidth=fixedyval
]
v>>AltoWidthInfo.Corrections=(not justwidths)
WindowWriteBlock(out,v,size AltoWidthInfo/16)
unless justwidths then
[
for i=0 to 255 do
[
let n=nil
let ms="Entry too big for 4-bit table"
n=altox!i-bufx!i+7; altox!i=n
if n ls 0 % n gr 15 then Scream(ms)
n=altoy!i-bufy!i; altoy!i=n
if n ls 0 % n gr 15 then Scream(ms)
]
]
unless fixedx then
Write4Bitties(altox+Min,Max-Min+1)
unless fixedy then
Write4Bitties(altoy+Min,Max-Min+1)
]
and
Write4Bitties(p,n) be
[
for i=0 to n-1 by 4 do
[
let a=p!i 
a=(a lshift 4)+(p!(i+1) )
a=(a lshift 4)+(p!(i+2) )
a=(a lshift 4)+(p!(i+3) )
WindowWrite(out,a)
]
]
and
//Given an IAlto entry, write the font bit-maps on the file.
WriteFONT(font,AxisPerm,glyph) be
[
let pos=vec 1
WindowGetPosition(out,pos)
let c=PrePressWindowInit(lv font>>IAlto.FileName,false)
let v=vec 4; v!0=3; v!1=AxisPerm; v!4=font>>IAlto.trantab
PlayOutFont(v,font,c,out)
let npos=vec 1
GetPosRelative(out,pos,npos)
glyph>>GlyphDescription.GlyphWordLength=npos!1
glyph>>GlyphDescription.AxisPermutation=AxisPerm
glyph>>GlyphDescription.Soffset=v!2
glyph>>GlyphDescription.Boffset=v!3
WindowClose(c)
]
and
WriteAtPos(s,pos,val) be [
let opos=vec 1
WindowGetPosition(s,opos)
WindowSetPosition(s,pos)
WindowWrite(s,val)
WindowSetPosition(s,opos)
]
and
MoveToRecord(s) = valof [
let pos=vec 1
WindowGetPosition(s,pos)
DPAD(pos,(table [ 0;255 ]))
pos!1=pos!1𫓸
WindowSetPosition(s,pos)
resultis (pos!0 lshift 8)+(pos!1 rshift 8)
]
and
FaceCompareGe(f1,f2) = valof [
resultis f1 ge f2
]
//CalculateWidths(best,s,siz,rot,boundbox,bufx,bufy,bufl)
// If you have a file you want to read by hand, use this proc.
// best is an IX entry to get widths from; s is the file; rot
// is the rotation you desire; boundbox is a vec 4 that will be
// filled with the bounding box; bufx and bufy are as for
// LookupFontName
and
CalculateWidths(best,s,siz,rot,boundbox,bufx,bufy,bufl) be
[
SetBlock(bufx,-1,bufl)
SetBlock(bufy,-1,bufl)
//Position s to read width table
WindowSetPosition(s,lv best>>IX.sa)
let wt=vec size WTB/16
WindowReadBlock(s,wt,(size WTB/16))
MoveBlock(boundbox,wt,4) //Extract the bounding box info
let bc=best>>IX.bc
let ec=best>>IX.ec
if bufl ls bc then return // yes but...
let ecb=(ec ge bufl)? bufl,ec
//Now read either one word or a number of words for the widths.
for i=0 to 1 do
[
let bufp=(lv bufx)!i+bc
test ((i eq 0)? wt>>WTB.XWidthFixed,wt>>WTB.YWidthFixed)
ifso [
let v=WindowRead(s)
SetBlock(bufp,v,ecb-bc+1)
]
ifnot [
WindowReadBlock(s,bufp,ecb-bc+1)
]
]
//Now do scaling if needed.
if best>>IX.siz ne 0 then return
for i=bc to ecb do if bufx!i ne #100000 then
[
bufx!i=MulDiv(bufx!i,siz,1000)
bufy!i=MulDiv(bufy!i,siz,1000)
]
for i=0 to 3 do
boundbox!i=SignedMulDiv(boundbox!i,siz,1000)
//And rotation if needed.
if rot eq 0 then return
let cm,cs,sm,ss=nil,nil,nil,nil
Cos(rot,lv cs,lv cm) //Get cosine
Cos(rot-90*60,lv ss,lv sm) //and sine
for i=bc to ecb do if bufx!i ne #100000 then
[
let t=MulDiv(bufx!i,cm,#177777)
if cs then t=-t
let s=MulDiv(bufy!i,sm,#177777)
unless ss then s=-s
let x=t+s
t=MulDiv(bufy!i,cm,#177777)
if cs then t=-t
s=MulDiv(bufx!i,sm,#177777)
if ss then s=-s
bufx!i=x
bufy!i=t+s
]
]
and
SignedMulDiv(a,b,c) = valof [
let sgn=a xor b xor c //Sign bit
let abs(x)=(x ge 0? x,-1)
let res=MulDiv(abs(a),abs(b),abs(c))
resultis (sgn ls 0? -res,res)
]