// ScanConvert.bcpl

// modified by Ramshaw, January 20, 1982  12:12 PM
// - if Transparent, then don't count on sync codes being monotonically
//   increasing.  Thus, check colors not codes.
// Now use syncInfinity, instead of '9999' (shrug)
// modified by Ramshaw, December 15, 1981  9:28 PM
// - Use Ugt to compare sync's instead of "gr"
// last modified by Ramshaw, March 20, 1981  1:33 PM
// - ScanConvert, keep maximum character size in longLines, so
//   don't let longLines nextBogusChar get above longLines - 10/20
// - ScanConvert, have 15 extended rectangles - 10/16
// - ScanConvert, have ScanChar call ScanCharFault - 9/30
// - ScanConvert, don't let longLines nextBogusChar get above longIccMax - 8/8
// - this file is Joe's changed version - 4/17/80

//   errors 1300
//
//Controller for scan conversion process. 
//
//ScanConvertInit()
//	Assumes the "file" statics contain pointers to files.  Sets up
//	various buffers, etc. (e.g., character hash table & storage areas)
//	%%%% Here's where to pre-load character table %%%%
//ScanConvertClose()
//	Finishes current scan conversion session.
//ScanConvert(pg,CopyToPrint)
//	Scan converts the page described by the PageG structure pg, and
//	writes it onto the bits file starting at pg>>PageG.BitPage.  Returns
//	number of pages of the bits file used, or -1 if not enough available.
//	CopyToPrint is the copy number -- governs band list interp.
//	pg is filled up with PageG structure of goodies.
//

get "PressInternals.df"
get "PressParams.df"

// outgoing procedures
external
	[
	ScanConvertInit
	ScanConvertClose
	ScanConvert
	ScanColorPassValue //to scanconvert2
	]

// outgoing statics
external
	[
				//State to other "scan" routines:
	ScanBuf			//Core buffer for bits
	ScanBitWc		//Word count for a scan line
	ScanBitMargin
	mpSBuf		//Map scan-line in band (0-15) to scan buffer
	ScanS			//Scan line number of first in buffer
	ScanMin
	ScanMax

	Left1RB			//RB's for leftovers (for ScanChars)
	Left2RB

	FMCycles			//Font memory cycles (for metering)
	currentScanColor		//Current color set up in ink well
	ScanHalftoneDot
	colorCache
	]
static
	[
	ScanBuf
	ScanBitWc
	mpSBuf
	ScanBitMargin
	ScanS
	ScanMin
	ScanMax

	Left1RB
	Left2RB

	FMCycles
	currentScanColor	
	ScanHalftoneDot
	colorCache
	]

// incoming procedures
external
	[
///SCANCONVERT2
	ScanColor
//SCANCHARS
	ScanCharInit
	ScanCharClose
	ScanChar
	ScanCharLO
	ScanCharColor
//SCANDOTS
	InitScreen
	ScanDotsInit
	ScanDotsClose
	ScanDots
	GCD
//SCANOBJECTS
	ScanObjectInit
	ScanObjectClose
	ScanObject

//WINDOW
	WindowInit
	WindowClose
	WindowSetPosition
	WindowGetPosition
	WindowReadBlock
	WindowWriteBlock
	WindowNext
	WindowWrite
	WindowRead

//FILES
	FileWritePage
	FileStuff

//METER
	MeterBlock
	MeterTime

//PRESS
	PressError
	FSGet;FSGetX
	FSPut
	GetTime
	DblShift

//PRESSML
	DoubleCop
	DoubleAdd;DoubleAddV
	DoubleSub;DoubleShr
	MulDiv
	DivFull
	BitBLT

//OS
	Ugt
	MoveBlock
	Zero

//CURSOR
	CursorChar
	CursorDigit
	CursorToggle
	]

// incoming statics
external
	[
//Files needed
	BitsFile
	BandFile
	LeftOverFile1
	LeftOverFile2

	BESizes			//Table of lengths of BE entries.
	DPzero			//Double-precision zero
	nBands
	ICCtot

	UseMicroCode
	Report
	Debug
	SoftScan
	TShirtMode
	InvertMode
	Transparent
	nPrinterColors
	printerDevice

	ScreenModulus	//for determining color table screen frequency
	ScreenAngle
	]

