Dim Shared As LongInt cpuclock = 1789773, samplerate = 44100, sampleticks = 1789773/44100
Dim Shared As Integer buflen, freqmod = 7402, bufpos = 0
Dim Shared As Byte cursample = 0, square1sample = 0, square2sample = 0, trianglesample = 0,_
	noisesample = 0, dmcsample = 0, gain = 1, tester = 0, square1=0, square2=0, triangle=0, noise=0,_
	tricounter = 0, counterstep = 4, curstep = 1, nosound

Dim Shared As Integer square1_duty = 0, square1_dutypos = 0, square1_loopenv = 0, square1_env = 15,_
	square1_disableenv = 0, square1_envperiod = 0, square1_enablesweep = 0, square1_period = 0,_
	square1_negative = 0, square1_shift = 0, square1counter = 0, square1_sweep = 0,_
	square1_length = 0, square1_enable = 0, square1_write = 0

Dim Shared As LongInt square1_timer = 1, square1_freq = 100000, s1t = 1

Dim Shared As Integer square2_duty = 0, square2_dutypos = 0, square2_loopenv = 0, square2_env = 15,_
	square2_disableenv = 0, square2_envperiod = 0, square2_enablesweep = 0, square2_period = 0,_
	square2_negative = 0, square2_shift = 0, square2counter = 0, square2_sweep = 0,_
	square2_length = 0, square2_enable = 0, square2_write = 0

Dim Shared As LongInt square2_timer = 1, square2_freq = 100000, s2t = 1

Dim Shared As Integer triangle_control = 0, triangle_counter = 0, triangle_length = 0, triangle_period = 0,_
	triangle_enable = 0, triangle_write = 0, triangle_halt = 0
Dim Shared As LongInt triangle_timer = 1, triangle_freq = 10000000

Dim Shared As Integer noise_loopenv = 0, noise_disableenv = 0, noise_envperiod = 0, noise_shortmode = 0,_
	noise_shift = 1, noise_period = 0, noise_length = 0, noise_write = 0, noise_halt = 0, noise_env = 0,_
	noise_enable = 0, noise_loop = 0, noise_origenv = 0
Dim Shared As LongInt noise_timer = 1

Dim Shared As Integer dmc_irqenable = 0, dmc_loop = 1, dmc_freqindex = 0, dmc_dac = 0, dmc_addr = 0,_
	dmc_length = 0, dmc_enable = 0

Dim Shared As Integer lengthcounterenable = 1, dmclen = 1, noiselen = 1, trianglelen = 1, square1len = 1, square2len = 1

Dim Shared As Integer frameinterrupt = 0

Dim Shared As Integer squarelookup(32), otherlookup(204)

Dim Shared As UByte lengthtable(&h20) => {_
	10,254, 20,  2, 40,  4, 80,  6, 160,  8, 60, 10, 14, 12, 26, 14,_
	12, 16, 24, 18, 48, 20, 96, 22, 192, 24, 72, 26, 16, 28, 32, 30 }


Dim Shared As Integer noisefreq(&h10) => {_
	4, 8, 16, 32, 64, 96, 128, 160, 202,_
	254, 380, 508, 762, 1016, 2034, 4068 }

Dim Shared As UByte tritable(32) => {_
	8, 9, 10, 11, 12, 13, 14, 15, 15, 14, 13, 12, 11, 10, 9 ,8,_
   7, 6, 5, 4, 3, 2, 1, 0, 0, 1, 2, 3, 4, 5, 6, 7 }

Dim Shared As UByte duty0(16) => { 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }
Dim Shared As UByte duty1(16) => { 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }
Dim Shared As UByte duty2(16) => { 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0 }
Dim Shared As UByte duty3(16) => { 1, 1, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1 }

Dim Shared buf(1, 44100) As Byte

Function APUreadregs(ByVal addr As UShort) As Integer
     Dim tmpstatus As Integer
     tmpstatus = dmc_irqenable*128 + frameinterrupt*64
     if (dmc_length) Then tmpstatus = tmpstatus + 16
     if (triangle_length) Then tmpstatus = tmpstatus + 4
     If (square2_length) Then tmpstatus = tmpstatus + 2
     If (square1_length) then tmpstatus = tmpstatus + 1
     APUreadregs = tmpstatus
