morse.gs.s

	lst off
	rel
	xc
	xc

	use morse.equ
	use e16.window
	use e16.event
	use e16.types
	use e16.control
	use e16.resources

*	lst on

kWindowID equ $1000
kTextEdit equ 1
kPlayID	equ 2
kStopID	equ 3
kAboutAlert equ 1

	tbx on


beep_left	equ 0
beep_right	equ 1
noise_left	equ 2
noise_right	equ 3
timer_1		equ 4
timer_3		equ 5
timer_7		equ 6


bic	mac
	if #=]1
	and ]1!$ffff
	else
	err 1 ; immediate only.
	fin
	<<<

docwait	mac
	if MX<2
	err 1 ; 8-bit m only
	fin
wait	lda >SoundCtrl
	bmi wait
	<<<

docmode mac
	docwait
*	lda >SoundAddr
	bic #%01000000 ; DOC mode
	ora #%00100000 ; auto-incr
	sta >SoundCtrl
	<<<




main
	mx %00
	phk
	plb

	sta MyID
	jsr init

	jsr mainloop

	jsr shutdown
	_GSOS:Quit :QuitDCB
	brk $ea

:QuitDCB	dw 2
		adrl 0
		dw 0


draw_window
	pha
	pha
	_GetPort
	_DrawControls
	rtl


mainloop

	pha
	pha ; result
	psl #0
	psl #0
	psl #draw_window
	psl #0
	psw #refIsResource
	psl #kWindowID
	psw #rWindParam1
	_NewWindow2
	pll window

	pha
	pha
	psl window
	psw #singlePtr
	psl #:ctemplate
	_NewControl2
	pll cctrl


	psl window
	_ShowWindow


*	psw #'x'
*	psl cctrl
*	_SetCtlValue



	_InitCursor
	stz quit

	lda #$001fffff
	sta event+owmTaskMask
	lda #^$001fffff
	sta event+owmTaskMask+2

:loop
	pha
	psw #-1
	psl #event
	_TaskMaster
	pla
	cmp #:table_size+1
	bcs :loop

	asl
	tax
	jsr (:table,x)
	lda quit
	beq :loop

:rts
	rts

:table
	dw idle ; null
	dw :rts ; mouse down
	dw :rts ; mouse up
	dw :rts ; key down
	dw :rts ; auto key down
	dw :rts
	dw :rts ; update
	dw :rts
	dw :rts ; activate
	dw :rts ; switch
	dw :rts ; desk acc.
	dw :rts ; driver
	dw :rts ; app 1
	dw :rts ; app 2
	dw :rts ; app 3
	dw :rts ; app 4
	dw :rts ; wInDesk
	dw menu ; wInMenuBar
	dw :rts ; wClickCalled
	dw :rts ; wInContent
	dw :rts ; wInDrag
	dw :rts ; wInGrow
	dw bye ; wInGoAway
	dw :rts ; wInZoom
	dw :rts ; wInInfo
	dw menu ; wInSpecial menu 250-255
	dw :rts ; wInDeskItem menu 1-249
	dw :rts ; wInFrame
	dw :rts ; wInactMenu
	dw :rts ; wClosedNDA
	dw :rts ; wCalledSysEdit
	dw :rts ; wTrackZoom
	dw :rts ; wHitFrame
	dw control ; wInControl
	dw :rts ; wInControlMenu
:table_size = {*-:table}/2


	ext char_control
:ctemplate	dw 6 ; pcount
		adrl 0 ; id
		dw 100-4-13,200-8,100-4,200+8 ; rect
		adrl char_control ; proc
		dw 0 ; flag
		dw 0 ; more flags
		adrl 0 ; refcon

idle
	lda _finished
	beq :c
	stz _finished
	brl stopped

:c	lda _current
*	beq :rts
	bmi :rts
	ora #$8000
	sta _current
	and #$00ff
	pha
	psl cctrl
	_SetCtlValue
* set the control char.

:rts	rts

bye
	lda #1
	sta quit
	rts


menu
	lda event+owmTaskData
	sec
	sbc #250
	cmp #:table_size+1
	bcs :xmenu

	asl
	tax
	jsr (:table,x)
