Listing of file='EM3275S ' on disk='vmedia/3275_v1.10.wvd.zip'
# Sector 5, program filename = 'EM3275S' 0010 REM ***** EM3275S - RELEASE #1.10-- REVISED 1536 04/28/82 ***** 0020 COM X, T$4, B1, Z$18, C2, S1$11, L2, K, M$, L1, N1, R1$(24)1 0030 COM B, M, R2$(80)1, S$(16), A$2, F$1, J$(16), P, P1, X1$1 0040 COM S, S1, L, N, A1$1, L$1, R$(16), C$(80)1, X$1, K$1 0050 COM E$(1)2, I, K$(1)1, J, F1$(1)1, A1, Q$(24,2)40, I2, A2, A0, D$1, M$(1) 1 0060 COM I$10, P$(24,2)40, C 0070 COM CLEAR 0072 SELECT #4 005, #5 215, #6 01C 0075 DATA LOAD DC OPEN T "TERM ID" 0076 DATA LOAD DC T$,Q$ 0077 IF T$ = HEX(00000000) THEN 9430 0080 GOTO 9040 0090 REM %^VARIABLE DEFINITIONS 0100 REM -------------------------------------------------- 0110 REM VARIABLE MEANING 0120 REM ----------- ----------------------------- 0130 REM A$ HEX(0000) 0140 REM A1 POINTER TO FIELD ATTRIBUTE CHARACTER 0150 REM A1$1 CURRENT AID CHARACTER 0160 REM B POINTER TO MESSAGE "KEYBOARD LOCKED" 0170 REM C POINTER TO CURSOR 0180 REM C$(80)1 LINE BUFFER AND SCRATCH ARRAY 0190 REM C2 SCRATCH VARIABLE 0200 REM E$(1)2 OUTPUT OF MAT SEARCH 0210 REM F$ "INPUT INHIBITED" FLAG 0220 REM F1$(1) CURRENT FIELD ATTRIBUTE CHARACTER 0230 REM I ROW POINTER TO CURSOR (1 - 24) 0240 REM I$10 SCRATCH VARIABLE REQUIRED BY $GIO STATEMENT 0250 REM J COLUMN POINTER TO CURSOR (1 - 80) 0260 REM J$(16) JUMP TABLE 0270 REM K INDEX USED FOR DISPLAYING CRT IMAGE 0280 REM K$ CURRENT KEYSTROKE 0290 REM K$(1)1 CHARACTER IN IMAGE AREA AT CURRENT CURSOR LOCATION 0300 REM L LENGTH (USED IN VARIOUS SUBROUTINES) 0310 REM L$1 ONE-BYTE SCRATCH VARIABLE 0320 REM L1 TEMPORARY LENGTH (USED IN VARIOUS SUBROUTINES) 0330 REM L2 TEMPORARY LENGTH (USED IN VARIOUS SUBROUTINES) 0340 REM M BEGINNING OF INSERT ZONE 0350 REM M$ "KEYBOARD LOCKED" 0360 REM N END OF INSERT ZONE 0365 REM N1 NUMBER OF FIELDS ERASED 0370 REM P$(24,2)40 CRT IMAGE (WITH UNPRINTABLE CHARACTERS) 0380 REM Q$(24,2)40 REVERSE CRT IMAGE 0390 REM R$(16) "PRINTABLE ONLY" TRANSLATION TABLE 0400 REM S$(16) LOCATE UNPROTECTED FIELDS 0410 REM R1$(24)1 ROW POSITIONING VECTOR 0420 REM R2$(80)1 COLUMN POSITIONING VECTOR 0425 REM T$3 TERMINAL ID 0430 REM X$1 HEX(80) 0440 REM %^SPECIAL KEY DEFINITIONS 0450 REM -------------------------------------------------- 0460 REM KEYS 0470 REM 3275 WANG HEX 0480 REM ---- ---- --- 0490 REM ENTER RUN .82 0500 REM RIGHT '12 f0C f4C f5C 0510 REM LEFT '13 f0D f4D f5D 0520 REM UP '11 f0B f46 f56 0530 REM DOWN '14 f0E f45 f55 0540 REM NEW LINE CARR. RET. .0D 0550 REM TAB STMT # / FN .E6 f7E f7F 0560 REM BK TAB LINE ERASE .E5 0570 REM CLEAR CLEAR / PRVSCRN .81 f42 f52 0580 REM ERASE INPUT '8 f08 0590 REM ERASE EOF '24 f18 0593 REM FIELD MARK PRINT .A0 0594 REM or FIELD MARK CONTINUE .84 0595 REM or FIELD MARK BTAB/RCALL f4F f5F 0596 REM DUP '15 f0F 0600 REM TEST REQ '31 f1F 0610 REM RESET '0 f00 0620 REM INS. MODE '10 f0A 0630 REM DELETE '9 f09 0640 REM PA1 - PA3 '1 - '3 f01-f03 0650 REM PF1 - PF4 '4 - '7 f04-f07 0660 REM PF5 - PF12 '16 - '23 f10-f17 0670 REM VERT. LINE LOAD .A1 0672 REM CENTS UP ARROW .5E (shift 6 is normal cent sign) 0673 REM UNDERLINE '25 (underline) f19 fA0 A7 0674 REM or on 2236 shift hyphen fA0 (underline) 0675 REM or on 2226 shift hyphen .A7 (PRINTUSING) 0680 REM %^MAIN LINE 0690 REM -------------------------------------------------- 0700 REM % BASIC SCAN LOOP 0710 REM - REQUEST STATUS OF CONTROLLER 0720 $GIO WHATS UP #6 (Q$,I$) C$()<1,16> : IF D$>HEX(00) THEN 730 : IF C$(4)=HEX(00) THEN 740 : D$=HEX(01) : GOSUB 1880 : GOTO 720 0730 IF C$(4) > HEX(00) THEN 740 : PRINT HEX(010D0C08080808080808080808080808080808); "LINE DOWN."; HEX(01); : D$=HEX(00) 0740 IF C$(1) > HEX(00) THEN 3350 : REM /ERROR CONDITION 0745 IF C$(3) > HEX(00) THEN 3385 : REM /SEND DATA REQUEST 0750 IF C$(2) > HEX(00) THEN 3510 : REM /READ DATA REQUEST 0755 IF P > 0 THEN 6020 0757 ON S GOTO 3390 : ON S1 GOTO 3680 0760 IF F$ = "I" THEN 4150 0770 KEYIN K$, 800, 902 : GOTO 720 : REM /SCAN KEYBOARD 0780 REM -------------------------------------------------- 0790 REM % PROCESS 'TYPEWRITER' KEY 0800 L$ = K$ 0810 $TRAN(L$,J$()) 0820 REM - COMPUTED GOTO = NORMAL, TAB, BACKSPACE, NEW LINE 0830 REM BACK TAB, CLEAR, FIELD MARK, ENTER, 0840 REM UNDERSCORE, CENTS, VERT. LINE 0860 ON VAL(L$) GOTO 1080,3020,2000,3080,5020,3260,4123,3310,3893,3683,3897 0861 REM .............01 , 02 , 03 , 04 , 05 , 06 , 07 , 08 , 09 , 0A , 0B . 0862 REM ............Norm, TAB, BSp,NwLn,BTab, Clr, FM , ENT,Undr,Cent,VLin. 0863 REM ..HexKeys...Most, E6 , 08 , 0D , E5 , 81 ,5D84, 82 , A0 , 5E , 86 . 0864 REM .08=BackSpace 0D=RETURN 5D= 0870 REM - ILLEGAL KEYSTROKE 0880 GOTO 1840 0890 REM -------------------------------------------------- 0900 REM % PROCESS SPECIAL FUNCTION KEY 0902 IF K$<HEX(20)THEN 920 0904 $TRAN(K$,HEX(01F0027E027F03460356044C045C054D055D0645065507420752084F085F 2020))R 0905 REM .01=edit 02=FN 03=up 04=right 05=left 06=down 07=PrvScrn 08=FM 0906 ON VAL(K$)GOTO 953,3020,2450,2190,2000,2230,3260,4123 0908 GOTO 1840 : REM /.Illegal keystroke 0910 REM '0 = RESET '1 = PA1 '2 = PA2 '3 = PA3 0911 REM '4 = PF1 '5 = PF2 '6 = PF3 '7 = PF4 0912 REM '8 = ERASE INP '9 = DELETE '10 = INSERT '11 = UP 0913 REM '12 = RIGHT '13 = LEFT '14 = DOWN '15 = DUP 0914 REM '16 = PF5 '17 = PF6 '18 = PF7 '19 = PF8 0915 REM '20 = PF9 '21 = PF10 '22 = PF11 '23 = PF12 0916 REM '24 = ERASE EOF'25 = UNDERLINE'26 = CENTS '27 = VERT. LINE 0917 REM '28 = NOT '29 = CHG I.D. '30 = START UP '31 = TEST REQ 0918 REM EDIT = DIAMONDS 0920 ON VAL(K$) + 1 GOTO 3920, 3800, 3840, 3880, 3750, 3750, 3750, 3750, 6420 , 5340, 4710, 2450, 2190, 2000, 2230, 4127 0930 ON VAL(K$) - 15 GOTO 3773, 3773, 3773, 3773, 3773, 3773, 3773, 3773, 614 0, 3893, 7000, 3897, 3902, 9430, 9420, 3710 0951 REM - DIAMONDS "ON/OFF" KEY. 0953 XOR (STR(R$(9),9,2),A1) 0954 XOR (STR(R$(10),9,2),A1) 0955 XOR (STR(R$(11),9,2),A1) 0956 XOR (STR(R$(12),9,2),A1) 0957 GOSUB 1880 0958 GOTO 720 0960 REM -------------------------------------------------- 0970 REM % INSERT MODE - KEYIN LOOP 0980 KEYIN K$, 1000, 1020 0985 B1 = B1 + 1 : IF B1 <= 20 THEN 980 : B1 = 0 : $GIO GET STATUS #6 (Q$,I$)C$()<1,16> : IF C$(1) > HEX(00) THEN 3350 : IF C$(2) > HEX(00) THEN 3390 0990 GOTO 980 1000 IF K$ < HEX(20) THEN 1010 : IF K$ <= HEX(7F) THEN 4280 : GOTO 980 1010 IF K$ = HEX(08) THEN 4640 : GOTO 980 1020 IF K$ = HEX(00) THEN 3920 : ON VAL(K$)-24 GOTO 1021, 1022, 1023, 1024 : GOTO 980 1021 K$ = HEX(5F) : GOTO 4280 1022 K$ = HEX(7F) : GOTO 4280 1023 K$ = HEX(5B) : GOTO 4280 1024 K$ = HEX(5D) : GOTO 4280 1030 REM -------------------------------------------------- 1040 REM % NORMAL CHARACTER 1050 REM 1060 REM - VALIDATE OPERATION 1080 IF K$(1) >= X$ THEN 1840 : REM /UPDATING A FIELD ATTRIBUTE CHARACTER? 1090 IF F1$(1) >= HEX(A0) THEN 1840 : REM /PROTECTED FIELD 1100 REM - DETERMINE TYPE OF INPUT 1110 IF F1$(1) >= HEX(90) THEN 1350 : REM /NUMERIC INPUT 1120 REM -------------------------------------------------- 1130 REM % ALPHANUMERIC DATA 1140 REM - COPY CHARACTER TO IMAGE AREA 1150 K$(1) = K$ 1160 MAT COPY K$() TO P$()<C,1> 1170 REM - FLAG THAT DATA WAS MODIFIED 1180 IF F1$(1) < X$ THEN 1220 1190 OR (F1$(1),01) 1200 MAT COPY F1$() TO P$()<A1,1> 1210 REM - WRITE CHARACTER TO SCREEN 1220 $TRAN(K$,R$()) 1225 $GIO#4(A000,I$) K$ 1230 REM % MOVE RIGHT - ENTRY POINT 1240 C = C + 1 1250 J = J + 1 1260 REM - TEST FOR END OF LINE 1270 IF J > 80 THEN 1420 1280 REM - IS CURSOR ON A FIELD ATTRIBUTE CHARACTER? 1285 IF K$(1) = HEX(1C) THEN 1315 1290 MAT COPY P$()<C,1> TO K$() 1300 IF K$(1) < HEX(80) THEN 720 1310 REM - FIND NEXT UNPROTECTED INPUT FIELD 1315 C = C - 1 1320 GOTO 3020 1330 REM -------------------------------------------------- 1340 REM % NUMERIC INPUT 1350 IF K$ = "-" THEN 1150 1360 IF K$ = "." THEN 1150 1370 IF K$ < "0" THEN 1840 1380 IF K$ > "9" THEN 1840 1390 GOTO 1150 1400 REM -------------------------------------------------- 1410 REM % START A NEW LINE 1420 J = 1 1430 I = I + 1 1440 REM - TEST FOR WRAP AROUND 1450 IF I > 24 THEN 1500 1460 $GIO#4(400D 400A,I$) 1470 MAT COPY P$()<C,1> TO K$() 1480 GOTO 1290 1490 REM - MOVE TO TOP OF SCREEN 1500 C, I = 1 1510 $GIO#4(4001,I$) 1520 MAT COPY P$()<C,1> TO K$() 1530 GOTO 1290 1540 REM -------------------------------------------------- 1550 REM % LOCATE FIELD ATTRIBUTE CHARACTER 1560 REM - GET CURRENT CHARACTER AND CURRENT FIELD ATTRIBUTE CHARACTER 1570 IF I0=1 THEN 1680 : MAT COPY P$()<C,1> TO K$() 1580 A1 = 1 : REM /DEFAULT LOCATION 1590 F1$(1) = P$(1,1) 1600 AND (F1$(1),BF) 1610 REM - SEARCH FRONT HALF OF CRT 1620 MAT COPY -P$()<1,C> TO Q$()<1,C> 1630 MAT SEARCH Q$()<1,C>, >= X$ TO E$() 1640 IF E$(1) = A$ THEN 1700 1650 A1 = C + 1 - 256*VAL(E$(1)) - VAL(STR(E$(1),2)) 1660 MAT COPY P$()<A1,1> TO F1$() 1670 AND (F1$(1),BF) 1680 ON I0+1 GOTO 720,980 : GOTO 720 1690 REM - SEARCH BACK HALF OF CRT 1700 MAT COPY -P$()<C+1,1920-C> TO Q$()<1,1920-C> 1710 MAT SEARCH Q$()<1,1920-C>, >= X$ TO E$() 1720 IF E$(1) = A$ THEN 720 1730 A1 = 1921 - 256*VAL(E$(1)) - VAL(STR(E$(1),2)) 1740 MAT COPY P$()<A1,1> TO F1$() 1750 AND (F1$(1),BF) 1760 GOTO 720 1770 REM -------------------------------------------------- 1780 REM % POSITION CURSOR 1790 $GIO#4(A000,I$) R1$()<1,I> 1800 $GIO#4(A000,I$) R2$()<1,J> 1810 RETURN 1820 REM -------------------------------------------------- 1830 REM % BEEP BEEP 1840 $GIO#4(4007,I$) : F$="I" : GOSUB 4080 : GOSUB 1790 1850 GOTO 720 1860 REM -------------------------------------------------- 1870 REM % DISPLAY CRT 1880 $GIO#4(4001,I$) 1890 FOR K = 1 TO 1761 STEP 80 1900 MAT COPY P$()<K,80> TO C$() 1910 $TRAN(C$(),R$()) 1920 $GIO#4(400D A000 400A,I$) C$() 1930 NEXT K 1940 MAT COPY P$()<1841,80> TO C$() 1950 $TRAN(C$(),R$()) 1960 $GIO#4(400D A000,I$) C$() 1963 IF F$ <> "I" THEN 1790 : IF I0=1 THEN 1790 1964 GOSUB 4080 1970 GOTO 1790 1980 REM -------------------------------------------------- 1990 REM % MOVE LEFT 2000 C = C - 1 2010 J = J - 1 2020 $GIO#4(4008,I$) 2030 REM - TEST FOR WRAP AROUND 2040 IF J <= 0 THEN 2070 2050 IF F1$(1) >= X$ THEN 1570 : GOTO 720 2060 REM - PREVIOUS ROW 2070 J = 80 2080 I = I - 1 2090 IF I = 0 THEN 2130 2100 $GIO#4(400C,I$) 2110 IF F1$(1) >= X$ THEN 1570 : GOTO 720 2120 REM - WRAP AROUND 2130 I = 24 2140 C = 1920 2150 GOSUB 1790 : REM /POSITION CURSOR 2160 IF F1$(1) >= X$ THEN 1570 : GOTO 720 2170 REM -------------------------------------------------- 2180 REM % MOVE RIGHT 2190 $GIO#4(4009,I$) 2200 GOTO 1240 2210 REM -------------------------------------------------- 2220 REM % MOVE DOWN 2230 C = C + 80 2240 IF C > 1920 THEN 2330 2250 MAT COPY -P$()<C-79,80> TO C$() 2260 I = I + 1 2270 $GIO#4(400A,I$) 2280 MAT COPY P$()<C,1> TO K$() 2290 MAT SEARCH C$(), >= X$ TO E$() 2300 IF E$(1) <> A$ THEN 2380 2310 GOTO 720 2320 REM - WRAP AROUND 2330 C = J 2340 I = 1 2350 GOSUB 1790 : REM /POSITION CURSOR 2360 GOTO 1570 2370 REM - GET NEW FIELD ATTRIBUTE CHARACTER 2380 A1 = C - 256*VAL(E$(1)) - VAL(STR(E$(1),2)) + 1 2390 MAT COPY P$()<A1,1> TO F1$() 2400 AND (F1$(1),BF) 2410 GOTO 720 2420 REM -------------------------------------------------- 2430 REM % MOVE UP 2440 REM 2450 C = C - 80 2460 IF C < 1 THEN 2510 2470 I = I - 1 2480 $GIO#4(400C,I$) 2490 GOTO 1570 2500 REM - WRAP AROUND 2510 C = 1840 + J 2520 I = 24 2530 GOSUB 1790 : REM /POSITION CURSOR 2540 GOTO 1570 2550 REM -------------------------------------------------- 2560 REM % FIND NEXT INPUT 2570 A1 = C 2580 REM - TEST FOR LAST POSITION ON CRT 2590 IF A1 = 1920 THEN 2740 2600 REM - SEARCH BACK HALF OF CRT FOR UNPROTECTED FIELD ATTRIBUTE CHARACTER 2610 MAT COPY P$()<A1+1,1920-A1> TO Q$()<1,1920-A1> 2620 $TRAN(Q$()<1,1920-A1>,S$()) 2630 MAT SEARCH Q$()<1,1920-A1>, =X$ TO E$() 2640 IF E$(1) = A$ THEN 2740 2650 A1 = A1 + 256*VAL(E$(1)) + VAL(STR(E$(1),2)) 2660 IF A1 = 1920 THEN 2910 2670 MAT COPY P$()<A1+1,1> TO K$() 2680 IF K$(1) >= X$ THEN 2590 2690 MAT COPY P$()<A1,1> TO F1$() 2700 AND (F1$(1),BF) 2710 C = A1 + 1 : I = INT((C-1)/80) + 1 : J = C - 80*I + 80 2720 RETURN 2730 REM - SEARCH FRONT HALF OF CRT FOR UNPROTECTED FIELD ATTRIBUTE CHARACTER 2740 A1 = 0 2750 MAT COPY P$()<1,C> TO Q$()<1,C> 2760 $TRAN(Q$()<1,C>,S$()) 2770 MAT SEARCH Q$()<A1+1,C-A1>, =X$ TO E$() 2780 IF E$(1) = A$ THEN 2900 2790 A1 = A1 + 256*VAL(E$(1)) + VAL(STR(E$(1),2)) 2800 IF A1 = 1920 THEN 2970 : IF A1 >= C THEN 2900 2810 MAT COPY P$()<A1+1,1> TO K$() 2820 MAT COPY P$()<A1,1> TO F1$() 2830 AND (F1$(1),BF) 2840 IF K$(1) >= X$ THEN 2770 2850 MAT COPY P$()<A1,1> TO F1$() 2860 AND (F1$(1),BF) 2870 C = A1 + 1 : I = INT((C-1)/80) + 1 : J = C - 80*I + 80 2880 RETURN 2890 REM - UNFORMATTED SCREEN 2900 A1 = 1 : F1$(1) = P$(1,1) : AND (F1$(1),BF) 2910 K$(1) = P$(1,1) 2920 IF K$(1) >= X$ THEN 2740 2930 C, I, J = 1 2940 MAT COPY P$()<A1,1> TO F1$() 2950 AND (F1$(1),BF) 2960 RETURN 2970 MAT COPY P$()<1920,1> TO F1$() 2980 AND (F1$(1),BF) 2990 GOTO 2910 3000 REM -------------------------------------------------- 3010 REM % TAB 3020 GOSUB 2570 : REM /FIND NEXT INPUT 3030 GOSUB 1790 : REM /POSITION CURSOR 3040 GOTO 720 3050 REM -------------------------------------------------- 3060 REM % NEW LINE 3070 REM - POSITION CURSOR AT END OF CURRENT LINE 3080 IF F1$(1) < X$ THEN 3150 3090 C, C2 = C - J + 79 3100 REM - FIND NEXT UNPROTECTED FIELD 3110 GOSUB 2570 3120 GOSUB 1790 3130 GOTO 720 3140 REM - UNFORMATTED SCREEN 3150 C = C - J + 81 3160 IF C > 1920 THEN 3210 3170 J = 1 3180 I = I + 1 3190 GOSUB 1790 3200 GOTO 720 3210 C, I, J = 1 3220 GOSUB 1790 3230 GOTO 720 3240 REM -------------------------------------------------- 3250 REM % CLEAR 3260 A1$ = HEX(2D) 3265 C, I, J, A1 = 1 3270 INIT(00) P$(), K$(), F1$() 3275 GOSUB 1880 3280 GOTO 4050 3290 REM -------------------------------------------------- 3300 REM % ENTER 3310 A1$ = HEX(3D) 3320 GOTO 4050 3330 REM -------------------------------------------------- 3340 REM % ERROR CONDITION 3350 PRINT HEX(030A0A0A0A0A0A); , , "ERROR CONDITION"; HEX(01); 3360 STOP 3370 REM -------------------------------------------------- 3380 REM % SEND DATA 3385 S = 1 : GOTO 720 3390 I$ = A1$ : S = 0 : REM /SET AID 3400 C2 = INT((C-1)/256) 3410 BIN(STR(I$,3,1)) = C2 3420 BIN(STR(I$,4,1)) = C - 1 - 256*C2 3430 $GIO SEND DATA #6 (4408 4000 4000 4210 4000 4230 4240 A000 4400,I$) P$() 3440 REM - SET TERMINAL STATUS BYTE IN 8080 TO "READY" 3460 REM - INITIALIZE AID BYTE 3470 A1$ = HEX(20) 3480 GOTO 720 3490 REM -------------------------------------------------- 3500 REM % READ DATA 3510 ON VAL(C$(2)) GOTO 3511, 3555 3511 $GIO READ CONSOLE DATA #6 (4404 8600 8600 8601 8602 8603 8604 C620,I$) P $() 3520 REM - POSITION CURSOR 3530 C = 256*VAL(STR(I$,3)) + VAL(STR(I$,4)) + 1 3540 I = INT((C-1)/80) + 1 3550 J = C - 80*I + 80 3551 $GIO ENABLE #6(4406 4000,I$) : GOTO 3570 3555 $GIO READ PRINTER DATA #6 (4404 8600 8600 8601 8602 8603 8604 C620,I$) Q $() : MAT COPY Q$() TO P$() : STR(R$(2),10,1)=HEX(19) : $TRAN(Q$(),R$()) : STR(R$(2),10,1)=HEX(20) : P = 1 : L$ = STR(I$,2) : ROTATE(L$,4) : AND (L$,03) : P1 = VAL(L$) 3557 PRINT HEX(010D0C08080808080808080808080808080808); " PRINTER BUSY"; HE X(01); 3560 REM - SOUND ALARM 3570 L$ = STR(I$,2) 3580 AND (L$,06) 3590 IF L$ < HEX(04) THEN 3620 3600 $GIO BEEP #4 (4007,I$) 3610 REM - RESET AID & UNLOCK KEYBOARD 3620 AND (L$,02) 3630 A1$ = " " 3640 IF L$ = HEX(00) THEN 3663 3650 F$ = " " 3663 IF C$(2) = HEX(02) THEN 720 3670 S1 = 1 3674 GOTO 720 3680 GOSUB 1880 : S1 = 0 : GOTO 1570 3681 REM -------------------------------------------------- 3682 REM % CENTS 3683 K$ = HEX(7F) 3684 GOTO 1080 3690 REM -------------------------------------------------- 3700 REM % TEST REQUEST 3710 A1$ = HEX(30) 3720 GOTO 4050 3730 REM -------------------------------------------------- 3740 REM % PF1 - PF4 3750 A1$ = K$ 3760 ADD (A1$,2D) 3770 GOTO 4050 3771 REM -------------------------------------------------- 3772 REM % PF5 - PF12 3773 A1$ = K$ 3774 ADD(A1$,25) 3775 GOTO 4050 3780 REM -------------------------------------------------- 3790 REM % PA1 3800 A1$ = HEX(2C) 3810 GOTO 4050 3820 REM -------------------------------------------------- 3830 REM % PA2 3840 A1$ = HEX(2E) 3850 GOTO 4050 3860 REM -------------------------------------------------- 3870 REM % PA3 3880 A1$ = HEX(2B) 3890 GOTO 4050 3891 REM -------------------------------------------------- 3892 REM % UNDERLINE 3893 K$ = HEX(5F) 3894 GOTO 1080 3895 REM -------------------------------------------------- 3896 REM % VERT. LINE 3897 K$ = HEX(5B) 3898 GOTO 1080 3900 REM -------------------------------------------------- 3901 REM % LOGICAL NOT 3902 K$ = HEX(5D) 3903 GOTO 1080 3904 REM -------------------------------------------------- 3910 REM % RESET 3915 DEFFN'15 3916 RETURN CLEAR 3920 F$ = " " : MAT COPY P$()<C,1> TO M$() : IF M$(1)<>HEX(5C) THEN 3930 : M$(1)=HEX(00) : MAT COPY M$() TO P$()<C,1> 3930 IF M=0 THEN 4010 : M=0 3940 IF N < C THEN 3990 : IF A2=1 THEN 4010 3960 MAT COPY Q$() TO P$()<C,L> 3970 GOTO 4010 3990 MAT COPY Q$() TO P$()<C,1921-C> 4000 MAT COPY Q$()<1922-C,L-1921+C> TO P$()<1,L-1921+C> 4010 GOSUB 1963 : F$=" " : I0=0 : GOSUB 1880 : GOTO 1570 4030 REM -------------------------------------------------- 4040 REM % REQUEST TO SEND 4050 $GIO SEND REQUEST #6 (4409 4000,I$) 4060 REM - SET INPUT INHIBITED 4070 F$ = "I" : GOSUB 4080 : ON I0+1 GOTO 720,980 : GOTO 720 4080 PRINT HEX(010D0C08080808080808080808080808080808); "KEYBOARD LOCKED."; H EX(01); : RETURN 4121 REM -------------------------------------------------- 4122 REM % FIELD MARK 4123 K$ = HEX(1E) 4124 GOTO 1080 4125 REM -------------------------------------------------- 4126 REM % DUP 4127 K$ = HEX(1C) : GOTO 1080 4130 REM -------------------------------------------------- 4140 REM % KEYBOARD LOCKED 4150 KEYIN K$, 720, 4160 : GOTO 720 4160 IF K$ = HEX(00) THEN 3920 : GOTO 720 4240 REM -------------------------------------------------- 4250 REM % INSERT MODE 4260 REM PROCESS A KEYSTROKE 4270 REM - STORE CURRENT KEYSTROKE IN CRT IMAGE AREA 4280 IF K$(1)>=X$ THEN 1840 : IF F1$(1)>=HEX(A0) THEN 1840 4281 REM - DETERMINE TYPE OF INPUT 4282 IF F1$(1)>=HEX(90) THEN 4370 4286 MAT COPY P$()<C+L-1,1> TO M$() : IF M$(1)=HEX(00) THEN 4289 : IF I2<>1 THEN 1840 4289 K$(1)=K$ 4290 MAT COPY K$() TO P$()<C,1> 4295 $GIO#4(A000,I$)K$() 4300 REM - ADVANCE CURSOR POINTERS 4310 C = C + 1 4315 L = L - 1 4320 IF C > 1920 THEN 4500 4330 J = J + 1 4340 IF J > 80 THEN 4530 4350 REM - DECREMENT NUMBER OF SPACES LEFT IN INSERT FIELD 4360 IF L>=0 THEN 4361 : L=0 4361 B=0 : IF L<>1 THEN 4362 : B=1 4362 MAT COPY P$()<C,1> TO M$() : IF M$(1)=HEX(00) THEN 4363 : IF B=1 THEN 1840 4363 ON L+1 GOTO 4625,4420 : GOTO 4380 4369 REM - NUMERIC INPUT 4370 IF K$="-" THEN 4289 : IF K$="." THEN 4289 4371 IF K$<"0" THEN 1840 : IF K$>"9" THEN 1840 : GOTO 4289 4380 MAT COPY P$()<C,1> TO M$() : IF M$(1)<>HEX(00) THEN 4381 : A2=1 : GOTO 4382 4381 MAT COPY P$()<C+L-1,1> TO M$() : IF M$(1)<>HEX(00) THEN 1840 4382 B=0 : IF A2<>1 THEN 4383 : B=1 4383 MAT COPY P$()<C,1> TO M$() : IF M$(1)=HEX(00) THEN 4384 : IF B=1 THEN 4710 4384 IF N<C THEN 4570 : IF A2=1 THEN 4420 4390 REM - COPY "REST OF INSERT AREA" TO REST OF INSERT AREA 4400 MAT COPY Q$()<1,L-1> TO P$()<C+1,L-1> 4410 REM - STORE "INSERT" SYMBOL IN INSERT AREA 4420 INIT(5C) K$() 4430 MAT COPY K$() TO P$()<C,1> 4440 MAT COPY P$()<C-J+1,80> TO C$() 4450 REM - UPDATE CRT 4460 $TRAN(C$(),R$()) 4470 $GIO#4(400D A000,I$) C$() 4480 $GIO#4(A000,I$)R2$()<1,J> 4490 IF A2<>1 THEN 4491 : I2=0 4491 IF I2=1 THEN 1840 4492 MAT COPY P$()<C+L-1,1> TO M$() : IF M$(1)=HEX(00) THEN 980 : I2=1 : GOTO 980 4500 C, I, J = 1 4510 $GIO HOME #4 (4001,I$) 4520 GOTO 4360 4530 J = 1 4540 I = I + 1 4550 $GIO LINE FEED #4 (400A,I$) 4560 GOTO 4360 4570 L1 = 1921 - C 4580 L2 = L - L1 4590 IF C = 1920 THEN 4610 4600 MAT COPY Q$()<1,L1-1> TO P$()<C+1,L1-1> 4610 MAT COPY Q$()<L1,L2-1> TO P$()<1,L2-1> 4620 GOTO 4420 4625 M = 0 4626 GOTO 3920 4630 REM % BACKSPACE 4640 IF C = M THEN 4675 4650 $GIO#4(4008,I$) : C = C - 1 : J = J - 1 : L = L + 1 : IF J >= 1 THEN 4380 4660 J = 80 : I = I - 1 : $GIO#4(400C,I$) : IF I > 0 THEN 4380 4670 I = 24 : C = 1920 : GOTO 4380 4674 REM - BEEP! BEEP! 4675 $GIO#4(4007,I$) : GOTO 980 4680 REM -------------------------------------------------- 4690 REM % INSERT MODE - ENTRY POINT 4700 REM - VALIDATE THAT INSERT CAN BE DONE 4710 I2,A2=0 : I0=1 : L$ = F1$(1) 4720 $TRAN(L$,S$()) 4730 IF L$ > X$ THEN 1840 4735 IF L$ < X$ THEN 4945 4740 IF K$(1) >= X$ THEN 1840 4750 REM - FLAG THAT DATA HAS BEEN CHANGED 4760 OR (F1$(1),01) 4770 MAT COPY F1$() TO P$()<A1,1> 4780 REM - SAVE STARTING LOCATION 4790 M = C 4800 REM - COPY IMAGE AREA TO Q$(), STARTING 4810 REM - WITH THE CURRENT CHARACTER 4820 MAT COPY P$()<C,1921-C> TO Q$()<1,1921-C> 4830 IF C = 1 THEN 4850 4840 MAT COPY P$()<1,C-1> TO Q$()<1922-C,C-1> 4850 L = 1920 4860 IF L$ < X$ THEN 4380 4870 MAT SEARCH Q$(), >= X$ TO E$() 4880 IF E$(1) = A$ THEN 4380 4890 L = 256*VAL(E$(1)) + VAL(STR(E$(1),2)) - 1 4900 N = M + L - 1 4910 IF N <= 1920 THEN 4380 4920 N = N - 1920 4930 GOTO 4380 4940 REM - UNFORMATTED SCREEN 4945 IF C = 1920 THEN 4675 4950 M = C : N = 1919 : L = 1920 - C 4955 MAT COPY P$()<C,L> TO Q$()<1,L> 4960 GOTO 4380 4980 REM -------------------------------------------------- 4990 REM % BACK TAB 5000 REM 5010 REM - SET UP FOR A BACKWARDS SEARCH 5020 IF C = 1 THEN 5040 5030 MAT COPY -P$()<1,C-1> TO Q$()<1,C-1> 5040 MAT COPY -P$()<C,1921-C> TO Q$()<C,1921-C> 5050 $TRAN(Q$(),S$()) 5060 C2 = 1 5070 MAT SEARCH Q$()<C2+1,1920-C2>, =X$ TO E$() 5080 IF E$(1) = A$ THEN 5270 5090 C2 = C2 + 256*VAL(E$(1)) + VAL(STR(E$(1),2)) 5100 MAT COPY Q$()<C2-1,1> TO K$() 5110 IF K$(1) >= X$ THEN 5260 5120 C = C - C2 + 1 5130 IF C > 0 THEN 5160 5140 C = C + 1920 5150 GOTO 5130 5160 MAT COPY P$()<C,1> TO K$() 5170 I = INT((C-1)/80) + 1 5180 J = C - 80*I + 80 5190 A1 = C - 1 5200 IF A1 > 0 THEN 5220 5210 A1 = 1920 5220 MAT COPY P$()<A1,1> TO F1$() 5230 AND (F1$(1),BF) 5240 GOSUB 1790 5250 GOTO 720 5260 IF C2 < 1920 THEN 5070 5270 C, I, J, A1 = 1 5280 K$(1), F1$(1) = P$(1,1) 5290 AND (F1$(1),BF) 5300 GOSUB 1790 5310 GOTO 720 5320 REM -------------------------------------------------- 5330 REM % DELETE 5340 L$ = F1$(1) 5350 $TRAN(L$,S$()) 5360 IF L$ > X$ THEN 1840 5370 IF K$(1) >= X$ THEN 1840 5380 IF F1$(1) < X$ THEN 5530 5390 OR (F1$(1),01) 5400 MAT COPY F1$() TO P$()<A1,1> 5410 MAT SEARCH P$()<C,81-J>, >= X$ TO E$() 5420 C2 = 81-J 5430 IF E$(1) = A$ THEN 5530 5440 C2 = VAL(STR(E$(1),2)) - 1 5450 MAT COPY P$()<C+1,C2-1> TO P$()<C,C2> 5460 C$(1) = HEX(00) 5470 MAT COPY C$()<1,1> TO P$()<C+C2-1,1> 5480 MAT COPY P$()<C-J+1,80> TO C$() 5490 $TRAN(C$(),R$()) 5500 $GIO#4(400D A000,I$) C$() 5510 $GIO#4(A000,I$) R2$()<1,J> 5520 GOTO 720 5530 C2 = 81 - J 5540 GOTO 5450 6000 REM -------------------------------------------------- 6010 REM % PRINT DATA 6020 X = 40 : IF P1 = 1 THEN 6080 : X = 64 : IF P1 = 2 THEN 6080 : X = 80 : IF P1 = 3 THEN 6080 6030 X1$ = HEX(0D) : MAT SEARCH Q$()<P,1921-P>, =X1$ TO E$() : IF E$(1) = HEX(0000) THEN 6070 : X = 256*VAL(E$(1)) + VAL(STR(E$(1),2)) 6040 I$ = HEX(0400) : X1$=HEX(19) : MAT SEARCH Q$()<P,X>,=X1$ TO E$() : IF E$(1)=HEX(0000) THEN 6045 : X=256*VAL(E$(1))+VAL(STR(E$(1),2)) : F=1 6045 $GIO#5(1212 A000,I$) Q$()<P,X> : AND (STR(I$,8,1),10) : IF STR(I$,8,1) > HEX(00) THEN 6060 6050 IF F=1 THEN 6053 : P = P + X : IF P <= 1920 THEN 6055 6053 F = 0 : P = 0 : GOSUB 1880 : $GIO ENABLE RCV #6(4406 4000,I$) 6055 IF M = 0 THEN 720 : GOTO 980 6060 PRINT HEX(07030A0A0A0A0A0A0A),,"PRINTER NOT READY" : $GIO DISABLE RCV #6(4405 4000,I$) : IF M = 0 THEN 720 : GOTO 980 6070 P = 0 : GOSUB 1880 : $GIO ENABLE RCV #6(4406 4000,I$) : GOTO 6055 6080 I$ = HEX(0F00) : X1$=HEX(19) : MAT SEARCH Q$()<P,X>,=X1$ TO E$() : IF E$(1)=HEX(0000) THEN 6090 : X=256*VAL(E$(1))+VAL(STR(E$(1),2)) : F=1 6090 $GIO#5(1212 A000 400D,I$) Q$()<P,X> : AND (STR(I$,8,1),10) : IF STR(I$,8,1) > HEX(00) THEN 6060 : GOTO 6050 6105 REM -------------------------------------------------- 6110 REM % ERASE EOF 6130 REM - VALIDATE OPERATION 6140 IF K$(1) >= X$ THEN 1840 6150 IF F1$(1) >= HEX(A0) THEN 1840 6155 INIT(00) Q$(), K$() 6160 REM - CHECK FOR UNFORMATTED SCREEN 6170 IF F1$(1) < X$ THEN 6360 6172 REM - SET MODIFIED DATA BIT 6173 OR (F1$(1),01) : MAT COPY F1$() TO P$()<A1,1> 6180 REM - FIND THE LIMITING FIELD ATTRIBUTE CHARACTER 6190 IF C >= 1920 THEN 6260 6200 MAT SEARCH P$()<C+1,1920-C>, >= X$ TO E$() 6210 IF E$(1) = A$ THEN 6260 6220 N = C + 256*VAL(E$(1)) + VAL(STR(E$(1),2)) - 1 6230 MAT COPY Q$() TO P$()<C,N-C+1> 6235 REM - UPDATE CRT 6240 GOSUB 1880 6245 GOTO 720 6250 REM - FIELD ATTRIBUTE CHARACTER IS IN WRAP AROUND 6260 MAT COPY Q$() TO P$()<C,1921-C> 6270 MAT SEARCH P$()<1,C>, >= X$ TO E$() 6280 IF E$(1) > A$ THEN 6290 : PRINT HEX(03) : STOP "PGM ERROR" 6290 N = 256*VAL(E$(1)) + VAL(STR(E$(1),2)) - 1 6300 IF N = 0 THEN 6330 6310 MAT COPY Q$() TO P$()<1,N> 6320 REM - UPDATE CRT 6330 GOSUB 1880 6340 GOTO 720 6350 REM - UNFORMATTED SCREEN 6360 MAT COPY Q$() TO P$()<C,1921-C> 6370 GOSUB 1880 6380 GOTO 720 6400 REM -------------------------------------------------- 6410 REM % ERASE INPUT 6415 REM - TEST FOR UNFORMATTED SCREEN 6420 IF F1$(1) < X$ THEN 6910 6425 A1 = 0 6430 INIT(00) K$() 6435 PRINT HEX(030A) : N1 = 0 6440 REM - FIND NEXT UNPROTECTED FIELD 6450 IF A1 = 1920 THEN 6840 : MAT SEARCH P$()<A1+1,1920-A1>, >= X$ TO E$() 6460 IF E$(1) = A$ THEN 6840 : REM /FINISHED. 6470 A1 = A1 + 256*VAL(E$(1)) + VAL(STR(E$(1),2)) 6480 MAT COPY P$()<A1,1> TO F1$() 6490 AND (F1$(1),20) 6500 IF F1$(1) = HEX(00) THEN 6540 6510 IF A1 < 1920 THEN 6450 6520 GOTO 6840 6530 REM - CLEAR CURRENT FIELD 6540 N1 = N1 + 1 : PRINT HEX(0C); "ERASING FIELD #"; N1 : IF A1 = 1920 THEN 6760 : MAT SEARCH P$()<A1+1,1920-A1>, >= X$ TO E$() 6550 IF E$(1) = A$ THEN 6680 6560 L = 256*VAL(E$(1)) + VAL(STR(E$(1),2)) - 1 6570 IF L = 0 THEN 6450 6580 MAT COPY K$() TO P$()<A1+1,1> 6590 IF L = 1 THEN 6610 6600 MAT COPY P$()<A1+1,L-1> TO P$()<A1+2,L-1> 6610 MAT COPY P$()<A1,1> TO F1$() 6620 AND (F1$(1),FE) 6630 MAT COPY F1$() TO P$()<A1,1> 6640 A1 = A1 + L 6650 IF A1 < 1920 THEN 6450 6660 GOTO 6760 6670 REM - LAST FIELD ON SCREEN 6680 L = 1920 - A1 6690 IF L = 0 THEN 6760 : MAT COPY K$() TO P$()<A1+1,1> 6700 IF L = 1 THEN 6720 6710 MAT COPY P$()<A1+1,L-1> TO P$()<A1+2,L-1> 6720 MAT COPY P$()<A1,1> TO F1$() 6730 AND (F1$(1),FE) 6740 MAT COPY F1$() TO P$()<A1,1> 6750 REM - WRAP AROUND 6760 MAT SEARCH P$(), >= X$ TO E$() 6770 L = 256*VAL(E$(1)) + VAL(STR(E$(1),2)) - 1 6780 IF L = 0 THEN 6840 6790 STR(P$(1,1),1,1) = A$ 6800 IF L = 1 THEN 6840 6810 MAT COPY P$() TO P$()<2,L-1> 6830 REM - WRAP UP 6840 C = 1919 6850 REM - FIND NEXT INPUT 6860 GOSUB 2570 6870 REM - RE-DISPLAY SCREEN 6880 GOSUB 1880 6890 GOTO 720 6900 REM - UNFORMATTED SCREEN 6910 INIT(00) P$(), K$(), F1$() 6920 C, I, J, A1 = 1 6930 GOSUB 1880 6940 GOTO 720 6990 REM .S.F. '26 PRINT screen contents 7000 $GIO TOP OF FORM #5(400D400C,I$) 7010 FOR K = 1 TO 1920 STEP 80 7020 MAT COPY P$()<K,80> TO C$() 7030 $TRAN(C$(),R$()) 7040 $GIO#5(A000 400D,I$) C$() 7050 NEXT K 7060 $GIO TOP OF FORM #5(400C400D,I$) 7200 GOTO 720 9000 REM -------------------------------------------------- 9010 REM % INITIALIZATION 9020 REM 9030 REM - INITIALIZE POINTERS 9040 C, I, J = 1 : A2,I0,I2=0 9050 A1 = 1 9060 F1$(1) = P$(1,1) 9070 AND (F1$(1),BF) 9080 M$ = "KEYBOARD LOCKED." 9085 INIT(08) Z$ : STR(Z$,1,2) = HEX(010C) 9090 REM - INITIALIZE CURSOR POSITIONING VECTORS 9100 INIT(0A) R1$() 9110 INIT(01) R1$(1) 9120 INIT(09) R2$() 9130 INIT(0D) R2$(1) 9140 REM - INITIALIZE IMAGE AREAS 9150 INIT(20) R$() 9160 INIT(00) P$(), Q$() 9170 REM - INITIALIZE JUMP TABLE 9180 INIT(00) J$(), A$ 9190 INIT(01) J$(3), J$(4), J$(5), J$(6), J$(7), J$(8) 9200 J$(1) = HEX(00000000000000000300000000040000) 9210 STR(J$(4),12,1) = HEX(07) : STR(J$(6),15,1)=HEX(0A) 9220 J$(9) = HEX(0006080007000B000000000000000000) 9240 J$(11) = HEX(07000000000000090000000000000000) 9242 J$(15) = HEX(00000000000502000000000000000000) 9250 GOSUB 1880 : REM /DISPLAY CRT 9260 REM - TERMINAL ID & CONNECT 9270 S1$ = HEX(000086C64D5C4001604000) : STR(S1$,3,4) = T$ : $GIO CONNECT #6 (4401 A200 4400,I$) S1$ 9280 F$ = " " 9290 A1$ = HEX(20) 9300 REM - INITIALIZE "PRINTABLE ONLY" TRANSLATION TABLE 9305 STR(R$(1),14,1) = HEX(0D) 9310 R$(3) = HEX(202122232425262728292A2B2C2D2E2F) 9315 STR(R$(2),13,3) = "* ;" 9320 R$(4) = HEX(303132333435363738393A3B3C3D3E3F) 9330 R$(5) = HEX(404142434445464748494A4B4C4D4E4F) 9340 R$(6) = HEX(505152535455565758595A868B855EA0) 9350 R$(7) = HEX(606162636465666768696A6B6C6D6E6F) 9360 R$(8) = HEX(707172737475767778797A7B7C7D7E7F) 9370 X$ = HEX(80) 9380 INIT(31) S$(1), S$(2), S$(3), S$(4), S$(5), S$(6), S$(7), S$(8) 9390 INIT(80) S$(9), S$(10), S$(13), S$(14) 9400 INIT(81) S$(11), S$(12), S$(15), S$(16) 9410 GOTO 1570 9420 DEFFN'30 : LOAD DC T "START" 9430 DEFFN'29 : LOAD DC T "CHANGEID"