(*	FileRequest.pas
 *		An example program which shows how to use the ASL and ARP file
 *		requesters from a HighSpeed Pascal program.  It also illustrates
 *		some methods of string conversion, handling of path names, the
 *		XASSEMBLER keyword, use of 'tags' from Pascal and a way of
 *		implementing function calls via pointers.
 *
 *		Written by Keith Wilson, HiSoft.
 *)

program FileRequest;
{ ARP.unit and some 2.0 units are required to compile this }
{ so you will have to set up your Units Path accordingly }
uses Amiga, AmigaDOS, ARP, ASL, Exec, Intuition, Utility;


const
{ required library versions }
	ASL_REV = 36;
	ARP_REV = 33;


(*	SplitName extracts the directory and filename components of an
 *	AmigaDOS pathname.  It is similar to FSplit in the DOS unit but
 *	handles up to 255 character names.
 *)

procedure SplitName (path: string; var dir, name: string);
var i: integer;
begin
	i := Length(path);
	repeat
		dec(i)
	until (i = 0) or (path[i] = ':') or (path[i] = '/');
	name := Copy(path, i+1, Length(path)-i);

	if dir[i] = '/' then dec(i);	{ don't give a trailing slash }
	dir := Copy(path, 1, i)
end;


(*	You should use this routine to glue a directory and filename back
 *	together.  It automatically adds a slash separator if necessary.
 *)

procedure AddName (var dir: string; name: string);
var c: char;
begin
	c := dir[Length(dir)];
	if (c <> #0) and (c <> ':') and (c <> '/') then dir := dir + '/';
	dir := dir + name;
end;


(*	This function turns any Pascal string into a C string by adding
 *	a null to the end and returning a pointer to the first character.
 *	Note that the string can still be used as a Pascal string.
 *)

function NullTerm (var s: string): STRPTR;
var i: integer;
begin
	i := Length(s) + 1;
	if i > 255 then
	begin
		Delete(s, 255, 1);		{ ensure there is a spare byte }
		Dec(i)
	end;
	s[i]	 := #0;
	NullTerm := @s[1]
end;


(*	To make a Pascal string from a C string which starts at s[1], we
 *	fool the Pos function into searching the whole string for a null
 *	byte then place the string length in s[0].
 *)

procedure MakeString (var s: string);
begin
	s[0] := #255;
	s[0] := Chr(Pos(#0, s) - 1)		{ gives -1 (255) if not found }
end;


(*	Here is an assembly language implementation of the C strncpy.
 *	It differs from the standard by not padding unused destination bytes.
 *	Note that when all bytes are used, the string does not get null-
 *	terminated.
 *
 *	The XASSEMBLER keyword means that no LINK and UNLK instructions are
 *	generated although this does mean that we have to use stack offsets
 *	rather than names for accessing the parameters.
 *)

function strncpy (dest, source: pointer; n: integer): STRPTR; xassembler;
asm
	move.w	4(sp),d0			{ D0 = max }
	movem.l	6(sp),a0-a1			{ A0 = source, A1 = dest }
	move.l	a1,14(sp)			{ return dest for convenience }
	bra		@2					{ so we don't do one too many }
@1:
	move.b	(a0)+,(a1)+			{ copy characters }
@2:	dbeq	d0,@1				{ until reached null or maximum }
end;


(*	This function produces an ASL file requester.  Note that the supplied
 *	dir and name string buffers must be 255 characters long.
 *
 *	Like many Release 2 libraries, ASL uses 'tags'.  These are arrays
 *	tTagItem records (see Utility.pas), each containing an identifying
 *	tag value and some associated data.  TAG_END terminates the list.
 *	C can pass taglists in function calls but Pascal has to use an array
 *	although you can use pairs of long integers rather than tTagItems.
 *)

function ASLRequest (win: pWindow; title, dir, name: STRPTR): boolean;
var fr: ASL.pFileRequester; arg: array [0..8] of long; junk: STRPTR;
begin
	ASLRequest := false;
	arg[0] := ASL_Window;	arg[1] := long(win);
	arg[2] := ASL_Hail;		arg[3] := long(title);
	arg[4] := ASL_Dir;		arg[5] := long(dir);
	arg[6] := ASL_File;		arg[7] := long(name);
	arg[8] := TAG_END;

	fr := AllocASLRequest(ASL_FileRequest, @arg);
	if fr <> NIL then
	begin
		ASLRequest := RequestFile(fr);
		with fr^ do begin
			junk := strncpy(name, rf_File, 255);
			junk := strncpy(dir, rf_Dir, 255)
		end;
		FreeASLRequest(fr)
	end
end;


(*	The ARP version is simple by comparison!
 *)

function ARPRequest (win: pWindow; title, dir, name: STRPTR): boolean;
var fr: ARP.tFileRequester;
begin
	FillChar(fr, sizeof(fr), 0);
	with fr do
	begin
		fr_Window	:= win;
		fr_Hail		:= title;
		fr_Dir		:= dir;
		fr_File		:= name
	end;
	ARPRequest := ARP.FileRequest(@fr) <> NIL
end;


(*	Although HighSpeed Pascal does not support procedures as parameters,
 *	a little bit of assembly code magic does the job nicely.  This dummy
 *	function takes the same parameters as the functions we are calling
 *	followed by the function to call.  This is popped off the stack and
 *	jumped to, leaving the correct parameters for our function.
 *)

function CallRequest (win: pWindow;
		title, dir, name: STRPTR; func: pointer): boolean; inline
	$205F,		{ move.l (sp)+,a0	}
	$4E90;		{ jsr (a0)			}


(*	The main file requester function.  It first looks for the ASL library
 *	and if this is not found, the ARP library.  This means that programs
 *	using it will work under 2.0 and 1.3.  Adding support for other file
 *	requesters is made simple by the use of a function pointer.
 *)

function FRequest(win: pWindow;
		title: string; var selection: string): boolean;
var dir, name: string; lib: pLibrary; func: Pointer;
begin
	FRequest := false;
	lib := OpenLibrary('asl.library', ASL_REV);
	if lib <> NIL then
	begin
		ASLBase	:= lib;
		func	:= @ASLRequest
	end
	else
	begin
		lib		:= OpenLibrary('arp.library', ARP_REV);
		ArpBase	:= pArpBase(lib);
		func	:= @ARPRequest
	end;

	if lib <> NIL then
	begin
		SplitName(selection, dir, name);
		if CallRequest(win, NullTerm(title),
				NullTerm(dir), NullTerm(name), func) then
		begin
			MakeString(dir);
			MakeString(name);
			AddName(dir, name);
			selection	:= dir;
			FRequest	:= true
		end;
		CloseLibrary(lib)
	end
end;


(* And just to prove that it really works, here's a sample program! *)
var name: string;
begin
	name := '';
	if FRequest(NIL, 'HighSpeed Pascal Requester', name) then
		WriteLn(name, ' selected')
	else
		WriteLn('Cancelled');
	Delay(100)
end.