*	PlayAY Debugger, (C) 1994 Patrik Rak - Raxoft

*	WARNING: This program has not been optimized... So do not try to learn
;	how to "code" from this source... On the other hand, the GUI methods
;	presented here can help you...

;	Compile, save as binary from b to e and load as MODULE (not player!)
;	to your DT2. Of course, PlayAY must be running...

*	1.0 - 12.9.1994
;	Initial release. Env stuff not implemented yet.

DEBUG_VERSION	EQU	0

	incdir	Include40/
	include	libraries/gadtools.i
	include	exec/exec_lib.i
	include	dos/dos_lib.i
	include	dos/dos.i
	include	dos/dostags.i
	include	intuition/intuition_lib.i
	include	libraries/gadtools_lib.i
	include	misc/AYPlayer.i
	include	misc/mine.i
	incdir	''
b

;	nop			;Bug in asmone workaround...
	IFNE	DEBUG_VERSION
	bsr	Relocate
	bra.w	EntryPoint
	ENDC

	AYMODHEADER	TEST,0,0
	dc.w	player-8-*	;This "module" contains internal "AY player"
	dc.w	creator-*
	dc.w	misc-*
	dc.b	1-1		;how many songs
	dc.b	0		;which should start first
	dc.w	songdata-*

songdata	dc.w	name-*
	;dc.w	0	;we can ommit this - no song to be played really...

player	;ds.b	8	;we omit these too
	dc.l	AYM_TEST
	dc.b	1,0
	dc.b	PLAYAY_RELEASE_VERSION

	dc.b	0	;transpose
AYbase	ds.l	1
AYass	ds.l	1
AYfreq	ds.l	1
	dc.w	initplayer-*
	dc.w	endplayer-*
	dc.w	initsound-*
	dc.w	endsound-*
	dc.w	interrupt-*
	dc.w	nextpattern-*
	dc.w	prevpattern-*
name	dc.b	'PlayAY Debugger 1.0',0
creator	dc.b	'(C) 1994 Patrik Rak - Raxoft',0
	dc.b	0		;no conversion
misc	dc.b	'Used for AY-3-8912 emulation testing',0

;------------------------- Texts ----------------------

dosn	dc.b	'dos.library',0
intn	dc.b	'intuition.library',0
gtn	dc.b	'gadtools.library',0
topazn	dc.b	'topaz.font',0

txtT	dc.b	'T',0
txtN	dc.b	'N',0
txtE	dc.b	'E',0

txtFreq	dc.b	'Freq',0
txtVol	dc.b	'Vol',0
txtNoise	dc.b	'Noise',0
txtEnv	dc.b	'Env',0
txtEnvType	dc.b	'Type',0
txtEnvLoop	dc.b	'L',0

txtSquare	dc.b	'Square',0
txtSaw		dc.b	'Saw',0
	even

;--------------------- AY player routines --------------------

initplayer
	bsr.b	Relocate
	bsr.b	StartGUI
	move.l	d2,d0		;signal error
	rts
	
endplayer
	bsr.b	StopGUI
;	rts

initsound
;	rts

endsound
	rts

interrupt
	lea	AY_Registers(pc),a0
	move.l	AYbase(pc),a1
	moveq	#14/2-1,d0
.loop	move.w	(a0)+,(a1)+
	dbra	d0,.loop
	moveq	#0,d0
;	rts

nextpattern
;	rts
prevpattern
	rts

;------------------------- GUI Routines ---------------------

Relocate	lea	b(pc),a5
	tst.b	relocated-b(a5)
	bne.b	.rts
	lea	reloc(pc),a0
.loop	move.l	a0,a1
	move.w	(a0)+,d0
	beq.b	.exit
	add.w	d0,a1
	move.l	a1,d0
	add.l	d0,(a1)
	bra.b	.loop
.exit	st	relocated-b(a5)
.rts	rts

StartGUI
	exec	a6
	lea	b(pc),a5
	tst.l	proc-b(a5)
	bne.b	.failed
	lea	dosn(pc),a1
	moveq	#37,d0
	jsrlib	OpenLibrary
	tst.l	d0
	beq.b	.failed
	move.l	d0,a6
	lea	TagProc(pc),a0
	move.l	a0,d1
	jsrlib	CreateNewProc
	moveq	#-1,d2
	move.l	d0,proc-b(a5)
	beq.b	.error
	moveq	#0,d2
