// ConvertColor.bcpl -- scan conversion color setup

//  errors 800

// This module is responsible for implementing the color functions.
// When a "set color" command is read from a PD file, the
// main loop builds a "color leftover" structure (LOCxxx).
//
// The procedure ColorSet is responsible for establishing a new
// color leftover description as the current color. It sets some state
// variables (colorType, colorTransparent), and decides whether this
// color will be leftover into the next band (colorLeftover=true).
//
// The leftover machinery is actually responsible for writing into
// the leftover file the color leftover. The reason is that not all
// potentially leftover colors need to be written. For example, consider
// the PD file that contains:
//		1. setColor
//		2. maskRectangle
//		3. setColor
//		4. maskTrapezoid
// If the rectangle terminates in this band, the color set on line 1 need
// not be carried forward in the leftovers.
//
// The procedure ColorGetLine(s) is then called by the mask-putting
// routines to set up the vector colorLine with a full scan-line's worth
// of color data. In simple cases, (colorInk and colorClear), this procedure
// need not be called at all.


get "PDInternals.d"
get "PDConvert.d"
get "AltoDefs.d"

// outgoing procedures
external
	[
	ColorInit
	ColorFinish
	ColorSet
	ColorGetLine
	]

// incoming procedures
external
	[
//ConvertUtils
	LoadRead
	LoadReadBlock
	GetBBT
	PutBBT
//ConvertPut
	PutNewColor
//PDPRINT
	FSGetX
	FSPutZ
	PDError
//PDML
	MulDivT
	MulMod
	MulFull
	BitBLT
	Zero
	MoveBlock
	SetBlock
	]

// incoming statics
external
	[
	SMin
	FMin
	FMax
	FWC
	LOSizes
	LOProcs
	colorLine
	colorType
	colorTransparent
	colorParams
	colorLeftover
	]

// internal statics
static
	[
	colorBuf		//Single scan-line buffer
	bbc			//BitBLT table
	]

// ColorInit()
// Set up buffers, etc. for Color routines

let ColorInit() be
[
	LOSizes!loColorInk=size LOC/16
	LOSizes!loColorClear=size LOC/16
	LOSizes!loColorTile=size LOCTile/16
	LOProcs!loColorInk=ColorSet
	LOProcs!loColorClear=ColorSet
	LOProcs!loColorTile=ColorSet
	colorLine=FSGetX(FWC)
	colorBuf=FSGetX(FWC)	//single scan-line buffer for color

// Obtain color leftover block
	colorParams=FSGetX(loColorSize)

// Make up BitBlt control table for filling colorLine
	bbc=GetBBT()
	bbc>>BBT.sType=sBM
	bbc>>BBT.op=fReplace
	bbc>>BBT.dbca=colorLine
	bbc>>BBT.dbmr=FWC
//	bbc>>BBT.dty=0
	bbc>>BBT.dh=1		//single scan-line in destination
	bbc>>BBT.sbca=colorBuf
	bbc>>BBT.sbmr=FWC
//	bbc>>BBT.sty=0
]

and ColorFinish() be
[
	FSPutZ(lv colorLine)
	FSPutZ(lv colorBuf)
	FSPutZ(lv colorParams)
	PutBBT(lv bbc)
]

// ColorSet(v, first) is called by PD reader or leftover reader to set new color.
// v has a color leftover description in it. If "first" is true (default=false)
// initializes color stuff (ink to black, force leftover)

and ColorSet(v, first; numargs na) = valof
[
	let typ=v>>LOC.typ
	MoveBlock(colorParams, v, LOSizes!typ)

// If the color is simple and the same as before, no need for new leftover
	if na eq 1 & first eq false & typ ne loColorTile &
		typ eq colorType then resultis false
	colorType=typ
	colorTransparent=(typ eq loColorTile)? v>>LOCTile.transparent, false
	colorLeftover=true

// Announce new color to Put routines
	PutNewColor()

	resultis false		//Never any leftovers done this way
]

//ColorGetLine(s)
//	Fill colorLine with one scan-line of color data for the band-relative
//	scan-line s. Not called on simple colors (i.e., loColorInk and loColorClear)

and ColorGetLine(s) be
[
	s=s+SMin		//now absolute s rather than band-relative
	let addr=colorParams>>LOCTile.addr
	compileif offset Tile.phase ne 0 then [ foo=nil ]
	compileif offset Tile.sMin ne 16 then [ foo=nil ]
	compileif offset Tile.fMin ne 32 then [ foo=nil ]
	compileif offset Tile.sSize ne 48 then [ foo=nil ]
	compileif offset Tile.fSize ne 64 then [ foo=nil ];
	let phase,sMin,fMin,sSize,fSize=nil,nil,nil,nil,nil
	LoadReadBlock(addr, lv phase, 5)
	addr=addr+5
//Check for simple, inkwell case
	if fSize eq 16 & sSize eq 16 & phase eq 0 then
		[
		SetBlock(colorLine, LoadRead(addr+(s&#17)), FWC)
		return
		]
	if fSize eq 0 % sSize eq 0 then PDError(801)
// If fMin lies below FMin, bump it up
	while fMin uls FMin do fMin=fMin+fSize
	fMin=fMin-FMin
// Compute sDiff, distance from sMin to our scan-line
	let negg=(sMin ugr s)
	let sDiff=s-sMin; if negg then sDiff=-sDiff
// Compute sRem, the scan-line within tile to use.
	let sRem=MulMod(1, sDiff, sSize)
	if negg then sRem=sSize-sRem-1
// Compute f, 0 le f ls fSize, to offset (second) tile vertically
	let f=MulMod(1, fMin, fSize)	//Phase of home tile
	let nTiles=MulDivT(1, sDiff, sSize)	//Number of tiles displaced
		// Note: Must not use MulDiv, which rounds!
	let df=nil
	test negg then df=MulMod(nTiles+1, fSize-phase, fSize) or
			df=MulMod(nTiles, phase, fSize)
	f=f+df
	if f ugr fSize then f=f-fSize

// Now get sRem'th scan line in colorBuf
	let d=vec 1
	let colWC=(fSize+15) rshift 4
	MulFull(sRem, colWC, d)
	LoadReadBlock(addr+d!1, colorBuf, colWC)

// Test for simple optimization
	test f eq 0 & fSize eq 16 then
		SetBlock(colorLine, colorBuf!0, FWC)
	or [
// Put first fragment of 'f' bits into colorLine
	if f ne 0 then
		[
		bbc>>BBT.dlx=0
		bbc>>BBT.dw=f
		bbc>>BBT.slx=fSize-f
		BitBLT(bbc)
		]

// Now loop, copying 'fSize' bits at a time, until the line is full, or
// the repeating pattern occupies an integral number of words
	bbc>>BBT.slx=0
	let fcount=FMax-FMin+1
	let frag=f // size of first fragment
	while f ne fcount do
		[
		let w=fSize
		let fnext=f+fSize
		if ((fnext-frag)%15) eq 0 then fcount=fnext-frag
		if f+w ugr fcount then w=fcount-f
		bbc>>BBT.dlx=f
		bbc>>BBT.dw=w
		BitBLT(bbc)
		f=f+w
		]
// Replicate the initial pattern to finish the line
	let wordsDone=fcount rshift 4 // number of words filled
	let wordsLeft=FWC-wordsDone // number of words to go
	if wordsLeft ugr 0 then
		[
		MoveBlock(colorLine+wordsDone, colorLine, wordsLeft)
		]

	]
]