PSG Module (including Music Macro Language)

[wilbert]

With some feedback from J. Baker I created this PSG module.
It's a sound generator with a retro sound and basic Music Macro Language.
The main focus has been the retro sound and using up little system resources so it can run in the background.

Requirements :
- a cpu capable of handling first generation sse instructions. (unless your computer is 15+ years old, it most likely has support for sse)
- on Linux you need PortAudio. On OS X and Windows the use of PortAudio is optionally.

The module code

Code: Select all

; PSG module by Wilbert

; Requirements : SSE, PortAudio on Linux

; Last updated : March 22, 2021


; r         rest (if number follows, rest length)
; cdefgab   note names (if number follows, note length)
; + or #    sharp
; -         flat
; .         increase note length by half
; <         octave - 1
; >         octave + 1
; o         octave (0 - 8)
; k         transpose (-24 - +24)
; l         note length (1 - 32)
; t         tempo (0 - 15)
; v         volume (0 - 63)
; v+        increase volume
; v-        decrease volume
; w         waveform (0 = triangle, 1 = sawtooth, 2 and 3 are complex waves, 4 = square)
; \         decay speed (0 = no decay) or comma separated envelope setting
; *         post event (number can be retrieved with EventData() ) 
; :         loop

; channel 0 can be used for noise with waveform w5

; t0  =  40 BPM
; t6  =  60 BPM
; t9  =  80 BPM
; t10 =  90 BPM
; t11 = 103 BPM
; t12 = 120 BPM
; t13 = 144 BPM
; t14 = 180 BPM
; t15 = 240 BPM

