mirror of
https://github.com/wwarthen/RomWBW.git
synced 2026-02-06 14:11:48 -06:00
218 lines
6.9 KiB
COBOL
218 lines
6.9 KiB
COBOL
00100 IDENTIFICATION DIVISION.
|
||
00200 PROGRAM-ID. CRTEST.
|
||
00300
|
||
00400 THIS PROGRAM TESTS THE FUNCTIONS OF THE
|
||
00500 CRT DRIVERS USED WITH COBOL-80.
|
||
00600
|
||
00700 AUTHOR. MICROSOFT.
|
||
00800 DATE-WRITTEN. 01 JUNE 1980.
|
||
00900 SECURITY. NONE.
|
||
01000
|
||
01100 ENVIRONMENT DIVISION.
|
||
01200
|
||
01300 DATA DIVISION.
|
||
01400 WORKING-STORAGE SECTION.
|
||
01500 01 ACCEPT-FIELDS.
|
||
01600 03 IN-FIELD PIC X(6).
|
||
01700 03 IN-CHAR PIC X.
|
||
01800 03 ESC-CODE PIC 99.
|
||
01900
|
||
02000 SCREEN SECTION.
|
||
02100 01 BLINK-SCREEN.
|
||
02200 03 BLANK SCREEN
|
||
02300 VALUE "HIGHLIGHT ($HILIT/$LOLIT) TEST.".
|
||
02400 03 LINE 3 BLINK
|
||
02500 VALUE "THIS MESSAGE SHOULD BE HIGHLIGHTED.".
|
||
02600 03 COLUMN 40
|
||
02700 VALUE "THIS SHOULD BE IN NORMAL VIDEO.".
|
||
02800
|
||
02900 01 BLANK-LINE-SCREEN.
|
||
03000 03 LINE 10 PIC X(80) FROM ALL "X".
|
||
03100 03 LINE 11 PIC X(80) FROM ALL "X".
|
||
03200 03 LINE 12 PIC X(80) FROM ALL "X".
|
||
03300 03 LINE 13 PIC X(80) FROM ALL "X".
|
||
03400 03 LINE 14 PIC X(80) FROM ALL "X".
|
||
03500
|
||
03600 03 LINE 11 COLUMN 20 BLANK LINE
|
||
03700 VALUE "B".
|
||
03800 03 LINE 12 COLUMN 40 BLANK LINE
|
||
03900 VALUE "B".
|
||
04000 03 LINE 13 COLUMN 60 BLANK LINE
|
||
04100 VALUE "B".
|
||
04200
|
||
04300 PROCEDURE DIVISION.
|
||
04400 MAIN.
|
||
04500 PERFORM INITIAL-SCREEN.
|
||
04600 PERFORM ERASE-TEST.
|
||
04700 PERFORM POSITION-TEST.
|
||
04800 PERFORM TERMINATOR-TEST.
|
||
04900 PERFORM EDIT-TEST.
|
||
05000 PERFORM ALARM-TEST.
|
||
05100 PERFORM BLINK-TEST.
|
||
05200 PERFORM BLANK-LINE-TEST.
|
||
05300
|
||
05400 DISPLAY (23, 1) "END OF TESTS.".
|
||
05500 DISPLAY " ".
|
||
05600
|
||
05700 STOP RUN.
|
||
05800
|
||
05900
|
||
06000
|
||
06100
|
||
06200
|
||
06300 INITIAL-SCREEN.
|
||
06400 DISPLAY "THIS PROGRAM TESTS THE CRT DRIVER.".
|
||
06500 DISPLAY "IF YOUR TERMINAL HAS THE ABILITY TO"
|
||
06600 DISPLAY "TURN THE CURSOR ON AND OFF, THEN"
|
||
06700 DISPLAY "YOU SHOULD SEE THE CURSOR STAY ON"
|
||
06800 DISPLAY "THE SCREEN ONLY WHEN ASKED TO ENTER"
|
||
06900 DISPLAY "DATA."
|
||
07000 DISPLAY " ".
|
||
07100 DISPLAY "A 24 BY 80 DISPLAY IS ASSUMED.".
|
||
07200 DISPLAY " ".
|
||
07300
|
||
07400
|
||
07500
|
||
07600 ERASE-TEST.
|
||
07700 DISPLAY "*****************************************".
|
||
07800 DISPLAY " ".
|
||
07900 DISPLAY "CURSOR POSITION AND ERASE TEST.".
|
||
08000 DISPLAY "FIRST, LINES 12-24 OF THE".
|
||
08100 DISPLAY "SCREEN SHOULD BE ERASED. THEN"
|
||
08200 DISPLAY "THE CURSOR SHOULD HOME (TO THE"
|
||
08300 DISPLAY "TOP LEFT CORNER) AND THE FULL"
|
||
08400 DISPLAY "SCREEN SHOULD BE ERASED."
|
||
08500
|
||
08600 PERFORM DELAY 10000 TIMES.
|
||
08700 DISPLAY (12, 1) ERASE.
|
||
08800 PERFORM DELAY 5000 TIMES.
|
||
08900 DISPLAY ( 1, 1) ERASE.
|
||
09000
|
||
09100 PERFORM WAIT-FOR-INPUT.
|
||
09200
|
||
09300
|
||
09400
|
||
09500
|
||
09600 POSITION-TEST.
|
||
09700 DISPLAY ( 1, 1) "GENERAL CURSOR POSITION TEST.".
|
||
09800 DISPLAY ( 2, 1) "THIS TEST DISPLAYS TEXT IN THE"
|
||
09900 DISPLAY ( 3, 1) "POSITIONS DESCRIBED BY THE"
|
||
10000 DISPLAY ( 4, 1) "TEXT ITSELF."
|
||
10100
|
||
10200 PERFORM DELAY 5000 TIMES.
|
||
10300 DISPLAY ( 1, 1) ERASE.
|
||
10400 PERFORM DELAY 10 TIMES.
|
||
10500 DISPLAY ( 1, 1) "TOP LEFT CORNER".
|
||
10600 DISPLAY (24, 61) "BOTTOM RIGHT CORNER".
|
||
10700 DISPLAY ( 1, 65) "TOP RIGHT CORNER".
|
||
10800 DISPLAY (24, 1) "BOTTOM LEFT CORNER".
|
||
10900 DISPLAY (12, 30) "CENTER (MORE OR LESS)".
|
||
11000 DISPLAY ( 1, 35) "TOP CENTER".
|
||
11100 DISPLAY (24, 34) "BOTTOM CENTER".
|
||
11200 DISPLAY (12, 1) "LEFT CENTER".
|
||
11300 DISPLAY (12, 69) "RIGHT CENTER".
|
||
11400
|
||
11500 PERFORM WAIT-FOR-INPUT.
|
||
11600
|
||
11700
|
||
11800
|
||
11900
|
||
12000 TERMINATOR-TEST.
|
||
12100 DISPLAY (1, 1) ERASE
|
||
12200 "TERMINATOR KEY ($TLIST, $FLIST) TEST.".
|
||
12300
|
||
12400 DISPLAY (3, 1) "THIS TESTS WHETHER THE TERMINATOR "
|
||
12500 "AND FUNCTION KEYS ARE RECOGNIZED CORRECTLY.".
|
||
12600
|
||
12700 DISPLAY (5, 1) "EACH TIME THE PROMPT IS GIVEN, ENTER "
|
||
12800 "ONE OF THE KEYS FROM $TLIST OR $FLIST.".
|
||
12900 DISPLAY (6, 1) "THIS PROGRAM WILL RESPOND WITH THE "
|
||
13000 "ESCAPE CODE FOR THAT KEY.".
|
||
13100
|
||
13200 DISPLAY (8, 1) "THE TEST WILL TERMINATE WHEN YOU ENTER "
|
||
13300 "ANY NON-SPACE KEY BEFORE THE TERMINATOR.".
|
||
13400
|
||
13500 MOVE SPACE TO IN-CHAR.
|
||
13600 PERFORM GET-TERMINATOR
|
||
13700 UNTIL IN-CHAR NOT = SPACE.
|
||
13800
|
||
13900 GET-TERMINATOR.
|
||
14000 DISPLAY (11, 1) ERASE.
|
||
14100 DISPLAY (10, 1) "ENTER TERMINATOR KEY: ".
|
||
14200 ACCEPT (, ) IN-CHAR WITH PROMPT.
|
||
14300 ACCEPT ESC-CODE FROM ESCAPE KEY.
|
||
14400 DISPLAY (11, 1) "ESCAPE CODE IS " ESC-CODE.
|
||
14500 PERFORM DELAY 2000 TIMES.
|
||
14600
|
||
14700
|
||
14800
|
||
14900
|
||
15000
|
||
15100 EDIT-TEST.
|
||
15200 DISPLAY (1, 1) ERASE
|
||
15300 "EDIT KEY ($CLIST, $CURBK) TEST.".
|
||
15400
|
||
15500 DISPLAY (3, 1) "THE FOLLOWING ABBREVIATIONS ARE USED "
|
||
15600 "TO REPRESENT THE EDITING KEYS:".
|
||
15700 DISPLAY (5, 10) "[LD] = LINE (FIELD) DELETE KEY"
|
||
15800 (6, 10) "[CD] = CHARACTER DELETE KEY"
|
||
15900 (7, 10) "[BS] = BACKSPACE KEY"
|
||
16000 (8, 10) "[FS] = FORWARD SPACE KEY".
|
||
16100
|
||
16200 DISPLAY (10, 1) "ENTER ABCDE[LD]+-XXX[CD]"
|
||
16300 "[BS][BS]W[FS]YZ ".
|
||
16400
|
||
16500 MOVE SPACES TO IN-FIELD.
|
||
16600 ACCEPT (, ) IN-FIELD.
|
||
16700 IF IN-FIELD NOT = "+-WXYZ"
|
||
16800 DISPLAY (15, 1) "*** RESULT WAS " IN-FIELD
|
||
16900 DISPLAY (16, 1) "SHOULD HAVE BEEN +-WXYZ"
|
||
17000 ELSE DISPLAY (15, 1) "RESULT WAS CORRECT.".
|
||
17100
|
||
17200 PERFORM WAIT-FOR-INPUT.
|
||
17300
|
||
17400
|
||
17500
|
||
17600 ALARM-TEST.
|
||
17700 DISPLAY (1, 1) ERASE "ALARM ($ALARM) TEST.".
|
||
17800
|
||
17900 DISPLAY (3, 1) "THE AUDIBLE TONE SHOULD SOUND "
|
||
18000 "WHEN THIS MESSAGE IS PRINTED.".
|
||
18100
|
||
18200 DISPLAY (5, 1) "TYPE ANY CHARACTER TO CONTINUE.".
|
||
18300
|
||
18400 ACCEPT (, ) IN-CHAR WITH AUTO-SKIP BEEP.
|
||
18500
|
||
18600
|
||
18700
|
||
18800
|
||
18900 BLINK-TEST.
|
||
19000 DISPLAY BLINK-SCREEN.
|
||
19100 PERFORM WAIT-FOR-INPUT.
|
||
19200
|
||
19300
|
||
19400
|
||
19500
|
||
19600
|
||
19700 BLANK-LINE-TEST.
|
||
19800 DISPLAY (1, 1) ERASE "BLANK LINE ($EOL) TEST.".
|
||
19900
|
||
20000 DISPLAY (3, 1) "LINES 10-14 WILL BE FILLED WITH X.".
|
||
20100 DISPLAY (4, 1) "THEN LINES 11-13 SHOULD BE BLANKED "
|
||
20200 "FOLLOWING THE 'B' CHARACTER.".
|
||
20300
|
||
20400 DISPLAY BLANK-LINE-SCREEN.
|
||
20500 PERFORM WAIT-FOR-INPUT.
|
||
20600
|
||
20700
|
||
20800
|
||
20900
|
||
21000
|
||
21100 DELAY.
|
||
21200 MOVE 1 TO LIN.
|
||
21300
|
||
21400
|
||
21500 WAIT-FOR-INPUT.
|
||
21600 DISPLAY (20, 1) "TYPE ANY CHARACTER TO CONTINUE ".
|
||
21700 ACCEPT (, ) IN-CHAR WITH AUTO-SKIP.
|
||
|