--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 𡤌Zone.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 𡤀
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 𡤌Zone.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 𡤏irstChain;
  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.