|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 8320 (0x2080)
Types: TextFile
Names: »CR.L1«, »CRTEST.L1«
└─⟦811637d18⟧ Bits:30005383 Microsoft COBOL-80 v4.01
└─ ⟦this⟧ »CR.L1«
└─ ⟦this⟧ »CRTEST.L1«
\f Microsoft COBOL-80 V4.01.. CRTEST COB 3-Oct-80 PAGE 1 1 IDENTIFICATION DIVISION. 2 PROGRAM-ID. CRTEST. 3 4 THIS PROGRAM TESTS THE FUNCTIONS OF THE 5 CRT DRIVERS USED WITH COBOL-80. 6 7 AUTHOR. MICROSOFT. 8 DATE-WRITTEN. 01 JUNE 1980. 9 SECURITY. NONE. 10 11 ENVIRONMENT DIVISION. 12 13 DATA DIVISION. 14 WORKING-STORAGE SECTION. 15 01 ACCEPT-FIELDS. 16 03 IN-FIELD PIC X(6). 17 03 IN-CHAR PIC X. 18 03 ESC-CODE PIC 99. 19 20 SCREEN SECTION. 21 01 BLINK-SCREEN. 22 03 BLANK SCREEN 23 VALUE "HIGHLIGHT ($HILIT/$LOLIT) TEST.". 24 03 LINE 3 BLINK 25 VALUE "THIS MESSAGE SHOULD BE HIGHLIGHTED.". 26 03 COLUMN 40 27 VALUE "THIS SHOULD BE IN NORMAL VIDEO.". 28 29 01 BLANK-LINE-SCREEN. 30 03 LINE 10 PIC X(80) FROM ALL "X". 31 03 LINE 11 PIC X(80) FROM ALL "X". 32 03 LINE 12 PIC X(80) FROM ALL "X". 33 03 LINE 13 PIC X(80) FROM ALL "X". 34 03 LINE 14 PIC X(80) FROM ALL "X". 35 36 03 LINE 11 COLUMN 20 BLANK LINE 37 VALUE "B". 38 03 LINE 12 COLUMN 40 BLANK LINE 39 VALUE "B". 40 03 LINE 13 COLUMN 60 BLANK LINE 41 VALUE "B". 42 43 PROCEDURE DIVISION. 44 MAIN. 45 PERFORM INITIAL-SCREEN. 46 PERFORM ERASE-TEST. 47 PERFORM POSITION-TEST. 48 PERFORM TERMINATOR-TEST. 49 PERFORM EDIT-TEST. 50 PERFORM ALARM-TEST. 51 PERFORM BLINK-TEST. 52 PERFORM BLANK-LINE-TEST. 53 54 DISPLAY (23, 1) "END OF TESTS.". 55 DISPLAY " ". \f Microsoft COBOL-80 V4.01.. CRTEST COB 3-Oct-80 PAGE 2 56 57 STOP RUN. 58 59 60 61 62 63 INITIAL-SCREEN. 64 DISPLAY " ". 65 DISPLAY " +++++ CRTEST +++++". 66 DISPLAY " ". 67 DISPLAY " THIS PROGRAM TESTS THE CRT DRIVER". 68 DISPLAY " (24 BY 80 DISPLAY ASSUMED)". 69 DISPLAY " ". 70 DISPLAY " ". 71 72 73 74 ERASE-TEST. 75 DISPLAY "**********************************". 76 DISPLAY " ". 77 DISPLAY "* CURSOR POSITION AND ERASE TEST *". 78 DISPLAY " ". 79 DISPLAY "FIRST, LINES 12-24 OF THE". 80 DISPLAY "SCREEN SHOULD BE ERASED. THEN" 81 DISPLAY "THE CURSOR SHOULD HOME (TO THE" 82 DISPLAY "TOP LEFT CORNER) AND THE FULL" 83 DISPLAY "SCREEN SHOULD BE ERASED." 84 85 PERFORM DELAY 10000 TIMES. 86 DISPLAY (12, 1) ERASE. 87 PERFORM DELAY 5000 TIMES. 88 DISPLAY ( 1, 1) ERASE. 89 90 PERFORM WAIT-FOR-INPUT. 91 92 93 94 95 POSITION-TEST. 96 DISPLAY ( 1, 2) "* GENERAL CURSOR POSITION TEST *". 97 DISPLAY ( 2, 1) " ". 98 DISPLAY ( 3, 1) "THIS TEST DISPLAYS TEXT IN THE" 99 DISPLAY ( 4, 1) "POSITIONS DESCRIBED BY THE" 100 DISPLAY ( 5, 1) "TEXT ITSELF." 101 102 PERFORM DELAY 5000 TIMES. 103 DISPLAY ( 1, 1) ERASE. 104 PERFORM DELAY 10 TIMES. 105 DISPLAY ( 1, 1) "TOP LEFT CORNER". 106 DISPLAY (24, 61) "BOTTOM RIGHT CORNER". 107 DISPLAY ( 1, 65) "TOP RIGHT CORNER". 108 DISPLAY (24, 1) "BOTTOM LEFT CORNER". 109 DISPLAY (12, 30) "CENTER (MORE OR LESS)". 110 DISPLAY ( 1, 35) "TOP CENTER". \f Microsoft COBOL-80 V4.01.. CRTEST COB 3-Oct-80 PAGE 3 111 DISPLAY (24, 34) "BOTTOM CENTER". 112 DISPLAY (12, 1) "LEFT CENTER". 113 DISPLAY (12, 69) "RIGHT CENTER". 114 115 PERFORM WAIT-FOR-INPUT. 116 117 118 119 120 TERMINATOR-TEST. 121 DISPLAY (1, 1) ERASE 122 " * TERMINATOR KEY ($TLIST, $FLIST) TEST *". 123 124 DISPLAY (3, 1) "THIS TESTS WHETHER THE TERMINATOR " 125 "AND FUNCTION KEYS ARE RECOGNIZED CORRECTLY.". 126 127 DISPLAY (5, 1) "EACH TIME THE PROMPT IS GIVEN, ENTER " 128 "ONE OF THE KEYS FROM $TLIST OR $FLIST.". 129 DISPLAY (6, 1) "THIS PROGRAM WILL RESPOND WITH THE " 130 "ESCAPE CODE FOR THAT KEY.". 131 132 DISPLAY (8, 1) "THE TEST WILL TERMINATE WHEN YOU ENTER " 133 "ANY NON-SPACE KEY BEFORE THE TERMINATOR.". 134 135 MOVE SPACE TO IN-CHAR. 136 PERFORM GET-TERMINATOR 137 UNTIL IN-CHAR NOT = SPACE. 138 139 GET-TERMINATOR. 140 DISPLAY (11, 1) ERASE. 141 DISPLAY (10, 1) "ENTER TERMINATOR KEY: ". 142 ACCEPT (, ) IN-CHAR WITH PROMPT. 143 ACCEPT ESC-CODE FROM ESCAPE KEY. 144 DISPLAY (11, 1) "ESCAPE CODE IS " ESC-CODE. 145 PERFORM DELAY 2000 TIMES. 146 147 148 149 150 151 EDIT-TEST. 152 DISPLAY (1, 1) ERASE 153 " * EDIT KEY ($CLIST, $CURBK) TEST *". 154 155 DISPLAY (3, 1) "THE FOLLOWING ABBREVIATIONS ARE USED " 156 "TO REPRESENT THE EDITING KEYS:". 157 DISPLAY (5, 10) "ÆLDÅ = LINE (FIELD) DELETE KEY" 158 (6, 10) "ÆCDÅ = CHARACTER DELETE KEY" 159 (7, 10) "ÆBSÅ = BACKSPACE KEY" 160 (8, 10) "ÆFSÅ = FORWARD SPACE KEY". 161 162 DISPLAY (10, 1) "ENTER ABCDEÆLDÅ+-XXXÆCDÅ" 163 "ÆBSÅÆBSÅWÆFSÅYZ ". 164 165 MOVE SPACES TO IN-FIELD. \f Microsoft COBOL-80 V4.01.. CRTEST COB 3-Oct-80 PAGE 4 166 ACCEPT (, ) IN-FIELD. 167 IF IN-FIELD NOT = "+-WXYZ" 168 DISPLAY (15, 1) "*** RESULT WAS " IN-FIELD 169 DISPLAY (16, 1) "SHOULD HAVE BEEN +-WXYZ" 170 ELSE DISPLAY (15, 1) "RESULT WAS CORRECT.". 171 172 PERFORM WAIT-FOR-INPUT. 173 174 175 176 ALARM-TEST. 177 DISPLAY (1, 1) ERASE " * ALARM ($ALARM) TEST *". 178 179 DISPLAY (3, 1) "THE AUDIBLE TONE SHOULD SOUND " 180 "WHEN THIS MESSAGE IS PRINTED.". 181 182 DISPLAY (5, 1) "TYPE ANY CHARACTER TO CONTINUE.". 183 184 ACCEPT (, ) IN-CHAR WITH AUTO-SKIP BEEP. 185 186 187 188 189 BLINK-TEST. 190 DISPLAY BLINK-SCREEN. 191 PERFORM WAIT-FOR-INPUT. 192 193 194 195 196 197 BLANK-LINE-TEST. 198 DISPLAY (1, 1) ERASE " * BLANK LINE ($EOL) TEST *". 199 200 DISPLAY (3, 1) "LINES 10-14 WILL BE FILLED WITH X.". 201 DISPLAY (4, 1) "THEN LINES 11-13 SHOULD BE BLANKED " 202 "FOLLOWING THE 'B' CHARACTER.". 203 204 DISPLAY BLANK-LINE-SCREEN. 205 PERFORM WAIT-FOR-INPUT. 206 207 208 209 210 211 DELAY. 212 213 214 WAIT-FOR-INPUT. 215 DISPLAY (20, 1) "TYPE ANY CHARACTER TO CONTINUE ". 216 ACCEPT (, ) IN-CHAR WITH AUTO-SKIP. «eof»