Listing of file='WSE-EMUL' on disk='vmedia/731-8011A.wvd.zip'
# Sector 30, program filename = 'WSE-EMUL'
0010 REM WSE-EMUL 10DEC86 REV 1.0A
0011 REM % (c) Copyright Wang Laboratories, Inc. 1986
0020 REM PROGRAM NAME = WSE EMULATION
0030 REM DATE OF FIRST CODE - 05 FEBRUARY 1986
0031 REM DATE OF LATEST UPDATE - 01 OCTOBER 1986 BY GES
0032 REM LINE 1385 & 1440 IF A6$<>HEX(0000000000)
0033 REM THEN PRINT A6$ - TO FIX MCS BUG
0034 REM - 29 JUNE 1986 BY NO
0036 REM DEPENDING ON A3$, EXITS TO VATTCH1 OR VDETCH1
0038 REM - 24 JUNE 1986
0040 REM 2256MWS DOES NOT SKIP TO NEXT MODIFIABLE FIEL
D
0042 REM AUTOMATICALLY AFTER CHARACTER ECHO. TAB COLUM
NS
0044 REM NOW SUPPORTED.
0046 REM - 18 JUNE 1986
0048 REM MODIFICATION TO WCC AREA TO SUPPORT ROLL UP
0050 REM - 05 MAY 1986
0052 REM FIX TO A8$() & A9$() UPDATE SUBR (LINE 3000)
0054 REM PROGRAM WS1 OF WSOBJ ON MICKEY ERR P57
0056 REM - 02 MAY 1986
0058 REM SCROLL UP AND SCROLL DOWN SUPPORT ADDED
0060 REM ERASE ALL MODIFIABLE FIELDS
0070 REM ERASE & PROTECT REST OF SCREEN
0080 REM COPY OF SCREEN (AS RECEIVED FROM VS)
0090 REM MAINTAINED IN S$()
0100 REM TAB WORKING WITH FAC (8E)
0120 REM - 04 MARCH 1986
0130 REM XLATE 00-0F TO 80-8F BEFORE DISPLAY
0140 REM IF LAST LINE <> 80 THEN NOT DISPLAYED
0160 REM - 12 FEBRUARY 1986
0170 REM UNDERLINE KEY IS THROWN AWAY
0190 REM - 11 FEBRUARY 1986
0200 REM PRINT AT ON LINE 3600 (S2=24) CAUSED SCREEN
0210 REM TO ROLL WHEN PAINTING FULL SCREEN. CHANGED
0220 REM CURSOR UP, DOWN ETC TO USE HEX VS AT()
0240 REM - 07 FEBRUARY 1986
0250 REM SOUND ALARM AND ROLL UP SUPPORT ADDED
0255 REM - MAR 03 1988
0256 REM ADDED BACKTAB SUPPORT
0260 REM FIX/P10F227710/10 Oct., '90/Ram/- Line 4010 has been changed to detec
t numeric protected field.
0261 REM Ram/10 Oct., '90/ - Insert blows WS emulation at first character
position of a line starting with numer
ic protected field.
0262 REM - Line 5452 has been changed to detect protecte
d numeric field.
0263 REM Ram/10 Oct., '90/ -Erase creates pseudo blanks in protected numer
ic field. Line 5252 has been changed to de
tect protected numeric field.
0264 REM Ram/10 Oct., '90/ -Delete highlights protected numeric field. Lin
e 5352 has been changed to fix the bug.
0270 REM FUNCTION -
0280 REM TO CONTROL THE EMULATION AFTER IT HAS BEEN STARTED OR RESUMED
0290 REM
0510 REM %========= Local Keys Procedure =====================================
=
0520 COM A$4,A$(24)80,Q1,Q2,Q3,Q4,T$(16),T1$(16),Q1$(25)80,P(2),K9$1,T5$(6)20,
T6$(1)20,A1$(10)1
0530 DIM A1$1,A2$1,W1(8),Y1$2,Y3$2,O(4),A7$1,A6$5,K8$1,B$80
0540 DIM K$1,A8$1,T2$64,S$(25)80,A8$(24,80)1,A9$(24,80)1
0550 INIT(00)Q$, Q1$()
: STR(Q$,3,2) = HEX(0003)
: INIT(20)B$
0560 REM EMULATION ACTIVE AND 1ST SCREEN HAS BEEN DISPLAYED
0570 $IF OFF #1, 1565
0580 REM IS THERE A SCREEN FOR ME?
: STR(Q$,6,1)=BIN(#PART-1) AND HEX(0F)
: $OPEN #2
: $GIO #2 (4660 8701, Q$)
: $CLOSE#2
: IF STR(Q$,1,1) = HEX(00) THEN 1565
0590 REM READY TO SEND SCREEN?
: A2$=HEX(01)
: A1$=STR(Q$,1,1) OR A2$
: IF A1$<>STR(Q$,1,1) THEN 730
0600 STR(Q$,7,1)=HEX(31)
0605 STR(Q$,6,1)=BIN(#PART-1) AND HEX(0F) OR HEX(30)
: $OPEN #2
: $GIO #2 (4660 4270 0100 0200 8B12 EFFF 8703 8704 1800 C340 01FF 0600,Q$)
STR(Q1$(),1,VAL(STR(Q$,3,2),2))
: $CLOSE#2
0610 IF STR(Q$,1,1)=HEX(00) THEN 730
0615 IF STR(Q1$(),1,1)<>HEX(80) AND STR(Q1$(),1,1)<>HEX(84) AND STR(Q1$(),1,1)
<>HEX(90) THEN 1565
0620 IF STR(Q1$(),2,2)=HEX(0000) THEN 1565
0630 A$=STR(Q1$(),4,4)
: REM SAVE ORDER AREA
: REM BYTE 1 = ROW
: REM BYTE 2 = WCC
: REM BYTE 3 = CURSOR COLUMN
: REM BYTE 4 = CURSOR ROW
0640 REM IOCW BYTE 1 = HEX(84) = WRITE TABS
: REM IOCW BYTE 1 = HEX(80) =
: REM IOCW BYTE 1 = HEX(90) =
0650 REM IOCW BYTE 2,3 = LENGTH OF DATA AREA
0660 Q1=1
: A2$=STR(Q1$(),3,1)
: STR(Q1$(),3,1)=STR(Q1$(),2,1)
: STR(Q1$(),2,1)=A2$
: Q3,Q4=VAL(STR(Q1$(),2,2),2)-4
0670 Q2 = Q3/80
: IF Q2<>INT(Q2) THEN Q2=INT(Q2)+1
0680 Q2=Q2+Q1-1
0690 IF Q3<>0 THEN STR(A$(),(Q1-1)*80+1,Q3) = STR(Q1$(),8,Q3)
: REM DATA AREA
0700 REM CHECK IF WRITE TABS(84)
: IF STR(Q1$(),1,1)<>HEX(84) THEN 1000
0710 REM WRITE TABS COMMAND
: A1$()=STR(Q1$(),8,10)
: GOTO 1565
0720 REM PROBLEM IN SCRREN COMMUNICATION BETWEEN 2258 AND THIS PROGRAM
0730 PRINT HEX(03); AT(4,0);"PROGRAM HAS EXPERIENCED A PROBLEM WITH SCREEN HAN
DSHAKING BETWEEN THE "
0740 PRINT "2258 AND THIS SOFTWARE."
0750 PRINT
: PRINT "STRIKE ANY KEY TO RETURN TO VS SERVICES MENU."
0760 KEYIN STR(Q$,1,1)
0770 LOAD RUN "VS.START"
1000 REM % MODULES WITH SCREENS - START HERE
1005 REM CONVERT NON DISPLAYABLE CHARACTERS
: T2$=HEX(80008101820283038404850586068707880889098A0A8B0B200C8D0D8E0E8F0F)
: REM $TRAN (STR(A$()),HEX(208C)) R
1010 REM % Read WCC (- Write Control Character -)
1015 MAT W1=ZER
1020 REM %- Row Number -
1030 S1=VAL(STR(A$,1,1))
: IF S1 = 0 THEN S1 = 1
: IF VAL(STR(A$,2,1))=0 THEN 1202
1040 REM % - Bit 0 - Unlock Keyboard - Lock is 0
1050 A2$=HEX(80)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1070
: W1(1)=1
: K9$=HEX(00)
1060 REM % - Bit 1 - Sound Alarm -
1070 A2$=HEX(40)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1090
: W1(2)=1
: PRINT HEX(07)
1080 REM % - Bit 2 - Position Cursor -
1090 A2$=HEX(20)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1110
1095 P(1)=VAL(STR(A$,3,1))
: P(2)=VAL(STR(A$,4,1))
: IF P(1)>79 THEN P(1)=0
: IF P(2)>23 THEN P(2)=0
1108 REM % - Bit 3 - Roll Down -
1110 A2$=HEX(10)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1130
1112 W1(4)=1
: FOR I = 24 TO S1+1 STEP -1
: IF I = 1 THEN 1113
: S$(I)=S$(I-1)
: STR(A8$(),(I-1)*80+1,80)=STR(A8$(),(I-2)*80+1,80)
: STR(A9$(),(I-1)*80+1,80)=STR(A9$(),(I-2)*80+1,80)
1113 NEXT I
: S$(S1)=ALL(" ")
: STR(A8$(),(S1-1)*80+1,80), STR(A9$(),(S1-1)*80+1,80)= ALL(HEX(00))
1116 Q1=1
: Q2 = 25-S1
: Q3=Q2*80
1118 REM IF Q3<>0 THEN STR(A$(),1,Q3) = STR(S$(),(S1-1)*80+1,Q3)
1120 REM % - Bit 4 - Roll Up -
1130 A2$=HEX(08)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1150
: W1(5)=1
1132 IF S1=24 THEN 1133
: STR(S$(),(S1-1)*80+1,(24-S1)*80)=STR(S$(),S1*80+1,(24-S1)*80)
: STR(A8$(),(S1-1)*80+1,(24-S1)*80)=STR(A8$(),S1*80+1,(24-S1)*80)
: STR(A9$(),(S1-1)*80+1,(24-S1)*80)=STR(A9$(),S1*80+1,(24-S1)*80)
1133 S$(24)=ALL(" ")
: STR(A8$(),1841,80),STR(A9$(),1841,80)=ALL(HEX(00))
1134 Q1=1
: Q2=25-S1
: Q3=Q2*80
1140 REM % - Bit 5 - Erase modifiable fields to pseudoblanks -
1150 A2$=HEX(04)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1170
1151 W1(6)=1
1152 REM FIND 1ST NO 00 CHAR, IF NONE THEN DONE
: X=POS(STR(A9$(),(S1-1)*80+1)<>HEX(00))
: IF X=0 THEN 1160
: X=X+(S1-1)*80
1154 REM FIND END OF FIELD (HEX(00)), NONE SET Y TO END
: Y=POS(STR(A9$(),X+1)=HEX(00))
: IF Y=0 THEN Y=1921-X
1156 STR(A9$(),X,Y)=ALL(HEX(8B))
: STR(S$(),X,Y)=ALL(HEX(0B))
: X=X+Y
1158 REM FIND START OF NEXT FIELD
: Y=POS(STR(A9$(),X)<>HEX(00))
: X=X+Y-1
: IF Y<>0 THEN 1154
1159 REM RE-DISPLAY SCREEN
: Q1=1
: Q2=25-S1
: Q3=Q2*80
1160 REM % - Bit 6 - Erase and protect rest of screen -
1170 A2$=HEX(02)
: A1$=STR(A$,2,1)
: A1$=OR A2$
: IF A1$<>STR(A$,2,1) THEN 1180
1172 W1(7)=1
1174 STR(S$(),(S1-1)*80+1)=ALL(HEX(20))
: STR(A8$(),(S1-1)*80+1),STR(A9$(),(S1-1)*80+1)=ALL(HEX(00))
1178 Q1=1
: Q2=25-S1
: Q3=Q2*80
1180 REM % - Bit 7 - Reserved (Must be 0) -
1200 REM UPDATE SCREEN COPY S$()
1202 IF Q2=0 THEN 1220
: IF Q4=0 THEN 1204
: IF W1(5)=1 THEN S$(24)=STR(A$(),1,80)
: ELSE STR(S$(),(S1-1)*80+1,Q4)=STR(A$(),1,Q4)
1204 Q3=INT((Q3+79)/80)*80
: STR(A$(),1,Q3)=STR(S$(),(S1-1)*80+1,Q3)
1210 REM % Analize and Paint the Mapping Area
1220 S2=S1-1
: PRINT AT(S2,0);
: N1=1
: PRINT HEX(06)
: IF Q2=0 THEN 1560
: INIT(00)STR(A8$(),((S1-1)*80)+1,Q3),STR(A9$(),((S1-1)*80)+1,Q3)
1230 FOR I=Q1 TO Q2
: SELECT PRINT 205(80)
1235 IF POS(A$(I)<>HEX(8C)) = 0 THEN A$(I) = ALL(" ")
1240 N1=1
: N2=0
: S8=0
1250 MAT SEARCH STR(A$(I),N1),<>HEX(20) TO Y1$
1260 REM %- Case ( NOFAC-NODATA-NOFAC ) Anything
1270 IF Y1$<>HEX(0000) THEN 1280
: PRINT HEX(020400000E);AT(S2,0,80);
: S2=S2+1
: NEXT I
: GOTO 1560
1280 GOSUB '115(Y1$)
: Z1=Y1
: M1=Y2
: IF Y3=0 THEN N1=1
: ELSE N1=Y3
1290 IF STR(A$(I),N1,1) >= HEX(80) THEN 1340
1295 PRINT AT(S2,N2,(N1-N2)-1);
: S8=1
1300 Y1$=HEX(0000)
: IF N1>79 THEN 1320
: MAT SEARCH STR(A$(I),N1+1),>= HEX(80) TO Y1$
1310 IF Y1$<>HEX(0000) THEN 1470
1320 REM %- Case ( NOFAC-DATA-NOFAC )
1330 IF S8=0 THEN GOSUB 3300
: PRINT HEX(020400000E)
: $TRAN(STR(A$(I),N1,81-N1),T2$)R
: PRINT AT(S2,N1-1);STR(A$(I),N1,81-N1);
: S2=S2+1
: NEXT I
: GOTO 1560
1340 REM %- Case ( FAC-DATA-FAC )
1350 GOSUB 1655
1360 Y1$=HEX(0000)
: IF N1>79 THEN 1430
: MAT SEARCH STR(A$(I),N1+1),>=HEX(80) TO Y1$
1370 GOSUB '115(Y1$)
: Z2=Y1+Z1
: M2=Y2
: N2=Y3+N1
1380 IF Y1$=HEX(0000) THEN 1430
1385 GOSUB 1510
: GOSUB 3000
: IF A6$<>HEX(0000000000) THEN PRINT A6$;
: IF O(4)<>4 AND O(4)<>8 THEN 1390
: STR(A$(I),N1,N2-N1)=STR(B$,N1,N2-N1)
1390 IF S8=0 THEN GOSUB 3300
: $TRAN(STR(A$(I),N1,N2-N1),T2$)R
: PRINT AT(S2,N1-1);STR(A$(I),N1,N2-N1);
: PRINT HEX(020400000E);
: Z1=Z2
: N1=N2
: GOTO 1340
1430 REM %- Case ( FAC-DATA-NOFAC )
: N2=81
1440 GOSUB 1510
: GOSUB 3000
: IF A6$<>HEX(0000000000) THEN PRINT A6$;
1443 IF O(4)<>4 AND O(4)<>8 THEN 1450
: STR(A$(I),N1,80-N1+1)=STR(B$,N1,80-N1+1)
1450 IF S8=0 THEN GOSUB 3300
: $TRAN(STR(A$(I),N1),T2$)R
: PRINT AT(S2,N1-1);STR(A$(I),N1);
1465 PRINT HEX(020400000E);
: S2=S2+1
: NEXT I
: GOTO 1560
1470 REM %- Case ( NOFAC-DATA-FAC )
1480 GOSUB '115(Y1$)
: Z2=Y1+Z1
: M2=Y2
: N2=Y3+N1
1490 IF S8=0 THEN GOSUB 3300
: PRINT HEX(020400000E)
: $TRAN(STR(A$(I),N1,N2-N1),T2$)R
: PRINT AT(S2,N1-1);STR(A$(I),N1,N2-N1);
1500 Z1=Z2
: M1=M2
: N1=N2
: GOTO 1340
1510 REM %- Translate printables characters -
1520 $TRAN(STR(A$(I),N1,N2-N1),HEX(8B0B))R
1540 STR(A$(I),N1,1) = HEX(20)
1550 RETURN
1560 REM END OF DISPLAY, RE-POSITION CURSOR AND CHECK FOR INPUT FROM KEYBOARD
: IF P(1)<0 THEN P(1)=0
: PRINT AT(P(2),P(1));HEX(02050E);
1565 $IF OFF /001, 1615
: S0=0
: IF K9$=HEX(00) THEN 1575
1567 REM LOOK FOR EXIT OR HELP ONLY
: KEYIN K$,,1568
: IF K$=HEX(84) THEN 1595
: PRINT HEX(07)
: GOTO 550
1568 IF K$=HEX(F0) THEN 2245
: PRINT HEX(07)
: GOTO 550
1575 KEYIN K$,1595,1625
1585 GOTO 550
1595 REM NORMAL KEY, TRANSLATE TO A SCAN CODE AND SEND TO VS
1600 IF K$<>HEX(FF) THEN 1602
: K8$=HEX(5F)
: KEYIN K$
: K$=K8$
1602 K8$=K$
: GOSUB 4000
: IF S0<>0 THEN 550
1605 A1$=K$
: IF K$=HEX(0D) OR K$=HEX(84) THEN K9$=HEX(01)
: $TRAN (K$,T$())
1607 IF A1$=HEX(84) THEN A1$=HEX(00)
1608 IF Y9<>0 AND K$=HEX(6F) THEN 1618
1609 STR(Q$,6,1)=BIN(#PART-1) AND HEX(0F) OR HEX(10)
: STR(Q$,7,1) = K$
: $OPEN #2
: $GIO #2 (0100 4660 8702 1C12 DFFF 01FF 4270 0600,Q$)
: $CLOSE#2
1610 IF STR(Q$,1,1)<>HEX(FF) THEN 1618
: IF STR(Q$,2,1)<HEX(80) THEN 1618
1615 $BREAK
: GOTO 550
1616 REM PROBLEM WITH KEYSTROKE HANDLING
1618 PRINT HEX(03); AT(4,0);"PROGRAM IS UNABLE TO TRANSMIT KEYSTROKE."
1620 GOTO 750
1625 REM SPECIAL FUNCTION KEY
1630 K8$=K$
: GOSUB 4100
: IF S0=0 THEN 1635
: PRINT HEX(07);
: GOTO 550
1635 IF K$ = HEX(F0) THEN 2245
: IF VAL(K8$)<>6 THEN 1640
: K9$=HEX(02)
1640 A1$=K$
: $TRAN (K$, T1$())
1645 GOTO 1608
1655 REM ========= FAC Table =================================================
=
1657 IF VAL(STR(A$(I),N1,1))<191 THEN 1665
: STR(A$(I),N1,1)=STR(A$(I),N1,1) SUBC HEX(40)
1665 ON VAL(STR(A$(I),N1,1))-127 GOSUB 1675,1685,1695,,1705,1715,1725,,1735,17
45,1755,,1765,1775,1785,,1795,1805,1815,,1825,1835,1845,,1855,1865,1875,,
1885,1895,1905,,1915,1925,1935,,1945,1955,1965,,1975,1985,1995,,2005,2015
,2025,,2035,2045,2055,,2065,2075,2085,,2095,2105,2115,,2125,2135,2145,215
5
: RETURN
1675 A6$=HEX(020402000E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=2
: RETURN
1685 A6$=HEX(020402000E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=2
: RETURN
1695 A6$=HEX(020402000E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=2
: RETURN
1705 A6$=HEX(020402000E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=2
: RETURN
1715 A6$=HEX(020402000E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=2
: RETURN
1725 A6$=HEX(020402000E)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=2
: RETURN
1735 A6$=HEX(020400000E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=1
: RETURN
1745 A6$=HEX(020400000E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=1
: RETURN
1755 A6$=HEX(020400000E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=1
: RETURN
1765 A6$=HEX(020400000E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=1
: RETURN
1775 A6$=HEX(020400000E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=1
: RETURN
1785 A6$=HEX(020400000E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=1
: RETURN
1795 A6$=HEX(02040B000E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=3
: RETURN
1805 A6$=HEX(02040B000E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=3
: RETURN
1815 A6$=HEX(02040B000E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=3
: RETURN
1825 A6$=HEX(02040B000E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=3
: RETURN
1835 A6$=HEX(02040B000E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=3
: RETURN
1845 A6$=HEX(02040B000E)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=3
: RETURN
1855 A6$=HEX(0000000000)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=4
: RETURN
1865 A6$=HEX(0000000000)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=4
: RETURN
1875 A6$=HEX(0000000000)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=4
: RETURN
1885 A6$=HEX(0000000000)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=4
: RETURN
1895 A6$=HEX(0000000000)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=4
: RETURN
1905 A6$=HEX(0000000000)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=4
: RETURN
1915 A6$=HEX(020402040E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=6
: RETURN
1925 A6$=HEX(020402040E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=6
: RETURN
1935 A6$=HEX(020402040E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=6
: RETURN
1945 A6$=HEX(020402040E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=6
: RETURN
1955 A6$=HEX(020402040E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=6
: RETURN
1965 A6$=HEX(020402040E)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=6
: RETURN
1975 A6$=HEX(020400040E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=5
: RETURN
1985 A6$=HEX(020400040E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=5
: RETURN
1995 A6$=HEX(020400040E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=5
: RETURN
2005 A6$=HEX(020400040E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=5
: RETURN
2015 A6$=HEX(020400040E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=5
: RETURN
2025 A6$=HEX(020400040E)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=5
: RETURN
2035 A6$=HEX(02040B040E)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=7
: RETURN
2045 A6$=HEX(02040B040E)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=7
: RETURN
2055 A6$=HEX(02040B040E)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=7
: RETURN
2065 A6$=HEX(02040B040E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=7
: RETURN
2075 A6$=HEX(02040B040E)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=7
: RETURN
2085 A6$=HEX(02040B040E)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=7
: RETURN
2095 A6$=HEX(0100000000)
: O(1)=1
: O(2)=1
: O(3)=0
: O(4)=8
: RETURN
2105 A6$=HEX(0100000000)
: O(1)=1
: O(2)=2
: O(3)=0
: O(4)=8
: RETURN
2115 A6$=HEX(0100000000)
: O(1)=1
: O(2)=3
: O(3)=0
: O(4)=8
: RETURN
2125 A6$=HEX(0100000000)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=8
: RETURN
2135 A6$=HEX(0100000000)
: O(1)=0
: O(2)=2
: O(3)=0
: O(4)=8
: RETURN
2145 A6$=HEX(0100000000)
: O(1)=0
: O(2)=3
: O(3)=0
: O(4)=8
: RETURN
2155 A6$=HEX(020400000E)
: O(1)=0
: O(2)=1
: O(3)=0
: O(4)=1
: RETURN
2165 RETURN
2175 REM %- Convert to phisical position and x and y in the screen -
2185 DEFFN '115(Y1$)
2195 Y1=VAL(STR(Y1$,1,1))*(16^2)
: Y1=Y1+VAL(STR(Y1$,2,1))
2205 Y2=Y1
: Y2=(Y2/80)
: Y3=Y2-INT(Y2)
: Y3=Y3*80
: Y2=INT(Y2)
: Y3=INT(Y3)
: RETURN
2215 DEFFN'31"SCRATCH T";HEX(22);"WSE-EMUL";HEX(22);":SAVET()";HEX(22);"WSE-EM
UL";HEX(22)
2225 DEFFN'01"LIST S";HEX(0D)
2235 DEFFN'0"LIST SD1200,";HEX(0D)
2245 REM EXIT FROM EMULATION, SUSPEND EMULATION THEN PRESENT MENU
2250 STR(Q$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(30)
2260 STR(Q$,7,1) = HEX(33)
2270 $OPEN #2
: $GIO #2 (4660 4270 8701, Q$)
: $CLOSE#2
2282 IF A3$="A" THEN 2290
: IF A3$="D" THEN 2295
2285 REM LOAD EXIT MENU
: $PSTAT=".WSE3"
: LOAD T "@VSMENU"
2290 LOAD T "VATTCH1"
2295 LOAD T "VDETCH1"
2490 REM AWAITING SCREEN FROM VS
2500 REM NOT IMPLEMENTED YET - WAIT FOR EVER
: GOTO 1615
3000 REM %- Upadate Arrays A8$() and A9$() for Keyboard Control -
3005 IF O(1)=0 THEN RETURN
3007 IF N1=80 THEN N1=79
3015 A8$=HEX(00)
3017 A2$=BIN(O(4))
: ADDC (A8$,A2$)
: A2$=BIN(O(2)*16)
: ADDC (A8$,A2$)
3020 IF N2=N1+1 THEN RETURN
3085 STR(A8$(),S2*80+N1+1,N2-N1-1)=ALL(A8$)
: STR(A9$(),S2*80+N1+1,N2-N1-1)= STR(A$(),(I-1)*80+N1+1,N2-N1-1)
: RETURN
3300 REM *** CLEAN UP THE GARBAGE AT FIRST OF THE LINE ***
3305 PRINT HEX(020400000E);
: PRINT AT(S2,0);STR(B$,1,N1);
: PRINT A6$;
: S8=1
: RETURN
3320 REM *** GET ATTRIBUTE FROM A8$ ***
3321 A7$=A8$ AND HEX(F0)
3322 ON VAL(A7$) GOTO 3323,3324,3325,3326,3327,3328,3329,3330
3323 PRINT HEX(020402000E);
: RETURN
3324 PRINT HEX(020400000E);
: RETURN
3325 PRINT HEX(02040B000E);
: RETURN
3326 PRINT HEX(020400000E);
: RETURN
3327 PRINT HEX(020402040E);
: RETURN
3328 PRINT HEX(020400040E);
: RETURN
3329 PRINT HEX(02040B040E);
: RETURN
3330 PRINT HEX(020400000E);
: RETURN
4000 REM *** PROCEDURE IN NORMAL KEY ***
4005 IF K$<>HEX(5F) THEN 4010
: K8$=HEX(07)
: GOTO 4030
4010 IF K$<HEX(20) OR K$>HEX(7A) THEN 4015
: IF A8$(P(2)+1,P(1)+1)=HEX(31) THEN RETURN
: K8$=HEX(05)
: GOTO 4030
4015 IF K$=HEX(E5) THEN 4100
: K8$=K$
4020 $TRAN(K8$,T6$())R
4030 ON VAL(K8$) GOSUB 5010,5030,5050,5070,5090,5150,5170,5190,5250,5350,5450,
5500
: RETURN
4100 REM *** PROCEDURE IN SPECIAL KEY ***
4103 K8$=K$
4105 $TRAN(K8$,T5$())R
4110 IF K8$>HEX(0D) THEN K8$=HEX(07)
4120 ON VAL(K8$) GOSUB 5010,5030,5050,5070,5090,5150,5170,5190,5250,5350,5450,
5500,6560
: RETURN
5010 REM *** CURSOR UP *** Case '01'
5012 IF P(2)=0 THEN P(2)=24
: P(2)=P(2)-1
: PRINT HEX(0C);
: RETURN
5030 REM *** CURSOR DOWN *** Case '02'
5032 IF P(2)=23 THEN 5034
: P(2)=P(2)+1
: PRINT HEX(0A);
: RETURN
5034 P(2)=0
: PRINT AT(P(2),P(1));
: RETURN
5050 REM *** CURSOR LEFT *** Case '03'
5052 IF P(1)=0 THEN 5054
: P(1)=P(1)-1
: PRINT HEX(08);
: RETURN
5054 P(1)=79
: IF P(2)=0 THEN P(2)=24
: P(2)=P(2)-1
: PRINT AT(P(2),P(1));
: RETURN
5070 REM *** CURSOR RIGHT *** Case '04'
5072 IF P(1)=79 THEN 5074
: P(1)=P(1)+1
: PRINT HEX(09);
: RETURN
5074 P(1)=0
: IF P(2)=23 THEN P(2)=-1
: P(2)=P(2)+1
: PRINT AT(P(2),P(1));
: RETURN
5090 REM *** BASIC ASCII CHARACTERS . HEX(20) THRU HEX(7A) *** Case '05'
5091 REM IS CURRENT CURSOR POSITION MODIFIABLE
: IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 5092
: REM NO! - FIND NEXT
: P9=0
: GOSUB 6800
: IF S0=0 THEN 5092
: S0=1
: PRINT HEX(07);
: RETURN
5092 A7$=A8$(P(2)+1,P(1)+1) AND HEX(30)
5093 IF A7$=HEX(10) OR K$=HEX(20) THEN 5100
: IF A7$<>HEX(20) THEN 5095
: IF K$>=HEX(20) AND K$<=HEX(7A) THEN 5100
: S0=1
: RETURN
5095 IF K$<HEX(30) OR K$>HEX(39) THEN RETURN
5100 A7$=A8$(P(2)+1,P(1)+1) AND HEX(0F)
5105 ON VAL(A7$) GOTO 5106,5107,5108,5109,5110,5111,5112,5113
5106 PRINT HEX(020400000E);
: GOTO 5115
5107 PRINT HEX(020402000E);
: GOTO 5115
5108 PRINT HEX(02040B000E);
: GOTO 5115
5109 PRINT HEX(020400000E);
: GOTO 5115
5110 PRINT HEX(020400040E);
: GOTO 5115
5111 PRINT HEX(020402040E);
: GOTO 5115
5112 PRINT HEX(02040B040E);
: GOTO 5115
5113 PRINT HEX(020400040E);
: GOTO 5115
5115 IF A7$=HEX(08) THEN 5120
: IF A7$<>HEX(04) THEN 5117
: PRINT AT(P(2),P(1));" ";
: GOTO 5118
5117 PRINT AT(P(2),P(1));K$;
: A9$(P(2)+1,P(1)+1)=K$
: STR(S$(),P(2)*80+P(1)+1,1)=K$
5118 REM UPDATE CURSOR POSITION
: P(1)=P(1)+1
: IF P(1)<80 THEN 5120
: P(1)=0
: P(2)=P(2)+1
: IF P(2)<24 THEN 5130
: P(2)=0
: GOTO 5130
5120 RETURN
5125 P9=1
: GOSUB 6800
: IF S0=0 THEN 5130
: S0=0
: RETURN
5130 PRINT AT(P(2),P(1));
: RETURN
5150 REM *** PFKey - Help - Return *** Case '06'
: RETURN
5170 REM *** Keys not defined *** Case '07'
: RETURN
5180 REM *** TAB *** Case '08'
5190 A1$=BIN(P(1)+1)
: X=POS(STR(A1$())>A1$)
: IF X=0 THEN 5192
5191 P(1)=VAL(A1$(X))-1
: IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 5200
: P9=P(2)*80+P(1)+1
: GOTO 5195
5192 P9=(P(2)*80)+P(1)+1
5194 MAT SEARCH A8$()<P9,> ,=HEX(00) TO Y3$
: GOSUB '115(Y3$)
: P9=P9+Y1
5195 MAT SEARCH A8$()<P9,> ,<>HEX(00) TO Y3$
: IF Y3$<>HEX(0000) THEN 5196
: S0=1
: RETURN
5196 GOSUB '115(Y3$)
: P9=P9+Y1
: P8=INT(P9/80)+1
: P7=MOD(P9,80)-1
5198 P(1)=P7-1
: P(2)=P8-1
: IF P(1)<0 THEN P(1)=0
5200 PRINT AT(P(2),P(1));
: RETURN
5210 IF X=0 THEN P9=(P(2)*80)+P(1)+1
: ELSE P9=(P(2)*80)+VAL(A1$(X))
5220 S0=0
: GOSUB 6810
: PRINT AT(P(2),P(1));
: RETURN
5250 REM *** ERASE *** Case '09'
5251 IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 5252
: S0=1
: RETURN
5252 IF A8$(P(2)+1,P(1)+1)=HEX(31) THEN RETURN
: P9=(P(2)*80)+P(1)+1
: MAT SEARCH A8$()<P9,> ,=HEX(00) TO Y3$
: GOSUB '115(Y3$)
: P0=P9+Y1-2
: INIT(8B)B$
5253 IF P0-P9>0 THEN 5256
: STR(A9$(),P9,1)=HEX(8B)
: GOTO 5257
5256 STR(A9$(),P9,P0-P9+1)=STR(B$,1,P0-P9+1)
5257 GOSUB 3320
: PRINT AT(P(2),P(1));STR(A9$(),P9,P0-P9+1);
: PRINT AT(P(2),P(1));
: PRINT HEX(020400000E);
: RETURN
5350 REM *** DELETE *** Case '0A'
5351 IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 5352
: S0=1
: RETURN
5352 IF A8$(P(2)+1,P(1)+1)=HEX(31) THEN RETURN
: P9=(P(2)*80)+P(1)+1
: MAT SEARCH A8$()<P9,> ,=HEX(00) TO Y3$
: GOSUB '115(Y3$)
: P0=P9+Y1-2
: INIT(20)B$
5353 IF P0-P9>0 THEN 5354
: STR(A9$(),P9,1)=HEX(20)
: GOTO 5357
5354 STR(B$,1,P0-P9)=STR(A9$(),P9+1,P0-P9)
5356 STR(A9$(),P9,P0-P9+1)=STR(B$,1,P0-P9+1)
5357 GOSUB 3320
: PRINT AT(P(2),P(1));STR(A9$(),P9,P0-P9+1);
: PRINT AT(P(2),P(1));
: PRINT HEX(020400000E);
: RETURN
5450 REM *** INSERT *** Case '0B'
5451 IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 5452
: S0=1
: RETURN
5452 IF A8$(P(2)+1,P(1)+1)=HEX(31) THEN RETURN
: P9=(P(2)*80)+P(1)+1
: MAT SEARCH A8$()<P9,> ,=HEX(00) TO Y3$
: GOSUB '115(Y3$)
: P0=P9+Y1
: INIT(8B)B$
5454 STR(B$,2,P0-P9)=STR(A9$(),P9,P0-P9)
5456 STR(A9$(),P9,P0-P9)=STR(B$,1,P0-P9)
: GOSUB 3320
: PRINT AT(P(2),P(1));STR(A9$(),P9,(P0-P9)-1);
: PRINT AT(P(2),P(1));
: PRINT HEX(020400000E);
: RETURN
5500 REM ***** CASE 0C - THROUGH KEY AWAY *******
: S0=1
: RETURN
6550 REM ****BACKTAB *** Case '0D'
6560 A1$=BIN(P(1)+1)
: Z=POS(A1$()<>HEX(00))
: IF Z=0 THEN 6580
: X=POS( STR(A1$())<A1$)
6570 P(1)=VAL(A1$(X))+1
: IF A8$(P(2)+1,P(1)+1)<>HEX(00) THEN 6630
: P9=P(2)*80+P(1)+1
: GOTO 6600
6580 P9=(P(2)*80)+P(1)+1
6590 Y3 = POS(-STR(A8$(),1,(P9-1))<>HEX(00))
: IF Y3<>0 THEN 6595
: S0=1
: RETURN
6595 P9=Y3
6600 Y3=POS(-STR(A8$(),1,(P9-1))=HEX(00))
: IF Y3<>0 THEN 6610
: S0=1
: RETURN
6610 P9=Y3+2
: P8=INT(P9/80)+1
: P7=MOD(P9,80)-1
6620 P(1)=P7-1
: P(2)=P8-1
: IF P(1)<0 THEN P(1)=0
6630 PRINT AT(P(2),P(1));
: RETURN
6800 REM *** Find next Modifiable Field ***
6805 P9=P9+(P(2)*80)+P(1)+1
6810 MAT SEARCH A8$()<P9,> ,<>HEX(00) TO Y3$
6813 IF Y3$<>HEX(0000) THEN 6820
: REM PRINT HEX(07);
: S0=1
: RETURN
6820 GOSUB '115(Y3$)
: P9=P9+Y1
6825 P8=INT(P9/80)+1
: P7=MOD(P9,80)-1
6830 P(1)=P7-1
: P(2)=P8-1
: RETURN