// ScanObjects.bcpl

// modified by Ramshaw, March 11, 1981 10:58 AM
// - added random off-by-one hack to Objects, to move them one bit over in the scan
// direction. This seems to be needed to line them up correctly with rectangles..
// modified by Ramshaw, January 23, 1981 1:31 PM
// - fixed off-by-one bug in rectangle code
// modified by Butterfield, October 16, 1980 11:48 AM
// - ScanObject, have 15 extended rectangles - 10/16
// - this file is Joe’s changed version - 4/17/80

// errors 1500

//ScanObjectInit()
//Called at beginning of scan conversion pass to get intersection
//buffer
//ScanObjectClose()
//Called at end of scan conversion pass.
//ScanObject(v)
//Called with v containing a structure for a band entry (BE) for
//an object. (Including rectangles).
//Does the right thing, returns # of words to put in leftover list.


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

// outgoing procedures
external
[
ScanObjectInit
ScanObjectClose
ScanObject
]

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

// incoming procedures
external
[
//PRESS
PressError
FSGetX
FSPut

//PRESSML
MulMod;DoubleAdd; DoubleSub; DoubleShr
Ugt;BitBLT

//OS
MoveBlock
]

// incoming statics
external
[
BESizes

ScanBuf//Address of scan buffer
ScanBitWc//Word count for scan line
mpSBuf//Map from scan-line to scan buffer
ScanS//S value at left edge of buffer
ScanColorTable//Color table pointer
ScanMin
ScanMax
currentScanColor

Debug
SoftScan
Transparent
]

// internal statics
static
[
ScanObjectBase//Base address of buffer for intersections
ScanObjectOffset// and offset
]

// Procedures

let ScanObjectInit() be
[
ScanObjectBase=FSGetX(nObjectIntersections*2) +
nObjectIntersections*2
ScanObjectOffset=-nObjectIntersections*2
]

and ScanObjectClose() be
[
FSPut(ScanObjectBase-nObjectIntersections*2)
]


