-- File EntityEditorImpl.mesa
-- Created by Donahue, October 18, 1982 5:10 pm
-- Last edited by:
-- Donahue July 14, 1983 1:37 pm
-- Cattell July 27, 1983 7:32 pm

DIRECTORY
Cursors: TYPE USING[ CursorType ],
DB,
DBNames,
EntityEditor,
Icons: TYPE USING[ IconFlavor, DrawIcon ],
Nut: TYPE USING[ Display ],
Rope: TYPE USING[ ROPE ],
TIPUser: TYPE USING[ TIPTable, InstantiateNewTIPTable ],
ViewerClasses: TYPE USING[ Viewer, PaintProc, NotifyProc,
        ViewerClassRec, ViewerRec, ViewerClass ],
ViewerOps: TYPE USING[ AddProp, FetchProp, CreateViewer,
        RegisterViewerClass, FetchViewerClass ],
NutViewer,
NutOps USING[ IsSystemDomain, IsSystemRelation ],
VTables: TYPE USING[ VTable, Create, GetTableEntry, SetRowsAndColumns, NullBorder,
       SetTableEntry, Install, SwapTableEntries, GetRowsAndColumns ];

EntityEditorImpl: PROGRAM
IMPORTS DB, Icons, TIPUser, ViewerOps, VTables, NutViewer, Nut, NutOps, DBNames
EXPORTS EntityEditor =

BEGIN OPEN DB, Rope, ViewerClasses, VTables;

SaveFailed: PUBLIC ERROR = CODE;

DisplayEntities: PUBLIC PROC[ of: Entity, parent: Viewer, in: DB.Segment,
          noEdits: BOOLEAN ← FALSE ] RETURNS[VTable] =
