-- Compiler ObjectOps/n;bind griffin;griffin
-- mstone November 10, 1980  5:29 PM

DIRECTORY
	GriffinDefs: FROM "GriffinDefs",
	GriffinStartDefs: FROM "GriffinStartDefs",
	StringDefs: FROM "StringDefs",
	MenuDefs: FROM "MenuDefs",
	ObjectDefs: FROM "ObjectDefs",
	RealFns: FROM "RealFns",
	StyleDefs: FROM "StyleDefs",
	PointDefs: FROM "PointDefs",
	OpDefs: FROM "OpDefs",
	XFormDefs: FROM "XFormDefs",
	GriffinMemoryDefs: FROM "GriffinMemoryDefs",
	RefreshDefs: FROM "RefreshDefs",
	ScreenDefs: FROM "ScreenDefs" USING [ClipPointToScreen],
	RelationDefs: FROM "RelationDefs";

ObjectOps: PROGRAM
	IMPORTS GriffinDefs, MenuDefs, ObjectDefs, StringDefs, GriffinMemoryDefs, RealFns, XFormDefs, PointDefs, RefreshDefs, RelationDefs, ScreenDefs
	EXPORTS GriffinDefs, GriffinStartDefs,OpDefs = 
BEGIN OPEN ObjectDefs,PointDefs,GriffinMemoryDefs,RefreshDefs;
xftype: {map,scale,scalex,scaley,rotate};
oltype: {top,bottom,up1,down1};
TL,BR: ScrPt;

OverallMBB: PROCEDURE[obj:  ObjectHandle]=
BEGIN
IF obj.tl[X]<TL[X] THEN TL[X] _ obj.tl[X];
IF obj.tl[Y]<TL[Y] THEN TL[Y] _ obj.tl[Y];
IF obj.br[X] >BR[X] THEN BR[X] _ obj.br[X];
IF obj.br[Y] >BR[Y] THEN BR[Y] _ obj.br[Y];
END;

AnySelected: PROCEDURE RETURNS[BOOLEAN] =
BEGIN
anyselected: BOOLEAN _ FALSE;
IsSelected: PROCEDURE[obj:  ObjectHandle]=BEGIN
	anyselected _ TRUE;
	END;
ForAllSelectedDo[IsSelected];
RETURN[anyselected];
END;


Delete: MenuDefs.MenuProc =
BEGIN
DeleteObjs: PROCEDURE[obj:  ObjectHandle]=BEGIN
	DeSelectObject[obj];
	EraseAndSave[obj];
	obj.deleted _ TRUE;
	END;
IF AnySelected[] THEN BEGIN 
	ExpungeObjects[];
	ForAllSelectedDo[DeleteObjs];
	RestoreScreen[];
	END;
END;

Undo: MenuDefs.MenuProc =
BEGIN
Undelete: ObjectProc = BEGIN
	IF ~obj.deleted THEN RETURN;
	obj.deleted _ FALSE;
	IF obj.cluster # 0 THEN [] _ SelectCluster[obj.cluster]
		ELSE [] _ SelectObject[obj];
	MarkBox[obj.tl,obj.br,obj];
	END;
ForAllObjects[Undelete];
RestoreScreen[];
END;

Transfer: MenuDefs.MenuProc =
BEGIN
view: View _  IF objectMenu.view=main THEN alternate ELSE main;
token: ObjectHandle _ NIL;
TransferObjs: PROCEDURE[obj:  ObjectHandle]=BEGIN
	EraseAndSave[obj];
	IF (token _ ReturnSelected[obj]) # NIL
		THEN BEGIN
			EraseAndSave[token];
			token.view _ view;
			END;
	obj.view _ view;
	END;
IF ~AnySelected[] THEN GriffinDefs.UserMessage["Please make a selection"];
ForAllSelectedDo[TransferObjs];
RestoreScreen[];
END;

SelObj: TYPE = RECORD[up,down: POINTER TO SelObj, item: ObjectHandle];

ChangeOverlap: MenuDefs.MenuProc =
BEGIN OPEN StringDefs;
string: STRING _ MenuDefs.MenuString[item];
topObj,bottomObj: POINTER TO SelObj _ NIL;
ptr,next: POINTER TO SelObj _ NIL;

