unit listObjs;

  { listObjs                                                                       }
  { Copyright © 1992 by Michael J. Gibbs, all rights reserved.                     }
  {                                                                                }
  { This unit provides a set of classes for managing lists of objects              }
  { non-invasively.  Non-invasively means the objects do not have their own        }
  { mechanisms for managing the list, they are referenced by cListElems that are   }
  { physically part of the list.                                                   }
  {                                                                                }
  { Known problems                                                                 }
  {  € prependList does not work                                                   }

interface

	uses
		ObjIntf, OSUtils;

	type
		cListElem = object(tObject)                     { an element of a list       }
				next: cListElem;                            { reference to next element  }
				theData: tObject;                           { ref to object in list      }
				procedure iListElem;                        { initialize list element    }
				procedure setData (newData: tObject);       { assign list object ref     }
				function getData: tObject;                  { get ref to list object     }
				procedure setNext (theNext: cListElem);     { set ref to next element    }
				function getNext: cListElem;                { get ref to next element    }
			end;

		cList = object(tObject)                          { a list of objects          }
				first: cListElem;                            { reference to first element }
				numElems,                                    { number of elements in list }
				lastAccess: longint;                         { # of last element used     }
				lastAccessElem: cListElem;                   { reference to last elem used}
				procedure iList;
          { initialize the list object }
				procedure prependToList (newData: tObject);
          { add a new element to the beginning of the list }
				procedure appendToList (newData: tObject);
          { add a new element to the end of the list }
				procedure insertInList (newData: tObject; thePosition: longint);
          { insert a new element at position thePosition }
				procedure insertInOrder (newData: tObject);
          { insert a new element, in order (based on isLessThan), into the list }
				function isLessThan (obj1, obj2: tObject): boolean;
          { OVERRIDE - Return true if obj1<obj2; used by insertInOrder & mergeList }
				procedure deleteElement (theElem: longint);
          { delete the Nth element }
				procedure prependList (theList: cList; cloneTheData: boolean);
          { insert a list before this list }
				procedure appendList (theList: cList; cloneTheData: boolean);
          { append a list to this list }
				procedure mergeList (theList: cList; cloneTheData: boolean);
          { merge theList into this list, in order, based on isLessThan }
				function getNumElements: longint;
          { return the number of elements in the list }
				function getElement (elemNumber: longint): tObject;
          { return the Nth element of list }
				function getNextElement: tObject;
          { return the next element in list }
				procedure setPosition (newPosition: longint);
          { set current position within the list }
				function getPosition: longint;
          { get the current position within the list }
				function findElement (searchFor: tObject): longint;
          { returns location of the specified object within the list }
				function findElementUsing (function elemMatch (theData: tObject): boolean): tObject;
          { returns the object for which elemMatch returns true }
				function select (function elemMatch (theData: tObject): boolean): cList;
          { returns a new list containing all elements for which elemMatch returned true }
				procedure doForEach (function theProc (theData: tObject): boolean);
          { calls theProc for each element in the list, or until theProc returns false }
				procedure freeData;
          { send a free message to each obj in the list }
				procedure clear;
          { clear the list structure (but not the data objects) }
				procedure free;
          { free the entire list structure (but not the data objects) }
				override;
			end;

implementation

	uses
		Sound;
  { €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ }

	procedure cListElem.iListElem;

  { Initialize a list element }

	begin
		next := nil;
		theData := nil;
	end;

	procedure cListElem.setData (newData: tObject);

  { Set the object to be referenced by the list element }

	begin
		theData := newData;
	end;

	function cListElem.getData: tObject;

  { Return a reference to the object associated with the list element }

	begin
		getData := theData;
	end;

	procedure cListElem.setNext (theNext: cListElem);

  { Set a reference to the next element in the list }

	begin
		next := theNext;
	end;

	function cListElem.getNext: cListElem;

  { Return a reference to the next element in the list }

	begin
		getNext := next;
	end;

  { €€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€€ }

	function makeNewElem (newData: tObject): cListElem;

  { Create and initialize a new list element and set its data to newData }

		var
			newElem: cListElem;

	begin
		new(newElem);
		newElem.iListElem;
		newElem.setData(newData);
		makeNewElem := newElem;
	end; { makeNewElem }

	procedure cList.iList;

  { Initialize a list object }

	begin
		first := nil;
		numElems := 0;
		lastAccess := 0;
		lastAccessElem := nil;
	end; { cList.iList }

	procedure cList.prependToList (newData: tObject);

  { add new data to the beginning of the list }

		var
			newElem: cListElem;

	begin
		newElem := makeNewElem(newData);
		newElem.setNext(first);
		first := newElem;
		numElems := numElems + 1;
		lastAccess := 1;
		lastAccessElem := first;
	end;

	procedure cList.appendToList (newData: tObject);

  { add new data to the end of the list }

		var
			newElem, temp: cListElem;

	begin
		newElem := makeNewElem(newData);
		newElem.setNext(nil);

		if first = nil then
			first := newElem
		else if (lastAccess = numElems) & (lastAccessElem <> nil) then
			lastAccessElem.setNext(newElem)
		else
			begin
				temp := first;
				while temp.getNext <> nil do
					temp := temp.getNext;
				temp.setNext(newElem);
			end;
		lastAccessElem := newElem;

		numElems := numElems + 1;
		lastAccess := numElems;
	end;

	procedure cList.insertInList (newData: tObject; thePosition: longint);

		var
			temp, previous, newElem: cListElem;
			n: longint;

	begin
		if thePosition < 2 then
			self.prependToList(newData)
		else if thePosition > numElems then
			self.appendToList(newData)
		else
			begin
				newElem := makeNewElem(newData);
				if thePosition = 1 then
					begin
						newElem.setNext(first);
						first := newElem;
					end
				else
					begin
						temp := first;
						n := 1;
						while n < thePosition do
							begin
								previous := temp;
								temp := temp.getNext;
								n := n + 1;
							end;
						newElem.setNext(temp);
						previous.setNext(newElem);
					end;
				numElems := numElems + 1;
				lastAccess := thePosition;
				lastAccessElem := newElem;
			end;
	end;

	procedure cList.insertInOrder (newData: tObject);

  { Insert newData into the list in order.  NOTE- if any of the other insertion    }
  { methods are used to place data into the list its ordering cannot be guaranteed }
  { and this method may not correctly place the data within the list.              }

		var
			temp, prev, newElem: cListElem;
			found: boolean;
			n: integer;

	begin
		if (first = nil) | (self.isLessThan(newData, first.getData)) then
			prependToList(newData)
		else
			begin
				found := false;
				n := 1;
				temp := first;
				prev := temp;
				while (temp <> nil) & (not found) do
					begin
						found := self.isLessThan(newData, temp.getData);
						if found then
							begin
								newElem := makeNewElem(newData);
								newElem.setNext(temp);
								prev.setNext(newElem);
							end
						else
							begin
								prev := temp;
								temp := temp.getNext;
								n := n + 1;
								if temp = nil then
									begin
										newElem := makeNewElem(newData);
										prev.setNext(newElem);
									end;
							end;
					end;
				lastAccess := n;
				lastAccessElem := newElem;
				numElems := numElems + 1;
			end;
	end; { cList.insertInOrder }

	function cList.isLessThan (obj1, obj2: tObject): boolean;

  { Returns TRUE if obj1 is less than obj2.  Override this method with one         }
  { specific to the data class.                                                    }

	begin
		SysBeep(1);
	end; { cList.isLessThan }

	procedure cList.deleteElement (theElem: longint);

		var
			n: longint;
			temp, previous: cListElem;

	begin
		if (theElem > 0) and (theElem <= numElems) then
			begin
				if theElem = 1 then
					begin
						temp := first;
						first := first.getNext;
						temp.free;
						lastAccessElem := first;
					end
				else
					begin
						n := 1;
						temp := first;
						while n < theElem do
							begin
								previous := temp;
								temp := temp.getNext;
								n := n + 1;
							end;
						lastAccessElem := temp.getNext;
						previous.setNext(lastAccessElem);
						temp.free;
					end;
				lastAccess := theElem;
				numElems := numElems - 1;
			end;
	end;

	procedure cList.prependList (theList: cList; cloneTheData: boolean);

		procedure prependItem (theElem: cListElem);

		begin
			if theElem.getNext <> nil then
				prependItem(theElem.getNext);
			if cloneTheData then
				self.prependToList(theElem.clone)
			else
				self.prependToList(theElem);
		end;

	begin
		prependItem(theList.first);
	end; { cList.prependList }

	procedure cList.appendList (theList: cList; cloneTheData: boolean);

		function appendElement (theElem: tObject): boolean;

		begin
			self.appendToList(theElem);
			appendElement := true;
		end;

		function appendElementClone (theElem: tObject): boolean;

		begin
			self.appendToList(theElem.clone);
			appendElementClone := true;
		end;

	begin
		if cloneTheData then
			theList.doForEach(appendElementClone)
		else
			theList.doForEach(appendElement);
	end; { cList.appendList }

	procedure cList.mergeList (theList: cList; cloneTheData: boolean);

		function insertElement (theElem: tObject): boolean;

		begin
			self.insertInOrder(theElem);
			insertElement := true;
		end;

		function insertElementClone (theElem: tObject): boolean;

		begin
			self.insertInOrder(theElem.clone);
			insertElementClone := true;
		end;

	begin
		if cloneTheData then
			theList.doForEach(insertElementClone)
		else
			theList.doForEach(insertElement);
	end; { cList.mergeList }

	function cList.getNumElements: longint;

	begin
		getNumElements := numElems;
	end; { cList.getNumElements }

	function cList.getElement (elemNumber: longint): tObject;

		var
			temp: cListElem;
			n: longint;

	begin
		if (elemNumber < 1) or (elemNumber > numElems) then
			getElement := nil
		else
			begin
				temp := first;
				n := 1;
				while n < elemNumber do
					begin
						temp := temp.getNext;
						n := n + 1;
					end;
				lastAccessElem := temp;
				lastAccess := elemNumber;
				getElement := temp.getData;
			end;
	end; { cList.getElement }

	function cList.getNextElement: tObject;

	begin
		if lastAccess < numElems then
			if lastAccessElem = nil then
				getNextElement := getElement(lastAccess + 1)
			else
				begin
					lastAccessElem := lastAccessElem.getNext;
					lastAccess := lastAccess + 1;
					getNextElement := lastAccessElem.getData;
				end
		else
			getNextElement := nil;
	end; { cList.getNextElement }

	procedure cList.setPosition (newPosition: longint);

	begin
		lastAccessElem := nil;
		if newPosition < 1 then
			begin
				lastAccess := 1;
				lastAccessElem := first;
			end
		else if newPosition > numElems then
			lastAccess := numElems
		else
			lastAccess := newPosition;
	end; { cList.setPosition }

	function cList.getPosition: longint;

	begin
		getPosition := lastAccess;
	end;

	function cList.findElement (searchFor: tObject): longint;

		var
			n: longint;
			found: boolean;
			temp: cListElem;

	begin
		n := 1;
		temp := first;
		found := false;
		while (not found) and (temp <> nil) do
			if temp.getData = searchFor then
				found := true
			else
				begin
					n := n + 1;
					temp := temp.getNext;
				end;
		if temp = nil then
			n := 0;
		findElement := n;
	end;

	function cList.findElementUsing (function elemMatch (theData: tObject): boolean): tObject;

		var
			result: boolean;
			temp: cListElem;
			n: integer;

	begin
		n := 1;
		result := false;
		temp := first;
		while (not result) & (temp <> nil) do
			begin
				result := elemMatch(temp.getData);
				if not result then
					begin
						temp := temp.getNext;
						n := n + 1;
					end;
			end;
		if result then
			begin
				findElementUsing := temp.getData;
				lastAccess := n;
				lastAccessElem := temp;
			end
		else
			findElementUsing := nil;
	end; { cList.findElementUsing }

	function cList.select (function elemMatch (theData: tObject): boolean): cList;

		var
			theNewList: cList;
			temp: cListElem;
			tempData: tObject;

	begin
		new(theNewList);
		theNewList.iList;
		temp := first;
		while temp <> nil do
			begin
				tempData := temp.getData;
				if elemMatch(tempData) then
					theNewList.appendToList(tempData);
				temp := temp.getNext;
			end;
		select := theNewList;
	end; { cList.select }

	procedure cList.doForEach (function theProc (theData: tObject): boolean);

		var
			temp: cListElem;
			result: boolean;

	begin
		result := true;
		temp := first;
		while result & (temp <> nil) do
			begin
				result := theProc(temp.getData);
				temp := temp.getNext;
			end;
	end; { cList.doForEach }

	procedure cList.freeData;

  { Free all the data attached to the list structure }

		var
			temp: cListElem;
			data: tObject;

	begin
		temp := first;
		while temp <> nil do
			begin
				data := temp.getData;
				if data <> nil then
					data.free;
				temp := temp.getNext;
			end;
	end;

	procedure cList.clear;

		var
			temp: cListElem;

	begin
		while first <> nil do
			begin
				temp := first.next;
				first.free;
				first := temp;
			end;
		first := nil;
		numElems := 0;
		lastAccess := 0;
		lastAccessElem := nil;
	end;

	procedure cList.free;

	begin
		self.clear;
		inherited free;
	end;

end.