home *** CD-ROM | disk | FTP | other *** search
- (* This is a test program for the TSUNTE.TPU unit
- 19-Aug-89, Updated 24-Sep-89, 8-Oct-89, 4-Nov-89, 4-Dec-89 *)
-
- uses TSUNTE;
-
- procedure LOGO;
- begin
- writeln;
- writeln ('TSUNTE unit test by Prof. Timo Salmi, 19-Aug-89');
- writeln ('University of Vaasa, Finland, ts@chyde.uwasa.fi');
- writeln;
- end; (* logo *)
-
- (* Testing the cursor routines *)
- procedure TEST1;
- begin
- CURSOFF;
- writeln ('Cursor is off, press <═╝');
- CLB;
- readln;
- CURSON;
- writeln ('Cursor is on, press <═╝');
- CLB;
- readln;
- CURSOR (0, 13);
- writeln ('Cursor is big, press <═╝');
- CLB;
- readln;
- CURSOR (6, 7);
- writeln ('Cursor is normal, press <═╝');
- CLB;
- readln;
- end; (* test1 *)
-
- (* The most common system clock weekday *)
- procedure TEST2;
- const wkday : string[21] = 'SunMonTueWedThuFriSat';
- begin
- writeln ('25-7-1980 was ', Copy (wkday, 3*WKDAYFN(25,7,1980)+1, 3));
- writeln ('Week number ', WEEKNRFN (25,7,1980,false));
- end; (* test2 *)
-
- (* Special key status *)
- procedure TEST5;
- begin
- if CAPSONFN then writeln ('CapsLock on') else writeln ('CapsLock off');
- if NUMLONFN then writeln ('NumLock on') else writeln ('NumLock off');
- end; (* test5 *)
-
- (* Existence and size of a file
- IMPORTANT: Never apply on an open file! *)
- procedure TEST6;
- var fname : string;
- begin
- fname := 'a:\command.com'; {Alter fname as appropriate}
- if FEXISTFN (fname) then {**************************}
- begin
- writeln ('File ', fname, ' size ', FSIZEFN(fname), ' bytes');
- {$IFNDEF VER40}
- writeln ('The allocated size is ', ALLSIZFN(fname), ' bytes');
- {$ENDIF}
- end
- else
- writeln ('File ', fname, ' does not exist');
- end; (* test6 *)
-
- (* Get the entire command line, spaces and all *)
- procedure TEST7;
- begin
- writeln;
- writeln ('Command line = ', CMDLNFN);
- writeln;
- end; (* test7 *)
-
- (* Main program *)
- begin
- LOGO;
- BORDER(5);
- TEST7;
- TEST1;
- TEST2;
- TEST5;
- TEST6;
- write ('Press <═╝'); readln;
- BORDER(0);
- end. (* tsunte.tst *)
-