home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l391 / 3.ddi / SORTDEMO.BA$ / SORTDEMO.bin
Encoding:
Text File  |  1992-08-19  |  26.3 KB  |  725 lines

  1. ' ------------------------------------------------------------------------
  2. ' Visual Basic for MS-DOS Sorting Demonstration Program
  3. '
  4. ' This program graphically demonstrates six common sorting algorithms.  It
  5. ' prints 25 or 43 horizontal bars, all of different lengths and all in random
  6. ' order, then sorts the bars from smallest to longest.
  7. '
  8. ' The program also uses SOUND statements to generate different pitches,
  9. ' depending on the location of the bar being printed. Note that the SOUND
  10. ' statements delay the speed of each sorting algorithm so you can follow
  11. ' the progress of the sort.  Therefore, the times shown are for comparison
  12. ' only. They are not an accurate measure of sort speed.
  13. '
  14. ' If you use these sorting routines in your own programs, you may notice
  15. ' a difference in their relative speeds (for example, the exchange
  16. ' sort may be faster than the shell sort) depending on the number of
  17. ' elements to be sorted and how "scrambled" they are to begin with.
  18. '
  19. ' Copyright (C) 1982-1992 Microsoft Corporation
  20. '
  21. ' You have a royalty-free right to use, modify, reproduce
  22. ' and distribute the sample applications and toolkits provided with
  23. ' Visual Basic for MS-DOS (and/or any modified version)
  24. ' in any way you find useful, provided that you agree that
  25. ' Microsoft has no warranty, obligations or liability for
  26. ' any of the sample applications or toolkits.
  27. ' ------------------------------------------------------------------------
  28.  
  29. DEFINT A-Z      ' Default type integer.
  30.  
  31. ' Declare FUNCTION and SUB procedures, and the number and type of arguments:
  32.   DECLARE FUNCTION RandInt% (lower, Upper)
  33.  
  34.   DECLARE SUB BoxInit ()
  35.   DECLARE SUB BubbleSort ()
  36.   DECLARE SUB CheckScreen ()
  37.   DECLARE SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide)
  38.   DECLARE SUB ElapsedTime (CurrentRow)
  39.   DECLARE SUB ExchangeSort ()
  40.   DECLARE SUB HeapSort ()
  41.   DECLARE SUB Initialize ()
  42.   DECLARE SUB InsertionSort ()
  43.   DECLARE SUB PercolateDown (MaxLevel)
  44.   DECLARE SUB PercolateUp (MaxLevel)
  45.   DECLARE SUB PrintOneBar (Row)
  46.   DECLARE SUB QuickSort (Low, High)
  47.   DECLARE SUB Reinitialize ()
  48.   DECLARE SUB ShellSort ()
  49.   DECLARE SUB SortMenu ()
  50.   DECLARE SUB SwapBars (Row1, Row2)
  51.   DECLARE SUB ToggleSound (Row, Column)
  52.  
  53. ' Define the data type used to hold the information for each colored bar:
  54.   TYPE SortType
  55.      Length AS INTEGER         ' Bar length (the element compared
  56.                                ' in the different sorts)
  57.      ColorVal AS INTEGER       ' Bar color
  58.      BarString AS STRING * 43  ' The bar (a string of 43 characters)
  59.   END TYPE
  60.  
  61. ' Declare global constants:
  62.   CONST FALSE = 0, TRUE = NOT FALSE, LEFTCOLUMN = 49
  63.   CONST NUMOPTIONS = 11, NUMSORTS = 6
  64.  
  65. ' Declare global variables, and allocate storage space for them.  SortArray
  66. ' and SortBackup are both arrays of the data type SortType defined above:
  67.   DIM SHARED SortArray(1 TO 43) AS SortType, SortBackup(1 TO 43) AS SortType
  68.   DIM SHARED OptionTitle(1 TO NUMOPTIONS) AS STRING * 12
  69.   DIM SHARED StartTime AS SINGLE
  70.   DIM SHARED Foreground, Background, NoSound, Pause
  71.   DIM SHARED Selection, MaxRow, InitRow, MaxColors
  72.  
  73. ' Data statements for the different options printed in the sort menu:
  74.   DATA Insertion, Bubble, Heap, Exchange, Shell, Quick,
  75.   DATA Toggle Sound, , <   (Slower), >   (Faster)
  76.  
  77. ' Begin logic of module-level code:
  78.  
  79.   Initialize             ' Initialize data values.
  80.   SortMenu               ' Print sort menu.
  81.   WIDTH 80, InitRow      ' Restore original number of rows.
  82.   COLOR 7, 0             ' Restore default color    
  83.   CLS
  84.   END
  85.  
  86. ' GetRow, MonoTrap, and RowTrap are error-handling routines invoked by
  87. ' the CheckScreen SUB procedure.  GetRow determines whether the program
  88. ' started with 25, 43, or 50 lines.  MonoTrap determines the current
  89. ' video adapter is monochrome.  RowTrap sets the maximum possible
  90. ' number of rows (43 or 25).
  91.  
  92. GetRow:
  93.    IF InitRow = 50 THEN
  94.       InitRow = 43
  95.       RESUME
  96.    ELSE
  97.       InitRow = 25
  98.       RESUME NEXT
  99.    END IF
  100.  
  101. MonoTrap:
  102.    MaxColors = 2
  103.    RESUME NEXT
  104.  
  105. RowTrap:
  106.    MaxRow = 25
  107.    RESUME
  108.  
  109. ' =============================== BoxInit ====================================
  110. '    Calls the DrawFrame procedure to draw the frame around the sort menu,
  111. '    then prints the different options stored in the OptionTitle array.
  112. ' ============================================================================
  113. '
  114. STATIC SUB BoxInit ()
  115.    DrawFrame 1, 22, LEFTCOLUMN - 3, 78
  116.  
  117.    LOCATE 3, LEFTCOLUMN + 7: PRINT "SORTING DEMO";
  118.    LOCATE 5
  119.    FOR I = 1 TO NUMOPTIONS - 1
  120.       LOCATE , LEFTCOLUMN: PRINT OptionTitle(I)
  121.    NEXT I
  122.  
  123.    ' Don't print the last option (> Faster) if the length of the Pause
  124.    ' is down to 1 clock tick:
  125.    IF Pause > 1 THEN LOCATE , LEFTCOLUMN: PRINT OptionTitle(NUMOPTIONS);
  126.  
  127.    ' Toggle sound on or off, then print the current value for NoSound:
  128.    NoSound = NOT NoSound
  129.    ToggleSound 12, LEFTCOLUMN + 12
  130.  
  131.    LOCATE NUMOPTIONS + 6, LEFTCOLUMN
  132.    PRINT "Type first character of"
  133.    LOCATE , LEFTCOLUMN
  134.    PRINT "choice ( I B H E S Q T < > )"
  135.    LOCATE , LEFTCOLUMN
  136.    PRINT "or ESC key to end program: ";
  137. END SUB
  138.  
  139. ' ============================== BubbleSort ==================================
  140. '    The BubbleSort algorithm cycles through SortArray, comparing adjacent
  141. '    elements and swapping pairs that are out of order.  It continues to
  142. '    do this until no pairs are swapped.
  143. ' ============================================================================
  144. '
  145. STATIC SUB BubbleSort ()
  146.    Limit = MaxRow
  147.    DO
  148.       Switch = FALSE
  149.       FOR Row = 1 TO (Limit - 1)
  150.  
  151.          ' Two adjacent elements are out of order, so swap their values
  152.          ' and redraw those two bars:
  153.          IF SortArray(Row).Length > SortArray(Row + 1).Length THEN
  154.             SWAP SortArray(Row), SortArray(Row + 1)
  155.             SwapBars Row, Row + 1
  156.             Switch = Row
  157.          END IF
  158.       NEXT Row
  159.  
  160.       ' Sort on next pass only to where the last switch was made:
  161.       Limit = Switch
  162.    LOOP WHILE Switch
  163.  
  164. END SUB
  165.  
  166. ' ============================== CheckScreen =================================
  167. '     Checks for type of monitor (VGA, EGA, CGA, or monochrome) and
  168. '     starting number of screen lines (50, 43, or 25).
  169. ' ============================================================================
  170. '
  171. STATIC SUB CheckScreen ()
  172.  
  173.    ' Try locating to the 50th row; if that fails, try the 43rd. Finally,
  174.    ' if that fails, the user was using 25-line mode:
  175.    InitRow = 50
  176.    ON ERROR GOTO GetRow
  177.    LOCATE InitRow, 1
  178.  
  179.    ' Try a SCREEN 1 statement to see if the current adapter has color
  180.    ' graphics; if that causes an error, reset MaxColors to 2:
  181.    MaxColors = 15
  182.    ON ERROR GOTO MonoTrap
  183.    SCREEN 1
  184.    SCREEN 0
  185.  
  186.    ' See if 43-line mode is accepted; if not, run this program in 25-line
  187.    ' mode:
  188.    MaxRow = 43
  189.    ON ERROR GOTO RowTrap
  190.    WIDTH 80, MaxRow
  191.    ON ERROR GOTO 0              ' Turn off error trapping.
  192. END SUB
  193.  
  194. ' ============================== DrawFrame ===================================
  195. '   Draws a rectangular frame using the high-order ASCII characters ╔ (201) ,
  196. '   ╗ (187) , ╚ (200) , ╝ (188) , ║ (186) , and ═ (205). The parameters
  197. '   TopSide, BottomSide, LeftSide, and RightSide are the row and column
  198. '   arguments for the upper-left and lower-right corners of the frame.
  199. ' ============================================================================
  200. '
  201. STATIC SUB DrawFrame (TopSide, BottomSide, LeftSide, RightSide)
  202.    CONST ULEFT = 201, URIGHT = 187, LLEFT = 200, LRIGHT = 188
  203.    CONST VERTICAL = 186, HORIZONTAL = 205
  204.  
  205.    FrameWidth = RightSide - LeftSide - 1
  206.    LOCATE TopSide, LeftSide
  207.    PRINT CHR$(ULEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(URIGHT);
  208.    FOR Row = TopSide + 1 TO BottomSide - 1
  209.       LOCATE Row, LeftSide
  210.       PRINT CHR$(VERTICAL); SPC(FrameWidth); CHR$(VERTICAL);
  211.    NEXT Row
  212.    LOCATE BottomSide, LeftSide
  213.    PRINT CHR$(LLEFT); STRING$(FrameWidth, HORIZONTAL); CHR$(LRIGHT);
  214. END SUB
  215.  
  216. ' ============================= ElapsedTime ==================================
  217. '    Prints seconds elapsed since the given sorting routine started.
  218. '    Note that this time includes both the time it takes to redraw the
  219. '    bars plus the pause while the SOUND statement plays a note, and
  220. '    thus is not an accurate indication of sorting speed.
  221. ' ============================================================================
  222. '
  223. STATIC SUB ElapsedTime (CurrentRow)
  224.    CONST FORMAT = "  &###.### seconds  "
  225.  
  226.    ' Print current selection and number of seconds elapsed in
  227.    ' reverse video:
  228.    COLOR Foreground, Background
  229.    LOCATE Selection + 4, LEFTCOLUMN - 2
  230.    PRINT USING FORMAT; OptionTitle(Selection); TIMER - StartTime;
  231.  
  232.    IF NoSound THEN
  233.       SOUND 30000, Pause            ' Sound off, so just pause.
  234.    ELSE
  235.       SOUND 60 * CurrentRow, Pause  ' Sound on, so play a note while
  236.    END IF                           ' pausing.
  237.  
  238.    COLOR MaxColors, 0               ' Restore regular foreground and
  239.                                     ' background colors.
  240. END SUB
  241.  
  242. ' ============================= ExchangeSort =================================
  243. '   The ExchangeSort compares each element in SortArray - starting with
  244. '   the first element - with every following element.  If any of the
  245. '   following elements is smaller than the current element, it is exchanged
  246. '   with the current element and the process is repeated for the next
  247. '   element in SortArray.
  248. ' ============================================================================
  249. '
  250. STATIC SUB ExchangeSort ()
  251.    FOR Row = 1 TO MaxRow
  252.       SmallestRow = Row
  253.       FOR J = Row + 1 TO MaxRow
  254.          IF SortArray(J).Length < SortArray(SmallestRow).Length THEN
  255.             SmallestRow = J
  256.             ElapsedTime J
  257.          END IF
  258.       NEXT J
  259.  
  260.       ' Found a row shorter than the current row, so swap those
  261.       ' two array elements:
  262.       IF SmallestRow > Row THEN
  263.          SWAP SortArray(Row), SortArray(SmallestRow)
  264.          SwapBars Row, SmallestRow
  265.       END IF
  266.    NEXT Row
  267. END SUB
  268.  
  269. ' =============================== HeapSort ===================================
  270. '  The HeapSort procedure works by calling two other procedures - PercolateUp
  271. '  and PercolateDown.  PercolateUp turns SortArray into a "heap," which has
  272. '  the properties outlined in the diagram below:
  273. '
  274. '                               SortArray(1)
  275. '                               /          \
  276. '                    SortArray(2)           SortArray(3)
  277. '                   /          \            /          \
  278. '         SortArray(4)   SortArray(5)   SortArray(6)  SortArray(7)
  279. '          /      \       /       \       /      \      /      \
  280. '        ...      ...   ...       ...   ...      ...  ...      ...
  281. '
  282. '
  283. '  where each "parent node" is greater than each of its "child nodes"; for
  284. '  example, SortArray(1) is greater than SortArray(2) or SortArray(3),
  285. '  SortArray(3) is greater than SortArray(6) or SortArray(7), and so forth.
  286. '
  287. '  Therefore, once the first FOR...NEXT loop in HeapSort is finished, the
  288. '  largest element is in SortArray(1).
  289. '
  290. '  The second FOR...NEXT loop in HeapSort swaps the element in SortArray(1)
  291. '  with the element in MaxRow, rebuilds the heap (with PercolateDown) for
  292. '  MaxRow - 1, then swaps the element in SortArray(1) with the element in
  293. '  MaxRow - 1, rebuilds the heap for MaxRow - 2, and continues in this way
  294. '  until the array is sorted.
  295. ' ============================================================================
  296. '
  297. STATIC SUB HeapSort ()
  298.    FOR I = 2 TO MaxRow
  299.       PercolateUp I
  300.    NEXT I
  301.  
  302.    FOR I = MaxRow TO 2 STEP -1
  303.       SWAP SortArray(1), SortArray(I)
  304.       SwapBars 1, I
  305.       PercolateDown I - 1
  306.    NEXT I
  307. END SUB
  308.  
  309. ' ============================== Initialize ==================================
  310. '    Initializes the SortBackup and OptionTitle arrays.  It also calls the
  311. '    CheckScreen, BoxInit, and RandInt% procedures.
  312. ' ============================================================================
  313. '
  314. STATIC SUB Initialize ()
  315.    DIM TempArray(1 TO 43)
  316.  
  317.    CheckScreen                  ' Check for monochrome or EGA and set
  318.                                 ' maximum number of text lines.
  319.    FOR I = 1 TO MaxRow
  320.       TempArray(I) = I
  321.    NEXT I
  322.  
  323.    MaxIndex = MaxRow
  324.  
  325.    RANDOMIZE TIMER              ' Seed the random-number generator.
  326.    FOR I = 1 TO MaxRow
  327.  
  328.       ' Call RandInt% to find a random element in TempArray between 1
  329.       ' and MaxIndex, then assign the value in that element to BarLength:
  330.       Index = RandInt%(1, MaxIndex)
  331.       BarLength = TempArray(Index)
  332.  
  333.       ' Overwrite the value in TempArray(Index) with the value in
  334.       ' TempArray(MaxIndex) so the value in TempArray(Index) is
  335.       ' chosen only once:
  336.       TempArray(Index) = TempArray(MaxIndex)
  337.  
  338.       ' Decrease the value of MaxIndex so that TempArray(MaxIndex) can't
  339.       ' be chosen on the next pass through the loop:
  340.       MaxIndex = MaxIndex - 1
  341.  
  342.       ' Assign the BarLength value to the .Length element, then store
  343.       ' a string of BarLength block characters (ASCII 223: ▀) in the
  344.       ' .BarString element:
  345.       SortBackup(I).Length = BarLength
  346.       SortBackup(I).BarString = STRING$(BarLength, 223)
  347.  
  348.       ' Store the appropriate color value in the .ColorVal element:
  349.       IF MaxColors > 2 THEN
  350.          SortBackup(I).ColorVal = (BarLength MOD MaxColors) + 1
  351.       ELSE
  352.          SortBackup(I).ColorVal = MaxColors
  353.       END IF
  354.    NEXT I
  355.  
  356.    FOR I = 1 TO NUMOPTIONS      ' Read SORT DEMO menu options and store
  357.       READ OptionTitle(I)       ' them in the OptionTitle array.
  358.    NEXT I
  359.  
  360.    CLS
  361.    Reinitialize         ' Assign values in SortBackup to SortArray and draw
  362.                         ' unsorted bars on the screen.
  363.    NoSound = FALSE
  364.    Pause = 2            ' Initialize Pause to 2 clock ticks (@ 1/9 second).
  365.    BoxInit              ' Draw frame for the sort menu and print options.
  366.  
  367. END SUB
  368.  
  369. ' ============================= InsertionSort ================================
  370. '   The InsertionSort procedure compares the length of each successive
  371. '   element in SortArray with the lengths of all the preceding elements.
  372. '   When the procedure finds the appropriate place for the new element, it
  373. '   inserts the element in its new place, and moves all the other elements
  374. '   down one place.
  375. ' ============================================================================
  376. '
  377. STATIC SUB InsertionSort ()
  378.    DIM TempVal AS SortType
  379.    FOR Row = 2 TO MaxRow
  380.       TempVal = SortArray(Row)
  381.       TempLength = TempVal.Length
  382.       FOR J = Row TO 2 STEP -1
  383.  
  384.          ' As long as the length of the J-1st element is greater than the
  385.          ' length of the original element in SortArray(Row), keep shifting
  386.          ' the array elements down:
  387.          IF SortArray(J - 1).Length > TempLength THEN
  388.             SortArray(J) = SortArray(J - 1)
  389.             PrintOneBar J               ' Print the new bar.
  390.             ElapsedTime J               ' Print the elapsed time.
  391.  
  392.          ' Otherwise, exit the FOR...NEXT loop:
  393.          ELSE
  394.             EXIT FOR
  395.          END IF
  396.       NEXT J
  397.  
  398.       ' Insert the original value of SortArray(Row) in SortArray(J):
  399.       SortArray(J) = TempVal
  400.       PrintOneBar J
  401.       ElapsedTime J
  402.    NEXT Row
  403. END SUB
  404.  
  405. ' ============================ PercolateDown =================================
  406. '   The PercolateDown procedure restores the elements of SortArray from 1 to
  407. '   MaxLevel to a "heap" (see the diagram with the HeapSort procedure).
  408. ' ============================================================================
  409. '
  410. STATIC SUB PercolateDown (MaxLevel)
  411.    I = 1
  412.  
  413.    ' Move the value in SortArray(1) down the heap until it has
  414.    ' reached its proper node (that is, until it is less than its parent
  415.    ' node or until it has reached MaxLevel, the bottom of the current heap):
  416.    DO
  417.       Child = 2 * I             ' Get the subscript for the child node.
  418.  
  419.       ' Reached the bottom of the heap, so exit this procedure:
  420.       IF Child > MaxLevel THEN EXIT DO
  421.  
  422.       ' If there are two child nodes, find out which one is bigger:
  423.       IF Child + 1 <= MaxLevel THEN
  424.          IF SortArray(Child + 1).Length > SortArray(Child).Length THEN
  425.             Child = Child + 1
  426.          END IF
  427.       END IF
  428.  
  429.       ' Move the value down if it is still not bigger than either one of
  430.       ' its children:
  431.       IF SortArray(I).Length < SortArray(Child).Length THEN
  432.          SWAP SortArray(I), SortArray(Child)
  433.          SwapBars I, Child
  434.          I = Child
  435.  
  436.       ' Otherwise, SortArray has been restored to a heap from 1 to MaxLevel,
  437.       ' so exit:
  438.       ELSE
  439.          EXIT DO
  440.       END IF
  441.    LOOP
  442. END SUB
  443.  
  444. ' ============================== PercolateUp =================================
  445. '   The PercolateUp procedure converts the elements from 1 to MaxLevel in
  446. '   SortArray into a "heap" (see the diagram with the HeapSort procedure).
  447. ' ============================================================================
  448. '
  449. STATIC SUB PercolateUp (MaxLevel)
  450.    I = MaxLevel
  451.  
  452.    ' Move the value in SortArray(MaxLevel) up the heap until it has
  453.    ' reached its proper node (that is, until it is greater than either
  454.    ' of its child nodes, or until it has reached 1, the top of the heap):
  455.    DO UNTIL I = 1
  456.       Parent = I \ 2            ' Get the subscript for the parent node.
  457.  
  458.       ' The value at the current node is still bigger than the value at
  459.       ' its parent node, so swap these two array elements:
  460.       IF SortArray(I).Length > SortArray(Parent).Length THEN
  461.          SWAP SortArray(Parent), SortArray(I)
  462.          SwapBars Parent, I
  463.          I = Parent
  464.  
  465.       ' Otherwise, the element has reached its proper place in the heap,
  466.       ' so exit this procedure:
  467.       ELSE
  468.          EXIT DO
  469.       END IF
  470.    LOOP
  471. END SUB
  472.  
  473. ' ============================== PrintOneBar =================================
  474. '  Prints SortArray(Row).BarString at the row indicated by the Row
  475. '  parameter, using the color in SortArray(Row).ColorVal.
  476. ' ============================================================================
  477. '
  478. STATIC SUB PrintOneBar (Row)
  479.    LOCATE Row, 1
  480.    COLOR SortArray(Row).ColorVal
  481.    PRINT SortArray(Row).BarString;
  482. END SUB
  483.  
  484. ' ============================== QuickSort ===================================
  485. '   QuickSort works by picking a random "pivot" element in SortArray, then
  486. '   moving every element that is bigger to one side of the pivot, and every
  487. '   element that is smaller to the other side.  QuickSort is then called
  488. '   recursively with the two subdivisions created by the pivot.  Once the
  489. '   number of elements in a subdivision reaches two, the recursive calls end
  490. '   and the array is sorted.
  491. ' ============================================================================
  492. '
  493. SUB QuickSort (Low, High)
  494.    IF Low < High THEN
  495.  
  496.       ' Only two elements in this subdivision; swap them if they are out of
  497.       ' order, then end recursive calls:
  498.       IF High - Low = 1 THEN
  499.          IF SortArray(Low).Length > SortArray(High).Length THEN
  500.             SWAP SortArray(Low), SortArray(High)
  501.             SwapBars Low, High
  502.          END IF
  503.       ELSE
  504.  
  505.          ' Pick a pivot element at random, then move it to the end:
  506.          RandIndex = RandInt%(Low, High)
  507.          SWAP SortArray(High), SortArray(RandIndex)
  508.          SwapBars High, RandIndex
  509.          Partition = SortArray(High).Length
  510.          DO
  511.  
  512.             ' Move in from both sides towards the pivot element:
  513.             I = Low: J = High
  514.             DO WHILE (I < J) AND (SortArray(I).Length <= Partition)
  515.                I = I + 1
  516.             LOOP
  517.             DO WHILE (J > I) AND (SortArray(J).Length >= Partition)
  518.                J = J - 1
  519.             LOOP
  520.  
  521.             ' If we haven't reached the pivot element, it means that two
  522.             ' elements on either side are out of order, so swap them:
  523.             IF I < J THEN
  524.                SWAP SortArray(I), SortArray(J)
  525.                SwapBars I, J
  526.             END IF
  527.          LOOP WHILE I < J
  528.  
  529.          ' Move the pivot element back to its proper place in the array:
  530.          SWAP SortArray(I), SortArray(High)
  531.          SwapBars I, High
  532.  
  533.          ' Recursively call the QuickSort procedure (pass the smaller
  534.          ' subdivision first to use less stack space):
  535.          IF (I - Low) < (High - I) THEN
  536.             QuickSort Low, I - 1
  537.             QuickSort I + 1, High
  538.          ELSE
  539.             QuickSort I + 1, High
  540.             QuickSort Low, I - 1
  541.          END IF
  542.       END IF
  543.    END IF
  544. END SUB
  545.  
  546. ' =============================== RandInt% ===================================
  547. '   Returns a random integer greater than or equal to the Lower parameter
  548. '   and less than or equal to the Upper parameter.
  549. ' ============================================================================
  550. '
  551. STATIC FUNCTION RandInt% (lower, Upper)
  552.    RandInt% = INT(RND * (Upper - lower + 1)) + lower
  553. END FUNCTION
  554.  
  555. ' ============================== Reinitialize ================================
  556. '   Restores the array SortArray to its original unsorted state, then
  557. '   prints the unsorted color bars.
  558. ' ============================================================================
  559. '
  560. STATIC SUB Reinitialize ()
  561.    FOR I = 1 TO MaxRow
  562.       SortArray(I) = SortBackup(I)
  563.    NEXT I
  564.  
  565.    FOR I = 1 TO MaxRow
  566.       LOCATE I, 1
  567.       COLOR SortArray(I).ColorVal
  568.       PRINT SortArray(I).BarString;
  569.    NEXT I
  570.  
  571.    COLOR MaxColors, 0
  572. END SUB
  573.  
  574. ' =============================== ShellSort ==================================
  575. '  The ShellSort procedure is similar to the BubbleSort procedure.  However,
  576. '  ShellSort begins by comparing elements that are far apart (separated by
  577. '  the value of the Offset variable, which is initially half the distance
  578. '  between the first and last element), then comparing elements that are
  579. '  closer together (when Offset is one, the last iteration of this procedure
  580. '  is merely a bubble sort).
  581. ' ============================================================================
  582. '
  583. STATIC SUB ShellSort ()
  584.  
  585.    ' Set comparison offset to half the number of records in SortArray:
  586.    Offset = MaxRow \ 2
  587.  
  588.    DO WHILE Offset > 0          ' Loop until offset gets to zero.
  589.       Limit = MaxRow - Offset
  590.       DO
  591.          Switch = FALSE         ' Assume no switches at this offset.
  592.  
  593.          ' Compare elements and switch ones out of order:
  594.          FOR Row = 1 TO Limit
  595.             IF SortArray(Row).Length > SortArray(Row + Offset).Length THEN
  596.                SWAP SortArray(Row), SortArray(Row + Offset)
  597.                SwapBars Row, Row + Offset
  598.                Switch = Row
  599.             END IF
  600.          NEXT Row
  601.  
  602.          ' Sort on next pass only to where last switch was made:
  603.          Limit = Switch - Offset
  604.       LOOP WHILE Switch
  605.  
  606.       ' No switches at last offset, try one half as big:
  607.       Offset = Offset \ 2
  608.    LOOP
  609. END SUB
  610.  
  611. ' =============================== SortMenu ===================================
  612. '   The SortMenu procedure first calls the Reinitialize procedure to make
  613. '   sure the SortArray is in its unsorted form, then prompts the user to
  614. '   make one of the following choices:
  615. '
  616. '               * One of the sorting algorithms
  617. '               * Toggle sound on or off
  618. '               * Increase or decrease speed
  619. '               * End the program
  620. ' ============================================================================
  621. '
  622. STATIC SUB SortMenu ()
  623.    Escape$ = CHR$(27)
  624.  
  625.    ' Create a string consisting of all legal choices:
  626.    Option$ = "IBHESQ><T" + Escape$
  627.  
  628.    DO
  629.  
  630.       ' Make the cursor visible:
  631.       LOCATE NUMOPTIONS + 8, LEFTCOLUMN + 27, 1
  632.  
  633.       Choice$ = UCASE$(INPUT$(1))          ' Get the user's choice and see
  634.       Selection = INSTR(Option$, Choice$)  ' if it's one of the menu options.
  635.  
  636.       ' User chose one of the sorting procedures:
  637.       IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
  638.          Reinitialize                      ' Rescramble the bars.
  639.          LOCATE , , 0                      ' Make the cursor invisible.
  640.          Foreground = 0                    ' Set reverse-video values.
  641.          Background = 7
  642.          StartTime = TIMER                 ' Record the starting time.
  643.       END IF
  644.  
  645.       ' Branch to the appropriate procedure depending on the key typed:
  646.       SELECT CASE Choice$
  647.          CASE "I"
  648.             InsertionSort
  649.          CASE "B"
  650.             BubbleSort
  651.          CASE "H"
  652.             HeapSort
  653.          CASE "E"
  654.             ExchangeSort
  655.          CASE "S"
  656.             ShellSort
  657.          CASE "Q"
  658.             QuickSort 1, MaxRow
  659.          CASE ">"
  660.  
  661.             ' Decrease pause length to speed up sorting time, then redraw
  662.             ' the menu to clear any timing results (since they won't compare
  663.             ' with future results):
  664.             Pause = (2 * Pause) / 3
  665.             BoxInit
  666.  
  667.          CASE "<"
  668.  
  669.             ' Increase pause length to slow down sorting time, then redraw
  670.             ' the menu to clear any timing results (since they won't compare
  671.             ' with future results):
  672.             Pause = (3 * Pause) / 2
  673.             BoxInit
  674.  
  675.          CASE "T"
  676.             ToggleSound 12, LEFTCOLUMN + 12
  677.  
  678.          CASE Escape$
  679.  
  680.             ' User pressed ESC, so exit this procedure and return to
  681.             ' module level:
  682.             EXIT DO
  683.  
  684.          CASE ELSE
  685.  
  686.             ' Invalid key
  687.       END SELECT
  688.  
  689.       IF (Selection >= 1) AND (Selection <= NUMSORTS) THEN
  690.          Foreground = MaxColors            ' Turn off reverse video.
  691.          Background = 0
  692.          ElapsedTime 0                     ' Print final time.
  693.       END IF
  694.  
  695.    LOOP
  696.  
  697. END SUB
  698.  
  699. ' =============================== SwapBars ===================================
  700. '   Calls PrintOneBar twice to switch the two bars in Row1 and Row2,
  701. '   then calls the ElapsedTime procedure.
  702. ' ============================================================================
  703. '
  704. STATIC SUB SwapBars (Row1, Row2)
  705.    PrintOneBar Row1
  706.    PrintOneBar Row2
  707.    ElapsedTime Row1
  708. END SUB
  709.  
  710. ' ============================== ToggleSound =================================
  711. '   Reverses the current value for NoSound, then prints that value next
  712. '   to the "Toggle Sound" option on the sort menu.
  713. ' ============================================================================
  714. '
  715. STATIC SUB ToggleSound (Row, Column)
  716.    NoSound = NOT NoSound
  717.    LOCATE Row, Column
  718.    IF NoSound THEN
  719.       PRINT ": OFF";
  720.    ELSE
  721.       PRINT ": ON ";
  722.    END IF
  723. END SUB
  724.  
  725.