// 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
	if p>>IXH.Type eq IXTypeWidths then
		if p>>IX.fam eq fam &
		   p>>IX.face eq face &
		   ((p>>IX.siz eq siz & 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&#377) 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,0	c/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)
	
]