bwBASIC/BP100/SORT3.BAS

1 REM SORT3  
5 CLS  
10000 PRINT  "        SHELL SORT ROUTINE"  
10020 PRINT   
10030 PRINT  "THE INPUT OF THIS PROGRAM IS A LIST OF WORDS.(OR POS NOS.).  
10040 PRINT  "THE OUTPUT IS THE LIST IN ALPHABETICAL (OR NUMERICAL)ORDER.  
10050 PRINT  "WHEN INPUTTING THE DATA DO NOT IMBED COMMAS WITHIN INPUT  
10060 PRINT  "WORDS OR NUMBERS OR USE NEGATIVE NUMBERS."  
10070 PRINT "THE SHELL SORT IS GENERALLY MORE EFFICIENT THAN THE EASIER TO  
10080 PRINT  "UNDERSTAND BUBBLE SORT.  
10082 PRINT "   THERE IS AN OPTION TO PRINT OUT BOTH THE ORIGINAL AND THE  
10084 PRINT "SORTED LISTS ON THE LINE PRINTER."  
10085 PRINT   
10090 INPUT  "PRESS ENTER TO BEGIN";Z9  
10100 CLS  
10105 CLEAR  2000  
10110 INPUT  "WHAT IS THE MAXIMUM NUMBER OF ITEMS YOU WISH TO SORT";NM  
10130 DIM  A$(NM)  
10140 PRINT :INPUT "DO YOU WANT OUTPUT TO GO TO THE LINE PRINTER(Y/N)";Z2$  
10145 IF  Z2$<>"Y"  AND  Z2$<>"N"  THEN  PRINT "INPUT ERROR":GOTO  10140  
10150 INPUT "PRESS 1 FOR ALPHABETIC DATA, 2 FOR NUMERIC DATA";AN  
10160 IF  AN=1  OR  AN = 2 THEN GOTO  10200  
10170 PRINT  "INPUT ERROR. TRY AGAIN."  
10180 FOR  I= 1  TO  300:NEXT  I  
10190 GOTO  10150  
10200 GOSUB 10500 :REM INPUT SUBROUTINE  
10210 GOSUB 10600 :REM PRINT ORIGINAL LIST  
10220 GOSUB 10700 :REM SORTING SUBROUTINE  
10230 GOSUB 10800 :REM PRINT SORTED LIST  
10250 END  
10500 REM INPUT SUBROUTINE  
10510 I=0  
10520 PRINT  "INPUT ITEM";I+1;" (99999 TO END)";:INPUT  A$(I+1)  
10530 IF  A$(I+1)="99999" THEN GOTO  10590  
10540 I=I+1  
10550 GOTO  10520  
10590 RETURN   
10600 REM PRINT ORIGINAL LIST 14 AT A TIME  
10605 INPUT  "TO PRINT ORIGINAL LIST PRESS ENTER";Z9  
10607 IF  Z2$="Y"  THEN  INPUT "PRESS ENTER WHEN PRINTER READY";Z9$: LPRINT  TAB(15); "ORIGINAL LIST": LPRINT  " "  
10610 GOSUB 10900:REM PRINT HEADING  
10620  FOR  L=1  TO  I  
10630 PRINT USING  Z8$;L,A$(L)  
10635 IF  Z2$="Y"  THEN  LPRINT  USING  Z8$;L,A$(L): GOTO  10670  
10640 IF  L/14 <>INT(L/14) THEN GOTO  10670  
10650 INPUT  "PRESS ENTER FOR MORE OF LISTING";Z9  
10660 GOSUB  10900  
10670 NEXT  L  
10680 INPUT  "PRESS ENTER TO CONTINUE";Z9  
10690 RETURN   
10700 REM SORTING SUBROUTINE  
10702 AD$="00000000000000000000"  
10705 CLS:PRINT  @  320,"SORTING - SORTING - SORTING "  
10706 IF  AN=1 THEN GOTO  10710  
10707 FOR  K=1  TO  I:A$(K)=AD$+A$(K):A$(K)=RIGHT$(A$(K),20):NEXT  K  
10710 S=I  
10715 S=INT(S/2)  
10720 IF  S>=1 THEN GOTO  10730  
10725 GOTO  10790  
10730 FOR  K= 1  TO  S  
10735 FOR  L=K  TO  I-S  STEP  S  
10740 J=L  
10745 T$=A$(L+S)  
10755 IF  T$>=A$(J) THEN GOTO  10775  
10760 A$(J+S)=A$(J)  
10765 J=J-S  
10770 IF  J >= 1 THEN GOTO  10755  
10775 A$(J+S)=T$  
10780 NEXT  L  
10785 NEXT  K  
10788 GOTO  10715  
10790 IF  AN=1 THEN GOTO  10799  
10792 FOR  K= 1  TO  I  
10794 A=VAL(A$(K))  
10795 A$(K)=STR$(A)  
10797 NEXT  K  
10799 RETURN   
10800 REM PRINT SORTED LIST 14 AT A TIME  
10805 INPUT  "TO PRINT SORTED LIST PRESS ENTER";Z9  
10807 IF  Z2$="Y"  THEN  INPUT "PRESS ENTER WHEN PRINTER READY";Z9$: LPRINT  TAB(15); "SORTED LIST": LPRINT  " "  
10810 GOSUB  10610  
10890 RETURN   
10900 REM PRINT HEADING SUBROUTINE  
10905 CLS  
10910 Z9$ = " ITEM NUMBER               ITEM VAL.  "  
10920 Z8$ = "    ####                  %                   %  
10930 PRINT  Z9$  
10940 IF  Z2$="Y"  THEN  LPRINT  Z9$:LPRINT  " "  
10950 RETURN