End Function

Sub APUwriteregs(ByVal addr As UShort, ByVal value As UByte)
     Select Case As Const (addr)
            'START SQUARE 1 HERE
     	case &h4000:
                 square1_duty = value Shr 6
                 if (value And 32) Then square1_disableenv = 1 else square1_disableenv = 0                 
                 square1_env = value And &hF
                 square1_env = square1_env + ((value Shr 1) And &h10)
                 
     	case &h4001:
                 if (value And 128) Then square1_enablesweep = 1 else square1_enablesweep = 0
                 square1_sweep = ((value Shr 4) And 7)+1
                 if (value And &h10) Then square1_negative = 1 else square1_negative = 0
                 square1_shift = value And 7
                 
     	case &h4002:
                 square1_timer = (square1_timer  And  &hF00) + value
                 
     	case &h4003:
                 square1_length = lengthtable(value Shr 3)
                 square1_timer = (square1_timer And &hFF) + ((value And &h7) Shl 8)
                 square1_dutypos = 0
                 
            'START SQUARE 2 HERE
     	case &h4004:
                 square2_duty = value Shr 6
                 if (value And 32) Then square2_disableenv = 1 else square2_disableenv = 0                 
                 square2_env = value And &hF
                 square2_env = square2_env + ((value Shr 1) And &h10)
                 
     	case &h4005:
                 if (value And 128) Then square2_enablesweep = 1 else square2_enablesweep = 0
                 square2_sweep = ((value Shr 4) And 7)+1
                 if (value And &h10) Then square2_negative = 1 else square2_negative = 0
                 square2_shift = value And 7
                 
     	case &h4006:
                 square2_timer = (square2_timer  And  &hF00) + value
                 
     	case &h4007:
                 square2_length = lengthtable(value Shr 3)
                 square2_timer = (square2_timer And &hFF) + ((value And &h7) Shl 8)
                 square2_dutypos = 0
                 
            'START TRIANGLE HERE
     	case &h4008:
                 triangle_halt = value And &h80 Shr 7
                 if (triangle_control=0) Then triangle_halt = 1
                 triangle_counter = value And &h7F
                 
     	case &h400A:
                 triangle_timer = (triangle_timer And &hF00) + value
                 
     	case &h400B:
                 triangle_timer = (triangle_timer And &hFF) + ((value And &h7) Shl 8)
                 triangle_length = lengthtable(value Shr 3)
                 triangle_freq = cpuclock / (32*(triangle_timer)+1)
                 triangle_halt = 1
                 
            'START NOISE HERE
     	case &h400C:
                 if (value And 32) Then noise_halt = 1 else noise_halt = 0
                 noise_env = value And &h1F
                 noise_origenv = noise_env
                 
     	case &h400E:
                 if (value And 128) Then noise_loop = 1 else noise_loop = 0
                 noise_timer = noisefreq(value And &hF)
                 
     	case &h400F:
                 noise_length = lengthtable(value Shr 3)
                 noise_env = noise_origenv
                 
     	case &h4015:
                 if (value And 1) Then square1_enable = 1 else square1_enable = 0
                 if (value And 2) Then square2_enable = 1 else square2_enable = 0
                 if (value And 4) Then triangle_enable = 1 else triangle_enable = 0
                 if (value And 8) Then noise_enable = 1 else noise_enable = 0
                 if (value And 16) Then dmc_enable = 1 else dmc_enable = 0
                             
     	case &h4017:
                 if (value And &h80) Then counterstep = 5 else counterstep = 4
                 curstep = 1
                 
     End Select
End Sub

Sub putinbuf()     
     buf(0, bufpos) = cursample
     bufpos = bufpos + 1
     If (bufpos=buflen) Then
     		For dblbuf = 0 To buflen-1
     			buf(1, dblbuf) = buf(0, dblbuf)
     		Next dblbuf
     		bufpos = 0
     End If
     'Put #2, , cursample
End Sub

