{ ------------------------------------------------------------- }
{ SWSDEMO.PAS, a sorting demonstration by Robert Manning.       }
{ Copyright 1996 Robert Manning, South Bay Computer Assistance. }
{ ------------------------------------------------------------- }

{ ------------------------------------------------------- }
{ Draws a text-based representation of an unsorted array, }
{ then proceeds to sort it based on user choice of sort.  }
{ ------------------------------------------------------- }
{ This source code is distributed as part of the sort     }
{ demo package. It includes the Brute Force Bubble sort   }
{ and the improved Bubble sort only. To receive the full  }
{ source code with all sort routines for the main         }
{ SortDemo program, send $10 check or money order in U.S. }
{ Dollars only, to:                                       }
{                                                         }
{ Robert Manning, PO Box 2011, Lomita, CA 90717, USA.     }
{ ------------------------------------------------------- }

program SortDemo(input, output);
uses Dos, Crt;

type SortArray = record
     BarSize,            {the length of the bar}
     Color: integer;     {color of the bar}
     end; {type}

const SCREENROWS = 45; {assumes actual 50 line screen mode}

var Bar, SaveBar: array[1..SCREENROWS] of SortArray;
    {user defined variables of type SortArray}
    displaydelay,        {display delay for drawing bars}
    sortchoice: integer; {specifies sort routine}
    choice, dummy: string; {ye olde dummy & input vars}
    BubbleTime,
    BruteTime: real; {for storing algorithm run times}
    Hour, Min, Sec, HSec, {variables for GetTime function & timing indicator}
    SaveHour, SaveMin, SaveSec, SaveHSec: word;
    EnableSound: Boolean; {flag to indicate whether we want sound.}
    OrigMode: integer; {for saving original video mode}

procedure InitSortArray;
{initialize the array of bars, and make a copy to save for restoring
after sort}
var i: integer;
begin
    for i := 1 to SCREENROWS do
     begin
        Bar[i].BarSize := random(70) + 1;
        Bar[i].Color := random(14) + 1;
        SaveBar[i].BarSize := Bar[i].BarSize;
        SaveBar[i].Color := Bar[i].Color;
     end;
end;

procedure ResetBars;
var i: integer; {resets the Bars array to their initial saved values}
begin   {do this at the end of each sort, so the next sort gets same data}
    for i := 1 to SCREENROWS do
     begin
        Bar[i].BarSize := SaveBar[i].BarSize;
        Bar[i].Color := SaveBar[i].Color;
     end;
end;

procedure DrawNewBars;
var i, j: integer;
begin {draws the 'Bars' array, whatever the order happens to be}
    for i := 1 to SCREENROWS do
     begin
        textcolor(Bar[i].Color);
        gotoxy(1, i);
        writeln('                                                                        ');
        gotoxy(1, i);
        for j := 1 to Bar[i].BarSize do write(' ');
        {get the ascii char above by pressing ALT + 002}
        if displaydelay > 0 then delay(displaydelay);
     end;
end;

procedure SwapBars(low, hi: integer);   {swaps the data in Bars array}
var temp: array[1..2] of integer; {use whenever you want to swap data}
begin                 {parameters indicate array index values to swap}
    temp[1] := Bar[low].BarSize;
    temp[2] := Bar[low].Color;
    Bar[low].BarSize := Bar[hi].BarSize;
    Bar[low].Color := Bar[hi].Color;
    Bar[hi].BarSize := temp[1];
    Bar[hi].Color := temp[2];
    if EnableSound = true then
     begin
         Sound(8000 - (Bar[low].BarSize * 110));
         Delay(60);
         NoSound;
     end;
end;

procedure BubbleSortDemo; {display a bubble sort}
{This version of the bubble sort will stop running when the file is}
{sorted, as opposed to the brute force version, which keeps on running}
{even when the file is sorted. For a demo of this size, this single}
{difference is small if any. For larger files, it is significant.}
{This version is also faster for a file that is partly sorted.}
var inOrder: Boolean;
    temp: array[1..4] of integer;
    i: integer;
begin
    GetTime(SaveHour, SaveMin, SaveSec, SaveHSec);
    DrawNewBars;
    inOrder := false;
    while not inOrder do
     begin
         inOrder := true;
         for i := 1 to SCREENROWS - 1 do
          begin
             if (Bar[i].BarSize > Bar[i+1].BarSize) then
              begin {swap the data}
                  SwapBars(i, i+1);
                  inOrder := false;
                  DrawNewBars;
              end; {if}
          end; {for}
     end; {while}
    GetTime(Hour, Min, Sec, HSec);
    gotoxy(1, SCREENROWS + 2);
    write('Sort Completed. Press Enter to Continue.');
    readln(dummy);