:xmenu
	psw #0
	psw event+owmTaskData+2
	_HiliteMenu
:rts	rts

:table
	dw :rts ; 250 undo
	dw :rts ; 251 cut
	dw :rts ; 252 copy
	dw :rts ; 253 paste
	dw :rts ; 254 clear
	dw :rts ; 255 close
	dw about ; 256 about
	dw bye ; 257 quit
	dw :select ;  258 - select all
	dw :rts ;  259 - preferences
:table_size = {*-:table}/2


:select
	psl #0
	psl #255
	psl #0
	_TESetSelection
	rts

about
	pha
	psw #awResource
	psl #0
	psl #kAboutAlert
	_AlertWindow
	pla
	rts

control
	lda event+owmTaskData4 ; id of control selected.
	cmp #:table_size+1
	bcs :rts
	asl
	tax
	jmp (:table,x)
:rts	rts

:table
	dw :rts ; 0 - none
	dw :rts ; text edit. 
	dw play
	dw stop
:table_size = {*-:table}/2


play
* copy text to the buffer and start audio.

	pha
	pha
	psw #%00000000000_00_001 ; c-string, ptr
	psl #_buffer
	psl #256
	psw #0 ; style 
	psl #0 ; style ref
	psl #0 ; teHandle.
	_TEGetText
	pla
*	sta :len
	pla

	bcs :err

	jsr buffer_to_buffer
	bcc :err ;

* can use key filter to block invalid characters....
* copy/convert :buffer to _buffer -still needed for space elimination,
* disable text edit?
* disable play button
* enable stop button
* queue up playing

	psw #inactiveHilite
	psl window ; window
	psl #kPlayID
	_HiliteCtlByID

	psw #noHilite
	psl window ; window
	psl #kStopID
	_HiliteCtlByID

	jsr start_audio

:err	rts


buffer_to_buffer
:c	equ 0

	lda #0
	ldx #0
	ldy #0
	stz :c

	sep $20

:loop	lda _buffer,x
	beq :eof
	bmi :space
	cmp #' '+1
	bcc :space
	phx
	tax
	bit valid,x
	plx
	bvc :space
	sta _buffer,y
	inx
	iny
	stz :c
	bra :loop	

:space	inx
	lda :c
	bne :loop
	inc :c
	lda #' '
	sta _buffer,y
	iny
	bra :loop

:eof	sta _buffer,y
	rep $20
	tya ; len
	cmp #1
	rts


stop
	jsr stop_audio

stopped
* enable controls
	psw #noHilite
	psl window ; window
	psl #kPlayID
	_HiliteCtlByID

	psw #inactiveHilite
	psl window ; window
	psl #kStopID
	_HiliteCtlByID


	psw #' '
	psl cctrl
	_SetCtlValue

	rts



start_audio
	mx %00

	stz _index
	stz _template
	stz _template+2
	stz _on
	stz _active
	stz _finished
	stz _current

	sep $30

	docmode

* start osc 0-3 w/ volume 0.

	lda #$40
	sta >SoundAddr
	lda #0
	sta >SoundData
	sta >SoundData
	lda #$01  ; silent channel to fix GS+ audio deficiencies.
	sta >SoundData
	sta >SoundData

	lda #$a0
	sta >SoundAddr
	lda #%0000_0_00_1 ; free-run, disabled
	sta >SoundData
	lda #%0001_0_00_1 ; free-run, disabled
	sta >SoundData
	lda #%0000_0_00_0 ; free-run, enabled
	sta >SoundData
	lda #%0001_0_00_0 ; free-run, enabled
	sta >SoundData

* volume, again.
	lda #$40
	sta >SoundAddr
	lda #$ff
	sta >SoundData
	sta >SoundData


* trigger the timing oscillator.
	lda #$a0+timer_1
	sta >SoundAddr
	lda #%0000_1_01_0 ; one-shot, enabled, interrupt
	sta >SoundData
	rep $30

	inc _active

	rts

