home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / tspas18.arj / TSUNTE.TST < prev    next >
Text File  |  1989-12-06  |  2KB  |  87 lines
  1. (* This is a test program for the TSUNTE.TPU unit
  2.    19-Aug-89, Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89 *)
  3.  
  4. uses TSUNTE;
  5.  
  6. procedure LOGO;
  7. begin
  8.   writeln;
  9.   writeln ('TSUNTE unit test by Prof. Timo Salmi, 19-Aug-89');
  10.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  11.   writeln;
  12. end;  (* logo *)
  13.  
  14. (* Testing the cursor routines *)
  15. procedure TEST1;
  16. begin
  17.   CURSOFF;
  18.   writeln ('Cursor is off, press <═╝');
  19.   CLB;
  20.   readln;
  21.   CURSON;
  22.   writeln ('Cursor is on, press <═╝');
  23.   CLB;
  24.   readln;
  25.   CURSOR (0, 13);
  26.   writeln ('Cursor is big, press <═╝');
  27.   CLB;
  28.   readln;
  29.   CURSOR (6, 7);
  30.   writeln ('Cursor is normal, press <═╝');
  31.   CLB;
  32.   readln;
  33. end;  (* test1 *)
  34.  
  35. (* The most common system clock weekday *)
  36. procedure TEST2;
  37. const wkday : string[21] = 'SunMonTueWedThuFriSat';
  38. begin
  39.   writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
  40.   writeln ('Week number ', WEEKNRFN (25,7,1980,false));
  41. end;  (* test2 *)
  42.  
  43. (* Special key status *)
  44. procedure TEST5;
  45. begin
  46.   if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
  47.   if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
  48. end;  (* test5 *)
  49.  
  50. (* Existence and size of a file
  51.    IMPORTANT: Never apply on an open file! *)
  52. procedure TEST6;
  53. var fname : string;
  54. begin
  55.   fname := 'a:\command.com';          {Alter fname as appropriate}
  56.   if FEXISTFN (fname) then            {**************************}
  57.      begin
  58.        writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
  59. {$IFNDEF VER40}
  60.        writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
  61. {$ENDIF}
  62.      end
  63.    else
  64.      writeln ('File ', fname, ' does not exist');
  65. end;  (* test6 *)
  66.  
  67. (* Get the entire command line, spaces and all *)
  68. procedure TEST7;
  69. begin
  70.   writeln;
  71.   writeln ('Command line = ', CMDLNFN);
  72.   writeln;
  73. end;  (* test7 *)
  74.  
  75. (* Main program *)
  76. begin
  77.   LOGO;
  78.   BORDER(5);
  79.   TEST7;
  80.   TEST1;
  81.   TEST2;
  82.   TEST5;
  83.   TEST6;
  84.   write ('Press <═╝'); readln;
  85.   BORDER(0);
  86. end.  (* tsunte.tst *)
  87.