Topspeed_JPI/TS-V3/EXAMPLES/ADDRESS.LST

Listing:

    1  MODULE Address;
    2  (*
    3      Copyright 1989 by Jensen & Partners International, All Rights Reserved
    4  *)
    5  
    6  
    7  IMPORT IO, FIO, Window, Btree, Str, Lib, Misc;
    8  
    9  
   10  TYPE
   11      AddrKey     = ARRAY[0..25] OF CHAR;
*****                             ^ not supported yet
*****                                    ^ not supported yet
   12      AddrRec     = RECORD
   13                    LName      : ARRAY[0..14] OF CHAR;
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
   14                    FName      : ARRAY[0..9] OF CHAR;
*****                                          ^ not supported yet
*****                                                ^ not supported yet
   15                    Street     : ARRAY[0..25] OF CHAR;
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
   16                    City       : ARRAY[0..15] OF CHAR;
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
   17                    State      : ARRAY[0..1] OF CHAR;
*****                                          ^ not supported yet
*****                                                ^ not supported yet
   18                    Zip        : ARRAY[0..4] OF CHAR;
*****                                          ^ not supported yet
*****                                                ^ not supported yet
   19                    Phone      : ARRAY[0..12] OF CHAR;
*****                                          ^ not supported yet
*****                                                 ^ not supported yet
   20                  END;  (* record *)
*****                  ^ not supported yet
   21      CharSet     = SET OF CHAR;
*****                           ^ not supported yet
   22  
   23  
   24  VAR
   25      choice, ch2 : CHAR;
   26      FOUND,
   27      DONE        : BOOLEAN;
   28      DataColor,
   29      TemplateColor : Window.Color;
*****                             ^ not supported yet
   30      NameFile    : Btree.FHandle;   (* physical file handle *)
*****                          ^ not supported yet
   31      NameData,                   (* logical data file handle *)
   32      NameIndex   : Btree.IHandle;   (* logical index file handle *)
*****                          ^ not supported yet
   33      blankAddr,
   34      tempAddr    : AddrRec;
*****                    ^ not supported yet
   35      Create      : BOOLEAN;
   36  
   37  
   38  PROCEDURE MAKEKEY(keyA,myRecA: ADDRESS);
*****                                 ^ undeclared identifier
   39  VAR
   40    key : POINTER TO AddrKey;
*****                     ^ not supported yet
   41    myRec : POINTER TO AddrRec;
*****                       ^ not supported yet
   42    i,j : CARDINAL;
   43  BEGIN
   44    key := keyA;
*****    ^ not supported yet
*****           ^ not supported yet
   45    myRec := myRecA;
*****    ^ not supported yet
*****             ^ not supported yet
   46    Str.Copy(key^,myRec^.LName);
*****    ^ not supported yet
*****        ^ not supported yet
*****             ^ not supported yet
*****                  ^ not supported yet
*****                         ^ not supported yet
   47    i := Str.Length(key^);
