-- File: VLTest1Impl.mesa
-- Contents: Simple test program for DBView.mesa
-- Created by: Rick Cattell, 12-Aug-81
-- Derived from: TLTest1Impl
-- Last Edited by: Cattell, March 25, 1983 3:47 pm

DIRECTORY
  DB, IO, Rope, ViewerIO;

VLTest1Impl: PROGRAM
  IMPORTS DB, IO, Rope, ViewerIO =

BEGIN OPEN IO, DB;

INT: TYPE = LONG INTEGER;

tty: IO.STREAM;
in: IO.STREAM;

mySeg: DB.Segment = $Test;
Person, Frog, Thing: Domain;
Friend: Relation;
  friendOf, friendIs: Attribute;
Phone: Relation;
  phoneOf, phoneIs: Attribute;
ageProp, heightProp: Attribute;
wsh, harry, mark, nori: --Person-- Entity;
george: --Frog-- Entity;
rock, pebble: --Thing-- Entity;
myName: ROPE _ "Rick Cattell";
myExt: REF INT_ NEW[INT _ 4466];

Initialize: PROC =
  BEGIN
  tty.Put[rope["Defining data dictionary..."], char[CR]];
  -- Declare domains and make Persons and Frogs be subtypes of Things:
  Person_ DeclareDomain["Person", mySeg];
  Thing_ DeclareDomain["Thing", mySeg];
  Frog_ DeclareDomain["Frog", mySeg];
  DeclareSubType[of: Thing, is: Person];
  DeclareSubType[of: Thing, is: Frog];
  -- Declare phone age and height property of Things
  ageProp_ DeclareProperty["Age", Thing, IntType, mySeg];
  heightProp_ DeclareProperty["Height", Thing, RopeType, mySeg];
  -- Declare Friend relation between Persons
  Friend_ DeclareRelation["Friend", mySeg];
   friendOf_ DeclareAttribute[Friend, "of", Person];
   friendIs_ DeclareAttribute[Friend, "is", Person];
  -- Declare Phone relation between Persons and integers
  Phone_ DeclareRelation["Phone", mySeg];
   phoneOf_ DeclareAttribute[Phone, "of", Person];
   phoneIs_ DeclareAttribute[Phone, "is", IntType];
  []_ DeclareIndex[Phone, LIST[phoneIs], NewOrOld];
  END;

InsertData: PROC =
  BEGIN t: Relship; rick: Entity;
  tty.Put[rope["Creating data..."], char[CR]];
  harry_ DeclareEntity[Person, "Harry Q. Bovik"];
  mark_ DeclareEntity[Person, "Mark Brown"];
  rick_ DeclareEntity[Person, myName];
  nori_ DeclareEntity[Person]; ChangeName[nori, "Nori Suzuki"];
  -- Data can be assigned with SetP, SetF, or DeclareRelship's initialization list:
  []_ SetP[harry, phoneIs, I2V[4999]];
  []_ SetP[mark, phoneIs, I2V[4464]];
  []_ SetP[nori, phoneIs, I2V[4425]];
  []_ SetP[rick, phoneIs, I2V[4466]];
  []_ SetP[rick, heightProp, S2V["medium"]];
  t_ DeclareRelship[Friend]; SetF[t, friendOf, rick]; SetF[t, friendIs, harry];
  []_ DeclareRelship[Friend, LIST[[friendOf, nori], [friendIs, harry]]];
  END;

InsertMoreData: PROCEDURE =
  BEGIN t: Relship; rick: Entity; ok: BOOL_ FALSE;
  tty.Put[rope["\nCreating more data..."], char[CR]];
  -- Create some new entities and fetch old one (rick)
  wsh_ DeclareEntity[Person];
  rick_ DeclareEntity[Person, "Rick Cattell", OldOnly];
  rock_ DeclareEntity[Thing, "Harry the rock"];
  pebble_ DeclareEntity[Thing, "Fred the pebble"];
  george_ DeclareEntity[Frog, "George the frog"];
  []_ DeclareEntity[Frog, "Larry the frog"];
  -- Use SetP to assign names and heights
  ChangeName[wsh, "Willie-Sue H"];
  []_ SetP[wsh, heightProp, S2V["medium"]];
  []_ SetP[mark, heightProp, S2V["taller"]];
  []_ SetP[rock, heightProp, S2V["big"]];
  []_ SetP[pebble, heightProp, S2V["little"]];
  []_ SetP[george, heightProp, S2V["little"]];
  -- Check that Person can't be friend of frog
  t_ DeclareRelship[Friend];
  SetF[t, friendOf, rick];
  SetF[t, friendIs, george ! DB.Error =>
    TRUSTED {IF code=MismatchedAttributeValueType THEN {ok _ TRUE; CONTINUE}}];
  IF NOT ok THEN ERROR;
  END;