ListSelected: PROCEDURE[obj:  ObjectHandle]=BEGIN
	selObj: POINTER TO SelObj _Allocate[SIZE[SelObj]];
	selObj^ _ [up: NIL,down: topObj,item: obj];
	IF bottomObj=NIL THEN bottomObj _ topObj _ selObj
	ELSE BEGIN topObj.up _ selObj; topObj _ selObj; END;
	END;
Up: PROCEDURE=BEGIN
	selObj: POINTER TO SelObj _topObj;
	FOR selObj _ topObj, selObj.down UNTIL selObj=NIL DO
		FlipUpObject[selObj.item];
		ENDLOOP;
	END;
Down: PROCEDURE=BEGIN
	selObj: POINTER TO SelObj ;
	FOR selObj _ bottomObj, selObj.up UNTIL selObj=NIL DO
		FlipDownObject[selObj.item];
		ENDLOOP;
	END;
Bottom: PROCEDURE=BEGIN
	selObj: POINTER TO SelObj _topObj;
	FOR selObj _ topObj, selObj.down UNTIL selObj=NIL DO
		SinkObject[selObj.item];
		ENDLOOP;
	END;
Top: PROCEDURE=BEGIN
	selObj: POINTER TO SelObj ;
	FOR selObj _ bottomObj, selObj.up UNTIL selObj=NIL DO
		FloatObject[selObj.item];
		ENDLOOP;
	END;
--make a list of all items affected.  Work in different order for different cases
IF ~AnySelected[] THEN GriffinDefs.UserMessage["Please make a selection"];
ForAllSelectedDo[ListSelected];
IF bottomObj=NIL THEN RETURN;	--none found
oltype _ SELECT TRUE FROM
	EquivalentStrings[string,"Top"] => top,
	EquivalentStrings[string,"Bottom"] => bottom,
	EquivalentStrings[string,"Up One"] => up1,
	EquivalentStrings[string,"Down One"] => down1,
	ENDCASE => ERROR;
SELECT oltype FROM
	top => Top[];
	bottom => Bottom[];
	up1 => Up[];
	down1 =>  Down[];
	ENDCASE; 

ForAllSelectedDo[ PlotAndMark];
RestoreScreen;
ptr _ bottomObj;
UNTIL ptr=NIL DO
	next _ptr.up;
	Free[ptr];
	ptr _ next;
	ENDLOOP;
END;

XForm: MenuDefs.MenuProc =
BEGIN OPEN StringDefs;
	ENABLE XFormDefs.ProblemWithXForms => BEGIN
		IF EquivalentString[string,"Singular transform"] THEN
		   SIGNAL GriffinDefs.UserMessage["Transform will flatten picture"]
		ELSE SIGNAL GriffinDefs.UserMessage["ProblemWith Transform"];
		END;

string: STRING _ MenuDefs.MenuString[item];
cps: DESCRIPTOR FOR ARRAY OF  ObjPt _ ReadCPs[];
mspace: XFormDefs.XFormMatrix;
matrix: XFormDefs.XFMDescriptor _ DESCRIPTOR[mspace];
clusterRelation: RelationDefs.Relation;
MoveObjs: PROCEDURE[obj:  ObjectHandle]=BEGIN
	MoveObject[obj,ObjToScr[cps[0]],ObjToScr[cps[1]]];
	END;
CopyObjs: PROCEDURE[obj:  ObjectHandle]=BEGIN 
	OPEN RelationDefs;
	newobj: ObjectHandle;
	newcluster: ClusterID;
	IF NOT obj.selected OR NOT Visible[obj] THEN RETURN;
	newobj _ CopyObject[obj];
	IF obj.cluster # 0 THEN
		BEGIN
		IF  Right[clusterRelation,obj.cluster] = notFound
		    THEN BEGIN
			newcluster _ GetNextClusterID[];
			AddPair[clusterRelation, obj.cluster,newcluster];
			END
		ELSE newcluster _ Right[clusterRelation,obj.cluster];
		EraseAndSave[ReturnSelected[obj]];
		newobj.cluster _ newcluster;
		END
	    ELSE BEGIN
		[] _ SelectObject[newobj];
		EraseAndSave[ReturnSelected[obj]];
		DeSelectObject[obj];
		END;	
	END;
