// 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&#17)	//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
 ]

(635)\20f1 10144f0 1f1 32f0 1f1 95f0 1f1 101f0 1f1 31f0 1f1 23f0 1f1 36f0 1f1 22f0 1f1 31f0 37f1 16f0 11f1 1f0 11f1 19f0 1f1 7f0 1f1 6f0 1f1 26f0 1f1 17f0 1f1 20f0 1f1