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