Topspeed_JPI/TS/EXAMPLES/ADDRESS.MOD

MODULE Address;
(*
    Copyright 1989 by Jensen & Partners International, All Rights Reserved
*)


IMPORT IO, FIO, Window, Btree, Str, Lib, Misc;


TYPE
    AddrKey     = ARRAY[0..25] OF CHAR;
    AddrRec     = RECORD
                  LName      : ARRAY[0..14] OF CHAR;
                  FName      : ARRAY[0..9] OF CHAR;
                  Street     : ARRAY[0..25] OF CHAR;
                  City       : ARRAY[0..15] OF CHAR;
                  State      : ARRAY[0..1] OF CHAR;
                  Zip        : ARRAY[0..4] OF CHAR;
                  Phone      : ARRAY[0..12] OF CHAR;
                END;  (* record *)
    CharSet     = SET OF CHAR;


VAR
    choice, ch2 : CHAR;
    FOUND,
    DONE        : BOOLEAN;
    DataColor,
    TemplateColor : Window.Color;
    NameFile    : Btree.FHandle;   (* physical file handle *)
    NameData,                   (* logical data file handle *)
    NameIndex   : Btree.IHandle;   (* logical index file handle *)
    blankAddr,
    tempAddr    : AddrRec;
    Create      : BOOLEAN;


PROCEDURE MAKEKEY(keyA,myRecA: ADDRESS);
VAR
  key : POINTER TO AddrKey;
  myRec : POINTER TO AddrRec;
  i,j : CARDINAL;
