Code: Select all
;{
ProgName.s=GetFilePart(ProgramFilename())
a = CreateSemaphore_(#Null,0,1,@ProgName)
If a<>0 And GetLastError_()=#ERROR_ALREADY_EXISTS
CloseHandle_(a)
End
EndIf
;}
Enumeration
#Window
#PathString
#OpenButton
#File
#Text
EndEnumeration
DeclareModule SN76489
Declare SN76489()
Declare Clock(freq.l)
Declare Reset()
Declare Render(*buf, len.l)
Declare Write(val.a)
EndDeclareModule
Module SN76489
#MONO_RENDER = #True
EnableExplicit
DisableDebugger
EnableASM
;- Structures
Structure SN76489_State
ticksCount.l ; offset 0
ticksPerSample.l ; offset 4
vol.a[4] ; offset 8
div.u[4] ; offset 12
cnt.w[4] ; offset 20
out.w[4] ; offset 28
noiseLFSR.u ; offset 36
noiseTap.u ; offset 38
latchedChan.u ; offset 40
latchedVol.u ; offset 42
vt.u[32] ; offset 44
EndStructure
;-Global variables
Global SN76489_State.SN76489_State
;- Render core
CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
Macro rax : eax : EndMacro
Macro rbx : ebx : EndMacro
Macro rdx : edx : EndMacro
Macro rdi : edi : EndMacro
CompilerEndIf
Macro M_Channel(channel)
sub word [rdx + 20 + channel * 2], 1 ; cnt - 1
!jnc .c1#channel ; cnt < 0 => c1#channel
movzx ecx, word [rdx + 12 + channel * 2] ; get div
CompilerIf channel = 3
!and ecx, 3
!mov eax, 0x10
!shl al, cl
!jns .n0
movzx eax, word [rdx + 16] ; get divC
!shl eax, 1 ; divC << 1
!.n0:
mov ecx, eax ; ecx = cntD
movzx eax, word [rdx + 36] ; get noiseLFSR
cmp word [rdx + 38], 9 ; noiseTap 9 => .n1
!jne .n1
!and eax, 9 ; tap & 9
!xor al, ah ; get parity
!setnp al
!.n1:
!and eax, 1
!shl eax, 16
add ax, [rdx + 36]
!shr eax, 1
mov [rdx + 36], ax ; update noiseLFSR
!xor eax, 1
!shl eax, 12
mov al, [rdx + 11] ; get volD
!and al, 15
!or al, ah
!and eax, 31
CompilerElse
!cmp ecx, 1 ; div <= 1 => c0#channel
!jna .c0#channel
movzx eax, byte [rdx + 8 + channel] ; get vol
!xor eax, 16 ; vol ! 16
CompilerEndIf
mov [rdx + 8 + channel], al ; set vol
movzx eax, word [rdx + 44 + rax * 2] ; lookup vol in table
mov [rdx + 28 + channel * 2], ax ; out = lookup value
!.c0#channel:
mov [rdx + 20 + channel * 2], cx ; set cnt
!.c1#channel:
EndMacro
Macro M_ChannelOut(channel)
movsx ecx, word [rdx + 28 + channel * 2]
add eax, ecx
imul ecx, 0xfe00
sar ecx, 16
mov [rdx + 28 + channel * 2], cx
EndMacro
Procedure Render(*buf, len.l)
!mov ecx, [p.v_len]
!test ecx, ecx
!jz .exit
mov rax, *buf
mov rdx, SN76489_State
push rbx
push rdi
mov rdi, rax
mov ebx, ecx
!.rloop:
M_Channel(0)
M_Channel(1)
M_Channel(2)
M_Channel(3)
sub dword [rdx], 0x01000000 ; update ticksCount
!ja .rloop
mov eax, [rdx + 4] ; ticksCount+=ticksPerSample
add [rdx], eax
sub eax, eax
M_ChannelOut(0)
M_ChannelOut(1)
M_ChannelOut(2)
M_ChannelOut(3)
!sar eax, 1
cmp eax, 32768
!jl .clip0
mov eax, 32767 ; clip output
!jmp .clip1
!.clip0:
cmp eax,-32768
!jg .clip1
mov eax,-32767
!.clip1:
mov [rdi], ax ; write samples
CompilerIf #MONO_RENDER
add rdi, 2
CompilerElse
mov [rdi + 2], ax
add rdi, 4
CompilerEndIf
sub ebx ,1
!jnz .rloop
pop rdi
pop rbx
!.exit:
EndProcedure
;- Other procedures
Procedure Clock(freq.l)
!mov eax, [p.v_freq]
!cdq
!mov ecx, 0x01000000
!mul ecx
!mov ecx, 16 * 44100
!div ecx
mov rdx, SN76489_State
mov [rdx + 4], eax
EndProcedure
Procedure Reset()
FillMemory(@SN76489_State\vol[0], 4, 15) ; reset volume
FillMemory(@SN76489_State\div[0], 32) ; clear rest of state
SN76489_State\noiseLFSR = $f037
SN76489_State\ticksCount = SN76489_State\ticksPerSample
EndProcedure
Procedure SN76489()
Protected i.i, delitmer.i
;- DELETE IT
;MY ADDITIONAL - SET DELITMER TO 1 FOR ORIGIMAL VOLUME
;i think / 4 will avoid clip cases, when all 4 channel have
;max value after mixing channels. maybe i am wrong, as always :)
delitmer = 4
With SN76489_State
\vt[0] = 32767 / delitmer : \vt[1] = 26028 / delitmer : \vt[2] = 20675 / delitmer
\vt[3] = 16422 / delitmer : \vt[4] = 13045 / delitmer : \vt[5] = 10362 / delitmer
\vt[6] = 8231 / delitmer : \vt[7] = 6568 / delitmer : \vt[8] = 5193 / delitmer
\vt[9] = 4125 / delitmer : \vt[10] = 3277 / delitmer : \vt[11] = 2603 / delitmer
\vt[12] = 2067 / delitmer : \vt[13] = 1642 / delitmer : \vt[14] = 1304 / delitmer
\vt[15] = 0
For i = 0 To 15
\vt[i + 16] = -\vt[i]
Next
EndWith
Clock(3579545)
Reset()
EndProcedure
Procedure Write(val.a)
Protected.u chan, cdiv, div, vol
If val & $80
chan = val >> 5 & 3
cdiv = SN76489_State\div[chan] & $fff0 | (val & $f)
SN76489_State\latchedChan = chan
SN76489_State\latchedVol = val >> 4 & 1
Else
chan = SN76489_State\latchedChan
cdiv = SN76489_State\div[chan] & $f | (val << 4 & $3f0)
EndIf
If SN76489_State\latchedVol
SN76489_State\vol[chan] = SN76489_State\vol[chan] & $10 | (val & $f)
Else
SN76489_State\div[chan] = cdiv
If chan = 3
SN76489_State\noiseTap = cdiv << 1 & 8 + 1
SN76489_State\noiseLFSR = $8000
EndIf
EndIf
EndProcedure
EndModule
UseModule SN76489
SN76489()
#PSG_BUFFERS = 4
Global Dim wavebuf.w(#PSG_BUFFERS - 1, 1023)
Global Dim wavehdr.WAVEHDR(#PSG_BUFFERS - 1)
Global.i PSG_Unit, WMME_Playing
DataSection
PCM16BitSigned:
Data.w 1,1,$AC44,0,$5888,1,2,16,0
EndDataSection
Procedure WMME_Callback(hwo, uMsg, dwInstance, *wavehdr.WAVEHDR, dwParam2)
If WMME_Playing And uMSG = #WOM_DONE
Render(*wavehdr\lpData, 1024)
waveOutWrite_(hwo, *wavehdr, SizeOf(WAVEHDR))
EndIf
EndProcedure
Procedure PSG_Terminate()
Protected i.i
If PSG_Unit
WMME_Playing = #False
waveOutReset_(PSG_Unit)
While i < #PSG_BUFFERS
waveOutUnprepareHeader_(PSG_Unit, @wavehdr(i), SizeOf(WAVEHDR))
i + 1
Wend
waveOutClose_(PSG_Unit)
PSG_Unit = 0
EndIf
EndProcedure
Procedure PSG_Init()
If waveOutOpen_(@PSG_Unit, #WAVE_MAPPER, ?PCM16BitSigned, @WMME_Callback(), 0, #CALLBACK_FUNCTION)
MessageRequester("Error", "Unable to initialize PSG")
Else
While i < #PSG_BUFFERS
wavehdr(i)\lpData = @wavebuf(i, 0)
wavehdr(i)\dwBufferLength = 2048
waveOutPrepareHeader_(PSG_Unit, @wavehdr(i), SizeOf(WAVEHDR))
waveOutWrite_(PSG_Unit, @wavehdr(i), SizeOf(WAVEHDR))
i + 1
Wend
WMME_Playing = #True
EndIf
EndProcedure
PSG_Init()
;Procedure Spam(*Value)
;
; Repeat
;
; XIncludeFile "spam.pb"
;
; ForEver
;
;EndProcedure
;CreateThread(@Spam(), 154)
Structure VGMFSt
type.i
reg.a
val.a
pause.u
samplenum.a
sampleadress.i
samplesize.i
summofpauses.i
EndStructure
Global Dim VGMARR.VGMFSt(0)
Global TormozFlag = 1
Global PlThr
;{
Macro SetBit(Var, Bit)
Var | (Bit)
EndMacro
Macro ClearBit(Var, Bit)
Var & (~(Bit))
EndMacro
Macro TestBit(Var, Bit)
Bool(Var & (Bit))
EndMacro
Macro NumToBit(Num)
(1<<(Num))
EndMacro
Macro GetBits(Var, StartPos, EndPos)
((Var>>(StartPos))&(NumToBit((EndPos)-(StartPos)+1)-1))
EndMacro
;}
Procedure Play(*Value)
PlayedTicks.i = 0
PlayedUS.i = 0
CurrentUS.i = 0
StartMS.i = ElapsedMilliseconds()
For i = start To ArraySize(VGMARR())-1
Select VGMARR(i)\type
Case 3 ; pauses
PlayedTicks + VGMARR(i)\pause
PlayedUS = PlayedTicks * 22.675736961;90.702947844;22.675736961
While (CurrentUS < PlayedUS)
Delay(1)
CurrentUS.i = (ElapsedMilliseconds() - StartMS) * 1000
Wend
Case 5 ; PSG
Write(VGMARR(i)\val)
EndSelect
If TormozFlag
Break
EndIf
Next
EndProcedure
Procedure ParsePlay(*FileMem)
memsize = MemorySize(*FileMem)
;get version of vgm
ver$ = ""
tmp = PeekA(*FileMem + 11)
ver$ = Str(GetBits(tmp, 4, 7))
ver$ + Str(GetBits(tmp, 0, 3))
tmp = PeekA(*FileMem + 10)
ver$ + Str(GetBits(tmp, 4, 7))
ver$ + Str(GetBits(tmp, 0, 3))
tmp = PeekA(*FileMem + 9)
ver$ + Str(GetBits(tmp, 4, 7))
ver$ + Str(GetBits(tmp, 0, 3))
tmp = PeekA(*FileMem + 8)
ver$ + Str(GetBits(tmp, 4, 7))
ver$ + Str(GetBits(tmp, 0, 3))
If Val(ver$) < 151
ot = *FileMem + 64 ; 64 - it is vgm header. no need it yet
Else
ot = *FileMem + 256
EndIf
do = *FileMem + memsize
; create array with size as filesize. array will get less size, than file, but it is ok
Dim VGMARR(memsize)
Number.a = 0
PSGvalue.a
Arrayind = 0
For i = ot To do
Number = PeekA(i)
Select Number
Case $67 ; 0x67 0x66 tt ss ss ss ss (data)
; it is big wav data block
; get size of wav data block
WavDataSize = PeekI(i + 3)
; get adress of wav data block
WavAddres = i + 7
; jump to end of wav data block
i + 6 + WavDataSize
Case $52 ; $52 - register +0
i+2
Case $53 ; $53 - register +256
i+2
Case $61 ; $61 - can range from 0 to 65535 (approx 1.49 seconds)
VGMARR(Arrayind)\type = 3
VGMARR(Arrayind)\pause = PeekU(i + 1)
If flagpausehunt
VGMARR(numforsizecount)\summofpauses + VGMARR(Arrayind)\pause
flagpausehunt = 0
EndIf
Arrayind + 1
i+2
Case $70 To $7F ; wait n+1 samples, n can range from 0 to 15.
VGMARR(Arrayind)\type = 3
VGMARR(Arrayind)\pause = ((Number - $70) + 1)
If flagpausehunt
VGMARR(numforsizecount)\summofpauses + VGMARR(Arrayind)\pause
flagpausehunt = 0
EndIf
Arrayind + 1
Case $E0 ; 0xE0 dddddddd seek to offset dddddddd (Intel byte order) in PCM data bank
;jump far
i + 4
Case $80 To $8F
flagpausehunt = 1
If Number > $80
VGMARR(Arrayind)\type = 3
VGMARR(Arrayind)\pause = (Number - $80)
VGMARR(numforsizecount)\summofpauses + VGMARR(Arrayind)\pause
Arrayind + 1
EndIf
Case $4F ; 0x4F dd Game Gear PSG stereo, write dd to port 0x06 ; dune with samples
; ignore, just jump far
i + 1
;MAIN COMMAND :))
Case $50 ; 0x50 dd PSG (SN76489/SN76496) write value dd ; dune with samples
i + 1
PSGvalue = PeekA(i)
VGMARR(Arrayind)\type = 5
VGMARR(Arrayind)\val = PSGvalue
Arrayind + 1
Case $62 ; wait 735 samples (60th of a second), a shortcut for 0x61 0xdf 0x02 ; Lego Tune
VGMARR(Arrayind)\type = 3
VGMARR(Arrayind)\pause = 735
If flagpausehunt
VGMARR(numforsizecount)\summofpauses + VGMARR(Arrayind)\pause
flagpausehunt = 0
EndIf
Arrayind + 1
Case $63 ; wait 882 samples (50th of a second), a shortcut For 0x61 0x72 0x03
VGMARR(Arrayind)\type = 3
VGMARR(Arrayind)\pause = 882
If flagpausehunt
VGMARR(numforsizecount)\summofpauses + VGMARR(Arrayind)\pause
flagpausehunt = 0
EndIf
Arrayind + 1
Case $66 ; end of sound
Debug "end"
Break
EndSelect
Next
Play(0)
EndProcedure
If OpenWindow(#Window, 100, 200, 195, 260, "PureBasic Window", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget)
StringGadget(#PathString, 10, 20, 120, 20, "", #PB_String_ReadOnly)
ButtonGadget(#OpenButton, 130, 20, 50, 20, "open")
TextGadget(#Text, 10, 40, 170, 80, "WARNING! VGZ must be unpacked by manualy into VGM (7z can do this. i cant plug zlib yet). and see what chips was used by this VGM. it plays only SN76489. YM2612 is ignored. any VGM with other chips can crash programm.")
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventGadget()
;- Event
Case #OpenButton
If File$
StandardFile$ = GetPathPart(File$)
Else
StandardFile$ = "C:\" ; initial path + file
EndIf
Pattern$ = "VGM files (*.vgm)|*.vgm;";*.vgz|" ; set first pattern (index = 0)
Pattern = 0 ; use the second of the five possible patterns as standard
; Now we open a filerequester, you can change the pattern and will get the index after closing
File$ = OpenFileRequester("Please choose file to load", StandardFile$, Pattern$, Pattern)
If File$
SetGadgetText(#PathString, File$)
If ReadFile(#File, File$)
length = Lof(#File) ; get the length of opened file
If *MemoryID
FreeMemory(*MemoryID)
*MemoryID = 0
EndIf
*MemoryID = AllocateMemory(length) ; allocate the needed memory
If *MemoryID
bytes = ReadData(#File, *MemoryID, length) ; read all data into the memory block
EndIf
CloseFile(#File)
TormozFlag = 0
PlThr = CreateThread(@ParsePlay(), *MemoryID)
EndIf
EndIf
EndSelect
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
EndIf
End