( --- Gforth SID chip stub --- )

( : PC! DUP 255 AND . 8 RSHIFT .  . CR ; )
( : >< DUP 8 RSHIFT SWAP 8 LSHIFT 65534 AND OR ; )

( --- Library --- )

: PC2!   ( b b p-addr -- ) ( Data byte A, high address byte B, port address C )
   SWAP >< OR PC! ;
: BIT    ( n -- ) ( define bit flag )
   1 SWAP LSHIFT CONSTANT ;
: BIT+    ( n -- n+1 ) ( define bit flag and next )
   DUP 1+ SWAP BIT ;

( --- SID chip access --- )

: SID!   ( b n0-31 -- ) ( Send byte to SID { 1data , 4?register | 2?interrupt } ) 
   2DUP 128 OR 84 PC2!
   2DUP 127 AND 84 PC2!
   128 OR 84 PC2! ;

( --- Voice selection --- )

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

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

CREATE >VOICE-BASE VOICE-BASES ,
CREATE >VOICE-CTL VOICE-CTLS ,

: VOICE   ( voice -- ) ( select SELECT voice )
   DUP  VOICE>BASE >VOICE-BASE !  VOICE>CTL >VOICE-CTL ! ;

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

0 BIT+ GATE
  BIT+ SYNC
  BIT+ RING
  BIT+ TEST
  BIT+ TRI
  BIT+ SAW
  BIT+ PWM
  BIT+ NOISE
DROP

( --- Voice register operation --- )

: VOICE!   ( b n -- ) ( Store byte in selected voice register n )
   >VOICE-BASE @ @ + SID! ;

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

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

( --- Other registers operation --- )

: CUTOFF!   ( n0-2047 -- ) ( Reg 21/22 - { 5?- | 11?filter-cutoff-frequency } )
   DUP 7 AND 21 SID! 3 RSHIFT 255 AND 22 SID! ;

( Reg 23 - { 4?filter-resonance [0-15] | 1?ext | 1?voice-2 | 1?voice-1 | 1?voice-0 } )
: RES   ( n0-15 -- b )   15 AND 4 LSHIFT ;
: VOICE-FILTER   ( voice -- b )  1 SWAP LSHIFT ;
3 BIT EXT-FILTER
: RES|FILTER!   ( b -- )  23 SID! ;

( Reg 24 - { 1?mute-voice-3 | 1?highpass | 1?bandpass | 1?lowpass | 4?volume )
: VOLUME   ( n0-15 -- b )  15 AND ;
4 BIT+ LOWPASS
  BIT+ BANDPASS
  BIT+ HIGHPASS
  BIT+ MUTE-VOICE3
DROP
: MODE|VOLUME!   24 SID! ;

( --- Frequency table --- )

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

: /OCTAVE   2* ;
: \OCTAVE   2/ ;

( --- Reset --- )

: VOICE-RESET   C4 FREQ!  2048 PWM!  0 CTL!  4 2 ATK|DEC!  10 9 SUS|REL! ;
: OTHER-RESET   1024 CUTOFF!  10 RES RES|FILTER!  15 VOLUME MODE|VOLUME! ;

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

( --- Music --- )

CREATE TEMPO 40000 ,
: NOTE\\   ( whole note ) TEMPO @ ;
: NOTE\   ( half note ) NOTE\\ 1 RSHIFT ;
: NOTE   ( quater note ) NOTE\\ 2 RSHIFT ;
: NOTE/   ( eight note ) NOTE\\ 3 RSHIFT ;
: NOTE//   ( 1/16 ) NOTE\\ 3 RSHIFT ;
: NOTE///   ( 1/32 ) NOTE\\ 3 RSHIFT ;

: DELAY   ( delay -- ) 0 DO LOOP ;
: PAUSE   ( delay -- ) DUP DELAY DELAY ;

: PLAY START DUP PAUSE STOP ;

( --- Test --- )

: SONG
   NOTE  B4 PLAY NOTE/ PAUSE
   NOTE  A4 PLAY NOTE/ PAUSE
   NOTE/ F4 PLAY NOTE/ G4 PLAY NOTE/ PAUSE
   NOTE  A4 PLAY NOTE/ PAUSE
   NOTE/ F4 PLAY NOTE/ G4 PLAY NOTE/ PAUSE
   NOTE  A4 PLAY NOTE/ PAUSE
   NOTE/ G4 PLAY NOTE/ F4 PLAY NOTE/ PAUSE
   NOTE  E4 PLAY NOTE/ PAUSE
   ;

SID-RESET

TRI CTL!   ( Select triangle waveform )
NOTE/ C4 PLAY
SONG SONG