//----------------------------------------------------------------------------
and ScanObject(v) = valof
//----------------------------------------------------------------------------
[
let a = v!0;
if a eq BEEndObjectH then resultis ScanEndObject();

if Transparent & (currentScanColor eq 255) then resultis 0; // nothing

let lo = BESizes!a; // Left over count if any
let l = nil; let r = nil;
switchon a into
[
case BEExtendedRectangleH:
case BERectangleH: // different structure (ORbit)
[
if (not SoftScan) & (currentScanColor eq 0) then
resultis 0 // ORbit does it all
l = ScanS + v>>BERectangle.Sr;
r = l + v>>BERectangle.widthM1; //bug: used to include a mistaken "+1" (Ramshaw)
endcase;
]
default:
[
if a gr BEExtendedRectangleH & a le BELastRectangleH then
docase BEExtendedRectangleH;
l = v>>SH.Sbegin; // Left-most s.
if l ge ScanS + BANDWidth then
resultis lo; // Nothing in this band, wait
if l ls ScanS then l = ScanS; // Set to left edge of band
r = v>>SH.Send;
endcase;
]
]

test r ge ScanS + BANDWidth
ifso
[
r = ScanS + (BANDWidth-1); // Set to right edge of band
if (a eq BERectangleH) %
(a ge BEExtendedRectangleH) & (a le BELastRectangleH) then
[
v>>BERectangle.widthM1 = v>>BERectangle.widthM1 -
(16 - v>>BERectangle.Sr);
v>>BERectangle.Sr = 0;
]
]
ifnot lo=0; // Ends in this band

//Now compute intersections from s=l to r (exception: do Rectangles
// directly).
let off=ScanObjectOffset//Current offset
let offincr=(r-l+1)*2//No. words of buffer reqd.

switchon a into
[
default: // must be gr BEExtendedRectangleH & le BELastRectangleH
case BEExtendedRectangleH:
case BERectangleH:
[
let bitStart = v>>BERectangle.Bit + ((a eq BERectangleH)? 0,
(a - BEExtendedRectangleH + 1) lshift 12);
let bitEnd = bitStart - v>>BERectangle.nHeight;
ScanPutRun(l, bitStart, bitEnd, r);
endcase;
]
// starting here ScanObject is in the style it was

case BELineH:
[
compileif DebugSw then [ if off+offincr gr 0 then PressError(1500) ]
for s=l to r do
[
ScanObjectBase!off=s
off=off+1
ScanObjectBase!off=@(lv v>>BELine.Bit)
off=off+1
DoubleAdd(lv v>>BELine.Bit,lv v>>BELine.dBit)
]
ScanObjectOffset=off
]
endcase

 case BESplineH:
[
compileif DebugSw then [ if off+offincr gr 2 then PressError(1500) ]
let b=ScanObjectBase+off

//***************************************************
//Stolen from SCVMAIN.C

let onehalf=table [ 0;#100000 ] //DP 1/2
let tolerance=table [ 0;#100000 ] //DP 1/2

//Layout of "stack": each entry is 16 words, divided into
//4 DP numbers for S direction, followed by
//4 DP numbers for R direction (see structure RSPLINE)
//Each block of four is:
// F(tright)
// G(tright,n)
// F(tleft)
// G(tleft,n)
// (see Sproull notes for meaning of F,G)
let sp=vec splineStackSize//Stacks.
let se=sp-16//End if you get here
//***fixed structure ref here.
MoveBlock(sp,lv v>>BESpline.Stuff,16)
let s=l//Scan-line number
if sp!4 eq s then//Begins exactly at s.
[
b!0=l; b!1=sp!12//Intersection.
b=b+2; s=s+1
]
[if sp eq se then break//Stack empty
test sp!0 ls s then//Right edge < sl
[
sp=sp-16; //Pop stack, move right
] or
test sp!0 eq s &(valof [
let v=vec 2
v!0=sp!0; v!1=sp!1 //Larger S.
DoubleSub(v,sp+4)//minus smaller S.
DoubleSub(v,tolerance)
if v!0 ls 0 then resultis true //Small enough
resultis false//Search to finer detail
]) then
[//Output a point.
DoubleAdd(sp+8,sp+12)//Average two R’s
b!0=s; b!1=(sp!8+1)/2//R value (rounded)
b=b+2
if s eq r then break//done
s=s+1//Bump scan-line count
sp=sp-16//Pop stack.
] or
[//Subdivide....
let x=sp//Part of stack to subdivide
for i=0 to 1 do//Two blocks on stack.
[//Subdivide stack "x":
// x!0,1 F(tright)
// x!2,3 G(tright,n)
// x!4,5 F(tleft)
// x!6,7 G(tleft,n)
let x2=x+2; let x6=x+6; let x4=x+4
DoubleShr(x2); DoubleShr(x2)//Gright
DoubleShr(x6); DoubleShr(x6)//Gleft
x!22=x!6;x!23=x!7//Gleft in place
DoubleAdd(x6,x2)//Gleft+Gright
DoubleShr(x6)//Gmiddle
x!18=x!6;x!19=x!7// and again
x!20=x!4;x!21=x!5//Xleft in place
DoubleAdd(x4,x)//Xleft+Xright
DoubleShr(x4)// *.5
DoubleSub(x4,x6)//.5(Xleft+Xright)-Gmiddle
x!16=x!4;x!17=x!5//Xmiddle again

x=x+8//Do the other block next time.
]

sp=sp+16//Bump stacks.
if (sp-se) ge splineStackSize-16 then PressError(1501)
]//Subdivide
] repeat//Recursive loop
if s ne r then PressError(1502)
//***************************************************
ScanObjectOffset=off+offincr
]
endcase
]

resultis lo
]


and ScanEndObject() = valof
[
let c=(nObjectIntersections*2+ScanObjectOffset) rshift 1 //No. intersections
if c eq 0 then resultis 0//Nothing left...
ScanObjectOffset=-nObjectIntersections*2//Set for next time
let q=ScanObjectBase-nObjectIntersections*2

// Do a bucket sort on scan line, then
// an insertion sort on intersection within the scan line.

if (c&1) ne 0 then PressError(1503)
let intersectionBuckets=FSGetX(nObjectIntersections+BANDWidth)
for i=0 to nObjectIntersections+BANDWidth-1
by nObjectIntersections/BANDWidth+1 do
intersectionBuckets!i=nObjectIntersections/BANDWidth
let p=q
for i=1 to c do
[ let scanLine=(p!0)&(BANDWidth-1)
let intersection=p!1
p=p+2
let bucket=intersectionBuckets+scanLine*(nObjectIntersections/BANDWidth+1)
let nextEntry=bucket!0
if nextEntry eq 0 then
[ PressError(1506);loop]
let inserted=false
for j=nObjectIntersections/BANDWidth to nextEntry+1 by -1 do
if bucket!j gr intersection then
[ MoveBlock(bucket+nextEntry,bucket+nextEntry+1,j-nextEntry)
bucket!j=intersection
inserted=true
break
]
unless inserted do bucket!nextEntry=intersection
bucket!0=nextEntry-1
]

let bucket=intersectionBuckets
for scanLine=ScanS to ScanS+15 do
[ let nextEntry=bucket!0
let nIntersections=nObjectIntersections/BANDWidth-nextEntry
if (nIntersections&1) ne 0 then PressError(1504)
for i=nextEntry+1 to nObjectIntersections/BANDWidth by 2 do
ScanPutRun(scanLine,bucket!(i+1)+1,bucket!i+1) //These plus 1’s are a naked hack
// to move objects over one bit in the scan direction, added by Ramshaw.
bucket=bucket+nObjectIntersections/BANDWidth+1
]

FSPut(intersectionBuckets)

// let changes=nil
// [
// changes=false
// let p=q
// for i=2 to c do
//[
//if p!0 gr p!2 % (p!0 eq p!2 & p!1 gr p!3) then
// [
// changes=true//Exchange
// let t=nil
// t=p!0; p!0=p!2; p!2=t
// t=p!1; p!1=p!3; p!3=t
// ]
//p=p+2
//]
// ] repeatuntil changes eq false
//
// for i=1 to c by 2 do
// [
// if q!0 ne q!2 then PressError(1504)
// ScanPutRun(q!0,q!1,q!3)//Play out run
// q=q+4
// ]
//
resultis size BEEndObject/16
]

//Put out a run of current color on scan line s between b1 (inclusive)
// and b2 (NOT included).
// **** Will eventually be in microcode ****

and ScanPutRun(s,b1,b2,sEnd;numargs na) be
[
//******** kludge *********
if b1 eq b2 then b1=b1-1
//*****************

if b1 ls ScanMin then ScanMin=b1
if b2 gr ScanMax then ScanMax=b2//shouldn’t this be b2-1??ScanPutShadedDots cares

if na ls 4 then sEnd = s
let BLTv=vec 16;BLTv=BLTv+(BLTv&1)
let cycleLen=ScanColorTable!0
let cycleBitLen=cycleLen*16
let cyclePerBlock=ScanColorTable!1
let linesPerBlock=ScanColorTable!2
let totalLen=b2-b1
BLTv!0=Transparent?1,0//src=block,fn=paint/replace
BLTv!2=mpSBuf!0//dbca
BLTv!3=ScanBitWc//dbmr
BLTv!4=b1//dlx
BLTv!5=s&(BANDWidth-1)//dty
BLTv!7=sEnd+1-s//dh
if (cycleLen eq 1)&(linesPerBlock eq 1) then//simple case
[BLTv!0=BLTv!0+#14//source=gray
BLTv!6=totalLen//dw
let gray=ScanColorTable!3
BLTv!12=gray
BLTv!13=gray
BLTv!14=gray
BLTv!15=gray
BitBLT(BLTv)
return
]
let blockNum=s/linesPerBlock
let lineNum=s rem linesPerBlock
let wordOffset=b1 rshift 4
//let lineIndex=(blockNum*cyclePerBlock+wordOffset) rem cycleLen
let lineIndex=MulMod(blockNum,cyclePerBlock,cycleLen)
lineIndex=(lineIndex+wordOffset) rem cycleLen
BLTv!8=ScanColorTable+3//sbca
BLTv!9=cycleLen//sbmr
BLTv!10=lineIndex*16+(b1)//slx
BLTv!11=lineNum//sty
let maxLen=cycleBitLen-BLTv!10

[if totalLen le maxLen then
[ BLTv!6=totalLen;BitBLT(BLTv);return]
BLTv!6=maxLen//dw
BitBLT(BLTv)
totalLen=totalLen-maxLen
BLTv!10=0//slx
maxLen=cycleBitLen
BLTv!4=BLTv!4 + BLTv!6//dlx
] repeat
]