{*************************************************************************
 ***																																   ***
 ***                     TASK REGISTRATION                             ***
 ***																																   ***
 *************************************************************************}
{$I compflgs}

{Designed for the "flexibility" side of Kameleon - it allows the
programmer to include modules at compile time, which at runtime will
register themselves as tasks on the various task lists.

This allows the modularity of Kameleon to work by having each task
register it's objects and procedures with the Kameleon application.  It is
also possible to register tasks with the lists, in a way making dynamic objects.

Thus you have:

1) Application Tasks, registered with the desktop, consisting of
a command and the procedure that is run with when that command is
sent to the desktop.  The generation of those commands is usually done through
the application main menu, see startup2 (the startup2 module does not act
strictly in the modularity sense, but it makes life much easier.  It may be
possible to change this in the future...)

2) Creator functions, used to register object constructors.  Ideally, this
should become a simple extension of REgisterType, if I can find a way of
adding a pointer to the .init constructor and a generalised way of accessing
it, but at the moment they tie a command with a function that returns a pointer
to the newly constructed object

3) List Tasks, registered with in the lsxxx list.  These are tied, via an
lstype (for the list type) and command to procedures that take the list
itself as a parameter.  This allows one module to tie extra tasks to other
modules, eg Rongai workshops ties two new reports to the diary for listing
drivers in and out

{Each list consists of a pointer to the first taskitem, which has a Next
pointer to the next one, and so on, similar to the way the menus work.  There
are two controlling procedures - registertask, which adds a given task to
the end, and RunTask, which is given the command given in a TEvent, and it
runs that task, in the form of a function of type TaskProcedure, which takes
a parameter in the form of a general pointer, and returns a general pointer.
It is thus up to whatever uses RunTask to set up and/or use these pointers}

unit Tasks;

INTERFACE

uses
{$IFDEF WINDOWS}
	win, {menu method extensions, etc...}
	{$IFDEF fixit}	wincrt, {$ENDIF} {For initialising message}
	WinTypes,	{windows}
{$ELSE}
	{text mode - turbo vision interface}
	tui,{} menus, {menus}
{$ENDIF}
	chains;

