-- 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.