{ ----------------------------------------------------------------------------------------------------------	}
{ ----------------------------------------------------------------------------------------------------------	}
{																								}
{										GENERIC SORT									}
{										```````````````````````									}
{																								}
{	A Generic Utilities unit, for use by any program.
	Copyright İ by David Sinclair, 1990 ­ 2001.
	
	<http://www.dejal.com/pascal/>
	
	I am releasing these units to the Pascal community.  Feel free to use them in whole or part in your Pascal programs.
	You are also welcome to modify these units to suit your needs.  If you wish to re-distribute the sources with your changes,
	please clearly indicate that you have changed them.  In all cases, you must leave these comments and the copyright notice intact.
	If you use a significant portion of these units, I would appreciate acknowledgement in your About dialog and/or documentation,
	e.g. ³Dejal Generic Utilities copyright İ by David Sinclair, 1990 - 2001.²
	
	Iıd appreciate it if you also e-mail me at <pascal@dejal.com> if you find these units useful.  If you have any questions about
	these units, you can e-mail me at that address and I will do my best to help, time permitting.  However, these units are provided
	³as is² and I do not guarantee their reliablity or suitability for any particular purpose.
	
	These units have been used extensively in my Dejal shareware and freeware products over the years.  Most of the code was written
	many years ago, and the code and style may not be optimal in all cases, but unless otherwise noted all routines have been used
	in released software, so should work as described.
	
	Please visit <http://www.dejal.com/> and try out Dejal QuickEncrypt and/or my other shareware products.  If you want to show
	your appreciation for these units financially, registrations for my shareware are always welcome!  Or you can make a donation to
	me via my online order form: <http://www.dejal.com/kagi/>.
	
	I hope you find these units useful, and good luck in your Pascal endeavors!
	
	- David Sinclair, Dejal
}
{											* * *												}
{	UNIT HISTORY:																		}
{																								}
{	Version:	Start - finish dates:	Comments / changes:								}
{																								}
{	1.0:		21 Sep 1991			Code from 07.230 exerice 2 to implement a	}
{										QuickSort used to start the unit off.				}
{	1.1:		25 October 1991		Added the sortCount function.					}
{	2.0:		20 December 1991	First public release, in library form.				}
{	2.1:		30 Sep ­ 1 Oct 92	Updated for SndConverter etc, reworking		}
{										to use a dynamic- instead of fixed array.		}
{	2.2:		4 January 1995		Modified to use numNewHandle etc instead	}
{	27 October 2001				Public release as source code.					}
{										of NewHandle etc.									}
{											* * *												}
{	N.B:	Most of my units require the compile-time variables Œapplicationı	}
{			and Œdebugı, both of which are booleans.									}
{ ----------------------------------------------------------------------------------------------------------	}
{ ----------------------------------------------------------------------------------------------------------	}


unit genSort;


interface


	uses

		genNumerics;


	const

		sortStringLength = 21;	{ To make the string an even length, incl. length byte }
								{ Note: this length is enough for a sorted index, but }
								{ you might want to use this to access the full string }


{ ----------------------------------------------------------------------------------------------------------	}


	function sortCreateList (maxItemsInList: integer): handle;

	procedure sortAddString (listHndl: handle; name: str255);

	procedure sortTheStrings (listHndl: handle);

	function sortReadString (listHndl: handle; index: integer): str255;

	function sortCount (listHndl: handle): integer;

	procedure sortDisposeList (var listHndl: handle);


{ ----------------------------------------------------------------------------------------------------------	}
{ ----------------------------------------------------------------------------------------------------------	}


implementation


	type

		stringType = string[sortStringLength];
		arrayOfStrings = array[1..1] of stringType;

{ Private data format and pointers: }

		dataRec = record
				maxItems, count: integer;				{ Header info }

				data: arrayOfStrings						{ Dynamic data array }
			end;

		dataPtr = ^dataRec;
		dataHandle = ^dataPtr;


	const

		headerSize = sizeOf(dataRec);
		itemSize = sizeOf(stringType);


{ ----------------------------------------------------------------------------------------------------------	}


	procedure swap (var s, t: stringType);
		var
			temp: stringType;
	begin
		temp:= s;
		s:= t;
		t:= temp
	end; { of procedure swap }

{ ----------------------------------------------------------------------------------------------------------	}

{$PUSH}
{$R-}

	procedure split (var data: arrayOfStrings; first, last: integer; var splitPt1, splitPt2: integer);

{ Chooses a splitting value 'v' and arranges data so that }
{ data[first].. data[splitPt2 <= v and data[splitPt1 + 1].. data[last] > v. }
{ }
{ From pp 533-535 of 07.105 text (see below for more details. }
{ From 1989 07.230 Exercise 2 Model Answer, written by John Thornley, 31-Jan-1989 }

		var
			right, left: integer;
			v: stringType;

	begin
		v:= data[(first + last) div 2];
		right:= first;
		left:= last;
		repeat
{€   while data[right] < v do€}
			while iuCompString(data[right], v) < 0 do		{ Better way of doing it! }
				right:= right + 1;
{€   while data[left] > v do€}
			while iuCompString(data[left], v) > 0 do
				left:= left - 1;
			if right <= left then
				begin
					swap(data[right], data[left]);
					right:= right + 1;
					left:= left - 1
				end
		until right > left;
		splitPt1:= right;
		splitPt2:= left
	end;

{$POP}

{ ----------------------------------------------------------------------------------------------------------	}

	procedure quickSort (var data: arrayOfStrings; first, last: integer);

{ Sorts 'data' from index 'first' to index 'last' using a quickSort. }
{ This is a recursive solution. }
{ Algorithm taken from Chapter 11, page 533 of "Pascal Plus Data Structures". }
{ From 1989 07.230 Exercise 2 Model Answer, written by John Thornley, 31-Jan-1989 }

		var
			splitPt1, splitPt2: integer;

	begin
		if first < last then
			begin
				split(data, first, last, splitPt1, splitPt2);
				if splitPt1 < last then
					quickSort(data, splitPt1, last);
				if first < splitPt2 then
					quickSort(data, first, splitPt2)
			end
	end;

{ ----------------------------------------------------------------------------------------------------------	}

	function sortCreateList (maxItemsInList: integer): handle;

{ Creates a new sort list, and returns a handle to it.  The data format is private, so you will need to }
{ use the following routines to access it.  Call this routine before any other genSort routines.  It can }
{ be called as many times as needed.  The resulting handle is nil if there isnıt sufficient memory to }
{ allocate the list; though it will attempt to use temporary memory, if available.  If valid, the }
{ handle is unlocked and in high memory.  The handle will be locked when necessary: you donıt }
{ need to worry about it. }
{ Written by David Sinclair, 30 September 1992. }

		var
			theHandle: handle;
			err: osErr;

	begin
		err:= numNewHandle(theHandle, headerSize + (itemSize * maxItemsInList));

		if theHandle <> nil then
			begin
				moveHHi(theHandle);

				with dataHandle(theHandle)^^ do
					begin
						maxItems:= maxItemsInList;
						count:= 0
					end
			end;

		sortCreateList:= theHandle
	end;

{ ----------------------------------------------------------------------------------------------------------	}

{$PUSH}
{$R-}

	procedure sortAddString (listHndl: handle; name: str255);

{ Adds the specified string to the specified list to be sorted. }
{ Written by David Sinclair, 21 September 1991 & 30 September 1992. }

	begin
		if listHndl <> nil then
			with dataHandle(listHndl)^^ do
				if count < maxItems then
					begin
						count:= count + 1;
						data[count]:= copy(name, 1, sortStringLength)
					end
	end;

{$POP}

{ ----------------------------------------------------------------------------------------------------------	}

	procedure sortTheStrings (listHndl: handle);

{ Does the actual sort of the data.  The data can be read after this call by calling }
{ sortReadString. }
{ Written by David Sinclair, 21 September 1991 & 30 September 1992. }

	begin
		if listHndl <> nil then
			with dataHandle(listHndl)^^ do
				if count > 1 then
					quickSort(data, 1, count)
	end;

{ ----------------------------------------------------------------------------------------------------------	}

{$PUSH}
{$R-}

	function sortReadString (listHndl: handle; index: integer): str255;

{ Reads the specified string from the specified list. }
{ Written by David Sinclair, 21 September 1991 & 1 October 1992. }

	begin
		sortReadString:= '';

		if listHndl <> nil then
			with dataHandle(listHndl)^^ do
				if index <= count then
					sortReadString:= data[index]
	end;

{$POP}

{ ----------------------------------------------------------------------------------------------------------	}

	function sortCount (listHndl: handle): integer;

{ Returns the number of items in the specified list. }
{ Written by David Sinclair, 25 October 1991 & 1 October 1992. }

	begin
		if listHndl <> nil then
			sortCount:= dataHandle(listHndl)^^.count
	end;

{ ----------------------------------------------------------------------------------------------------------	}

	procedure sortDisposeList (var listHndl: handle);

{ Disposes of the list of strings.  Call this after youıve finished with the list‹ }
{ the handle will be nil afterwards. }
{ Written by David Sinclair, 21 September 1991 & 30 September 1992. }

	begin
		numDisposeHandle(listHndl)
	end;


{ ----------------------------------------------------------------------------------------------------------	}
{ ----------------------------------------------------------------------------------------------------------	}


end.