{************************************************************************
 ***                                                                  ***
 ***                     CHAINED NODES ROUTINES                       ***
 ***                                                                  ***
 ************************************************************************}
{provides a basic chainlink item, with just next pointer for simple on-heap
flat linked list (chain) operations.}
{$I compflgs}
unit Chains;

INTERFACE

uses objects;

{****************************************
 ***         BASIC ROOT LINK          ***
 ****************************************}
type
	PChainLink = ^TChainLink;
	TChainLink = object(TObject)
		Next : pointer;
		constructor Init;
		destructor Done; virtual;
	end;

{****************************************
 ***         CHAIN OF LINKS           ***
 ****************************************}
 {a small special case of a tree (1d), useful for little linked lists on
 the heap, easy to set up, etc, for use with above ChainLink,
 whereas TTree may be a little too much}
	PChain = ^TChain;
	TCHain = object(TObject)
		FirstLink, LastLink, CurrentLink : PChainLink;

		constructor Init;
		destructor Done; virtual;

		procedure SetCurrent(Link : PChainLink);
		procedure AddLink(Link : PChainLink; Where : boolean); {add link at start or end}
		procedure Delete;
		procedure DeleteLink(Link : PChainLink);
		function Remove : PChainLink; virtual;
		procedure Insert(Link : PChainLink);

		procedure ForEach(const ActionProc : pointer);
		function FirstThat(const TestFunc : pointer) : PChainLink;

		function Empty : boolean;

		{for treating it as a 0-based index}
		function LinkAt(Index : word) : PChainLink;
		function IndexOf(Link : PChainLink) : integer;
		function NumLinks : word;
	end;

{	PSortedChain = ^TSortedChain;
	TSortedCHain = object(TChain)
		FirstLink, LastLink, CurrentLink : PChainLink;

		function Compare(Key1, Key2 : pointer) : longint;
		function KeyOf(Link : PChainLink) : pointer;
		procedure Insert(Link : PChainLink);
		function Search(Key: Pointer; var Index: Integer): Boolean; virtual;

	end;{}

const
	{for insert}
	AtStart = True;
	AtEnd = False;

IMPLEMENTATION


{**************************************************************************
 ***                                                                    ***
 ***                              CHAIN ITEM                            ***
 ***                                                                    ***
 **************************************************************************}
constructor TChainLink.Init;
begin
	inherited Init;
	Next := nil;
end;

destructor TChainLink.Done;
begin
	if Next<>nil then dispose(PChainLink(Next), done);
	inherited Done;
end;


{**************************************************************************
 ***                                                                    ***
 ***                        CHAIN OF LINKS                              ***
 ***                                                                    ***
 **************************************************************************}

constructor TChain.Init;
begin
	inherited Init;
	FirstLink := nil;
	LastLink := nil;
	CurrentLink := nil;
end;

destructor TChain.Done;
begin
	if FirstLink<>nil then dispose(FirstLink, done); {which disposes of whole chain}
	inherited Done;
end;

{********************************************
 ***          INSERTING/ETC               ***
 ********************************************}

procedure TChain.SetCurrent(Link : PChainLink);
begin
	CurrentLink := Link;
end;

{Inserts just after currentlink}
procedure TChain.Insert(Link : PChainLink);
begin
	if CurrentLink = nil then begin
		{insert at start}
		Link^.Next := FirstLink;
		FirstLink := Link;
		if LastLink = nil then LastLink := Link; {empty list}
	end else begin
		{insert after current}
		if LastLink=nil then begin
			FirstLink := Link;
			LastLink := Link;
		end	else begin
			Link^.Next := CurrentLink^.next;
			CurrentLink^.Next := Link;
			if LastLink = CurrentLink then LastLink := Link; {move last pointer on}
		end;
	end;
	SetCurrent(Link);
end;



procedure TChain.AddLink(Link : PChainLink; Where : boolean);
begin
	if Where then
		SetCurrent(nil)
	else
		SetCurrent(LastLink);

	Insert(Link);
end;


{remove current from list & return pointer but don't dispos}
function TChain.Remove;
var WorkLink : PChainLink;
begin
	if CurrentLink = FirstLink then begin
		FirstLink := FirstLink^.Next;
		if CurrentLink = LastLink then LastLink := nil; {last element disposed}
	end else begin
		{find one previous to the one to be deleted}
		WorkLink := FirstLink;
		while (WorkLink<>nil) and (WorkLink^.Next<>CurrentLink) do WorkLink := WorkLink^.Next;
		if WorkLink<>nil then WorkLink^.Next := CurrentLink^.Next;
		if CurrentLink = LastLink  then LastLink := WorkLink;
	end;

	WorkLink := CurrentLink;
	CurrentLink := CurrentLink^.Next;
	WorkLink^.Next := nil; {so dispose works w/o deleting rest of chain}
	Remove := WorkLink;
end;

{remove & dispose current}
procedure TChain.Delete;
begin
	dispose(Remove, done);
end;

procedure TChain.DeleteLink;
begin
	SetCurrent(Link);
	Delete;
end;

function TChain.Empty : boolean;
begin Empty := (FirstLink = nil); end;

{*********************************************
 ***          FOR EACH/FIRST THAT          ***
 *********************************************}
{See linklist for notes on stackframes, etc}
procedure TChain.ForEach(const ActionProc : pointer);
var Link : PChainLink;
begin
	Link := FirstLink;
	while Link<>nil do begin

		{need to put caller's stack frame on before calling foreachproc, which should be a local proc}
		asm
			LES     DI,Link      {put parameter onto stack}
			PUSH    ES
			PUSH    DI

			PUSH		WORD PTR [BP]		{put testfunc's parent's stack frame onto stack}

			CALL    ActionProc     	{do action}
		end;

		Link := Link^.Next;
	end;
end;

function TChain.FirstThat(const TestFunc : pointer) : PChainLink;
var Link : PChainLink;
		Found : boolean;
begin
	Link := FirstLink;
	Found := False;

	while (Link<>nil) and not Found do begin

		{need to put caller's stack frame on before calling foreachproc, which should be a local proc}
		asm
			LES     DI,Link      {put parameter onto stack}
			PUSH    ES
			PUSH    DI

			PUSH		WORD PTR [BP]		{put testfunc's parent's stack frame onto stack}

			CALL    TestFunc       	{call testFunc}
			MOV			Found, AL
		end;

		if not Found then Link := Link^.Next;
	end;

	FirstThat := Link;
end;

{********************************************
 ***           AS AN ARRAY                ***
 ********************************************}
{for treating it as a 0-based index}

{=== LINK AT POSITION =================}
function TChain.LinkAt(Index : word) : PChainLink;
var Link : PChainLink;
begin
	Link := FirstLink;
	while (Link<>nil) and (Index>0) do begin
		Link := Link^.Next;
		dec(Index);
	end;
	LinkAt := Link;
end;

{======= POSITION OF LINK =============}
function TChain.IndexOf(Link : PChainLink) : integer;
var W : integer;
		WorkLink : PChainLink;
begin
	WorkLink := FirstLink;
	W := 0;
	while (WorkLink<>nil) and (Link<>WorkLink) do begin
		WOrkLink := WorkLink^.Next;
		inc(W);
	end;
	if WorkLink = nil then IndexOf := -1 else IndexOf := W;
end;

function TChain.NumLinks : word;
var W : word;
		Link : PChainLink;

begin
	W := 0;
	Link := FirstLink;
	while Link<>nil do begin Link := Link^.Next; inc(W); end;
	NumLinks := W;
end;


end.
