mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
218 lines
6.9 KiB
218 lines
6.9 KiB
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.
|
|
|