home *** CD-ROM | disk | FTP | other *** search
/ Black Box 4 / BlackBox.cdr / progpas / tspas18.arj / TSUNTG.TST < prev    next >
Text File  |  1990-02-25  |  2KB  |  89 lines
  1. {$M 16384,0,655360}
  2.  
  3. (* This is a test program for the TSUNTG.TPU unit
  4.    Updated 26-Nov-89, 6-Dec-89 *)
  5.  
  6. uses TSUNTG;
  7.  
  8. procedure LOGO;
  9. begin
  10.   writeln;
  11.   writeln ('TSUNTG unit test by Prof. Timo Salmi');
  12.   writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
  13.   writeln;
  14. end;
  15.  
  16. (* Number of diskette drives *)
  17. procedure TEST1;
  18. begin
  19.   writeln ('Number of diskette drives on this system is ', DRIVESFN);
  20. end; (* test1 *)
  21.  
  22. (* Number of diskette drives *)
  23. procedure TEST2;
  24. begin
  25.   writeln ('The first diskette drive is ', FDRIVEFN);
  26. end; (* test2 *)
  27.  
  28. (* Is a media present in the drive *)
  29. procedure TEST3;
  30. const drive = 'B';
  31. begin
  32.   If INDRIVFN (drive) then
  33.     writeln ('Disk present in drive ', drive)
  34.   else
  35.     writeln ('Disk not present in drive ', drive);
  36. end;  (* test3 *)
  37.  
  38. (* Cursor location test *)
  39. procedure TEST4;
  40. var x , y : byte;
  41. begin
  42.   GOATXY (10, 20);
  43.   write ('▓The block is at 10,20 .');
  44.   x := WHEREXFN - 1; y := WHEREYFN;
  45.   write (' and the point at ', x:0, ',', y:0);
  46. end;  (* test4 *)
  47.  
  48. (* Reverse the colors of an area *)
  49. procedure TEST5;
  50. begin
  51.   REVAREA (2, 2, 79, 24);
  52.   GOATXY (1, 22);
  53. end;  (* test5 *)
  54.  
  55. (* Redirection of writes *)
  56. procedure TEST6;
  57. begin
  58.   USEPRN;
  59.   writeln ('This goes to the printer');
  60.   writeln ('As does this');
  61.   USECON;
  62.   write   ('This goes on the screen');
  63. end;  (* test6 *)
  64.  
  65. (* Test of the timed inkey function *)
  66. procedure TEST7;
  67. var key : char;
  68.     timeout : boolean;
  69. begin
  70.   repeat
  71.     key := INKEYFN (3.0, timeout);
  72.     if not timeout then write (key)
  73.       else begin writeln; writeln ('Timeout',#7); end;
  74.   until key = #27;
  75. end;  (* test7 *)
  76.  
  77. (* Main program
  78.    If you just want a particular test, comment the others away *)
  79. begin
  80.   LOGO;
  81.   TEST1;
  82.   TEST2;
  83.   TEST3;
  84.   TEST4;
  85.   TEST5;
  86.   TEST6;
  87.   {Put TEST7 here if you want to try it out}
  88. end.  (* tsuntg.tst *)
  89.