Sub square1_clock()     
     if ((square1_enable=1) And (square1_length>0)) Then
     if (square1_disableenv=1) Then square1_env = &hF
       Select case (square1_duty)
       	case 0: if (duty0(square1_dutypos)) Then square1sample = square1_env else square1sample = 0
       	case 1: if (duty1(square1_dutypos)) Then square1sample = square1_env else square1sample = 0
       	case 2: if (duty2(square1_dutypos)) Then square1sample = square1_env else square1sample = 0
       	case 3: if (duty3(square1_dutypos)) Then square1sample = -1*square1_env else square1sample = 0
       End Select
       square1_dutypos = (square1_dutypos + 1) Mod 16
     Else
     	square1sample = 0
     End If
End Sub

Sub square2_clock() 
     if ((square2_enable=1) and (square2_length>0)) Then
     if (square2_disableenv=1) Then square2_env = &hF
       Select Case (square2_duty)
       	case 0: if (duty0(square2_dutypos)) Then square2sample = square2_env else square2sample = 0
       	case 1: if (duty1(square2_dutypos)) Then square2sample = square2_env else square2sample = 0
       	case 2: if (duty2(square2_dutypos)) Then square2sample = square2_env else square2sample = 0
       	case 3: if (duty3(square2_dutypos)) Then square2sample = -1*square2_env else square2sample = 0
       End Select
       square2_dutypos = (square2_dutypos + 1) Mod 16
     Else
     		square2sample = 0
     End If
End Sub

Sub triangle_clock()
     if ((triangle_enable=0) or (triangle_length<=0)) Then Exit Sub
     trianglesample = tritable(tricounter)
     if (trianglesample>15) Then trianglesample = 31 - trianglesample
     tricounter = (tricounter + 1) mod 32
End Sub

sub noise_clock()
  dim feedback, tmpbit As Integer
  if (noise_loop) Then
    if (noise_shift And 64) Then tmpbit = 1 else tmpbit = 0
    feedback = (noise_shift And 1) Xor tmpbit
  Else
    if (noise_shift And 2) Then tmpbit = 1 else tmpbit = 0
    feedback = (noise_shift And 1) Xor tmpbit
  End If
  noise_shift = (noise_shift Shr 1) + (feedback Shl 13)
  if ((noise_enable) and (noise_length>0) and ((noise_shift And 1)=0) and (noise_timer>=8)) Then
  		noisesample = noise_env
  Else
  		noisesample = 0
  End If
End Sub

Sub APU_frame_seq_tick()
     if (counterstep=4) Then
        if (triangle_length>0) Then triangle_length = triangle_length - 1
        if (square1_length>0) Then square1_length = square1_length - 1
        if (square2_length>0) Then square2_length = square2_length - 1
        if (noise_length>0) Then noise_length = noise_length - 1
        if ((curstep=4) And ((flag_reg And 4)=0)) Then flag_reg = flag_reg or &h14
        if (square1_sweep>0) Then square1_sweep = square1_sweep - 1
        if (square2_sweep>0) Then square2_sweep = square2_sweep - 1
        
        if ((square1_negative=1) and (square1_enablesweep=1) and (square1_sweep>0) and (curstep<5)) Then
        		square1_timer = square1_timer - (square1_timer Shr square1_shift)
        ElseIf ((curstep<5) And (square1_enablesweep=1) and (square1_sweep>0)) Then
        		square1_timer = square1_timer + (square1_timer Shr square1_shift)
        End If
        if ((square2_negative=1) and (square2_enablesweep=1) and (square2_sweep>0) and (curstep<5)) Then
        		square2_timer = square2_timer - (square2_timer Shr square2_shift)
        ElseIf ((curstep<5) and (square2_enablesweep=1) and (square2_sweep>0)) Then
        	square2_timer = square2_timer + (square2_timer Shr square2_shift)
        End If
     End If
     
     curstep = (curstep+1) mod counterstep
End Sub

Sub fillaudio Cdecl (ByVal userdata As Any Ptr, ByVal audbuffer As UByte Ptr, ByVal audlen As Integer)
	'Dim As Single stretchratio
	'stretchratio = Cast(Single, audlen-1) / Cast(Single, bufpos)
	Dim As UByte Ptr audbyte
	For n = 0 To audlen-1 Step 2
		audbyte = audbuffer+n+1
		*audbyte = buf(1, n\2) 'buf(n/stretchratio)
	Next n
	'bufpos = 0
End Sub
