// G R O W  (PREPRESS)
// catalog number ???
//
//GROW command is used to "bolden" characters, or to "shrink" characters
// via simple image processing functions.

get "ix.dfs"

// outgoing procedures
external
	[
	Grow
	]

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

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

//MAPACTEMP
	MapACtemp

//PREPRESSUTIL
	FSGetX
	FSPut
	Scream

//OS
	Noop
	Zero
	SetBlock
	MoveBlock
	]

// incoming statics
external
	[
	@params
	@resolutionx
	@bitfactor
	]

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

// File-wide structure and manifest declarations.
manifest ACtemp=-1

//Grow command -- if growflag is true, this is to grow; else shrink.
// Argument is passed via /d switch.

let Grow(growflag,inputName,outputName;numargs na) be
[
	let arg=vec 3
	arg!0=growflag
	arg!1=bitfactor
	if na ls 3 then
	[ inputName=ACtemp;outputName=ACtemp
	  let amt=resolutionx
	  if (params&gotresolution) eq 0 then amt=1
	  arg!1=amt
	]

	MapACtemp(GrowIX, GrowFn, arg, inputName, outputName)
]

and GrowIX(ix) be
 [ unless ix>>IX.Type eq IXTypeChars then 
		Scream("Grow called with wrong input type")
 ]

and GrowFn(p, si, so, arg) be
[
	let growflag=arg!0
	let amt=arg!1

	let buf=0
	let a=WindowRead(si)		//FHEAD
	let ns=a<<FHEAD.ns
	let hw=a<<FHEAD.hw

	let newhighword=nil
	let newhigh=p>>CharWidth.H
	if newhigh then
		[			//Not a space
		let newns=ns
		if growflag then
			[
			newhigh=newhigh+2*amt
			newns=newns+2*amt
			]
		newhighword=(newhigh+15)/16
		let wc=newhighword*newns
		buf=FSGetX(wc)		//Enuf room
		Zero(buf, wc)
		for s=0 to ns-1 do WindowReadBlock(si, buf+s*newhighword, hw)
		for i=1 to amt do
			[
			GrowOne(buf, newns, newhighword, p, (growflag? 1,-1))
			]
		if p>>CharWidth.W le 0 % p>>CharWidth.H le 0 then
			[		//Exhausted!
			p>>CharWidth.W=0
			p>>CharWidth.H=0
			p>>CharWidth.XL=0
			p>>CharWidth.YB=0
			]
		]			//Not a space
	hw=(p>>CharWidth.H+15)/16
	ns=p>>CharWidth.W
	a<<FHEAD.ns=ns
	a<<FHEAD.hw=hw
	WindowWrite(so, a)
	for s=0 to ns-1 do WindowWriteBlock(so, buf+s*newhighword, hw)
	if buf then FSPut(buf)
]

//GrowOne (amt=1) or shrink (amt=-1) one bit.  buf points to buffer that
// has "lines" lines of "words" words each.  p is pointer to CharWidth
// structure to update.

and GrowOne(buf, lines, words, p, amt) be
[
	let wc=words*lines
	let wcm1=wc-1
	let WorkBuf=FSGetX(wc)
	let ResBuf=FSGetX(wc)		//Result buffer
	if amt gr 0 then		//Grow -- must make
		[			// room for new bits.
		ShiftChar(4, buf, WorkBuf, lines, words)
		ShiftChar(2, WorkBuf, buf, lines, words)
		]
	MoveBlock(ResBuf, buf, wc)		//Start with original
	for direction=1 to 4 do
		[
		ShiftChar(direction, buf, WorkBuf, lines, words)
		test amt gr 0
		ifso for i=0 to wcm1 do ResBuf!i=ResBuf!i % WorkBuf!i
		ifnot for i=0 to wcm1 do ResBuf!i=ResBuf!i & WorkBuf!i
		]
	unless amt gr 0 then		//Shrink -- move down over now
		[			// blank bits
		ShiftChar(3, ResBuf, WorkBuf, lines, words)
		ShiftChar(1, WorkBuf, ResBuf, lines, words)
		]
	MoveBlock(buf, ResBuf, wc)		//Store back in buffer
	FSPut(WorkBuf)
	FSPut(ResBuf)

//Now fix width entries
	p>>CharWidth.W=p>>CharWidth.W+2*amt
	p>>CharWidth.H=p>>CharWidth.H+2*amt
	p>>CharWidth.XL=p>>CharWidth.XL-amt
	p>>CharWidth.YB=p>>CharWidth.YB-amt
]

//ShiftChar:  how is: 1 (to left); 2 (to right); 3 (to bottom); 4 (to top).
// src character is shifted one bit in given direction, stored in dest
// char.  lines and words are parameters of encoding. There is no harm if
// src=dest.

and ShiftChar(how, src, dest, l, w) be
[
	let wm1=w-1
	let lm1=l-1
	let fillbits=0			//or -1
	switchon how into [

case 1:					//One bit to left
	[
	for i=0 to l-2 do MoveBlock(dest+i*w, src+i*w+w, w)
	SetBlock(dest+lm1*w, fillbits, w)
	]
	endcase
case 2:					//One bit to right
	[
	for i=lm1 to 1 by -1 do MoveBlock(dest+i*w, src+i*w-w, w)
	SetBlock(dest, fillbits, w)
	]
	endcase
case 3:					//One bit down
	[
	for i=0 to lm1 do
		[
		let pw=fillbits
		for j=wm1 to 0 by -1 do
			[
			dest!j=(src!j lshift 1)+(pw rshift 15)
			pw=src!j
			]
		dest=dest+w
		src=src+w
		]
	]
	endcase
case 4:					//One bit up
	[
	for i=0 to lm1 do
		[
		let pw=fillbits
		for j=0 to wm1 do
			[
			dest!j=(src!j rshift 1)+(pw lshift 15)
			pw=src!j
			]
		dest=dest+w
		src=src+w
		]
	]
	endcase
]
]