SelectNewClusters: PROCEDURE[leftPart, rightPart: UNSPECIFIED] =
	BEGIN 
	-- selects new clusters formed after XForm with copy
	[] _ SelectCluster[rightPart];
	DeSelectCluster[leftPart];
	END;

XFormObjs: PROCEDURE[obj:  ObjectHandle]=BEGIN
	ObjectDefs.XFormObject[obj,matrix];
	END;

IF LENGTH[cps] <=1 THEN BEGIN
	Free[BASE[cps]];
	GriffinDefs.UserMessage["All transforms need at least two points"];
	RETURN;
	END;
IF ~AnySelected[] THEN GriffinDefs.UserMessage["Please make a selection"];

XFormDefs.InitXForms[matrix];
xftype _ SELECT TRUE FROM
	EquivalentStrings[string,"Map"] => map,
	EquivalentStrings[string,"Scale"] => scale,
	EquivalentStrings[string,"ScaleX"] => scalex,
	EquivalentStrings[string,"ScaleY"] => scaley,
	EquivalentStrings[string,"Rotate"] => rotate,
	ENDCASE => ERROR;
SELECT xftype FROM
	map => Map[matrix];
	scale => Scale[matrix,both];
	scalex => Scale[matrix,xonly];
	scaley =>  Scale[matrix,yonly];
	rotate =>  Rotate[matrix];
	ENDCASE; 

EraseAndSaveAllCPs[];
DeleteAllCPs[];
--will use the selection
IF MenuDefs.IsSelected[copy] THEN
	BEGIN
	clusterRelation _ RelationDefs.CreateRelation[];
	ForAllObjectsThroughObject[CopyObjs, GetTopPictureObj[]];
	RelationDefs.ForAllPairs[clusterRelation,SelectNewClusters];
	RelationDefs.DestroyRelation[clusterRelation];
	END
ELSE ForAllSelectedDo[ EraseAndSave];
IF LENGTH[cps]=2  AND xftype=map THEN BEGIN
	ForAllSelectedDo[MoveObjs];
	END
ELSE BEGIN
	ForAllSelectedDo[XFormObjs];
	END;
Free[BASE[cps]];
ForAllSelectedDo[ PlotAndMark];
RestoreScreen[];
END;

Toggle: MenuDefs.MenuProc =
BEGIN OPEN MenuDefs;
IF IsSelected[item] THEN Deselect[item] ELSE Select[item];
END;

Rotate: PROCEDURE[matrix: XFormDefs.XFMDescriptor] = 
BEGIN OPEN XFormDefs;
cps: DESCRIPTOR FOR ARRAY OF  ObjPt _ ReadCPs[];
npts: INTEGER _ LENGTH[cps];
dorig: ObjPt _ cps[0];
negdorig: ObjPt _ [-cps[0][X],-cps[0][Y]];
dx,dy,theta: REAL;
IF npts>3 THEN GriffinDefs.UserMessage["Only 2 and 3 point rotate is valid"];
dx _ cps[1][X]-cps[0][X];
dy _ cps[1][Y]-cps[0][Y];
theta _ RealFns.ArcTan[dy,dx];
IF npts>=3 THEN BEGIN
	theta1: REAL;
	dx _ cps[2][X]-cps[0][X];
	dy _ cps[2][Y]-cps[0][Y];
	theta1 _ RealFns.ArcTan[dy,dx];
	theta _ theta1-theta;
	END;
Translate[dorig,matrix];
Rotate[theta,z,matrix];
Translate[negdorig,matrix];
END;

--will mirror.  Imagine a pinned point and a new point
Scale: PROCEDURE[matrix: XFormDefs.XFMDescriptor,direction: {both,xonly,yonly}] = 
BEGIN OPEN XFormDefs;
cps: DESCRIPTOR FOR ARRAY OF  ObjPt _ ReadCPs[];
npts: INTEGER _ LENGTH[cps];
sx,sy: REAL;
dorig: ObjPt _ cps[0];
tl,br: ObjPt;
negdorig: ObjPt _ [-cps[0][X],-cps[0][Y]];
dx1,dy1,dx2,dy2: REAL;
IF npts>3 THEN GriffinDefs.UserMessage["Only 2 and 3 point scale is valid"];
--scale max dimension into 2 pt span
IF npts=2 THEN BEGIN
	TL _ [77777B,77777B];	--init for  OverallMBB
	BR _ [0,0];
	ForAllSelectedDo[OverallMBB];
	tl _ ScrToObj[TL];
	br _ ScrToObj[BR];
	dx1 _ br[X]-tl[X];
	dy1 _ tl[Y]-br[Y];	--object space
	dx2 _ ABS[cps[1][X]-cps[0][X]];
	dy2 _ ABS[cps[1][Y]-cps[0][Y]];
	END