DeclareModule PSG
  
  CompilerIf #PB_Event_FirstCustomValue >= $4D4D4C20
    ; if 'MML ' is not a valid custom event, use this
    #MML_Event = #PB_Event_FirstCustomValue + 459    
  CompilerElse
    ; preferably the FourCC code 'MML ' is used.
    #MML_Event = $4D4D4C20; 'MML '
  CompilerEndIf
  
  #MML_NoChange = ":"
  
  Structure MML_Info
    EvtCnt.l          ; event counter
    Tempo.l           ; tempo setting
    Octave.l          ; current octave
    Transpose.l       ; transpose value
    NoteLen.l         ; current note length
    Volume.l          ; current volume
    Waveform.l        ; current waveform
    Decay.l           ; current decay value
  EndStructure  
  
  Declare   PSG_Terminate()
  Declare   PSG_Init()
  Declare.i PSG_IsPlayingMML()
  Declare   PSG_PlayMML(Channel0.s, Channel1.s = "", Channel2.s = "", Channel3.s = "")
  Declare.i PSG_GetInfoMML(*MMLString, Position, *MML_Info.MML_Info)
  Declare   PSG_SetMasterVolume(Volume.f = 1.0)
  Declare   PSG_Sound(Channel.a, Frequency.f, Volume.a, Waveform.a = 0)
  
  Declare   PSG_StartWaveRecord(FileName.s, AutoStop = #False); only functional when #ENABLE_WAVE_RECORD is set to #True
  Declare   PSG_StopWaveRecord()
  
EndDeclareModule

Module PSG
  
  #ALWAYS_USE_PORTAUDIO = #False; Setting to force the use of PortAudio on OS X and Windows
  
  #ENABLE_WAVE_RECORD = #True
  
  CompilerIf #PB_Compiler_OS = #PB_OS_Windows
    CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
      #PSG_PORTAUDIO = "portaudio_x86.lib"
    CompilerElse
      #PSG_PORTAUDIO = "portaudio_x64.lib"
    CompilerEndIf    
  CompilerElse
    #PSG_PORTAUDIO = "-lportaudio"
  CompilerEndIf
  
  EnableASM
  EnableExplicit
  DisableDebugger
  
  ; *** OS specific ***
  
  Global PSG_Unit.i 
  
  DeclareC PSG_Core(arg1, arg2, arg3, arg4, arg5, arg6)
  Declare PSG_SetDefaults()
  
  CompilerIf #ALWAYS_USE_PORTAUDIO Or #PB_Compiler_OS = #PB_OS_Linux
    
    #PSG_FLOAT32 = #True
    
    ImportC #PSG_PORTAUDIO
      Pa_CloseStream(*stream)
      Pa_Initialize()
      Pa_OpenDefaultStream(*stream, numInputChannels, numOutputChannels, sampleFormat, sampleRate.d, framesPerBuffer, *streamCallback, *user_data)
      Pa_StartStream(*stream)
      Pa_Terminate()
    EndImport
    
    Procedure PSG_Init()
      PSG_Terminate()
      PSG_SetDefaults()
      If Pa_Initialize() Or Pa_OpenDefaultStream(@PSG_Unit, 0, 1, 1, 44100, 0, @PSG_Core(), 0) Or Pa_StartStream(PSG_Unit)
        PSG_Terminate()
        MessageRequester("Error", "Unable to initialize PSG")
      EndIf
    EndProcedure
    
    Procedure PSG_Terminate()
      If PSG_Unit
        Pa_CloseStream(PSG_Unit)
        Pa_Terminate()
        PSG_Unit = 0
      EndIf
    EndProcedure  
    
  CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows
    
    #PSG_FLOAT32 = #False
    #PSG_BUFFERS = 4
    
    Global Dim wavebuf.w(#PSG_BUFFERS - 1, 1023)
    Global Dim wavehdr.WAVEHDR(#PSG_BUFFERS - 1)
    Global WMME_Playing.i
    
    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
        PSG_Core(0, *wavehdr\lpData, 1024, 0, 0, 0)
        waveOutWrite_(hwo, *wavehdr, SizeOf(WAVEHDR))
      EndIf
    EndProcedure
    
    Procedure PSG_Init()
      Protected i.i
      PSG_Terminate()
      PSG_SetDefaults()
      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
    
    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  
    
  CompilerElse
    
    #PSG_FLOAT32 = #True
    
    ImportC "-framework AudioUnit"
      AudioComponentFindNext(inComponent, *inDesc)
      AudioComponentInstanceNew(inComponent, *outInstance)
      AudioComponentInstanceDispose(inInstance)
      AudioOutputUnitStart(ci)
      AudioOutputUnitStop(ci)
      AudioUnitInitialize(inUnit)
      AudioUnitUninitialize(inUnit)
      AudioUnitSetProperty(inUnit, inID, inScope, inElement, *inData, inDataSize)
    EndImport
    
    DataSection
      dOut:
      Data.l $61756f75,$64656620,$6170706c,0,0
      CallbackStruct:
      Data.i @PSG_Core(), 0    
      PCM32BitFloat:
      Data.l 0,$40E58880,$6C70636D,1,4,1,4,1,32,0
    EndDataSection
    
    Procedure PSG_Init()
      Protected BufferSize.l = 2048
      PSG_Terminate()
      PSG_SetDefaults()
      AudioComponentInstanceNew(AudioComponentFindNext(#Null, ?dOut), @PSG_Unit)
      AudioUnitSetProperty(PSG_Unit, 23, 1, 0, ?CallBackStruct, SizeOf(Integer) << 1)
      AudioUnitSetProperty(PSG_Unit, 8, 1, 0, ?PCM32BitFloat, 40)
      AudioUnitSetProperty(PSG_Unit, $6673697a, 1, 0, @BufferSize, 4)
      AudioUnitInitialize(PSG_Unit)
      If AudioOutputUnitStart(PSG_Unit)
        PSG_Terminate()
        MessageRequester("Error", "Unable to initialize PSG")
      EndIf
    EndProcedure
    
    Procedure PSG_Terminate()
      If PSG_Unit
        AudioOutputUnitStop(PSG_Unit)
        AudioUnitUninitialize(PSG_Unit)
        AudioComponentInstanceDispose(PSG_Unit)
        PSG_Unit = 0
      EndIf
    EndProcedure
    
  CompilerEndIf
  
  ; *** End of OS specific ***
  
  ; *** PSG Core ***
  
  Structure PSGInternal
    phase.f[4]            ; [0x00] phase
    phase_add.f[4]
    wave_mask.l[4]
    vmul.f[4]             ; [0x30] volume multiplier
    tmp.f[4]              ; [0x40]
    xmm6_backup.f[4]      ; [0x50] 
    xmm7_backup.f[4]      ; [0x60]
    vol_change_speed.f[4] ; [0x70]
    mastervolume.f        ; [0x80]
    interrupt_cnt.l       ; [0x84]
  EndStructure
  
  Global Dim PSGIntMem.a(SizeOf(PSGInternal) + 15)
  Global *internal.PSGInternal = (@PSGIntMem() + 15) & -16
  Global prng.l = 1, rcp44100.f = PeekF(?Rcp44100)
  Global.i reg_bx, reg_di, reg_si
  
  CompilerIf #ENABLE_WAVE_RECORD
    
    DataSection
      WaveHeader:
      Data.l $46464952,0,$45564157,$20746D66,$10,$10001,$AC44,$15888,$100002,$61746164,0
    EndDataSection
    
    Global Dim record_buffer.a(524288 - 1)
    Global auto_stop.i, stop_record_idx.l
    Global wave_file.i, stop_recording.l, record_buffer_idx.l, *record_buffer = @record_buffer()
    
    Procedure Thread_WriteWaveData(*value)
      Protected Dim Buffer459.w(458)
      Protected.l idx, prev_idx, stop_flag, flen
      Protected.f vmul = 1
      Repeat
        Delay(100)
        stop_flag = stop_recording
        If IsFile(wave_file)
          If stop_flag
            If (stop_record_idx ! prev_idx) & $40000
              WriteData(wave_file, *record_buffer + (prev_idx & $40000), $40000)
            EndIf            
            WriteData(wave_file, *record_buffer + (stop_record_idx & $40000), stop_record_idx & $3ffff)
            
            flen = Lof(wave_file)
            If flen >= 962
              FileSeek(wave_file, flen - 918)
              ReadData(wave_file, @Buffer459(), 918)
              For idx = 0 To 458
                vmul * 0.988
                Buffer459(idx) * vmul
              Next
              FileSeek(wave_file, flen - 918)
              WriteData(wave_file, @Buffer459(), 918)
            EndIf
            
          Else
            idx = record_buffer_idx
            If (idx ! prev_idx) & $40000
              WriteData(wave_file, *record_buffer + (prev_idx & $40000), $40000)
              prev_idx = idx
            EndIf
          EndIf
        Else
          stop_flag = #True
        EndIf
      Until stop_flag
      If IsFile(wave_file)
        flen = Lof(wave_file)
        FileSeek(wave_file, 4) : WriteLong(wave_file, flen - 8)
        FileSeek(wave_file, 40) : WriteLong(wave_file, flen - 44)
        CloseFile(wave_file)
      EndIf
      stop_recording = #False
    EndProcedure
    
  CompilerEndIf
  
  Procedure PSG_StopWaveRecord()
    CompilerIf #ENABLE_WAVE_RECORD      
      auto_stop = #False
      If IsFile(wave_file)
        stop_record_idx = record_buffer_idx
        stop_recording = #True
        Repeat
          Delay(10)
        Until stop_recording = #False
      EndIf
    CompilerEndIf
  EndProcedure    
  
  Procedure PSG_StartWaveRecord(FileName.s, AutoStop = #False)
    CompilerIf #ENABLE_WAVE_RECORD
      PSG_StopWaveRecord()
      auto_stop = AutoStop
      wave_file = CreateFile(#PB_Any, FileName)
      If wave_file
        WriteData(wave_file, ?WaveHeader, 44)
        record_buffer_idx = 0        
        CreateThread(@Thread_WriteWaveData(), 0)
      EndIf
    CompilerEndIf
  EndProcedure
  
  Declare MML_Interrupt()
  
  CompilerIf #PB_Compiler_Processor = #PB_Processor_x86
    Macro rax : eax : EndMacro
    Macro rbx : ebx : EndMacro   
    Macro rcx : ecx : EndMacro
    Macro rdx : edx : EndMacro
    Macro rdi : edi : EndMacro
    Macro rsi : esi : EndMacro
  CompilerEndIf  
  Macro M_movaps(arg1, arg2)
    !movaps arg1, arg2
  EndMacro
  Macro M_movups(arg1, arg2)
    !movups arg1, arg2
  EndMacro
  Macro M_movlps(arg1, arg2)
    !movlps arg1, arg2
  EndMacro
  Macro M_movss(arg1, arg2)
    !movss arg1, arg2
  EndMacro
  Macro M_addps(arg1, arg2)
    !addps arg1, arg2
  EndMacro  
  
  ProcedureC PSG_Core(arg1, arg2, arg3, arg4, arg5, arg6)
    
    ; arg1 used for loopCount
    ; arg2 used for sample_data_ptr
    ; arg3 used for numSamples
    
    mov reg_bx, rbx
    mov reg_di, rdi
    mov reg_si, rsi
    mov rdx, *internal
    CompilerIf #PB_Compiler_OS = #PB_OS_MacOS And #ALWAYS_USE_PORTAUDIO = #False
      mov rax, arg6
      CompilerIf #PB_Compiler_Processor = #PB_Processor_x64
        !mov rcx, [rax + 16]            ; sample_data_ptr
      CompilerElse
        !mov ecx, [eax + 12]            ; sample_data_ptr
      CompilerEndIf
      mov arg2, rcx                     ; make arg2 sample_data_ptr
      mov rax, arg5                     ; make arg3 numSamples
      mov arg3, rax
    CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows And #PB_Compiler_Processor = #PB_Processor_x64
      !movaps [rdx + 0x50], xmm6        ; backup xmm6 (required for Win64)
      !movaps [rdx + 0x60], xmm7        ; backup xmm7 (required for Win64)  
    CompilerEndIf
    
    ; *** logic for variable sized sample buffers ***
    !psg.l_core_start:
    mov eax, [rdx + 0x84]; interrupt counter
    !test eax, eax
    !jnz psg.l_core_cont0
    MML_Interrupt()
    mov rdx, *internal
    !mov eax, 459
    !psg.l_core_cont0:
    mov rcx, arg3
    cmp rcx, rax
    !jb psg.l_core_cont1
    mov arg1, rax
    sub rcx, rax
    mov arg3, rcx
    mov dword [rdx + 0x84], 0
    !jmp psg.l_core_cont2
    !psg.l_core_cont1:
    mov arg1, rcx
    sub rax, rcx
    mov [rdx + 0x84], eax
    mov arg3, 0
    !psg.l_core_cont2:
    
    ; *** generate sample data ***
    ; init some registers
    mov edi, prng                       ; pseudo random generator     
    M_movups(xmm4, [psg.l_f4_rcp2])     ; xmm4 = 1/2
    M_movaps(xmm3, [rdx])               ; xmm3 = phase
    M_movaps(xmm7, [rdx + 0x20])        ; xmm7 = waveform selection
    mov esi, [rdx + 0x20]               ; waveform channel 0
    M_movaps(xmm6, [rdx + 0x30])        ; xmm6 = volume
    M_movaps(xmm5, [rdx + 0x40])        ; xmm5 = current volume
    M_movss(xmm0, [rdx + 0x80])
    ; apply master volume
    !movaps xmm1, xmm4
    !mulps xmm1, xmm1
    !addps xmm1, xmm4
    !mulps xmm6, xmm1
    !shufps xmm0, xmm0, 0
    !mulps xmm6, xmm0
    ; load sample_data_ptr and loopCount
    mov rax, arg1                       ; loopCount
    mov rcx, arg2                       ; sample_data_ptr
    
    ; *** main loop *** 
    !psg.l_core_sample_loop:
    ; prepare volume
    M_movaps(xmm0, [rdx + 0x70])
    !movaps xmm1, xmm4
    !addps xmm1, xmm1
    !mulps xmm5, xmm0
    !subps xmm1, xmm0
    !mulps xmm1, xmm6
    !addps xmm5, xmm1    
    ; calculate phase
    M_addps(xmm3, [rdx + 0x10])         ; phase += phase_add
    !movaps xmm1, xmm4                  ; set xmm1 to 1
    !addps xmm1, xmm1
    !movaps xmm0, xmm3
    !cmpnltps xmm0, xmm1
    !movmskps ebx, xmm0
    !andps xmm0, xmm1
    !subps xmm3, xmm0                   ; if (phase >= 1) phase -= 1
    ; generate waveform
    !movaps xmm0, xmm3
    !addps xmm0, xmm0
    !subps xmm0, xmm1
    !andps xmm0, xmm7
    !movaps xmm2, xmm3
    !cmpnltps xmm2, xmm4
    !andps xmm2, xmm1
    !movaps xmm1, xmm7
    !andnps xmm1, xmm3
    !orps xmm0, xmm1
    !movaps xmm1, xmm7
    !cmpneqps xmm1, xmm4
    !andps xmm0, xmm1
    !andnps xmm1, xmm2
    !orps xmm0, xmm1    
    ; channel 0 noise generator
    !cmp esi, 1
    !jne psg.l_core_noise_cont2
    !xorps xmm1, xmm1
    !test ebx, 1
    !jz psg.l_core_noise_cont0
    !shr edi, 1
    !jnc psg.l_core_noise_cont0
    !xor edi, 0x80200003
    !psg.l_core_noise_cont0:
    !test edi, 1
    !jz psg.l_core_noise_cont1
    !movaps xmm1, xmm4
    !addps xmm1, xmm1
    !psg.l_core_noise_cont1:
    !movss xmm0, xmm1
    !psg.l_core_noise_cont2:
    ; end of noise generator
    !subps xmm0, xmm4
    ; apply volume
    !mulps xmm0, xmm5
    ; mix 4 channels
    !movhlps xmm1, xmm0
    !addps xmm0, xmm1
    !movaps xmm1, xmm0
    !shufps xmm1, xmm1, 1
    !addps xmm0, xmm1
    ; clip output sample
    !xorps xmm1, xmm1
    !minss xmm0, xmm4
    !subss xmm1, xmm4
    !maxss xmm0, xmm1
    CompilerIf #PSG_FLOAT32
      CompilerIf #ENABLE_WAVE_RECORD
        !movss xmm1, [psg.l_int_conv]
        !mulss xmm1, xmm0
        !cvttss2si ebx, xmm1        
      CompilerEndIf
      !addss xmm0, xmm0
      M_movss([rcx], xmm0)               ; 32 bit float 
      add rcx, 4
    CompilerElse
      !mulss xmm0, [psg.l_int_conv]
      !cvttss2si ebx, xmm0
      mov [rcx], bx                      ; 16 bit signed integer
      add rcx, 2
    CompilerEndIf
    CompilerIf #ENABLE_WAVE_RECORD
      ; bx contains 16 bit signed integer sample
      mov edx, record_buffer_idx
      add rdx, *record_buffer
      mov [rdx], bx
      mov edx, record_buffer_idx
      !add edx, 2
      !and edx, $7fffe
      mov record_buffer_idx, edx
      mov rdx, *internal   
    CompilerEndIf
    !dec eax
    !jnz psg.l_core_sample_loop
    mov prng, edi    
    M_movaps([rdx], xmm3)
    M_movaps([rdx + 0x40], xmm5)
    
    ; *** logic for variable sized sample buffers ***
    mov rax, arg3
    test rax, rax
    !jz psg.l_core_cont3
    ; update sample pointer
    mov rax, arg1                       ; loopCount
    mov rcx, arg2                       ; sample_data_ptr
    CompilerIf #PSG_FLOAT32
      shl rax, 2
    CompilerElse
      shl rax, 1
    CompilerEndIf
    add rcx, rax
    mov arg2, rcx
    !jmp psg.l_core_start
    !psg.l_core_cont3:
    
    CompilerIf #PB_Compiler_OS = #PB_OS_Windows And #PB_Compiler_Processor = #PB_Processor_x64
      !movaps xmm6, [rdx + 0x50]        ; restore xmm6 (required for Win64)
      !movaps xmm7, [rdx + 0x60]        ; restore xmm7 (required for Win64)  
    CompilerEndIf
    mov rbx, reg_bx
    mov rdi, reg_di
    mov rsi, reg_si
  EndProcedure
  
  Procedure PSG_SetDefaults()
    Protected i.i
    FillMemory(*internal, SizeOf(PSGInternal))
    While i < 4
      *internal\vol_change_speed[i] = 0.988
      i + 1
    Wend
    *internal\mastervolume = 1.0
  EndProcedure
  
  Procedure PSG_SetMasterVolume(Volume.f = 1.0)
    *internal\mastervolume = Volume
  EndProcedure
  
  ; *** End of PSG Core ***
  
  #SOC = SizeOf(Character)
  
  Structure WaveMask : m.l[4] : EndStructure
  Structure VolTable : v.f[64] : EndStructure
  Structure NoteTable : n.f[97] : EndStructure
  Structure MMLTable : c.a[256] : EndStructure
  
  Structure MML_Channel Extends MML_Info
    EvtLen.l
    Volume_.l
    *CmdPtr.Character ; MML commands pointer
  EndStructure
  
  Global *wm.WaveMask = ?WaveMask
  Global *vt.VolTable = ?VolTable
  Global *nt.NoteTable = ?NoteTable
  Global *mt.MMLTable = ?MMLTable
  
  Global Dim MML_Channel.MML_Channel(3)
  Global Dim MML_Commands.s(3)
  Global Dim MML_Numbers.i(3, 255)
  Global Dim MML_Envelope.i(3, 255)
  Global.i IsSettingMML, IsParsingMML, IsPlayingMML; flags
  
  MML_Channel(0)\EvtCnt = -1 : MML_Channel(1)\EvtCnt = -1
  MML_Channel(2)\EvtCnt = -1 : MML_Channel(3)\EvtCnt = -1
  
  Procedure PSG_Sound(Channel.a, Frequency.f, Volume.a, Waveform.a = 0)
    Channel & 3
    If Frequency <= 0 Or Frequency > 22000
      Frequency = 0 : Volume = 0
    EndIf
    *internal\phase_add[Channel] = Frequency * rcp44100
    If *internal\vmul[Channel] < 0.001
      If Waveform = 0
        *internal\phase[Channel] = 0.75 
      Else
        *internal\phase[Channel] = 0.5 
      EndIf
    EndIf
    *internal\vmul[Channel] = *vt\v[Volume & 63]
    *internal\wave_mask[Channel] = *wm\m[Waveform & 7]
    If Waveform = 5 And Channel = 0; Channel 0 noise ?
      *internal\phase_add[Channel] * 10
      If *internal\phase_add[Channel] > 0.999
        *internal\phase_add[Channel] = 0.999
      EndIf
    EndIf
  EndProcedure
  
  Macro M_ResetMMLChannel()
    *ch\EvtCnt = 0
    *ch\Tempo = 12; (120 BPM)
    *ch\Octave = 4
    *ch\Transpose = 0
    *ch\NoteLen = 4
    *ch\Volume = 40
    *ch\Waveform = 0
    *ch\Volume_ = 0
    *ch\Decay = 0      
  EndMacro
  
  Macro M_SetMMLChannel(mml_ch)
    If Channel#mml_ch <> #MML_NoChange
      MML_Commands(mml_ch) = Channel#mml_ch
      *ch = @MML_Channel(mml_ch)
      M_ResetMMLChannel()
      *ch\CmdPtr = @MML_Commands(mml_ch)
      *internal\phase[i] = 0.75
      IsPlayingMML | 1 << mml_ch
    EndIf
  EndMacro
  
  Procedure PSG_PlayMML(Channel0.s, Channel1.s = "", Channel2.s = "", Channel3.s = "")
    Protected i.i, *ch.MML_Channel
    IsSettingMML = #True
    ; wait for flag parsing mml data is cleared
    While IsParsingMML : Delay(1) : Wend
    ; set channels
    M_SetMMLChannel(0)
    M_SetMMLChannel(1)
    M_SetMMLChannel(2)
    M_SetMMLChannel(3)
    ; clear flag
    IsSettingMML = #False
  EndProcedure
  
  Procedure.i PSG_IsPlayingMML()
    ProcedureReturn IsPlayingMML  
  EndProcedure
  
  Macro M_ParseMML(interrupt = #True)
    ; find and read next command
    Repeat
      cmd = *mt\c[*m\a] : *m + #SOC
    Until cmd & $80
    If cmd = $ff
      ; exit
      *m - #SOC : Break
    Else
      ; read modifiers
      n = 0 : number = 0 : note = 0 : dot = #False
      c = *mt\c[*m\a]
      While c & $80 = 0
        If c & $40
          number * 10 + c & $f
        ElseIf c & $20
          note = c & $f - 1
        ElseIf c & $10
          dot = #True
        ElseIf c = 2
          ; next number
          CompilerIf interrupt
            If n < 252
              MML_Numbers(i, n) = number
              n + 1
            EndIf
          CompilerEndIf
          number = 0
        ElseIf c = 0
          number = 0
        EndIf
        *m + #SOC : c = *mt\c[*m\a]
      Wend
      CompilerIf interrupt
        MML_Numbers(i, n) = number
        MML_Numbers(i, 253) = dot
        MML_Numbers(i, 254) = 0
        MML_Numbers(i, 255) = n + 1
      CompilerEndIf  
      ; process command
      If cmd & $40; ** note a-g or rest **
        If number = 0 : number = *ch\NoteLen : EndIf
        CompilerIf interrupt
          ; counter for interrupt procedure
          If cmd = $cf
            ; rest
            *ch\Volume_ = 0
            *internal\vmul[i] = 0
          Else
            ; note
            note + cmd & $f
            If note < 0 : note = 11 : ElseIf note > 11 : note = 0 : EndIf
            note + *ch\Octave * 12 + *ch\Transpose
            If note < 0 Or note > 96
              *internal\vmul[i] = 0; invalid note                   
            Else
              *ch\Volume_ = *ch\Volume << 3
              If *ch\Decay = -256
                PSG_Sound(i, *nt\n[note], *ch\Volume_ * MML_Envelope(i, 0) / 72, *ch\Waveform)
              Else
                PSG_Sound(i, *nt\n[note], *ch\Volume, *ch\Waveform)
              EndIf
            EndIf
          EndIf
          *ch\EvtLen = (18 - *ch\Tempo) << 5 / number
          If dot : *ch\EvtLen = (*ch\EvtLen << 1 + *ch\EvtLen) >> 1 : EndIf
          *ch\EvtCnt = *ch\EvtLen
          Break
        CompilerElse
          ; counter for info procedure
          If dot
            *ch\EvtCnt + 192 / number
            number = (18 - *ch\Tempo) << 5 / number
            TimeCounter + (number << 1 + number) >> 1 
          Else
            *ch\EvtCnt + 128 / number
            TimeCounter + (18 - *ch\Tempo) << 5 / number
          EndIf  
        CompilerEndIf
      ElseIf cmd & $20; ** octave change / transpose **
        If cmd = $ae  ; transpose
          If number <= 24
            If note = -1 : number = -number : EndIf
            *ch\Transpose = number
          EndIf
        ElseIf cmd = $af; octave change
          *ch\Octave = number
        Else; < >
          *ch\Octave + (cmd & $f - 1)
        EndIf
      Else
        Select cmd
          Case $90; note length change
            If number : *ch\NoteLen = number : EndIf
          Case $91; tempo change
            If number < 40
              *ch\Tempo = number & 15
            ElseIf number <= 240
              *ch\Tempo = 18 - (1440 / number + 1) >> 1
            EndIf 
          Case $92; note volume change
            If number
              *ch\Volume = number & 63
            ElseIf note
              *ch\Volume + note << 2
              If *ch\Volume < 0
                *ch\Volume = 0
              ElseIf *ch\Volume > 63
                *ch\Volume = 63
              EndIf
            Else
              *ch\Volume = 0
            EndIf
          Case $93; waveform select
            *ch\Waveform = number
          Case $94; attack speed (not supported)
          Case $95; decay speed
            If n
              *ch\Decay = -256
              CompilerIf interrupt
                CopyMemory(@MML_Numbers(i, 0), @MML_Envelope(i, 0), 256 * SizeOf(Integer))
              CompilerEndIf  
            Else
              *ch\Decay = number
            EndIf
          Case $9e; event
            CompilerIf interrupt
              PostEvent(#MML_Event, 0, 0, 0, number)
            CompilerEndIf
          Case $9f; loop
            CompilerIf interrupt            
              M_ResetMMLChannel()
              loopmask | (1 << i)
              *m = @MML_Commands(i)
            CompilerElse
              Break              
            CompilerEndIf      
        EndSelect
      EndIf
    EndIf  
  EndMacro
  
  Procedure MML_Interrupt()
    Protected i.i, loopmask.i, *m.Ascii, *ch.MML_Channel
    Protected c.a, cmd.a, f.f, n.i, number.i, note.i, dot.i
    If IsSettingMML = #False
      IsParsingMML = #True
      CompilerIf #ENABLE_WAVE_RECORD
        If MML_Channel(0)\CmdPtr = @MML_Commands(0) And MML_Channel(1)\CmdPtr = @MML_Commands(1) And MML_Channel(2)\CmdPtr = @MML_Commands(2) And MML_Channel(3)\CmdPtr = @MML_Commands(3) And record_buffer_idx < 88200
          record_buffer_idx = 0
        EndIf      
      CompilerEndIf
      While i < 4
        *ch = @MML_Channel(i)
        If *ch\EvtCnt > 0
          If *ch\Decay = -256
            If MML_Envelope(i, 253)
              n = *ch\Volume_ * MML_Envelope(i, MML_Envelope(i, 255) * (*ch\EvtLen - *ch\EvtCnt) / *ch\EvtLen) / 72
            Else
              f = (MML_Envelope(i, 255) - 1) * (*ch\EvtLen - *ch\EvtCnt) / *ch\EvtLen
              n = Int(f) : f - n
              n = *ch\Volume_ * (MML_Envelope(i, n) * (1 - f) + MML_Envelope(i, n + 1) * f) / 72
            EndIf
            If n > 63
              n = 63
            ElseIf n < 0
              n = 0
            EndIf
            *internal\vmul[i] = *vt\v[n]
          ElseIf *ch\Volume_
            *ch\Volume_ - *ch\Decay
            If *ch\Volume_ < 0 : *ch\Volume_ = 0 : EndIf
            *internal\vmul[i] = *vt\v[*ch\Volume_ >> 3]
          EndIf
          *ch\EvtCnt - 1
        EndIf
        If *ch\EvtCnt = 0
          *m = *ch\CmdPtr
          If *m And *m\a
            Repeat
              M_ParseMML()
            ForEver
            *ch\CmdPtr = *m
          Else
            ; silence if nothing more to play
            *internal\vmul[i] = 0
            *ch\EvtCnt = -1
            IsPlayingMML & ~(1 << i)
            If IsPlayingMML = 0
              CompilerIf #ENABLE_WAVE_RECORD
                If auto_stop
                  PSG_StopWaveRecord()
                EndIf
              CompilerEndIf
              PostEvent(#MML_Event, 0, 0, 0, -1)
            EndIf
          EndIf
        EndIf
        i + 1
      Wend
      If loopmask And loopmask = IsPlayingMML
        CompilerIf #ENABLE_WAVE_RECORD
          If auto_stop
            PSG_StopWaveRecord()
          EndIf
        CompilerEndIf
        PostEvent(#MML_Event, 0, 0, 0, -2)
      EndIf
      IsParsingMML = #False
    EndIf
  EndProcedure
  
  Procedure.i PSG_GetInfoMML(*MMLString, Position, *MML_Info.MML_Info)
    Protected ch.MML_Channel, *ch.MML_Channel = @ch, m.s, *m.Ascii
    Protected c.a, cmd.a, n.i, number.i, note.i, dot.i
    Protected TimeCounter.i = 0
    If *MMLString And *MML_Info And Position > 0
      m = PeekS(*MMLString, Position - 1) : *m = @m
      M_ResetMMLChannel()
      Repeat
        M_ParseMML(#False)
      ForEver
      *ch\EvtCnt >> 2
      CopyMemory(*ch, *MML_Info, SizeOf(MML_Info))
    EndIf
    ProcedureReturn TimeCounter * 459 / 4410
  EndProcedure
  
  ; *** Initialize the PSG ***
  
  PSG_Init()
  
  ; *** DataSection ***
  
  DataSection
    !psg.l_f4_rcp2  : dd 0x3f000000,0x3f000000,0x3f000000,0x3f000000
    !psg.l_int_conv : dd 0x477ffe00
    Rcp44100:
    !dd 0x37be37c6
    WaveMask:
    !dd 0x7fffffff,0x00000000,0x7faaffff,0x007fffff,0x3f000000,0x00000001,0x7faaffff,0x007fffff
    VolTable:   ; Volume 0-63
    !dd 0x00000000,0x3b9b0abd,0x3ba9063b,0x3bb84489,0x3bc8e2c5,0x3bdb00ab,0x3beec0d5,0x3c02247e
    !dd 0x3c0de120,0x3c1aacbb,0x3c289fbe,0x3c37d4ce,0x3c4868f6,0x3c5a7be0,0x3c6e3011,0x3c81d595
    !dd 0x3c8d8b19,0x3c9a4ef1,0x3ca8397f,0x3cb76556,0x3cc7ef70,0x3cd9f764,0x3ced9fa2,0x3d0186da
    !dd 0x3d0d3544,0x3d19f15f,0x3d27d37d,0x3d36f621,0x3d477634,0x3d597339,0x3d6d0f8c,0x3d813850
    !dd 0x3d8cdfa5,0x3d999407,0x3da76db9,0x3db68730,0x3dc6fd42,0x3dd8ef5f,0x3dec7fcd,0x3e00e9f5
    !dd 0x3e0c8a39,0x3e1936e7,0x3e270833,0x3e361882,0x3e468498,0x3e586bd3,0x3e6bf064,0x3e809bc9
    !dd 0x3e8c3500,0x3e98d9fe,0x3ea6a2e9,0x3eb5aa15,0x3ec60c36,0x3ed7e896,0x3eeb6151,0x3f004dcc
    !dd 0x3f0bdffb,0x3f187d4e,0x3f263dde,0x3f353bee,0x3f459420,0x3f5765ab,0x3f6ad298,0x3f800000
    NoteTable:  ; Note frequencies C0-C8
    !dd 0x4182d013,0x418a9760,0x4192d517,0x419b9041,0x41a4d054,0x41ae9d37,0x41b8ff49,0x41c3ff6a
    !dd 0x41cfa700,0x41dc0000,0x41e914f6,0x41f6f110,0x4202d013,0x420a9760,0x4212d517,0x421b9041
    !dd 0x4224d054,0x422e9d37,0x4238ff49,0x4243ff6a,0x424fa700,0x425c0000,0x426914f6,0x4276f110
    !dd 0x4282d013,0x428a9760,0x4292d517,0x429b9041,0x42a4d054,0x42ae9d37,0x42b8ff49,0x42c3ff6a
    !dd 0x42cfa700,0x42dc0000,0x42e914f6,0x42f6f110,0x4302d013,0x430a9760,0x4312d517,0x431b9041
    !dd 0x4324d054,0x432e9d37,0x4338ff49,0x4343ff6a,0x434fa700,0x435c0000,0x436914f6,0x4376f110
    !dd 0x4382d013,0x438a9760,0x4392d517,0x439b9041,0x43a4d054,0x43ae9d37,0x43b8ff49,0x43c3ff6a
    !dd 0x43cfa700,0x43dc0000,0x43e914f6,0x43f6f110,0x4402d013,0x440a9760,0x4412d517,0x441b9041
    !dd 0x4424d054,0x442e9d37,0x4438ff49,0x4443ff6a,0x444fa700,0x445c0000,0x446914f6,0x4476f110
    !dd 0x4482d013,0x448a9760,0x4492d517,0x449b9041,0x44a4d054,0x44ae9d37,0x44b8ff49,0x44c3ff6a
    !dd 0x44cfa700,0x44dc0000,0x44e914f6,0x44f6f110,0x4502d013,0x450a9760,0x4512d517,0x451b9041
    !dd 0x4524d054,0x452e9d37,0x4538ff49,0x4543ff6a,0x454fa700,0x455c0000,0x456914f6,0x4576f110
    !dd 0x4582d013
    MMLTable:
    !dd 0x000000ff,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000
    !dd 0x22000001,0x00000000,0x229e0000,0x94102002,0x43424140,0x47464544,0x009f4948,0x00a200a0
    !dd 0xc0cbc900,0xc7c5c4c2,0xae000000,0xaf000090,0x00cf0000,0x93920091,0x00000000,0x00000095
    !dd 0xc0cbc900,0xc7c5c4c2,0xae000000,0xaf000090,0x00cf0000,0x93920091,0x00000000,0x00000000
    !dd 0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000
    !dd 0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000
    !dd 0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000
    !dd 0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000,0x00000000
  EndDataSection
  
  ; *** End of module code ***
  
EndModule

[wilbert]

A little tune J. Baker created

Code: Select all

UseModule PSG

OpenWindow(0, 0, 0, 200, 100, "PSG Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

PSG_PlayMML("\8 T15 W0 V49 O4 L4 EEB CACB:", "\8 T15 W0 V42 O2 L4 F:", "\3 T15 W0 V50 O3 R1 L1 A R1 L4 BAB R2 L1 B:", "\8 T15 W0 V42 O4 R1 L1 A R1:")

Repeat
  Event = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow

PSG_Terminate()

End

A little demo I created

Code: Select all

; Test code

UseModule PSG

Dim Colors.l(2)
Colors(0) = $ff0080ff
Colors(1) = $ffff4040

OpenWindow(0, 0, 0, 200, 100, "PSG Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
CanvasGadget(0, 0, 0, 200, 100)
StartDrawing(CanvasOutput(0))
Box(0, 0, 200, 100, $ffff4040)
DrawText(10, 10, "<< Click me >>", $ffffffff, $ffff4040)
StopDrawing()

PSG_PlayMML("\20 T10 W3 V55 O2 L16 ER*0E*1CECEC:", "\4 T10 W2 V50 L8 BABABABABA:", "\4 T10 W2 V50 L8 G>E<GEG>E<GEGE:")

Repeat
  Event = WaitWindowEvent()
  If Event = #MML_Event
    EvData = EventData()
    If EvData >= 0
      StartDrawing(CanvasOutput(0))
        Circle(100, 50, 10, Colors(EvData))
      StopDrawing()   
    EndIf
  EndIf  
  If EventType() = #PB_EventType_LeftButtonDown
    PSG_PlayMML(#MML_NoChange, #MML_NoChange, #MML_NoChange, "\4W0 V55 O5 L16 EGBGE")
  EndIf
Until Event = #PB_Event_CloseWindow

PSG_Terminate()

[idle]

nice works on linux, setting #PSG_PORTAUDIO path as

Code: Select all

CompilerIf #PB_Compiler_OS = #PB_OS_Linux
    #PSG_PORTAUDIO = "-lportaudio"
  CompilerElseIf #PB_Compiler_OS = #PB_OS_Windows 
    #PSG_PORTAUDIO = "portaudio_x86.lib"
  CompilerEndIf   

[wilbert]

nice works on linux, setting #PSG_PORTAUDIO path as

Thanks for letting me know Idle

I added the "-lportaudio" to the module.
It seems to work on OS X Yosemite as well so I have set it for all non Windows systems.

[Joris]

Hi Wilbert,

On XP32 it doesn't work (=> "Er is een fout opgetreden in Purebasic_Compilation0.exe ...")
PortAudio is aanwezig en wordt na pad-aanpassing ingeladen maar :
- a cpu capable of handling first generation sse instructions.
How to now ?

(Oops, sorry non Dutch people.)

[wilbert]

English:
Hi Joris,
The first generation SSE instructions were added in 1999 with the Pentium III.
Unless you are having a very old computer, that shouldn't be the cause of the problem.
When you comment the DisableDebugger command inside the module and compile with debugger enabled, do you get any more information ?
I found a precompiled dll that worked for me here https://github.com/adfernandes/precompi ... io-windows

Dutch:
Dag Joris,
De eerste generatie SSE instructies werd in 1999 toegevoegd met de komst van de Pentium III.
Wanneer je niet een heel oude computer hebt, kan dat de oorzaak van het probleem niet zijn.
Als je een ';' voor DisableDebugger plaatst in de module en compileert met de debugger ingeschakeld, krijg je dan meer informatie ?
Ik vond een voorgecompileerde dll die voor mij werkte hier https://github.com/adfernandes/precompi ... io-windows

[wilbert]

I posted an update of the module.
The notes that were played with the previous version were wrong due to a problem with the lookup table.

[Joris]

Hi Wilbert,

Tried again, same fault.
I don't know much about modules and just try to run the source in the first place, but then it goes wrong.
I can send you the "Foutenrapport" als je daar iets aan hebt ? (oops weerom .
(Processor is Intell Core Duo 3.0 GHz)

The use of this :
Als je een ';' voor DisableDebugger plaatst in de module en compileert met de debugger ingeschakeld, krijg je dan meer informatie ?
is new to me... if really need for you I'll make time to learn how to use.

[wilbert]

I don't know much about modules and just try to run the source in the first place, but then it goes wrong.
I can send you the "Foutenrapport" als je daar iets aan hebt ? (oops weerom .
(Processor is Intell Core Duo 3.0 GHz)

The processor is not the problem; it must be something else.
Here's a Win32 compiled version of the few lines of demo code I posted http://www.w73.nl/pb/PSG_x86_test.zip
Does that also crash ?
What PureBasic version are you using ?

[Joris]

I can run that but it only shows up as a new process in the XP-process-list that it's running, nothing more to see. So should that normal ?

[J. Baker]

I can run that but it only shows up as a new process in the XP-process-list that it's running, nothing more to see. So should that normal ?

The previous example worked fine on XP when I tried it. Haven't tried the update on XP yet. A couple simple questions just to verify...

1.) Have you included one of the demo songs in the second post to the Module? Both can be in the same *.pb source file. Just paste one of the demo songs to the bottom of the source module. Make sure to save it as a *.pb file.
2.) Do you have both the lib and dll in the same folder as the *.pb source file?
3.) What version of PB did you test it on? I used 5.24 LTS on XP when I tested it.
4.) Do you have the latest sound card driver on your pc? I don't know if the issue could be a sound card issue or not.

EDIT: I just tried the latest code here and all is fine on my XP pc. It may just be a sound card issue, since you couldn't get Wilbert's compiled executable running properly. As you said it opened but there was no sound. I would try updating your sound driver or maybe a different sound card, if you have one.

[Joris]

1.) Have you included one of the demo songs in the second post to the Module? Both can be in the same *.pb source file. Just paste one of the demo songs to the bottom of the source module. Make sure to save it as a *.pb file.
2.) Do you have both the lib and dll in the same folder as the *.pb source file?
3.) What version of PB did you test it on? I used 5.24 LTS on XP when I tested it.
4.) Do you have the latest sound card driver on your pc? I don't know if the issue could be a sound card issue or not.

The portaudio.lib inside Wilbert's zip was already 20kB bigger then the one I used, so I replaced that and trow mine away.
1) I didn't first and now I try but the same error. I pasted the second example source under the module source, saved it and tried to run, same error.
2) What dll ? So, I now tried to compile the PSG model as DLL (is that the dll you ment ???) and tried to include it in the sample source, but UseModule PSG or UseModule PSG.dll doesn't work, and they are all in the same map.
Yeah sorry I'm a real noob on modules, and to bussy still with other thing, but just wonted to test 'music related' codings.
3) I use PB 5.31 x86.
4) Yes, even if they are old a Pro Yamaha, and some little pc-soundcardl, those work fine (and are the reason I still work on XP).

[wilbert]

I use PB 5.31 x86.

That also shouldn't be the problem.
If you wish you can PM me the crash report; maybe it gives some information.
I'm also curious if you ever got any of the other PortAudio related examples on this forum to work.

[Joris]

I'm also curious if you ever got any of the other PortAudio related examples on this forum to work.

Indeed I didn't succeed with that yet, but I need to say that I didn't spend much time to research on the reason.
Below the 'XP-fouten-rapport' print, if that can help :

<?xml version="1.0" encoding="UTF-16"?>
<DATABASE>
<EXE NAME="PureBasic_Compilation0.exe" FILTER="GRABMI_FILTER_PRIVACY">
<MATCHING_FILE NAME="PSG.dll" SIZE="20992" CHECKSUM="0xE379887C" MODULE_TYPE="WIN32" PE_CHECKSUM="0x0" LINKER_VERSION="0x0" LINK_DATE="02/08/2015 07:26:06" UPTO_LINK_DATE="02/08/2015 07:26:06" />
<MATCHING_FILE NAME="PureBasic_Compilation0.exe" SIZE="69120" CHECKSUM="0xDE49883D" MODULE_TYPE="WIN32" PE_CHECKSUM="0x0" LINKER_VERSION="0x0" LINK_DATE="02/08/2015 17:08:17" UPTO_LINK_DATE="02/08/2015 17:08:17" />
</EXE>
<EXE NAME="portaudio_x86.dll" FILTER="GRABMI_FILTER_THISFILEONLY">
<MATCHING_FILE NAME="portaudio_x86.dll" SIZE="193024" CHECKSUM="0x93A0E07" MODULE_TYPE="WIN32" PE_CHECKSUM="0x31F5F" LINKER_VERSION="0x10000" LINK_DATE="10/26/2011 08:48:18" UPTO_LINK_DATE="10/26/2011 08:48:18" />
</EXE>
<EXE NAME="kernel32.dll" FILTER="GRABMI_FILTER_THISFILEONLY">
<MATCHING_FILE NAME="kernel32.dll" SIZE="1034240" CHECKSUM="0x14E38B6" BIN_FILE_VERSION="5.1.2600.6532" BIN_PRODUCT_VERSION="5.1.2600.6532" PRODUCT_VERSION="5.1.2600.6532" FILE_DESCRIPTION="DLL-bestand voor Windows NT BASE API-client" COMPANY_NAME="Microsoft Corporation" PRODUCT_NAME="Besturingssysteem Microsoft® Windows®" FILE_VERSION="5.1.2600.6532 (xpsp_sp3_qfe.140312-0419)" ORIGINAL_FILENAME="kernel32" INTERNAL_NAME="kernel32" LEGAL_COPYRIGHT="© Microsoft Corporation. Alle rechten voorbehouden." VERFILEDATEHI="0x0" VERFILEDATELO="0x0" VERFILEOS="0x40004" VERFILETYPE="0x2" MODULE_TYPE="WIN32" PE_CHECKSUM="0x101CFD" LINKER_VERSION="0x50001" UPTO_BIN_FILE_VERSION="5.1.2600.6532" UPTO_BIN_PRODUCT_VERSION="5.1.2600.6532" LINK_DATE="03/12/2014 10:47:47" UPTO_LINK_DATE="03/12/2014 10:47:47" VER_LANGUAGE="Nederlands (Nederland) [0x413]" />
</EXE>
</DATABASE>

[wilbert]

Below the 'XP-fouten-rapport' print, if that can help :

Unfortunately I don't see anything there that points me into a direction.
There's one more thing I can try. Currently I'm using 32 bit float samples. Maybe 16 bit integer will work.
I updated the compiled demo I asked you to try before.
Can you re-download this http://www.w73.nl/pb/PSG_x86_test.zip and see if this does anything ?
If not, I'm out of options