*****         ^ not supported yet
*****             ^ not supported yet
*****                    ^ not supported yet
   48    WHILE (i#0) AND (key^[i-1]=' ') DO
*****                     ^ not supported yet
*****                             ^ not supported yet
   49      key^[i-1] := 0C;
*****      ^ not supported yet
*****              ^ not supported yet
   50      DEC(i);
*****      ^ undeclared identifier
*****           ^ not supported yet
   51    END;  (* while *)
   52    Str.Append(key^," ");
*****    ^ not supported yet
*****        ^ not supported yet
*****               ^ not supported yet
*****                       ^ not supported yet
   53    Str.Append(key^,myRec^.FName);
*****    ^ not supported yet
*****        ^ not supported yet
*****               ^ not supported yet
*****                    ^ not supported yet
*****                           ^ not supported yet
   54    i := Str.Length(key^);
*****         ^ not supported yet
*****             ^ not supported yet
*****                    ^ not supported yet
   55    WHILE (i#0) AND (key^[i-1]=' ') DO
*****                     ^ not supported yet
*****                             ^ not supported yet
   56      key^[i-1] := 0C;
*****      ^ not supported yet
*****              ^ not supported yet
   57      DEC(i);
*****      ^ undeclared identifier
*****           ^ not supported yet
   58    END;  (* while *)
   59    Str.Caps(key^);
*****    ^ not supported yet
*****        ^ not supported yet
*****             ^ not supported yet
   60  END MAKEKEY;
*****      ^ not supported yet
   61  
   62  
   63  PROCEDURE COMPARE(key1,key2: ADDRESS): Btree.CmpRes;
*****                               ^ undeclared identifier
*****                                               ^ not supported yet
   64  (* compare two keys, and determine which is "smaller" *)
   65  BEGIN
   66      RETURN Btree.CmpRes(Str.Compare(AddrKey(key1^),AddrKey(key2^))+1);
*****             ^ not supported yet
*****                   ^ not supported yet
*****                          ^ not supported yet
*****                              ^ not supported yet
*****                                              ^ not supported yet
*****                                                             ^ not supported yet
*****                                                                      ^ not supported yet
   67  END COMPARE;
*****      ^ not supported yet
   68  
   69  
   70  PROCEDURE Beep();
   71  BEGIN
   72    Lib.Speaker(1500,10);
*****    ^ not supported yet
*****        ^ not supported yet
*****                       ^ not supported yet
   73  END Beep;
*****      ^ not supported yet
   74  
   75  
   76  PROCEDURE WriteAt(row,col: CARDINAL; txt: ARRAY OF CHAR);
*****                                                     ^ not supported yet
   77  BEGIN
   78      Window.GotoXY(col,row);
*****      ^ not supported yet
*****             ^ not supported yet
*****                           ^ not supported yet
   79      IO.WrStr(txt);
*****      ^ not supported yet
*****         ^ not supported yet
*****               ^ not supported yet
   80  END WriteAt;
*****      ^ not supported yet
   81  
   82  
   83  PROCEDURE Template();
   84  BEGIN
   85      Window.TextColor(TemplateColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
   86      WriteAt(3,3,"Name:");
*****      ^ not supported yet
*****                  ^ not supported yet
   87      WriteAt(3,50,"(first last)");
*****      ^ not supported yet
*****                   ^ not supported yet
   88      WriteAt(4,3,"Address:");
*****      ^ not supported yet
*****                  ^ not supported yet
   89      WriteAt(5,3,"City:");
*****      ^ not supported yet
*****                  ^ not supported yet
   90      WriteAt(5,40,"State:");
*****      ^ not supported yet
*****                   ^ not supported yet
   91      WriteAt(5,55,"Zip:");
*****      ^ not supported yet
*****                   ^ not supported yet
   92      WriteAt(6,3,"Phone:");
*****      ^ not supported yet
*****                  ^ not supported yet
   93  END Template;
*****      ^ not supported yet
   94  
   95  
   96  PROCEDURE Display(myRec: AddrRec);
   97  BEGIN
   98      Window.TextColor(DataColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
   99      WriteAt(3,12,myRec.FName);  IO.WrStr(" ");  IO.WrStr(myRec.LName);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
*****                                  ^ not supported yet
*****                                     ^ not supported yet
*****                                              ^ not supported yet
*****                                                  ^ not supported yet
*****                                                     ^ not supported yet
*****                                                           ^ not supported yet
*****                                                                 ^ not supported yet
  100      WriteAt(4,12,myRec.Street);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  101      WriteAt(5,12,myRec.City);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  102      WriteAt(5,47,myRec.State);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  103      WriteAt(5,60,myRec.Zip);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  104      WriteAt(6,12,myRec.Phone);
*****      ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  105  END Display;
*****      ^ not supported yet
  106  
  107  
  108  PROCEDURE GetMenu(Prompt: ARRAY OF CHAR; OKChars: CharSet;
*****                                     ^ not supported yet
  109                    VAR ch: CHAR);
  110  VAR
  111    OK    : BOOLEAN;
  112    MenuWin : Window.WinType;
*****                     ^ not supported yet
  113    i : CARDINAL;
  114  BEGIN
  115      MenuWin := Window.Open( Window.WinDef( 0, 22, 79, 24,
*****      ^ not supported yet
*****                 ^ not supported yet
*****                        ^ not supported yet
*****                              ^ not supported yet
*****                                     ^ not supported yet
  116              Window.White,Window.Black,TRUE,FALSE,TRUE,TRUE,
*****              ^ not supported yet
*****                     ^ not supported yet
*****                           ^ not supported yet
*****                                  ^ not supported yet
  117              Window.SingleFrame,Window.White,Window.Black) );
*****              ^ not supported yet
*****                     ^ not supported yet
*****                                 ^ not supported yet
*****                                        ^ not supported yet
*****                                              ^ not supported yet
*****                                                     ^ not supported yet
  118      i := Str.Length(Prompt);
*****           ^ not supported yet
*****               ^ not supported yet
*****                      ^ not supported yet
  119      Window.Change(MenuWin,((80-i) DIV 2) -2,22, ((80-i) DIV 2) + i + 3, 24);
*****      ^ not supported yet
*****             ^ not supported yet
*****                    ^ not supported yet
*****                                                                            ^ not supported yet
  120      Window.SetFrame(MenuWin,Window.SingleFrame,TemplateColor,Window.Black);
*****      ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
*****                              ^ not supported yet
*****                                     ^ not supported yet
*****                                                 ^ not supported yet
*****                                                               ^ not supported yet
*****                                                                      ^ not supported yet
  121      Window.TextColor(DataColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
  122      Window.Use(MenuWin);
*****      ^ not supported yet
*****             ^ not supported yet
*****                 ^ not supported yet
  123      Window.PutOnTop(MenuWin);
*****      ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
  124      IO.WrStr("  ");
*****      ^ not supported yet
*****         ^ not supported yet
*****               ^ not supported yet
  125      IO.WrStr(Prompt);
*****      ^ not supported yet
*****         ^ not supported yet
*****               ^ not supported yet
  126      OK := FALSE;
  127      REPEAT
  128           ch := CAP(IO.RdKey());
*****                 ^ undeclared identifier
*****                     ^ not supported yet
*****                        ^ not supported yet
*****                              ^ not supported yet
  129           IF ch IN OKChars THEN
*****                    ^ not supported yet
  130              OK := TRUE;
  131           ELSE
  132              Beep();
*****              ^ not supported yet
*****                   ^ not supported yet
  133           END;
  134      UNTIL OK;
  135      Window.Close(MenuWin);
*****      ^ not supported yet
*****             ^ not supported yet
*****                   ^ not supported yet
  136  END GetMenu;
*****      ^ not supported yet
  137  
  138  
  139  PROCEDURE ShowNames();
  140  VAR
  141    myRec : AddrRec;
*****            ^ not supported yet
  142    ch : CHAR;
  143    row : CARDINAL;
  144    switchColor : BOOLEAN;
  145  BEGIN
  146      Window.Clear();
*****      ^ not supported yet
*****             ^ not supported yet
*****                   ^ not supported yet
  147      Btree.Reset(NameData);
*****      ^ not supported yet
*****            ^ not supported yet
*****                  ^ not supported yet
  148      row := 1;
  149      switchColor := TRUE;
  150      WHILE Btree.Next(NameIndex,myRec) DO
*****            ^ not supported yet
*****                  ^ not supported yet
*****                       ^ not supported yet
*****                                 ^ not supported yet
  151          IF switchColor THEN
  152             Window.TextColor(TemplateColor);
*****             ^ not supported yet
*****                    ^ not supported yet
*****                              ^ not supported yet
  153          ELSE
  154             Window.TextColor(DataColor);
*****             ^ not supported yet
*****                    ^ not supported yet
*****                              ^ not supported yet
  155          END;
  156          switchColor := NOT switchColor;
  157          IO.WrStrAdj(myRec.LName, -17);
*****          ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
  158          IO.WrStrAdj(myRec.FName, -12);
*****          ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
  159          IO.WrStrAdj(myRec.Phone, -15);
*****          ^ not supported yet
*****             ^ not supported yet
*****                      ^ not supported yet
*****                            ^ not supported yet
*****                                      ^ not supported yet
  160          IO.WrLn();
*****          ^ not supported yet
*****             ^ not supported yet
*****                  ^ not supported yet
  161          INC(row);
*****          ^ undeclared identifier
*****                 ^ not supported yet
  162          IF row>23 THEN
  163             IO.WrLn();
*****             ^ not supported yet
*****                ^ not supported yet
*****                     ^ not supported yet
  164             IO.WrStr("Press <ESC> to quit, any other key to continue: ");
*****             ^ not supported yet
*****                ^ not supported yet
*****                      ^ not supported yet
  165             ch := IO.RdKey();
*****                   ^ not supported yet
*****                      ^ not supported yet
*****                            ^ not supported yet
  166             IF ch = 33C THEN RETURN; END;
  167             Window.Clear();
*****             ^ not supported yet
*****                    ^ not supported yet
*****                          ^ not supported yet
  168             row := 1;
  169          END;  (* if *)
  170       END;  (* while *)
  171  END ShowNames;
*****      ^ not supported yet
  172  
  173  
  174  PROCEDURE FindName();
  175  VAR
  176    fname : AddrKey;
*****            ^ not supported yet
  177    myRec : AddrRec;
*****            ^ not supported yet
  178    ch : CHAR;
  179  BEGIN
  180      Window.Clear();
*****      ^ not supported yet
*****             ^ not supported yet
*****                   ^ not supported yet
  181      Window.TextColor(TemplateColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
  182      FOUND := FALSE;
  183      WriteAt(3,3,"Enter name as 'Last First' (e.g. 'Smith John').");
*****      ^ not supported yet
*****                  ^ not supported yet
  184      WriteAt(4,3,"Be sure to include the space between the names.");
*****      ^ not supported yet
*****                  ^ not supported yet
  185      WriteAt(5,3,"> ");
*****      ^ not supported yet
*****                  ^ not supported yet
  186      Window.TextColor(DataColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
  187      fname := '';
*****      ^ not supported yet
*****               ^ incompatible assignment
  188      Misc.InputStr(fname,25);
*****      ^ not supported yet
*****           ^ not supported yet
*****                    ^ not supported yet
*****                            ^ not supported yet
  189      Str.Caps(fname);
*****      ^ not supported yet
*****          ^ not supported yet
*****               ^ not supported yet
  190      Window.TextColor(TemplateColor);
*****      ^ not supported yet
*****             ^ not supported yet
*****                       ^ not supported yet
  191      WriteAt(7,3,"Searching... ");
*****      ^ not supported yet
*****                  ^ not supported yet
  192      IF Btree.Find(NameIndex,fname,myRec) THEN
*****         ^ not supported yet
*****               ^ not supported yet
*****                    ^ not supported yet
*****                              ^ not supported yet
*****                                    ^ not supported yet
  193         Window.Clear();
*****         ^ not supported yet
*****                ^ not supported yet
*****                      ^ not supported yet
  194         Template();
*****         ^ not supported yet
*****                  ^ not supported yet
  195         Display(myRec);
*****         ^ not supported yet
*****                 ^ not supported yet
  196         FOUND := TRUE;
  197      ELSE
  198         WriteAt(7,20,"done.  Failed exact search.  Trying closest match.");
*****         ^ not supported yet
*****                      ^ not supported yet
  199         Window.TextColor(DataColor);
*****         ^ not supported yet
*****                ^ not supported yet
*****                          ^ not supported yet
  200         WriteAt(9,3,"Searching... ");
*****         ^ not supported yet
*****                     ^ not supported yet
  201         IF Btree.Search(NameIndex,fname,myRec) THEN
*****            ^ not supported yet
*****                  ^ not supported yet
*****                         ^ not supported yet
*****                                   ^ not supported yet
*****                                         ^ not supported yet
  202            Window.Clear();
*****            ^ not supported yet
*****                   ^ not supported yet
*****                         ^ not supported yet
  203            Template();
*****            ^ not supported yet
*****                     ^ not supported yet
  204            Display(myRec);
*****            ^ not supported yet
*****                    ^ not supported yet
  205            FOUND := TRUE;
  206            REPEAT
  207               GetMenu("N)ext, P)revious, or T)his one? ",
*****               ^ not supported yet
*****                       ^ not supported yet
  208                               CharSet{'N','P','T'},ch);
*****                                      ^ 'CASE' expected
*****                                       ^ not supported yet
*****                                           ^ not supported yet
*****                                               ^ not supported yet
  209               WriteAt(10,3,"                      ");
  210               CASE ch OF
  211                    'N' : IF Btree.Next(NameIndex,myRec) THEN
  212                             Display(blankAddr);
  213                             Display(myRec);
  214                          ELSE
  215                             WriteAt(10,3,"No more records found");
  216                             Beep();
  217                             Btree.Reset(NameIndex);
  218                             Display(blankAddr);
  219                             IF Btree.Prev(NameIndex,myRec) THEN
  220                               Display(myRec);
  221                             ELSE
  222                               FOUND := FALSE;
  223                             END;
  224                          END;
  225                  | 'P' : IF Btree.Prev(NameIndex,myRec) THEN
  226                             Display(blankAddr);
  227                             Display(myRec);
  228                          ELSE
  229                             WriteAt(10,3,"No more records found");
  230                             Beep();
  231                             Btree.Reset(NameIndex);
  232                             Display(blankAddr);
  233                             IF Btree.Next(NameIndex,myRec) THEN
  234                               Display(myRec);
  235                             ELSE
  236                               FOUND := FALSE;
  237                             END;
  238                          END;
  239                  ELSE
  240                     Beep();
  241                  END;  (* case *)
  242            UNTIL ch = 'T';
  243         ELSE
  244            WriteAt(9,20,"done.  Failed closest match search.");
  245         END;  (* if *)
  246      END;  (* if *)
  247  END FindName;
  248  
  249  
  250  PROCEDURE AddName();
  251  VAR
  252    myRec : AddrRec;
  253    ch : CHAR;
  254  BEGIN
  255      Window.Clear();
  256      Template();
  257      ch := 'N';
  258      myRec := blankAddr;
  259      REPEAT
  260         Window.TextColor(DataColor);
  261         Window.GotoXY(12,3);       Misc.InputStr(myRec.FName,10);
  262         Window.GotoXY(35,3);       Misc.InputStr(myRec.LName,15);
  263         Window.GotoXY(12,4);       Misc.InputStr(myRec.Street,25);
  264         Window.GotoXY(12,5);       Misc.InputStr(myRec.City,15);
  265         Window.GotoXY(47,5);       Misc.InputStr(myRec.State,2);
  266         Window.GotoXY(60,5);       Misc.InputStr(myRec.Zip,5);
  267         Window.GotoXY(12,6);       Misc.InputStr(myRec.Phone,12);
  268         GetMenu("Do these look ok? (Y/N) ",CharSet{'Y','N'},ch);
  269      UNTIL ch = 'Y';
  270      (* Now put it in the file *)
  271      Btree.Add(NameData,myRec,SIZE(myRec));
  272  END AddName;
  273  
  274  
  275  PROCEDURE DeleteName();
  276  VAR
  277    ch : CHAR;
  278  BEGIN
  279      FindName();
  280      IF FOUND THEN
  281         GetMenu("Delete this one? (Y/N) ",CharSet{'Y','N'},ch);
  282         IF ch = 'Y' THEN
  283            Btree.Delete(NameData);
  284         END;  (* if *)
  285      END;  (* if *)
  286      FOUND := FALSE;
  287  END DeleteName;
  288  
  289  
  290  BEGIN (* main program *)
  291      TemplateColor := Window.LightGreen;
  292      DataColor := Window.Yellow;
  293      Str.Copy(blankAddr.LName,"               ");
  294      Str.Copy(blankAddr.FName,"          ");
  295      Str.Copy(blankAddr.Street,"                          ");
  296      Str.Copy(blankAddr.City,"                ");
  297      Str.Copy(blankAddr.State,"  ");
  298      Str.Copy(blankAddr.Zip,"     ");
  299      Str.Copy(blankAddr.Phone,"             ");
  300      Window.Clear();
  301      Create := NOT FIO.Exists("Addressb.ook");
  302      NameFile := Btree.Open("Addressb.ook",2,Btree.FixSize,FALSE,FALSE,Create);
  303      NameData := Btree.OpenData(NameFile,1,SIZE(AddrRec),Create);
  304      NameIndex := Btree.OpenIndex(NameFile,NameData,2,COMPARE,MAKEKEY,
  305                                SIZE(AddrKey),TRUE,Create);
  306      DONE := FALSE;
  307      choice := ' ';
  308      REPEAT
  309          GetMenu("S)howNames F)indSomeone A)ddSomeone D)eleteSomeone Q)uit :",
  310                              CharSet{'S','F','A','D','Q'},choice);
  311          CASE choice OF
  312               'S' :  ShowNames();
  313             | 'F' :  FindName();
  314             | 'A' :  AddName();
  315             | 'D' :  DeleteName();
  316             | 'Q' :  DONE := TRUE;
  317          ELSE
  318                Beep();
  319          END;  (* case *)
  320      UNTIL DONE;
  321      Btree.Close(NameFile);
  322  END Address.

  310 errors