.error	move.l	a6,a1
	exec	a6
	jsrlib	CloseLibrary
.failed	rts

StopGUI
	move.l	proc(pc),d0
	beq.b	.failed
	move.l	d0,a1
	move.l	#SIGBREAKF_CTRL_C,d0
	exec	a6
	jsrlib	Signal
.active	move.l	proc(pc),d0		;bleurgh!!! Active waiting!!!
	bne.b	.active	
.failed	rts

EntryPoint
	bsr.b	OpenGUI
.loop	moveq	#-1,d0		;Not very nice...
	exec	a6
	jsrlib	Wait
	btst	#SIGBREAKB_CTRL_C,d0
	bne.b	.exitus
	bsr.w	ProcessGUI
	bra.b	.loop
.exitus	jsrlib	Forbid
	bsr.w	ProcessGUI	;flush all Imsgs
	bsr.w	CloseGUI
	clr.l	proc-b(a5)
	rts
	
OpenGUI	lea	b(pc),a5
	exec	a6
	lea	intn(pc),a1
	moveq	#37,d0
	jsrlib	OpenLibrary
	move.l	d0,intb-b(a5)
	beq.w	.rts
	lea	gtn(pc),a1
	moveq	#37,d0
	jsrlib	OpenLibrary
	move.l	d0,gtb-b(a5)
	beq.w	.rts
	move.l	intb(pc),a6
	sub.l	a0,a0		;workbench
	jsrlib	LockPubScreen
	move.l	d0,scr-b(a5)
	beq.w	.rts
	move.l	d0,a0
	moveq	#0,d6
	move.b	sc_WBorLeft(a0),d6	;left offset
	move.l	sc_Font(a0),a1
	moveq	#0,d7
	move.b	sc_WBorTop(a0),d7
	add.w	ta_YSize(a1),d7
	addq.w	#1,d7			;top offset
	lea	TagDone(pc),a1
	move.l	gtb(pc),a6
	jsrlib	GetVisualInfoA
	move.l	d0,vi-b(a5)
	beq.b	.unlock
	lea	glist(pc),a0
	jsrlib	CreateContext
	tst.l	d0
	beq.b	.unlock
	move.l	d0,a0	;context
	lea	gadgets(pc),a3
	lea	gtable(pc),a4
.loop	lea	NewGad(pc),a1
	moveq	#0,d0
	move.b	(a4)+,d0	;kind
	beq.b	.finito
	move.b	(a4)+,gng_Flags+3(a1)	;flags
	move.w	(a4)+,(a1)	;left
	add.w	d6,(a1)+
	move.w	(a4)+,(a1)	;top
	add.w	d7,(a1)+
	move.l	(a4)+,(a1)+	;width & height
	move.l	a4,a2		;text
	add.w	(a4)+,a2
	move.l	a2,(a1)
	lea	NewGad(pc),a1
	move.l	a4,a2		;userdata
	add.w	(a4)+,a2
	move.l	a2,gng_UserData(a1)
	move.l	a4,a2
	add.w	(a4)+,a2		;taglist
	;d0 kind, a0 previous, a1 NewGad, a2 taglist
	;a3 gadgets, a4 gtable, d6 loffset, d7 roffset
	jsrlib	CreateGadgetA
	move.l	d0,a0
	move.l	d0,(a3)+
	bne.b	.loop
	bra.b	.unlock
.finito	add.w	#WindowHeight,d7
	move.w	d7,wh+2-b(a5)
	sub.l	a0,a0
	lea	TagWindow(pc),a1
	move.l	intb(pc),a6
	jsrlib	OpenWindowTagList
	move.l	d0,win-b(a5)
	beq.b	.unlock
	move.l	d0,a0
	sub.l	a1,a1
	move.l	gtb(pc),a6
	jsrlib	GT_RefreshWindow
.unlock	move.l	intb(pc),a6
	move.l	scr(pc),a1
	jsrlib	UnlockPubScreen
.rts	rts

CloseGUI
	lea	b(pc),a5
	move.l	win(pc),d0
	beq.b	.nowin
	move.l	d0,a0
	move.l	intb(pc),a6
	jsrlib	CloseWindow
	clr.l	win-b(a5)