end;

procedure BruteForceBubbleSortDemo;
{The difference between this and the other bubble sort is that this one}
{keeps running, even after the file is sorted! The loop is entirely}
{dependent on the size of the file - this is a real O(n^2) method!}
{The speed of this routine does not vary depending on the sorted state}
{of the data being sorted, only on the size of input.}
var i, j: integer;
begin
    GetTime(SaveHour, SaveMin, SaveSec, SaveHSec);
    DrawNewBars;
    for i := 1 to SCREENROWS do
     begin
         for j := 1 to SCREENROWS - 1 do
          begin
              if Bar[j].BarSize > Bar[j+1].BarSize then
               begin
                  SwapBars(j, j+1);
                  DrawNewBars;
               end;
          end;
     end;
    GetTime(Hour, Min, Sec, HSec);
    gotoxy(1, SCREENROWS + 2);
    write('Sort Completed. Press Enter to Continue.');
    readln(dummy);
end;

procedure SetDisplayDelay;
begin {slow this baby down if you need to ... }
     write('       Enter Delay (milliseconds): ');
     readln(displaydelay);
end;

function CalculateRunTime: real; {calculates algorithm run time, returns}
var before, after: real;         {real number showing run time}
begin
    before := (SaveMin * 60) + SaveSec + (SaveHSec / 100);
    after := (Min * 60) + Sec + (HSec / 100);
    CalculateRunTime := after - before;
end;

function Getinput: integer;
var choice: integer;
begin {display program title and get user input}
    choice := 0;
    textcolor(15);
    clrscr;
    writeln('       ???????????????????????????????????????????????????????????????');
    writeln('       ?  PASCAL Sort Demo Program, Copyright 1996, Robert Manning.  ??');
    writeln('       ?   Shareware demo code to demonstrate Bubble sort routine.   ??');
    writeln('       ????????????????????????????????????????????????????????????????');
    writeln('        ???????????????????????????????????????????????????????????????');
    writeln;
    writeln('       Sort Method:           Sort Time (Seconds):');
    writeln('       1) Bubble Sort         ', BubbleTime:5:5);
    writeln('       2) Brute Force Bubble  ', BruteTime:5:5);
    writeln('                     ');
    writeln('       Options:');
    writeln('       8) Enable Sound = ', EnableSound);
    writeln('       9) Reinitialize Sort Array');
    writeln('       10) Set Delay Value (Setting = ', displaydelay, ' ms)');
    writeln;
    write('       Choose a sorting routine, Enter 0 to Quit: ');
    readln(choice);
    Getinput := choice;
end;

begin {****** MAIN PROGRAM *******}
    randomize;                     {gotta do this once!}
    displaydelay := 0;             {initialize things}
    BruteTime := 0;
    BubbleTime := 0;
    EnableSound := false;
    OrigMode := LastMode;
    if SCREENROWS > 23 then TextMode(CO80 + Font8x8);
    InitSortArray;
    sortchoice := Getinput;        {get a menu choice}
    while sortchoice > 0 do
     begin
         case sortchoice of        {do something}
            1: begin
                 BubbleSortDemo;
                 BubbleTime := CalculateRunTime;
               end;
            2: begin
                 BruteForceBubbleSortDemo;
                 BruteTime := CalculateRunTime;
               end;
            8: begin
                 write('       Enable Sound Effects? (Y/N): ');
                 readln(choice);
                 if UpCase(choice[1]) = 'Y' then
                    EnableSound := true
                 else
                    EnableSound := false;
               end;
            9: InitSortArray;
           10: SetDisplayDelay;
         end; {case}
         ResetBars;                {reset the Bar array to initial value}
         sortchoice := Getinput;   {get a menu choice}
     end; {while}
    TextMode(OrigMode);
    clrscr;
    writeln('       ???????????????????????????????????????????????????????????????');
    writeln('       ?  PASCAL Sort Demo Program, Copyright 1996, Robert Manning.  ??');
    writeln('       ?   Shareware demo code to demonstrate Bubble sort routine.   ??');
    writeln('       ?                                                             ??');
    writeln('       ?   Register to receive the complete sort demo program with   ??');
    writeln('       ?   full source code. Send $10 check or money order (U.S.     ??');
    writeln('       ?   Dollars only, please) to:                                 ??');
    writeln('       ?                                                             ??');
    writeln('       ?   Robert Manning, PO Box 2011, Lomita, CA 90717, USA        ??');
    writeln('       ????????????????????????????????????????????????????????????????');
    writeln('        ???????????????????????????????????????????????????????????????');
    writeln;
    writeln('       Program Ended. Have a nice day!');
end.