{var
	TaskCOmmand : word; {current command being processed in runtask}
											{so that task procedures can look up what command
											generated them}

type
	{Some tasks are simple procedure types, some require parameters, etc, so
	provide:}
	TTaskProc = procedure;
	TRangeTaskProc = procedure(Command : word);
	TCreatorFunc = function(Parameters : pointer) : pointer;
	{$IFDEF Windows}
		TListTaskProc = procedure(List : THandle);
	{$ELSE}
		TListTaskProc = procedure(List : pointer); {for list tasks}
	{$ENDIF}

	{a straight chain/link tying the tasks to a procedure, whether a TaskProc
	or a ListTaskProc}
	PTaskItem = ^TTaskItem;
	TTaskItem = object(TChainLink)
		Command : word;              {The command used to start the task}
		TaskProc: pointer;    			{Procedure task to be run}
		constructor Init(ACommand : word; ATaskProc : pointer);
		function Valid(ForCommand : word) : boolean; virtual;
		procedure DoTask(ForCommand : word); virtual;
	end;

	{takes a range of commands, and passes that command as a parameter to
	the taskproc}
	PRangeTaskItem = ^TRangeTaskItem;
	TRangeTaskItem = object(TTaskItem)
		CommandEndRange : word;    {The command used to start the task}
		constructor Init(ACommandRangeStart,ACommandRangeEnd : word; ATaskProc : pointer);
		function Valid(ForCommand : word) : boolean; virtual;
		procedure DoTask(ForCommand : word); virtual;
	end;

	PCreatorItem = ^TCreatorItem;
	TCreatorItem = object(TChainLink)
		Command : word;              {The command used to start the task}
		Creator : TCreatorFunc;    			{Procedure task to be run}
		constructor Init(ACommand : word; ACreator : TCreatorFunc);
	end;

	{complete registration - the list it is with, the menu item that will
	generate the command, and the task to be run}
	PCommandListItem = ^TCommandListItem;
	TCommandListItem = object(TChainLink)
		lsType : word;
		BarTitle : PChar;
		MenuItem : PMenuItem;
		TaskProc : pointer;
		constructor Init(AlsType : word; ABarTitle : PChar; AMenuItem : PMenuItem; ATaskProc : pointer);
	end;

{direct registration into the given command/task list}
procedure RegisterTask(var TaskList : PTaskItem; ACommand : word; ATaskProc : pointer);
procedure RegisterRangeTask(var TaskList : PTaskItem; ACommandStart,ACommandEnd : word; ATaskProc : pointer);
procedure ReplaceTask(var TaskList : PTaskItem; ACommand : word; ATaskProc : pointer);

{there is only one global creator tasklist}
procedure RegisterCreator(ACommand : word; ACreator : TCreatorFunc); {adds to Creators var below}

{Registering commands/menu items with lists}
procedure RegisterWithList(const AlsType : word; const ABarTitle : PChar; const AMenuItem : PMenuItem;
{shortcut to above}																																				const ATaskProc : TListTaskProc);
procedure RegisterNewWithList(const lsType : word; const Name : PChar; const Command : word);  {shorthand way of doing above}

{for registering RTypes}
{procedure RegisterWithStreams(const RType : TStreamRec);
procedure RegisterWithStreamsEnd(const RType : TStreamRec);


{---- Running Tasks --------}
function RunTask(TaskList : PTaskItem; Command : word) : boolean; {returns true if it existed and was run}
{$IFDEF Windows}
function RunListTask(TaskList : PTaskItem; COmmand : word; List : THAndle) : boolean;
{$ELSE}
function RunListTask(TaskList : PTaskItem; COmmand : word; List : pointer) : boolean;
{$ENDIF}
procedure RunAllTasks(TaskList : PTaskItem); {run all tasks in chain - eg shutdown, lowmemory, etc}

function Create(Command : word; Parameters : pointer) : pointer; {returns pointer to created object}
function CreatorExists(Command : word) : boolean;

{---- Building list's menu from list's tasklist -----}
{$IFDEF WIndows}
procedure AddCommandsToListMenu(const lsType : word; var Menu : hMenu; var ListTasks : PTaskItem);
procedure AddCommandsToListNewMenu(const lsType : word; var Menu : hMenu);
{$ELSE}
procedure AddCommandsToListMenu(const lsType : word; var Menu : PMenu; var ListTasks : PTaskItem);
procedure AddCommandsToListNewMenu(const lsType : word; var Menu : PMenu);
{$ENDIF}
function IsMenuForlsType(const lsType : word) : boolean;

{define global kind of tasks for use anywhere}
var	DesktopTasks : PTaskItem;
		StartUpTasks : PTaskItem; {tasks to be run after initial startup - ie after config read, status sorted out, etc}
		ShutDownTasks :PTaskItem; {and tasks to be run when system is closed}
		LowMemoryTasks : PTaskItem; {to be run when low on memory}
		CommandMenuList : PCommandListItem; {commands available for each kind of list}
		IdleTasks : PTaskItem;


IMPLEMENTATION

uses
	strings, {strpas,etc}
	help, {hcnocontext}
	global, {kbnone}
	minilib; {deltilde}

{****************************************************
 ***              TASK CHAIN/ITEMS                ***
 ****************************************************}

{======= PROCEDURE TASKS ============}

constructor TTaskItem.Init;
begin
	inherited Init;
	Command := ACommand;
	TaskProc := ATaskProc;
end;

function TTaskItem.Valid;
begin
	Valid := Command = ForCommand;
end;

procedure TTaskItem.DoTask;
begin
	TTaskProc(TaskProc);
end;

constructor TRangeTaskItem.Init;
begin
	inherited Init(ACommandRangeStart, ATaskProc);
	CommandEndRange := ACommandRangeEnd;
end;

function TRangeTaskItem.Valid;
begin
	Valid := (ForCommand>=Command) and (ForCommand<=CommandEndRange);
end;

procedure TRangeTaskItem.DoTask;
begin
	TRangeTaskProc(TaskProc)(ForCommand);
end;

{======= CREATOR TASKS ===============}
constructor TCreatorItem.Init;
begin
	inherited Init;
	Command := ACommand;
	Creator := ACreator;
end;

{======== LIST TASKS =================}
constructor TCommandListItem.Init;
begin
	inherited Init;
	lsType := AlsType;
	BarTitle := ABarTitle;
	MenuItem := AMenuItem;
	TaskProc := ATaskProc;
end;


{*********************************
 ***     TASK LIST MANAGEMENT  ***
 *********************************}
{Given a command, see if the procedure exists}
function GetTask(const TaskList : PTaskItem; const Command : word) : PTaskItem;
var WorkTask : PTaskItem;
begin
	{look down chain for task}
	WorkTask := TaskList;
	while (WorkTask<>nil) and (not WorkTask^.Valid(Command)) do WorkTask := PTaskItem(WorkTask^.Next);
	GetTask := WorkTask;
end;


procedure RegisterTask;
var WorkTask : PTaskItem;

begin
	New(WorkTask, init(ACommand, ATaskProc));
	{insert at beginning}
	WorkTask^.Next := TaskList;
	TaskList := WorkTask;
end;

procedure RegisterRangeTask;
var WorkTask : PRangeTaskItem;

begin
	New(WorkTask, init(ACommandStart, ACommandEnd, ATaskProc));
	{insert at beginning}
	WorkTask^.Next := TaskList;
	TaskList := WorkTask;
end;


{Replaces task already in list, or adds if not}
procedure ReplaceTask;
var WorkTask : PTaskItem;

begin
	WorkTask := GetTask(TaskList, ACommand);
	if WorkTask = nil then
		RegisterTask(TaskList, ACommand, ATaskProc)
	else
		WorkTask^.TaskProc := ATaskProc;
end;

{Given a command, run the procedure}
function RunTask;
var WorkTask : PTaskItem;
begin
	WorkTask := GetTask(TaskList, Command);
	if WorkTask<>nil then begin
		WorkTask^.DoTask(Command);
		RunTask := True;
	end else
		RunTask := False;
end;

{as above, but for list tasks which need a parameter of the list itself}
function RunListTask;
var WorkTask : PTaskItem;
begin
	WorkTask := GetTask(TaskList, Command);

	{Carry out task}
	if WorkTask<>nil then begin
{		TaskCommand := Command;{}
		TListTaskProc(WorkTask^.TaskProc)(List);
		RunListTask := True;
	end else
		RunListTask := False;
end;

{Run all tasks in chain}
{Since order can be important, it runs in "command" order - for shutdown
tasks etc don't bother using cmxxx constants, (??) just give a value. eg
signoff in kusers needs to be run before shutting down scodes, files, etc}
{runs in order of lowest TaskList{}
procedure RunAllTasks;
var WorkTask : PTaskItem;
		Currentcm, Nextcm : word;
begin
	Currentcm := 0; Nextcm := 0;
	while Nextcm<>9999 do begin
		CUrrentcm := Nextcm;
		Nextcm := 9999;
		WorkTask := TaskList;
		while WorkTask<>nil do begin {do all currentcm's and set nextcm}
			if WorkTask^.Valid(Currentcm) then begin
				{run task}
{				TaskCommand := Currentcm;{}
				WorkTask^.DoTask(Currentcm);
			end;
			if (WorkTask^.Command>Currentcm) and (WorkTask^.Command<Nextcm) then Nextcm := WorkTask^.Command;
			WorkTask := PTaskItem(WorkTask^.Next);
		end;
	end;
end;

{************************************
 ***     MODIFIED REGISTERTYPE    ***
 ************************************}
{This records the last type registered, so that
we can follow the chain at any pointer, and, for example,
add TStreamREcs to the far end for special update stuff}

{should be able to do this with objects StreamTypes word,
but I'm not sure how..

type PStreamRec = ^TStreamRec;

const LastRType : PStreamRec = nil;

procedure RegisterWithStreams;
begin
	LastRType := @RType;
	RegisterType(RType);
end;

procedure RegisterWithStreamsEnd;
var Work : PStreamRec;
begin
	Work := LastRType;
	if Work = nil then
		RegisterWithStreams(RType)
	else begin
		while Work^.Next<>nil do
			Work := Work^.Next

		Work^.Next := @Rtype;
	end;
end;





{************************************
 ***     CREATOR LIST MANAGEMENT  ***
 ************************************}
{=== GLOBAL CREATOR LIST =========}
var GlobalCreators : pointer;

{Given a command, see if the procedure exists}
function GetCreator(const Command : word) : PCreatorItem;
var WorkTask : PCreatorItem;
begin
	{look down chain for task}
	WorkTask := PCreatorItem(GlobalCreators);
	while (WorkTask<>nil) and (WorkTask^.Command<>Command) do WorkTask := PCreatorItem(WorkTask^.Next);
	GetCreator := WorkTask;
end;


procedure RegisterCreator;
var WorkTask : PCreatorItem;
begin
	New(WorkTask, init(ACOmmand, ACreator));
	WorkTask^.Next := PCreatorItem(GlobalCreators);
	GlobalCreators := WorkTask;
end;

{Given a command, run the procedure}
function Create;
var WorkTask : PCreatorItem;
begin
	WorkTask := GetCreator(Command);
	if WorkTask<>nil then
		Create := WorkTask^.Creator(Parameters)
	else
		Create := nil;
end;

function CreatorExists;
begin
	CreatorExists := GetCreator(Command)<>nil;
end;

{************************************
 *** COMMAND/MENU LIST MANAGEMENT  ***
 ************************************}
procedure RegisterWithList;
var Work : PCommandListItem;
begin
	New(Work, init(AlsType, ABarTitle, AMenuItem, @ATaskProc));
	Work^.Next := CommandMenuList;
	COmmandMenuList := Work;
end;

procedure RegisterNewWithList; {shorthand way of adding standard new item}
begin
	RegisterWithList(lsType, '~N~ew', NewItem(StrPas(Name), '', kbNone, Command, hcNoContext, nil),nil);
end;

{$IFDEF Windows}
procedure AddCommandsToListMenu;
{$ELSE}
procedure AddCommandsToListMenu;
{$ENDIF}
var Work : PCommandListItem;
		MenuItem : PMenuItem;

begin
	Work := CommandMenuList;

	while Work<>nil do begin
		if Work^.lsType=lsType then begin

			{add to menu}
			if StrLen(Work^.BarTitle) = 0 then
				AddItemEnd(Menu, CopyItem(Work^.MenuItem))
			else
				if (Deltildes(strpas(Work^.BarTitle))='New') and (lsType<>lsDesktop) then
					AddItemSubSubMenu(Menu, '~E~dit', '~N~ew', CopyItem(Work^.MenuItem))
				else
					AddItemSubMenu(Menu, strPas(Work^.BarTitle), CopyItem(Work^.MenuItem));{}

			{add to task list}
			if Work^.TaskProc<>nil then RegisterTask(ListTasks, Work^.MenuItem^.COmmand, Work^.TaskProc);{}
		end;

		Work := PCommandListItem(Work^.Next);
	end;
end;

{Extracts just new items}
{$IFDEF WIndows}
procedure AddCommandsToListNewMenu(const lsType : word; var Menu : hMenu);
{$ELSE}
procedure AddCommandsToListNewMenu(const lsType : word; var Menu : PMenu);
{$ENDIF}
var Work : PCommandListItem;
begin
	Work := CommandMenuList;

	while Work<>nil do begin
		if (Work^.lsType=lsType) and (DelTildes(StrPas(Work^.BarTitle))='New') then
			AddItemEnd(Menu, CopyItem(Work^.MenuItem));

		Work := PCommandListItem(Work^.Next);
	end;
end;

function IsMenuForlsType;
var Work : PCommandListItem;

begin
	Work := CommandMenuList;

	while (Work<>nil) and (Work^.lsType<>lsType) do
		Work := PCommandListItem(Work^.Next);

	IsMenuForlsType := (Work<>nil) and (Work^.lsType=lsType);
end;




begin
{$IFDEF fixit}	writeln('Initialising tasks unit');{$ENDIF}

	StartUpTasks := nil; {tasks to be run after initial startup - ie after config read, status sorted out, etc}
	ShutDownTasks := nil;

	DesktopTasks := nil;{}
	GlobalCreators := nil; {clear to begin with}
	CommandMenuList := nil;
	LowMemoryTasks :=nil;

	IdleTasks := nil;
{	TaskCommand := 0;{}
end.
