Sorting Algorithm Visualizer in MS Quick Basic

DECLARE SUB quickSort (p AS INTEGER, l AS INTEGER, r AS INTEGER)
DECLARE SUB colorArray (c AS INTEGER)
DECLARE SUB drawArrayPos (p AS INTEGER, c AS INTEGER)
DECLARE SUB bubbleSort ()
DECLARE SUB populateArray ()
DECLARE SUB shuffleArray ()
DECLARE SUB playSoundForPos (p AS INTEGER)
DECLARE SUB swapValues (p1 AS INTEGER, p2 AS INTEGER)
DECLARE SUB setArrayValue (p AS INTEGER, v AS INTEGER)
DECLARE FUNCTION readArrayValue% (p AS INTEGER, d AS INTEGER, s AS INTEGER)
RANDOMIZE TIMER
OPTION BASE 0
PLAY "MB"

'Sorting algorithm visualizer
'Written in MS Quick Basic on an IBM PC/AT
'IBM PC/AT specifications (with expansion cards):
'Intel 80286 8 MHz CPU
'EGA graphics
'2 MB RAM (640K standard + 1.5 MB extended)
'70 MB hard drive
'Quadtel BIOS (non-destructive upgrade from original IBM BIOS)
'IBM 5153 color monitor
'And an IBM Personal Computer Graphics Printer.

'This program will run in EGA 320x200 16 color mode (QB SCREEN Mode 7)
'It may also run in EGA 640x200 16 color mode (QB SCREEN Mode 8)
'The IBM 5153 monitor does not support EGA 640x350 high resolution
'mode, but we don't care about that because this program
'uses entirely vertical lines, so the horizontal resolution
'matters more.
'It will visualize arbitrary algorithms for sorting arrays.
'We will need to interface with the array using QB subroutines
'in order to easily plug different algorithms into the visualizer.

'The program will also play variable pitch sounds when an array
'item is moved from one place to another.
'We will do this with the QB SOUND command, which plays single
'channel tones through the PC Speaker, perfect for this application.

'We will configure the array with parameters so that the
'vertical bars in the visualization will fit within the
'320 or 640 pixel screen width.

DIM SHARED xres AS INTEGER, yres AS INTEGER
xres = 320
yres = 200


'Allocate memory for array:
DIM SHARED arrlen AS INTEGER
arrlen = VAL(COMMAND$)
IF arrlen = 0 THEN arrlen = 16
DIM SHARED arr(arrlen)

'Infer some parameters from the array length and screen resolution:
DIM SHARED barwidth AS INTEGER
barwidth = INT(xres / arrlen)
DIM SHARED barstep AS INTEGER
barstep = INT(yres / arrlen)
DIM SHARED reduceWidth AS INTEGER
reduceWidth = 0
IF barwidth > 1 THEN reduceWidth = 1
IF barwidth > 2 THEN reduceWidth = 2


'Initialize graphics mode:
IF xres = 320 AND yres = 200 THEN
    SCREEN 7
ELSEIF xres = 640 AND yres = 200 THEN
    SCREEN 8
ELSE
    PRINT "Graphics mode not supported at this time."
END IF



'Populate the array:
LOCATE 1, 1
PRINT "Populating           "
populateArray

'Shuffle the array:
LOCATE 1, 1
PRINT "Shuffling            "
shuffleArray
SLEEP 1

'We have our basic array functions working now:
'Reading, writing, populating, shuffling, swapping elements.
'Now we can write a simple bubble sort and sort the array
'after shuffling it.

LOCATE 1, 1
PRINT "Bubble Sort                  "
bubbleSort
colorArray 2
SLEEP 1

'Shuffle the array:
colorArray 15
LOCATE 1, 1
PRINT "Shuffling            "
shuffleArray
SLEEP 1

'Now that we've gotten Bubble Sort working fairly well,
'it's time to implement a better sorting algorithm
'to demonstrate the difference: Quick Sort.

LOCATE 1, 1
PRINT "Quick Sort                     "
quickSort -1, 0, 0
colorArray 2

WHILE INKEY$ = "": WEND

'Return to text mode:
SCREEN 0
END