shutdown
	mx %00
	jsr stop_audio

	psw #$b
	psl old_irq
	_SetVector

	psw #refIsHandle
	psl tools
	_ShutDownTools
	psw MyID
	_MMShutDown
	_TLShutDown

	rts

stop_audio
	mx %00
	stz _active

* shut off all oscillators.
	sep $30

	docmode

	lda #$a0
	sta >SoundAddr
	lda #%0000_0_01_1 ; one-shot, disabled, nointerrupt
	sta >SoundData
	sta >SoundData
	sta >SoundData
	sta >SoundData
	sta >SoundData
	sta >SoundData
	sta >SoundData

	rep #$30
	stz _finished
	stz _current

	rts

audio_irq
	mx %11


	docmode
	lda #$e0
	sta >SoundAddr
	lda >SoundData ; osc interrupt register. needed to clear the interrupt

	lda >_active
	bne :ok
	clc
	rtl

:ok
	phb
	phk
	plb


	rep $30

	lsr _template+2
	ror _template

	sep $30
	bcc :off
*	lda _on
*	bne :trigger1
*	ldx #$ff
*	stx _on
	jsr beep_on
*	jsr setvolume


:trigger1 ; osc 5 interrupt on
	lda #$a0+timer_1
	sta >SoundAddr
	lda #%0000_1_01_0 ; one-shot, enabled, interrupt
	sta >SoundData
	bra :exit

:off
* turn off sound generators.
*	stz _on
*	ldx #0
*	jsr setvolume
	jsr beep_off


* check for advance...
	lda _template
	bne :trigger1

	rep $30
	ldx _index
	lda _buffer,x
	and #$7f
	beq :fini
	sta _current

	inx
	stx _index
	cmp #' '+1
	blt :space

	asl
	asl
	tax
	lda table,x
	sta _template
	lda table+2,x
	sta _template+2
	sep $30
*	bra :trigger3 ; inter-char delay.

:trigger3 ; osc 6 interrupt on
	lda #$a0+timer_3
	sta >SoundAddr
	lda #%0000_1_01_0 ; one-shot, enabled, interrupt
	sta >SoundData
	bra :exit



:fini	mx %00
*	stz _index
	stz _active
	inc _finished

	sep $30
* disable the silent generators.
	lda #$a0+noise_left
	sta >SoundAddr
	lda ##%0000_0_00_1 ; stopped
	sta >SoundData
	sta >SoundData

	bra :exit

:space	mx %00
	stz _template ; should already be 0.
	stz _template+2
	sep $30
*	bra :trigger7 ; inter-word delay

:trigger7 ; osc 7 interrupt on
	lda #$a0+timer_7
	sta >SoundAddr
	lda #%0000_1_01_0 ; one-shot, enabled, interrupt
	sta >SoundData
	bra :exit

:exit
	plb
	clc
	rtl

beep_on
	mx %11
	lda _on
	bne :rts
	lda #$a0
	sta >SoundAddr
	lda #%0000_0_00_0 ; free-run, enabled
	sta >SoundData
	lda #%0001_0_00_0 ; free-run, enabled
	sta >SoundData
	inc _on

:rts	rts

beep_off ; changes to one-shot mode so it will expire at the end of the sample
	mx %11
	lda _on
	beq :rts
	lda #$a0
	sta >SoundAddr
	lda #%0000_0_01_0 ; one-shot, enabled
	sta >SoundData
	lda #%0001_0_01_0 ; one-shot, enabled
	sta >SoundData
	stz _on
:rts	rts

setvolume
	mx %11
	lda #$40
	sta >SoundAddr
	txa
	sta >SoundData
	sta >SoundData
	rts



init
	mx %00

	_TLStartUp
	pha
	pha
	psw MyID
	psw #refIsResource
	psl #1
	_StartUpTools
	pll tools

	pha
	pha
	psw #refIsResource
	psl #1
	psl #0
	_NewMenuBar2
	_SetSysBar

	psl #0
	_SetMenuBar

	psw #1
	_FixAppleMenu

	pha
	_FixMenuBar
	pla
	_DrawMenuBar

	jsr init_audio
	rts

