// I M P O S E W I D T H S  (PREPRESS)
// catalog number ???
//
// Read the WDtemp file for a list of widths, and "impose" them
// on the SDtemp or ACtemp file, selon the argument to ImposeWidths
// Used for making fonts that "match" photo typesetter fonts.

get "ix.dfs"

// outgoing procedures
external
	[
	ImposeWidths
	]

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

// incoming procedures
external
	[
//WINDOW
	WindowRead
	WindowReadBlock
	WindowWriteBlock
	WindowGetPosition
	WindowSetPosition
	WindowClose

//PREPRESS
	ReadIXTempFile
	PrePressWindowInit

//UTIL
	Scream
	IllCommand
	FSGetX
	FSPut

//OS
	SetBlock

//FLOAT
	FLDI; FDV; FML; FTR; FST; FSTDP; FLD
	]

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

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

// File-wide structure and manifest declarations.


// Procedures
// fType=1 for ACtemp (characters already scan-converted)
// fType=2 for SDtemp (splines)

let ImposeWidths(fType,widthFile,outFile;numargs na) be
[

	if na eq 1 then
	 [ widthFile=-3	//WDtemp
		outFile=-fType	//SDTemp or ACTemp
	 ]

//Get widths file:
	let sw=PrePressWindowInit(widthFile)
	let fnw=vec IXLName
	let ixw=vec IXLMax
	ReadIXTempFile(sw, fnw, ixw)
	let ncw=ixw>>IX.ec-ixw>>IX.bc+1
	let bbw=vec size WTB/16
	WindowReadBlock(sw, bbw, size WTB/16)
	let xWidthVec=vec 256
	let yWidthVec=vec 256
	for i=0 to 1 do
		[
		let p=(i eq 0)? xWidthVec,yWidthVec
		test ((i eq 0)? bbw>>WTB.XWidthFixed, bbw>>WTB.YWidthFixed)
		ifso SetBlock(p, WindowRead(sw), ncw)
		ifnot WindowReadBlock(sw, p, ncw)
		]
	WindowClose(sw)

//Get ACtemp or SDtemp
	let si=PrePressWindowInit(outFile)
	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(si, fn, ix)
	unless na eq 1 do	//find out the type
	 fType=selecton ix>>IXH.Type into
		 [	case IXTypeChars:
			case IXTypeOrbitChars: 1
			case IXTypeSplines: 2
		   default: Scream("Illegal input type (must be chars or splines)")
		 ]

//Now compute scale factors: x in 3, y in 4
	test fType eq 2 then	//Imposing on spline widths
		[
		FLDI(3, 1); FLDI(4, 1000); FDV(3, 4); FLD(4, 3)	// 1/1000
		if ixw>>IX.siz ne 0 then Scream("Cannot impose absolute widths on splines")
		]
	or test fType eq 1 then
		[
// Here's how the calculations go. The ABSOLUTE width of a
// character is (let w be the 16-bit number recorded for this
// character in the widths file):
//  If the font size recorded in the widths file is non-zero:
// 	(w/2540)*(resolution/10)
//	...remember, w is in micas
//	...the /10 is just because resolution figures in the
//	...files are given times 10
//  Else if font the size recorded in the widths file is zero:
//	(CharFontSize/2540)*(w/1000)*(resolution/10)

		FLDI(3,ix>>IX.resolutionx)
		FLDI(4,ix>>IX.resolutiony)
		FLDI(2,25400); FDV(3,2); FDV(4,2)
		test ixw>>IX.siz eq 0 then
			[
			FLDI(2,ix>>IX.siz)
			FLDI(1,1000);
			FDV(2,1)
			FML(3,2); FML(4,2)
			]
		or if ixw>>IX.siz ne ix>>IX.siz then
		Scream("Warning: WDtemp font size does not equal ACtemp size")
		]
		or Scream("Destination file not splines or chars")

	let fp=vec 1
	WindowGetPosition(si, fp)		//Remember for re-writing
	let nc=ix>>IX.ec-ix>>IX.bc+1
	let wSiz=((fType eq 1)? CharWidthsize, SplineWidthsize)
	let tl=nc*wSiz
	let WD=FSGetX(tl)
	WindowReadBlock(si, WD, tl)

	for c=ix>>IX.bc to ix>>IX.ec do
		[
		let p=(c-ix>>IX.bc)*wSiz+WD
		let charAbsent=nil
		test fType eq 1 then charAbsent=(p>>CharWidth.H eq HNonExCode)
		 or charAbsent=(p!0 eq 0)&(p!1 eq -1)

		unless charAbsent then
		[
		let xWidth=#100000
		let yWidth=#100000
		let relC=c-ixw>>IX.bc
		if relC ge 0 & relC ls ncw then
			xWidth,yWidth=xWidthVec!relC, yWidthVec!relC
		if xWidth ne #100000 & yWidth ne #100000 then
			[
			FLDI(1, xWidth); FML(1, 3)
			FLDI(2, yWidth); FML(2, 4)
			test fType eq 2
			ifso	[
				FST(1, lv p>>SplineWidth.WX)
				FST(2, lv p>>SplineWidth.WY)
				]
			ifnot	[
				FSTDP(1, lv p>>CharWidth.WX)
				FSTDP(2, lv p>>CharWidth.WY)
				]
			]
		]
		]

//Now put the updated widths back out on the file.
	WindowSetPosition(si, fp)
	WindowWriteBlock(si, WD, tl)
	WindowClose(si)
	FSPut(WD)
]