;---------------------------------------------------------------------
;    **   **   **  ***   ***   ****     **    ***  **  ****
;   ****  *** *** ** ** **     ** **   ****  **    ** **  **
;  **  ** ** * ** ** **  ***   *****  **  **  ***  ** **
;  ****** **   ** ** **    **  **  ** ******    ** ** **
;  **  ** **   ** ** ** *  **  **  ** **  ** *  ** ** **  **
;  **  ** **   **  ***   ***   *****  **  **  ***  **  ****
;---------------------------------------------------------------------
; AMOS Requester handler V1.3
; By François Lionet
; AMOS and AMOS Compiler (c) Europress Software 1991
; To be used with AMOS1.3 and over
;--------------------------------------------------------------------- 
; This file is public domain
;---------------------------------------------------------------------
; Please refer to the _Music.s file for more informations
;---------------------------------------------------------------------
*
ExtNb		equ	3-1
*
 		Include	"_Equ.s"
		RsSet	DataLong
		Include "_Pointe.s"
		Include	"_WEqu.s"
		Include "_CEqu.s"
		Include	"_LEqu.s"
*
Start		dc.l	C_Tk-C_Off
		dc.l	C_Lib-C_Tk
		dc.l	C_Title-C_Lib
		dc.l	C_End-C_Title
		dc.w	-1	
*
******************************************************************
* 		OFFSETS TO FUNCTIONS
C_Off           dc.w (L1-L0)/2,(L2-L1)/2,(L3-L2)/2,(L4-L3)/2
        	dc.w (L5-L4)/2,(L6-L5)/2,(L7-L6)/2,(L8-L7)/2
        	dc.w (L9-L8)/2,(L10-L9)/2,(L11-L10)/2

******************************************************************
* 	TOKEN TABLE + Addresses
C_Tk		dc.w 	1,0
		dc.b 	$80,-1
		dc.w	L_ReqOn,-1
		dc.b	"request o","n"+$80,"I",-1
		dc.w	L_ReqOf,-1
		dc.b	"request of","f"+$80,"I",-1
		dc.w	L_ReqWb,-1
		dc.b	"request w","b"+$80,"I",-1
		dc.w 	0

******************************************************************
C_Lib
******************************************************************
*		COLD START
L0	movem.l	a3-a6,-(sp)
	lea	ReqData(pc),a4
	move.l	a4,ExtAdr+ExtNb*16(a5)
	lea	Quit(pc),a0
	move.l	a0,ExtAdr+ExtNb*16+8(a5)
* Copy default palette	
	lea	DefEPa+8(a5),a0	
	lea	ReqPal+8(pc),a1
	moveq	#28-1,d0
CPal	move.w	(a0)+,(a1)+
	dbra	d0,CPal
* Branch the requester
	move.l	a5,Datas-ReqData(a4)
	lea	Request(pc),a0
	Rbsr	L_SetJump
	move.l	d0,ReqPrev-ReqData(a4)
	move.w	#-1,ReqFlag-ReqData(a4)	        * Default is AMOS request
* Return to caller
	movem.l	(sp)+,a3-a6
	moveq	#ExtNb,d0			* NO ERRORS
	rts

******* SCREEN RESET
Warm	rts

******* QUIT
Quit	move.l	ReqPrev(pc),a0
	Rbsr	L_SetJump
	rts

***********************************************************
*	AMOS REQUESTER
Request	movem.l	a0-a6/d0-d7,-(sp)
	lea	ReqData(pc),a6
	move.l	Datas-ReqData(a6),a5
	tst	ReqFlag-ReqData(a6)
	beq.s	ReqANo
	bmi.s	ReqAMOS

******* System requester
SyReq	EcCalD	AMOS_WB,-1		* Is AMOS here?
SyReq0	move.w	d1,ReqOld-ReqData(a6)
	beq.s	SyReq1
	EcCalD	AMOS_WB,0		* AMOS To BACK
