-- ClipperImpl.mesa
-- Last changed by Doug Wyatt, September 19, 1980 2:58 PM

DIRECTORY
Clipper,
Area USING [Handle, Free],
Patch USING [Handle, New, NewPipe, Free],
Pipe USING [Handle, Procs, Object, Sink, Put, Ref, Free],
Memory USING [zone];

ClipperImpl: PROGRAM
IMPORTS Memory,Area,Patch,Pipe
EXPORTS Clipper SHARES Clipper,Pipe = {
OPEN Clipper;

ClipperError: PUBLIC SIGNAL = CODE;

zone: UNCOUNTED ZONE = Memory.zone;

-- Concrete form of the data
Data: PUBLIC TYPE = RECORD [
plist: NodeRef, -- list of all patches
ppipe: Pipe.Handle, -- pipe into first patch
ipipe,opipe: Pipe.Handle, -- current in,out pipes
ip,op: Pipe.Handle, -- pipes which direct output to ipipe,opipe
inuse: BOOLEAN, -- TRUE if clipper has a pipe outstanding
state: State, -- current clipper state
level,dlevel: CARDINAL -- stack depth
];
DataRef: TYPE = LONG POINTER TO Data;

Node: TYPE = RECORD [
next: NodeRef,
patch: Patch.Handle,
level: CARDINAL
];
NodeRef: TYPE = LONG POINTER TO Node;

clipProcs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
NewPipe: CNewPipe,
Push: CPush,
Pop: CPop,
Test: CTest,
NewRegion: CNewRegion,
Copy: CCopy,
Free: CFree
]];

iClipProcs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
NewPipe: INewPipe,
Push: IPush,
Pop: IPop,
Test: CTest,
NewRegion: CNewRegion,
Copy: CCopy,
Free: CFree
]];

oClipProcs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
NewPipe: ONewPipe,
Push: IPush,
Pop: IPop,
Test: CTest,
NewRegion: CNewRegion,
Copy: CCopy,
Free: CFree
]];

ipipeProcs: LONG POINTER TO READONLY Pipe.Procs = zone.NEW[Pipe.Procs = [
Put: IPPut, Free: PFree]];
opipeProcs: LONG POINTER TO READONLY Pipe.Procs = zone.NEW[Pipe.Procs = [
Put: OPPut, Free: PFree]];
IPPut: PROC[self: Pipe.Handle, area: Area.Handle] = {
d: DataRef=LOOPHOLE[self.data];
d.state.in←TRUE; Pipe.Put[d.ipipe,area];
};
OPPut: PROC[self: Pipe.Handle, area: Area.Handle] = {
d: DataRef=LOOPHOLE[self.data];
d.state.out←TRUE; Pipe.Put[d.opipe,area];
};
PFree: PROC[self: Pipe.Handle] = {
zone.FREE[@self];
};

NewClipper: PUBLIC PROC RETURNS[Handle] = {
d: DataRef = zone.NEW[Data ← [
plist: NIL, ppipe: NIL, ipipe: NIL, opipe: NIL, ip: NIL, op: NIL,
inuse: FALSE, state: [in: FALSE, out: TRUE],
level: 0, dlevel: 0
]];
d.ip←zone.NEW[Pipe.Object ← [procs: ipipeProcs, data: LOOPHOLE[d]]];
d.op←zone.NEW[Pipe.Object ← [procs: opipeProcs, data: LOOPHOLE[d]]];
RETURN[zone.NEW[Object ← [procs: clipProcs, data: d]]];
};

MakePipe: PROC[d: DataRef] = {
d.ppipe←Pipe.Ref[d.op];
FOR p: NodeRef←d.plist,p.next UNTIL p=NIL DO
d.ppipe←Patch.NewPipe[p.patch,Pipe.Ref[d.ip],d.ppipe];
ENDLOOP;
};

tpipeProcs: LONG POINTER TO READONLY Pipe.Procs = zone.NEW[Pipe.Procs = [
Put: TPPut, Free: TPFree]];
TPPut: PROC[self: Pipe.Handle, area: Area.Handle] = {
d: DataRef=LOOPHOLE[self.data];
-- could do some culling here
Pipe.Put[d.ppipe,area];
};
TPFree: PROC[self: Pipe.Handle] = {
d: DataRef=LOOPHOLE[self.data];
Pipe.Free[@d.ipipe]; Pipe.Free[@d.opipe];
zone.FREE[@self]; d.inuse←FALSE;
};

