image of READY prompt

Wang2200.org

Listing of file='DDA.STOR' on disk='vmedia/701-2720C.wvd.zip'

# Sector 598, program filename = 'DDA.STOR'
7104 % DDA.142, RELEASE X01, (AUG 03, 81) STORE A RECORD
7108 DEFFN'142(N0$,N1(2),N3)
   : IF N(N3,3)>0THEN 7109
   : M=78
   : GOTO 7165
7109 IF N1(2)=0THEN N1(2)=1
   : GOSUB '143(N0$,"EQ",-N3)
   : IF M=52THEN 7112
   : IF M<>0THEN 7165
   : M=53
   : GOTO 7165
7112 $OPEN #N0
   : M=0
   : DATA LOAD DA T#N0,(N(N3,3))N0(),N9$
   : ERRORM=ERR
   : GOTO 7165
7113 N1(9)=N3
   : IF N0(8)*N0(10)+N0(10)+N0(7)+N(N3,3)<N(N3,4)THEN 7117
   : M=76
   : GOTO 7165
7117 IF N0(4)=0THEN N0(4)=N0(3)-1
   : I1=N0(2)+1
   : I2=N0(4)-N0(3)+1
   : IF I1+I2<((N0(7)-N0(1))/N0(6))-1THEN 7121
   : M=76
   : GOTO 7165
7121 GOSUB '149(N(N3,3)+N0(7),N0(10),N0(8))
   : IF N1(3)=0THEN GOTO 7123
   : ELSE M=N1(3)
   : GOTO 7165
7123 N1(4)=VAL(N0$(),2)
   : IF 2+N1(2)<N0(10)*249-N1(4)THEN GOTO 7131
   : N0(8)=N0(8)+1
   : N0$()=HEX(0002)&ALL(00)
   : N1(4)=2
7131 N1(5)=N1(4)+1
   : STR(N0$(),N1(5),2)=BIN(N1(2),2)
   : N1(4)=N1(4)+N1(2)+2
   : STR(N0$(),1,2)=BIN(N1(4),2)
   : MAT COPY K8$()<1,N1(2)>TO N0$()<N1(5)+2,N1(2)>
   : GOSUB '148(N(N3,3)+N0(7),N0(10),N0(8))
   : IF N5>N0(2)THEN 7145
   : GOSUB '149(N(N3,3),1,2)
   : MAT SEARCHN0$()<,156>,=STR(N0$,,2)TO N2$()STEP 4
   : I2=VAL(N2$(1),2)
   : IF I2>0THEN 7145
