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"