DestroySomeData: PROCEDURE =
  -- Destroy one person entity and all frog entities
  BEGIN flag: BOOL_ FALSE;
  tty.Put[char[CR], rope["Deleting some data: Rick and all the frogs..."], char[CR]];
  DestroyEntity[DeclareEntity[Person, "Rick Cattell", OldOnly]];
  DestroyDomain[Frog];
  END;

PrintPeople: PROC =
  -- Use DomainSubset with no constraints to enumerate all Persons
  BEGIN
  person: -- PersonDomain -- Entity;
  es: EntitySet;
  lint: LONG INTEGER;
  tty.PutF["\nPerson Domain:\n\n"];
    tty.Put[rope["Name		Phone"], char[CR]];
  es_ DomainSubset[Person];
  WHILE (person_ NextEntity[es])#NIL DO
    tty.Put[rope[GetName[person]], char[TAB]];
    lint_ V2I[GetP[person, phoneIs]];
    tty.Put[int[lint], char[CR]];
    ENDLOOP;
  ReleaseEntitySet[es];
  END;

PrintEverything: PROCEDURE =
  -- Use DomainSubset to enumerate all Things (includes Frogs and Persons).
  -- Print "unknown" if height field is null string.
  BEGIN
  thing: -- Thing -- Entity;
  es: EntitySet;
  r: ROPE;
  tty.PutF["\nThings:\n\n"];
  tty.PutF["Type	Name		Height\n"];
  es_ DomainSubset[Thing];
  WHILE (thing_ NextEntity[es])#NIL DO
    tty.Put[rope[GetName[DomainOf[thing]]], char[TAB]];
    tty.Put[rope[GetName[thing]], char[TAB]];
    r_ V2S[GetP[thing, heightProp]];
    tty.Put[rope[IF r.Length[]=0 THEN "[unknown]" ELSE r], char[CR]];
    ENDLOOP;
  ReleaseEntitySet[es];
  END;

PrintCSLPhones: PROC =
  -- Use RelationSubset to enumerate phones between 4400 and 4500
  BEGIN
  rs: RelshipSet; r: Relship;
  tty.PutF["\nPhone numbers between 4400 and 4499:\n"];
  tty.PutF["Name	Phone\n"];
  rs_ RelationSubset[Phone, LIST[[phoneIs, I2V[4400], I2V[4499]]], Last];
  UNTIL (r_ PrevRelship[rs])=NIL DO
    tty.PutF["%g	%g\n", rope[GetFS[r, phoneOf]], rope[GetFS[r, phoneIs]] ];
    ENDLOOP;
  ReleaseRelshipSet[rs];
  END;

PrintFriends: PROC =
  -- Use RelationSubset to enumerate friends of Harry
  BEGIN
  friendRS: --Friend-- Relship;
  friendName: --Person-- ROPE; 
  rs: RelshipSet;
  tty.Put[char[CR], rope["Harry's friends:"], char[CR]];
  rs_ RelationSubset[Friend, LIST[[friendIs, harry]]];
  WHILE (friendRS_ NextRelship[rs])#NIL DO
    friendName_ GetFS[friendRS, friendOf];
    tty.Put[rope[friendName], rope["	"], char[CR]];
    ENDLOOP;
  ReleaseRelshipSet[rs];
  END;


DoIt: PROC = {
  [in, tty]_ ViewerIO.CreateViewerStreams["VLTest1Impl.log"];
  tty.PutF["Creating database...\n"];
  DB.Initialize[];
  DB.DeclareSegment["[Luther.Alpine]<Cattell.pa>Test.segment", mySeg];
  DB.EraseSegment[mySeg];
  DB.OpenTransaction[mySeg];
  Initialize[];
  tty.PutF["Type a character to proceed...\n"];
  []_ in.GetChar[];
  InsertData[];
  PrintPeople[];
  PrintCSLPhones[];
  PrintFriends[];
  InsertMoreData[];
  PrintEverything[];
  DestroySomeData[];
  PrintEverything[];
  tty.PutF["\n\nDone.\n"];
  CloseTransaction[TransactionOf[mySeg]];
  };


DoIt[]

END.