CNewPipe: PROC[self: Handle, ipipe,opipe: Pipe.Handle]
RETURNS[Pipe.Handle] = {
d: DataRef=self.data;
IF d.inuse THEN ERROR ClipperError;
d.ipipe←ipipe; d.opipe←opipe; d.inuse←TRUE;
RETURN[zone.NEW[Pipe.Object ← [procs: tpipeProcs, data: LOOPHOLE[d]]]];
};

INewPipe: PROC[self: Handle, ipipe,opipe: Pipe.Handle]
RETURNS[Pipe.Handle] = {
Pipe.Free[@opipe]; RETURN[ipipe]
};

ONewPipe: PROC[self: Handle, ipipe,opipe: Pipe.Handle]
RETURNS[Pipe.Handle] = {
Pipe.Free[@ipipe]; RETURN[opipe]
};

CPush: PROC[self: Handle, area: Area.Handle] = {
d: DataRef=self.data;
oldlevel: CARDINAL=d.level;
newlevel: CARDINAL=oldlevel+1;
pipe: Pipe.Handle←CNewPipe[self,Pipe.Sink[],Pipe.Sink[]];
d.state←[FALSE,FALSE]; Pipe.Put[d.ppipe,area]; Pipe.Free[@pipe];
IF d.state=[TRUE,TRUE] THEN d.level←newlevel
ELSE {
self.procs←(IF d.state.in THEN iClipProcs ELSE oClipProcs);
d.dlevel←newlevel;
};
};

CPop: PROC[self: Handle] = {
d: DataRef=self.data;
oldlevel: CARDINAL=d.level;
IF oldlevel>0 THEN d.level←oldlevel-1;
};

IPush: PROC[self: Handle, area: Area.Handle] = {
d: DataRef=self.data;
Area.Free[@area];
d.dlevel←d.dlevel+1;
};

IPop: PROC[self: Handle] = {
d: DataRef=self.data;
oldlevel: CARDINAL=d.dlevel;
IF oldlevel>0 THEN {
newlevel: CARDINAL=oldlevel-1;
IF newlevel=d.level THEN {
d.state←[TRUE,TRUE]; self.procs←clipProcs; d.dlevel←0;
}
ELSE d.dlevel←newlevel;
};
};

CTest: PROC[self: Handle] RETURNS[State] = {
d: DataRef=self.data; RETURN[d.state]
};

regionProcs: LONG POINTER TO READONLY Pipe.Procs = zone.NEW[Pipe.Procs = [
Put: RPut, Free: RFree]];

CNewRegion: PROC[self: Handle] RETURNS[Pipe.Handle] = {
d: DataRef=self.data;
FreeList[d];
d.state←[in: FALSE, out: TRUE]; d.level←0;
self.procs←oClipProcs;
RETURN[zone.NEW[Pipe.Object ← [procs: regionProcs, data: LOOPHOLE[self]]]];
};

RPut: PROC[self: Pipe.Handle, area: Area.Handle] = {
clipper: Handle=LOOPHOLE[self.data];
d: DataRef=clipper.data;
p: NodeRef=zone.NEW[Node ← [
next: NIL, patch: Patch.New[area], level: 0
]];
p.next←d.plist; d.plist←p;
};

RFree: PROC[self: Pipe.Handle] = {
clipper: Handle=LOOPHOLE[self.data];
d: DataRef=clipper.data;
IF d.plist#NIL THEN {
MakePipe[d]; d.state←[TRUE,TRUE]; clipper.procs←clipProcs;
};
zone.FREE[@self];
};

CCopy: PROC[self: Handle] RETURNS[Handle] = {
d: DataRef=self.data;
RETURN[NIL]; -- *** fix this
};

FreeList: PROC[d: DataRef] = {
IF d.plist#NIL THEN {
list: NodeRef←d.plist;
d.plist←NIL; Pipe.Free[@d.ppipe];
UNTIL list=NIL DO
p: NodeRef←list; list←p.next;
Patch.Free[@p.patch]; zone.FREE[@p];
ENDLOOP;
};
};

CFree: PROC[self: Handle] = {
d: DataRef←self.data;
IF d.inuse THEN ERROR ClipperError;
FreeList[d];
Pipe.Free[@d.ip]; Pipe.Free[@d.op];
zone.FREE[@d]; zone.FREE[@self];
};

}.