'===========================================================================
' Subject: VISUAL QUICK SORT                  Date: Year of 1992           
'  Author: Ethan Winer                        Code: QB, QBasic, PDS        
'  Origin: PC Magazine BASIC Techniques     Packet: ALGOR.ABC
'===========================================================================
'********* SEEQSORT.BAS - Quick Sort algorithm visual demonstration

'Copyright (c) 1992 Ethan Winer

DEFINT A-Z
DECLARE SUB SeeQSort (Array!())

RANDOMIZE TIMER         'generate a new series each run

CONST MaxElements = 23  'the size of the text array
CONST Delay! = 1!       'pause delay, change to suit
CONST FG = 7            'the foreground color
CONST BG = 1            'the background color
CONST Hi = 15 + 16      'high-intensity flashing

DIM Array!(1 TO MaxElements)    'create an array
FOR X = 1 TO MaxElements        'fill with random numbers
  Array!(X) = RND(1) * 500      'between 0 and 500
NEXT

COLOR FG, BG
CLS
LOCATE 25, 1
PRINT "Press Escape to end the program early"; TAB(80);
CALL SeeQSort(Array!())

SUB SeeQSort (Array!()) STATIC

REDIM QStack(10)        'create a stack big enough for this example

First = LBOUND(Array!)  'initialize work variables
Last = UBOUND(Array!)

DO
  DO
    Temp! = Array!((Last + First) \ 2)  'seek midpoint
    I = First
    J = Last

    DO     'reverse both < and > below to sort descending
      WHILE Array!(I) < Temp!
        I = I + 1
        GOSUB UpdateScreen
        GOSUB Pause
      WEND
      WHILE Array!(J) > Temp!
        J = J - 1
        GOSUB UpdateScreen
        GOSUB Pause
      WEND
      IF I > J THEN EXIT DO
      IF I < J THEN
        LOCATE 1, 60
        COLOR BG, FG
        PRINT " About to swap ";
        COLOR Hi, BG
        LOCATE I, 39
        PRINT USING "####.## "; Array!(I);
        LOCATE J, 39
        PRINT USING "####.## "; Array!(J);
        COLOR FG, BG
        GOSUB Pause
        SWAP Array!(I), Array!(J)
        GOSUB UpdateScreen
        LOCATE 1, 60
        COLOR BG, FG
        PRINT "    Swapped    ";
        GOSUB Pause
      END IF

      I = I + 1
      J = J - 1
    LOOP WHILE I <= J

    IF I < Last THEN                    'Done
      LOCATE 1, 60
      COLOR BG, FG
      PRINT " About to push ";
      GOSUB Pause
      QStack(StackPtr) = I              'Push I
      QStack(StackPtr + 1) = Last       'Push Last
      StackPtr = StackPtr + 2
      GOSUB UpdateScreen
      LOCATE 1, 60
      COLOR BG, FG
      PRINT "     Pushed    ";
      GOSUB Pause
    END IF

    Last = J
  LOOP WHILE First < Last

  IF StackPtr = 0 THEN EXIT DO

  LOCATE 1, 60
  COLOR BG, FG
  PRINT " About to pop ";
  GOSUB Pause
  StackPtr = StackPtr - 2
  First = QStack(StackPtr)              'Pop First
  Last = QStack(StackPtr + 1)           'Pop Last
  GOSUB UpdateScreen
  LOCATE 1, 60
  COLOR BG, FG
  PRINT "    Popped    ";
  GOSUB Pause
LOOP

ERASE QStack               'delete the stack array
COLOR FG, BG
EXIT SUB

UpdateScreen:
  COLOR FG, BG
  LOCATE 1, 60
  PRINT SPC(15);

  FOR X = 1 TO MaxElements
    LOCATE X, 24
    IF X = (Last + First) \ 2 THEN
      COLOR BG, FG
      PRINT " Midpoint ==> "
      COLOR FG, BG
    ELSE
      PRINT SPC(14);
    END IF
  
    LOCATE X, 1
    IF X = First THEN
      COLOR BG, FG
      PRINT " First ==> "
      COLOR FG, BG
    ELSE
      PRINT SPC(11);
    END IF
   
    LOCATE X, 13
    IF X = Last THEN
      COLOR BG, FG
      PRINT " Last ==> "
      COLOR FG, BG
    ELSE
      PRINT SPC(11);
    END IF


    LOCATE X, 39
    PRINT USING "####.## "; Array!(X);
    PRINT SPC(17);
    COLOR BG, FG
    LOCATE X, 48

    IF X = I THEN
      PRINT " <== I "
    END IF
    IF X = J THEN
      LOCATE X, 56
      PRINT " <== J "
    END IF

    COLOR FG, BG
  NEXT
RETURN


Pause:
  Start! = TIMER
  DO
  LOOP WHILE Start! + Delay! > TIMER

  IF INKEY$ = CHR$(27) THEN END

  RETURN

END SUB