7141 UNPACK(####)STR(N0$(),,2)TO I2
   : PACK(####)STR(N0$(),,2)FROMI2+4
   : N0(4)=N0(4)+1
   : STR(N0$(),I2,4)=STR(N0$,,2)&BIN(N0(4),2)
   : GOSUB '148(N(N3,3),1,2)
   : N5=N0(4)
   : N1(4)=0
   : N0$()=ALL(FF)
   : GOTO 7154
7145 GOSUB '149(N(N3,3)+N0(1),N0(6),N5)
   : IF N1(3)=0THEN GOTO 7148
   : ELSE M=N1(3)
   : GOTO 7165
7148 MAT SEARCHN0$()<1,N3(5)*N0(5)>,=HEX(FFFF)TO N2$()STEP N0(5)
   : N1(4)=VAL(N2$(1),2)-1
   : IF N1(4)>=0THEN 7154
   : STR(N0$(),N0(6)*249-1,2)=BIN(N0(4)+1,2)
   : GOSUB '148(N(N3,3)+N0(1),N0(6),N5)
   : N5,N0(4)=N0(4)+1
   : N0$()=ALL(FF)
   : N1(4)=0
7154 STR(N0$,N0(5)-3,2)=BIN(N0(8),2)
   : STR(N0$,N0(5)-1,2)=BIN(N1(5),2)
   : STR(N0$,N0(5)-5,2)=BIN(0,2)
   : MAT COPY N0$<,N0(5)>TO N0$()<N1(4)+1,N0(5)>
   : STR(N0$(),N0(6)*249-1,2)=BIN(0,2)
   : GOSUB '148(N(N3,3)+N0(1),N0(6),N5)
7160 GOSUB '143(STR(N0$,,N0(5)-6),"GT",-N3)
   : I3=M
   : M=0
   : IF I3=75THEN 7163
   : IF N2>0THEN 7163
   : IF N5<>N3(6)THEN GOSUB '149(N(N3,3)+N0(1),N0(6),N3(6))
7161 IF STR(N0$(),N3(7)+N0(5)-6,2)>HEX(0000)THEN 7163
   : STR(N0$(),N3(7)+N0(5)-6,2)=BIN(N0(4),2)
   : GOSUB '148(N(N3,3)+N0(1),N0(6),N3(6))
   : IF N(N3,1)=N3(6)THEN MAT COPY N0$()TO N5$()<(N3-1)*N0(6)*249+1,N0(6)*249>
7163 DATA SAVE DA T#N0,(N(N3,3))N0(),N9$
   : ERRORM=ERR
7165 $CLOSE#N0
   : MAT COPY N0$<1,N0(5)-6>TO N0$
   : RETURN
7438 %DDA.145, RELEASE X01, (AUG 3, 81) REWRITE A RECORD
7442 DEFFN'145(N3)
   : $OPEN #N0
   : M=0
   : MAT COPY N5$()<(N3-1)*(249*N0(6))+N(N3,2),N0(5)>TO N1$(2)
   : N1(6)=VAL(STR(N1$(2),N0(5)-3),2)
   : N1(5)=VAL(STR(N1$(2),N0(5)-1),2)
   : IF N1(5)=0OR N1(6)=0THEN 7457
   : GOSUB '149(N(N3,3)+N0(7),N0(10),N1(6))
   : IF N1(3)=0THEN GOTO 7451
   : ELSE M=N1(3)
   : GOTO 7457
7451 N1(2)=VAL(STR(N0$(),N1(5)),2)
   : IF N1(2)=0THEN 7457
   : MAT COPY K8$()TO N0$()<N1(5)+2,N1(2)>
   : GOSUB '148(N(N3,3)+N0(7),N0(10),N1(6))
7457 $CLOSE#N0
   : RETURN
7779 DEFFN'153(M$,K8$(),M1$,M2$,M3$,M4$,M5$,M6$)
   : M=0
   : IF M$<>"RW"AND M$<>" "THEN 7799
   : M9$=M1$&M4$
   : GOSUB '157(M9$)
   : IF M<>0THEN 7797
   : M0$=M2$
   : GOSUB 7804
   : IF M<>0THEN 7802
   : IF M4$=" "THEN 7786
   : M0$=M5$
   : GOSUB 7804
   : IF M<>0THEN 7802
7786 IF K8$()<>" "THEN IF LEN(K8$())>K7(6)-K7(5)THEN 7801
   : GOSUB '158
   : IF K8$()<>" "THEN MAT COPY -K8$()<1,K7(6)-K7(5)>TO -K8$()<K7(5)+1,K7(6)-K
     7(5)>
   : STR(K8$(),1,K7(5))=N0$
   : IF M$<>"RW"THEN 7795
   : GOSUB '143(N0$,"EQ",K7(7))
   : IF M=52THEN 7795
   : IF M<>0THEN 7802
   : GOSUB '145(K7(7))
   : GOTO 7802
7795 GOSUB '142(N0$,K7(6),K7(7))
   : GOTO 7802
7797 M=56
   : GOTO 7802
7799 M=54
   : GOTO 7802
7801 M=65
   : GOTO 7802
7802 RETURN
7804 IF M0$=" "THEN 7808
   : FOR I=1TO LEN(M0$)
   : I1=VAL(STR(M0$,I,1))
   : IF I1<32OR I1>122THEN 7808
   : NEXT I
   : GOTO 7809
7808 M=58
7809 RETURN