.nowin	move.l	gtb(pc),a6
	move.l	glist(pc),d0
	beq.b	.nogad
	move.l	d0,a0
	jsrlib	FreeGadgets
	clr.l	glist-b(a5)
.nogad	move.l	vi(pc),d0
	beq.b	.novi
	move.l	d0,a0
	jsrlib	FreeVisualInfo
	clr.l	vi-b(a5)
.novi	exec	a6
	move.l	gtb(pc),d0
	beq.b	.nogt
	move.l	d0,a1
	jsrlib	CloseLibrary
	clr.l	gtb-b(a5)
.nogt	move.l	intb(pc),d0
	beq.b	.noint
	move.l	d0,a1
	jsrlib	CloseLibrary
	clr.l	intb-b(a5)
.noint	rts

ProcessGUI
	lea	b(pc),a5
.loop	move.l	win(pc),d0
	beq.b	.rts
	move.l	d0,a0
	move.l	wd_UserPort(a0),a0
	move.l	gtb(pc),a6
	jsrlib	GT_GetIMsg
	tst.l	d0
	beq.b	.rts
	move.l	d0,a2
	moveq	#IDCMP_GADGETUP!IDCMP_GADGETDOWN!IDCMP_MOUSEMOVE,d0
	and.w	im_Class+2(a2),d0	;faster
	beq.b	.done
	move.l	im_IAddress(a2),a3	;gadget
	move.l	gg_UserData(a3),d1
	beq.b	.done
	move.l	d1,a0
	move.w	im_Code(a2),d0		;note that d0 upper word is 0
	move.l	gg_SpecialInfo(a3),a4
	jsr	(a0)	;a2 message, a3 gadget, a4 special info, d0 im_Code
.done	move.l	a2,a1
	jsrlib	GT_ReplyIMsg
	bra.b	.loop
.rts	rts


;a4 Special info, d1 maximum d2 slider nr, d3 integer nr

SetPair
	cmp.l	d0,d1
	bcs.b	.toobig
	move.l	d0,d1
.toobig	btst	#4,im_Class+3(a2)	;IDCMP_MOUSEMOVE
	bne.b	.notnow
	move.l	#GTSL_Level,d0
	bsr.b	SetGadget
.notnow	move.l	d3,d2

SetIntGadget
	move.l	#GTIN_Number,d0

;d0 tag, d1 value d2 gadget number

SetGadget
	lea	gadgets(pc),a0
	add	d2,d2
	add	d2,d2
	add	d2,a0
	move.l	(a0),a0
	moveq	#0,d2
	pushm	d0-d2/a1-a3/a6
	move.l	win(pc),a1
	sub.l	a2,a2
	move.l	a7,a3
	move.l	gtb(pc),a6
	jsrlib	GT_SetGadgetAttrsA	;a0 gad a1 win a2 null a3 taglist
	popm	d0-d2/a1-a3/a6
	rts
	
;------------------------- Gadget Routines ----------------------

;d0 code a3 gadget, a4 special info,a5 b

FreqAgdg				;Just do the AND.L #$000ffff,d0
	lea	AY_FreqA(pc),a1		;correction. Ignore slider position.
	moveq	#0,d2
.in	moveq	#0,d1
	move.w	si_LongInt+2(a4),d1
	move.w	d1,(a1)
	bra.b	SetIntGadget

FreqBgdg
	lea	AY_FreqB(pc),a1
	moveq	#7,d2
	bra.b	FreqAgdg\.in
FreqCgdg
	lea	AY_FreqC(pc),a1
	moveq	#14,d2
	bra.b	FreqAgdg\.in

FreqAslide	lea	AY_FreqA(pc),a1
	moveq	#0,d2			;int gadget nr
.in	moveq	#0,d1
	subq	#1,d0
	bcs.b	.zero
	add.w	d0,d0
	move.l	AYfreq(pc),a0
	add.w	d0,a0
	move.w	(a0),d1
.zero	move.w	d1,(a1)
	bra.b	SetIntGadget
FreqBslide
	lea	AY_FreqB(pc),a1
	moveq	#7,d2
	bra.b	FreqAslide\.in
FreqCslide
	lea	AY_FreqC(pc),a1
	moveq	#14,d2
	bra.b	FreqAslide\.in