-- assume 3 points
ELSE BEGIN
	dx2 _ cps[2][X]-cps[0][X];
	dy2 _ cps[2][Y]-cps[0][Y];
	dx1 _ cps[1][X]-cps[0][X];
	dy1 _ cps[1][Y]-cps[0][Y];
	END;
Translate[dorig,matrix];
SELECT direction FROM
	both => BEGIN
		IF dx1=0 OR dy1=0 THEN GriffinDefs.UserMessage["Transform will flatten picture"];
		sx _ dx2/dx1;
		sy _ dy2/dy1;
		Scale[[sx,sy],matrix];
		END;
	xonly => BEGIN
		IF dx1=0 THEN GriffinDefs.UserMessage["Transform will flatten picture"];
		sx _ dx2/dx1;
		Scale[[sx,1],matrix];
		END;
	yonly => BEGIN
		IF dy1=0 THEN GriffinDefs.UserMessage["Transform will flatten picture"];
		sy _ dy2/dy1;
		Scale[[1,sy],matrix];
		END;
	ENDCASE;
Translate[negdorig,matrix];
END;

Map: PROCEDURE[matrix: XFormDefs.XFMDescriptor] = 
BEGIN OPEN XFormDefs;
cps: DESCRIPTOR FOR ARRAY OF  ObjPt _ ReadCPs[];
npts: INTEGER _ LENGTH[cps];
pts: DESCRIPTOR FOR ARRAY OF  ObjPt;
free: BOOLEAN _ FALSE;
dorig: ObjPt _ cps[0];
negdorig: ObjPt _ [-cps[0][X],-cps[0][Y]];
IF npts>6 THEN GriffinDefs.UserMessage["Maximum of 6 points for map"];
SELECT npts FROM
--0,1 NOP, 2 is a move, which is done above
	=3 => BEGIN
		pts _ DESCRIPTOR[Allocate[4*SIZE[ ObjPt]],4];
		free _ TRUE;
		pts[0] _ cps[0];
		pts[1] _ cps[1];
		pts[2] _ cps[0];
		pts[3] _ cps[2];
		npts _ 4;
		END;
	=4 => pts _ cps;
	=5 => BEGIN
		pts _ DESCRIPTOR[Allocate[6*SIZE[ ObjPt]],6];
		free _ TRUE;
		pts[0] _ cps[0];
		pts[1] _ cps[1];
		pts[2] _ cps[2];
		pts[3] _ cps[0];
		pts[4] _ cps[3];
		pts[5] _ cps[4];
		npts _ 6;
		END;
	=6 => pts _ cps;
	ENDCASE=> pts _ DESCRIPTOR[BASE[cps],6];
Translate[dorig,matrix];
SELECT npts FROM
	=4 => XForm4Pts[pts,matrix];
	>=6 => XForm6Pts[pts,matrix];
	ENDCASE;
Translate[negdorig,matrix];
Free[BASE[cps]];
IF free THEN Free[BASE[pts]];
END;

Cluster: MenuDefs.MenuProc =
BEGIN
id: ClusterID _ GetNextClusterID[];
called: BOOLEAN _ FALSE;
token: ObjectHandle _ NIL;
clu: ObjectProc=BEGIN
	obj.cluster _ id;
	called _ TRUE;
	IF token # NIL
	    THEN token _ DeleteObject[token];
	token _ ReturnSelected[obj];
	EraseAndSave[token];
	END;
IF ~AnySelected[] THEN GriffinDefs.UserMessage["Please make a selection"];
ForAllSelectedDo[clu];
IF called THEN BEGIN
	GriffinDefs.ShowUserMessage["New cluster made"];
	RestoreScreen[];
	END;
END;

