(--- SID chip access ---)

: PC2! ( c c p-addr --   Data byte A, high address byte B, port address C - OUT to port with A and B registers set )
   SWAP >< OR PC! ;
: SID! ( c c --          Data value, register 0-31; bits 5,6 are for interrupt settings; bit 7 /CS is handled )
  2DUP 128 OR 84 PC2!
  2DUP 127 AND 84 PC2!
  128 OR 84 PC2! ;

(--- SID chip control register flags ---)

: SID:CTL:GATE  1 ;
: SID:CTL:SYNC  2 ;
: SID:CTL:RING  4 ;
: SID:CTL:TEST  8 ;
: SID:CTL:TRI   16 ;
: SID:CTL:SAW   32 ;
: SID:CTL:PWM   64 ;
: SID:CTL:NOISE 128 ;

(--- Frequency table ---)

: SID:NOTE:C4  4389 ;
: SID:NOTE:C4# 4650 ;
: SID:NOTE:D4  4927 ;
: SID:NOTE:D4# 5220 ;
: SID:NOTE:E4  5530 ;
: SID:NOTE:F4  5859 ;
: SID:NOTE:F4# 6207 ;
: SID:NOTE:G4  6577 ;
: SID:NOTE:G4# 6968 ;
: SID:NOTE:A4  7382 ;
: SID:NOTE:A4# 7821 ;
: SID:NOTE:B4  8286 ;

( Octave shifts )
: SID:OCT:UP 2* ;
: SID:OCT:DOWN 2/ ;

(--- Direct access ---)

( Voice 1 )
: SID0/1:FREQ!  ( n --  Reg 0,1 - frequency voice 1 )
   DUP 255 AND 0 SID! >< 255 AND 1 SID! ;
: SID2/3:PWM!   ( n --  Reg 2,3 - pulse wave duty cycle voice 2 )
   DUP 255 AND 2 SID! >< 15 AND 3 SID! ;
: SID4!         ( c --  Reg 4 - control register voice 1 )
   4 SID! ;
: SID5:ATK/DEC! ( c --  Reg 5 - attack duration / decay duration voice 1 )
   15 AND SWAP 4 LSHIFT OR 5 SID! ;
: SID6:SUS/REL! ( c --  Reg 6 - sustain level / release duration voice 1 )
   15 AND SWAP 4 LSHIFT OR 6 SID! ;

( Voice 2 )
: SID7/8:FREQ!   ( n --  Reg 7,8 - frequency voice 2 )
   DUP 255 AND 7 SID! >< 15 AND 8 SID! ;
: SID9/10:PWM!   ( n --  Reg 9,10 - pulse wave duty cycle voice 2 )
   DUP 255 AND 9 SID! >< 255 AND 10 SID! ;
: SID11!         ( c --  Reg 10 - control register voice 2 )
   11 SID! ;
: SID12:ATK/DEC! ( c --  Reg 12 - attack duration / decay duration voice 2 )
   15 AND SWAP 4 LSHIFT OR 12 SID! ;
: SID13:SUS/REL! ( c --  Reg 13 - sustain level / release duration voice 2 )
   15 AND SWAP 4 LSHIFT OR 13 SID! ;

( Voice 3 )
: SID14/15:FREQ! ( n --  Reg 14,15 - frequency voice 3 )
   DUP 255 AND 14 SID! >< 15 AND 15 SID! ;
: SID16/17:PWM!  ( n --  Reg 16,17 - pulse wave duty cycle voice 3 )
   DUP 255 AND 16 SID! >< 255 AND 17 SID! ;
: SID18!         ( c --  Reg 18 - control register voice 18 )
   18 SID! ;
: SID19:ATK/DEC! ( c --  Reg 19 - attack duration / decay duration voice 3 )
   15 AND SWAP 4 LSHIFT OR 19 SID! ;
: SID20:SUS/REL! ( c --  Reg 20 - sustain level / release duration voice 3 )
   15 AND SWAP 4 LSHIFT OR 20 SID! ;

( Filters )
: SID21/22:CUT!  ( n --  Reg 21/22 - filter cutoff frequency 0 - 2047 / 11 bits )
   DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ;
( c -- c  Reg 23 - filter resonance 0 - 15 / 4 bits, ext, voice 3, voice 2, voice 1 )
: SID23:RES 15 AND 4 LSHIFT ;
: SID23:V1 1 OR ;
: SID23:V2 2 OR ;
: SID23:V3 4 OR ;
: SID23:EXT 8 OR ;
: SID23! ( c -- )
   23 SID! ;
( c -- c  Reg 24 - filter mode and main volume control )
: SID24:VOL 15 AND ;
: SID24:LOWPASS 16 OR ;
: SID24:BANDPASS 32 OR ;
: SID24:HIGHPASS 64 OR ;
: SID24:MUTEVOICE3 128 OR ;
: SID24! ( c -- )
   24 SID! ;