SyReq1	movem.l	(sp),a0-a6/d0-d7
	move.l	ReqPrev(pc),a5
	jsr	(a5)
	lea	ReqData(pc),a6
	move.l	Datas-ReqData(a6),a5
	move.l	d0,ReqPos-ReqData(a6)
	move.w	ReqOld(pc),d1
	beq.s	SyReq2
	EcCalD	AMOS_WB,1		* AMOS To FRONT
SyReq2	bra	ReqXX
	
******* Always NO!
ReqANo	movem.l	(sp)+,a0-a6/d0-d7
	moveq	#0,d0
	rts

******* AMOS Normal requester
ReqAMOS
	tst.w	WB2.0(a5)		* WB2.0-> Normal requester!
	bne.s	SyReq
	EcCalD	AMOS_WB,-1		* Is AMOS here?
	tst.w	d1
	beq.s	SyReq0

******* Screen setup (boring!!!)
ReqAm0	SyCall	AMALFrz
	bsr	UnMix1

	move.w	#288,d0
	move.w	d2,d1
	lsr.w	#2,d1
	sub.w	d1,d0
	move.w	d0,ReqWX-ReqData(a6)	
	move.l	d2,d0
	lsr.w	#3,d0
	move.w	d0,ReqSX-ReqData(a6)
	add.w	#16,d3			* 2 lines in Y!!!
	move.w	d3,d0
	lsr.w	#1,d0
	move.w	d0,ReqSY-ReqData(a6)
	move.l	a1,ReqMain-ReqData(a6)
	move.l	a2,ReqPos-ReqData(a6)
	move.l	a3,ReqNeg-ReqData(a6)
* Open screen
	moveq	#2,d4
	move.l	#$8000,d5
	moveq	#4,d6
	moveq	#0,d7
	lea	ReqPal-ReqData(a6),a1
	EcCalD	Cree,EcReq
	bne	NoReq
	move.l	a0,ScAdr-ReqData(a6)
	SyCalD	ResZone,2
* Initialise background text
	WiCalA	Print,ReqBack-ReqData(a6)
	WiCalA	Centre,ReqTit-ReqData(a6)
* Print main text
	moveq	#0,d1
	moveq	#4,d2
	WiCall	Locate
	move.l	ReqMain-ReqData(a6),a4
MnText	move.l	12(a4),a1
	WiCall	Centre
	WiCalD	ChrOut,10
	move.l	16(a4),d0
	move.l	d0,a4
	bne.s	MnText
* Positive text (left)
	move.l	ReqPos-ReqData(a6),d0
	beq.s	NoPos
	move.l	d0,a0
	move.l	12(a0),d0
	beq.s	NoPos
	move.l	d0,ReqPos-ReqData(a6)
	moveq	#1,d0
	moveq	#"0",d1
	bsr	PrtZone
* Negative text (right)
NoPos	move.l	ReqNeg-ReqData(a6),d0
	beq.s	NoNeg
	move.l	d0,a0
	move.l	12(a0),d0
	beq.s	NoPos
	move.l	d0,ReqNeg-ReqData(a6)
	move.l	d0,a0
CptNeg	tst.b	(a0)+
	bne.s	CptNeg
	sub.l	d0,a0
	move.w	ReqSx-ReqData(a6),d0
	sub.w	a0,d0
	add.b	#48,d0
	move.b	d0,XTNeg-ReqData(a6)
	moveq	#2,d0
	moveq	#"0",d1
	bsr	PrtZone
* Screen appearance
NoNeg	move.l	ScAdr-ReqData(a6),a2
	move.w	ReqWX-ReqData(a6),EcAWX(a2)
	bset	#1,EcAW(a2)
	moveq	#8,d7
	moveq	#1,d6
	moveq	#ReqWY,d5
	add.w	ReqSY-ReqData(a6),d5
	bsr	AppCentre
	bsr	UnMix2
* State of disc drive
	SyCall	GetDisc
	move.w	d0,DOld-ReqData(a6)
	move.w	#-1,DAuto-ReqData(a6)

