Listing of file='VDELETE' on disk='vmedia/731-8011A.wvd.zip'
# Sector 411, program filename = 'VDELETE' 0004 REM % (c) Copyright Wang Laboratories, Inc. 1986 0005 REM % DELETE VDISK UTILITY-"VDELETE" ** Nori Odoi ** Rev. 1.00 * 12/10/86 ** 0010 REM % Variables used by screen subs 0015 DIM T1$(416)1, R1, S0, T1(8),S4$80,T1$1 0020 REM % Disk variables- VDISKMAP record, desired VDISK rec,temp,temp 0022 DIM F1$(50)12,F1,F$,F,F6$40,A9$3 0023 REM /VS filename, file handle, Exc/Sh,record buffer(must be redimmed to ( 8)28 for VDISK config file) : DIM F3$(33)8,F4$(33)8,F5$(33)8,F6$(33)8,F7$(33)8,F9$(8)30 0040 REM % Input variables-D1$()=cntlr add,primary disk addr,config file;D3$() =vol name,D4$()=libe name;D5$()=file name : DIM D1$(4)8,D3$(1)8, D4$(1)8, D5$(1)8,D5$29 0050 REM % Control variables-C=EXIT,P$=Search variable, P9=Screen #,E9$=Error msg,E=error : DIM C,P$16,P9,E8$1,E9$80,E 0070 REM % Scratch : DIM I,J,D 0097 DIM V$32, V1$1, V2$1, V3$1, V4$2, V5$2, V6$6,V7$32, V8$, V8$(16), V9$2, V 9$(16,16) 0099 REM % Goto beginning of program 0100 GOTO 2000 0130 REM % **** DEFFN'45 - DMS\A0STATUS -- V<0=err 0131 REM /* Response-F6$,len V1-assignment,2200SRV status,disk addr,VDISK stat us * 0132 DEFFN'45 : V=1 : REM construct command : F6$=ALL(00) : STR(A$,7,1)=HEX(52) : STR(A$,6,1) = BIN(#PART-1) AND HEX(0F) OR HEX(50) : $OPEN 138,#2,#3 : ERRORV=-1 : GOTO 139 0133 $GIO#2(4500) : ERRORV=-1 : GOTO 139 0134 $BREAK : FOR D=1 TO 1200 : $IF ON #2,135 : NEXT D : V=-10 : GOTO 139 0135 $IF ON #3,137 : ERRORV=-1 : GOTO 139 0136 $GIO#3(4550 405F) : $BREAK : FOR D=1 TO 1200 : $IF ON #3,137 : NEXT D : V=-10 : GOTO 139 0137 $GIO #3 (4660 4270 8703 8704 1801 C340, A$)A$;STR(F6$,1,VAL(STR(A$,3,2),2 )) : V1=VAL(STR(A$,3,2),2) : GOTO 139 0138 V=-20 0139 $CLOSE#2,#3 : RETURN 0140 REM %** DEFFN'48 - SET\A0DEVICE\A0TABLE(comm addr) V<0=err 0142 DEFFN'48(A9$) : V=1 : IF STR(A9$,1,1)<>"0" OR STR(A9$,2,1)="0" THEN 146 : HEXPACK T1$ FROM STR(A9$,2,2) : IF MOD(VAL(T1$),4)>0 THEN 146 0143 REM /status addr : T1$=ADD HEX(01) : HEXUNPACK T1$ TO STR(A9$,2,2) : SELECT #1 <A9$> : ERRORGOTO 146 0144 REM /command addr : T1$=ADD HEX(01) : HEXUNPACK T1$ TO STR(A9$,2,2) : SELECT #2 <A9$> : ERRORGOTO 146 0145 REM /data addr : T1$ =ADD HEX(01) : HEXUNPACK T1$ TO STR(A9$,2,2) : SELECT #3 <A9$> : GOSUB '45 : IF V<0 THEN RETURN : T$="D" : HEXUNPACK STR(F6$,4,1) TO STR(T$,2,2) : SELECT #4<T$> : RETURN 0146 V=-1 : RETURN 0160 REM % **** DEFFN'50 - READ\A0MAP routine ******************************** *** 0170 REM / **** Reads VDISKMAP & stores in F1$() - array of entries ********* * 0180 DEFFN'50 : V=1 : DATA LOAD DC OPEN T"VDISKMAP" : ERRORE=ERR : V=0 : RETURN 0190 MAT REDIM F1$(50)12 : DATA LOAD DC F1$() : DATA SAVE DC CLOSE : RETURN 0400 REM % **** DEFFN'70 - ADDR\A0VAL routine ******************************** * 0405 REM / **** Validate hex address. V=1 if valid, =0 if not ************* 0415 DEFFN'70(F$) : IF VER(F$,"HHH")=3 AND LEN(F$)=3 THEN V=1 : ELSE V=0 : RETURN 0460 REM %** DEFFN'74-FIND\A0ATTACHED/DETACHED-"A"=Att,"D"=Det.V=index,if err <0 0465 DEFFN'74(F$) : V=-2 : FOR I=1 TO 50 : IF STR(F1$(I),1,3)="ZZZ" THEN 468 : GOSUB '48(STR(F1$(I),1,3)) : IF V<0 THEN 469 : IF F$="A" THEN 466 : IF STR(F6$,,1)<>HEX(00)THEN 469 : ELSE V=I : IF V>0 THEN RETURN 0466 IF STR(F6$,,1)=HEX(00) OR STR(F6$,3,1)=HEX(00) THEN 469 : V=I : RETURN 0468 I=50 0469 NEXT I : V=-5 : RETURN 0500 REM % **** DEFFN'90 - DISK\A0ERR routine ****************************** *** 0505 REM / **** Process disk errors ************ * 0515 DEFFN'90(D) : RESTORE LINE 4010,D-79 : READ E9$ : GOSUB '128(E9$,99,1,20) : RETURN 0520 REM % **** DEFFN'91 - OPEN\A0ERR(errclass,errcode) 0525 DEFFN'91(V3$,V4$) : E9$="Could not delete" : RETURN : V5$,V6$=" " : CONVERT VAL(STR(V3$,,1)) TO V5$,(##) : CONVERT VAL(STR(V4$,,2),2) TO V6$,(####) : E9$="2200SRV err class- "&STR(V5$,POS(V5$<>"0"))& " Err code- "&STR(V6$,P OS(V6$<>"0")) : RETURN 0600 REM % **** DEFFN'95 - CHECK\A0TERMINAL routine ************************** *** 0605 REM / **** Check if is terminal 1 or not ************ * 0606 REM / **** Return V=1 if true, V=0 if false, if false, print error ***** * 0615 DEFFN'95 : V=1 : IF #TERM=1 THEN RETURN : ELSE V=0 : RETURN 1000 DEFFN'100(S9$,S0$) : REM Display and Accept DELETEV (VER 7.00) 1001 S4=1 : S3=04 : S2=0 : S1=0 : T0$=" " 1002 IF POS(S9$=F2)>0 THEN T0$=STR(S9$,POS(S9$=F2)+1,4) 1003 IF POS(S9$=F6)>0 THEN GOTO 1007 : RESTORE LINE 1032 : GOSUB '129 1004 T9=0 : FOR T4=1TO 04 1005 ON T4GOSUB 1012,1017,1022,1027 1006 NEXT T4 1007 T9=-1 : IF POS(S9$=F9)>0 THEN T3=VAL(STR(S9$,POS(S9$=F9)+1)) : ELSE T3=S4 1008 ON T3GOSUB 1012,1017,1022,1027 1009 ON R1GOTO ,,,,1010,1011 : RETURN 1010 T3=MOD(T3+1,S3+1) : IF T3=0 THEN T3=S4 : GOTO 1008 1011 T3=MOD(T3-1,S3+1) : IF T3<S4 THEN GOTO 1011 : GOTO 1008 1012 MAT REDIM T1$(001)003 : GOSUB '126(10,52,3,1,1,001,1,1,D1$(1),S0$,"X",1,T9," ",1) : IF R1<=0 OR T9=0 THEN RETURN : D1$(1)=T1$() : IF VER(T1$(),"HHH")<>3 THEN 1013 : GOSUB '48(D1$(1)) : IF V<1 THEN 1014 : IF STR(F6$,,1)>HEX(00) THEN 1015 : E9$="Controller not attached" : GOTO 1016 1013 E9$="Invalid characters in field" : GOTO 1016 1014 IF V=-1 THEN E9$="Illegal communications address" : IF V=-10 THEN E9$="Controller not responding" : IF V=-20 THEN E9$="Controller is being accessed by another partition" : GOTO 1016 1015 IF STR(F6$,3,1)=HEX(FF)THEN RETURN : E9$="2200SRV malfunction - Please detach and re-attach this controller" 1016 GOSUB '128(E9$,99,0,20) : T0$=HEX(18000150) : GOTO 1012 1017 MAT REDIM T1$(1)6 : GOSUB '126(11,52,6,1,1,1,1,1,D3$(1),S0$,"X",1,T9," ",1) : IF R1>0 THEN D3$(1)=T1$() : RETURN 1022 MAT REDIM T1$(001)008 : GOSUB '126(12,52,8,1,1,001,1,1,D4$(1),S0$,"X",1,T9," ",1) : IF R1>0 THEN D4$(1)=T1$() : RETURN 1027 MAT REDIM T1$(001)008 : GOSUB '126(13,52,8,1,1,001,1,1,D5$(1),S0$,"X",1,T9," ",1) : IF R1>0 THEN D5$(1)=T1$() : RETURN 1032 DATA 01,23,00,"***** D E L E T E V D I S K *****" 1033 DATA 02,34,00,"Revision 2.0 " 1034 DATA 10,22,00,"Enter communications address:" 1035 DATA 11,32,00,"Enter VDISK volume:" 1036 DATA 12,31,00,"Enter VDISK library:" 1037 DATA 13,29,00,"Enter VDISK file name:" 1038 DATA 22,50,00,"EXEC/RUN - Delete VDISK file" 1039 DATA 23,47,00,"CANCEL/EDIT - Exit" 1040 DATA 0,0,0," " 1500 REM VSACESS0 12 JUNE 86 1501 DEFFN'199 1502 STR(V8$,7,1)=HEX(53) 1503 STR(V8$,6,1)=BIN(#PART-1)AND HEX(0F)OR HEX(50) 1504 $OPEN #3 : $GIO#3(466042708701,V8$) : IF STR(V8$,1,1)<>HEX(80)THEN 1511 1505 V1=LEN(V8$())+34 : STR(V8$,6,2)=BIN(V1,2) : $GIO#3(40E3426042701800A0001801A00040008701,V8$)V7$;STR(V8$(),,V1) 1506 IF STR(V8$,1,1)<>HEX(80)THEN 1511 1507 V9$()=ALL(" ") : $GIO#3(870387041801C340,V8$)V8$;STR(V9$(),1,VAL(STR(V8$,3,2),2)) 1508 $GIO#3(4000,V8$) 1509 $CLOSE#3 1510 V0$=HEX(FF) : RETURN 1511 V0$=HEX(5A) : RETURN 1600 REM VSACESS9 21 JULY 86 1601 DEFFN'201(V$) 1602 V7$=ALL(HEX(00)) : STR(V7$,,5)=HEX(FF)&"SMB"&HEX(FF) : STR(V7$,7,1)=HEX(17) : STR(V7$,23,2)=HEX(FFFF) 1603 STR(V8$(),1,3)=HEX(010000) 1604 V1=LEN(V$) : STR(V8$(),4,2)=BIN(2+V1,2) 1605 STR(V8$(),6,V1+2)=HEX(04)&V$&HEX(00) 1606 V1=V1+8 : STR(V8$(),V1,1)=HEX(00) 1607 GOSUB '199 : IF V0$=HEX(5A)THEN 1612 1608 V7$=STR(V9$(),,32) 1609 V1=VAL(STR(V8$,3,2),2)-32 : STR(V9$(),,V1)=STR(V9$(),33,V1) : STR(V9$(),V1+1)=ALL(" ") 1610 V0$=HEX(FF) : RETURN 1611 V0$=HEX(00) 1612 RETURN 2000 REM % Quit if not terminal 1 : GOSUB '95 : IF V<>0 THEN 2003 : E9$="Delete VDISKs can only be run from terminal 1" : E9=23 : E8$="K" : C=1 : PRINT HEX(03) : GOTO 3005 2003 REM %Read VDISKMAP, get controller address, & initialize : C=0 : E9=99 : GOSUB '50 : IF V=1 THEN 2007 : IF E=82 THEN E9$="VDISKMAP file not found" : ELSE GOSUB '90(E) : GOTO 3005 2007 GOSUB '74("A") : IF V>0 THEN D1$(1)=STR(F1$(V),1,3) : ELSE D1$(1)=" " 2008 PRINT HEX(03) : P9$=HEX(F218000150) 2010 REM % REPEAT loop : REM /Display input screen : GOSUB '100(P9$," ") 2020 REM % IF cancel or shift cancel or screen not found then exit : IF R1>0 THEN 2060 : E8$=" " : E9=23 : IF R1=-2 THEN E9$="Could not access screen" : ELSE E9$="Delete VDISK Utility cancelled" : C=1 : GOTO 3005 2060 REM %ELSE delete : IF D5$(1)<>" " THEN 2066 : E9$="Invalid VDISK name" : P9$=HEX(F218000150F6F904) : GOTO 3005 2066 PRINT AT(22,0,160); : GOSUB '128("WARNING: Are you sure you want to delete this file?",23,0,20) : GOSUB '128("Press EXEC/RUN to delete file, CANCEL/EDIT to exit.",24,0,20) 2067 T$=" " : KEYIN T$ : V=POS(HEX(50F082A1)=STR(T$,1,1)) : IF V=0 THEN 2067 : PRINT AT(22,0,160); : IF V>2 THEN 2068 : E9$=" " : GOTO 3005 2068 GOSUB '128("Deleting VDISK",24,00,20) 2070 REM /Check if attached : GOSUB '48(D1$(1)) : IF V>0 THEN 2080 : IF V=-1 THEN E9$="Controller not attached" : IF V=-10 THEN E9$="Controller not responding" : IF V=-20 THEN E9$="Controller is being accessed by another partition" : GOTO 3005 2080 D5$="///"&D3$()&"/"&D4$()&"/"&D5$() : GOSUB '201(D5$) : IF V0$=HEX(FF) THEN 2085 : E9$="Could not delete VDISK" : GOTO 3005 2085 IF STR(V7$,6,1)=HEX(00) THEN 2090 : GOSUB '91(STR(V7$,6,1),STR(V7$,8,2)) : GOTO 3005 2090 E9$="VDISK deleted" 3000 REM % UNTIL delete exit 3005 PRINT AT(19,0,400); : IF E9$<>" " THEN GOSUB '128(E9$,E9,0,20) : IF C=0 THEN 2010 3006 IF E9$=" " OR E8$<>"K" THEN 3008 : GOSUB '128("Press any key to exit",99,0,20) : KEYIN T$ 3008 PRINT AT(23,00,80); : GOSUB '128("Loading VS Services Menu",24,0,20) 3010 LOAD T"@VSMENU" 3799 REM % *********************** SCREEN SUBS - APEERS ********************* 3800 REM SE.SUBS, RELEASE 7.00, (08/23/82) SCREEN SUBROUTINES 3801 DIM T1(8),T2(2),S1$,S2$124,S3$1,S4$80,T1$1,T2$80,T3$1,T4$3,T$(10)1 3802 DEFFN'126(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),S0$,S2$,T 2,T9,T$(),S9) : S3$=S2$ : I=20 : GOSUB 3864 : T2,T5=MIN(MAX(1,T2),T1(6)) : $TRAN(T$(),HEX(202E))R : T$(5)="5" : R1=1 : IF S9>1THEN 3806 : IF T9<0THEN 3803 : T$(5)="5" : T3$=S2$ : GOSUB 3831 : S2$=T3$ : IF T9=0THEN 3805 : T2=T5 3803 GOSUB 3835 : GOSUB '130(T0,T1,T1(3),S3$,T1$(T2),S0$," ",T$(),T0$) : T1$(T2)=S4$ : IF T$(10)=" "THEN 3804 : GOSUB '125 : IF R1=-2THEN 3803 3804 IF R1<5OR R1=11OR R1=14THEN 3805 : IF R1=5THEN T2=T2+1 : IF R1=6THEN T2=T2-1 : IF T2>=1AND T2<=T1(6)THEN 3803 3805 RETURN 3806 S8$=S0$ : SELECT PRINT 205(80) : PRINT HEX(0202020F); : $TRAN(S2$,HEX(8520))R : T2=T2-1 3808 T2=MAX(1,MOD(T2+1,T1(6))) : IF STR(T1$(T2),,1)=HEX(00)THEN 3808 3810 IF T9<0THEN 3814 : T5=T2 : FOR T2=1TO T1(6) : IF S9=2THEN 3811 : T4$=STR(S2$,T2,1)&HEX(0F09) : GOTO 3812 3811 IF T2=T5THEN T4$=HEX(8B0E09) : ELSE T4$=HEX(900F09) 3812 GOSUB 3835 : GOSUB 3824 : NEXT T2 : T2=T5 : IF T9=0THEN 3825 3814 IF S9=3THEN S8$=S8$&"DI" : GOSUB 3835 : PRINT HEX(06);AT(T0-1,T1-1); : T8=1 : GOSUB 3839 : IF S9=2AND R1>08AND R1<15THEN 3825 : IF R1<7THEN 3825 : IF S9=2THEN 3818 : IF POS(HEX(8B85)=STR(S2$,T2,1))=0THEN 3819 : ON R1-8GOTO 3815,3816 : GOTO 3819 3815 STR(S2$,T2,1)=HEX(85) : GOTO 3817 3816 STR(S2$,T2,1)=HEX(8B) 3817 T4$=STR(S2$,T2,1)&HEX(0F09) : GOSUB 3824 : I=1 : GOTO 3822 3818 T4$=HEX(900F09) : GOSUB 3824 3819 ON POS(HEX(2008)=T1$)GOTO 3820,3821 : GOSUB 3826 : GOTO 3823 3820 I=1 : GOTO 3822 3821 I=-1 3822 T2=T2+I : T2=MOD(T2,T1(6)) : IF T2=0THEN T2=T1(6) : IF T1$(T2)=" "OR STR(T1$(T2),,1)=HEX(00)THEN 3822 3823 IF S9=3THEN T4$=STR(S2$,T2,1)&HEX(0F09) : ELSE T4$=HEX(8B0E09) : GOSUB 3835 : GOSUB 3824 : GOTO 3814 3824 PRINT HEX(06);AT(T0-1,T1-1); : IF T1$(T2)>" "THEN PRINT HEX(0E);T4$;STR(T1$(T2)); : ELSE IF STR(T1$(T2),,1)>HEX(00)THEN PRINT TAB(T1-1+2);STR(T1$(T2)); : RETURN 3825 $TRAN(S2$,HEX(2085))R : T0=T2 : PRINT HEX(0F0202000F); : IF S2=2THEN RETURN : MAT REDIM T1$(T1(6))1 : T1$()=S2$ : SELECT PRINT 005(80) : RETURN 3826 T1$=OR HEX(20) : S=-1 : IF T2=T1(6)THEN 3827 : FOR I=T2+1TO T1(6) : T3$=STR(T1$(I),1,1)OR HEX(20) : IF T3$<>T1$THEN NEXT I : ELSE S=I 3827 IF T2=1OR S>0THEN 3828 : FOR I=1TO T2-1 : T3$=STR(T1$(I),1,1)OR HEX(20) : IF T3$<>T1$THEN NEXT I : ELSE S=I 3828 IF S>-1THEN T2=S : RETURN 3830 DEFFN'127(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),T$()) : $TRAN(T$(),HEX(202E))R 3831 SELECT PRINT 405(80) : IF T$(7)=" "THEN PRINT HEX(020402000E06); : ELSE PRINT HEX(0F06) : FOR T2=1TO T1(6) : GOSUB 3835 : S2$=T1$(T2) : IF T$(3)=" "OR S2$=" "THEN 3832 : STR(S2$,,LEN(S2$))=ALL(8B) 3832 IF T$(5)>" "THEN $TRAN(S2$,HEX(8520))R : PRINT AT(T0-1,T1-1); : IF STR(S2$,,1)>HEX(00)THEN PRINT STR(S2$,,T1(3)); : NEXT T2 : SELECT PRINT 005(80) : RETURN 3835 IF T$(4)>" "THEN T0=INT((T2-1)/T1(8))*T1(7)+T1(1) : ELSE T0=MOD((T2-1),T1(4))*T1(7)+T1(1) : IF T$(4)>" "THEN T1=MOD((T2-1),T1(8))*T1(5)+T1(2) : ELSE T1=INT((T2-1)/T1(4))*T1(5)+T1(2) : T0=T0+T2(1) : T1=T1+T2(2) : RETURN 3836 IF T0$<>" "THEN GOSUB 3860 : IF T>0THEN GOSUB 3862 : RETURN 3838 T=1 : PRINT HEX(06070E);AT(23,0,40);" Invalid key ignored";AT(T0-1,T1-2+T8); 3839 R1=99 : IF T$(9)=" "THEN PRINT HEX(02050F); : KEYIN T1$,,3845 : GOSUB 3836 : IF T1$>HEX(82)THEN 3838 : IF T$(9)=" "THEN 3841 : IF POS(HEX(8182)=T1$)=0OR POS(S8$=T1$)=0THEN 3838 3841 IF T1$>HEX(82)THEN 3838 : ON POS(HEX(81820D)=T1$)GOTO 3847,3843,3849 : RETURN 3843 R1=1 : RETURN 3845 GOSUB 3836 : IF T1$>HEX(1F)THEN 3846 : IF POS(S8$=T1$)=0THEN 3846 : R1=4 : S0=VAL(T1$) : RETURN 3846 ON POS(HEX(F01F50)=T1$)GOTO 3847,3847,3848 : IF T$(9)=" "THEN ON POS(HEX(7E7F)=T1$)GOTO 3849,3850 : GOTO 3851 3847 R1=0 : RETURN 3848 R1=-1 : RETURN 3849 R1=5 : RETURN 3850 R1=6 : RETURN 3851 T1$=AND HEX(0F) : IF POS(HEX(0203050608090A0C0D)=T1$)>0THEN 3852 : GOTO 3838 3852 $TRAN(T1$,HEX(0B060E05))R : R1=VAL(T1$) : T2$="*PN****EDIuewd**" : IF POS(S8$=STR(T2$,R1,1))>0THEN RETURN : GOTO 3838 3853 ON POS(HEX(2008)=T1$)GOTO 3854,3855 : GOTO 3856 3854 IF T$(4)>" "THEN R1=12 : ELSE R1=14 : GOTO 3856 3855 IF T$(4)>" "THEN R1=13 : ELSE R1=11 3856 I=T1(6) : IF T$(4)=" "THEN 3857 : IF R1=14THEN T2=MOD(T2+T1(8),I) : IF R1=11THEN T2=MOD(T2-T1(8),I) : GOTO 3858 3857 IF R1=14THEN T2=MOD(T2+1,I) : IF R1=11THEN T2=MOD(T2-1,I) 3858 IF T2=0THEN T2=T1(6) : IF T2>T1(6)THEN 3853 : RETURN 3860 FOR I=1TO VAL(STR(T0$,3)) : PRINT HEX(06);AT(VAL(STR(T0$,1))-2+I+T2(1),VAL(STR(T0$,2))+T2(2),VAL(STR( T0$,4))); : NEXT I : T0$=" " : GOSUB 3898 : RETURN 3862 PRINT HEX(06);AT(23,0,40); : T=0 : GOSUB 3898 : RETURN 3864 S1$=HEX(0204)&BIN(I/10)&BIN(MOD(I,10))&HEX(0E) : PRINT STR(S1$,,5); : RETURN 3866 DEFFN'128(S2$,T0,T1,I) : SELECT PRINT 005(80) : IF T0=99THEN PRINT HEX(07); : IF T1=99THEN T1=40-(LEN(S2$)/2) : T0=MIN(24,T0) : T1=MAX(1,T1) : GOSUB 3864 : I=1 : STR(S2$,LEN(S2$)+1,1)=HEX(AF) : S=POS(S2$=HEX(AF)) 3867 PRINT HEX(06);AT(T0-1,T1-1);STR(S2$,I,S-1); : I=I+S : S=POS(STR(S2$,I)=HEX(AF)) : T0=T0+1 : IF S>0THEN 3867 : PRINT HEX(020402000F06); : RETURN 3869 DEFFN'129 : SELECT PRINT 205(80) 3870 READ T0,T1,I,S4$ : ERRORR1=-2 : RETURN 3871 IF T0=0THEN RETURN : T0=T0+T2(1) : T1=T1+T2(2) : IF I=99THEN 3872 : IF I=0THEN PRINT HEX(0F); : ELSE GOSUB 3864 : PRINT HEX(06);AT(T0-1,T1-1);STR(S4$,,LEN(S4$)); : GOTO 3870 3872 PRINT HEX(06);AT(T0-1,T1-1);BOX(VAL(S4$),VAL(STR(S4$,2))) : GOTO 3870 3874 DEFFN'130(T0,T1,T5,S2$,S4$,S8$,T2$,T$(),T0$) : SELECT PRINT 405(80) : PRINT HEX(0202000F020402000E); : $TRAN(T$(),HEX(202E))R : IF T2$>" "THEN PRINT HEX(060F);AT(T0-1,T1-2-LEN(T2$));T2$;HEX(0E); : S2$=ALL(S2$) : T6=POS("H#X"=S2$) : PRINT HEX(0202020F); : T8=1 : IF T$(9)>" "THEN 3876 : GOSUB 3897 : IF S8$<>" "THEN S8$=S8$&"IDEew" : ELSE S8$="IDEew" 3876 GOSUB 3839 : IF T$(9)>" "THEN 3905 : IF R1<7THEN 3899 : IF R1=11OR R1=14THEN 3899 : ON R1-7GOTO 3880,3884,3882,3876,3886,3890,3876 : IF T1$=HEX(08)THEN 3890 : IF T8<=T5THEN 3878 : PRINT HEX(07); : GOTO 3876 3878 STR(S4$,T8,1)=T1$ : $TRAN(T1$,HEX(8020))R : IF T$(3)=" "THEN PRINT HEX(0E);T1$; : ELSE PRINT HEX(0E8B); : GOTO 3887 3880 IF T5<T8THEN 3876 : STR(S4$,T8)=" " : GOSUB 3897 : GOTO 3876 3882 IF T5<T8THEN 3876 : MAT COPY -S4$<T8,T5-T8>TO -S4$<T8+1,T5-T8> : STR(S4$,T8,1)=" " : GOSUB 3897 : GOTO 3876 3884 IF T5<T8THEN 3876 : MAT COPY S4$<T8+1,T5-T8>TO S4$<T8,T5-T8> : STR(S4$,T5,1)=" " : GOSUB 3897 : GOTO 3876 3886 IF T8<T5+1THEN PRINT HEX(09); 3887 IF T8<>T5THEN 3888 : IF T$(1)=" "THEN 3888 : R1=5 : GOTO 3899 3888 T8=MIN(T5+1,T8+1) : GOTO 3876 3890 IF T8>1THEN 3891 : IF T$(2)=" "THEN 3876 : R1=6 : GOTO 3899 3891 PRINT HEX(08); : T8=T8-1 : IF T1$<>HEX(08)THEN 3876 : STR(S4$,T8,1)=" " : PRINT HEX(8508); : GOTO 3876 3892 PRINT HEX(06070E);AT(23,0,50);T2$; : T=1 : GOSUB 3898 : GOTO 3876 3893 T2$=" Invalid key ignored" : GOTO 3892 3894 T2$=" Information required, please enter" : GOTO 3892 3895 T2$=" Invalid characters in field" : GOTO 3892 3897 PRINT HEX(06);AT(T0-1,T1-1); : T2$=S4$ : IF T$(3)>" "AND T2$>" "THEN STR(T2$,,LEN(T2$))=ALL(8B) : $TRAN(T2$,HEX(8520))R : PRINT STR(T2$,,T5); 3898 PRINT HEX(06);AT(T0-1,T1-2+T8); : RETURN 3899 IF T$(7)=" "OR T$(3)>" "THEN 3900 : PRINT HEX(0F); : GOSUB 3897 3900 $TRAN(S4$,HEX(20802085))R : IF R1<1THEN 3902 : IF S4$=" "AND T$(6)>" "THEN 3894 3902 ON T6GOTO 3904,3903,3905 : GOTO 3904 3903 IF NUM(S4$)<T5THEN 3895 : GOTO 3905 3904 IF S4$>" "AND VER(STR(S4$,,T5),S2$)<T5THEN GOTO 3895 3905 SELECT PRINT 005(80) : PRINT HEX(0F0202000F); : RETURN 3906 % S$="SE.SUBS ": SCRATCH TS$: SAVE <S>T()S$3800,3999: PRINT HEX(0E);S$;H EX(0F);" updated" 4000 REM % *********************** Text Messages ********************* 4010 REM / Disk error messages 4020 DATA "D80 File not open" 4022 DATA "D81 File full" 4024 DATA "D82 File not in catalog" 4026 DATA "D83 File already cataloged" 4028 DATA "D84 File not scratched" 4030 DATA "D85 Index full" 4032 DATA "D86 Catalog end error" 4034 DATA "D87 No end-of-file" 4036 DATA "D88 Wrong record type" 4038 DATA "D89 Sector address beyond end-of-file" 4040 DATA "I90 Disk hardware error" 4042 DATA "I91 Disk hardware error" 4044 DATA "I92 Timeout error" 4046 DATA "I93 Format error" 4048 DATA "I94 Format key engaged" 4050 DATA "I95 Device error" 4052 DATA "I96 Data error" 4054 DATA "I97 Longitudinal redundancy check error" 4056 DATA "I98 Illegal sector address or platter not mounted" 4058 DATA "I99 Read-after-write error" 9989 REM % *********************** Useful Text Constants ********************* 9992 DEFFN '16 "LIST S" 9994 DEFFN '17 "LIST SD" 9996 DEFFN '18 "LIST SD 2060, " 9997 DEFFN '19 "LIST SD 2000, " 9999 DEFFN '31 "SCRATCH T";HEX(22);"VDELETE";HEX(22);": SAVE T()";HEX(22);"VD ELETE";HEX(22)