image of READY prompt

Wang2200.org

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"