: SID:RST ( --  Put SID chip in known state )
   4389 SID0/1:FREQ!   0 SID4!  4 2 SID5:ATK/DEC!  10 9 SID6:SUS/REL!  2048 SID2/3:PWM!
   4389 SID7/8:FREQ!   0 SID11! 4 2 SID12:ATK/DEC! 10 9 SID13:SUS/REL! 2048 SID9/10:PWM!
   4389 SID14/15:FREQ! 0 SID18! 4 2 SID19:ATK/DEC! 10 9 SID20:SUS/REL! 2048 SID16/17:PWM!
   1024 SID21/22:CUT! 10 SID23:RES SID23!
   15 SID24:VOL SID24! ;

( Voice contorl registers )
VARIABLE SID:V1:CTL
: SID:V1:CTL!     ( c --  Set CTL register for voice 1 )
   SID:V1:CTL ! ;
: SID:V1:NOTE:ON  ( n --  Start note of given frequency )
   SID0/1:FREQ! SID:V1:CTL @ SID:CTL:GATE OR SID4! ;
: SID:V1:NOTE:OFF ( --    Stop note )
   SID:V1:CTL @ SID:CTL:GATE INVERT AND SID4! ;

VARIABLE SID:V2:CTL
: SID:V2:CTL!     ( c --  Set CTL register for voice 2 )
   SID:V2:CTL ! ;
: SID:V2:NOTE:ON  ( n --  Start note of given frequency )
   SID7/8:FREQ! SID:V2:CTL @ SID:CTL:GATE OR SID11! ;
: SID:V2:NOTE:OFF ( --    Stop note )
   SID:V2:CTL @ SID:CTL:GATE INVERT AND SID11! ;

VARIABLE SID:V3:CTL
: SID:V3:CTL!     ( c --  Set CTL register for voice 3 )
   SID:V3:CTL ! ;
: SID:V3:NOTE:ON  ( n --  Start note of given frequency )
   SID14/15:FREQ! SID:V3:CTL @ SID:CTL:GATE OR SID18! ;
: SID:V3:NOTE:OFF ( --    Stop note )
   SID:V3:CTL @ SID:CTL:GATE INVERT AND SID18! ;

: DELAY 10000 0 DO LOOP ;

: SID:V1:TEST:NOTE
   SID:CTL:TRI SID:V1:CTL!
   SID:NOTE:C4 SID:V1:NOTE:ON
   DELAY DELAY
   SID:V1:NOTE:OFF ;
: SID:V2:TEST:NOTE
   SID:CTL:SAW SID:V2:CTL!
   SID:NOTE:D4 SID:OCT:UP SID:V2:NOTE:ON
   DELAY DELAY
   SID:V2:NOTE:OFF ;
: SID:V3:TEST:NOTE
   SID:CTL:PWM SID:V3:CTL!
   SID:NOTE:E4 SID:V3:NOTE:ON
   DELAY DELAY
   SID:V3:NOTE:OFF ;

: SID:TEST:MELODY
   SID:V1:TEST:NOTE
   SID:V2:TEST:NOTE
   SID:V3:TEST:NOTE ;

: SID:TEST:FILTER
   10 SID23:RES SID23:V1 SID23:V2 SID23:V3 SID23:EXT SID23!
   15 SID24:VOL SID24:LOWPASS SID24!
   SID:CTL:PWM SID:V1:CTL! SID:NOTE:D4 SID:V1:NOTE:ON
   2047 0 DO I SID21/22:CUT! 1 +LOOP
   SID:V1:NOTE:OFF
   15 SID24:VOL SID24:BANDPASS SID24!
   SID:CTL:PWM SID:V2:CTL! SID:NOTE:D4 SID:V2:NOTE:ON
   2047 0 DO I SID21/22:CUT! 1 +LOOP
   SID:V2:NOTE:OFF
   15 SID24:VOL SID24:HIGHPASS SID24!
   SID:CTL:PWM SID:V3:CTL! SID:NOTE:D4 SID:V3:NOTE:ON
   2047 0 DO I SID21/22:CUT! 1 +LOOP
   SID:V3:NOTE:OFF
   0 SID23! ;

: SID:PLAY SID:V1:NOTE:ON DELAY SID:V1:NOTE:OFF ;
: SID:TEST:SONG
   SID:CTL:TRI SID:V1:CTL!
   SID:NOTE:G4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:F4 SID:PLAY
   SID:NOTE:D4 SID:PLAY
   SID:NOTE:D4 SID:PLAY
   SID:NOTE:C4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:G4 SID:PLAY
   DELAY DELAY
   SID:NOTE:G4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:F4 SID:PLAY
   SID:NOTE:D4 SID:PLAY
   SID:NOTE:D4 SID:PLAY
   SID:NOTE:C4 SID:PLAY
   SID:NOTE:E4 SID:PLAY
   SID:NOTE:C4 SID:PLAY ;

SID:RST

SID:TEST:MELODY
SID:TEST:FILTER
SID:TEST:SONG

(--- Voice selection ---)

