// M A K E W I D T H S		(PREPRESS)
//
//Last modified April 21, 1980  9:35 PM by Lyle Ramshaw, PARC:
//  adjusted call on EncodeFace to allow for new, funny faces.

get "ix.dfs"
get "scan.dfs"

// outgoing procedures
external [
	MakeWidths
	]

// incoming procedures
external [
//WINDOW
	WindowWriteBlock
	WindowClose
	WindowWrite
	WindowGetPosition
	WindowSetPosition
//PREPRESS
	PrePressWindowInit
	WriteIXTempFile
	GetPosRelative
	Scream
	IllCommand
//SCAN
	ScanInit
	ScanClose
	ScanSet
	Scan
	ScanFor
	ScanGiveID
	ReadNumber
	PrintFloat
	StrEq
	StrCop
	ReadCom
//FLOAT
	FTR; FML; FLDI; FLD; FAD; FDV
//FONTWIDTHS
	EncodeFace
//UTIL
	MulDiv
//OS
	SetBlock
	Zero
	]

external @ScanSavedLetter //from Scan

manifest [
	mwXL=0
	mwYB=1
	mwXW=2
	mwYH=3
	mwNAME=4
	mwSIZE=5
	mwFACE=6
	mwWIDTHS=7
	mwSCALE=8
	]

structure STRING [ length byte; char ^1,255 byte ]

let MakeWidths(inFileName,outFileName;numargs n) be
[
	let str=vec 20
	if n eq 0 then
	 [ if ReadCom(str) eq 0 then IllCommand()
	   inFileName=str
		outFileName="WDtemp"
	 ]
	let b=vec SCANIlen
	ScanInit(b, inFileName)
	ScanSet(b)

	let wt=vec 256
	SetBlock(wt, #100000, 256)
	let fn=vec IXLName
	let ix=vec IXLWidths
	let wtb=vec size WTB/16
	Zero(fn, IXLName)
	Zero(ix, IXLWidths)
	Zero(wtb, size WTB/16)
	FLDI(5, 1)			//Scale factor
	FLDI(6, 1); FLDI(7, 2); FDV(6, 7)	// 1/2 for rounding

[MWloop
	let c=Scan()
	if c eq ID then c=mwID(ScanGiveID())
	switchon c into
	[
	case mwXL: case mwYB: case mwXW: case mwYH:
		[
		compileif mwXL ne offset WTB.XL/16 then [ foo=nil ]
		compileif mwYB ne offset WTB.YB/16 then [ foo=nil ]
		compileif mwXW ne offset WTB.XW/16 then [ foo=nil ]
		compileif mwYH ne offset WTB.YH/16 then [ foo=nil ]
		ScanFor(NUMBER)
		wtb!c=FTR(1)
		endcase
		]
	case mwNAME:
		[
		ScanFor(ID)
		StrCop(ScanGiveID(), lv fn>>IXN.Name)
		endcase
		]
	case mwSIZE:
		[
		ScanFor(NUMBER)
		let m=FTR(1)
		ix>>IX.siz=MulDiv(m, 635, 18)
		endcase
		]
	case mwFACE:
		[
		let faceByte=nil
		switchon Scan() into
		  [
		  case NUMBER:
			[
			// We want to call EncodeFace, but it
			// expects its argument in string form, so:
			let str=vec 10
			PrintFloat(str, 1)
			faceByte=EncodeFace(str)
			endcase
			]
		  case ID:
			[
			let s=ScanGiveID()
			faceByte=EncodeFace(s)
			endcase
			]
		  default:  Scream("Illegal face code")
		  ]
		if faceByte eq -1 then Scream("Illegal face code")
		ix>>IX.face=faceByte
		endcase
		]
	case mwSCALE:
		[
		ScanFor(NUMBER)
		FLD(5, 1)
		endcase
		]
	case mwWIDTHS:
		[
		let letid=vec 20
		let letnum=nil
		[
		letnum=-1
		c=Scan()
		let s=ScanGiveID()
		test c eq NUMBER then
			[
			let l=s>>STRING.length
			test l ne 1 then
				[
				l=l+1
				s>>STRING.char^l=$Q
				s>>STRING.length=l
				letnum=ReadNumber(s)
				]
			or letnum=FTR(1)+$0
			]
		or	[
			test StrEq(s, "STOP") then break or
			test StrEq(s, "ALL") then letnum=-2 or
			letnum=ScanSavedLetter		//w/o upper case
			]
		c=Scan()
		if c ne NUMBER then mwScream()
		FML(1, 5); FAD(1, 6)		//Scale it.
		let val=FTR(1)
		test letnum eq -2 then for i=0 to 255 do wt!i=val
		or wt!letnum=val
		] repeat
		break		//All done
		]
	default: mwScream()
	]
]MWloop repeat
	ScanClose()

//Now actually write the output file:
	let w=PrePressWindowInit(outFileName, true)
	let bc,ec=257,-1
	for i=0 to 255 do if wt!i ne #100000 then
		[
		if i ls bc then bc=i
		if i gr ec then ec=i
		]
	ix>>IX.bc=bc; ix>>IX.ec=ec
	ix>>IX.Type=IXTypeWidths
	ix>>IX.Length=IXLWidths
	WriteIXTempFile(w, fn, ix)

	let xfixed=true
	for i=bc to ec do if wt!i ne wt!bc then xfixed=false

//Now write the WTB header
	if xfixed then wtb>>WTB.XWidthFixed=true
	wtb>>WTB.YWidthFixed=true
	WindowWriteBlock(w, wtb, size WTB/16)
	test xfixed then WindowWrite(w, wt!bc)
		or for i=bc to ec do WindowWrite(w, wt!i)
	WindowWrite(w, 0)

//Fix up lengths
	let cp=vec 1
	WindowGetPosition(w, cp)
	GetPosRelative(w, lv ix>>IX.sa, lv ix>>IX.len)
	WindowSetPosition(w, table [ 0;0 ] )
	WriteIXTempFile(w, fn, ix)
	WindowSetPosition(w, cp)
	WindowClose(w)
			
	]

and mwID(s)= valof [
	if StrEq(s, "XL") then resultis mwXL
	if StrEq(s, "YB") then resultis mwYB
	if StrEq(s, "XW") then resultis mwXW
	if StrEq(s, "YH") then resultis mwYH
	if StrEq(s, "NAME") then resultis mwNAME
	if StrEq(s, "SIZE") then resultis mwSIZE
	if StrEq(s, "FACE") then resultis mwFACE
	if StrEq(s, "WIDTHS") then resultis mwWIDTHS
	if StrEq(s, "SCALE") then resultis mwSCALE
	mwScream()
	]

and mwScream() be Scream("Illegal widths file.")