1 COMMON A, AL, B, BASEONLY, C, C$, C1, CAT$, CC, CKT$, D, D$, DD, DIA, DIMN$, DMS, E, EO, EX$, F, F$, FD, FF, FQ, FRQ, G$, GO$, I, I$, L, LATLONG, LD, LL, LN, LS, LW, LX, MAX, MENU, MIN, MX, N, NN, NT, OV, P, PI, PROG$, Q, QQ, QU, R, RA, RC, T, T$, U, U$, UH, UL$, V$, VC, W, WHIP, WIRD, WW, X, X$, X1, XS, Z$, ZP, ZS
5 'OMMON EX$,PROG$
10 'NUMSORT' - Number Sorter  - 01 JAN 2003
20 CLS:KEY OFF
30 IF EX$=""THEN EX$="EXIT"
40 IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
50 
60 DIM A(500)
70 VIEW PRINT
80 '
90 '.....title page
100 CLS
110 COLOR 15,2,1
120 PRINT " Number Sorter";TAB(57);"by George Murphy VE3ERP ";
130 COLOR 1,0:PRINT STRING$(80,223);
140 COLOR 7,0
150 '
160 '.....preface
170 PRINT TAB(7);"This program sorts up to 500 6-digit integers (whole ";
180 PRINT "numbers)."
190 PRINT
200 PRINT TAB(7);"To run program.....press 1"
210 PRINT TAB(7);"To EXIT............press 0"
220 Z$=INKEY$:IF Z$=""THEN 220
230 IF Z$="0"THEN CHAIN EX$
240 IF Z$="1"THEN 270
250 GOTO 220
260 '
270 '.....start
280 REM  (Shell-Metzner algorithm) QST Dec 1985, page 53
290 CLS :COLOR 7,0,0
300 SN=0
310 '....input numbers to be sorted
320 X$=""
330 PRINT "........ENTER a number to be sorted"
340 PRINT "or......ENTER 0 (zero) to sort numbers already entered"
350 PRINT "or......ENTER x to erase last number entered"
360 LN=CSRLIN:VIEW PRINT LN TO 24
370 INPUT "........";N$:N=VAL(N$)
380 IF N$<>"x"THEN 420
390 IF SN=0 THEN 420
400 LN=CSRLIN-2:VIEW PRINT LN TO 23:CLS:VIEW PRINT:LOCATE LN
410 SN=SN-1
420 IF N$="0"THEN GOSUB 500:GOTO 630
430 IF N<10^6 THEN 460
440 LOCATE CSRLIN-1:BEEP:COLOR 0,7
450 PRINT " Number must be less than 1,000,000 ";:COLOR 7,0:GOTO 330
460 SN=SN+1
470 A(SN)=N
480 GOTO 370
490 '
500 '.....start sort
510 'SN= (no. of data)
520 SM=SN
530 SM=INT(SM/2):IF SM=0 THEN CLS:GOTO 610 ELSE CLS:PRINT SM*2
540 SK=SN-SM:SJ=1
550 SI=SJ
560 SL=SI+SM
570 IF A(SI)<=A(SL)THEN 590 ELSE SWAP A(SI),A(SL)
580 SI=SI-SM:IF SI>0 THEN 560
590 SJ=SJ+1:IF SJ>SK THEN 530
600 GOTO 550
610 RETURN
620 '
630 '.....screen display
640 VIEW PRINT:CLS
650 PRINT SN;;"numbers sorted:"
660 FOR Z=1 TO SN
670 IF A(Z)=0 THEN 690
680 PRINT USING "  ######";A(Z);
690 NEXT Z:PRINT ""
700 GOTO 730
710 '.....end
720 '
730 GOSUB 750:GOTO 90
740 '
750 '.....PRT
760 KEY OFF:GOSUB 830:LOCATE 25,5:COLOR 0,2
770 PRINT " Send this page to:(1)Printer Queue? (2)Printout? ";
780 PRINT "(3)Next page? (1/2/3)";:COLOR 7,0
790 Z$=INKEY$:IF Z$<"1"OR Z$>"3"THEN 790 ELSE GOSUB 830
800 IF Z$="3"THEN RETURN
810 FOR I%=1 TO 24:FOR J%=1 TO 80:LPRINT CHR$(SCREEN(I%,J%));:NEXT J%:NEXT I%
820 IF Z$="2"THEN LPRINT CHR$(12) ELSE 760
830 LOCATE 25,1:PRINT STRING$(80,32);:RETURN
840 STOP
