// 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
[ lhbyte
rhbyte
]
// 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È) ne 0 then val=1
if (id) ne 0 then val=val+#002
if (i() ne 0 then val=val+#004
if (i) ne 0 then val=val+#010
if (i ) ne 0 then val=val+#020
if (i) ne 0 then val=val+#040
if (i) ne 0 then val=val+#100
if (i
) 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𒿑) 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)𫙠
ScanMin=ScanMin𫙠//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)
]