external longLines;  // from PreChars

// internal statics
static
	[
	BandRB			//RB for Bands (a Window)
	BandWriter			//output window for Bands
	lastLeftOverSync		//File position where last sync stored
	ColorPass
	pctSynthetic 
	FlipVec
	blackPass
	]
	compileif DebugSw then [ static [ ScanStop] ]			//Debugging
	compileif ReportSw then [ static [ ConvertTimeIn] ]

// File-wide structure and manifest declarations.
manifest
[
BitBLTFlag=false
]
structure
 [ lh	byte
   rh	byte
 ]
// Procedures

let ScanConvertInit() be
 [
   compileif ReportSw then [ ConvertTimeIn=GetTime() ]
   CursorChar($C)

   compileif offset RB.Base ne offset W.Base then [ foo=0 ]
   ScanCharInit()			//Get char tables
   ScanObjectInit()		//And object tables
   ScanDotsInit()
   BandRB=WindowInit(BandFile, 2)
   BandWriter=WindowInit(BandFile, 1)
   Left1RB=WindowInit(LeftOverFile1, 1)
   Left2RB=WindowInit(LeftOverFile2, 1)
   @DoubleAdd=DoubleAddTrap
   @DoubleSub=DoubleSubTrap
   @DoubleShr=DoubleShrTrap
   pctSynthetic = (nPrinterColors eq 4)?50,100 
   colorCache=FSGetX(256)
   colorCache!0=table [ 1;0;1;-1]
   colorCache!255=table [ 1;0;1;0]
   Zero(colorCache+1,254)
   if TShirtMode then
    [ FlipVec=FSGetX(256)
      for i=0 to 255 do
	[ let val=0
	  if (i&#200) ne 0 then val=1
	  if (i&#100) ne 0 then val=val+#002
	  if (i&#040) ne 0 then val=val+#004
	  if (i&#020) ne 0 then val=val+#010
	  if (i&#010) ne 0 then val=val+#020
	  if (i&#004) ne 0 then val=val+#040
	  if (i&#002) ne 0 then val=val+#100
	  if (i&#001) ne 0 then val=val+#200
	  FlipVec!i=val
	]
    ]
 ]

and ScanConvertClose() be
 [
   FSPut(colorCache)
   ScanCharClose()
   ScanObjectClose()
   ScanDotsClose()
   WindowClose(BandRB)
   WindowClose(BandWriter)
   WindowClose(Left1RB)
   WindowClose(Left2RB)
   @DoubleAdd=NoTrap
   @DoubleSub=NoTrap
   @DoubleShr=NoTrap
   compileif ReportSw then [ GetTime(lv Report>>REP.ConvertTime, ConvertTimeIn) ]
 ]

and ScanConvert(pg, CopyToPrint) = valof
 [
//Compute size of core buffer for bits.
   ColorPass=pg>>PageG.ColorPass
//fucking bcpl & is a bit operation, not a logical one!!!
let black=(pg>>PageG.ColorUsed)?false,true
if black&(printerDevice eq printerPuffin)&(ColorPass ne 0) then resultis 0
blackPass=(nPrinterColors ls 4)%
	    (ColorPass eq 3)%
	    (black&(printerDevice eq printerPuffin)&(ColorPass eq 0))
   ScanBitWc=pg>>PageG.BitWc	//Get length of scan line.
   let lScanBuf=ScanBitWc*BANDWidth
   ScanBitMargin=pg>>PageG.BitMargin
//Set bits file parameters
   let BitPage=pg>>PageG.BitPage		//Units are 1024 words
   let nPagesPerBuf=((lScanBuf+1023)/1024)
   let nPagesWritten=0
   let nWordsWritten=0
   let usePages=(pg>>PageG.LastBand-pg>>PageG.FirstBand+1)*nPagesPerBuf
   let fl=vec 1
   FileStuff(BitsFile, fl)
   DblShift(fl, 10)			//Convert to 1024-word pages
   let BitLimit=fl!1
//test overflow later (whole bitmap is not written out)
//   if BitPage+usePages gr fl!1 then resultis -1	//Will not fit
   let nextBuffFreeList=FSGetX(BandWriter>>W.BufSize)
   let nextBuffFreeIndex=0

//Now guaranteed to do some work:
   CursorDigit(pg>>PageG.PageNumber)
   let SCStats=vec (size SCStat/16)
   compileif MeterSw then
	[
	Zero(SCStats, (size SCStat/16))
	SCStats>>SCStat.TimeIn=MeterTime()
	]

//Allocate scan buffer:
   ScanBuf=FSGetX(lScanBuf+1)	//One core buffer (for now)
				//Reason for +1 is to make address checks
				// in ScanPutChar easier..(debug only)
   let OutputBuf=FSGetX(4097)	//should be 4096: when real BitBLT gets used

//Make table of beginning addresses of scan lines.  Each address is
// offset by the known margin (in words)
   let lmpSBuf=vec 16
   let p=ScanBuf-(pg>>PageG.BitMargin/16)
   for i=0 to 15 do
	[
	lmpSBuf!i=p
	p=p+ScanBitWc
	]
   mpSBuf=lmpSBuf

//Allocate color table
 [ let v=vec size BEDots/16
   v>>BEDots.ScreenModulus=ScreenModulus	//default frequency setting
   v>>BEDots.ScreenAngle=(table [ 30;0;60;45])!ColorPass
   if nPrinterColors eq 1 then v>>BEDots.ScreenAngle=ScreenAngle	//default
   v>>BEDots.IMin=0
   v>>BEDots.IMax=64
   v>>BEDots.ScreenAmplitude=100
   unless InitScreen(v) do [ PressError(1620);finish]
   let screenDef=v>>BEDots.ScreenStart
   let nWords,nLines,D=screenDef!0,screenDef!1,screenDef!2
   let outputWordsPerLine=nWords/nLines
   ScanHalftoneDot=FSGetX(nWords+4)
   MoveBlock(ScanHalftoneDot+4,screenDef+3,nWords)
   FSPut(screenDef)

   let lenTurnOn=outputWordsPerLine
   let wordD=-1
    [ for x=0 to lenTurnOn-1 do
	 if ((x*16) rem lenTurnOn) eq D then [ wordD=x;break]
      if wordD ge 0 then break
if (outputWordsPerLine&1) eq 1 then PressError(1306)
      outputWordsPerLine=outputWordsPerLine rshift 1
      let newSHD=FSGetX(nWords*2+4)
      MoveBlock(newSHD,ScanHalftoneDot,nWords+4)
      for i=0 to nLines-1 do
      [ let Offset=4+i*lenTurnOn
	MoveBlock(newSHD+nWords+Offset,ScanHalftoneDot+Offset+D,
									lenTurnOn-D)
	MoveBlock(newSHD+nWords+Offset+lenTurnOn-D,ScanHalftoneDot+Offset,
									D)
      ]
      FSPut(ScanHalftoneDot)
      ScanHalftoneDot=newSHD
      nWords=nWords*2
      D=(D*2) rem lenTurnOn
      nLines=nLines*2
    ] repeat
   ScanHalftoneDot!0=outputWordsPerLine
   ScanHalftoneDot!1=wordD
   ScanHalftoneDot!2=nLines
   ScanHalftoneDot!3=lenTurnOn
 ]
   currentScanColor=-1

//Make 2-word vector to hold file pos in output leftover file of
// last sync entry
   let vv=vec 1
   lastLeftOverSync=vv

//Pass global information to microcode
   if UseMicroCode then
	[
	let v=vec 5
	v!0=mpSBuf
	v!1=ScanBitWc
	( table [ ScanLoadVarsTrap ] )(v)
	]

//Set Band position
   WindowSetPosition(BandRB, lv pg>>PageG.BandPos)
   WindowSetPosition(BandWriter, lv pg>>PageG.BandPos)

//Set up RB's for bands, leftover stuff.
   WindowSetPosition(Left1RB, DPzero)
   let LeftOverOut=Left1RB		//Write into LeftOverOut
   let LeftOverRB=Left2RB		//Read from LeftOverRB

//Note that first band and last band were calculated at prescan time
// by knowing limits (in scan direction) of image.  Thus there will be
// an empty leftover list where this loop exits.

let nextBogusChar=#100000+ICCtot
CursorToggle(pg>>PageG.ColorPass)
for b=pg>>PageG.FirstBand to pg>>PageG.LastBand do
[
   CursorToggle(0,MulDiv(b,600,nBands))
   test SoftScan
   then [ ScanMin=pg>>PageG.BitMargin;ScanMax=ScanMin+pg>>PageG.BitWc*16]
   or    [ ScanMin=4096;ScanMax=0]
   ScanS=b*BANDWidth
   let StartingBandPos=vec 3
   compileif MeterSw then
	[
	StartingBandPos!2=0; StartingBandPos!3=0
	FMCycles=StartingBandPos+2	//Count memory cycles needed
	WindowGetPosition(BandRB, StartingBandPos)
	]
   compileif DebugSw then
	[
	if ScanStop ne 0 & (ScanStop&#077777) eq ScanS then
	   PressError(1300)
	]
   Zero(ScanBuf,lScanBuf)		//Massive zeroing!

//Switch leftover tables
   let  t=LeftOverRB
   LeftOverRB=LeftOverOut
   LeftOverOut=t

//Set up access to old leftovers for this band.
   let cRB=LeftOverRB			//Current RB.
   WindowWrite(LeftOverRB,BEEndH)	//Put 2 terminators on the leftover
   WindowWrite(LeftOverRB,BEEndH)	//One for us, one for ScanCharFault to see
   let ReadingLeftOvers=true
   LeftOverRB>>RB.Sync=0			//Init sync stuff
   Zero(lv LeftOverRB>>RB.Color,lColor)
   ScanColor(table [ 0;0])
   LeftOverRB>>RB.Reading=true
   WindowSetPosition(LeftOverRB, DPzero)	//Start reading at beginning

//And the new band stuff
   BandRB>>RB.Sync=0
   Zero(lv BandRB>>RB.Color,lColor)

//And position new leftover window.
   WindowSetPosition(LeftOverOut, DPzero)
   LeftOverOut>>RB.Reading=false
   lastLeftOverSync!0=-1		//No syncs out yet in leftover

   let v=vec BEMaxSize+10				//To hold long BE's


[					//For all BE's (bands+leftover)
   if cRB>>RB.Offset eq 0 then AdvanceRB(cRB)
   let off=cRB>>RB.Offset
   let a=(cRB>>RB.Base)!off
   cRB>>RB.Offset=off+1			//Read a word of BE

//Now dispatch appropriately.
   let LeftOverCount=0
   v!0=a
   compileif offset BEH.Cbit ne 0 % size BEH.Cbit ne 1 then [ foo=nil ]
   test (a&CharBit) ne 0				//*** Testing for Cbit ***
   ifso
	[				//A Character
	if cRB>>RB.Offset eq 0 then AdvanceRB(cRB)
	let off=cRB>>RB.Offset
	v!1=(cRB>>RB.Base)!off
	cRB>>RB.Offset=off+1		//Read next word.
	compileif size BEChar/16 ne 2 then [ foo=0 ]
	test ReadingLeftOvers then
	   [
	   if cRB>>RB.Offset eq 0 then AdvanceRB(cRB)
	   let off=cRB>>RB.Offset
	   v!2=(cRB>>RB.Base)!off
	   cRB>>RB.Offset=off+1		//Read next word.
	   if cRB>>RB.Offset eq 0 then AdvanceRB(cRB)
	   let off=cRB>>RB.Offset
	   v!3=(cRB>>RB.Base)!off
	   cRB>>RB.Offset=off+1		//Read next word.
	   compileif size BELOChar/16 ne 4 then [ foo=0 ]
	   LeftOverCount=ScanCharLO(v)	//Process character
	   ]
	or
	   [
	    unless SoftScan%(a eq CharBit)%(currentScanColor ne 0) do
		 WindowWriteBlock(BandWriter,v,size BEChar/16)
	   LeftOverCount = ScanChar(v);  // Process character
	   ]
	]
   ifnot
	[lf				//Something less frequent!
	v!0=a				//First word.
	for i=1 to BESizes!a-1 do
	   [
	   if cRB>>RB.Offset eq 0 then AdvanceRB(cRB)
	   let off=cRB>>RB.Offset
	   v!i=(cRB>>RB.Base)!off
	   cRB>>RB.Offset=off+1		//Read next word.
	   ]
	switchon a into
	[
	case BESyncH:
	case BEEndH:
			[
//Call a procedure to deal with the sync point.  Returns 0 (no leftovers),
// -1 (end of processing this band).  May write a leftover by hand.
			let a=ScanSyncProc(v,lv cRB,LeftOverRB,BandRB)
			if a ls 0 then break	//All done with band!
			ReadingLeftOvers=(cRB eq LeftOverRB)
			]
			endcase
	case BECopyH:
			[
			LeftOverCount=0
			unless ( v>>BECopy.Copy eq 0 %
			 v>>BECopy.Copy eq CopyToPrint ) then
			   [
//Call a procedure to pass up stuff not for this copy.  It may encounter
// sync points as it does so.  In this case, it returns true, and sets
// the vector v to contain an appropriate sync point, which must then
// be processed as above.
			   let a=ScanCopyProc(v,cRB,CopyToPrint)
			   if a then
				[
				a=ScanSyncProc(v,lv cRB,LeftOverRB,BandRB)
				if a ls 0 then break
				ReadingLeftOvers=(cRB eq LeftOverRB)
				]
			   ]
			]
			endcase
	case BEDotsH:
			[
			LeftOverCount=ScanDots(v,ReadingLeftOvers)
			]
			endcase

	case BEExtendedRectangleH:	//only called if SoftScan true
	case BERectangleH: 
		LeftOverCount=ScanObject(v,ReadingLeftOvers)
		if (not SoftScan)&(currentScanColor eq 0)&(not ReadingLeftOvers) then //ORbit will do the work
			 WindowWriteBlock(BandWriter,v,size BERectangle/16)
		endcase
	case BELineH:
	case BESplineH:
	case BEEndObjectH:	
			[
			LeftOverCount=ScanObject(v,ReadingLeftOvers)
			]
			endcase
	default: if a gr BEExtendedRectangleH & a le BELastRectangleH then
	 docase BEExtendedRectangleH;  // otherwise fall through
	case BEMaxH + 1: [ PressError(1301); endcase; ]
	]

	]lf					//ifnot

   if LeftOverCount then
    [					//Write out stuff.
	compileif DebugSw then 
	   [
	   if LeftOverCount ls 0 % LeftOverCount gr BEMaxSize then
		PressError(1302)
	   ]
	WindowWriteBlock(LeftOverOut,v,LeftOverCount)
    ]

] repeat					//For all BE's

//Record size of leftovers
   compileif MeterSw then
	[
	let t=vec 1
	WindowGetPosition(LeftOverOut, t)
	let oloc=(t!1)/BandDistUnit		//Left over out count
	let adr=(lv SCStats>>SCStat.LOSizes)+
		((oloc le BandDist-2)? oloc, BandDist-1)
	@adr=@adr+1

	WindowGetPosition(LeftOverRB, t)
	let iloc=t!1
	WindowGetPosition(BandRB, t)
	DoubleSub(t, StartingBandPos)
	iloc=(iloc+t!1)/BandDistUnit
	let adr=(lv SCStats>>SCStat.TotSizes)+
		((iloc le BandDist-2)? iloc, BandDist-1)
	@adr=@adr+1

	let FMC=((FMCycles!0*2)+(FMCycles!1 rshift 15))*(#77777/FMCycleUnit)+
		(FMCycles!1 & #77777)/FMCycleUnit
	let adr=(lv SCStats>>SCStat.FMCycleDist)+
		((FMC le nFMCycleDist-2)? FMC, nFMCycleDist-1)
	@adr=@adr+1
	if oloc ls 0 % iloc ls 0 % FMC ls 0 then PressError(1303)
	]

if TShirtMode then //bit reverse ScanBuf
 [ let scanLineStart=ScanBitMargin/BANDWidth
   let scanLineEnd=scanLineStart+ScanBitWc-1
   for s=0 to BANDWidth-1 do
    [ let firstAddr=mpSBuf!s+scanLineStart
      let lastAddr=mpSBuf!s+scanLineEnd
      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 the buffer!
test printerDevice gr printerDurango then //3100 interface
[ if (BitPage+nPagesWritten+nPagesPerBuf) ge BitLimit then resultis -1 //won't fit
  FileWritePage(BitsFile,BitPage+nPagesWritten,ScanBuf,nPagesPerBuf)
  nPagesWritten=nPagesWritten+nPagesPerBuf
]

//for ORbit: ScanMin,ScanMax has min and max bit position for this band
or 
[ if ScanMin le ScanMax then //write out the buffer
[
compileif not BitBLTFlag then
 [ ScanMax=(ScanMax+15)&#177760
   ScanMin=ScanMin&#177760	//even word boundaries for MoveBlock
 ]
if longLines & (nextBogusChar & #77777) gr longLines then PressError(1306);
let v=vec size BEChar/16;v!0=nextBogusChar;v!1=ScanMin
nextBogusChar=nextBogusChar+1
WindowWriteBlock(BandWriter,v,size BEChar/16)

let w=(ScanMax+1-ScanMin)&-2 //bit width, must be even (so wordlen is even)
let wWords=w/16
let wRem=w&15
let nWordsToWrite=2+w
if nWordsToWrite gr (4096-nWordsWritten) then
	[ //pad to <4096> page boundary
	unless nWordsWritten eq 4096 do OutputBuf!nWordsWritten=1	//positive number is flush flag
	if (BitPage+nPagesWritten+4096/1024) gr BitLimit then resultis -1 //won't fit
	FileWritePage(BitsFile,BitPage+nPagesWritten,OutputBuf,4096/1024)
	nPagesWritten=nPagesWritten+4096/1024
	nWordsWritten=0
	nextBuffFreeList!nextBuffFreeIndex=b+1
	nextBuffFreeIndex=nextBuffFreeIndex+1
	]
OutputBuf!nWordsWritten=-w //-bits per scan line for ORbit
OutputBuf!(nWordsWritten+1)=15	//width-1 for ORbit
nWordsWritten=nWordsWritten+2

compiletest BitBLTFlag then
[
//BITBLT!!!!
let BLTv=vec 12;BLTv=(BLTv+1)&-2
BLTv!0=0
BLTv!3=4096	//Dest scan line length (don't care: just doing 1 scan line)
BLTv!5=0	//Dest y offset
BLTv!6=w	//Dest width (and so, source width)
BLTv!7=1	//Dest height
BLTv!9=ScanBitWc
BLTv!10=ScanMin	//Source x offset
BLTv!11=0		//Source y offset
let iwWords,iwRem=0,0
for s=0 to BANDWidth-1 do
 [ BLTv!2=OutputBuf+nWordsWritten+iwWords	//Dest BCA
   BLTv!4=iwRem	//Dest x offset
   BLTv!8=mpSBuf!s	//Source BCA
   BitBLT(BLTv)
   //optimize out the multiplications
   iwWords=iwWords+wWords
   iwRem=iwRem+wRem
 ]
]
or//not BitBLTFlag, so MoveBlock
[ let iwWords=0
  for s=0 to BANDWidth-1 do
    [ MoveBlock(OutputBuf+nWordsWritten+iwWords,
			mpSBuf!s+ScanMin/BANDWidth,
			wWords)
      iwWords=iwWords+wWords
     ]
]

nWordsWritten=nWordsWritten+w

] //end of "if ScanMin le ScanMax"
WindowWriteBlock(BandWriter,table [ 0;0],2)	//band terminator
] //end of non-ORbit case
   ]					//end of "for b=firstband to lastband"

//Write out meter
   compileif MeterSw then
	[
	SCStats>>SCStat.TimeOut=MeterTime()
	MeterBlock(METERConvertPage,SCStats,(size SCStat/16))
	]

unless printerDevice gr printerDurango do
[   unless nWordsWritten eq 0 do
	[ if nWordsWritten eq 4096 then
	   [ if (BitPage+nPagesWritten+4096/1024) gr BitLimit then resultis -1
	     FileWritePage(BitsFile,BitPage+nPagesWritten,OutputBuf,4096/1024)
	     nWordsWritten=0 
	     nPagesWritten=nPagesWritten+4096/1024
	   ]
	OutputBuf!nWordsWritten=0	///end signal
	if (BitPage+nPagesWritten+4096/1024) gr BitLimit then resultis -1 //won't fit
	FileWritePage(BitsFile,BitPage+nPagesWritten,OutputBuf,4096/1024)
	nPagesWritten=nPagesWritten+4096/1024
	]

   //and insert two blank bands at the end
   WindowWriteBlock(BandWriter,table [ 0;0;0;0],4)
   let pageEnd=WindowNext(BandWriter)
   let v=vec 1;DoubleCop(v,lv pg>>PageG.BandPos)
   DblShift(v,BandWriter>>W.LogBufSize)//convert to pages
   pg>>PageG.nRecords=pageEnd-v!1
   unless pg>>PageG.SimplePage do
	WindowWriteBlock(BandWriter,nextBuffFreeList,BandWriter>>W.BufSize)
] //end of ORbit cleanup case

//shouldn't this stuff go in ScanConvertClose??
   for i = 1 to 254 do if colorCache!i ne 0 then 
	[ FSPut(colorCache!i);colorCache!i=0]
   FSPut(ScanHalftoneDot)
   FSPut(OutputBuf)
   FSPut(ScanBuf)
   FSPut(nextBuffFreeList)
   resultis nPagesWritten

]


//AdvanceRB advances an RB structure to get a new usable window on
// the structure.  


and AdvanceRB(rb) be
 [
   WindowNext(rb,false)
 ]

//ScanSyncProc
// Process a sync point.  May switch the current RB we are reading from.
// Also may change color.  If a leftover must be written, it does so
// itself, and checks to make sure that two consecutive sync entries
// are not written.
// Returns: -1 if done with entire band.

and ScanSyncProc(v,lvcRB,LeftOverRB,BandRB) = valof
 [
   let cRB=@lvcRB			//Current reading from
   let currentSync=cRB>>RB.Sync	//Sync code we are currently doing.
   let currentColor=vec lColor
   MoveBlock(currentColor,lv cRB>>RB.Color, lColor)
   let otherRB=LeftOverRB xor BandRB xor cRB
   let sync=v>>BESync.Sync		//New sync code we just came upon.
   if v>>BESync.H eq BEEndH then sync=syncInfinity

//Save state of current RB (state= AFTER reading this sync)
   cRB>>RB.Sync=sync
   MoveBlock(lv cRB>>RB.Color,lv v>>BESync.Color,lColor)	//Save so when we resume, correct

//Now decide if we must switch.
   if Ugt(sync,otherRB>>RB.Sync) then
     [
      @lvcRB=otherRB		//Switched!!!!!
      cRB=otherRB
     ]

//Now get stuff from newly current RB
   sync=cRB>>RB.Sync
// If the sync we are about to execute is syncInfinity, we are done, because
// it was generated by encountering an "End" indication:
   if sync eq syncInfinity then resultis -1
// If the sync we are about to process is the same as the one we
// were processing when this procedure was called, there is 
// no need for a left-over or color change.
// BUT:  If Transparent mode is set, then sync codes will cycle, so we
// must check for equal colors, not for equal sync codes.

   test Transparent
    ifso
	[
	if currentColor>>Color.Hue eq cRB>>RB.Hue &
	   currentColor>>Color.Saturation eq cRB>>RB.Saturation &
	   currentColor>>Color.Intensity eq cRB>>RB.Intensity then
		resultis 0
	]
    ifnot
	[
	if sync eq currentSync then resultis 0
	]
   if sync eq 0 then PressError(1304)	//Should never output LO sync=0

   ScanColor(lv cRB>>RB.Color)			//Now set color

//Prepare a leftover entry to record.
   v>>BESync.H=BESyncH		//In case previous guy was end and this is leftover!
   v>>BESync.Sync=sync		//Record new number.
   MoveBlock(lv v>>BESync.Color,lv cRB>>RB.Color,lColor)

// Try to avoid duplicate sync entries in the leftover list.  These
// can pile up and slow down color selection tremendously.  We do this
// by remembering (in lastLeftOverSync) the file position just AFTER
// we put out the previous sync entry.  If we try to put out another
// before an intervening (graphical) leftover has been put out, we
// first back up the leftover file.

   let LeftOverOut=Left1RB xor Left2RB xor LeftOverRB
   let dpSyncSize= table [ 0;size BESync/16 ]
   let dp=vec 1
   WindowGetPosition(LeftOverOut, dp)
   if dp!0 eq lastLeftOverSync!0 & dp!1 eq lastLeftOverSync!1 then
	[					//Back up over previous sync.
	DoubleSub(dp, dpSyncSize)
	WindowSetPosition(LeftOverOut, dp)
	]
   WindowWriteBlock(LeftOverOut, v, size BESync/16)
   DoubleAdd(dp, dpSyncSize)
   DoubleCop(lastLeftOverSync, dp)

   resultis 0
]

and

//ScanCopyProc
// Scans ahead on the current RB (guaranteed to be the BandRB) and
// returns when there is more info for this copy number.  If there
// is a sync point encountered along the way, returns true with the
// vector v set up with a description of the last sync point.  If no
// sync point encountered, returns false.

ScanCopyProc(v,cRB,CopyToPrint) = valof
 [
   let sync=false
   let q=vec 10

     [
      let a=WindowRead(cRB)
      test a ls 0 then WindowRead(cRB)	//Rest of char
      or
	[
	v!0=a
	WindowReadBlock(cRB,v+1,BESizes!a-1)
	test a eq BESyncH then
	   [
	   MoveBlock(q,v,10)
	   sync=true
	   ] or
	test a eq BEEndH then resultis true or
	if a eq BECopyH then
	   [
	   if v>>BECopy.Copy eq 0 % v>>BECopy.Copy eq CopyToPrint
		then break
	   ]
	]
     ] repeat
   MoveBlock(v,q,10)
   resultis sync
 ]


// returning 0 produces the most intense color here
and ScanColorPassValue(colorV)=valof
[
manifest [ RED=0; YELLOW=40; GREEN=80; CYAN=120
	BLUE=160; MAGENTA=200 ]

let hue=colorV>>Color.Hue
if hue ge 240 then hue=0   //[240..255] all mean red by definition
let sat=colorV>>Color.Saturation // 0 means grey
let brightness = colorV>>Color.Intensity // 0 means very dark

// if printing on a black-and-white printer:
// colors print as 50% grey, greys print correctly
if nPrinterColors eq 1 then resultis sat? 128, brightness

// if it's a grey, then print it correctly
// blackPass means this is a pass used to generate black 
// may be a color if it's a 3-color printer)
// return nothing for (4-color) non-black pass
if sat eq 0 then resultis blackPass? brightness, 255

let hueregion = (hue/40)*40
let amtmagenta, amtyellow, amtcyan = 0, 0, 0
switchon hueregion into
	[ // 40 = full saturation
	case RED: amtmagenta=YELLOW-hue; amtyellow=40; endcase
	case YELLOW: amtcyan=hue-YELLOW; amtyellow=40; endcase
	case GREEN: amtyellow=CYAN-hue; amtcyan=40; endcase
	case CYAN: amtmagenta=hue-CYAN; amtcyan=40 ; endcase
	case BLUE: amtcyan=MAGENTA-hue; amtmagenta=40; endcase
	case MAGENTA:amtyellow=hue-MAGENTA;amtmagenta=40;endcase
	]
amtmagenta = (amtmagenta*sat)/40
amtcyan = (amtcyan*sat)/40
amtyellow = (amtyellow*sat)/40
// at least one of these will be 0

let ourcolor = selecton ColorPass into
	[
	case 0: amtmagenta
	case 1: amtyellow
	case 2: amtcyan
	case 3: 0
	]

// following line says that amount of hue used to make black is
// some proportion of amount of hue not used to make hue
// because 255-ourcolor is hue remaining
let black = MulDiv (255-ourcolor, 255-brightness, 255)
// have now separated them as much as possible;
// now put back the appropriate amount of synthetic black
let synthamt = (pctSynthetic*black)/100
if ColorPass ne 3 then resultis 255 - (ourcolor+synthamt)
// following line takes account of the fact that putting real black
// over synthetic black results in some overlap
resultis MulDiv (255, brightness, 255-synthamt)
]
(1270)\17781i1I7296i10I

(635)