start tok64 d64-bxu38B
10 ck=0
20 PRINT CHR$(14)"{clear}{down*2}{right*7}Insert disk to be sorted."
30 PRINT"{down}{right}Press [RETURN] to begin directory sort."
40 GET z$: IF z$<>CHR$(13) THEN40
50 IF ck=0 THEN GOSUB430
60 IF ck=1 THEN GOSUB440
70 GOTO210
80 PRINT"{down}Sorting":sk=k1:l%(k1)=k1:r%(1)=nf
90 l1=l%(sk):r1=r%(sk):sk=sk-1
100 l2=l1:r2=r1:ke$=ns$(INT((l1+r1)/2))
110 ke$=MID$(ke$,31)+MID$(ke$,4,m%(INT((l1+r1)/2)))
120 IFMID$(ns$(l2),31)+MID$(ns$(l2),4,m%(l2))<ke$THENl2=l2+k1:GOTO120
130 IFke$<MID$(ns$(r2),31)+MID$(ns$(r2),4,m%(r2))THENr2=r2-k1:GOTO130
140 IFl2>r2THEN170
150 n$=ns$(r2):h=m%(r2):ns$(r2)=ns$(l2):m%(r2)=m%(l2)
160 ns$(l2)=n$:m%(l2)=h:l2=l2+1:r2=r2-1:GOTO120
170 IFl2<r1THENsk=sk+1:l%(sk)=l2:r%(sk)=r1
180 r1=r2:IFl1<r1THEN100
190 IFskTHEN90
200 RETURN
210 nf=0:GOSUB390
220 GOSUB410:FORpp=1TO8:r$="":fl=0:m%(nf+1)=16:FORx=1TO30:GET#5,i$
230 IFi$=CHR$(160)ANDfl=0THENm%(nf+1)=x-4:fl=1
240 r$=r$+LEFT$(i$+c0$,1):NEXT:IFpp<>8THENGET#5,i$,i$
250 x$=c0$:IFMID$(r$,1,1)=c0$THENx$=CHR$(255):PRINTdd$;
260 nf=nf+1:ns$(nf)=r$+x$:PRINTMID$(r$,4,16):NEXTpp:IFys<>255THEN220
270 CLOSE5:GOSUB80
280 PRINT"{down}Press space bar to rewrite directory"
290 GETa$:IFa$<>" "THEN290
300 GOSUB390:nn=0
310 GOSUB410:FORpp=1TO8:nn=nn+1
320 PRINT#5,MID$(ns$(nn),1,30);:IFMID$(ns$(nn),31)=CHR$(255)THENPRINTdd$;
330 PRINTMID$(ns$(nn),4,16):IFpp<>8THENPRINT#5,c0$;c0$;
340 NEXTpp:PRINT#15,"u2";5;0;lt;ls:IFys<>255THEN310
350 CLOSE5:CLOSE15:PRINT"{down*2}{right*2}{down*2}Sort another disk?{space*2}(y/n)": ck=1
360 GET z$: IF z$="n" THEN PRINT"{clear}":END
370 IF z$="y" THEN20
380 IF z$ <> "n" OR z$ <> "y" THEN360
390 OPEN5,8,5,"#":yt=18:ys=0:GOSUB410:PRINT#15,"b-p";5;143:PRINTCHR$(14)
400 PRINTrn$;:FORx=1TO24:GET#5,i$:PRINTi$;:NEXT:PRINTrf$:RETURN
410 PRINT#15,"u1";5;0;yt;ys:lt=yt:ls=ys:GET#5,t$,s$:yt=ASC(t$+c0$)
420 ys=ASC(s$+c0$):RETURN
430 x=150:DIM l%(x),m%(x),r%(x),ns$(x)
440 k1=1:OPEN15,8,15,"i":c0$=CHR$(0):nf=0
450 dd$="{:*14}deleted{cm +}":rn$=CHR$(18):rf$=CHR$(146):RETURN
stop tok64
(bastext 1.0)