CREATE SID:VOICE-BASES 0 , 7 , 14 , ( 3'base )
CREATE SID:VOICE-CTLS 0 , 0 , 0 , ( 3clt-reg-shadow )

: SID:VOICE-BASE-ADDR   ( voice -- 'reg-no )
   CELL * SID:VOICE-BASES + ;
: SID:VOICE-CTL-ADDR   ( voice -- 'ctl-addr )
   CELL * SID:VOICE-CTLS + ;

CREATE SID:VOICE-BASE-PTR SID:VOICE-BASES ,
CREATE SID:VOICE-CTL-PTR SID:VOICE-CTLS ,

: SID:SELECT-VOICE   ( voice -- ) ( select SELECT voice )
   DUP
   SID:VOICE-BASE-ADDR SID:VOICE-BASE-PTR !
   SID:VOICE-CTL-ADDR SID:VOICE-CTL-PTR ! ;

: SID:VOICE-REG-NO   ( -- n ) ( Base SID register number for selected voice )
   SID:VOICE-BASE-PTR @ @ ;

(--- Voice register ops ---)

: SID:VOICE!   ( c n -- ) ( Store byte in selected voice register n )
   SID:VOICE-REG-NO + SID! ;

: SID:VOICE-CTL   ( -- a-addr ) ( Control register shadow for current voice )
   SID:VOICE-CTL-PTR @ ;

: SID:VOICE-FREQ!   ( n -- ) ( Reg 0,1 - Set frequency )
   DUP 255 AND 0 SID:VOICE! >< 255 AND 1 SID:VOICE! ;
: SID:VOICE-PWM!   ( n -- ) ( Reg 2,3 - Set pulse wave duty cycle )
   DUP 255 AND 2 SID:VOICE! >< 15 AND 3 SID:VOICE! ;
: SID:VOICE-CTL!   ( c -- ) ( Reg 4 - Set control register; write-through shadow )
   DUP SID:VOICE-CTL ! 4 SID:VOICE! ;
: SID:VOICE-ATK/DEC!   ( c -- ) ( Reg 5 - Set attack duration / decay duration )
   15 AND SWAP 4 LSHIFT OR 5 SID:VOICE! ;
: SID:VOICE-SUS/REL!   ( c -- ) ( Reg 6 - Set sustain level / release duration )
   15 AND SWAP 4 LSHIFT OR 6 SID:VOICE! ;

: SID:VOICE-PLAY   ( freq -- ) ( Start note at given frequency )
   SID:VOICE-FREQ! SID:VOICE-CTL @ SID:CTL:GATE OR 4 SID:VOICE! ;
: SID:VOICE-STOP   ( -- ) ( Stop note )
   SID:VOICE-CTL @ SID:CTL:GATE INVERT AND 4 SID:VOICE! ;

(--- Other registers ---)

: SID:CUTOFF!   ( n -- ) ( Reg 21/22 - Set filter cutoff frequency 0 - 2047 / 11 bits )
   DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ;

( Reg 23 - filter resonance 0 - 15 / 4 bits, ext, voice 3, voice 2, voice 1 )
: SID:FILTER:RES 15 AND 4 LSHIFT ;
: SID:FILTER:V1 1 OR ;
: SID:FILTER:V2 2 OR ;
: SID:FILTER:V3 4 OR ;
: SID:EXT 8 OR ;
: SID:FILTER-RES-FLAGS!
   23 SID! ;

( Reg 24 - filter mode and main volume control )
: SID:VOLUME 15 AND ;
: SID:FILTER:LOWPASS 16 OR ;
: SID:FILTER:BANDPASS 32 OR ;
: SID:FILTER:HIGHPASS 64 OR ;
: SID:MUTEVOICE3 128 OR ;
: SID:VOL-FILTER!
   24 SID! ;

(--- Reset ---)

: SID:VOICE-RST   ( -- ) ( Reset selected voice state )
   SID:NOTE:C4 SID:VOICE-FREQ!
   2048 SID:VOICE-PWM!
   0 SID:VOICE-CTL!
   4 2 SID:VOICE-ATK/DEC!
   10 9 SID:VOICE-SUS/REL! ;

: SID:OTHER-RST
   1024 SID:CUTOFF!
   10 SID:FILTER:RES SID:FILTER-RES-FLAGS!
   15 SID:VOLUME SID:VOL-FILTER! ;

: SID:RST   ( Full SID chip reset )
   2 SID:SELECT-VOICE SID:VOICE-RST
   1 SID:SELECT-VOICE SID:VOICE-RST
   0 SID:SELECT-VOICE SID:VOICE-RST
   SID:OTHER-RST ;

(--- Test ---)

: DELAY 10000 0 DO LOOP ;

: SID:TEST:NOTE
   SID:NOTE:C4 SID:VOICE-PLAY
   DELAY DELAY
   SID:VOICE-STOP ;

SID:RST

SID:CTL:TRI SID:VOICE-CTL!   ( Select triangle waveform )
SID:TEST:NOTE