section	Enquire,CODE
	IDNT	QUERY

**	Enquire
**		for getting a three option responce from the user
**
**		Copyright ©1990 DigiSoft
**
**	Permission is granted to purchasers of Macro68 to modify this source
**	file.  Permission is further granted to distribute the source code that
**	they have modified subject to the following conditions:
**	1.  That the original, unaltered, source is included with the
**	    distribution.
**	2.  That no charge is made for the distribution, other than the cost of
**	    media.                    (Distribution via Fred Fish is permitted)
**	3.  That my copyright notice remains as part of this and any other
**	    file adapted from this file.
**                                               Paul Coward
**                                                         DigiSoft
**
**	Tabstops : 8
**	Assemble with Macro68


**	20-07-90	** written


**  FUNCTION & USAGE
**
**	Enquire TO file PROMPT "text" OK okReply WARN warnReply FAIL failReply WORD
**
**	Reads characters typed to the console and checks result.  If result is ok
**	then the keyword responce is output to the file in the ENV: directory.
**
**  KEYWORDS
**
**	TO	filename to direct result to (in env:)
**
**	PROMPT	prompt text for the user
**
**	OK	text to indicate an OK reply (default = Yes)
**
**	WARN	text to indicate a WARN reply (default = No)
**
**	FAIL	text to indicate an FAIL reply (default = Abort)
**
**  SWITCHES
**
**	word	match entire word
**
***********************************************************



		OBJFILE		"ram:Enquire"
	;	ERRFILE		"ram:Enquire.bugs"

	;	PALL
	;	HALL
	;	LFCOND
		EXEOBJ
	;	LIST
	;	LISTSYMS
	;	ADDSYM
	;	LISTFILE	"ram:Enquire.lst"
	;	CREFFILE	"ram:Enquire.cref"
	;	EQUFILE		"ram:Enquire.equ"
	;	REALTIME
		STRICT


	ifnd	EXEC_TYPES_I
_AbsExecBase		equ	4
_LVOAlert		equ	-108	;exec
_LVOCloseLibrary	equ	-414	;exec
_LVOOpenLibrary		equ	-552	;exec
AT_Recovery		equ	$00000000
AG_OpenLib		equ	$00030000
MODE_NEWFILE		equ	1006
RETURN_OK		equ	0
RETURN_ERROR		equ	10
	endc


_LVOdsAllocCPremember	equ	-30
_LVOdsAllocScratch	equ	-42
_LVOdsDosClose		equ	-414
_LVOdsDosOpen		equ	-408
_LVOdsDosWrite		equ	-864
_LVOdsParse		equ	-216
_LVOdsPuts		equ	-648
_LVOdsReadLine		equ	-654
_LVOdsStrLen		equ	-288
_LVOdsToLower		equ	-840


	ifnd	AO_DSSLib
AO_DSSLib		equ	$00008099	;alert number id support library can't be opened
Lf			equ	$0a
csd_Output		equ	20*4
	endc


		setso	84
csd_RememberKey	so.l	1
csd_FileHandel	so.l	1
csd_Args	so.b	8
csd_QueryBuffer	so.b	20
csd_SIZEOF	soval


Release			equ	'1.0 '
VerNo			equ	'0.02'

*************************
*	COLD ENTRY	*
*************************


START:		moveq		#0,d3
		move.l		a0,d6
		move.l		d0,d7
		movea.l		(_AbsExecBase).w,a6	;establish exec for calls

	; --- open the support library

		moveq		#2,d0			;version #
		lea	 	(supportLibName,pc),a1	;point to liberary name
		jsr		(_LVOOpenLibrary,a6)	;exec
		tst.l		d0
		bne.b		1$
		move.l		#AT_Recovery!AG_OpenLib!AO_DSSLib,d7
		jsr		(_LVOAlert,a6)
		bra		fail

	; --- initialize the scratch area

1$		movea.l		d0,a6
		move.l		#csd_SIZEOF,d0
		moveq		#33,d1
		moveq		#0,d2
		jsr		(_LVOdsAllocScratch,a6)
		bne		fail

	; --- initialize the argument pointers

		movem.l		d6-d7,(csd_Args,a5)	;& a_Length(A0)

	; --- parse args

		lea		(csd_RememberKey,a5),a0
		move.l		#256,d0
		jsr		(_LVOdsAllocCPremember,a6)
		move.l		d0,(ArgPointers).l
		beq		fail

		lea		(csd_Args,a5),a0
		lea		(additionalHelp,pc),a1
		lea		(ArgPointers+4,pc),a2
		lea		(CmdTemplate,pc),a3
		jsr		(_LVOdsParse,a6)
		bpl.b		configure
		movea.l		(ArgPointers,pc),a1
		jsr		(_LVOdsPuts,a6)
		bra		fail

	; --- do it

configure:	move.l		(filename,pc),d0
		beq		fail
		movea.l		d0,a0
		lea		(file,pc),a1