init_audio
	pha
	pha
	psw #$b
	_GetVector
	pll old_irq

	psw #$b
	psl #audio_irq
	_SetVector

	sep $30

	docmode


* halt all oscillators. 
	ldy #$20-7
	lda #$a0
	sta >SoundAddr

* osc 1-4 are free-run, halted, stereo pairs.
	lda #%0000_0_00_1 ; free-run, halted
	sta >SoundData
	lda #%0001_0_00_1 ; free-run, halted
	sta >SoundData
	lda #%0000_0_00_1 ; free-run, halted
	sta >SoundData
	lda #%0001_0_00_1 ; free-run, halted
	sta >SoundData

* 5-7 are one-shot, interrupt enabled, halted.
	lda #%0000_1_01_1 ; one-shot, halted, interrupt enabled.
	sta >SoundData
	sta >SoundData
	sta >SoundData

* all others - halted.
	lda #%0000_0_01_1 ; one-shot, halted
]loop	sta >SoundData
	dey
	bne ]loop


* volume 0
	ldy #$20
	lda #$40
	sta >SoundAddr
	lda #0
]loop	sta >SoundData
	dey
	bne ]loop


* 32 oscillators.

	lda #$e1
	sta >SoundAddr
	lda #17*2 ; 18 osc = 44744.3125 hz
	sta >SoundData

* osc 1/2 are 256 bytes, running at the natural rate.

* osc 5/6/7 are 256 bytes, running at 1 / 3 / 6 time units 
SR	= 44744
t1_freq = $01000000*8/SR ;5103
t3_freq = $01000000*8/SR/3 ; 1701
t7_freq = $01000000*8/SR/7 ; 729

* frequency low registers
	lda #$00
	sta >SoundAddr
	lda #<$0200  ; low
	sta >SoundData
	sta >SoundData
*	lda #>$0180
	sta >SoundData
	sta >SoundData

	lda #<t1_freq
	sta >SoundData
	lda #<t3_freq
	sta >SoundData
	lda #<t7_freq
	sta >SoundData

* freq high
	lda #$20
	sta >SoundAddr
	lda #>$0200
	sta >SoundData
	sta >SoundData
*	lda #>$0180
	sta >SoundData
	sta >SoundData

	lda #>t1_freq
	sta >SoundData
	lda #>t3_freq
	sta >SoundData
	lda #>t7_freq
	sta >SoundData



* wave table pointer
	lda #$80
	sta >SoundAddr
	lda #$00 ; page 0
	sta >SoundData
	sta >SoundData
	inc ; page 1
	sta >SoundData
	sta >SoundData
*	inc ; page 2 
	sta >SoundData
	sta >SoundData
	sta >SoundData

* wave table size registers
	lda #$c0
	sta >SoundAddr
* 1-4 use 256 byte date, 9-bit shift.
	lda #%00000000
	sta >SoundData
	sta >SoundData
	sta >SoundData
	sta >SoundData
* 5-7 use 256 byte data, 16-bit shift
	lda #%00_000_111
	sta >SoundData
	sta >SoundData
	sta >SoundData


* now load data...

	docwait

	ora #%01100000 ; ram mode, incr
	sta >SoundCtrl

	lda #0
	sta >SoundAddr
	sta >SoundAddr+1

	ldx #0
]loop	lda beep_f5,x
	sta >SoundData
	inx
	bne ]loop


*]loop	lda noise,x
*	sta >SoundData
*	inx
*	bne ]loop


* 256 silent bytes for the timer.
	lda #$80
]loop	sta >SoundData
	inx
	bne ]loop


	rep #$30

	rts


	lst off
	put tables

old_irq	ds 4

tools	ds 4
window	ds 4
cctrl	ds 4
MyID	ds 2


quit	ds 2
event	ds wmTaskRecSize





_active		ds 2
_finished	ds 2
_on		ds 2
_current	ds 2

_template	ds 4
_index		ds 2
_buffer		ds 256
*_buffer		asc 'Apple 2 forever',00

	dat 8

	typ $b3
*	aux $db03
	sav morse.gs.l
*	lst on
	sym