{***************************************************************************
 ***                                                                     ***
 ***                          RONGAI WORKSHOPS 2 - PARTS REFERENCING     ***
 ***                                                                     ***
 *** MCH                                                           Jul 96***
 ***************************************************************************}
unit KRongai2;

interface

uses jimmys, notes, scodes, global,
			views, devices, forms, tuiedit, files;

const
	hkSuppliers = 1;

	PartCatgyIndexSize = 40;
	PartNumIndexSize = 20;

	prUsual = 0;
	prOK = 1;
	prLastResort = 3;

type
	PPartItem = ^TPartItem;
	TPartItem = object(TJimmy)
		PartNumIdx : array[1..4] of longint;
		CatgyIdx : array[1..8] of longint;
		Suppliers : longint; {supplier list}

		Vehicles 	: string[12];
		Catgy 		: TSCode;
		AltCatgy 	: TScode;
		Code 			: TScode;
		Description : string[30];

		PartNum : array[1..4] of record
			Make : TSCode;
			Num : string[15];
		end;

		Notes : PFreeTextData;

		LastOrder : longint; {pointer to last order made}

		constructor Init(Param : PJimmyInitParam);
		procedure COmmonInit; virtual;
		destructor Done; virtual;

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		function GetName(naType : byte; Maxlen : integer) : string; virtual; {used for various displays/prints -{}
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{for fixit, etc}
		function NumIDs : byte; virtual; {the number of jimmy ID ptrs in the data}
		function GetJimmyID(const jiType : byte) : PLongint; virtual; {each jimmy ID}

		{--- Indexing ----}
		function NumixTypes : byte; virtual;
		procedure GetIndex(const ixType : byte; var IdxRec : Plongint; var fiType : byte); virtual;
		function GetIndexKey(const ixType : byte) : string; virtual;

		{--- Hooking on others -----}
		function NumhkTypes : byte; virtual;
		procedure GetHookOn(const hkType : byte; var HookRec : PLongint); virtual;

		{--- printing ----}
		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;
		procedure PrintSummary(const Device : PDeviceStream; const PrintAs : word); virtual;
	end;

	{link between part & supplier, with priority}
	PPartSupplier = ^TPartSupplier;
	TPartSupplier = object(TJimmy)
		PartID : longint;
		SupplierID : longint;
		Priority : word; {ie usual, ok, last resort}

		constructor Init(Param : PJimmyInitParam);

		{--- Viewing -----}
		function DisplayLine(ListForWho : longint; lstype : byte; Maxlen : integer; View : word) : string; virtual;
		procedure MakeEditBox(var EditBox : PEditBox; Caller : PView); virtual;

		procedure SetFormCodes(const FormCodes: PFormCodeCollection); virtual;

		{--- Database ----}
		function RecSize : word; virtual; {space to be reserved in jimmy file}
		function srType : word; virtual; {descendants set as fixed, so can be
																			used to identify jimmy for file operations, etc}

		procedure Storefields(var S : TDataStream); virtual;
		constructor Load(var S : TDataStream);

		{for fixit, etc}
		function NumIDs : byte; virtual; {the number of jimmy ID ptrs in the data}
		function GetJimmyID(const jiType : byte) : PLongint; virtual; {each jimmy ID}

		{-- Hooking to others -----}
		function NumHookTo : byte; virtual;
		procedure GetHookTo(const htType : byte; var HookToID,SubHookToID : PLongint;
												var hkType : byte; var Key : longint; var InsertBias : boolean); virtual;
	end;


implementation

uses
	objects,
	tui, tuijimmy, tuimsgs,
	jimhooks,
	tasks,
	dialogs,
	inpjimmy,
	kdirctry,
	app,
	jimindxs,
	minilib;

{*********************************************************************
 ***                                                               ***
 ***                     PART ITEM                                 ***
 ***                                                               ***
 *********************************************************************}

constructor TPartItem.INit;
var PartItem : PPartitem;
begin
	inherited Init;

	LastORder := -1;

	{to aid entry of items, look at focused one and copy in fields}
	if Param<>nil then begin
		PartItem := PPartItem(GetJimmy(Param^.FocusedID));
		if PartItem<>nil then begin
			if PartItem^.srtype = srPartItem then begin
				{it really is a part item}
				Vehicles := PartItem^.Vehicles;
				Catgy := PartItem^.Catgy;
				AltCatgy := PartItem^.AltCatgy;
				Code := PartItem^.Code;

				{suppliers...}
			end;
			dispose(PartItem, done);
		end;
	end;
end;

procedure TPartItem.CommonInit;
begin
	inherited CommonInit;

	ScodeCollection[scPartMakers]^.LogOn;
	ScodeCollection[scVehicleModel]^.LogOn;
	ScodeCollection[scPartCatgy]^.LogOn;
	ScodeCollection[scPartCode]^.LogOn;

	New(Notes, init);
end;

destructor TPartItem.Done;
begin
	ScodeCollection[scPartMakers]^.LogOff;
	ScodeCollection[scVehicleModel]^.LogOff;
	ScodeCollection[scPartCatgy]^.LogOff;
	ScodeCollection[scPartCode]^.LogOff;

	dispose(Notes, done);

	inherited Done;
end;

function TPartItem.DisplayLine;
var S,SS : string;
begin
	S := 'No display line for TPartItem?';

	case lsType of
		lsPartNum : begin
			S := Setlength(PartNum[gotbyix].Num+' '+PartNum[gotbyix].Make,20)+Code + Description;
		end;
		lsPartCatgy : begin
			case gotbyix of
				5..8 	: S := Setlength(WordNo(Vehicles, gotbyix-4),3)+Setlength(Catgy,3);
				9..12 : S := Setlength(WordNo(Vehicles, gotbyix-8),3)+Setlength(AltCatgy,3);

			end;
			if Description='' then SS := '' else SS := ', '+Description;
			S := S +Setlength(Code,3)+' '
							+Setlength(ExpandSCode(scPartCode, Code)+SS, 40)
							+' '+PartNum[1].Make+' '+PartNum[1].Num;
		end;
	end;

{	if GetLock<>0 then S := SetLength(S, Maxlen-1)+char(GetLock);{}

	DisplayLine := S;
end;

function TPartItem.GetName;
begin
	if naType = naRef then
		GetName := FirstWord(Description)
	else
		GetName := Code + ' ' + Description;
end;

{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TPartItem.MakeEditBox;
var	R: TRect;
		B : byte;
		S : string;

begin
	if not Notes^.Loaded then Notes^.LoadText;

	R.Assign(0, 0, 70, 17);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Part Item',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+16+32+4)));

		InsTitledField(15,  1,51, 1, 'For ~V~ehicles',  New(PInputSCLine, init(R, 12, scVehicleModel)));

		InsTitledField(15,  3,20, 1, 'C~a~tegory', New(PinputSCode, init(R, scPartCatgy)));
		InsTitledField(15,  4,20, 1, 'Alt Category', New(PinputSCode, init(R, scPartCatgy)));
		InsTitledField(15,  5,20, 1, '~I~tem', 				New(PInputSCode, init(R, scPartCode)));
		InsTitledField(15,  6,20, 1, '~D~esc', 			New(PInputELine, init(R, 30)));

		S := 'Part ~N~os';
		for B := 1 to 4 do begin
			InsTitledField(47, 2+B, 3, 1, S, New(PinputSCode, init(R, scPartMakers)));
			InsTitledBox(  53, 2+B,13, 1, '', 15);
			S := '';
		end;

		InsTitledField(10, 8,  56, 3, '~S~upplrs',
			New(PDlgHookView,	Init(R, lsPartSuppliers, 0, hkSuppliers, @Self, PJimmyEditBox(EditBox))));
		Insert(PDlgHookView(Current)^.VScrollBar);

		InsTitledField(10, 12, 32, 4, 'N~o~tes', New(PInputFreeText, init(R, 1000, 30, nil)));

		Insert(New(PAccessJimmyButton, init(46, Size.Y-3, 'Last ~O~rder', 0,@Self))); {owning order}

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(58,Size.Y-5, @Self)));
		Insert(New(PjimmyCancelButton, init(58,Size.Y-3, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RPartItem : TStreamRec = (
		ObjType : srPartItem;
		VmtLink : Ofs(TypeOf(TPartItem)^);
		Load : @TPartItem.Load;
		Store : @TPartItem.Store
	);

function TPartItem.RecSize;
begin RecSize := 200; end;

function TPartItem.srType;
begin srType := srPartItem; end;


constructor TPartItem.Load(var S : TDataStream);
var	B,Ver : byte;

begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			Vehicles := S.ReadStr;
			S.Read(Catgy, 4);
			S.Read(AltCatgy, 4);
			S.REad(Code, 4);
			Description := S.ReadStr;
			for B := 1 to 4 do begin
				S.Read(PartNum[B].Make, 4);
				PartNum[B].Num := S.ReadStr;
			end;

			Notes^.Load(S);
			S.REad(LastOrder, 4);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TPartItem.Load',mfError,hcNoContext);
		fail;
	end;
end;

procedure TPartItem.StoreFields(var S : TDataStream);
var	B,Ver : byte;

begin
	Ver := 1; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.WriteStr(@Vehicles);
	S.Write(Catgy, 4);
	S.Write(AltCatgy, 4);
	S.Write(Code, 4);
	S.WriteStr(@Description);
	for B := 1 to 4 do begin
		S.Write(PartNum[B].Make, 4);
		S.WriteStr(@PartNum[B].Num);
	end;
	Notes^.Store(S);
	S.Write(LastOrder, 4);
end;

{****************************************************
 ***               POINTERS TO OTHER JIMMYS       ***
 ****************************************************}
function TPartItem.NumIDs;
begin
	NumIDs := 1;
end;

function TPartItem.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @LastOrder;
	else
		GetJimmyID := nil;
	end;
end;

{**************************************
 ***       DATABASE                 ***
 **************************************}
function TPArtItem.NumixTypes;
begin NumixTypes := 12; end;

procedure TPartItem.GetIndex;
begin
	inherited GetIndex(ixType, IdxRec, fiType);

	case ixType of
		1..4 	: begin IdxRec := @PartNumIdx[ixType]; fiType := fiPartNumIdx; 		end;
		5..12 : begin IdxRec := @CatgyIdx[ixType-4]; fiType := fiPartCatgyIdx; 	end;
	end;
end;

function TPartItem.GetIndexKey;
begin
	GetIndexKey := '';
	case ixType of
		1..4 	: GetIndexKey := ucase(PartNum[ixType].Num);

		5..8	: if delspaceR(Vehicles)<>'' then begin
							if WordNo(Vehicles, ixType-4)<>'' then
								GetIndexKey := SetLength(WordNo(Vehicles,ixType-4),3)+Setlength(Catgy,3)+Setlength(Code,3)+ucase(Description);
						end else
							if ixtype = 5 then GetIndexKey := Setlength(Catgy,3)+Setlength(Code,3)+ucase(Description);

		9..12 : if delspaceR(AltCatgy)<>'' then
							if delspaceR(Vehicles)<>'' then begin
								if WordNo(Vehicles, ixType-8)<>'' then
									GetIndexKey := SetLength(WordNo(Vehicles,ixType-8),3)+Setlength(AltCatgy,3)+Setlength(Code,3)+ucase(Description);
								end else
									if ixtype = 9 then GetIndexKey := Setlength(AltCatgy,3)+Setlength(Code,3)+ucase(Description);

	end;
end;

function TPartItem.NumhkTypes;
begin NumhkTypes := hkSuppliers; end;

procedure TPartItem.GetHookOn;
begin
	inherited GetHookOn(hkType, HookRec);
	case hkType of
		hkSuppliers: HookRec := @Suppliers;
	end;
end;


{************************************************************
 ***              PRINTING                                ***
 ************************************************************}
procedure TPartItem.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	with FormCodes^ do begin
	end;
end;


{will only be used (?) in Driver's more-about list}
procedure TPartItem.PrintSummary;
begin
{	Device^.writeln(DisplayLine(Driver, lsMoreAbout, 0,0));{}
end;


{*********************************************************************
 ***                                                               ***
 ***                     PART SUPPLIER LINK                        ***
 ***                                                               ***
 *********************************************************************}

constructor TPartSupplier.INit;
begin
	inherited Init;
	SupplierID := -1;
	Priority := prOK;

	if Param=nil then
		programError('TPartSupplier, no param set?!', hcNoContext)
	else begin
		PartID := Param^.ForWho;
		if Param^.FocusedID = -1 then {if not focused, must be first in list}
			Priority := prUsual;
	end;
end;

function TPartSupplier.DisplayLine;
var S : string;
begin
	S := GetJimmyIDName(SupplierID, naReport, 0);

	case Priority of
		prUsual : S := Setlength(S,Maxlen-6)+'*USUAL';
		prLastResort : S := Setlength(S,Maxlen-12)+'LAST RESORT!';
	end;

	DisplayLine := S;
end;

{**************************************************
 ***             EDIT BOX                       ***
 **************************************************}
procedure TPartSupplier.MakeEditBox;
var	R: TRect;
		B : byte;
		S : string;

begin
	R.Assign(0, 0, 40, 8);
	CentreOnView(R, Caller);
	EditBox := New(PJimmyEditBox, Init(R, 'Part Supplier',Caller, @Self));

	with EditBox^ do begin
		Insert(New(PSkipBytes, init(Sizeof(TJimmy)+4)));

		InsTitledField(11,  1,25, 1, '~S~upplier',  New(PInputDIrectory, init(R, 30, fiCatDirIdx, lsDirectory, 'SUP')));
		PInputELine(Current)^.MustInput := True;

		R.Assign(11, 3, 28, 6);
		Insert(new(PERadioButtons, init(R, NewSItem('~U~sual', NewSItem('~O~K', NewSitem('Last ~R~esort', nil))))));

		{-- Buttons --}
		Insert(New(PJimmyOKButton, Init(29,3, @Self)));
		Insert(New(PjimmyCancelButton, init(29,5, @Self)));

		EndInit;
	end;
end;

{*****************************************
 ***     STREAMING DEFINITIONS         ***
 *****************************************}

const
	{--- Required for Stream ----}
	RPartSupplier : TStreamRec = (
		ObjType : srPartSupplier;
		VmtLink : Ofs(TypeOf(TPartSupplier)^);
		Load : @TPartSupplier.Load;
		Store : @TPartSupplier.Store
	);

function TPartSupplier.RecSize;
begin RecSize := 50; end;

function TPartSupplier.srType;
begin srType := srPartSupplier; end;


constructor TPartSupplier.Load(var S : TDataStream);
var	B,Ver : byte;

begin
	S.Read(Ver, 1);
	case Ver of
		1 : begin
			inherited Load(S);

			S.Read(SupplierID, 4);
			S.REad(PartID, 4);
			S.Read(Priority, 2);
		end;
	else
		DBaseMessage(@S, 'Version '+N2Str(Ver)+' not understood'#13#10'TPartSupplier.Load',mfError, hcNoContext);
		fail;
	end;
end;

procedure TPartSupplier.StoreFields(var S : TDataStream);
var	B,Ver : byte;

begin
	Ver := 1; S.Write(Ver, 1);

	inherited StoreFields(S);

	S.Write(SupplierID, 4);
	S.Write(PartID, 4);
	S.Write(Priority, 2);
end;

{****************************************************
 ***               POINTERS TO OTHER JIMMYS       ***
 ****************************************************}
function TPartSUpplier.NumIDs;
begin
	NumIDs := 2;
end;

function TPartSupplier.GetJImmyID;
begin
	case jiType of
		1 : GetJimmyID := @SupplierID;
		2 : GetJimmyID := @PartID;
	else
		GetJimmyID := nil;
	end;
end;
{**************************************
 ***       DATABASE                 ***
 **************************************}
function TPartSupplier.NumHookTo;
begin	NumHookTo := 1; end;

procedure TPartSupplier.GetHookTo;
begin
	inherited GetHookTo(htType, HookToID,SubHookToID, hkType, Key, InsertBias);

	case htType of
		1 : begin HookTOID := @PartID; hkType := hkSuppliers; end;
	end;
end;

{************************************************************
 ***              PRINTING                                ***
 ************************************************************}
procedure TPartSupplier.SetFormCodes(const FormCodes: PFormCodeCollection);
begin
	with FormCodes^ do begin
	end;
end;


{*********************************************************************
 ***                                                               ***
 ***                     PARTS LIST                                ***
 ***                                                               ***
 *********************************************************************}
type
	PPartsListView = ^TPartsListView;
	TPartsListView = object(TIndexedJimmyListView)

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

	end;

function TPartsListView.GetText;
var S : string;
begin
	S := inherited GetText(ItemNo);

	GetText := Copy(S, MatchLength(S, SubIndexString)+1, 256);
end;




{********************************************************************
 ***                 INITIALISERS, CREATORS, ETC                  ***
 ********************************************************************}
function CreatePartItem(P : pointer) : pointer; far;
begin CreatePartItem := New(PPartItem, init(P)); end;

function CreatePartSupplier(P : pointer) : pointer; far;
begin CreatePartSupplier := New(PPartSupplier, init(P)); end;

function NewPartCatgyIndex : PStream; far;
begin NewPartCatgyIndex := New(PIndexedJimmyStream, init('PARTCTGY.IDX',PartCatgyIndexSize)); end;

function NewPartNumIndex : PStream; far;
begin NewPartNumIndex := New(PIndexedJimmyStream, init('PARTNUM.IDX',PartNumIndexSize)); end;

procedure StartPartCatgyList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Parts List',
				New(PPartsListView, init(Bounds, lsPartCatgy, fiPartCatgyIdx, '')))));
end;

procedure StartPartNumList; far;
var Bounds : TRect;
begin
	Desktop^.GetExtent(Bounds);
	Desktop^.Insert(New(PIndexedJimmyListWindow, init(Bounds, 'Parts List (by part no.)',
				New(PPartsListView, init(Bounds, lsPartNum, fiPartNumIdx, '')))));
end;

procedure FindPart; far;
var AcceptorLine : PInputSCode;
		R : TRect;
		Model, Catgy : TScode;

begin
	{Ask for vehicle type}
	R.Assign(3,5,10,5); New(AcceptorLine, init(R, scVehicleModel));
	Desktop^.Insert(AcceptorLine); {has to, so that IsView works for accepting}

	AcceptorLine^.ExecuteList;

	AcceptorLine^.GetData(Model);

	dispose(AcceptorLine, done);

	{ask for category}
	if delspaceR(Model)<>'' then begin
		New(AcceptorLine, init(R, scPartCatgy));
		Desktop^.Insert(AcceptorLine);

		AcceptorLine^.ExecuteList;

		AcceptorLine^.GetData(Catgy);

		dispose(AcceptorLine, done);

		if delspaceR(Catgy)<>'' then begin

			{do list}
			Desktop^.GetExtent(R);
			Desktop^.Insert(New(PIndexedJimmyListWindow, init(R,
				ExpandSCode(scVehicleModel, Model)+' '+ExpandSCode(scPartCatgy, Catgy)+' Parts',
				New(PPartsListView, init(R, lsPartCatgy, fiPartCatgyIdx,
					Setlength(Model,3)+Setlength(Catgy,3))))));
		end;
	end;
end;



begin
	RegisterType(RPartItem);
	RegisterCreator(cmNewPartItem, CreatePartItem);

	RegisterType(RPartSupplier);
	RegisterCreator(cmNewPartSupplier, CreatePartSupplier);

	RegisterScodeType(scPartCatgy, 'PARTCTGY.SC', 'Part Categories', StdSCodeCreator);
	RegisterScodeType(scPartCode,  'PARTCODE.SC', 'Part Codes', StdSCodeCreator);
	RegisterScodeType(scPartMakers,  'PARTMAKR.SC', 'Part Makers', StdSCodeCreator);

	NewFileAdmin(fiPartNumIdx, 'Part Number Index',NewPartNumIndex);
	NewFileAdmin(fiPartCatgyIdx, 'Part Category Index',NewPartCatgyIndex);

	RegisterTask(DesktopTasks, cmStartPartNumList, @StartPartNumList);
	RegisterTask(DesktopTasks, cmStartPartCatgyList, @StartPartCatgyList);
	RegisterTask(DesktopTasks, cmFindPart, @FindPart);

	RegisterNewWithList(lsPartNum, '~P~arts', cmNewPartItem);
	RegisterNewWithList(lsPartCatgy, '~P~arts', cmNewPartItem);

	RegisterNewWithList(lsPartSuppliers, '~S~upplier', cmNewPartSupplier);

end.