UnCluster: MenuDefs.MenuProc =
BEGIN
called: BOOLEAN _ FALSE;
ctoken: ObjectHandle;
clu: ObjectProc=BEGIN
	IF obj.cluster IN [0..OpenCluster] THEN RETURN;
	obj.cluster _ 0;
	called _ TRUE;
	IF (ctoken _ ReturnSelected[obj]) # NIL THEN 
		BEGIN
		EraseAndSave[ctoken];
		RETURN;
		END;
	obj.selected _ FALSE;
	[] _ SelectObject[obj];
	END;
IF ~AnySelected[] THEN GriffinDefs.UserMessage["Please make a selection"];
ForAllSelectedDo[clu];
IF called THEN GriffinDefs.ShowUserMessage["Cluster unmade"];
END;

DeselectAll: MenuDefs.MenuProc =
BEGIN
DS: ObjectProc = BEGIN
	EraseAndSave[ReturnSelected[obj]];
	DeSelectObject[obj];
	END;
ObjectDefs.ForAllSelectedDo[DS];
RestoreScreen[];
END;

SelectAll: MenuDefs.MenuProc =
BEGIN OPEN ObjectDefs;
SelectObjs: ObjectProc=BEGIN
	token: ObjectHandle _ IF obj.cluster = 0 
			THEN SelectObject[obj]
			ELSE SelectCluster[obj.cluster];
	IF token#NIL THEN  PlotAndMark[token];
	END;
ForAllVisibleObjects[SelectObjs];
RestoreScreen[];
END;

--make a translated copy of indicated object or set, given xy,xy
CopyObjects:  PUBLIC PROCEDURE[Down,Up: ScrPt] =
BEGIN OPEN ObjectDefs;
new: ObjectHandle _ GetObjectHandle[Down];
selected: BOOLEAN;
id: ClusterID _ 0;
co: ObjectProc = BEGIN
	IF selected THEN BEGIN
		EraseAndSave[ReturnSelected[obj]];
		IF id = 0 THEN DeSelectObject[obj];
		END;
	obj _ CopyObject[obj] ;
	obj.cluster _ id;
	MoveObject[obj,Down,Up];
	PlotAndMark[obj];
	IF selected AND id = 0 THEN [] _ SelectObject[obj];
		-- clusters are selected below.
	END;
IF new=NIL THEN RETURN;
selected _ new.selected;
IF new.objectType=menu OR new.objectType=token OR new.cluster=OpenCluster
	THEN RETURN;
--click doesn't got thru move/refresh stuff
IF ABS[Down[X]-Up[X]]<1 AND ABS[Down[Y]-Up[Y]]<1 THEN RETURN;
IF new.cluster=0
	THEN co[new] -- not a clustered object
	ELSE BEGIN
		id _ GetNextClusterID[];
		ForAllInCluster[new.cluster,co];
		IF selected THEN BEGIN
			DeSelectCluster[new.cluster];
			[] _ SelectCluster[id];
			END;
		END;
RestoreScreen[];
END;

MoveObjects:  PUBLIC PROCEDURE[Down,Up: ScrPt] =
BEGIN
object: ObjectDefs.ObjectHandle _ ObjectDefs.GetObjectHandle[Down] ;
move: ObjectProc = BEGIN
	EraseAndSave[obj];
	ObjectDefs.MoveObject[obj,Down,Up];
	PlotAndMark[obj];
	END;
IF object=NIL THEN RETURN;
--click doesn't got thru move/refresh stuff
IF ABS[Down[X]-Up[X]]<1 AND ABS[Down[Y]-Up[Y]]<1 THEN RETURN;
IF object.cluster=OpenCluster THEN RETURN;	--unfortuneate
IF object.cluster=0 THEN move[object] ELSE ForAllInCluster[object.cluster,move];
RestoreScreen[];
END;

PlaceControlPoint: PUBLIC PROCEDURE[pt: ScrPt] =
BEGIN
top: ObjectHandle _ GetObjectHandle[pt];
IF top=NIL OR top.objectType#menu
	THEN ObjectDefs.AddToken[ScreenDefs.ClipPointToScreen[pt], CP]
END;

DeleteControlPoint: PUBLIC PROCEDURE[Down,Up: ScrPt] =
BEGIN OPEN ObjectDefs;
DelCP: ObjectProc = BEGIN
	IF obj=NIL THEN RETURN; 
	WITH obj SELECT FROM
	token=>
		IF tokenType = CP THEN BEGIN
			EraseAndSave[obj];
			[]_DeleteObject[obj];
		END;
	ENDCASE;
	END;
