// Convert.bcpl -- Scan-convert PD files

//  errors 300

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

// outgoing procedures
external
	[
	ConvertInit
	Convert
	ConvertClose
	]

// outgoing statics
external
	[
	bandBuffer	//Pointer to buffer of bits
	bandWidth	//Number of scan-lines in band
	SMin		//Beginning scan-line of this band
	SMax		//Last scan-line in this band
	FMin			//First bit on scan-line
	FMax			//Last bit on scan-line
	FWC			//F direction word count (FWC mod 32=0)
	LOSizes		//LOSizes!loCommand = # of words in leftover
	LOProcs		//LOProcs!loCommand = procedure to handle leftover

//Color stuff
	colorLine	//Pointer to one scan-line of color data
	colorType	//loColorInk, loColorClear,...
	colorTransparent	//True if color is transparent
	colorParams	//Pointer to LOColor structure
	colorLeftover	//True if this color must be recorded as leftover

//Load
	LoadBase		//Base address of load (in XM if UserXM is true)
	]
static
	[
	bandBuffer
	bandWidth
	SMin
	SMax
	FMin
	FMax
	FWC	
	LOSizes
	LOProcs
	colorLine
	colorType
	colorTransparent
	colorParams
	colorLeftover
	LoadBase
	]

// incoming procedures
external
	[
//CONVERT stuff
	XMInit
	XMFinish
	ColorInit
	ColorFinish
	ColorSet
	PutInit
	PutFinish
	MaskInit
	MaskFinish
	MaskNew
	LoadWriteBlock

//PDPRINT
	FSGetX
	FSPutZ
	PDError
	DblShift

//PDML
	MulDiv
	DoubleCop

//WINDOW,FILES
	WindowInit
	WindowClose
	WindowRead
	WindowWrite
	WindowReadBlock
	WindowWriteBlock
	WindowGetPosition
	WindowSetPosition
	FileStuff
	FileWritePage

//CURSOR
	CursorChar
	CursorDigit
	CursorToggle

//OS
	Zero
	MoveBlock
	]

// incoming statics
external
	[
	PDHerald		//PD herald structure
	LeftOverFile1
	LeftOverFile2
	BitsFile
	ScratchFile
	PDWindow

	nPrinterColors
	nScans
	nBitsPerScan
	mirrorX
	DPzero
	UseXM
	]

// internal statics
static
	[
	Left1RB		//Windows for leftover lists
	Left2RB

	reading			//Window reading from at the moment
	loRead			//Leftover list being read
	loWrite			//RB in which to write leftovers

	FlipVec		//To implement mirrorX
	imageStarted	//Flag to say 'startImage' has been found
	interpreterMode	//bandMode or leftOverMode

	pPriority		//Pointer to (doubleword) priority
//	curP		is kept in "priority" entry in PDWindow.RB
	curC		//Pointer to color properties for PD file

	SBreak=-1
	]

// File-wide structure and manifest declarations.

structure RB:
[
	priority	word 2
	end	word
	blank	word
	Base	word	//To become part of a "window"
]

structure
 [ lh	byte
   rh	byte
 ]

// Procedures

