home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / TSPA3340.ZIP / TSUNTF.TST < prev    next >
Text File  |  1993-01-23  |  3KB  |  136 lines
  1. (* This is a test program for the TSUNTF.TPU unit
  2.    All rights reserved 19-Aug-89
  3.    Updated 23-Sep-89, 21-Mar-90, 20-Sep-92, 23-Jan-93
  4. *)
  5.  
  6. uses Dos,
  7.      Crt,
  8.      TSUNTF;
  9.  
  10. procedure LOGO;
  11. begin
  12.   writeln;
  13.   writeln ('TSUNTF unit test by Prof. Timo Salmi, 23-Jan-93');
  14.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  15. {$IFDEF VER40}
  16.   writeln ('TP version 4.0');
  17. {$ENDIF}
  18. {$IFDEF VER50}
  19.   writeln ('TP version 5.0');
  20. {$ENDIF}
  21. {$IFDEF VER55}
  22.   writeln ('TP version 5.5');
  23. {$ENDIF}
  24. {$IFDEF VER60}
  25.   writeln ('TP version 6.0');
  26. {$ENDIF}
  27. {$IFDEF VER70}
  28.   writeln ('TP version 7.0');
  29. {$ENDIF}
  30.   writeln;
  31.   writeln ('....:....1....:....2....:....3....:....4....:....5....:....6....:....7....:....');
  32. end;  (* logo *)
  33.  
  34. (* Input line-editing *)
  35. procedure TEST1;
  36. var sj     : string;
  37.     prompt : string;
  38.     tmp    : string;
  39. begin
  40.   prompt := 'Give your input> ';
  41.   FillChar (tmp, SizeOf(tmp), '.');  { If you are wondering about these two, }
  42.   tmp[0] := chr(Length(prompt));     { they just produce points to show where}
  43.   repeat                             { we are.                               }
  44.     EDRDLN (prompt, sj);
  45.     writeln (tmp, sj);
  46.   until sj = 'exit';
  47. end;  (* test1 *)
  48.  
  49. (* Input line-editing with recall potential *)
  50. procedure TEST2;
  51. var sj     : string;
  52.     old    : string;
  53.     prompt : string;
  54. begin
  55.   prompt := 'Give your input> ';
  56.   old := '';
  57.   repeat
  58.     EDREADLN (prompt, old, sj);
  59.     writeln (sj);
  60.     old := sj;
  61.   until sj = 'exit';
  62. end;  (* test2 *)
  63.  
  64. (* Iput line-editing with recall and break potential *)
  65. procedure TEST3;
  66. var sj     : string;
  67.     old    : string;
  68.     prompt : string;
  69.     tmp    : string;
  70.     BreakPressed : boolean;
  71. begin
  72.   prompt := 'Give your input> ';
  73.   old := '';
  74.   repeat
  75.     EDREABLN (prompt, old, 79, sj, BreakPressed);
  76.     writeln (sj);
  77.     old := sj;
  78.   until BreakPressed;   {Press ctrl-c or break}
  79.   writeln ('Break was pressed');
  80. end;  (* test3 *)
  81.  
  82. (* Test input line-editing with recall and pre-fill potential.
  83.    Important, you must always assign a value to the PrefillString
  84.    before invoking this routine. Else you will have a random default
  85.    with unexpected results *)
  86. procedure TEST4;
  87. var sj      : string;
  88.     old     : string;
  89.     prompt  : string;
  90.     prefill : string;
  91. begin
  92.   prompt := 'Give your input> ';
  93.   prefill := 'Testing for the prefill';
  94.   old := prefill;
  95.   repeat
  96.     EDRDEFLN (prompt, old, prefill, sj);
  97.     prefill := '';
  98.     writeln (sj);
  99.     if sj <> '' then old := sj;
  100.   until sj = 'exit';
  101. end;  (* test4 *)
  102.  
  103. (* Test input line-editing with recall and pre-fill potential.
  104.    Important, you must always assign a value to the PrefillString
  105.    before invoking this routine. Else you will have a random default
  106.    with unexpected results *)
  107. procedure TEST5;
  108. var sj      : string;
  109.     old     : string;
  110.     prompt  : string;
  111.     prefill : string;
  112.     BreakPressed : boolean;
  113. begin
  114.   prompt := 'Give your input> ';
  115.   prefill := 'Testing for the prefill';
  116.   old := prefill;
  117.   repeat
  118.     EDRDEBLN (prompt, old, prefill, 79, sj, BreakPressed);
  119.     prefill := '';
  120.     writeln (sj);
  121.     if sj <> '' then old := sj;
  122.   until BreakPressed;   {Press ctrl-c or break}
  123.   writeln ('Break was pressed');
  124. end;  (* test5 *)
  125.  
  126. (* Main program *)
  127. begin
  128.   ClrScr;
  129.   LOGO;
  130.   { TEST1; }
  131.   { TEST2; }
  132.   { TEST3; }
  133.   TEST4;
  134.   { TEST5; }
  135. end.  (* tsuntf.tst *)
  136.