..		move.b		(a0)+,(a1)+
		bne.b		..
		move.l		#target,d1
		move.l		#MODE_NEWFILE,d2
		jsr		(_LVOdsDosOpen,a6)
		beq		fail
		move.l		d0,(csd_FileHandel,a5)

		movea.l		(promptStr,pc),a0
		jsr		(_LVOdsStrLen,a6)
		move.l		d0,d3
		move.l		a0,d2
		move.l		(csd_Output,a5),d1
		jsr		(_LVOdsDosWrite,a6)

		moveq		#0,d0
		movea.l		(okStr,pc),a2
		cmpa.l		d0,a2
		bne.b		1$
		lea		(defaultOk,pc),a2
		move.l		a2,(okStr)
1$		movea.l		(warnStr,pc),a3
		cmpa.l		d0,a3
		bne.b		2$
		lea		(defaultWarn,pc),a3
		move.l		a3,(warnStr)
2$		movea.l		(failStr,pc),a4
		cmpa.l		d0,a4
		bne.b		3$
		lea		(defaultFail,pc),a4
		move.l		a4,(failStr)

3$		move.b		(a2)+,d0
		jsr		(_LVOdsToLower,a6)
		move.l		d0,d7			;first char of ok
		move.b		(a3)+,d0
		jsr		(_LVOdsToLower,a6)
		move.l		d0,d6			;first char of warn
		move.b		(a4)+,d0
		jsr		(_LVOdsToLower,a6)
		move.l		d0,d5			;first char of fail

		moveq		#20-1,d2
		lea		(csd_QueryBuffer,a5),a0
		jsr		(_LVOdsReadLine,a6)
		beq		fail
		move.b		(a0)+,d0
		jsr		(_LVOdsToLower,a6)
		cmp.b		d0,d7
		beq.b		compareOk
possibleWarn:	cmp.b		d0,d6
		beq.b		compareWarn
		movea.l		(failStr,pc),a0
		bra.b		writeOutput



compareOk:	tst.l		(wordFlg)		;first char match ok ?
		beq.b		ok			;yes
.compareNext:	move.b		(a2)+,d0
		beq.b		.testEnd
		jsr		(_LVOdsToLower,a6)
		move.b		d0,d7
		move.b		(a0)+,d0
		beq.b		.notMatched
		jsr		(_LVOdsToLower,a6)
		cmp.b		d0,d7
		beq.b		.compareNext
.notMatched:	lea		(csd_QueryBuffer,a5),a0
		move.b		(a0)+,d0
		jsr		(_LVOdsToLower,a6)
		bra.b		possibleWarn
.testEnd:	tst.b		(a0)
		bne.b		.notMatched
ok:		movea.l		(okStr,pc),a0
		bra.b		writeOutput



compareWarn:	tst.l		(wordFlg)		;first char match ok ?
		beq.b		warn			;yes
.compareNext:	move.b		(a3)+,d0
		beq.b		.testEnd
		jsr		(_LVOdsToLower,a6)
		move.b		d0,d7
		move.b		(a0)+,d0
		beq.b		fail
		jsr		(_LVOdsToLower,a6)
		cmp.b		d0,d7
		beq.b		.compareNext
		bra.b		fail
.testEnd:	tst.b		(a0)
		bne.b		fail
warn:		movea.l		(warnStr,pc),a0

writeOutput:	jsr		(_LVOdsStrLen,a6)
		move.l		d0,d3
		move.l		a0,d2
		move.l		(csd_FileHandel,a5),d1
		jsr		(_LVOdsDosWrite,a6)
		sne		d2
		jsr		(_LVOdsDosClose,a6)
		clr.l		(csd_FileHandel,a5)
		tst.b		d2
		bne.b		fail
		movea.l		a6,a1
		movea.l		(_AbsExecBase).w,a6
		jsr		(_LVOCloseLibrary,a6)
		moveq		#RETURN_OK,d0
		rts


fail:		move.l		(csd_FileHandel,a5),d1
		beq.b		1$
		jsr		(_LVOdsDosClose,a6)
1$		movea.l		a6,a1
		movea.l		(_AbsExecBase).w,a6
		jsr		(_LVOCloseLibrary,a6)
		moveq		#RETURN_ERROR,d0		;fail by default
		rts


***************************************
***************************************
***************************************


ArgPointers:	dl	0
filename:	dl	0		;pointer to filename
promptStr:	dl	0		;pointer to text string
okStr:		dl	0		;pointer to text string
warnStr:	dl	0		;pointer to text string
failStr:	dl	0		;pointer to text string
wordFlg:	dl	0		;NE to match entire word


CmdTemplate:
	db	'TO/K/A,PROMPT/K,OK/K,WARN/K,FAIL/K,WORD/S',0


additionalHelp:
	db	'USAGE:',Lf
	db	'Enquire TO filename PROMPT "text" [OK text] [WARN text] [FAIL text] [WORD]'


***************************************
***************************************
***************************************


supportLibName:
	db	'digisoftSupport.library',0


defaultOk:
	cstr	'yes'
defaultWarn:
	cstr	'no'
defaultFail:
	cstr	'abort'

target:	db	'env:'
file:	dcb.b	32,0


*******************************************************************************

	END