VolAgdg	
	move.l	si_LongInt(a4),d0
VolAslide
	moveq	#3,d2	;slider nr
	moveq	#1,d3	;integer nr
	lea	AY_VolA(pc),a1
.in2	moveq	#15,d1
	bsr.w	SetPair
	moveq	#-16,d0
	and.b	(a1),d0
	or.b	d1,d0
	move.b	d0,(a1)
	rts
VolBgdg
	move.l	si_LongInt(a4),d0
VolBslide
	moveq	#10,d2	;slider nr
	moveq	#8,d3	;integer nr
	lea	AY_VolB(pc),a1
	bra.b	VolAslide\.in2
VolCgdg	
	move.l	si_LongInt(a4),d0
VolCslide
	moveq	#17,d2	;slider nr
	moveq	#15,d3	;integer nr
	lea	AY_VolC(pc),a1
	bra.b	VolAslide\.in2

ToneA	moveq	#0,d0
.in	move.b	AY_Strobe(pc),d1
	btst	#7,gg_Flags+1(a3)	;GFLG_SELECTED
	bne.b	.selected
	bset	d0,d1
	bra.b	.cont
.selected
	bclr	d0,d1
.cont	move.b	d1,AY_Strobe-b(a5)
	rts
ToneB	moveq	#1,d0
	bra.b	ToneA\.in
ToneC	moveq	#2,d0
	bra.b	ToneA\.in
NoiseA	moveq	#3,d0
	bra.b	ToneA\.in
NoiseB	moveq	#4,d0
	bra.b	ToneA\.in
NoiseC	moveq	#5,d0
	bra.b	ToneA\.in
Noisegdg
	move.l	si_LongInt(a4),d0
Noiseslide
	moveq	#31,d1
	moveq	#22,d2	;slider nr
	moveq	#21,d3	;integer nr
	bsr.w	SetPair
	move.b	d1,AY_Noise-b(a5)
EnvFreqgdg
EnvFreqslide
EnvType
EnvLoop
EnvA
EnvB
EnvC	rts

;------------------------- AY registers ----------------------

AY_Registers
AY_FreqA	dc.w	0
AY_FreqB	dc.w	0
AY_FreqC	dc.w	0
AY_Noise	dc.b	0
AY_Strobe	dc.b	%111111
AY_VolA		dc.b	0
AY_VolB		dc.b	0
AY_VolC		dc.b	0
AY_EnvFreq	dc.b	0,0
AY_EnvType	dc.b	0

;------------------------- Definitions ----------------------

	STRUCTURE	MyGadget,0
	UBYTE	MGDG_Kind
	UBYTE	MGDG_Flags
	UWORD	MDGD_LeftEdge
	UWORD	MDGD_TopEdge
	UWORD	MDGD_Height
	UWORD	MDGD_Width
	RPTR	MGDG_Text
	RPTR	MGDG_UserData
	RPTR	MGDG_Tags
	LABEL	MGDG_SizeOf

;------------------------- Macros ----------------------

gdg	macro	;kind,flags,left,top,height,width,text,user,tags
	dc.b	\1
	dc.b	\2
	dc.w	\3,\4,\5,\6
	dc.w	\7-*
	dc.w	\8-*
	dc.w	\9-*
	endm

;------------------------- Gadgets ----------------------

gadnr	equ	27	;nr of gadgets below

gadgets	dcb.l	gadnr