******* Test loop (fun!)
ReqLoop	SyCall	WaitVbl
* Automatic disc change
	SyCall	GetDisc
	cmp.w	DOld-ReqData(a6),d0
	beq.s	NoAuto
	move.w	d0,DOld-ReqData(a6)
	and.w	d0,DAuto-ReqData(a6)
	bne	ReqYes
* Keyboard
NoAuto	SyCall	Inkey
	cmp.w	#13,d1		* ASCII-> Return 
	beq.s	ReqYes	
	cmp.w	#27,d1		* ASCII-> ESC
	beq.s	ReqNo		
* Don't you think it is better than this wierd Amiga V and B?
* Sometime I ask myself what they were thinking when they chose such
* key combinations!
	swap	d1
	move.w	d1,d0		* Isolate AMIGA keys
	and.w	#%1100000000000000,d0
	beq.s	RqL0
	cmp.b	#$34,d1		* V
	beq.s	ReqYes
	cmp.b	#$35,d1		* B
	beq.s	ReqNo
* Mouse pointer
RqL0	SyCall	GetZone
	cmp.w	#EcReq,d1
	beq.s	RqL1
	moveq	#0,d1
RqL1:	swap 	d1
	cmp.w	d7,d1
	beq.s	RqL2
	move.w	d7,d0
	move.w	d1,d7
	moveq	#"0",d1
	bsr	UnMix1
	bsr	PrtZone
	bsr	UnMix2
RqL2:	move.w	d7,d0
	moveq	#"1",d1
	bsr	UnMix1
	bsr	PrtZone
	bsr	UnMix2
	tst.w	d7
	beq	ReqLoop
	SyCall	MouseKey
	tst.w	d1
	beq	ReqLoop
	cmp.w	#2,d7
	beq.s	ReqNo
ReqYes	moveq	#-1,d0
	bra.s	ReqGo
ReqNo	moveq	#0,d0

******* End of screen (well done!!!)
ReqGo	move.l	d0,-(sp)
	bsr	UnMix1
	move.l	ScAdr-ReqData(a6),a2
	moveq	#-8,d7
	move.w	EcTY(a2),d6
	lsr.w	#1,d6
	moveq	#ReqWY,d5
	add.w	ReqSY-ReqData(a6),d5
	bsr	AppCentre
	EcCalD	Del,EcReq
	bsr	UnMix2

******* Back to system!
ReqX	SyCall	AMALUFrz	
	move.l	(sp)+,ReqPos-ReqData(a6)	* Returns answer
* Normal exit
ReqXX	movem.l	(sp)+,a0-a6/d0-d7
	move.l	ReqPos(pc),d0
	rts
******* Can't open screen!!!
NoReq	clr.l	-(sp)
	bra.s	ReqX

******* Print a zone D0-> zone, D1-> inverse or not
PrtZone	subq.w	#1,d0
	bmi.s	PrtX
	bne.s	PrtNeg
* Print pos text
PrtPos	lea	TPos1-ReqData(a6),a1
	move.b	d1,5(a1)
	WiCall	Print
	move.l	ReqPos-ReqData(a6),a1
	WiCall	Print
	WiCalA	Print,TPos2-ReqData(a6)
	bra.s	PrtX
* Print neg text
PrtNeg	lea	TNeg1-ReqData(a6),a1
	move.b	d1,5(a1)
	WiCall	Print
	move.l	ReqNeg-ReqData(a6),a1
	WiCall	Print
	WiCalA	Print,TNeg2-ReqData(a6)
PrtX	rts

******* Screen appearance
AppCentre:
	move.w	d6,d4
	move.w	d6,EcAWTy(a2)
	add.w	d6,EcAWTy(a2)
	bset	#2,EcAWT(a2)
	move.w	EcTy(a2),d0
	lsr.w	#1,d0
	sub.w	d6,d0
	move.w	d0,EcAVY(a2)
	bset	#2,EcAV(a2)
	move.w	d5,EcAWy(a2)
	sub.w	d6,EcAWy(a2)
	bset	#2,EcAW(a2)
	movem.l	a2/d4-d7,-(sp)
	SyCall	WaitVBL
	EcCall	CopForce
	movem.l	(sp)+,a2/d4-d7
	add.w	d7,d6
	bpl.s	FsApp2
	clr.w	d6
