Listing of file='@TO.SUBS' on disk='vmedia/mvp-cs386-1.30-disk2.wvd.zip'
# Sector 1301, program filename = '@TO.SUBS'
3000 REM %^.@TO.SUBS 04/09/90 @TO.DISK & @TOIMAGE overlay
3005 REM %.'60 Display Highlighted
3010 DEFFN'60(Z0$,R,C,E1)
: REM Prints a message highlighted
: PRINT HEX(020402000E06);AT(R,C,E1);STR(Z0$,,LEN(Z0$));HEX(0F);
: RETURN
3020 REM %.'154 Get LIMITS of file N$
3030 DEFFN'154(N$)
: ON D0GOTO 3040,3040,3070,3070
: STOP "D0 must be 1-4 "#
3040 GOSUB '229(1,N$)
: IF Z6=0THEN 3075
: A$=Z9$(Z6)
: A1=VAL(STR(A$,3),2)
: B1=VAL(STR(A$,5),2)
: D1=POS(HEX(800040)=STR(A$,2))
3050 IF D1<>1THEN RETURN
: DATA LOAD BA T#1,(A1,Z)D$()
: K$=STR(D$(),,1)AND HEX(F0)
: IF K$=HEX(60)OR K$=HEX(70)THEN D1=3
: RETURN
3060 REM .Get from Disk.image
3070 FOR X=S8TO (S8+E9-1)
: Z=9
: IF X=S8THEN Z=25
: DATA LOAD BA T#1,(X,X9)D$()
: MAT SEARCHSTR(D$(),Z),=STR(N$,,8)TO M$STEP 16
: IF M$>HEX(0000)THEN 3080
: NEXT X
3075 Z0$=N$&" not found"
: GOSUB '60(Z0$,23,0,80)
: RETURN
3080 Z0$=STR(D$(),VAL(M$,2)+Z-9,16)
: A1=VAL(STR(Z0$,3),2)+S8
: B1=VAL(STR(Z0$,5),2)+S8
: D1=POS(HEX(1011)=STR(Z0$,,1))
: IF D1>0THEN D1=POS(HEX(800040)=STR(Z0$,2))
: IF STR(Z0$,,1)=HEX(11)THEN D1=-D1
: X=S8+E9
: NEXT X
: RETURN
3130 REM %.'155 Get a file name
3140 DEFFN'155
: X1=X1+1
: IF X1>FTHEN N1$=" "
: ELSE N1$=N$(X1)
: N$=N1$
: IF N$=" "THEN X1=0
: RETURN
3800 REM %^ -- SE.SUBS, RELEASE 6.03, (05/10/82) SCREEN SUBROUTINES --
3801 DIM T1(8),S1$,S4$80,T1$1,T2$80,T3$1,T$(10)1,T4$3,S2$124
3802 REM %ACCEPT REPEATING FIELD
3803 DEFFN'136(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),S0$,S2$,T
2,T9,T$(),S9)
: I=20
: GOSUB 3863
: T2,T5=MIN(MAX(1,T2),T1(6))
: $TRAN(T$(),HEX(202E))R
: T$(5)="5"
: R1=1
3804 IF S9>1THEN 3810
3805 IF T9<0THEN 3806
: T$(5)="5"
: T3$=S2$
: GOSUB 3831
: S2$=T3$
: IF T9=0THEN 3808
: T2=T5
3806 GOSUB 3835
: GOSUB '130(T0,T1,T1(3),S2$,T1$(T2),S0$," ",T$(),T0$)
: T1$(T2)=S4$
: IF R1<5OR R1=11OR R1=14THEN 3808
3807 IF R1=5THEN T2=T2+1
: IF R1=6THEN T2=T2-1
: IF T2>=1AND T2<=T1(6)THEN 3806
3808 RETURN
3809 REM %^PICKTYPE (S9 =2/P1; =3/PM)
3810 SELECT PRINT 205(80)
: PRINT HEX(0202020F);
: $TRAN(S2$,HEX(8520))R
: 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
3813 NEXT T2
: T2=T5
: IF T9=0THEN 3825
3814 IF S9=3THEN S0$=S0$&"DI"
: GOSUB 3835
: PRINT HEX(06);AT(T0-1,T1-1);
: T9=1
: GOSUB 3840
: IF S9=2AND R1<11OR R1<7THEN 3825
: IF S9=2THEN 3818
: 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)=" "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 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
3829 REM %^DISPLAY REPEATING FIELD
3830 DEFFN'137(T1(1),T1(2),T1(3),T1(4),T1(5),T1(6),T1(7),T1(8),T1$(),T$())
: MAT REDIM T1$(T1(6))T1(3)
: $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);STR(S2$,,T1(3));
: NEXT T2
3833 SELECT PRINT 005(80)
: RETURN
3834 REM %^GLOBAL ROUTINES
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)
: RETURN
3837 IF T0$<>" "THEN GOSUB 3859
: IF T>0THEN GOSUB 3861
: RETURN
3838 REM %keystroke eval
3839 T=1
: PRINT HEX(06070E);AT(23,0,40);" Invalid key ignored";AT(T0-1,T1-2+T9);
3840 R1=99
: IF T$(9)=" "THEN PRINT HEX(02050F);
: KEYIN T1$,,3844
: IF T1$>HEX(82)THEN 3840
: IF T$(9)>" "THEN IF POS(S0$=T1$)=0OR T1$=" "THEN 3839
: GOSUB 3837
: ON POS(HEX(81820D)=T1$)GOTO 3841,3842,3843
: RETURN
3841 R1=0
: RETURN
3842 R1=1
: RETURN
3843 R1=5
: RETURN
3844 GOSUB 3837
: IF T1$>HEX(1F)THEN 3845
: IF POS(S0$=T1$)=0THEN 3845
: R1=4
: S0=VAL(T1$)
: RETURN
3845 ON POS(HEX(F01F507E7F)=T1$)GOTO 3846,3846,3847,3848,3849
: GOTO 3850
3846 R1=0
: RETURN
3847 R1=-1
: RETURN
3848 R1=5
: RETURN
3849 R1=6
: RETURN
3850 T1$=AND HEX(0F)
: IF POS(HEX(0203050608090A0C0D)=T1$)>0THEN 3851
: GOTO 3839
3851 $TRAN(T1$,HEX(0B060E05))R
: R1=VAL(T1$)
: T2$="1PN4567EDIuewd56"
: IF POS(S0$=STR(T2$,R1,1))>0THEN RETURN
: GOTO 3839
3852 ON POS(HEX(2008)=T1$)GOTO 3853,3854
: GOTO 3855
3853 IF T$(4)>" "THEN R1=12
: ELSE R1=14
: GOTO 3855
3854 IF T$(4)>" "THEN R1=13
: ELSE R1=11
3855 I=T1(6)
: IF T$(4)=" "THEN 3856
: IF R1=14THEN T2=MOD(T2+T1(8),I)
: IF R1=11THEN T2=MOD(T2-T1(8),I)
: GOTO 3857
3856 IF R1=14THEN T2=MOD(T2+1,I)
: IF R1=11THEN T2=MOD(T2-1,I)
3857 IF T2=0THEN T2=T1(6)
: IF T2>T1(6)THEN 3852
: RETURN
3858 %erase window
3859 FOR I=1TO VAL(STR(T0$,3))
: PRINT HEX(06);AT(VAL(STR(T0$,1))-2+I,VAL(STR(T0$,2)),VAL(STR(T0$,4)));
: NEXT I
: T0$=" "
3860 %erase errmsg
3861 PRINT HEX(06);AT(23,0,79);
: T=0
: GOSUB 3898
: RETURN
3862 REM %set disp attr
3863 S1$=HEX(0204)&BIN(I/10)&BIN(MOD(I,10))&HEX(0E)
: PRINT STR(S1$,,5);
: RETURN
3864 REM %.DISPLAY MSG
3865 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 3863
: I=1
: STR(S2$,LEN(S2$)+1,1)=HEX(AF)
: T=POS(S2$=HEX(AF))
3866 PRINT HEX(06);AT(T0-1,T1-1);STR(S2$,I,T-1);
: I=I+T
: T=POS(STR(S2$,I)=HEX(AF))
: T0=T0+1
: IF T>0THEN 3866
: PRINT HEX(020402000F06);
: RETURN
3867 REM %^DISPLAY SCR TEXT
3868 DEFFN'129
: SELECT PRINT 205(80)
3869 READ T0,T1,I,S4$
: ERRORR1=-2
: RETURN
3870 IF T0=0THEN RETURN
: IF I=99THEN 3871
: IF I=0THEN PRINT HEX(0F);
: ELSE GOSUB 3863
: PRINT HEX(06);AT(T0-1,T1-1);STR(S4$,,LEN(S4$));
: GOTO 3869
3871 PRINT HEX(06);AT(T0-1,T1-1);BOX(VAL(S4$),VAL(STR(S4$,2)))
: GOTO 3869
3872 REM %^TEXT ENTRY
3873 DEFFN'130(T0,T1,T5,S2$,S4$,S0$,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);
3874 IF T$(3)>" "AND S4$>" "THEN T9=LEN(S4$)+1
: ELSE T9=1
: IF T$(9)=" "THEN GOSUB 3897
: IF S0$<>" "THEN S0$=S0$&"IDEew"
: ELSE S0$="IDEew"
3875 GOSUB 3840
: IF T$(9)>" "THEN 3906
: IF R1<7THEN 3900
: IF R1=11AND POS(S0$="U")>0THEN 3900
: IF R1=14AND POS(S0$="D")>0THEN 3900
: IF R1<99AND T$(3)>" "THEN 3893
: ON R1-7GOTO 3879,3884,3881,3875,3886,3890,3875
: IF T1$=HEX(08)THEN 3890
: IF T9<=T5THEN 3877
: PRINT HEX(07);
: GOTO 3875
3876 REM %char
3877 STR(S4$,T9,1)=T1$
: $TRAN(T1$,HEX(8020))R
: IF T$(3)=" "THEN PRINT HEX(0E);T1$;
: ELSE PRINT HEX(0E8B);
: GOTO 3887
3878 REM %erase
3879 IF T5<T9THEN 3875
: STR(S4$,T9)=" "
: GOSUB 3897
: GOTO 3875
3880 REM %insrt
3881 IF T5<T9THEN 3875
: MAT COPY -S4$<T9,T5-T9>TO -S4$<T9+1,T5-T9>
: STR(S4$,T9,1)=" "
: GOSUB 3897
: GOTO 3875
3882 REM %del
3884 IF T5<T9THEN 3875
: MAT COPY S4$<T9+1,T5-T9>TO S4$<T9,T5-T9>
: STR(S4$,T5,1)=" "
: GOSUB 3897
: GOTO 3875
3885 REM %incrm
3886 IF T9<T5+1THEN PRINT HEX(09);
3887 IF T9<>T5THEN 3888
: IF T$(1)=" "THEN 3888
: R1=5
: GOTO 3900
3888 T9=MIN(T5+1,T9+1)
: GOTO 3875
3889 REM %decrm
3890 IF T9>1THEN 3891
: IF T$(2)=" "THEN 3875
: R1=6
: GOTO 3900
3891 PRINT HEX(08);
: T9=T9-1
: IF T1$<>HEX(08)THEN 3875
: STR(S4$,T9,1)=" "
: PRINT HEX(8508);
: GOTO 3875
3892 PRINT HEX(06070E);AT(23,0,50);T2$;
: T=1
: GOSUB 3898
: GOTO 3875
3893 T2$=" Invalid key ignored"
: GOTO 3892
3894 T2$=" Information required, please enter"
: GOTO 3892
3895 T2$=" Invalid characters in field"
: GOTO 3892
3896 REM %print field
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+T9);
: RETURN
3900 IF T$(7)=" "OR T$(3)>" "THEN 3901
: PRINT HEX(0F);
: GOSUB 3897
3901 $TRAN(S4$,HEX(20802085))R
: IF R1<1THEN 3903
: IF S4$=" "AND T$(6)>" "THEN 3894
3902 REM %validation
3903 ON T6GOTO 3905,3904,3906
: GOTO 3905
3904 IF NUM(S4$)<T1(3)THEN 3895
: GOTO 3906
3905 IF S4$=" "THEN 3906
: I=LEN(S4$)
: IF VER(STR(S4$,,I),S2$)<ITHEN GOTO 3895
3906 SELECT PRINT 005(80)
: PRINT HEX(0F0202000F);
: RETURN
5000 DEFFN'50(S9$,S0$)
: REM Display and Accept ISNy0701 (VER 6.03)
5001 S4=1
: S3=3
: S2=0
: S1=0
: T0$=" "
5002 IF POS(S9$=F2)>0THEN T0$=STR(S9$,POS(S9$=F2)+1,4)
5003 RESTORE LINE5028
: GOSUB '129
5004 T9=0
: FOR T4=1TO 3
5005 ON T4GOSUB 5012,5017,5022
5006 NEXT T4
5007 T9=-1
: IF POS(S9$=F9)>0THEN T3=VAL(STR(S9$,POS(S9$=F9)+1))
: ELSE T3=S4
5008 ON T3GOSUB 5012,5017,5022
5009 ON R1GOTO ,,,,5010,5011
: RETURN
5010 T3=MOD(T3+1,S3+1)
: IF T3=0THEN T3=S4
: GOTO 5008
5011 T3=MOD(T3-1,S3+1)
: IF T3<S4THEN GOTO 5011
: GOTO 5008
5012 MAT REDIM T1$(2)15
: RESTORE LINE5012
: FOR I=1TO 2
: READ T1$(I)
: NEXT I
: GOSUB '136(7,9,1,2,1,2,1,1,T1$(),S0$," ",X0,T9," ",2)
: X0=T0
: RETURN
5013 DATA "Copy Only","Copy and Verify"
5017 IF D0>2THEN 5018
: MAT REDIM T1$(1)3
: GOSUB '136(11,32,3,1,4,1,1,1,X0$(1),S0$,"H",1,T9,"1",1)
: X0$(1)=T1$()
: RETURN
5018 X0$(1)=D$
: PRINT AT(10,31);D$
: RETURN
5022 MAT REDIM T1$(1)3
: GOSUB '136(12,32,3,1,4,1,1,1,X0$(2),S0$,"H",1,T9," ",1)
: X0$(2)=T1$()
: RETURN
5028 DATA 5,2,0,"Select Mode:"
5029 DATA 11,2,0,"Origin platter address:"
5030 DATA 12,2,0,"Destination platter address:"
5032 DATA 21,60,0," RUN - Accept?"
5033 DATA 22,60,0,"RETURN - Proceed"
5034 DATA 23,60,0,"CANCEL - Exit"
5036 DATA 22,1,0,"(c) Copyright Wang Laboratories, Inc. 1988"
5037 DATA 23,5,0,"All rights reserved"
5100 DATA 0,0,0," "
5200 REM %.Validate disk addr
5210 DEFFN'100(S$)
: IF S$="340"THEN 5230
: $TRAN(S$,"AaBbCcDdEeFf")R
: IF POS("DB3"=S$)>0AND POS("123567"=STR(S$,2))>0AND VER(STR(S$,3),"H")>0TH
EN 5220
: Q$="I"
: RETURN
5220 IF POS("3B"=S$)=0OR POS("123"=STR(S$,2))=0OR STR(S$,3)<>"0"THEN 5230
: IF STR(S$,,1)="3"THEN STR(S$,3)="1"
: STR(S$,,1)="D"
5230 Q$=" "
: RETURN
6490 REM %.Find index item
6500 DEFFN'229(Z9,STR(A$,1,8))
: DATA LOAD BA T#Z9,(0,Z3)Z9$()
: Z4=VAL(STR(Z9$(),2,1))
: STR(A$,9,8)=STR(A$,,8)
: ON POS(HEX(0001)=STR(Z9$(),,1))GOSUB 6770,6800
: Z5=Z3
: IF Z3=0THEN 6630
6620 DATA LOAD BA T#Z9,(Z3,Z8)Z9$()
6630 Z6=0
: FOR Z7=1TO 16
: IF Z3<>0THEN 6680
: IF Z7=1THEN Z7=2
6680 B$=STR(Z9$(Z7),,2)
: ON POS(HEX(001011)=B$)GOTO 6740,6720,6720
: GOTO 6750
6720 IF STR(Z9$(Z7),9,8)<>STR(A$,,8)THEN 6750
: Z6=Z7
6740 Z7=16
6750 NEXT Z7
: IF B$=HEX(00)THEN RETURN
: IF Z6<>0THEN RETURN
: B$=HEX(00)
: IF V9<>0THEN 6760
: Z3=Z3-1
: IF Z3=Z5THEN RETURN
: IF Z3<0THEN Z3=Z4-1
: GOTO 6620
6760 Z3=MOD(Z3+1,Z4)
: IF Z3<>Z5THEN 6620
: RETURN
6770 XOR (STR(A$,10,7),STR(A$,9,8))
: B$=STR(A$,16,1)
: STR(A$,18,2)=HEX(0000)
: ADDC(STR(A$,18,2),B$)
: ADDC(STR(A$,18,2),B$)
: ADDC(STR(A$,18,2),B$)
: ADD(STR(A$,18,1),STR(A$,19,1))
: Z3=VAL(STR(A$,18,2))
: Z3=Z3-INT(Z3/Z4)*Z4
: RETURN
6800 STR(A$,18,1)=HEX(00)
: FOR Z5=9TO 16
: IF MOD(Z5,2)>0THEN ROTATE(STR(A$,Z5,1),4)
: STR(A$,18,1)=STR(A$,18,1)ADDSTR(A$,Z5,1)
: NEXT Z5
: Z3=MOD(VAL(STR(A$,18,1)),Z4)
: RETURN