Compucolor.org – Virtual Media

Listing of file='NGSORT.BAS;01' on disk='vmedia/chip_77-sector.ccvf'

1 CLEAR 7000:DIM H$(288)
2 PLOT 12,15:INPUT "INDEX SORT.DO YOU WANT INSTRUCTIONS?:";ZX$
3 IF LEFT$ (ZX$,1)= "Y"THEN 31
4 PRINT :PRINT "NATGEO SORT ROUTINE.INSERT DISK WITH UNSORTED FILE AND "
5 PRINT :INPUT "PRESS RETURN:";Z$:GG= 0:NZ= 0
7 KC$= "
8 KC$= "0-B":KA$= "0":KB$= "B":XK= 2:GOSUB 16
9 KC$= "C":KA$= "C":KB$= "C":XK= QQ:GOSUB 16
10 KC$= "D-F":KA$= "D":KB$= "F":XK= QQ:GOSUB 16
11 KC$= "G-I":KA$= "G":KB$= "I":XK= QQ:GOSUB 16
12 KC$= "J-M":KA$= "J":KB$= "M":XK= QQ:GOSUB 16
13 KC$= "N-R":KA$= "N":KB$= "R":XK= QQ:GOSUB 16
14 KC$= "S":KA$= "S":KB$= "S":XK= QQ:GOSUB 16
15 KC$= "T-Z":KA$= "T":KB$= "Z":XK= QQ:GOSUB 16:GOTO 30
16 FILE "R",3,"NATGEO",1:GET 3,1;LR:AB= 0:AC= 0
17 FOR ZA= 2TO LR:GET 3,ZA;H$[25]:IF MID$ (H$,3,1)< KA$OR MID$ (H$,3,1)> KB$THEN 19
18 AB= AB+ 1:GG= GG+ 1:H$(AB)= H$:PRINT KC$,AB,GG,ZA,RIGHT$ (H$(AB),23)
19 NEXT ZA
20 FILE "C",3:PRINT "COMMENCING TO SORT":PRINT "CURRENT SORT INCREMENT:"
21 L= (2^ INT (LOG (AB+ 1)/ LOG (2)))- 1
22 L= INT (L/ 2):PRINT L:IF L< 1THEN 27
23 FOR I= 1TO L:FOR J= I+ LTO AB+ 1STEP L:K= J:T$= H$(K)
24 IF RIGHT$ (H$(K- L),23)< = RIGHT$ (T$,23)THEN 26
25 H$(K)= H$(K- L):K= K- L:IF K> LTHEN 24
26 H$(K)= T$:NEXT J,I:GOTO 22
27 PRINT :INPUT "CHANGE SIDES AND PRESS RETURN:";XC$:FILE "R",2,"NGLIST",16
28 FOR QQ= XKTO GG+ 1:AC= AC+ 1:PRINT AC,QQ,RIGHT$ (H$(AC+ 1),23):PUT 2,QQ;H$(AC+ 1)[25]:NEXT QQ:PUT 2,1;GG+ 1:FILE "C",2
29 PRINT :INPUT "CHANGE SIDES AND PRESS RETURN:";XC$:RETURN
30 PRINT "NATGEO SORTING COMPLETE! UNSORTED FILE NAMED 'NATGEO'":END
31 PLOT 12
32 PRINT "THIS PROGRAM SORTS THE INDEX INTO ALPHABETICAL ORDER,THUS"
33 PRINT :PRINT "ENABLING A SEARCH TO BE MADE FOR SPECIFIC ARTICLES."
34 PRINT :PRINT "BEFORE SORTING ENSURE THAT ALL NEW ARTICLES ARE INCLUDED"
35 PRINT :PRINT "AND ANY EDITING REQUIRED HAS BEEN CARRIED OUT.
36 PRINT :PRINT "THE SORTED RECORDS ARE WRITTEN TO THE FILE ON THE OTHER SIDE"
37 PRINT :PRINT "OF THE DISK.WHEN SORTING IS COMPLETED THE UNSORTED FILE WILL"
38 PRINT :PRINT "BE RE-NAMED 'NATGEO'."
39 PRINT :INPUT "PRESS RETURN TO START SORTING";ZZ$
40 GOTO 4