-- make a nested viewer (a VTable) that has all of the tuples for the "*" relation, using the
-- entity provided as the "of" field
-- if noEdits is true then the table produced cannot be changed
-- the viewer produced is NOT painted
-- the entities are displayed in iconic form (yellow-bugging them "opens" them, blue-bugging
-- deletes them from the display)
{ outerTable: VTable;
table: VTable;
nextRow: INT ← 0;
nextCol: INT ← 0;
starRel: Relation = IF in = NIL THEN NIL ELSE DeclareRelation["related-entity", in, OldOnly];
starOfAttr: Attribute =
   IF in = NIL OR starRel = NIL THEN NIL
   ELSE DeclareAttribute[ r: starRel, name: "of", type: RopeType, version: OldOnly ];
starIsAttr: Attribute =
   IF in = NIL OR starRel = NIL THEN NIL
   ELSE DeclareAttribute[ r: starRel, name: "is", type: RopeType, version: OldOnly ];
entitySet: RelshipSet =
 IF of = NIL OR starRel = NIL THEN NIL
 ELSE RelationSubset[starRel,LIST[AttributeValue[starOfAttr, DBNames.EntityToName[of]]]];
nextRel: Relship ← IF entitySet = NIL THEN NIL ELSE NextRelship[entitySet];
IF nextRel = NIL AND noEdits THEN
{ IF entitySet # NIL THEN ReleaseRelshipSet[entitySet]; RETURN[NIL] };
outerTable ← Create[ rows: 2, parent: parent ];
ViewerOps.AddProp[ outerTable, $of, of ];
ViewerOps.AddProp[ outerTable, $segment, in ];
SetTableEntry[ table: outerTable, row: 0, name: "Related Entities:", border: NullBorder ];
table ← Create[ rows: 1, columns: 6, parent: outerTable ];
SetTableEntry[ table: outerTable, row: 1, flavor: $Viewer,
     clientData: table, border: NullBorder, xoff: 5 ];
UNTIL nextRel = NIL DO
nextEntity: Entity = DBNames.NameToEntity[V2S[GetF[nextRel, starIsAttr]]];
IF nextEntity = NIL THEN { nextRel ← NextRelship[entitySet]; LOOP };
AddEntity[ nextEntity, in, table, nextRow, nextCol ];
nextCol ← nextCol+1 MOD 6;
IF nextCol = 0 THEN
{ nextRow ← nextRow+1;
SetRowsAndColumns[ table: table, rows: nextRow+1, columns: 6 ] };
nextRel ← NextRelship[entitySet]
ENDLOOP;
Install[ table, FALSE ];
ViewerOps.AddProp[ table, $nextRow, NEW[INT ← nextRow] ];
ViewerOps.AddProp[ table, $nextCol, NEW[INT ← nextCol] ];
ViewerOps.AddProp[ table, $edits, NEW[ BOOLEAN ← NOT noEdits ] ];
ReleaseRelshipSet[entitySet];
Install[ outerTable, FALSE ];
RETURN[ outerTable ] };

NewEntry: PUBLIC PROC[ is: Entity, table: VTable ] = {
innerTable: VTable = GetTableEntry[ table, 1 ];
segment: DB.Segment = NARROW[ ViewerOps.FetchProp[ table, $segment ] ];
nextRow: REF INT ← NARROW[ ViewerOps.FetchProp[ innerTable, $nextRow ], REF INT ];
nextCol: REF INT ← NARROW[ ViewerOps.FetchProp[ innerTable, $nextCol ], REF INT ];
FOR i: INT IN [0..nextRow^] DO
FOR j: INT IN [0..IF i < nextRow^ THEN 6 ELSE nextCol^) DO
eInVName: ROPE =
    NARROW[ ViewerOps.FetchProp[GetTableEntry[table, i, j], $name], ROPE];
eInV: Entity = IF eInVName = NIL THEN NIL ELSE DBNames.NameToEntity[eInVName];
IF DB.Eq[eInV, is] THEN RETURN
ENDLOOP
ENDLOOP;
AddEntity[ is, segment, innerTable, nextRow^, nextCol^ ];
nextCol^ ← (nextCol^+1) MOD 6;
IF nextCol^ = 0 THEN
{ nextRow^ ← (nextRow^ + 1);
SetRowsAndColumns[ table: innerTable, rows: nextRow^ + 1, columns: 6 ] };
Install[ innerTable, FALSE ];
Install[ table, FALSE ] };

AddEntity: PROC[ e: Entity, seg: DB.Segment, table: VTable, nextRow: INT, nextCol: INT ] = {
icon: Icons.IconFlavor = NutViewer.GetIcon[ e ];
newV: Viewer =
 ViewerOps.CreateViewer[ flavor: $IconEntity,
         info: ViewerClasses.ViewerRec[ ww: 70, wh:64,
               name: IF e = NIL THEN NIL ELSE GetName[e],
               parent: table, icon: icon, border: FALSE ],
         paint: FALSE ];
ViewerOps.AddProp[newV, $name,
       IF e = NIL THEN NIL ELSE DBNames.EntityToName[e, seg]];
SetTableEntry[ table: table, row: nextRow, column: nextCol,
     flavor: $Viewer, clientData: newV, border: NullBorder ] };

-- given a table set up by DisplayEntities, add all of its contents to the database
-- if a newOf is provided, then it will be used to create new relationships with all of the
-- entities that are displayed in the table; otherwise all of the existing relationships for the
-- entity provided when the table was created will be updated

SaveEntities: PUBLIC PROC[ viewer: Viewer, newOf: Entity ← NIL ] = {
table: VTable = GetTableEntry[ viewer, 1 ];
nextRow: INT = NARROW[ ViewerOps.FetchProp[ table, $nextRow ], REF INT ]^;
nextCol: INT = NARROW[ ViewerOps.FetchProp[ table, $nextCol ], REF INT ]^;
seg: Segment = NARROW[ ViewerOps.FetchProp[ table.parent, $segment ]];
starRel: Relation = DeclareRelation["related-entity", seg, NewOrOld];
starOfAttr: Attribute = DeclareAttribute[ starRel, "of", RopeType ];
starIsAttr: Attribute = DeclareAttribute[ starRel, "is", RopeType ];
oldOf: Entity = V2E[ ViewerOps.FetchProp[ viewer, $of ] ];
of: Entity = IF newOf = NIL THEN oldOf ELSE newOf;
ofName: ROPE = DBNames.EntityToName[ of ];
-- first destroy all of the old relationships for the entity
oldSet: RelshipSet =
 IF of = NIL THEN ERROR SaveFailed ELSE
RelationSubset[starRel,LIST[AttributeValue[starOfAttr, ofName]]];
FOR next: Relship ← NextRelship[oldSet], NextRelship[oldSet] UNTIL next = NIL DO
  DestroyRelship[next];
ENDLOOP;
ReleaseRelshipSet[oldSet];
-- now just add the new relships
FOR i: INT IN [0..nextRow] DO
FOR j: INT IN [0 .. IF i < nextRow THEN 6 ELSE nextCol) DO
nextViewer: Viewer = GetTableEntry[ table, i, j ];
IF nextViewer # NIL THEN
{ entityName: ROPE = NARROW[ ViewerOps.FetchProp[ nextViewer, $name ], ROPE ];
IF entityName # NIL THEN
[] ← DeclareRelship[starRel, LIST[ AttributeValue[starOfAttr, ofName],
          AttributeValue[starIsAttr, entityName]]] }
ENDLOOP
ENDLOOP };

MyPaint: ViewerClasses.PaintProc = TRUSTED {
icon: Icons.IconFlavor = self.icon;
Icons.DrawIcon[ flavor: icon, context: context, label: self.name ] };

MyNotify: ViewerClasses.NotifyProc = TRUSTED {
FOR list: LIST OF REF ANY ← input, list.rest UNTIL list = NIL DO
WITH list.first SELECT FROM
z: ATOM => InterpAtom[self, z];
ENDCASE;
ENDLOOP };

InterpAtom: PROC[ self: Viewer, atom: ATOM ] = {
SELECT atom FROM
$Open =>
{ name: ROPE = NARROW[ViewerOps.FetchProp[self, $name], ROPE ];
e: Entity = DBNames.NameToEntity[name];
IF e # NIL THEN
[] ← Nut.Display[e: e, parent: SpawnParent[self], seg: DBNames.SegmentOf[name] ] };
$Remove =>
{ name: ROPE = NARROW[ViewerOps.FetchProp[self, $name], ROPE ];
   e: Entity = DBNames.NameToEntity[name];
IF e # NIL AND NOT NutOps.IsSystemDomain[e] AND NOT NutOps.IsSystemRelation[e]
THEN DeleteEntity[ e, self.parent ] };
ENDCASE };

SpawnParent: PROC[ v: Viewer ] RETURNS [ parent: Viewer ] = {
parent ← v;
WHILE parent.parent # NIL DO parent ← parent.parent ENDLOOP };

DeleteEntity: PROC[ e: Entity, table: VTable ] = {
nextRow: REF INT ← NARROW[ ViewerOps.FetchProp[ table, $nextRow ], REF INT ];
nextCol: REF INT ← NARROW[ ViewerOps.FetchProp[ table, $nextCol ], REF INT ];
edits: REF BOOLEAN = NARROW[ ViewerOps.FetchProp[ table, $edits ], REF BOOLEAN ];
IF NOT edits^ THEN RETURN;
FOR i: INT IN [0..nextRow^] DO
FOR j: INT IN [0..IF i < nextRow^ THEN 6 ELSE nextCol^) DO
eInVName: ROPE =
    NARROW[ ViewerOps.FetchProp[GetTableEntry[table, i, j], $name], ROPE];
eInV: Entity = IF eInVName = NIL THEN NIL ELSE DBNames.NameToEntity[eInVName];
IF DB.Eq[eInV, e] THEN
{ ShiftTable[ table, i, j ];
IF nextCol^ = 0 THEN { nextCol^ ← 6; nextRow^ ← nextRow^ - 1 }
ELSE nextCol^ ← nextCol^ - 1;
RETURN }
ENDLOOP
ENDLOOP};

ShiftTable: PROC[ table: VTable, i: INT, j: INT ] = {
rows: INT = GetRowsAndColumns[ table ].rows;
nextI, nextJ: INT;
nextJ ← (j+1) MOD 6; nextI ← IF nextJ=0 THEN i+1 ELSE i;
SetTableEntry[ table: table, row: i, column: j, h: 64, w: 67, border: NullBorder ];
WHILE nextI < rows DO
SwapTableEntries[ table: table, row1: i, column1: j, row2: nextI, column2: nextJ ];
j ← (j+1) MOD 6; IF j = 0 THEN i ← i + 1;
nextJ ← (j+1) MOD 6; nextI ← IF nextJ=0 THEN i+1 ELSE i
ENDLOOP;
Install[ table, FALSE ];
Install[ table.parent, TRUE ] };


Init: PROC[]= {
tipTableName: ROPE = "/Indigo/Squirrel/Release/Hickory.tip";
tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable[tipTableName];
iconClass: ViewerClasses.ViewerClass ← NEW[ ViewerClasses.ViewerClassRec ← [] ];
iconClass^ ← ViewerOps.FetchViewerClass[$Button]^;
iconClass.flavor ← $IconEntity;
iconClass.notify ← MyNotify;
iconClass.tipTable ← tipTable;
iconClass.paint ← MyPaint;
iconClass.cursor ← Cursors.CursorType[crossHairsCircle];
ViewerOps.RegisterViewerClass[ flavor: $IconEntity, class: iconClass ] };

Init[];

END.