{***************************************************************
 ***                                                         ***
 ***                  ID INDEXING ROUTINES                   ***
 ***                                                         ***
 ***************************************************************}
{$I compflgs}

{methods, etc for providing unique id numbers for data objects, eg
consequtive invoice ref numbers, etc.  The ID index stream object
consists of a simple file of longints.  The record number corresponds
to the id number, the longint is a pointer to the data item, and so the
size of the file is the new ID number.{}

{To make things eas(ier) to keep separate, pass the srtype of the data item
which the file name is then made from.  For now. It'll be nicer to tie in
a name to the srtype...}

unit IDindex;

INTERFACE

uses objects, tuiedit, tuilist, drivers, files;

const
	IDIndexItemSize = 20;

{type
	TIDIndexFile = file of Longint;{}


procedure SetIDPtr(const srType : word; RefID : longint; Ptr2Dat : longint);
function 	GetIDPtr(const srType : word; RefID : longint) : longint;
function GetNewID(const srType : word) : longint;

{procedure ClearIDIndex(const srType : word);{}

{===== INPUT REFERENCE NUMBER ==========}
type
	{Reference number to go with inputrefnum below - has own store/load methods
	that update reference index file}
{problems with this... use ref & oldref like TOrder	PRefNum = ^TRefNum;
	TRefNum = object
		Ref : longint;
		OldRef : longint;
		srType : word;
		constructor Init(NsrType : word);
		constructor Load(var S : TStream);
		procedure Store(var S : TStream);
	end; {}

	PIDIndexFile = ^TIDIndexFile;
	TIDIndexFile = object(TDataStream)
		srType : word;
		opType : word; {"other pointer" (back pointer) type associated with jimmy - 0 if none}
{		IDFile : file of longint;{}
		constructor Init(NsrType, NopType : word);
		destructor Done; virtual;{}
		procedure Clear;
		procedure TrimNils;

		procedure SetIDPtr(RefID, Ptr2Dat : longint);
		function GetIDPtr(RefID : longint) : longint;
		function GetNewID : longint;

		procedure Delete(Rec : longint); {actually moves to end, not deleting}
		procedure ShuffleUp(FromRec,ToRec : longint);
		procedure ShuffleDown(FromRec, ToRec : longint);

		procedure SetBackPointer(JimmyID, NewID : longint);
	end;


{automatically puts in new number, confirms if changed from new & undoes
new number if abandoned}

	PInputRefNum = ^TInputRefNum;
	TInputRefNum = object(TinputLint)
		NewID : longint;
		srType : word;
		Confirmed : boolean;
		constructor Init(Bounds : TRect; NFieldLen : integer; NsrType : word);
		procedure SetData(var Rec); virtual;
		function DataSize : word; virtual;
		function Valid(Command : word) : boolean; virtual;
		procedure Draw; virtual;
	end;

	PRefNumList = ^TRefNumList;
	TRefNumList = object(TLIstView)
		IDIndexFile : PIDIndexFile;

		constructor Init(Bounds : TRect; NsrType,NopType,NlsType : word);
		destructor Done; virtual;

		function  GetText(const ItemNo: longint) : string; virtual; {for display}
		procedure FocusText(Text : string); virtual;

		procedure HandleEvent(var Event : TEvent); virtual;

		procedure Del(RecNo : LongInt); virtual; {}
		procedure Edit(RecNo : longint); virtual;

		{Ranging}
		procedure SetRange; virtual;
	end;

{procedure OpenIDIndex(const srType : word; var RefNumFile : TIDIndexFile);{}

function IDStream(const fiType : byte) : PIDIndexFile;

IMPLEMENTATION

uses
{$IFDEF WINDOWS}
	wui,	{windows}
{$ELSE}
	tuiboxes,
	tui, tuimsgs, views,{text}
{$ENDIF}
			messtext,
			jimmys, tuijimmy,
			dattime,
			help,
			app,
			minilib,
			global; {data path}

function IDStream;
begin
	IDStream := PIDIndexFile(Stream(fiType));
end;


{************************************************
 ***          THE ID INDEX FILE               ***
 ************************************************}
constructor TIDIndexFile.Init;
var LastIOResult : integer;
begin
	inherited Init('ID'+N2Str(NsrType)+'.IDX',4,MinStreamBufSize);

	srType := NsrType;
	opType := NopType;

	FileAdmin(fiJimmys)^.LogOn;
{	Assign(IDFile, DataPath+'ID'+N2Str(srType)+'.IDX');
{$I-}
{	Reset(IDFile); LastIOResult := IOResult;
{$I+}
{	if LastIOResult=2 then begin
		{$I-}
{		Rewrite(IDFile); LastIOResult := IOResult;
		{$I+}
{	end;

	if LastIOResult<>0 then
		ProgramError('Could not open ID Index File '+'ID'+N2Str(srType)+'.IDX'
										+#13#10+IOerror(LastIOResult));{}
end;

destructor TIDIndexFile.Done;
begin
	FileAdmin(fiJimmys)^.LogOff;
	inherited Done;
{	Close(IDFile);{}
end;

{only to be used in fixit!}
procedure TIDIndexFile.Clear;
begin
	Seek(0);
	Truncate;
{	rewrite(IDFile);{}
end;

procedure TIDINdexFile.TrimNils;
var Rec : longint;
		ProBox : PProgressBox;
begin
	Timer.Start;
	ProBox := nil;

	Rec := NoRecs-1;
	while (GetIDPtr(Rec)=-1) and ((ProBox=nil) or (ProBox^.Command=cmOK)) do begin
		if Rec mod 500 = 0 then begin
			if ProBox=nil then begin
				ProBox := NewProgressBox('ID INDEX', '    Trimming    ', mfCancelButton, hcNoContext);
				with ProBox^ do DisplayOptions := DisplayOptions and not bpBar;
			end;
			ProBox^.Update('Trimming Blanks at end of ID Index'+CRLF+'Please Wait'+CRLF,Rec, 0);
		end;
		dec(Rec);
	end;
	if ProBox<>nil then begin
		ProBox^.Update('Truncating at '+N2Str(Rec+1),0,0);
		dispose(ProBox, done);
	end;
	SeekRec(Rec+1);
	Truncate;
end;


{======= SET ID PTR ================}
procedure TIDindexFile.SetIDPtr;
var	Rec,ID : longint;

begin
	{this check in the line below is mostly used so that setting -1 after
	the end of file	doesn't cause the file to grow}
	if GetIDPtr(RefID)<>Ptr2Dat then begin
		if RefID>(NoRecs) then begin
			{file is smaller than position, so clear up to that}
			Seekrec(NoRecs);
			ID := -1;
			for Rec := NoRecs to RefID do Write(ID,4); {clear}
		end;

		SeekRec(RefID);
		Write(Ptr2Dat,4);
	end;
end;

{======= LOAD ID PTR ===============}
function TIDindexFile.GetIDPtr;
var	ID : longint;

begin
	if RefID>=NoRecs then
		GetIDPtr := -1
	else begin
		SeekRec(RefID);
		Read(ID,4);
		GetIDPtr := ID;
	end;
end;




{====== RETURN NEXT NEW ID ==========}
function TIDIndexFile.GetNewID : longint;
begin
	if NoRecs=0 then
		GetNewID := 1 {start at ref num 1}
	else begin
		if GetIDPtr(NoRecs-1)=-1 then TrimNils;
		GetNewID := NoRecs;
	end;

end;

{====== SHUFFLING UP ================}
procedure TIDindexFile.ShuffleUp(FromRec, ToRec : longint);
var DelJimmyID, JimmyID, IDRec : longint;
begin
	{get deleted one}
	DelJimmyID := GetIDPtr(FromRec); {use getidptr as it does the check for past eof}

	{Shuffle others}
	for IDRec := FromRec+1 to ToRec do begin
		SeekRec(IDRec);  	Read( JimmyID,4);
		SeekRec(IDRec-1);	Write(JimmyID,4);

		SetBackPointer(JimmyID, IDRec-1);
	end;

	{put deleted one at end}
	SeekRec(ToRec);
	Write(DelJimmyID,4);

	SetBackPointer(DelJimmyID, ToREc);
end;

procedure TIDindexFile.ShuffleDown(FromRec, ToRec : longint);
var DelJimmyID, JimmyID, IDRec : longint;
begin
	{get deleted one}
	SeekRec(FromRec);
	Read(DelJimmyID,4);

	{Shuffle others}
	for IDRec := FromRec downto ToRec+1 do begin
		SeekRec(IDRec-1);	Read(	JimmyID,4);
		SeekRec(IDRec); 		Write(JimmyID,4);

		SetBackPointer(JimmyID, IDRec);
	end;

	{put deleted one at end}
	SeekRec(ToRec);
	Write(DelJimmyID,4);

	SetBackPointer(DelJimmyID, ToREc);
end;

{===== DELETE ========================}
{A special case of shuffleup, moving the one to be "deleted" to the end}
procedure TIDIndexFile.Delete(REc : longint);
var DelJimmyID : longint;

begin
	ThinkingOn('Deleting');
	ShuffleUp(Rec, NoRecs-1);

	{delete back pointer}
	SeekRec(NoRecs-1);
	Read(DelJimmyID,4);
	SetBackPointer(DelJimmyID, -1);

	{clip off last}
	SeekRec(NoRecs-1);
	Truncate;
	ThinkingOff;
end;



{==== SET BACK PTR (FOR ABOVE) =======}
procedure TIDIndexFile.SetBackPointer;
var	Jimmy : PJimmy;
		BakPtr : PLongint;
begin
	if opType<>0 then begin
		{change back pointer}
		Jimmy := GetJImmy(JImmyID);
		if Jimmy<>nil then begin
			Jimmy^.Getop(opType, BakPtr);
			BakPtr^ := NewID;
			Jimmy^.Storeop(opType);
			dispose(Jimmy, done);
		end;
	end;
end;


{procedure OpenIDIndex(const srType : word; var RefNumFile : TIDIndexFile);
var LastIOResult : word;
begin
	Assign(RefNumFile, DataPath+'ID'+N2Str(srType)+'.IDX');
{{$I-}
{	Reset(RefNumFile); LastIOResult := IOResult;
{{$I+}
{	if LastIOResult<>0 then
		Rewrite(RefNumFile);
end;


{**************************************
 ***     SHORT CUTS TO ABOVE        ***
 **************************************}

{==== SET ID POINTER ==================}
procedure SetIDPtr(const srType : word; RefID : longint; Ptr2Dat : longint);
var	IDIndexFIle : PIDIndexFile;

begin
	New(IDIndexFile, init(srType, 0));
	IDIndexFile^.SetIDPtr(RefID, Ptr2Dat);
	Dispose(IDIndexFile, done);
end;

{==== GET ID POINTER ==================}
function GetIDPtr(const srType : word; RefID : longint) : longint;
var	IDIndexFIle : PIDIndexFile;

begin
	New(IDIndexFile, init(srType,0));
	GetIDPtr := IDIndexFile^.GetIDPtr(RefID);
	dispose(IDIndexFile, done);
end;

{===== RETURN NEW ID POINTER =============}
function GetNewID(const srType : word) : longint;
var	IDIndexFIle : PIDIndexFile;

begin
	New(IDIndexFile, init(srType,0));
	GetNewID := IDIndexFile^.GetNewID;
	dispose(IDIndexFile, done);
end;


{**********************************************
 ***              REFERENCE NUMBER          ***
 **********************************************}
{CONSTRUCTOR TRefNum.Init;
begin
	Ref := -1;
	OldRef := -1;
	srType := NsrType;
end;

constructor TRefNum.Load;
begin
	S.Read(Ref, 4);
	OldREf := Ref;
end;

procedure TRefNum.Store;
begin
	S.Write(Ref, 4);
	if OldRef<>Ref then begin
		if OldRef<>-1 then SetIDPtr(srType, OldRef, -1); {clear old reference}
{		if Ref<>0 then SetIDPtr(srType, Ref, RecNo); {ignore no ref}
{	end;
end;



{**********************************************
 ***            INPUT REFERENCE OBJECT      ***
 **********************************************}
constructor TInputRefNum.Init;
begin
	inherited Init(Bounds, NFieldLen);
	NewID := -1;
	srType := NsrType;
	Confirmed := False;
end;

procedure TInputRefNum.SetData;
begin
	inherited SetData(Rec);
	if Data^ = '-1' then begin {mark Rec as -1 in object's init proc}
		NewID := GetNewID(srType); {New id number - store as data^ may be changed}
		Data^ := N2Str(NewID);
		OrigChanged := True; {mark so that it gets stored}
	end;
	Confirmed := False; {see valid method for what this is for...}
end;

function TInputRefNum.DataSize;
begin DataSize := 4; {sizeof(TRefNum);{} end;

function TInputRefNum.Valid;
var ConfirmControl : word;
begin
	if inherited Valid(Command) then begin
		Valid := True;

		if DoValidFor(Command) then begin

		if (Command<>cmReleasedFocus) and (S2Num(Data^)<>0) then begin {check at end of box, not when changing view}
			{for multiuser systems, we ought to check that the ref number here
			is still the latest one, and if not just inform the user}
			{$IFNDEF SingleUser}
			if (NewID=S2Num(Data^)) and   {user has not changed}
					(GetNewID(srtype)<>S2Num(Data^)) and {but file has}
					(GetIDPtr(srType, S2Num(Data^))<>PJimmyEditBox(Owner)^.Jimmy^.RecNo) then begin{and not self}
				PauseMessage('ID REF','ID '+Data^+' been used by another terminal'#13
											+'Setting to '+N2Str(GetNewID(srType)), hcIDBeenUsed);
				Data^ := N2Str(GetNewID(srType));
			end;
			{$ENDIF}

			{check if number has been changed - if so, if it's less than the newId
			check it's not already in use, if after confirm new numbering}
			if OrigChanged then begin

				{$IFNDEF fixit}
					if S2Num(Data^)<GetNewID(srType) then begin
						if (GetIDPtr(SrType, S2Num(Data^))<>-1) and
								(GetIDPtr(srType, S2Num(Data^))<>PJimmyEditBox(Owner)^.Jimmy^.RecNo) then begin
							Valid := False;
							Focus;
							InputWarning('ID '+Data^+' already used', hcIDAlreadyUsed);
						end;
					end;{}
				{$ENDIF}

				if (S2Num(Data^)>GetNewID(srType)) and not Confirmed then begin
					{confirm with user new start ID number}
					{marker; the okbutton does a validation, then the execview, so this
					flag is used to prevent this question being asked twice}
					Confirmed := True;
					{warn user}
					ConfirmControl := MessageBox('CONFIRM',
																				'New Ref Number entered '+Data^+#13+
																				'Set '+Data^+' as new starting number?',
																				mfConfirmation + mfWarningBleep + mfYesNo,
																				hcIDRefNum);
					if ConfirmControl <> cmYes then begin
						Valid := False;
						Focus;
					end;
				end;
			end; {been changed}
		end; {not releasedfocus}
		end; {ok command}

	end; {inherited valid}
end;

procedure TInputRefNum.Draw;
begin
	inherited Draw;
	writeChar(0,0, '#',4,1);         {Hash}
end;

{**********************************************************
 ***          REFERENCE NUMBER LIST                     ***
 **********************************************************}
constructor TRefNumList.Init(Bounds : TRect; NsrType, NopType, NlsType : word);
begin
	inherited init(Bounds, NlsType);
	New(IDIndexFIle, init(NsrType, NopType));
end;

destructor TrefNumList.Done;
begin
	dispose(IDIndexFIle, done);
	inherited Done;
end;

function  TRefNumList.GetText(const ItemNo: longint) : string; {for display}
var Jimmy : PJimmy;
begin
	Jimmy := PJimmy(GetJimmy(IDIndexFile^.GetIDPtr(ItemNo)));

	if Jimmy=nil then
		{not loaded so mark as hole}
		GetTExt := N2Str(ItemNo)+' No Entry'
	else begin
		{get text}
		GetText := Jimmy^.DisplayLine(-1, lsType, Size.X, 0); {}
		dispose(Jimmy, done);
	end;
end;


procedure TRefNumList.FocusText(Text : string);
begin
	FocusItem(S2Num(Text));
end;

procedure TRefNumList.HandleEvent(var Event : TEvent);
{$IFDEF fixit}
var RefRec,Ref : longint;
		Control : word;
{$ENDIF}

begin
	inherited HandleEvent(Event);

	if (Event.What = evBroadCast) and (Event.Command=cmJimmyStored) then
		if PJimmyStoredInfo(Event.InfoPtr)^.Jimmy^.srType = IDIndexFile^.srType then begin
			SetRange;
			Redraw;
		end;

	{$IFDEF fixit}
	if (Event.What=evKeyDown) and (Event.KeyCOde = kbCtrlEnter) then begin
		RefRec := Focused;
		Ref := IDIndexFile^.GetIDPtr(RefRec);
		Control := InputLintBox('FIXIT','ID Ptr', Ref);
		if Control = cmOK then begin
			IDIndexFile^.SetIDPtr(refRec,Ref);
			Redraw;
		end;
		ClearEvent(Event);
	end;
	{$ENDIF}

end;

procedure TRefNumList.Del(RecNo : LongInt);
begin
	ThinkingOn('Deleting');
	IDIndexFIle^.Delete(RecNo);
	SetRange;
	Redraw;
	ThinkingOff;
end;

{Ranging}
procedure TRefNumList.SetRange;
begin
	FirstItem := 1;
	LastItem := IDIndexFile^.GetNewID-1;

	inherited SetRange;
end;

{==== EDIT - CHANGE POS =============}
procedure TRefNumList.Edit;
var C : word;
		JimmyID, NewPos : longint;
		Jimmy : PJimmy;

begin
	JimmyID := IDIndexFile^.GetIDPtr(RecNo);

	if JimmyID = -1 then exit;

	Jimmy := GetJimmy(JimmyID);

	NewPos := RecNo;

	C := InputLintBox('MOVE '+Jimmy^.GetName(naRef,0), 'New Position', NewPos);

	if (C=cmOK) and (NewPos<>RecNo) then begin
		ThinkingOn('Moving');
		if NewPos>RecNo then begin
			{move to later}
			IDIndexFile^.ShuffleUp(RecNo, NewPos);
		end else begin
			{move to earlier}
			IDIndexFile^.ShuffleDown(RecNo, NewPos);
		end;
		ThinkingOff;
		Redraw;
	end;

end;



end.