--Griffin encoding types
--m.stone November 20, 1979  2:55 PM
-- Last Edited by: Stone, February 18, 1983 4:37 pm
-- Last Edited by: Pier, February 14, 1984 10:08:57 am PST

DIRECTORY
	GriffinMemoryDefs USING [CZone, Allocate, Free],
	PointDefs: FROM "PointDefs",
	PrincOpsUtils: FROM "PrincOpsUtils",
	ScreenDefs: FROM "ScreenDefs" USING [StartChain, NextChainPoint, EndChain,
		NextScanLine, StartArea],
	Graphics USING [Context],
	GriffinDefs: FROM "GriffinDefs" ,
	EncodingDefs: FROM "EncodingDefs";

Encoding: PROGRAM IMPORTS PrincOpsUtils,GriffinMemoryDefs,GriffinDefs,ScreenDefs 
EXPORTS EncodingDefs   =
BEGIN OPEN EncodingDefs,GriffinMemoryDefs;

firstChunk,thisChunk: ChainHandle;
ptCount,orIndex: INTEGER;
Dir: TYPE = [0..10];
YMode: TYPE = {up,down,init,horiz};
zeroDir, oneDir: Dir;
minpt,maxpt,oldpt: PointDefs.ScrPt;
oldYmode: YMode _ init;
octruns: PACKED ARRAY[0..63] OF BYTE _ ALL[0];
newOctRuns: LONG DESCRIPTOR FOR PACKED ARRAY OF BYTE _ DESCRIPTOR[octruns];
first: BOOLEAN _ TRUE;
normalUpdate: BOOLEAN _ FALSE;
GetZeroDir: ARRAY [0..7] OF Dir = [6,2,1,0,4,8,9,10];
GetYMode: ARRAY [0..7] OF YMode = [horiz,down,down,horiz,horiz,up,up,horiz];
DirToYMode: ARRAY [0..10] OF YMode =
	 [up,up,up,init,horiz,init,horiz,init,down,down,down];
OctToDx: ARRAY [0..7] OF INTEGER = [1,1,0,-1,-1,-1,0,1];
OctToDy: ARRAY [0..7] OF INTEGER = [0,-1,-1,-1,0,1,1,1];
centerDir: Dir = 5;
whatOctant: INTEGER = 9;
DirToOctant: ARRAY [0..10] OF CARDINAL = [3,2,1,whatOctant,4,whatOctant,0,whatOctant,5,6,7];
bitmask: ARRAY[0..15] OF CARDINAL = [1B,2B,4B,10B,20B,40B,100B,200B,400B,1000B,2000B,4000B,10000B,20000B,40000B,100000B];

AddChainPoint: PUBLIC PROCEDURE[pt: PointDefs.ScrPt]=
BEGIN OPEN PointDefs;
dx,dy: INTEGER;
newDir: Dir;
newYmode: YMode _ init;
IF first THEN BEGIN
	StartNewChunk[pt];
	first _ FALSE;
	RETURN;
	END;

--normal case
dx _ pt[X]-oldpt[X];
dy _ pt[Y]-oldpt[Y];
newDir _ (dx+1)+ (dy+1)*4;
IF newDir=centerDir THEN RETURN;

