image of READY prompt

Wang2200.org

Listing of file='@TO.SUBS' on disk='vmedia/731-8017-A.wvd.zip'

# Sector 474, 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