FsApp2:	move.w	EcTy(a2),d0
	lsr.w	#1,d0
	cmp.w	d0,d6
	bcs.s	FsApp3
	move.w	d0,d6
FsApp3:	cmp.w	d4,d6
	bne.s	AppCentre
	rts

******* Prevent mixes between AMOS and the requester!
UnMix1	movem.l	d0-d7/a0-a6,-(sp)
	move.l	$4,a6
	jsr	Forbid(a6)
	EcCall	Current
	move.w	EcNumber(a0),d1
	lea	ReqOld(pc),a0
	move.w	d1,(a0)
	EcCalD	Active,EcReq
	EcCalD	First,EcReq
	movem.l	(sp)+,d0-d7/a0-a6
	rts
UnMix2	movem.l	d0-d7/a0-a6,-(sp)
	move.w	ReqOld(pc),d1
	EcCall	Active
	move.l	$4,a6
	jsr	Permit(a6)
	movem.l	(sp)+,d0-d7/a0-a6
	rts

;--------------------------------------------------------------------
*		DATA ZONE
ReqData		
*
ScAdr		dc.l 	0
Datas		dc.l 	0
ReqMain		dc.l 	0
ReqPos		dc.l 	0
ReqNeg		dc.l 	0
ReqPrev		dc.l	0
ReqWX		dc.w 	0
ReqWY		equ 	103
ReqSx		dc.w 	0
ReqSY		dc.w	0
ReqFlag		dc.w 	0
ReqOld		dc.w 	0
DOld		dc.w	0
DAuto		dc.w	0
WB20		dc.w	0

ReqPal		dc.w	$000,$46C,$FFF,$C41
		ds.w	28

* 		Background drawing
ReqBack		dc.b 27,"C0",27,"V0"
		dc.b 24,28,31,27,"E0",24,29,30,27,"E2"
		dc.b 27,"B3",24,31,7
		dc.b 24,28,31,27,"E0",29,29,31,27,"E2"
		dc.b 24,31
		dc.b 0
* 		Title
ReqTit		dc.b "System request",27,"B1",0
* 		Positive text
TPos1		dc.b 27,"B3",27,"I0",24,30,30,28,27,"E0",27,"Z0",0
TPos2		dc.b 27,"E2",27,"Z1",0
* 		Negative text
TNeg1		dc.b 27,"B3",27,"I0",24,30,30,27,"X"
XTNeg		dc.b "0",27,"E0",27,"Z0",0
TNeg2		dc.b 27,"E2",27,"Z2",0
		even
;--------------------------------------------------------------------

L1
L2
L3

***********************************************************
*		REQUEST WB
L_ReqWb		equ	4
L4	moveq	#1,d0
	Rbra	L_ROnOf
*********************************************************** 
*		REQUEST ON
L_ReqOn		equ	5
L5	moveq	#-1,d0
	Rbra	L_ROnOf
*********************************************************** 
*		REQUEST OFF
L_ReqOf		equ	6
L6	moveq	#0,d0
	Rbra	L_ROnOf
*
L_ROnOf		equ	7
L7	move.l	ExtAdr+ExtNb*16(a5),a0
	move.w	d0,ReqFlag-ReqData(a0)
	rts

********************************************************** 
*	Change the library jump
L_SetJump	equ	8
L8	movem.l	a1/a6,-(sp)
	move.l	a0,d0
	move.l	T_IntBase(a5),a1
	lea	-$15c,a0
	move.w	WB2.0(a5),d1
	beq.s	SetJ1
	lea	-$1d4-(20*6),a0
SetJ1	move.l	$4,a6
	jsr	SetFunction(a6)
	movem.l	(sp)+,a1/a6
	rts

**********************************************************
*	Even if you do not have error messages, you MUST
*	leave TWO routines empty at the end...
L9
L10
* Two routines means three borders!
L11

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

* 		Welcome message
C_Title		dc.b 	31,"Requester V 1.3",0
*		End of extension
C_End		dc.w	0

	even