BEGIN
  key := keyA;
  myRec := myRecA;
  Str.Copy(key^,myRec^.LName);
  i := Str.Length(key^);
  WHILE (i#0) AND (key^[i-1]=' ') DO
    key^[i-1] := 0C;
    DEC(i);
  END;  (* while *)
  Str.Append(key^," ");
  Str.Append(key^,myRec^.FName);
  i := Str.Length(key^);
  WHILE (i#0) AND (key^[i-1]=' ') DO
    key^[i-1] := 0C;
    DEC(i);
  END;  (* while *)
  Str.Caps(key^);
END MAKEKEY;


PROCEDURE COMPARE(key1,key2: ADDRESS): Btree.CmpRes;
(* compare two keys, and determine which is "smaller" *)
BEGIN
    RETURN Btree.CmpRes(Str.Compare(AddrKey(key1^),AddrKey(key2^))+1);
END COMPARE;


PROCEDURE Beep();
BEGIN
  Lib.Speaker(1500,10);
END Beep;


PROCEDURE WriteAt(row,col: CARDINAL; txt: ARRAY OF CHAR);
BEGIN
    Window.GotoXY(col,row);
    IO.WrStr(txt);
END WriteAt;


PROCEDURE Template();
BEGIN
    Window.TextColor(TemplateColor);
    WriteAt(3,3,"Name:");
    WriteAt(3,50,"(first last)");
    WriteAt(4,3,"Address:");
    WriteAt(5,3,"City:");
    WriteAt(5,40,"State:");
    WriteAt(5,55,"Zip:");
    WriteAt(6,3,"Phone:");
END Template;


PROCEDURE Display(myRec: AddrRec);
BEGIN
    Window.TextColor(DataColor);
    WriteAt(3,12,myRec.FName);  IO.WrStr(" ");  IO.WrStr(myRec.LName);
    WriteAt(4,12,myRec.Street);
    WriteAt(5,12,myRec.City);
    WriteAt(5,47,myRec.State);
    WriteAt(5,60,myRec.Zip);
    WriteAt(6,12,myRec.Phone);
END Display;


PROCEDURE GetMenu(Prompt: ARRAY OF CHAR; OKChars: CharSet;
                  VAR ch: CHAR);
VAR
  OK    : BOOLEAN;
  MenuWin : Window.WinType;
  i : CARDINAL;
BEGIN
    MenuWin := Window.Open( Window.WinDef( 0, 22, 79, 24,
            Window.White,Window.Black,TRUE,FALSE,TRUE,TRUE,
            Window.SingleFrame,Window.White,Window.Black) );
    i := Str.Length(Prompt);
    Window.Change(MenuWin,((80-i) DIV 2) -2,22, ((80-i) DIV 2) + i + 3, 24);
    Window.SetFrame(MenuWin,Window.SingleFrame,TemplateColor,Window.Black);
    Window.TextColor(DataColor);
    Window.Use(MenuWin);
    Window.PutOnTop(MenuWin);
    IO.WrStr("  ");
    IO.WrStr(Prompt);
    OK := FALSE;
    REPEAT
         ch := CAP(IO.RdKey());
         IF ch IN OKChars THEN
            OK := TRUE;
         ELSE
            Beep();
         END;
    UNTIL OK;
    Window.Close(MenuWin);
END GetMenu;


PROCEDURE ShowNames();
VAR
  myRec : AddrRec;
  ch : CHAR;
  row : CARDINAL;
  switchColor : BOOLEAN;
BEGIN
    Window.Clear();
    Btree.Reset(NameData);
    row := 1;
    switchColor := TRUE;
    WHILE Btree.Next(NameIndex,myRec) DO
        IF switchColor THEN
           Window.TextColor(TemplateColor);
        ELSE
           Window.TextColor(DataColor);
        END;
        switchColor := NOT switchColor;
        IO.WrStrAdj(myRec.LName, -17);
        IO.WrStrAdj(myRec.FName, -12);
        IO.WrStrAdj(myRec.Phone, -15);
        IO.WrLn();
        INC(row);
        IF row>23 THEN
           IO.WrLn();
           IO.WrStr("Press <ESC> to quit, any other key to continue: ");
           ch := IO.RdKey();
           IF ch = 33C THEN RETURN; END;
           Window.Clear();
           row := 1;
        END;  (* if *)
     END;  (* while *)
END ShowNames;


PROCEDURE FindName();
VAR
  fname : AddrKey;
  myRec : AddrRec;
  ch : CHAR;
BEGIN
    Window.Clear();
    Window.TextColor(TemplateColor);
    FOUND := FALSE;
    WriteAt(3,3,"Enter name as 'Last First' (e.g. 'Smith John').");
    WriteAt(4,3,"Be sure to include the space between the names.");
    WriteAt(5,3,"> ");
    Window.TextColor(DataColor);
    fname := '';
    Misc.InputStr(fname,25);
    Str.Caps(fname);
    Window.TextColor(TemplateColor);
    WriteAt(7,3,"Searching... ");
    IF Btree.Find(NameIndex,fname,myRec) THEN
       Window.Clear();
       Template();
       Display(myRec);
       FOUND := TRUE;
    ELSE
       WriteAt(7,20,"done.  Failed exact search.  Trying closest match.");
       Window.TextColor(DataColor);
       WriteAt(9,3,"Searching... ");
       IF Btree.Search(NameIndex,fname,myRec) THEN
          Window.Clear();
          Template();
          Display(myRec);
          FOUND := TRUE;
          REPEAT
             GetMenu("N)ext, P)revious, or T)his one? ",
                             CharSet{'N','P','T'},ch);
             WriteAt(10,3,"                      ");
             CASE ch OF
                  'N' : IF Btree.Next(NameIndex,myRec) THEN
                           Display(blankAddr);
                           Display(myRec);
                        ELSE
                           WriteAt(10,3,"No more records found");
                           Beep();
                           Btree.Reset(NameIndex);
                           Display(blankAddr);
                           IF Btree.Prev(NameIndex,myRec) THEN
                             Display(myRec);
                           ELSE
                             FOUND := FALSE;
                           END;
                        END;
                | 'P' : IF Btree.Prev(NameIndex,myRec) THEN
                           Display(blankAddr);
                           Display(myRec);
                        ELSE
                           WriteAt(10,3,"No more records found");
                           Beep();
                           Btree.Reset(NameIndex);
                           Display(blankAddr);
                           IF Btree.Next(NameIndex,myRec) THEN
                             Display(myRec);
                           ELSE
                             FOUND := FALSE;
                           END;
                        END;
                ELSE
                   Beep();
                END;  (* case *)
          UNTIL ch = 'T';
       ELSE
          WriteAt(9,20,"done.  Failed closest match search.");
       END;  (* if *)
    END;  (* if *)
END FindName;


PROCEDURE AddName();
VAR
  myRec : AddrRec;
  ch : CHAR;
BEGIN
    Window.Clear();
    Template();
    ch := 'N';
    myRec := blankAddr;
    REPEAT
       Window.TextColor(DataColor);
       Window.GotoXY(12,3);       Misc.InputStr(myRec.FName,10);
       Window.GotoXY(35,3);       Misc.InputStr(myRec.LName,15);
       Window.GotoXY(12,4);       Misc.InputStr(myRec.Street,25);
       Window.GotoXY(12,5);       Misc.InputStr(myRec.City,15);
       Window.GotoXY(47,5);       Misc.InputStr(myRec.State,2);
       Window.GotoXY(60,5);       Misc.InputStr(myRec.Zip,5);
       Window.GotoXY(12,6);       Misc.InputStr(myRec.Phone,12);
       GetMenu("Do these look ok? (Y/N) ",CharSet{'Y','N'},ch);
    UNTIL ch = 'Y';
    (* Now put it in the file *)
    Btree.Add(NameData,myRec,SIZE(myRec));
END AddName;


PROCEDURE DeleteName();
VAR
  ch : CHAR;
BEGIN
    FindName();
    IF FOUND THEN
       GetMenu("Delete this one? (Y/N) ",CharSet{'Y','N'},ch);
       IF ch = 'Y' THEN
          Btree.Delete(NameData);
       END;  (* if *)
    END;  (* if *)
    FOUND := FALSE;
END DeleteName;


BEGIN (* main program *)
    TemplateColor := Window.LightGreen;
    DataColor := Window.Yellow;
    Str.Copy(blankAddr.LName,"               ");
    Str.Copy(blankAddr.FName,"          ");
    Str.Copy(blankAddr.Street,"                          ");
    Str.Copy(blankAddr.City,"                ");
    Str.Copy(blankAddr.State,"  ");
    Str.Copy(blankAddr.Zip,"     ");
    Str.Copy(blankAddr.Phone,"             ");
    Window.Clear();
    Create := NOT FIO.Exists("Addressb.ook");
    NameFile := Btree.Open("Addressb.ook",2,Btree.FixSize,FALSE,FALSE,Create);
    NameData := Btree.OpenData(NameFile,1,SIZE(AddrRec),Create);
    NameIndex := Btree.OpenIndex(NameFile,NameData,2,COMPARE,MAKEKEY,
                              SIZE(AddrKey),TRUE,Create);
    DONE := FALSE;
    choice := ' ';
    REPEAT
        GetMenu("S)howNames F)indSomeone A)ddSomeone D)eleteSomeone Q)uit :",
                            CharSet{'S','F','A','D','Q'},choice);
        CASE choice OF
             'S' :  ShowNames();
           | 'F' :  FindName();
           | 'A' :  AddName();
           | 'D' :  DeleteName();
           | 'Q' :  DONE := TRUE;
        ELSE
              Beep();
        END;  (* case *)
    UNTIL DONE;
    Btree.Close(NameFile);
END Address.