100 REM *******************************
101 REM * DIDMERGE.BAC                *
102 REM * VER 1.3 / 1983-01-01        *
103 REM * Gjort av Nils H{ggblom      *
104 REM * Mod. av Nils H{ggblom       *
105 REM * Ins{nt av Nils H{ggblom     *
106 REM *******************************
107 N9%=103%
108 DIM F$(29%)=12%,S0$(N9%+1%)=50%,A%(N9%+1%),B%(N9%+1%),X$(1%)=17%,X$=120%,X0$=25%,Y1$=90%
109 DIM E0$=4%,E1$=14%,D0$=4%,W0$=20%,W$=20%,Z$=20%
110 \%=PEEK(65420%)-1%
111 DEFFNF1(X%,Y%)=FNK0%(X%)/(FNK0%(Y%)+0)+.00001
112 DEFFNK0%(X%)=X%/D2% AND 255%
113 DEFFNL0%(X$,Y$)=MID$(X$,D1%,25%)<MID$(Y$,D1%,25%)
114 DEFFNL1%(X$,Y$)=MID$(X$,D1%,25%)=MID$(Y$,D1%,25%)
115 D0$='Dr1:' : W$='Ahaa ...' : B0$=SPACE$(50%)
116 FOR X%=0% TO N9% : S0$(X%)=B0$ : NEXT X%
117 ONERRORGOTO 122
118 OPEN 'Dr 1: Dumpfil' ASFILE 1%
119 INPUT #1%,F$(N%),Z%
120 N%=N%+1%
121 GOTO 119
122 IF ERRCODE<>34% ; CHR$(12%)'Felet'ERRCODE' uppstod.' : END 
123 CLOSE 1%
124 N%=N%-1%
125 KILL 'Dr 1: Dumpfil'
126 X$(0%)='i bokstavsordning'
127 X$(1%)='efter felfrekvens'
128 Y1$=CUR(22%,0%)+SPACE$(79%)+CUR(22%,0%) : ; Y1$'Sortera efter f{lt ';
129 GET X$
130 IF X$<>'1' AND X$<>'2' 129
131 ; X$ : D%=VAL(X$)-1% : D1%=D%*25%+1% : D2%=D%*255%+1%
132 ; CUR(23%,0%)'Maximal utfilsl{ngd : '; : L%=5% : GOSUB 252 : ; '     ';
133 X=VAL(X$) : IF X<0% OR X>50000 THEN 132 ELSE L9%=X
134 IF L9%<9% 132
135 ; CUR(22%,0%)SPACE$(79%);CUR(22%,0%);
136 ; 'S{tt en skiva d{r det finns tillr{ckligtmed rum f|r utfilerna i DR1:';
137 GET X$ : ; '';
138 GOSUB 213
139 U1%=0% : FOR I%=0% TO N%
140 X0%=0%
141 OPEN F$(I%) ASFILE 1%
142 INPUT #1%,X$
143 ONERRORGOTO 158
144 GOSUB 202
145 INPUTLINE #1%X$ : INPUT #1%,Z1%,Z2%
146 X0%=X0%+1%
147 IF NOT F2% T%=T%+1%
148 X$=LEFT$(X$,LEN(X$)-2%)
149 ON \%+1% GOSUB 181,191 : IF L1% 143
150 FOR X%=0% TO U1%-1%
151 ON \%+1% GOSUB 170,175
152 IF L4% 155
153 NEXT X%
154 IF U1%=N9% 143
155 GOSUB 218
156 IF U1%<>N9% U1%=U1%+1% : U%=U%+1%
157 GOTO 143
158 REM Flera filer?
159 CLOSE 1% : NEXT I% : F2%=65535%
160 GOSUB 227
161 IF T%<>U% AND U1%=N9% 139
162 IF U0%=0% CLOSE 2% : KILL D0$+E1$+E0$
163 ; CUR(0%,0%) : CLOSE 1% : CLOSE 2%
164 ; Y1$'S{tt Didactos tillbaka i Dr1: om det    inte redan {r d{r.'; : GET X$
165 ONERRORGOTO 164
166 OPEN 'Dr1: Didactos.bac' ASFILE 1%
167 CLOSE 1%
168 ; CUR(0%,0%); : CHAIN 'Dr1:Didactos'
169 STOP 
170 REM Bokstavsordning
171 F%=0% : L4%=0%
172 IF FNL1%(X$,S0$(X%)) IF NOT F% F%=65535% : GOTO 177 ELSE RETURN 
173 L4%=FNL0%(X$,S0$(X%))
174 RETURN 
175 REM Felfrekvensordning
176 F%=0% : L4%=0%
177 Z3%=A%(X%) : Z4%=B%(X%) : GOSUB 208
178 IF W0$=Z$ IF NOT F% F%=65535% : GOTO 172 ELSE RETURN 
179 L4%=W0$<Z$
180 RETURN 
181 REM Bokstav-skip
182 F%=0% : L1%=0%
183 IF FNL0%(X$,B0$) 201
184 IF NOT FNL1%(B0$,X$) 187
185 GOSUB 206 : Z$=W$
186 IF Z$>=W$ 201
187 IF U1%=N9% IF FNL0%(S0$(U1%-1%),X$) 201 ELSE 188 ELSE RETURN 
188 IF NOT FNL1%(X$,S0$(U1%-1%)) RETURN 
189 IF NOT F% F%=65535% : GOTO 196
190 GOTO 201
191 REM Felfrekvens-skip
192 F%=0% : L1%=0%
193 GOSUB 206 : Z$=W0$
194 IF Z$>W$ 201
195 IF Z$=W$ IF FNL0%(X$,B0$) OR FNL1%(B0$,X$) 201
196 IF U1%=N9% Z3%=A%(U1%-1%) : Z4%=B%(U1%-1%) : GOSUB 208 : IF W0$>Z$ 201 ELSE 197 ELSE RETURN 
197 IF W0$<>Z$ RETURN 
198 IF NOT F% F%=65535% : GOTO 187
199 GOTO 201
200 RETURN 
201 L1%=65535% : RETURN 
202 REM Meddela status
203 ; CUR(22%,6%)E1$E0$TAB(21%)CUR(23%,6%)F$(I%)TAB(21%);
204 ; CUR(23%,22%)X0%TAB(27%)':'U0%TAB(33%)':'T%TAB(39%);
205 RETURN 
206 REM Kvot
207 Z3%=Z1% : Z4%=Z2%
208 ONERRORGOTO 212
209 Y=FNF1(Z3%,Z4%)
210 W0$=NUM$(FNK0%(Z4%)-FNK0%(Z3%)) : W0$=SPACE$(4%-LEN(W0$))+W0$
211 W0$=NUM$(Y)+W0$ : RETURN 
212 Y=2% : GOTO 210
213 REM Mask
214 ; CUR(22%,0%)SPACE$(79%);
215 ; CUR(22%,0%)'Utfil:' : ; 'Infil:';
216 ; CUR(22%,22%)'Infil:Utfil:Totalt';
217 RETURN 
218 REM Skjut in
219 FOR Y%=U1%-1% TO X% STEP 65535%
220 S0$(Y%+1%)=S0$(Y%)
221 A%(Y%+1%)=A%(Y%)
222 B%(Y%+1%)=B%(Y%)
223 NEXT Y%
224 S0$(X%)=X$
225 A%(X%)=Z1% : B%(X%)=Z2%
226 RETURN 
227 REM Output
228 ONERRORGOTO 246
229 FOR Y%=0% TO U1%-1%
230 Z%=U%-U1%+Y% : IF Z%/L9%=(Z%+0)/L9% GOSUB 260
231 IF Z%-Z%/L9%*L9%<>100% 237
232 E0$='.dim'
233 ONERRORGOTO 235
234 KILL D0$+E1$+E0$
235 ONERRORGOTO 246
236 NAME D0$+E1$+'.did' AS E1$+E0$
237 ; #2%S0$(Y%)
238 ; #2%A%(Y%)
239 ; #2%B%(Y%)
240 U0%=U0%+1%
241 GOSUB 202
242 NEXT Y%
243 B0$=S0$(Y%-1%)
244 Z3%=A%(Y%-1%) : Z4%=B%(Y%-1%) : GOSUB 208 : W$=W0$
245 RETURN 
246 IF ERRCODE<>41% 122
247 CLOSE 2%
248 KILL D0$+E1$+E0$
249 E1$=CHR$(7%)+'Skivan full'
250 GOSUB 202
251 GOTO 163
252 REM Inmatning
253 X$=''
254 X%=LEN(X$) : GET Y$ : Y%=ASC(Y$) : IF Y%=13% IF X%<>0% RETURN ELSE 254
255 IF X%=L% AND Y%<>8% 254
256 IF Y%=8% IF X% X$=LEFT$(X$,X%-1%) : ; CHR$(8%)' 'CHR$(8%);
257 IF Y%<48% OR Y%>57% 254
258 ; Y$; : X$=X$+Y$
259 GOTO 254
260 REM Sk|t om utfilen
261 CLOSE 2% : U0%=0%
262 E1$='Ut'+NUM$((U%-U1%+Y%)/L9%+1%) : E0$='.did'
263 PREPARE D0$+E1$+E0$ ASFILE 2%
264 X$='Detta {r en fil som sorterats           '+X$(\%)+' utg}ende'
265 X$=X$+SPACE$(80%-LEN(X$))+'fr}n flera sm} filer.'
266 ; #2%X$
267 RETURN