// 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"  THE FOLLOWING IS A COPY IX.DFS

// P R E P R E S S    D E F I N I T I O N S
//


// I N D E X     Definitions

structure IXH: [
	Type	bit 4
	Length	bit 12
	]

structure IXN: [		//For a name
	@IXH
	Code word
	Name word
	contd word 9
	]

structure IX: [			//For splines, characters
	@IXH			//Header
	[ fam byte		// Family number
	  face byte		// Face code
	] = famface word
	bc byte			// First char number
	ec byte			// and last
	siz word		// Font size (10 micron units)
	rotation word		// Rotation (anti clockwise)
	sa word 2		//Starting address of data part
	len word 2		//Length of data part
				//Width type ends here
				//Spline type ends here
	resolutionx word	// 10*(number of bits/inch)
	resolutiony word	//       ditto
	]

manifest [
//IXH types
	IXTypeEnd=0
	IXTypeName=1
	IXTypeSplines=2
	IXTypeChars=3
	IXTypeWidths=4
//IXH lengths
	IXLEnd=1
	IXLName=size IXN/16
	IXLSplines=9
	IXLChars=11
	IXLWidths=9
	IXLMax=11
	]

// W I D T H   segment definitions

structure WTB: [		//Width Table Block
	XL word			//X offset
	YB word			//Y offset
	XW word			// width
	YH word			// height
	XWidthFixed bit
	YWidthFixed bit
	spare bit 14
	]

// S P L I N E     segment definitions

structure SplineWidth: [		//Block describing spline widths
	WX word 2		//X width -- FP
	WY word 2		//Y width -- FP
	XL word 2		//X left -- FP
	YB word 2		//Y bottom -- FP
	XR word 2		//X right -- FP
	YT word 2		//Y top -- FP
	]

manifest SplineWidthsize=size SplineWidth/16

manifest [
//Codes in the height entry for a char that indicate something else
	HNonExCode=-1
	HSplineCode=-2

//DL Types (for Spline File)
	DSplineFontMoveTo=1
	DSplineFontDrawTo=2
	DSplineFontDrawCurve=3

	DSplineFontNewObject=-1
	DSplineFontEndObjects=-2
	]


// C H A R      segment definitions (scan-converted chars)

structure CharWidth: [		//Block describing char widths
	WX word 2		//X width -- DP
	WY word 2		//Y width -- DP
	XL word			//X left (offset) integer
	YB word			//Y bottom (offset) integer
	W word			//Width (integer)
	H word			//Height (integer) or special code
	]

manifest CharWidthsize=size CharWidth/16

structure FHEAD: [		//Font header, scan converted
	hw bit 6			//Height in words
	ns bit 10			//width in scan lines
	]


//Misc.
structure Convert: [
	Monotone word		//True if input to conversion is monotone
	SplineOk word		//True if output can be spline (too big)
	BBGood word		//True if bounding box will be correct
	PressFontPart word	//True if scan converting a press font part
	Len word			//	(if so, this is the length)
	]

manifest [
	gotname=1
	gotface=2
	gotsize=4
	gotrotation=8
	gotincline=16
	gotresolution=32
	gotrecord=64
	gotfactors=128
	]


//END OF 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: case $m: 0
		case $B: case $b: 2
		case $L: case $l: 4
		default: -100 ]) +
	     (selecton slope into [
		case 0:
		case $R: case $r: 0
		case $I: case $i: 1
		default: -100 ]) +
	     (selecton expansion into [
		case 0:
		case $R: case $r: 0
		case $C: case $c: 6
		case $E: 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
		[ //first fix the "off by one" possibility on sizes
		  let newSiz=p>>IX.siz
		  if ((newSiz-siz) eq 1) % ((newSiz-siz) eq -1) then newSiz=siz
		  if p>>IX.fam eq fam &
		   p>>IX.face eq face &
		   ((newSiz 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
			]
	   ] //end of if IXTypeWidths
] 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)
	
]