// 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 CDtemp 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

let ImposeWidths(fType) be
[

//Get widths file:
	let sw=PrePressWindowInit(-3)		//WDtemp
	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 CDtemp or SDtemp
	let si=PrePressWindowInit(-fType)
	let fn=vec IXLName
	let ix=vec IXLMax
	ReadIXTempFile(si, fn, ix)

//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
		[
		FLDI(3, 1); FLDI(4, 1)
		if ixw>>IX.siz eq 0 then
			[
			FLDI(1, ix>>IX.siz)	//Micas
			FLDI(2, 1000)
			FDV(1, 2)			// Size/1000
			FLDI(2, 25400)	// 2540*10 (because resolution is x 10)
			FDV(1, 2)
			FLDI(3, ix>>IX.resolutionx); FML(3, 1)
			FLDI(4, ix>>IX.resolutiony); FML(4, 1)
			]
		]
		or IllCommand()

	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 1
			ifso	[
				FSTDP(1, lv p>>CharWidth.WX)
				FSTDP(2, lv p>>CharWidth.WY)
				]
			ifnot	[
				FST(1, lv p>>SplineWidth.WX)
				FST(2, lv p>>SplineWidth.WY)
				]
			]
		]
		]

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