let ConvertInit() be 
[
	CursorChar($C)

	compileif offset RB.Base ne offset W.Base then [ foo=0 ]
	Left1RB=WindowInit(LeftOverFile1, 1)
	Left2RB=WindowInit(LeftOverFile2, 1)
	LOSizes=FSGetX(loMax+1)
	LOSizes!loPriority=3
	LOSizes!loEnd=1
	LOProcs=FSGetX(loMax+1)
	LOProcs!loPriority=LPriority
	LOProcs!loEnd=LEnd
	if mirrorX then
		[
		FlipVec=FSGetX(256)
		for i=0 to 255 do
			[
			let val=0
			for j=0 to 7 do if (i&(1 lshift j)) ne 0 then val=val%(#200 rshift j)
			FlipVec!i=val
			]
		]
	XMInit()
// Finally, set up load buffer
	if PDHerald>>PDH.maxLoadWord.high ne 0 then PDError(300)
	let loadSize=PDHerald>>PDH.maxLoadWord.low
	LoadBase=0
	unless UseXM then
		[
		if loadSize ugr #77777 then PDError(300)
		LoadBase=FSGetX(loadSize)
// And read in initial contents from scratch file
		let w=WindowInit(ScratchFile)
		WindowReadBlock(w, LoadBase, loadSize)
		WindowClose(w)
		]
]

and ConvertClose() be
[
	if FlipVec then FSPutZ(lv FlipVec)
	FSPutZ(lv LOSizes)
	FSPutZ(lv LOProcs)
	WindowClose(Left1RB)
	WindowClose(Left2RB)
	unless UseXM then
		[
// Write out current state of load to scratch file
		let w=WindowInit(ScratchFile)
		WindowWriteBlock(w, LoadBase, PDHerald>>PDH.maxLoadWord.low)
		WindowClose(w)
		FSPutZ(lv LoadBase)
		]
	XMFinish()
]

and Convert(pg) = valof
[
//Save current PD file position in case we need to back out
	let PDpos=vec 1
	WindowGetPosition(PDWindow, PDpos)

	bandWidth=PDHerald>>PDH.bandSSize
	pg>>PageG.BandWidth=bandWidth

//Start processing commands from band file, just to find startImage:
	compileif endBand eq 0 % endDocument eq 0 then
		[ foo=nil ] 	//Entire end-detection machinery will fail
	PDWindow>>RB.end=0
	imageStarted=false
	[
	let com=WindowRead(PDWindow)
	test com<<Command.typ eq typControl then DoControl(com, pg)
		or PDError(301)
	if PDWindow>>RB.end eq endDocument then resultis -2
	] repeatuntil imageStarted

//Keep track of where we are in the Bits file
	let nPagesWritten=0
	let BitPage=pg>>PageG.BitPage

//Decide if image will fit in BitsFile
	let bufLen=bandWidth*FWC
	let pageSize=BitsFile>>F.Pagesize
	let nPagesPerBuf=(bufLen+pageSize-1)/pageSize
	let nBands=pg>>PageG.LastBand-pg>>PageG.FirstBand+1
//Assume all separations for color are same size.
	let pagesRequired=nBands*nPagesPerBuf*nPrinterColors
	if pg>>PageG.feed ne 0 &
	   BitPage+pagesRequired ugr BitsFile>>F.Pagecnt then
		[
		WindowSetPosition(PDWindow, PDpos)
		resultis -1
		]

	CursorDigit()
	compileif MeterSw then
		[
		let SCStats=vec (size SCStat/16)
		Zero(SCStats, (size SCStat/16))
		SCStats>>SCStat.TimeIn=MeterTime()
		]

	bandBuffer=FSGetX(bufLen)
// Now initialize the rest of the package modules.
	MaskInit()
	ColorInit()
	PutInit()
//Set up RB's for bands, leftover stuff.
	loWrite=Left1RB
	WindowSetPosition(loWrite, DPzero)
	loRead=Left2RB

for thisBand=pg>>PageG.FirstBand to pg>>PageG.LastBand do
[BD
	SMin=thisBand*bandWidth
	SMax=SMin+bandWidth-1
	CursorToggle(0,MulDiv(SMin,600,nScans))
	if SMin eq SBreak then PDError(311)
// Zero the band buffer
	Zero(bandBuffer, bufLen)
//Write terminator on write leftover
	WindowWrite(loWrite, loEnd)
//Switch leftover tables
	let  t=loWrite
	loWrite=loRead
	loRead=t
//Initialize priorities and end indications
	let pVec=vec 1
	pPriority=pVec
	DoubleCop(pPriority, DPzero)
	DoubleCop(lv loWrite>>RB.priority, DPzero)
	DoubleCop(lv loRead>>RB.priority, DPzero)
	loRead>>RB.end=0
	DoubleCop(lv PDWindow>>RB.priority, DPzero)
	PDWindow>>RB.end=0
//Start reading at beginning of leftovers
	WindowSetPosition(loRead, DPzero)
//Start writing at beginning of leftovers
	WindowSetPosition(loWrite, DPzero)
//We will always start reading leftovers
	reading=loRead
//Initialize the color for this band
	let cVec= vec loColorSize
	curC=cVec
	curC>>LOC.typ=loColorInk
	ColorSet(curC, true)

	let v=vec 50	//**fix for better length**

// Main loop reading objects from current file (PD or leftover)

[ML
	let leftOver=nil

	test reading eq PDWindow then
	[
		let com=WindowRead(reading)
		switchon com<<Command.typ into
		[
			case typControl:
				if DoControl(com) then DecideReading()
				leftOver=false
				endcase
			case typImaging:
				leftOver=MaskNew(com, reading, v)
				endcase;
		]
	] or [
		let typ=WindowRead(reading)
		v!0=typ
		if typ ugr loMax then PDError(302)
		WindowReadBlock(reading, v+1, LOSizes!typ-1)
		leftOver=(LOProcs!typ)(v)
	]

//Now write out leftovers if necessary
	if leftOver ne 0 & interpreterMode eq leftOverMode then
	[
lowr:
	if DoubleCmp(pPriority, lv loWrite>>RB.priority) ne 0 then
		[
		DoubleCop(lv loWrite>>RB.priority, pPriority)
		WindowWrite(loWrite, loPriority)
		WindowWriteBlock(loWrite, pPriority, 2)
		]
	if colorLeftover then
		[
		WindowWriteBlock(loWrite, colorParams, LOSizes!colorType)
		colorLeftover=false
		]
	WindowWriteBlock(loWrite, v, LOSizes!(v!0))
	]

]ML repeatuntil reading>>RB.end ne 0

//Buffer of data is ready. Flip if necessary
	if mirrorX then //bit reverse bandBuffer
	 [ for s=0 to bandWidth-1 do
	    [ let firstAddr=s*FWC+bandBuffer
	      let lastAddr=firstAddr+FWC-1
	      for wordOffset=0 to (lastAddr-firstAddr)/2 do
	       [ let leftWord=firstAddr!wordOffset
	         let rightWord=lastAddr!(-wordOffset)
	         let newL,newR=nil,nil
	         newR<<rh=FlipVec!(leftWord<<lh)
	         newR<<lh=FlipVec!(leftWord<<rh)
	         newL<<rh=FlipVec!(rightWord<<lh)
	         newL<<lh=FlipVec!(rightWord<<rh)
	         firstAddr!wordOffset=newL
	         lastAddr!(-wordOffset)=newR
	       ] //end of "for wordOffset"
	    ] //end of "for s"
	 ]

//Now write out buffer onto bits file
fwp:	FileWritePage(BitsFile, BitPage+nPagesWritten, bandBuffer, nPagesPerBuf)
	nPagesWritten=nPagesWritten+nPagesPerBuf

]BD

	MaskFinish()
	ColorFinish()
	PutFinish()
	FSPutZ(lv bandBuffer)
	resultis nPagesWritten
]

and DecideReading() be
[
	let other=(reading eq PDWindow)? loRead, PDWindow
	if other>>RB.end eq 0 then
		[		//Consider switching
		if reading>>RB.end ne 0 %
		  DoubleCmp(lv reading>>RB.priority, lv other>>RB.priority) eq 1 then
			[
readswitch:		reading=other
			test reading eq PDWindow
			  then (LOProcs!(curC>>LOC.typ))(curC)	//set color from PD
			  or MoveBlock(curC, colorParams, loColorSize)	//save color
			]
		]
	DoubleCop(pPriority, lv reading>>RB.priority)
]

and DoControl(com, pg) = valof
[
	switchon com<<Command.com into
	[
	case startImage: [
		if imageStarted then PDError(303)
		imageStarted=true
		let v=vec size StartImage/16
		WindowReadBlock(PDWindow, v, size StartImage/16)
		pg>>PageG.strip=v>>StartImage.S
		pg>>PageG.feed=v>>StartImage.F
		pg>>PageG.ColorPass=v>>StartImage.toner
		interpreterMode=v>>StartImage.M
		pg>>PageG.FirstBand=v>>StartImage.passBands
		pg>>PageG.LastBand=v>>StartImage.passBands+v>>StartImage.nBands-1
		if pg>>PageG.FirstBand ugr pg>>PageG.LastBand %
			pg>>PageG.LastBand ls 0 then PDError(304)
		if (pg>>PageG.LastBand+1)*bandWidth ugr
			PDHerald>>PDH.imageSSize then PDError(305)
		FMin=v>>StartImage.fMinPage&(-16)
		let fLastPlus1=v>>StartImage.fMinPage+v>>StartImage.fSizePage
		if fLastPlus1 ugr PDHerald>>PDH.imageFSize then PDError(306)
		FWC=((fLastPlus1-FMin+31) rshift 5) lshift 1	//Even word count
		FMax=FMin+FWC*16-1
		if FMax+1 ugr nBitsPerScan then PDError(307)
		pg>>PageG.BitMargin=FMin
		pg>>PageG.BitWc=FWC
		]; endcase
	case setPriority: [
		let v=vec 1
		v!0=com<<Command.rest
		v!1=WindowRead(PDWindow)
		if DoubleCmp(v, lv PDWindow>>RB.priority) ne 1 then PDError(310)
		DoubleCop(lv PDWindow>>RB.priority, v)
		resultis true
		]; endcase
	case setColorInk: [
		let v=vec size LOC/16
		v>>LOC.typ=loColorInk
		(LOProcs!loColorInk)(v)
		]; endcase
	case setColorClear: [
		let v=vec size LOC/16
		v>>LOC.typ=loColorClear
		(LOProcs!loColorClear)(v)
		]; endcase
	case setColorTile: [
		let v=vec size LOCTile/16
		v>>LOCTile.typ=loColorTile
		v>>LOCTile.transparent=(com&1) ne 0
		let w=vec 2
		WindowReadBlock(PDWindow, w, 2)
		if w>>LongCard.high ne 0 then PDError(309)
		v>>LOCTile.addr=w>>LongCard.low
		(LOProcs!loColorTile)(v)
		]; endcase
	case endBand:
	case endDocument: [
		PDWindow>>RB.end=com<<Command.com
		resultis true
		]; endcase
	case storeLoad: [
		let v=vec size StoreLoad/16
		WindowReadBlock(PDWindow, v, size StoreLoad/16)
		if v>>StoreLoad.addr.high ne 0 then PDError(309)
		let p=v>>StoreLoad.addr.low
		let w=v>>StoreLoad.wordCount
		while w ne 0 do
			[
			let d=vec 100
			let cnt=w; if cnt ugr 100 then cnt=100
			WindowReadBlock(PDWindow, d, cnt)
			LoadWriteBlock(p, d, cnt)
			p=p+cnt; w=w-cnt
			]
		]; endcase
	case deviceCommand: [
		PDError(308)
		let wc=WindowRead(PDWindow)
		for i=1 to wc do WindowRead(PDWindow)
		]; endcase
	]
	resultis false
]

and LPriority(v) = valof
[
	DoubleCop(lv reading>>RB.priority, v+1)
	DecideReading()
	resultis false		//Leftovers handled differently
]

and LEnd(v) = valof
[
	reading>>RB.end=endBand
	DecideReading()
	resultis false
]

// Return -1 if a<b, 0 if a=b, 1 if a>b

and DoubleCmp(a, b) = valof
[
	if a!0 uls b!0 then resultis -1
	if a!0 ugr b!0 then resultis 1
	if a!1 uls b!1 then resultis -1
	if a!1 ugr b!1 then resultis 1
	resultis 0
]