-- 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];
	};

}.(670)