gtable	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,3,57,13,txtFreq,FreqAgdg,TagDone
g1	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,19,57,13,txtVol,VolAgdg,TagDone
g2	gdg	SLIDER_KIND,0,116,3,225,13,null,FreqAslide,TagFreqS
g3 	gdg	SLIDER_KIND,0,116,19,177,13,null,VolAslide,TagVolS
g4	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,4,26,11,txtT,ToneA,TagDone
g5	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,20,26,11,txtN,NoiseA,TagDone
g6	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,299,20,26,11,txtE,EnvA,TagDisabled
g7	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,35,57,13,txtFreq,FreqBgdg,TagDone
g8	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,51,57,13,txtVol,VolBgdg,TagDone
g9   	gdg	SLIDER_KIND,0,116,35,225,13,null,FreqBslide,TagFreqS
g10 	gdg	SLIDER_KIND,0,116,51,177,13,null,VolBslide,TagVolS
g11	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,36,26,11,txtT,ToneB,TagDone
g12	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,52,26,11,txtN,NoiseB,TagDone
g13	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,299,52,26,11,txtE,EnvB,TagDisabled
g14	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,67,57,13,txtFreq,FreqCgdg,TagDone
g15	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,83,57,13,txtVol,VolCgdg,TagDone
g16    	gdg	SLIDER_KIND,0,116,67,225,13,null,FreqCslide,TagFreqS
g17  	gdg	SLIDER_KIND,0,116,83,177,13,null,VolCslide,TagVolS
g18	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,68,26,11,txtT,ToneC,TagDone
g19	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,84,26,11,txtN,NoiseC,TagDone
g20	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,299,84,26,11,txtE,EnvC,TagDisabled
g21	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,99,57,13,txtNoise,Noisegdg,TagDone
g22  	gdg	SLIDER_KIND,0,116,99,273,13,null,Noiseslide,TagNoiseS
g23	gdg	INTEGER_KIND,PLACETEXT_LEFT,52,115,57,13,txtEnv,EnvFreqgdg,TagDisabled
g24	gdg	SLIDER_KIND,0,116,115,273,13,null,EnvFreqslide,TagEnvFreqS
g25	gdg	CYCLE_KIND,PLACETEXT_LEFT,52,131,289,13,txtEnvType,EnvType,TagEnvType
g26	gdg	CHECKBOX_KIND,PLACETEXT_RIGHT,347,132,26,11,txtEnvLoop,EnvLoop,TagDisabled
null   	dc.b	0

;------------------------- Some vars ----------------------

relocated	dc.b	0
intb	dc.l	0
gtb	dc.l	0
win	dc.l	0
proc	dc.l	0

NewGad	dc.w	0,0,0,0	;sizes
	dc.l	0	;text
_rel25	dc.l	TopazAtt-*	;font
	dc.w	0	;id
	dc.l	0	;flags
vi	dc.l	0	;visualinfo
	dc.l	0	;userdata

;------------------------- Some Static ----------------------

TopazAtt	
_rel24	dc.l	topazn-*
	dc.w	8,1

;------------------------- Tags ----------------------

	even

TagFreqS
	DC.L	GTSL_Max,109
TagVolS
TagDone	DC.L	TAG_DONE

TagNoiseS
	DC.L    GTSL_Max,31
	DC.l	TAG_DONE

TagEnvFreqS
    DC.L    GTSL_Max,8192
    DC.L    GA_Disabled,1
    DC.L    TAG_DONE

TagEnvType    
    DC.L    GTCY_Labels
_rel21	dc.l	LabEnvType-*
TagDisabled
    DC.L    GA_Disabled,1
    DC.L    TAG_DONE

TagWindow
    DC.L    WA_Width,403
    DC.L    WA_Height
WindowHeight	equ	149
wh	dc.l	0
    DC.L    WA_IDCMP,SLIDERIDCMP!CHECKBOXIDCMP!CYCLEIDCMP!INTEGERIDCMP!IDCMP_REFRESHWINDOW
    DC.L    WA_Flags,WFLG_DRAGBAR!WFLG_DEPTHGADGET!WFLG_SMART_REFRESH
Project1WG:
    DC.L    WA_Gadgets
glist	dc.l	0	;gadgetlist
    DC.L    WA_Title
_rel26	dc.l	name-*
    DC.L    WA_PubScreen
scr	dc.l	0	;pub screen
    DC.L    TAG_DONE

TagProc
	dc.l	NP_Entry
_rel27	dc.l	EntryPoint-*
	dc.l	NP_Name
_rel28	dc.l	name-*
	dc.l	TAG_DONE

;------------------------- Labels ----------------------

LabEnvType
_rel22	dc.l	txtSquare-*
_rel23	dc.l	txtSaw-*
	dc.l	0

;---------------------- reloc tables -------------------

reloc
	dc.w	_rel21-*
	dc.w	_rel22-*
	dc.w	_rel23-*
	dc.w	_rel24-*
	dc.w	_rel25-*
	dc.w	_rel26-*
	dc.w	_rel27-*
	dc.w	_rel28-*
	dc.w	0

e