SUB bubbleSort

    'Sort the array using the bubble method.


    DO
        changed% = 0
        FOR i% = 0 TO arrlen - 2
            'Check current and next values in array:
            v1% = readArrayValue(i%, 3, 1)
            v2% = readArrayValue(i% + 1, 3, 1)
            'Swap if needed:
            IF v1% > v2% THEN swapValues i%, i% + 1: changed% = 1
        NEXT i%
        IF changed% = 0 THEN EXIT DO
    LOOP

    'Removed recursion. What was I thinking?
    'IF changed% THEN bubbleSort 'Recurse until sorted

END SUB

SUB colorArray (c AS INTEGER)

    'Color entire array a certain color

    FOR i% = 0 TO arrlen - 1
        drawArrayPos i%, c
        playSoundForPos (i%)
    NEXT i%

END SUB

SUB drawArrayPos (p AS INTEGER, c AS INTEGER)
    xpos% = p * barwidth
    LINE (xpos% + reduceWidth, yres)-(xpos% + barwidth - reduceWidth, yres - arr(p)), c, BF
END SUB

SUB playSoundForPos (p AS INTEGER)

    SOUND 1, 0
    mult! = (p / (arrlen - 1))
    SOUND (INT(mult * 780)) + 100, 1

END SUB

SUB populateArray

    'This subroutine populates the array
    'with values ranging between 1 and yres

    'First bar height is 1:
    h% = 1

    FOR i% = 0 TO arrlen - 1
        setArrayValue i%, h%
        h% = h% + barstep
    NEXT i%

END SUB

SUB quickSort (p AS INTEGER, l AS INTEGER, r AS INTEGER)

    'Quick sort the array.

    'p - pivot
    'l - left
    'r - right

    'Choose defaults:
    IF p = -1 THEN
        p = INT(arrlen / 2) - 1
        l = 0
        r = arrlen - 1
    ELSEIF p = 0 THEN
        p = INT((l + r) / 2)
    END IF

    i% = p
    pv% = readArrayValue(p, 3, 1)
    'LOCATE 1, 1
    'PRINT "Left                     "
    DO
        i% = i% - 1
        iv% = readArrayValue(i%, 3, 1)
        IF iv% > pv% THEN
            FOR j% = i% TO p - 1
                setArrayValue j%, readArrayValue(j% + 1, 3, 1)
            NEXT j%
            setArrayValue p, iv%
            p = p - 1
        END IF
        IF i% = l THEN EXIT DO
    LOOP

    i% = p
    'pv% = readArrayValue(pv%, 3, 1)
    'LOCATE 1, 1
    'PRINT "Right                             "
    DO
        i% = i% + 1
        iv% = readArrayValue(i%, 3, 1)
        IF iv% < pv% THEN
            FOR j% = i% TO p + 1 STEP -1
                setArrayValue j%, readArrayValue(j% - 1, 3, 1)
            NEXT j%
            setArrayValue p, iv%
            p = p + 1
        END IF
        IF i% = r THEN EXIT DO
    LOOP

    IF p > l + 1 THEN quickSort 0, l, p
    IF p < r - 1 THEN quickSort 0, p, r

END SUB

FUNCTION readArrayValue% (p AS INTEGER, d AS INTEGER, s AS INTEGER)
    v% = arr(p)

    IF d THEN drawArrayPos p, d
    IF s THEN playSoundForPos (p)
    IF d THEN drawArrayPos p, 15

    readArrayValue% = v%
END FUNCTION

SUB setArrayValue (p AS INTEGER, v AS INTEGER)

    'This subroutine sets the array position p to value v

    'Erase old line:
    drawArrayPos p, 0

    arr(p) = v

    'Draw new line:

    'drawArrayPos p, 4

    'playSoundForPos (p)

    drawArrayPos p, 15

END SUB

SUB shuffleArray

    'This sub randomly swaps values already in the array
    'until it is statistically well shuffled enough.

    'How many times should we do this?
    '7 times is too slow. Maybe just 3.

    FOR i = 1 TO 3
        FOR j = 0 TO arrlen - 1
            p1% = INT(arrlen * RND)
            p2% = INT(arrlen * RND)
            swapValues p1%, p2%
        NEXT j
    NEXT i

END SUB

SUB swapValues (p1 AS INTEGER, p2 AS INTEGER)

    'This subroutine swaps two values in the array.

    v1% = readArrayValue(p1, 4, 1)
    setArrayValue p1, readArrayValue(p2, 4, 1)
    setArrayValue p2, v1%

END SUB