-- File EntityEditorImpl.mesa
-- Created by Donahue, October 18, 1982 5:10 pm
-- Last edited by:
 -- Donahue April 11, 1983 9:12 am
 -- Cattell April 6, 1983 12:05 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["*", in];
    starOfAttr: Attribute =
    			IF in = NIL THEN NIL ELSE DeclareAttribute[ starRel, "of", StringType ];
    starIsAttr: Attribute =
    			IF in = NIL THEN NIL ELSE DeclareAttribute[ starRel, "is", StringType ];
    entitySet: RelshipSet = 
    	IF of = 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, $starRel, starRel ];
    ViewerOps.AddProp[ outerTable, $starOfAttr, starOfAttr ];
    ViewerOps.AddProp[ outerTable, $starIsAttr, starIsAttr ];
    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 ]^;
    starRel: Relation = V2E[ ViewerOps.FetchProp[ viewer, $starRel ] ];
    starOfAttr: Attribute = V2E[ ViewerOps.FetchProp[ viewer, $starOfAttr ] ];
    starIsAttr: Attribute = V2E[ ViewerOps.FetchProp[ viewer, $starIsAttr ] ];
    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[]= {
    tipTable: TIPUser.TIPTable = TIPUser.InstantiateNewTIPTable["Hickory.tip"];
    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.
Ęj˜JšœĪc§
œ
Īk	œžœ
žœžœ&žœ
žœ!žœ
žœžœ
žœžœžœ
žœ7žœ
žœbžœ
žœŖ
žœ
žœœ
žœžœ
žœHžœžœžœ
žœ1žœ
žœžœ	Īnœžœ
žœ"žœ!žœžœžœōœ8žœžœžœžœ
žœ
žœ
žœ>žœžœ
žœ
žœ
žœSžœžœ
žœ
žœ
žœRžœžœ
žœ
žœžœžœPžœ
žœ
žœ
žœ
žœžœžœ
žœ	žœžœ
žœ
žœžœ
žœížœžœ
žœZžœžœ
žœ%žœ\žœžœ
žœž
žœžœ,žœ
žœ7žœ
žœ5žœžœžœJžœžœŸœžœ
žœežœžœ:žœ
žœžœ/žœ
žœžœ
žœžœ/žœ
žœ	žœžœ
žœžœžœžœ
žœžœžœžœžœžœžœ:žœžœžœ
žœ
žœ
žœ*žœ
žœžœ
žœ
žœžœ^žœ	žœžœ“
žœžœŸ	œžœžœ"žœžœŨ
žœžœ
žœ
žœ
žœFžœžœ5žœžœ
žœ
žœ
žœĒ
TœĪeō
œŸœžœ
žœ"žœDžœžœ*žœ
žœžœžœ*žœ
žœģžœ	žœ
žœžœžœ#=œžœžœ
žœ
žœžœžœ+žœ:žœžœ
žœ!žœ&"œžœžœ
žœžœžœžœ
žœžœ
žœžœ
žœBžœžœ
žœžœžœ,žœžœžœ
žœ)žœmžœžœ,žœ
žœžœžœ
žœ
žœ
žœžœžœ
žœžœžœ
žœžœ žœžœ	Ÿ
œžœžœ
žœžœžœžœ#žœ<žœžœ
žœ}žœžœ#žœ8žœžœ
žœ
žœžœ
žœ(žœ(žœŸœžœžœ,žœžœ
žœžœŸœžœ.žœ
žœžœ*žœ
žœžœ
žœžœ*žœ
žœžœ
žœžœ(žœ
žœ	žœ
žœžœ
žœžœžœ
žœžœžœžœ
žœžœžœžœžœžœžœ:žœžœžœ
žœ
žœ
žœ*žœ
žœ
žœ6žœžœ8žœ'žœžœžœ
Ÿ
œžœžœžœžœ6žœžœžœ	žœžœ`žœžœkžœžœžœ žœžœ	žœžœ	žœžœžœŸœžœ
žœˆžœ
˜ļR—…—)8.¨