1 REM Ins{nd av Johan Olofsson <5809>    1987-09-02 04.09.18 (DUMP)
10 ! +-------------------------------+ 
11 ! !                               ! 
12 ! !      S o r t   F i l e        ! 
13 ! !                               ! 
14 ! ! Program f|r sortering av      ! 
15 ! ! rader i ASCII-ordning.        ! 
16 ! !                               ! 
17 ! ! Programmet f|ruts{tter        ! 
18 ! ! att inputfilen {r en text-    ! 
19 ! ! fil och kan l{sas med INPUT   ! 
20 ! ! LINE, men filen kan i |vrigt  ! 
21 ! ! vid initiering av DOSet.      ! 
22 ! ! se ut hur som helst.          ! 
23 ! !                               ! 
24 ! ! Programmet f}r kopieras fritt ! 
25 ! ! [VEN i kommersiellt syfte !   ! 
26 ! !                               ! 
27 ! +-------------------------------+ 
28 ! * 
29 ! * Date     / VerRev / Sign / Note 
30 ! * --------   ------   ----   ---- 
31 ! * 87-09-02 /  1.00  / LogIn/ SortFile / 
40 ! * 
100 INTEGER : EXTEND 
110 DIM Rad$=162 
120 Slen=3 ! L{ngd p} del av str{ngen som sorteras i taget 
121 ! Litet v{rde ==> m}nga rader kan sorteras 
130 T=-1 : F=0 ! True / False 
140 ! ----------------------------------------------------------------------- 
150 INPUT 'Fil att sortera str{ngar i:'Infil$ 
160 OPEN Infil$ AS FILE 1 
170 INPUT 'Output: 'Utfil$ 
180 PREPARE Utfil$ AS FILE 2 
190 WHILE -1 
200   INPUT LINE #1 Rad$ 
210   Rad$=LEFT$(Rad$,LEN(Rad$)-2) : IF Rad$='' GOTO 200 
220   ; Rad$ 
230   INPUT 'Sorterar fr}n och med position: 'Startpos; 
240   ; CHR$(13) TAB(Startpos) '>' TAB(79) 
250   ; Rad$ 
260   INPUT 'Sorterar till och med position: 'Slutpos; 
270   ! H|gst tre tecken efter slutpos kan p}verka den sorterade ordningen 
280   IF Slutpos<=Startpos THEN Slutpos=160 
290   ; CHR$(13) TAB(Startpos) '>'; 
300   IF Slutpos<=80 THEN ; TAB(Slutpos) '<'; 
310   ; TAB(80) 
320 INPUT 'O K  ? 'Z$ : IF (95 AND ASCII(Z$))<>ASCII('J') WEND 
330 INPUT 'Ska f|r korta rader skrivas p} '+Utfil$+' ?'Z$ 
340 Dump=(95 AND ASCII(Z$))=ASCII('J') 
350 ! ----------------------------------------------------------------------- 
360 ON ERROR GOTO 420 
370 POSIT #1,0 : Antal=0 
380 WHILE -1 
390   INPUT LINE #1,Rad$ 
400   IF LEN(Rad$)-2>Startpos THEN Antal=Antal+1 
410 WEND 
420 ! 
430 ; Antal+1 ' rader att sortera' 
440 DIM Adr.(Antal),Str$(Antal)=Slen,N(Antal) 
450 ! ----------------------------------------------------------------------- 
460 ON ERROR GOTO 580 
470 POSIT #1,0 
480 FOR Line=0 TO Antal 
490   WHILE -1 
500     Adr.(Line)=POSIT(1) 
510     INPUT LINE #1,Rad$ ! : Rad$=LEFT$(Rad$,LEN(Rad$)-2) 
520     WHILE LEN(Rad$)-2<Startpos 
530       IF Dump ; #2 LEFT$(Rad$,LEN(Rad$)-2) 
540   IF 0 WEND ELSE WEND 
550   N(Line)=Line 
560 NEXT Line 
570 ! ----------------------------------------------------------------------- 
580 ! 
590 ! Antal=Line-1 
600 Z=FNBearb(0,Antal,Startpos) 
610 ! 
620 FOR Line=0 TO Antal 
630   POSIT #1,Adr.(N(Line)) 
640   INPUT LINE #1,Rad$ 
650   ; Rad$; 
660   ; #2 Rad$; 
670 NEXT Line 
680 ! 
690 END 
900 ! ----------------------------------------------------------------------- 
910 DEF FNB$(T)=Str$(N(T)) ! sorteringskriterium 
920 ! ----------------------------------------------------------------------- 
1000 DEF FNBearb(Start,Stop,Pos) LOCAL Klara,Old$=3,Adam,Bertil 
1010   WHILE Pos<Slutpos AND Start<Stop 
1020     ; CHR$(13) 'Bearb:',Start,Stop,Pos; 
1030     Klara=-1 
1040     FOR Line=Start TO Stop 
1050       POSIT #1,Adr.(N(Line)) 
1060       INPUT LINE #1,Rad$ : Rad$=LEFT$(Rad$,LEN(Rad$)-2) 
1070       WHILE LEN(Rad$)<Pos 
1080         IF Start<Line-1 THEN Z=FNBearb(Start,Line-1,Pos) 
1090         IF Line+1<Stop THEN Z=FNBearb(Line+1,Stop,Pos) 
1100         RETURN 0 
1110       IF 0 WEND 
1120       Rad$=RIGHT$(Rad$,Pos) 
1130       Str$(N(Line))=LEFT$(Rad$+CHR$(0,0),3) 
1140       IF Line=Start THEN Old$=Str$(N(Line)) 
1150       IF Klara THEN IF Old$<>Str$(N(Line)) THEN Klara=0 
1160     NEXT Line 
1170     IF Klara ; CHR$(13); ELSE ; 
1180     IF NOT Klara THEN Z=FNSort(Start,Stop) 
1190     Adam=Start 
1200     WHILE Adam<Stop 
1210       Bertil=Adam+1 
1220       WHILE Bertil<=Stop 
1230         WHILE FNB$(Adam)=FNB$(Bertil) 
1240           Bertil=Bertil+1 
1250       IF 0 WEND ELSE WEND 
1260       WHILE Bertil-Adam>1 
1270         Z=FNBearb(Adam,Bertil-1,Pos+3) 
1280       IF 0 WEND 
1290       Adam=Bertil 
1300     WEND 
1310   IF 0 WEND 
1320   RETURN 0 
1330 FNEND 
1499 ! 
1500 DEF FNDiff$(S1$,S2$) LOCAL Startval,Slutval 
1510   ! b}da str{ngarna skall vara lika l}nga ! 
1520   FOR H=1 TO LEN(S1$) 
1530   IF ASCII(RIGHT$(S1$,H))=ASCII(RIGHT$(S2$,H)) THEN NEXT H : RETURN S1$ 
1531   Startval=ASCII(RIGHT$(S1$,H)) 
1532   Slutval=ASCII(RIGHT$(S2$,H)) 
1540   RETURN LEFT$(S1$,H-1)+CHR$((Startval+Slutval)/2) 
1550 FNEND 
1599 ! 
1600 DEF FNByt(K1,L1) 
1605   Z=N(K1) : N(K1)=N(L1) : N(L1)=Z ! byter nycklar ! 
1640   RETURN F 
1650 FNEND 
1699 ! 
2000 DEF FNSort(Start,Slut) LOCAL Gr{ns,Bytt,K,L 
2003   WHILE Slut>Start 
2005     ; CHR$(13) 'Sort:',Start,Slut; 
2010     ! IF FNCheck(Start,Slut)=Slut THEN RETURN 0 
2011     ! {ter mer tid som tj{nas! 
2012     ! om det inte {r f{rdigsorterat i stora avsnitt! 
2050     Diff$=FNDiff$(FNB$(Start),FNB$(Slut)) 
2060     K=Start : L=Slut 
2065     WHILE K<L 
2070       WHILE FNB$(K)<Diff$+'' 
2080         K=K+1 
2090       IF K<L WEND ELSE 2130 
2100       WHILE FNB$(L)>=Diff$+'' 
2110         L=L-1 
2120       IF K<L WEND 
2130       IF K<L IF FNB$(K)>FNB$(L) THEN Z=FNByt(K,L) ELSE K=K+1 
2140     WEND 
2141     Gr{ns=K 
2151     IF Start<K-1 IF K-1<Slut Z=FNSort(Start,K-1) 
2153     IF Start<Gr{ns IF Gr{ns<Slut THEN Z=FNSort(Gr{ns,Slut) 
2160   IF 0 WEND 
2554   RETURN F 
3000 FNEND