--for monotonic pieces
newYmode _ DirToYMode[newDir];
--update to clear init or if make a change.
--horizontal ymode should be ignored except when would start new chunk anyway
IF (oldYmode=init AND newYmode#horiz) OR (oldYmode=init AND ptCount=63)
	THEN oldYmode _ newYmode
ELSE IF newYmode#oldYmode AND newYmode#horiz THEN BEGIN
	savept: PointDefs.ScrPt _ pt;	--shouldn't be necessary
	EndChunk[];
	StartNewChunk[oldpt];
	oldYmode _ newYmode;
	pt _ savept;
	END;
oldpt _pt;

IF ptCount =64 THEN BEGIN
	EndChunk[];
	StartNewChunk[pt];
	RETURN;
	END;

IF pt[X] > maxpt[X] THEN maxpt[X] _ pt[X];
IF pt[Y] > maxpt[Y] THEN maxpt[Y] _ pt[Y];
IF pt[X] < minpt[X] THEN minpt[X] _ pt[X];
IF pt[Y] < minpt[Y] THEN minpt[Y] _ pt[Y];

IF orIndex<0 THEN ChangeOctant[newDir];	--entry after startnewchunk
IF (newDir#oneDir AND newDir#zeroDir) THEN ChangeOctant[newDir];

--assume same octant, gen true for lines
IF ReadRun[newOctRuns[orIndex]] =31THEN BEGIN
	oct: CARDINAL _ ReadOctant[newOctRuns[orIndex]];
	orIndex _ orIndex+1;
	newOctRuns[orIndex] _ SetOctant[oct];
	normalUpdate _ FALSE;
	END;

IF newDir =oneDir THEN BEGIN
	index: CARDINAL _ ptCount/16;
	thisChunk.bits[index] _ SetBit[ptCount MOD 16,thisChunk.bits[index]];
	END;
ptCount _ ptCount+1;
IF normalUpdate THEN newOctRuns[orIndex] _ newOctRuns[orIndex]+1
ELSE normalUpdate _ TRUE;
END;

--top 3 bits are octant, bottom 5 are run
SetOctant: PROCEDURE[octant: [0..7]] RETURNS[BYTE]= INLINE
BEGIN OPEN PrincOpsUtils;
RETURN[BITSHIFT[octant,5]]; 
END;

ReadOctant: PROCEDURE[octant: [0..7]] RETURNS[CARDINAL]= INLINE
BEGIN RETURN[PrincOpsUtils.BITSHIFT[octant,-5]]; END;

ReadRun: PROCEDURE[byte: BYTE] RETURNS[CARDINAL]= INLINE
BEGIN RETURN[PrincOpsUtils.BITAND[byte,37B]]; END;

SetBit: PROCEDURE[bitnum,word: CARDINAL] RETURNS[CARDINAL]= INLINE
BEGIN RETURN[PrincOpsUtils.BITOR[bitmask[bitnum],word]]; END;

ChangeOctant: PROCEDURE[new: Dir]=
BEGIN
newOct: CARDINAL _ DirToOctant[new];
IF newOct = whatOctant THEN GriffinDefs.UserMessage["bad direction"];
orIndex _ orIndex+1;
newOctRuns[orIndex] _ SetOctant[newOct];
zeroDir _ new;
oneDir _ GetZeroDir[(newOct+1) MOD 8];
normalUpdate _ FALSE;
END;

StartNewChunk: PROCEDURE[pt: PointDefs.ScrPt]=
BEGIN
IF first THEN BEGIN
	firstChunk _ thisChunk _CZone.NEW[ChainEncoding];
	oldYmode _ init;
	END
ELSE BEGIN 
	thisChunk.link _ CZone.NEW[ChainEncoding];
	thisChunk _ thisChunk.link;
	END;
thisChunk^ _ [NIL,0,[0,0],[0,0],pt,DESCRIPTOR[NIL,0],[0,0,0,0]];
Zero[BASE[newOctRuns],LENGTH[newOctRuns]/2];	--cause it's packed
ptCount _ 0;
orIndex _  -1;
maxpt _ minpt _ oldpt _ pt;
END;

EndChunk: PROCEDURE=
BEGIN
thisChunk.tl _ minpt;
thisChunk.br _ maxpt;
thisChunk.octants _ DESCRIPTOR[Allocate[(orIndex+2)/2],orIndex+1];
PrincOpsUtils.LongCOPY[BASE[newOctRuns],(orIndex+2)/2,BASE[thisChunk.octants]];
END;

MakeChainEncoding:  PUBLIC PROCEDURE RETURNS[ptr: ChainHandle] =
BEGIN OPEN PointDefs;
IF first THEN RETURN[NIL];	--case called without any points
IF BASE[thisChunk.octants]=NIL THEN EndChunk[];
first _ TRUE;
RETURN[firstChunk];
END;

TestChainChunk: PUBLIC PROCEDURE[encoding: ChainHandle,
	NextPoint: PROCEDURE[PointDefs.ScrPt] RETURNS[stop: BOOLEAN] ]=
BEGIN OPEN PointDefs;
pt: ScrPt _ encoding.p0;
dx0,dy0,dx1,dy1: INTEGER;
oct,orNum,cnt,i: CARDINAL;
ptNum: CARDINAL _ 0;
[] _ NextPoint[pt] ;
FOR orNum IN [0..LENGTH[encoding.octants]) DO
	oct _ ReadOctant[encoding.octants[orNum]];
	dx0 _ OctToDx[oct];  dy0 _ OctToDy[oct];
	oct _ (oct+1) MOD 8;
	dx1 _ OctToDx[oct];  dy1 _ OctToDy[oct];
	cnt _ ReadRun[encoding.octants[orNum]];
	FOR i IN [0..cnt] DO
		IF BitOn[ptNum MOD 16, encoding.bits[ptNum/16]] 
			THEN BEGIN pt[X] _ pt[X]+dx1; pt[Y] _ pt[Y]+dy1 END
		ELSE BEGIN pt[X] _ pt[X]+dx0; pt[Y] _ pt[Y]+dy0 END;
		IF NextPoint[pt] THEN RETURN;
		ptNum _ptNum+1;
		ENDLOOP;
	ENDLOOP;
END;


--philosopy:  ShowObjects.PlotChainEncoding does culling
PlotChainChunk: PUBLIC PROCEDURE[encoding: ChainHandle, dc: Graphics.Context]=
BEGIN OPEN PointDefs;
dx0,dy0,dx1,dy1: INTEGER;
oct,orNum,cnt,i: CARDINAL;
ptNum: CARDINAL _ 0;
ScreenDefs.StartChain[encoding.p0, dc];
FOR orNum IN [0..LENGTH[encoding.octants]) DO
	oct _ ReadOctant[encoding.octants[orNum]];
	dx0 _ OctToDx[oct];  dy0 _ OctToDy[oct];
	oct _ (oct+1) MOD 8;
	dx1 _ OctToDx[oct];  dy1 _ OctToDy[oct];
	cnt _ ReadRun[encoding.octants[orNum]];
	FOR i IN [0..cnt] DO
		IF BitOn[ptNum MOD 16, encoding.bits[ptNum/16]] 
			THEN ScreenDefs.NextChainPoint[dx1,dy1, dc]
			ELSE ScreenDefs.NextChainPoint[dx0,dy0, dc];
		ptNum _ptNum+1;
		ENDLOOP;
	ENDLOOP;
ScreenDefs.EndChain[dc];
END;

BitOn: PROCEDURE[bitnum,word: CARDINAL] RETURNS[BOOLEAN]= INLINE
BEGIN 
RETURN[IF PrincOpsUtils.BITAND[bitmask[bitnum],word] = 0 THEN FALSE ELSE TRUE];
END;

AddChainLine: PUBLIC PROCEDURE[pt: PointDefs.ScrPt] =
BEGIN OPEN PointDefs;
E: INTEGER _0;
S: INTEGER _ Y;
L: INTEGER _ X;
IncS: INTEGER _ 1;	--point increments
IncL: INTEGER _ 1;
xy: ScrPt _ oldpt;
EIncS: INTEGER _ pt[X]-xy[X];	--error increments. S,L are direction, not size
EIncL: INTEGER _ pt[Y]-xy[Y];
--one dot wide
IF (ABS[pt[X]-xy[X]]<=1 AND ABS[pt[Y]-xy[Y]] <=1) THEN BEGIN
	AddChainPoint[pt];
	RETURN;
	END;
--IncL goes with EIncS, and IncS goes with EIncL in this section
IF ABS[EIncS] < ABS[EIncL] THEN BEGIN	--45-90 octant
	T: INTEGER _ L;
	EInc: INTEGER _ EIncL;
	L _ S; EIncL _ EIncS;
	S _ T; EIncS _ EInc;
	END;
--following assures that S error increment is positive, the other is negative, and the point increments 
--are the correct signs
IF EIncL < 0 THEN IncS _ -1 ELSE EIncL _ -EIncL;
IF EIncS < 0 THEN BEGIN IncL _ -1; EIncS _ - EIncS; END;
--now IncL goes with EIncL and IncS with EIncS
AddChainPoint[xy];	--get first point in.  Need this doubling in scan convert
UNTIL xy[L] = pt[L]  DO
	E _ E + EIncL;
	xy[L] _ xy[L]+IncL;
	IF ABS[E + EIncS] < ABS[E] THEN BEGIN
		xy[S] _ xy[S]+IncS;
		E _ E+EIncS;
		END;
	AddChainPoint[xy];
	ENDLOOP;	
AddChainPoint[pt];	--get last point in
oldpt _ pt;
END;

DeleteChainEncoding:  PUBLIC PROCEDURE[ptr: ChainHandle] =
BEGIN
encoding: ChainHandle;
UNTIL ptr=NIL DO
	Free[BASE[ptr.octants]];
	encoding _ ptr;
	ptr _ ptr.link;
--	Free[encoding];
	ENDLOOP;
END;
CopyChainEncoding: PUBLIC PROCEDURE[chain: ChainHandle] RETURNS[newchain: ChainHandle]=
--should really carefully clean up and deallocate, I suppose
BEGIN ENABLE UNWIND => {newchain _ NIL};
length: CARDINAL;
firstChunk: REF ChainEncoding _ NIL;
thisChunk,ptr: REF ChainEncoding;
FOR ptr _ chain, ptr.link UNTIL ptr=NIL DO
	IF firstChunk=NIL THEN firstChunk _ thisChunk _CZone.NEW[ChainEncoding]
	ELSE BEGIN 
		thisChunk.link _ CZone.NEW[ChainEncoding];
		thisChunk _ thisChunk.link;
		END;
	thisChunk^ _ ptr^;
	length _ LENGTH[ptr.octants];
	thisChunk.octants _ DESCRIPTOR[Allocate[length],length];
	PrincOpsUtils.LongCOPY[from: BASE[ptr.octants], to: BASE[thisChunk.octants], nwords: length];
	ENDLOOP;
newchain _ firstChunk;
END;


--START OF AREA ENCODING
--reads the chain encoding, which is assumed to be in monotonic sections.
--once it makes and sorts the edges, is a classic scan conversion algorithm.
--each encoded scan line may have 1 or more runs on it.  The flag in the encoding is
--a startx of -1 (377B for packed) which implies that dx is the number of runs per line. 
--Care is taken that chunks don't break across scan lines.  Chunks are roughly 64 
--scan lines each, or until there is a size change 

Edge: TYPE = RECORD
	[nextEdge: LONG POINTER TO Edge,
	nextCurrent: LONG POINTER TO Edge,
	currentMinX,currentMaxX,ymin,ymax: INTEGER,
	chain: ChainHandle,
	end: ChainHandle
	];

firstArea: AreaHandle _ NIL;
thisArea: AreaHandle _ NIL;
runs: ARRAY [0..64) OF LongRun _ ALL[[0,0]];	--runs while we are building them
newRuns: LONG DESCRIPTOR FOR ARRAY OF LongRun _ DESCRIPTOR[runs];
runIndex: CARDINAL _ 0;
yFirst: INTEGER _ 0;	--first y in a chunk
flag: INTEGER _ -77777B;	--large negative number

MakeAreaEncoding:  PUBLIC PROCEDURE[chain: ChainHandle] RETURNS[AreaHandle] =
BEGIN OPEN PointDefs;
nInters: CARDINAL _ 2;
allEdges,allCurrent,ptr,tptr: LONG POINTER TO Edge;
startX,dX,yScan: INTEGER;
scanIndex: CARDINAL;
patch: ChainHandle;

--Initialize
Zero[BASE[newRuns],LENGTH[newRuns]*SIZE[LongRun]];	
runIndex _ 0;
firstArea _ NIL;
allCurrent _ NIL;

--make the edges, linked together thru allEdges in ymin order
[allEdges,patch] _ MakeEdges[chain];
IF allEdges=NIL THEN RETURN[NIL];
yScan _ yFirst _ allEdges.ymin;
--YLOOP until no more current edges
DO
-- links together edges thru allCurrent
	UNTIL allEdges=NIL DO
		IF allEdges.ymin <=yScan THEN BEGIN
--add to allCurrent list
			allEdges.nextCurrent _ allCurrent;
			allCurrent _ allEdges;
--delete from allEdges list
			allEdges _ allEdges.nextEdge;
			END
--can exit since list is ymin sorted
		ELSE EXIT;
		ENDLOOP;
--delete out anything we've passed up
	ptr _ allCurrent;
	UNTIL ptr=NIL DO
		IF ptr.ymax < yScan THEN BEGIN 
			IF ptr = allCurrent THEN BEGIN
				allCurrent _ ptr.nextCurrent;
				Free[ptr];
				ptr _ allCurrent;
				END
			ELSE BEGIN
				tptr.nextCurrent _ ptr.nextCurrent;
				Free[ptr];
				ptr _ tptr.nextCurrent;
				END
			END
		ELSE BEGIN
			tptr _ ptr;
			ptr _ ptr.nextCurrent;
			END;
		ENDLOOP;

	IF allCurrent=NIL THEN EXIT;	--no more edges

--set currentX for all X, count edges and sort list
	scanIndex _ 0;
	FOR ptr _ allCurrent, ptr.nextCurrent UNTIL ptr=NIL DO
		SetCurrentX[ptr,yScan];
		scanIndex _ scanIndex+1;
		ENDLOOP;
	allCurrent _ XSort[allCurrent];
--test for change in number of intersections
	IF (scanIndex MOD 2#0) THEN BEGIN
		NULL; EXIT; END;
	IF scanIndex#nInters THEN BEGIN
		nInters _ scanIndex;
		AddRun[flag,nInters/2,yScan];
		END;
--XLOOP
	ptr _ allCurrent;
	UNTIL ptr=NIL DO
		startX _ ptr.currentMinX;
		IF startX<=flag THEN BEGIN
			NULL; EXIT; END;
		ptr _ ptr.nextCurrent;
		dX _ ptr.currentMaxX;
		AddRun[startX,dX-startX+1,yScan];
		ptr _ ptr.nextCurrent;
		ENDLOOP;
--inc yScan and YLOOP
	yScan _ yScan+1;
	ENDLOOP;
IF runIndex#0 THEN EndArea[yScan];
IF patch#NIL THEN patch.link _ NIL;	--break the circle in  the chain encoding if necessary
RETURN[firstArea];
END;

AddRun: PROCEDURE[startx,dx,y: INTEGER]=
BEGIN
IF runIndex>=64 THEN EndArea[y];
--IF startx#flag THEN ScreenDefs.HFill[y,startx,dx, NIL];
newRuns[runIndex] _ [startx,dx];
runIndex _ runIndex+1;
END;

EndArea: PROCEDURE[yscan: INTEGER]=
BEGIN
type: RunType _ short;
xmin,xmax,rx,lx: INTEGER;
i,j: CARDINAL;
rpl: CARDINAL _ 1;
nextra: CARDINAL _ 0;
yLast: INTEGER _ yscan-1;	--current scan line isn't in this chunk
i _ 0;
xmin _ 1000; xmax _ 0;
UNTIL i =runIndex DO
	IF newRuns[i].lx=flag THEN BEGIN
		rpl _ newRuns[i].dx;
		i _ i+1;
		LOOP;
		END;
--the nextra stuff is so that we don't split scanlines across chunks
	IF i+rpl >runIndex THEN BEGIN
		nextra_ runIndex-i;
		runIndex _ i;
		EXIT;
		END;
	lx _ newRuns[i].lx;
	FOR j IN [1..rpl] DO
		rx _ newRuns[i].lx+newRuns[i].dx-1;
		i _ i+1;
		yLast _ yLast-nextra;
		ENDLOOP;
	IF lx < xmin THEN xmin _ lx;
	IF rx > xmax THEN xmax _ rx;
	ENDLOOP;
--make the lx relative to xmin, and determine the type of encoding
FOR i IN [0..runIndex) DO
	IF newRuns[i].dx>377B THEN type_long;
	IF newRuns[i].lx =flag THEN LOOP;
	newRuns[i].lx _ newRuns[i].lx-xmin;
	IF newRuns[i].lx>376B THEN type_long;
	ENDLOOP;
IF firstArea=NIL THEN firstArea _ thisArea _ AllocateArea[type]
ELSE BEGIN 
	thisArea.link _ AllocateArea[type];
	thisArea _ thisArea.link;
	END;
--set common fields
thisArea.tl _ [xmin,yFirst];
thisArea.br _ [xmax,yLast];
--set varient fields
WITH area: thisArea SELECT FROM
	short => BEGIN
		sr: ShortRun;
		area.runs _ DESCRIPTOR[Allocate[runIndex*SIZE[ShortRun]],runIndex];
		FOR i IN [0..runIndex) DO
			IF newRuns[i].lx = flag THEN sr.lx _ 377B ELSE sr.lx _ newRuns[i].lx;
			sr.dx _ newRuns[i].dx;
			area.runs[i] _ sr;
			ENDLOOP;
		END;
	long => BEGIN
		area.runs _ DESCRIPTOR[Allocate[runIndex*SIZE[LongRun]],runIndex];
		PrincOpsUtils.LongCOPY[BASE[newRuns],runIndex*SIZE[LongRun],BASE[area.runs]];
		END;
	ENDCASE;
--copy in any extra
IF nextra#0 THEN BEGIN
	newRuns[0] _ [flag,rpl];	--set the switch
	FOR i IN [1..nextra] DO
		newRuns[i] _ newRuns[runIndex];
		newRuns[i].lx _ newRuns[i].lx;	
		runIndex _ runIndex+1;
		ENDLOOP;
	--zero rest (compulsive tidyness)
	FOR i IN [nextra+1..LENGTH[newRuns]) DO
		newRuns[i] _ [0,0];
		ENDLOOP;
	runIndex _ nextra+1;	--to account for the switch
	END
ELSE BEGIN
	Zero[BASE[newRuns],LENGTH[newRuns]*SIZE[LongRun]];	
	runIndex _ 0;
	IF rpl#1 THEN AddRun[flag,rpl,yLast+1];
	END;
yFirst _ yLast+1;
END;

MakeEdges: PROCEDURE[chain: ChainHandle] RETURNS[LONG POINTER TO Edge,ChainHandle]=
BEGIN OPEN PointDefs;
thisChain: ChainHandle _ chain;
firstChain: ChainHandle _ NIL;
lastInFirstChain: ChainHandle _ chain;
thisChunk: ChainHandle _ chain;
newEdge: LONG POINTER TO Edge _ NIL;
firstEdge: LONG POINTER TO Edge _ NIL;
thisYmode,nextYmode: YMode;
endpt: ScrPt;
--add in ymin order
AddEdge: PROCEDURE[edge: LONG POINTER TO Edge] = BEGIN
	ptr: LONG POINTER TO Edge _ NIL;
	IF firstEdge=NIL THEN BEGIN
		firstEdge _ edge	;
		RETURN;
		END;
--find right spot
	FOR ptr _ firstEdge, ptr _ ptr.nextEdge UNTIL ptr.nextEdge=NIL DO
		IF ptr.nextEdge.ymin>edge.ymin THEN EXIT;
		ENDLOOP;
--insert after ptr with another special case at list head
	IF ptr=firstEdge AND edge.ymin<firstEdge.ymin  THEN BEGIN
		edge.nextEdge _ firstEdge;	--insert before firstEdge
		firstEdge _ edge;
		END
	ELSE BEGIN
		edge.nextEdge _ ptr.nextEdge;
		ptr.nextEdge _ edge;
		END;
	END;

thisYmode _ SetYMode[thisChunk];
FOR thisChunk _ chain, thisChunk.link UNTIL thisChunk=NIL DO
--usual exit.  RETURN at end of routine is for fuckups
	IF thisChunk.link=NIL THEN BEGIN
		ymode: YMode _ init;
		chunk: ChainHandle _firstChain;
		firstendpt: ScrPt;	--last point in edge
--case of 2 edges total
		IF firstChain=NIL THEN BEGIN
			IF  thisYmode#horiz THEN BEGIN
				endpt _  ReadEndPt[thisChunk];	--last point in edge
				newEdge _ MakeEdge[thisChain,thisChunk.link,endpt]; 	--last edge
				AddEdge[newEdge];
				END;
			RETURN[firstEdge,NIL];
			END;
--can compute parameters for first chain
		firstendpt _  ReadEndPt[lastInFirstChain];	--last point in edge
		UNTIL chunk=lastInFirstChain.link DO
			ymode _ SetYMode[chunk];
			IF ymode#horiz THEN EXIT;	--direction of firstchain
			chunk _ chunk.link;
			ENDLOOP;
--case of separate edge for first chain
		IF thisYmode#ymode THEN BEGIN
--make a separate first edge if it isn't horizontal
			IF ymode#horiz THEN BEGIN
				newEdge _ MakeEdge[firstChain,lastInFirstChain.link,firstendpt]; 
				AddEdge[newEdge];
				END;
--make the last edge if it isn't horizontal
			IF thisYmode#horiz THEN BEGIN
				endpt _  ReadEndPt[thisChunk];	--last point in edge
				newEdge _ MakeEdge[thisChain,thisChunk.link,endpt]; 	--last edge
				AddEdge[newEdge];
				END;
			RETURN[firstEdge,NIL];
			END;
--otherwise, combine the chains and make one edge
--this will make a ring out of the encoding.  Can't just rearrange it because of external
--pointers to it.  This cludge lets MakeAreaEncoding know how to fix the ring.
--can be removed if this is rewritten to copy the data structure 
		thisChunk.link _ firstChain;
		newEdge _ MakeEdge[thisChain,lastInFirstChain.link,firstendpt];
		AddEdge[newEdge];
		RETURN[firstEdge,thisChunk];
		END;
--direction change in Y makes new edge
	nextYmode _ SetYMode[thisChunk.link];
	IF nextYmode= thisYmode OR nextYmode=horiz THEN LOOP;	--just ignore horizontal chunks
--Got a new edge
--just save first piece of chain
	IF firstChain=NIL THEN BEGIN
		firstChain _ thisChain;
		lastInFirstChain _ thisChunk;
		END
--set min,max and currentX
	ELSE BEGIN
		endpt _  ReadEndPt[thisChunk];	--last point in edge
		newEdge _ MakeEdge[thisChain,thisChunk.link,endpt];
		AddEdge[newEdge];
		END;
--init the next chain
	thisChain _ thisChunk.link;
	thisYmode _ nextYmode;
	ENDLOOP;
RETURN[firstEdge,NIL];
END;

MakeEdge: PROCEDURE[thisChain,end: ChainHandle,endpt: PointDefs.ScrPt] RETURNS[LONG POINTER TO Edge]=
BEGIN OPEN PointDefs;
newEdge: LONG POINTER TO Edge _ Allocate[SIZE[Edge]];
newEdge^ _ [NIL,NIL,0,0,0,0,thisChain,end];
--set min,max and currentX
IF endpt[Y] < thisChain.p0[Y] THEN BEGIN	--thisChain.p0 is first point
	newEdge.ymin _ endpt[Y];
	newEdge.ymax _ thisChain.p0[Y];
	END
ELSE BEGIN
	newEdge.ymin _ thisChain.p0[Y];
	newEdge.ymax _ endpt[Y];
	END;
RETURN[newEdge];
END;

SetYMode: PROCEDURE[chunk: ChainHandle] RETURNS[YMode]=
BEGIN OPEN PointDefs;
ymode: YMode;
oldY,dy: INTEGER;
i: CARDINAL;
done: BOOLEAN _ FALSE;
CheckDy: PROCEDURE[newpt: ScrPt] RETURNS[stop: BOOLEAN]= BEGIN
	dy _ newpt[Y] - oldY;
	ymode _ SELECT dy FROM
		-1 => down,
		0 => horiz,
		1 => up,
		ENDCASE => horiz;
	IF ymode#horiz THEN {done _ TRUE; RETURN[TRUE]} ELSE RETURN[FALSE];
	END;
--will only return horiz if entire chunk is horizontal
IF chunk.tl[Y]=chunk.br[Y] THEN RETURN[horiz];
FOR i IN [0..LENGTH[chunk.octants]) DO
	ymode _ GetYMode[ReadOctant[chunk.octants[i]]];
	IF ymode#horiz THEN RETURN[ymode];
	ENDLOOP;
--all octants read as horizontal.  Are going to have to check directions
oldY _ chunk.p0[Y];
TestChainChunk[chunk,CheckDy];
RETURN[ymode];
END;

ReadEndPt: PROCEDURE[chunk: ChainHandle] RETURNS[PointDefs.ScrPt]=
BEGIN
point: PointDefs.ScrPt _ chunk.p0;
Update: PROCEDURE[newPt: PointDefs.ScrPt] RETURNS[stop: BOOLEAN]=
	BEGIN point _ newPt; RETURN[FALSE]; END;
TestChainChunk[chunk,Update];
RETURN[point];
END;

--X Sort (switching sort, since x list is nearly sorted anyway)
XSort: PROCEDURE[edges: LONG POINTER TO Edge] RETURNS[LONG POINTER TO Edge]=
BEGIN
head,trail,ptr,tptr: LONG POINTER TO Edge;
switches: CARDINAL _ 1;
head _ edges;
IF edges = NIL THEN RETURN[edges];
UNTIL switches=0 DO
	switches _ 0;
	ptr _ head;
	UNTIL ptr.nextCurrent = NIL DO
	IF ptr.currentMinX > ptr.nextCurrent.currentMinX OR 
		  (ptr.currentMinX=ptr.nextCurrent.currentMinX
		  AND ptr.currentMaxX>ptr.nextCurrent.currentMaxX) THEN BEGIN
			switches _ switches+1;
			tptr _ ptr.nextCurrent;
			IF ptr=head THEN head _ tptr
			ELSE trail.nextCurrent _ tptr;
			ptr.nextCurrent _ tptr.nextCurrent;
			tptr.nextCurrent _ ptr;
			trail _ tptr;
			END
		ELSE BEGIN
			trail _ ptr;
			ptr _ ptr.nextCurrent;
			END;
		ENDLOOP;
	ENDLOOP;
RETURN[head];
END;

SetCurrentX: PROCEDURE[edge: LONG POINTER TO Edge,y: INTEGER]=
BEGIN OPEN PointDefs;
encoding: ChainHandle;
dx0,dy0,dx1,dy1: INTEGER;
oct,orNum,cnt,i: CARDINAL;
ptNum: CARDINAL _ 0;
found: BOOLEAN _ FALSE;
pt: ScrPt  _ edge.chain.p0;
scanning: {up,down} _ (IF pt[Y]=edge.ymin THEN up ELSE down);
edge.currentMinX _ 77777B;
edge.currentMaxX _ -77777B;
FOR encoding _ edge.chain, encoding.link UNTIL encoding=edge.end DO
  IF y IN [encoding.tl[Y]..encoding.br[Y]] THEN BEGIN
	pt _ encoding.p0;
	ptNum _ 0;
--check encoding.p0
	IF pt[Y]=y THEN BEGIN
		found _ TRUE;	--found something
		IF pt[X]<edge.currentMinX THEN edge.currentMinX _ pt[X];
		IF pt[X]>edge.currentMaxX THEN edge.currentMaxX _ pt[X];
		END;
--generate  and test the rest of the points
	FOR orNum IN [0..LENGTH[encoding.octants]) DO
		oct _ ReadOctant[encoding.octants[orNum]];
		dx0 _ OctToDx[oct];  dy0 _ OctToDy[oct];
		oct _ (oct+1) MOD 8;
		dx1 _ OctToDx[oct];  dy1 _ OctToDy[oct];
		cnt _ ReadRun[encoding.octants[orNum]];
		FOR i IN [0..cnt] DO
			IF BitOn[ptNum MOD 16, encoding.bits[ptNum/16]] 
				THEN BEGIN pt[X] _ pt[X]+dx1; pt[Y] _ pt[Y]+dy1 END
			ELSE BEGIN pt[X] _ pt[X]+dx0; pt[Y] _ pt[Y]+dy0 END;
--this is the test for definitely done.  may not hit it if pts are at min or max of edge.  In that case,
--will drop out the bottom with found set
			IF found AND ((scanning=up AND pt[Y]>y) OR (scanning=down AND pt[Y]<y))
				THEN RETURN;
			IF pt[Y]=y THEN BEGIN
				found _ TRUE;	--found something
				IF pt[X]<edge.currentMinX THEN edge.currentMinX _ pt[X];
				IF pt[X]>edge.currentMaxX THEN edge.currentMaxX _ pt[X];
				END;
			ptNum _ptNum+1;
			ENDLOOP;
		ENDLOOP;
	END;
  ENDLOOP;
IF NOT found THEN GriffinDefs.UserMessage["no point on this edge"];
END;

DeleteAreaEncoding:  PUBLIC PROCEDURE[ptr: AreaHandle] =
BEGIN
encoding,tptr: AreaHandle;
encoding _ ptr;
UNTIL encoding=NIL DO
	tptr _ encoding.link;
	WITH area: encoding SELECT FROM
		long => Free[BASE[area.runs]];
		short => Free[BASE[area.runs]];
		ENDCASE;
--	Free[encoding];
	encoding _ tptr;
	ENDLOOP;
END;

AllocateArea: PROC[type: RunType] RETURNS [AreaHandle] = INLINE {
	IF type=short THEN RETURN[CZone.NEW[AreaEncoding[short]]]
	ELSE RETURN[CZone.NEW[AreaEncoding[long]]];
	};

CopyAreaEncoding: PUBLIC PROCEDURE[oldarea: AreaHandle] RETURNS[newarea: AreaHandle]=
BEGIN ENABLE UNWIND => {newarea _ NIL};
firstArea,lastArea: REF AreaEncoding _ NIL;
thisArea,areaptr: REF AreaEncoding;
FOR areaptr _ oldarea, areaptr.link UNTIL areaptr=NIL DO
	WITH areaptr SELECT FROM
		area: REF AreaEncoding[short] => BEGIN
			short: REF AreaEncoding[short] _ CZone.NEW[AreaEncoding[short]];
			length: CARDINAL _ LENGTH[area.runs];
			short.tl _ area.tl; short.br _ area.br;
			short.runs _ DESCRIPTOR[Allocate[length*SIZE[ShortRun]],length];
			PrincOpsUtils.LongCOPY[from: BASE[area.runs],
				to: BASE[short.runs],
				nwords: length*SIZE[ShortRun]];
			thisArea _ short;
			END;
		area: REF AreaEncoding[long] => BEGIN
			long: REF AreaEncoding[long] _ CZone.NEW[AreaEncoding[long]];
			length: CARDINAL _ LENGTH[area.runs];
			long.tl _ area.tl; long.br _ area.br;
			long.runs _ DESCRIPTOR[Allocate[length*SIZE[LongRun]],length];
			PrincOpsUtils.LongCOPY[from: BASE[area.runs],
				to: BASE[long.runs],
				nwords: length*SIZE[LongRun]];
			thisArea _ long;
			END;
		ENDCASE;
	IF firstArea=NIL THEN firstArea _ lastArea _ thisArea
	ELSE {lastArea.link _thisArea; lastArea _ lastArea.link};
	ENDLOOP;
newarea _ firstArea;
END;

TestAreaChunk: PUBLIC PROCEDURE[encoding: AreaHandle,
	TestLine: PROCEDURE[y,lx,dx: INTEGER] RETURNS[stop: BOOLEAN] ]=
BEGIN OPEN PointDefs;
xorig,yScan,lx,dx: INTEGER;
i,rpl: CARDINAL;
xorig _ encoding.tl[X];
yScan _ encoding.tl[Y];
rpl _ 1;
i_ 0;
--not overlayed varient since eventually will have rules, etc
WITH area: encoding SELECT FROM
	long => UNTIL yScan>area.br[Y] DO
		IF area.runs[i].lx=flag THEN BEGIN
			rpl _ area.runs[i].dx;
			i_i+1;
			LOOP;
			END;
		THROUGH [1..rpl] DO
			lx _ xorig+area.runs[i].lx;
			dx _ area.runs[i].dx;
			IF TestLine[yScan,lx,dx] THEN RETURN;
			i _ i+1;
			ENDLOOP;
		yScan _ yScan+1;
		ENDLOOP;
	short => UNTIL yScan>area.br[Y] DO
		IF area.runs[i].lx=377B THEN BEGIN
			rpl _ area.runs[i].dx;
			i_i+1;
			LOOP;
			END;
		THROUGH [1..rpl] DO
			lx _ xorig+area.runs[i].lx;
			dx _ area.runs[i].dx;
			IF TestLine[yScan,lx,dx] THEN RETURN;
			i _ i+1;
			ENDLOOP;
		yScan _ yScan+1;
		ENDLOOP;
	ENDCASE;
END;

--ShowObject.PlotChainEncoding does culling
PlotAreaChunk: PUBLIC PROCEDURE[encoding: AreaHandle, dc: Graphics.Context]=
BEGIN OPEN PointDefs;
xorig,yScan,lx,rx: INTEGER;
i,rpl: CARDINAL;
[yScan,xorig] _ ScreenDefs.StartArea[encoding.tl[Y], dc];
xorig _ xorig+encoding.tl[X];
rpl _ 1;
i_ 0;
--not overlayed varient since eventually will have rules, etc
WITH area: encoding SELECT FROM
	long => UNTIL i>=LENGTH[area.runs] DO
		IF area.runs[i].lx=flag THEN BEGIN
			rpl _ area.runs[i].dx;
			i_i+1;
			LOOP;
			END;
		THROUGH [1..rpl] DO
			lx _ xorig+area.runs[i].lx;
			rx _ lx+area.runs[i].dx-1;
			ScreenDefs.NextScanLine[yScan,lx,rx,dc];
			i _ i+1;
			ENDLOOP;
		yScan _ yScan+1;
		ENDLOOP;
	short => UNTIL i>=LENGTH[area.runs] DO
		IF area.runs[i].lx=377B THEN BEGIN
			rpl _ area.runs[i].dx;
			i_i+1;
			LOOP;
			END;
		THROUGH [1..rpl] DO
			lx _ xorig+area.runs[i].lx;
			rx _ lx+area.runs[i].dx-1;
			ScreenDefs.NextScanLine[yScan,lx,rx,dc];
			i _ i+1;
			ENDLOOP;
		yScan _ yScan+1;
		ENDLOOP;
	ENDCASE;
END;

Zero: PROC [block: LONG POINTER, length: CARDINAL] = {
	block^ _ 0;
	PrincOpsUtils.LongCOPY[from: block, to: block+1, nwords: length-1];
	};

END.
Źł˜JšēĻc­
œ
Ļk	œžœ&žœžœžœžœMžœžœ žœžœ
žœ9žœžœ
žœVžœžœžœtžœ
žœžœ
žœžœžœ
ž
œ
žœ
žœ
žœ
žœ
žœž
œžœžœžœžœžœžœ%žœžœ@žœ	žœJžœžœ
žœ"žœžœ
žœ9žœžœ	žœ
žœ@žœžœ
žœZĻn
œžœ
ž	œžœ
žœžœ'žœžœ
žœžœžœžœœž
œž
œž
œž
œžœžœ
žœœzžœžœžœžœžœžœ
žœžœžœ
žœ œIžœžœ
žœ
žœ#žœžœžœž
œ
ž
œžœž
œž
œžœž
œ
ž
œžœž
œž
œžœž
œ
ž
œžœž
œž
œžœž
œ
ž
œžœž
œž
œžœžœžœžœžœ)žœ!žœ
žœžœqžœžœžœžœ
žœ	žœ7žœžœžœžœ-žœžœžœ*Ÿ	œž	œžœ
žœžœ
žœ
žœžœ
žœžœŸ
œž	œžœ
žœžœ
žœ
žœžœžœŸœž	œžœžœ
žœžœ
žœ
žœžœ
žœŸœž	œžœžœ
žœžœ
žœ
žœžœžœŸœž	œžœ	žœžœžœ—
žœžœžœŸ
œž	œžœ
žœžœ
žœ žœ$žœ
žœ
žœžœ/žœžœž
œ
žœžœ
žœœ8žœŸœž	œžœAž
œ<žœžœžœŸœžœ
ž	œ
žœžœ
žœžœžœ
žœ
žœ!žœ
žœžœ
žœžœžœžœŸœžœ
ž	œŸ	œž	œžœžœžœ
žœ6žœžœ	žœžœžœžœžœfžœXžœžœ
žœžœ
žœ"žœ
žœž
œž
œ
ž
œž
œžœžœ
žœž
œž
œ
ž
œž
œžœžœžœ
žœžœžœžœŸ
Ļi8Ÿœžœ
ž	œ/žœ
žœžœžœ	žœ.žœžœžœžœfžœXžœžœ
žœžœ
žœ"žœ+žœ=žœžœžœŸœž	œžœžœ
žœžœ
žœžœ
žœžœžœ
žœ
žœ
žœžœŸœžœ
ž	œžœ
žœž
œžœž
œžœž
œž
œžœž
œžœœžœ žœž
œž
œ0œžœž
œž
œžœžœž
œž
œžœ
žœž
œž
œžœ
žœžœžœAžœ
žœ
žœžœ
žœ
œ
ž
œžœž
œ	žœž
œž
œž
œž
œžœ
žœžœžœžœžœ
žœžœ/œ:žœž
œž
œžœž
œž
œž
œž
œ	žœ
žœ
ž
œžœ
ž
œžœ
žœž
œž
œ
ž
œž
œ
žœžœœžœŸœžœ
ž	œžœžœžœ
žœžœ2œ
žœžœŸœžœžœ=žœ
žœ
žœžœžœžœžœžœžœžœžœ
žœžœžœ
žœžœžœ
žœžœ1žœ žœ$ž
œ9žœžœ'žœžœęœžœžœ
žœ
žœ
žœžœ
žœ
žœ+žœFžœžœžœ	žœžœ	"œ	žœ
ž
œ
žœ
žœ
žœž
œžœžœœžœœ
Ÿœžœ
ž	œžœžœ
žœžœ$žœ
žœ
žœžœ
žœ	žœ
œžœ
žœ
žœ'žœžœ>œ%žœ
žœ
žœ
žœ
žœ#$žœ
(œ
žœ
žœ
žœžœžœ
žœ
œ@œ$žœ
%œžœ
žœžœ&œžœžœ
žœžœžœ
žœžœžœ
žœLžœžœ
žœXžœžœžœ
žœ-žœžœžœžœ
žœ
žœœ
4œžœ#žœžœ
žœ8žœ#-œ
žœžœžœ
žœžœžœžœžœžœ
žœ:žœœžœžœ
žœžœžœ
žœžœžœžœržœœžœžœžœžœžœ
žœžœ7žœ
žœŸœž	œžœžœ
žœžœ
žœ
žœžœ;žœŸœž	œžœžœ)žœžœžœžœ
žœ(œžœ
žœžœžœ
žœ%žœžœEœ
žœžœ
žœ)žœžœžœžœ
žœLžœžœžœ
žœžœ
žœCžœžœžœžœžœ
žœžœ
žœ(žœžœ
žœžœžœ
žœ+žœ
žœCžœœ9žœžœ
žœžœž
œžœžœžœžœžœžœžœKžœžœžœž
œžœ/žœžœ
žœžœžœžœ
žœ
žœœ
žœžœ
žœ`žœ"œ
žœžœžœžœžœœ
žœ
žœ
žœžœ
žœ
žœžœžœžœžœŸ	œž	œžœ
žœ
žœ
žœžœ
žœFžœRžœ
žœ
žœžœ
žœ
žœ
žœžœ,Ÿœž	œžœ
žœ
žœ	žœžœ
žœ
žœžœžœžœ
žœ
žœžœžœœ
žœ%žœžœ
žœžœžœ
žœžœ:œ
žœžœžœ
žœœžœžœ
žœ:žœžœ$žœ#žœžœ
žœ
7œ
žœžœ
žœ
žœ!žœ#-œžœžœ
žœ
žœžœžœ
žœ$œ9œžœžœžœžœ)œ-œžœžœ žœ
žœ
žœœžœ(œžœžœ
žœ
4œžœ
žœ
žœažœ,œžœžœ
žœ$œ9œžœžœžœžœœwžœžœ'œ(žœžœžœ
žœRœ
žœžœ
žœ
žœ=žœ
œ
žœ
žœ"œLžœœ6žœžœžœžœŸœž	œ4žœ
žœ
žœ
žœžœ
žœžœ
žœ
žœžœžœ
žœžœž
œž
œžœ
žœ
œž
œ ž
œžœ
žœ
žœž
œž
œžœžœžœŸœž	œžœ	žœ
žœ#žœžœžœžœŸœž	œžœžœžœ
ž
œžœžœ*žœžœ
žœ	žœžœ
žœžœ
žœ
žœžœ7žœ
ž
œž
œžœ
žœ	žœžœžœžœ3žœ
žœ
žœ
žœIœž
œ"žœ	žœŸ	œž	œžœžœ$Ÿœž	œžœžœžœžœ
žœ
žœ žœ	žœ@Ÿœž	œžœ
žœ
žœžœ
žœ
žœ
žœžœžœ
žœ
žœžœžœ	žœ
žœ
žœ	žœžœžœžœ
žœžœ/žœ7žœ.žœ
žœ9žœ
žœžœqžœžœ
žœ.žœžœžœžœžœŸœž	œžœ
žœ
žœ	žœžœ
žœ4žœžœ	žœ
žœžœ5žœž
œžœžœ?žœ&žœžœžœžœž
œž
œžœ
žœ œ
žœž
œžœ
žœžœœžœž
œžœž
œžœž
œžœž
œžœ,œ
žœžœžœžœižœ[žœžœ
žœžœ
žœ#žœ
žœž
œž
œ
ž
œž
œžœžœ
žœž
œž
œ
ž
œž
œžœ“
œžœžœžœž
œžœžœž
œ
žœ
žœžœž
œžœ
žœ
žœœžœž
œžœž
œžœž
œžœž
œžœžœžœžœžœžœ
žœžœ3žœŸœžœ
ž	œžœ,žœ
žœ
žœžœžœ
žœžœžœžœœžœžœŸœžœžœžœžœžœ
žœžœžœ
žœžœŸœžœžœžœ
žœ
žœžœžœžœžœžœ!žœ	žœ
žœžœ	žœ
žœ	žœžœžœžœ"žœžœHž
œžœ5žœžœ!žœ%žœ
žœžœ
žœžœ!žœžœEž
œžœ4žœžœ žœ#žœžœžœžœ
žœ"žœ7žœžœŸ
œžœ
ž	œŸœž	œ
žœ
žœžœžœ
žœžœ	žœž
œž
œ>žœžœ
žœ
žœž
œžœžœžœ
žœ(žœžœžœ
žœ<žœžœ
žœžœžœžœž
œžœžœžœ
žœ(žœžœžœ
žœ<žœžœ
žœžœžœžœžœŸ
 ,Ÿ
œžœ
ž	œ.žœ
žœžœ	žœ3ž
œ"ž
œ>žœžœ
žœ
žœžœžœžœžœ
žœ(žœžœžœ
žœyžœžœžœžœžœžœžœ
žœ(žœžœžœ
žœyžœžœžœžœŸœžœ	žœ
žœ
žœ]žœ
˜ĖČ
—…—dNwM