10 REM SWESORT Sortering i korrekt alfabetisk ordning av fil 1980-03-09
20 REM Program av Gunnar Tidner
30 REM Key P9%,L9% Recordl{ngd R9%
40 DIM C$(127%)=1%,D1$=9%,D2$=9%
50 D1$="@[\^`{|~_"
60 D2$="E`aUE`aU-"
70 FOR B%=1% TO 95%
80 C$(B%)=CHR$(B%)
90 NEXT B%
100 FOR B%=96% TO 127%
110 C$(B%)=CHR$(B% AND 223%)
120 NEXT B%
130 FOR I%=1% TO LEN(D1$)
140 C$(ASC(RIGHT$(D1$,I%)))=MID$(D2$,I%,1%)
150 NEXT I%
160 REM Slut initiering
170 ; "Infil:"; : INPUT F1$
180 ; "Recordl{ngd (exkl CRLF):"; : INPUT R9%
190 ; "Sorteringsnyckel (startpos,l{ngd):"; : INPUT P9%,L9%
200 OPEN F1$ ASFILE 1
210 PREPARE "DR1:SORT.TMP" ASFILE 2
220 ; "Sortera till fil:"; : INPUT F3$
230 ONERRORGOTO 400
240 M1%=14800%
250 N%=M1%/(4%+L9%) : IF N%>1000% THEN N%=1000%
260 ; "H|gst";N%;" records kan sorteras"
270 N1%=253%/R9%
280 DIM Q0$=253%,S$(N%)=L9%+4%,B$=150%,A$=L9%,A1$=L9%
290 I%=0%
300 FOR F%=0% TO 300%
310 Z%=CALL(28666%,2%) : Q0$=""
320 FOR J%=1% TO N1%
330 INPUTLINE #1,B$ : B$=LEFT$(B$,LEN(B$)-2%)+SPACE$(R9%+2%-LEN(B$)) : I%=I%+1%
340 A$=MID$(B$,P9%,L9%) : GOSUB 710
350 S$(I%)=RIGHT$(NUM$(I%+10000%),3%)+A1$
360 Q0$=Q0$+B$
370 NEXT J%
380 Z%=CALL(28670%,F%)
390 NEXT F%
400 IF ERRCODE=34% THEN Z%=CALL(28670%,F%) : N%=I% ELSE ; "Fel nr";ERRCODE : STOP 
410 CLOSE 1
420 ; "Byt disk i DR0 f|r utfilen?!" : OUT 6,131 : GET C$
430 ; "Start sortering"
440 M%=N% : J9%=0%
450 M%=M%/2%
460 IF M%=0% THEN 550
470 FOR J%=1% TO N%-M%
480 FOR I%=J% TO 1% STEP -M%
490 K%=I%+M%
500 J9%=J9%+1%
510 IF RIGHT$(S$(I%),5%)<=RIGHT$(S$(K%),5%) THEN 540
520 T$=S$(K%) : S$(K%)=S$(I%) : S$(I%)=T$
530 NEXT I%
540 NEXT J% : GOTO 450
550 OUT 6,131 : ; "Sorterat";N%;" records"
560 ; J9%;" j{mf|relser"
570 ONERRORGOTO 700
580 PREPARE F3$ ASFILE 3
590 FOR I%=1% TO N%
600 J%=VAL(LEFT$(S$(I%),4%))-1%
610 F%=J%/N1% : K%=J%-F%*N1%
620 Z%=CALL(28666%,2%)+CALL(28668%,F%) : B$=MID$(Q0$,1%+K%*R9%,R9%)
630 W%=LEN(B$) : IF ASC(RIGHT$(B$,W%))=32% THEN B$=LEFT$(B$,W%-1%) : GOTO 630
640 ; #3,B$
650 NEXT I%
660 CLOSE 3
670 CLOSE 2
680 ; "Sorterad fil: ";F3$
690 END 
700 ; "Fel nr:";ERRCODE : STOP 
710 REM SUB skapa korrekt sort-underlag
720 A1$=""
730 FOR A%=1% TO L9%
740 B%=ASC(RIGHT$(A$,A%))
750 A1$=A1$+C$(B%)
760 NEXT A%
770 RETURN