// S C A L E  (PREPRESS)
// catalog number ???
//
// Scales characters in ACtemp file carefully -- either up
// or down.

get "ix.dfs"

// outgoing procedures
external
	[
	Scale
	]

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

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

//MAPACTEMP
	MapACtemp

//PREPRESS
	CheckParams

//PREPRESSUTIL
	MulFull
	MulDiv
	DPCop
	FSGetX
	FSPut
	Scream
	RoundFP

//FLOAT
	FLDI;FDV;FLDDP;FSTDP;FLD
	FML;FAD;FTR;FSB;FST;FCM

//OS
	Zero
	DoubleAdd
	CallSwat
	]

// incoming statics
external
	[
	@params
	@resolutionx
	@xfp
	@yfp
	@percent
	]

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

// File-wide structure and manifest declarations.

let Scale(inputName,outputName;numargs na) be
[
	if na eq 0 then
	 [ unless CheckParams(gotfactors) then finish
	   inputName="ACtemp";outputName="ACtemp"
		percent=50
		if (params&gotresolution) ne 0 then percent=resolutionx
	 ]
	MapACtemp(ScaleIx, ScaleChar, nil, inputName, outputName)
]

and ScaleIx(ix) be
[
	unless ix>>IX.Type eq IXTypeChars then
		Scream("Scale called with wrong input type")
   ix>>IX.resolutionx=ScaleInteger(ix>>IX.resolutionx, 1)
	ix>>IX.resolutiony=ScaleInteger(ix>>IX.resolutiony, 2)
]

and ScaleChar(p, si, so) be
[
	WindowRead(si)		//Past FHEAD word

	let hb=p>>CharWidth.H
	let hw=(hb+15)/16
	let ns=p>>CharWidth.W
	let ons=ScaleInteger(ns, 1)	//Output number of scan-lines
	let ohb=ScaleInteger(hb, 2)	//Output number of bits high
	 let ohb2=ohb*2
	let ohw=(ohb+15)/16
	let outVec=FSGetX(ohw*ons)

	let inVec=FSGetX(hw)		//For input scan-line
	let sumVec=FSGetX(ohb2)		//For summing black bits

	let minBlackS=ons			//Bounding box of output character
	let maxBlackS=-1
	let minBlackB=ohb
	let maxBlackB=-1

// Threshold = percent/ (100 * xfp * yfp), saved as a double-precision number.
	let negThreshold=vec 1
	FLDI(1, -percent)		//negative
	FLDI(2, 100)
	FDV(1,2)
	FDV(1, xfp); FDV(1, yfp)
	FSTDP(1, negThreshold)

// Phase increments are amount to march in INPUT character
// for each step in output character.
	let SPhaseIncrement=vec 1
	FLDI(1, 1); FDV(1, xfp); FSTDP(1, SPhaseIncrement)
	let BPhaseIncrement=vec 1
	FLDI(1, 1); FDV(1, yfp); FSTDP(1, BPhaseIncrement)

	let currentSPhase=vec 1
	let nextSPhase=vec 1
	let currentBPhase=vec 1
	let nextBPhase=vec 1
	let finalNs=nil
	let finalHb=nil

	Zero(nextSPhase, 2)
	let inVecHolds=-1
	
for s=0 to ons-1 do
	[sOut
	Zero(sumVec, ohb2)
	DPCop(currentSPhase, nextSPhase)
	DoubleAdd(nextSPhase, SPhaseIncrement)
	for slIn=currentSPhase!0 to nextSPhase!0 do
		[
		if slIn ne inVecHolds then
			[
			inVecHolds=inVecHolds+1
			if slIn ne inVecHolds then CallSwat("Bug")
			WindowReadBlock(si, inVec, hw)
			]
// Calculate amount of input scan-line in image of output scan-line
		let sInAmount=177777b
		if slIn eq nextSPhase!0 then sInAmount=nextSPhase!1
		if slIn eq currentSPhase!0 then sInAmount=sInAmount-currentSPhase!1
		Zero(nextBPhase, 2)

		for b=0 to ohb-1 do
			[bOut
			let sumP=sumVec+b+b
			DPCop(currentBPhase, nextBPhase)
			DoubleAdd(nextBPhase, BPhaseIncrement)
			for bIn=currentBPhase!0 to nextBPhase!0 do
				[
				let bw=bIn/16+inVec
				if (@bw & (#100000 rshift (bIn&#17))) ne 0 then
				[black
// Calculate mount of input bit in image of output bit
				let bInAmount=177777b
				if bIn eq nextBPhase!0 then bInAmount=nextBPhase!1
				if bIn eq currentBPhase!0 then bInAmount=bInAmount-currentBPhase!1
// Calculate total "area" of input bit involved in output bit, and sum
				let tmp=vec 1
				tmp!0=0
				tmp!1=MulDiv(sInAmount, bInAmount, 177777b)
				DoubleAdd(sumP, tmp)
				]black
				]
			]bOut
		]			//Loop on relevant input scan-lines

// Threshold the output scan-line
	let outP=outVec+s*ohw
	Zero(outP, ohw)
	let blackSeen=false
	for i=0 to ohb-1 do
		[
		let sumP=sumVec+i+i
		DoubleAdd(sumP, negThreshold)
		if sumP!0 ge 0 then
			[
			let ow=outP+i/16
			@ow=@ow % (100000b rshift (i&#17))
			if i ls minBlackB then minBlackB=i
			if i gr maxBlackB then maxBlackB=i
			blackSeen=true
			]
		]
	if blackSeen then
		[
		if s ls minBlackS then minBlackS=s
		if s gr maxBlackS then maxBlackS=s
		]
	]sOut

// Prepare FHEAD word for output:
	let finalHb=(maxBlackB-minBlackB+1)
	let finalNs=(maxBlackS-minBlackS+1)
	if finalHb le 0 % finalNs le 0 then [ finalHb=0; finalNs=0 ]
	let finalHw=(finalHb+15)/16
	let a=nil
	a<<FHEAD.hw=finalHw
	a<<FHEAD.ns=finalNs
	WindowWrite(so, a)

//Now write character, shifting to adjust bounding box
	let phase=minBlackB&#17
	for s=0 to finalNs-1 do
		[
		let p=outVec+(s+minBlackS)*ohw+minBlackB/16
		for b=0 to finalHw-1 do
			[
			let nextw=p!(b+1)
			if b eq finalHw-1 then nextw=0
			WindowWrite(so, ((p!b) lshift phase)+(nextw rshift (16-phase)))
			]
		]

//Now patch up the character description
	FLDDP(1, lv p>>CharWidth.WX)
	FML(1, xfp)
	FSTDP(1, lv p>>CharWidth.WX)
	FLDDP(1, lv p>>CharWidth.WY)
	FML(1, yfp)
	FSTDP(1, lv p>>CharWidth.WY)
	p>>CharWidth.H=finalHb
	p>>CharWidth.W=finalNs
	test finalHb eq 0 then
		[
		p>>CharWidth.XL=0
		p>>CharWidth.YB=0
		]
	or	[
		p>>CharWidth.XL=ScaleInteger(p>>CharWidth.XL, 1)+minBlackS
		p>>CharWidth.YB=ScaleInteger(p>>CharWidth.YB, 2)+minBlackB
		]

	FSPut(inVec)
	FSPut(sumVec)
	FSPut(outVec)
]

// Scale an integer by a factor, governed by abs(which):
// 1 = x, 2 = y.

and ScaleInteger(x, which) = valof
[
	FLDI(1, x)
	let a=yfp
	if (which&1) ne 0 then a=xfp
	FML(1, a)
	resultis RoundFP(1)
]