IF NOT ForAllInBoxDo[Down, Up, DelCP] THEN
	ForObjectPointedAtDo[Down, Up, DelCP];
RestoreScreen[];
END;

DeselectObjects: PUBLIC PROCEDURE[Down,Up: ScrPt] =
BEGIN
Desel: ObjectProc = BEGIN
	IF obj=NIL OR obj.objectType=token OR obj.objectType=menu THEN RETURN; 
	IF obj.cluster = 0 THEN DS[obj]
		ELSE ForAllInCluster[obj.cluster, DS];
	END;
DS: ObjectProc = BEGIN
	EraseAndSave[ReturnSelected[obj]];
	DeSelectObject[obj];
	END;
IF NOT ForAllPictureObjectsInBoxDo[Down, Up, Desel]
	THEN ForObjectPointedAtDo[Down, Up, Desel];
RestoreScreen[];
END;

SelectObjects: PUBLIC PROCEDURE[Down,Up: ScrPt] =
BEGIN OPEN ObjectDefs,RefreshDefs;
Sel: ObjectProc = BEGIN
	IF obj=NIL OR obj.objectType=token OR obj.objectType=menu OR obj.cluster=OpenCluster
	 THEN RETURN; 
	S[obj];
	END;
S: ObjectProc = BEGIN
	obj _ IF obj.cluster = 0 THEN SelectObject[obj]
		ELSE SelectCluster[obj.cluster];
		--get the token, may return NIL if already selected
		-- if clustered, will select whole cluster
	IF obj#NIL THEN PlotAndMark[obj];
	END;
IF NOT ForAllPictureObjectsInBoxDo[Down, Up, Sel]
	THEN ForObjectPointedAtDo[Down, Up, Sel];
RestoreScreen[];
END;

ForObjectPointedAtDo: PROCEDURE[Down,Up: ScrPt,proc: ObjectProc] =
BEGIN 
upObj,downObj: ObjectHandle;
upObj _ GetObjectHandle[Up];
IF upObj=NIL THEN RETURN;
downObj _ GetObjectHandle[Down];
IF upObj=downObj OR downObj=NIL THEN proc[upObj] ;
END;

objectMenu, xformMenu, overlapMenu: PUBLIC MenuDefs.MenuHandle_NIL;

copy: MenuDefs.MenuItemHandle_NIL;

objectMenu _ MenuDefs.CreateMenu[horizontal, [100,600], NIL];
[]_MenuDefs.AddMenuItem[objectMenu,"Delete",Delete];
[]_MenuDefs.AddMenuItem[objectMenu,"Undo",Undo];
[]_MenuDefs.AddMenuItem[objectMenu,"Select all",SelectAll];
[]_MenuDefs.AddMenuItem[objectMenu,"Deselect all",DeselectAll];
[]_MenuDefs.AddMenuItem[objectMenu,"Cluster",Cluster];
[]_MenuDefs.AddMenuItem[objectMenu,"Uncluster",UnCluster];
[]_MenuDefs.AddMenuItem[objectMenu,"Transfer",Transfer];

xformMenu _ MenuDefs.CreateMenu[vertical, [400,400], NIL];
[]_MenuDefs.AddMenuItem[xformMenu,"Map",XForm];
[]_MenuDefs.AddMenuItem[xformMenu,"Scale",XForm];
[]_MenuDefs.AddMenuItem[xformMenu,"ScaleX",XForm];
[]_MenuDefs.AddMenuItem[xformMenu,"ScaleY",XForm];
[]_MenuDefs.AddMenuItem[xformMenu,"Rotate",XForm];
copy _ MenuDefs.AddMenuItem[xformMenu,"Use Copy",Toggle];

overlapMenu _ MenuDefs.CreateMenu[vertical, [200,250], NIL];
[]_MenuDefs.AddMenuItem[overlapMenu,"Top",ChangeOverlap];
[]_MenuDefs.AddMenuItem[overlapMenu,"Bottom",ChangeOverlap];
[]_MenuDefs.AddMenuItem[overlapMenu,"Up One",ChangeOverlap];
[]_MenuDefs.AddMenuItem[overlapMenu,"Down One",ChangeOverlap];

END.