// F O N T W I D T H S -- publicly distributed file. (PREPRESS)
// catalog number ???
//EncodeFace(weight,slope,expansion) => 8-bit face code.
//An entry that is omitted or made zero is defaulted.
//Arguments are upper case letters (e.g. M R R)
//DecodeFace(face,lvweight,lvslope,lvexpansion)
//Takes 8-bit face code and returns the three descriptive
//letters.
//LookupFontName(s,name,face,size,rotation,bufx,bufy,boundbox
//[,bufferlength,lvp])
//Looks up the font named by name(string),face(encoded as above),
//size(<0 =>microns, >0 => points), rotation(minutes). Returns
//true if match exists, false otherwise. "s" is a stream
//with FONTS.WIDTHS open on it. "bufx" and "bufy" will be filled
//with x and y widths respectively (indexed by char code).
//"boundbox" is a 4-word vector to receive the bounding box
//(rotations of bounding box are not performed!)
//"bufferlength" is the length of the buffer (256 if omitted).
//"lvp" is filled @ with family code (may be omitted)
//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
//MulDiv(a,b,c) => a*b/c
//Multiply and scale. All arguments positive 16-bit numbers.
//Maintains maximum precision.
//SignedMulDiv(a,b,c)
//Same as MulDiv, but will handle signed numbers.
//Cos(theta,lvsign,lvmag)
//Computes the cosine of the angle "theta" (in minutes) and
//returns sign (0 if positive, -1 if negative) and magnitude
//(0 to #177777)


get "ix.dfs"

// outgoing procedures
external
[
EncodeFace
LookupFontName
CalculateWidths
DecodeFace
GenLookup
MulDiv
SignedMulDiv
Cos
]

// outgoing statics
//external
//[
//]
//static
//[
//]

// incoming procedures
external
[
MoveBlock; SetBlock;Zero
Gets
ReadBlock
Resets
PositionPage
PositionPtr
]

// incoming statics
//external
//[
//]

// internal statics
//static
//[
//]

// File-wide structure and manifest declarations.

structure STR: [
byt↑0,255 byte
]

// Procedures

let

EncodeFace(weight,slope,expansion; numargs n) = valof [
for i=2 to n by -1 do (lv weight)!i=0
let w=(selecton weight into [
case 0:
case $M: 0
case $B: 2
case $L: 4
default: -100 ]) +
(selecton slope into [
case 0:
case $R: 0
case $I: 1
default: -100 ]) +
(selecton expansion into [
case 0:
case $R: 0
case $C: 6
case $E: 12
default: -100 ])
if w ls 0 then resultis -1
resultis w
]

and

DecodeFace(face,w,s,e) be [
@s=(table [ $R; $I ])!(face&1)
face=face rshift 1
@w=(table [ $M; $B; $L ])!(face rem 3)
face=face/3
@e=(table [ $R; $C; $E ])!(face rem 3)
]

and

LookupFontName(s,famstr,face,siz,rot,bufx,bufy,boundbox,bufl,lvp; numargs na) = valof [
siz=(siz ls 0)? -siz,MulDiv(siz,635,18)//points to microns
if na eq 8 then bufl=256
Resets(s)
let p=vec IXLMax
[fwReadIX(s,p)//Read an IX entry
if p>>IXH.Type eq IXTypeEnd then resultis false
if p>>IXH.Type eq IXTypeName then
[
let fnd=true
let str=lv p>>IXN.Name
for i=0 to str>>STR.byt↑0 do
if ((str>>STR.byt↑i xor famstr>>STR.byt↑i)&(not #40)) ne 0 then
fnd=false
if fnd then break
]
] repeat
let fam=p>>IXN.Code
if na eq 10 then @lvp=fam
let found=false
let best=vec IXLMax
[fwReadIX(s,p)
if p>>IXH.Type eq IXTypeEnd then break
let sizDif = p>>IX.siz-siz
if sizDif<0 then sizDif = -sizDif
if p>>IXH.Type eq IXTypeWidths then
if p>>IX.fam eq fam &
p>>IX.face eq face &
((sizDif le 2 & p>>IX.rotation eq rot) %
(p>>IX.siz eq 0)) then
[
if found eq false % p>>IX.siz ne 0 then
MoveBlock(best,p,IXLMax)
found=true
]
] repeat
unless found then resultis false
CalculateWidths(best,s,siz,rot,boundbox,bufx,bufy,bufl)
resultis true
]

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
let p=lv best>>IX.sa//DP address of font part.
PositionPage(s,(p!0 lshift 8)+(p!1 rshift 8)+1)
PositionPtr(s,((p!1Ź) lshift 1))
let wt=vec size WTB/16
ReadBlock(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=Gets(s)
SetBlock(bufp,v,ecb-bc+1)
]
ifnot[
ReadBlock(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

fwReadIX(s,p) be [
let a=Gets(s)//Type word.
p!0=a
let l=p>>IXH.Length
if l then ReadBlock(s,p+1,l-1)
]

and

MulDiv(a,b,c) = valof [
// Returns a*b/c using unsigned arithmetic.
MulDiv=table [
#55001// STA 3,1,2
#155000 // MOV 2,3 save stack pointer
#111000 // MOV 0,2 a
#21403// LDA 0,3,3
#101220// MOVZR 0,0c/2
#61020 // MUL
#31403 // LDA 2,3,3 c
#61021 // DIV
#101010 // MOV# 0,0
#121000 // MOV 1,0
#171000 // MOV 3,2
#35001// LDA 3,1,2
#1401// JMP 1,3
]
resultis MulDiv(a,b,c)
]

and

SignedMulDiv(a,b,c) = valof [
let sgn=a xor b xor c//Sign bit
let abs(x)=(x ge 0? x,-x)
let res=MulDiv(abs(a),abs(b),abs(c))
resultis (sgn ls 0? -res,res)
]

and

Cos(theta,lvsign,lvmag) be [
//Calculate the cosine of the given angle, and return the
// magnitude as a fraction of #177777 (largest number)
// Also return sign (0 if positive, -1 if negative)

if theta ls 0 then theta=-theta
@lvsign=-(((theta+90*60)/(180*60))&1)
let d=theta rem 90*60
if ((theta/(90*60))&1) ne 0 then d=90*60-d
let min=d rem 60//Minutes part
d=d/60//Degrees part
//Now d in range 0-90 degrees

let retrievecos(d,min) =valof [//0 le d le 45
let cosar=table [
#177777;
#177765; #177727; #177645; #177537; #177405;
#177227; #177026; #176601; #176330; #176033;
#175512; #175146; #174557; #174144; #173505;
#173024; #172317; #171567; #171014; #170216;
#167376; #166532; #165645; #164735; #164002;
#163026; #162030; #161007; #157746; #156662;
#155556; #154430; #153262; #152072; #150663;
#147432; #146162; #144672; #143362; #142032;
#140463; #137075; #135471; #134045; #132405;
#130743;//46 degrees because of interpolation
]

let a=cosar!d//First answer
if min ne 0 then//Must interpolate
[
let b=cosar!(d+1)
a=a-MulDiv(a-b,min,60)//Careful about signs
]
resultis a
]

test d gr 45 then
[//Use half-angle formulae
if (d&1) ne 0 then min=min+60 //Divide angle by 2
let a=retrievecos(d rshift 1,min rshift 1)
a=MulDiv(a,a,#177777)// cos↑2(theta/2)
a=a-#100000// cos↑2 -1/2
@lvmag=a lshift 1//2 cos↑2 -1
]
or@lvmag=retrievecos(d,min)

]