Noob's investigation of VGM and DMF and SMD audio drivers

For everything that's not in any way related to PureBasic. General chat etc...
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Noob's investigation of VGM

Post by wilbert »

SeregaZ wrote:this array is suks... some times i make overlimit and crash. and i am still not make noise type, and i have no idea how to make work it for 4 channels...

what do you think? :) no need to load, just play. and you can change some switchers for different effect of playing.
It looks nice. :)
I don't know what I'm doing wrong but I don't hear anything when I press play; only see the moving ADSR shape.
Windows (x64)
Raspberry Pi OS (Arm64)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

probably it is becouse i write in your module initialization commands, not like you made: in module - core and window part in main programm. in my case window part in module too. in main programm just frequency of core sets.

later i was try to make GEMS dinamic allocate channels:

Code: Select all

Enumeration
  #Window
  
  #Gadget
  #Gadget2
  
  #Img01
  #Img02
  
  #AtRP
  #AtRG
  #AtRM
  
  #AtLP
  #AtLG
  #AtLM
  
  #DcRP
  #DcRG
  #DcRM
  
  #SyLP
  #SyLG
  #SyLM
  
  #RrRP
  #RrRG
  #RrRM
  
  #Load
  
  #NoteM
  #NoteG
  #NoteP
  
  #DurM
  #DurG
  #DurP
  
EndEnumeration

XIncludeFile "G:\DISTR\SEREGASOFT\MIDI\SN76489 module.pb"

Global Dim PSGnote.i($5F) ;{
For i = 0 To $21
  PSGnote(i) = 1017
Next
;PSGnote($20) = 1017
;PSGnote($21) = 1017
PSGnote($22) = 960
PSGnote($23) = 906
PSGnote($24) = 855
PSGnote($25) = 807
PSGnote($26) = 762
PSGnote($27) = 719
PSGnote($28) = 679
PSGnote($29) = 641
PSGnote($2A) = 605
PSGnote($2B) = 571
PSGnote($2C) = 539
PSGnote($2D) = 508
PSGnote($2E) = 480
PSGnote($2F) = 453
PSGnote($30) = 428
PSGnote($31) = 404
PSGnote($32) = 381
PSGnote($33) = 360
PSGnote($34) = 339
PSGnote($35) = 320
PSGnote($36) = 302
PSGnote($37) = 285
PSGnote($38) = 269
PSGnote($39) = 254
PSGnote($3A) = 240
PSGnote($3B) = 226
PSGnote($3C) = 214
PSGnote($3D) = 202
PSGnote($3E) = 190
PSGnote($3F) = 180
PSGnote($40) = 170
PSGnote($41) = 160
PSGnote($42) = 151
PSGnote($43) = 143
PSGnote($44) = 135
PSGnote($45) = 127
PSGnote($46) = 120
PSGnote($47) = 113
PSGnote($48) = 107
PSGnote($49) = 101
PSGnote($4A) = 95
PSGnote($4B) = 90
PSGnote($4C) = 85
PSGnote($4D) = 80
PSGnote($4E) = 76
PSGnote($4F) = 71
PSGnote($50) = 67
PSGnote($51) = 64
PSGnote($52) = 60
PSGnote($53) = 57
PSGnote($54) = 53
PSGnote($55) = 50
PSGnote($56) = 47
PSGnote($57) = 45
PSGnote($58) = 42
PSGnote($59) = 40
PSGnote($5A) = 38
PSGnote($5B) = 35
PSGnote($5C) = 33
PSGnote($5D) = 32
PSGnote($5E) = 30
PSGnote($5F) = 28;}

Global Dim PSGInstARValues1(0) ; Attack Rate
Global Dim PSGInstDRValues1(0) ; Decoy Rate
Global Dim PSGInstRRValues1(0) ; Relise Rate

Global Dim PSGInstARValues2(0) ; Attack Rate
Global Dim PSGInstDRValues2(0) ; Decoy Rate
Global Dim PSGInstRRValues2(0) ; Relise Rate

Global Dim PSGInstARValues3(0) ; Attack Rate
Global Dim PSGInstDRValues3(0) ; Decoy Rate
Global Dim PSGInstRRValues3(0) ; Relise Rate

Global Dim PSGInstARValues4(0) ; Attack Rate
Global Dim PSGInstDRValues4(0) ; Decoy Rate
Global Dim PSGInstRRValues4(0) ; Relise Rate


Global PhaseOfPSG1
Global PhaseOfPSG2
Global PhaseOfPSG3
Global PhaseOfPSG4

Global curvolume1  = 17
Global curvolume2  = 17
Global curvolume3  = 17
Global curvolume4  = 17

Global psgstart1        ; means duration
Global psgmarker1
Global busyflag01

Global psgstart2        ; means duration
Global psgmarker2
Global busyflag02

Global psgstart3        ; means duration
Global psgmarker3
Global busyflag03

Global psgstart4        ; means duration
Global psgmarker4
Global busyflag04

Global type1, type2, type3, type4
Global noisedata1, noisedata2, noisedata3, noisedata4
Global attackrate1, attackrate2, attackrate3, attackrate4
Global sustainlevel1, sustainlevel2, sustainlevel3, sustainlevel4
Global attacklevel1, attacklevel2, attacklevel3, attacklevel4
Global decayrate1, decayrate2, decayrate3, decayrate4
Global releaserate1, releaserate2, releaserate3, releaserate4

Global fastshutdown3channel
Global noisetype

;{
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 FillARarray1(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues1(0)
  
  If ARvalue = $FF Or ARvalue = 32; 0 AR, top volume immediatly
    PSGInstARValues1(0) = ALvalue
  Else
    counterd.d     = 255 / (ARvalue * 16)
    countershift.d = counterd
    
    For i = 15 To ALvalue Step -1
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstARValues1())
        ReDim PSGInstARValues1(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues1(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri ; get 0.x value
      countershift + counterd                ; 0.x + how it names...
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillARarray2(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues2(0)
  
  If ARvalue = $FF Or ARvalue = 32; 0 AR, top volume immediatly
    PSGInstARValues2(0) = ALvalue
  Else
    counterd.d     = 255 / (ARvalue * 16)
    countershift.d = counterd
    
    For i = 15 To ALvalue Step -1
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstARValues2())
        ReDim PSGInstARValues2(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues2(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri ; get 0.x value
      countershift + counterd                ; 0.x + how it names...
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillARarray3(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues3(0)
  
  If ARvalue = $FF Or ARvalue = 32; 0 AR, top volume immediatly
    PSGInstARValues3(0) = ALvalue
  Else
    counterd.d     = 255 / (ARvalue * 16)
    countershift.d = counterd
    
    For i = 15 To ALvalue Step -1
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstARValues3())
        ReDim PSGInstARValues3(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues3(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri ; get 0.x value
      countershift + counterd                ; 0.x + how it names...
      
    Next
    
  EndIf
  
EndProcedure

Procedure FillDRarray1(DRvalue.i, ALvalue.i, SLvalue.i)
  
  ReDim PSGInstDRValues1(0)
  
  If DRvalue = 32 ; Sustain Level volume immedeatly
    PSGInstDRValues1(0) = SLvalue
  Else
    counterd.d     = 255 / (DRvalue * 16)
    countershift.d = counterd
    
    summoftik = SLvalue - ALvalue
    tmpval    = ALvalue
    If summoftik < 0
      summoftik = ALvalue - SLvalue
      tmpval    = SLvalue
    EndIf
    
    For i = 0 To summoftik
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstDRValues1())
        ReDim PSGInstDRValues1(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstDRValues1(k) = tmpval + i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd               
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillDRarray2(DRvalue.i, ALvalue.i, SLvalue.i)
  
  ReDim PSGInstDRValues2(0)
  
  If DRvalue = 32 ; Sustain Level volume immedeatly
    PSGInstDRValues2(0) = SLvalue
  Else
    counterd.d     = 255 / (DRvalue * 16)
    countershift.d = counterd
    
    summoftik = SLvalue - ALvalue
    tmpval    = ALvalue
    If summoftik < 0
      summoftik = ALvalue - SLvalue
      tmpval    = SLvalue
    EndIf
    
    For i = 0 To summoftik
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstDRValues2())
        ReDim PSGInstDRValues2(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstDRValues2(k) = tmpval + i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd               
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillDRarray3(DRvalue.i, ALvalue.i, SLvalue.i)
  
  ReDim PSGInstDRValues3(0)
  
  If DRvalue = 32 ; Sustain Level volume immedeatly
    PSGInstDRValues3(0) = SLvalue
  Else
    counterd.d     = 255 / (DRvalue * 16)
    countershift.d = counterd
    
    summoftik = SLvalue - ALvalue
    tmpval    = ALvalue
    If summoftik < 0
      summoftik = ALvalue - SLvalue
      tmpval    = SLvalue
    EndIf
    
    For i = 0 To summoftik
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstDRValues3())
        ReDim PSGInstDRValues3(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstDRValues3(k) = tmpval + i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd               
      
    Next
    
  EndIf
  
EndProcedure

Procedure FillRRarray1(RRvalue.i)
  
  ReDim PSGInstRRValues1(0)
  
  If RRvalue = 32 ; silence immediatly
    PSGInstRRValues1(0) = 15
  Else
    counterd.d     = 255 / (RRvalue * 16)
    countershift.d = counterd
    
    For i = 0 To 15
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstRRValues1())
        ReDim PSGInstRRValues1(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstRRValues1(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd    
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillRRarray2(RRvalue.i)
  
  ReDim PSGInstRRValues2(0)
  
  If RRvalue = 32 ; silence immediatly
    PSGInstRRValues2(0) = 15
  Else
    counterd.d     = 255 / (RRvalue * 16)
    countershift.d = counterd
    
    For i = 0 To 15
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstRRValues2())
        ReDim PSGInstRRValues2(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstRRValues2(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd    
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillRRarray3(RRvalue.i)
  
  ReDim PSGInstRRValues3(0)
  
  If RRvalue = 32 ; silence immediatly
    PSGInstRRValues3(0) = 15
  Else
    counterd.d     = 255 / (RRvalue * 16)
    countershift.d = counterd
    
    For i = 0 To 15
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstRRValues3())
        ReDim PSGInstRRValues3(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstRRValues3(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd    
      
    Next
    
  EndIf
  
EndProcedure

Procedure FillARarray4(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues4(0)
  
  If ARvalue = $FF Or ARvalue = 32; 0 AR, top volume immediatly
    PSGInstARValues4(0) = ALvalue
  Else
    counterd.d     = 255 / (ARvalue * 16)
    countershift.d = counterd
    
    For i = 15 To ALvalue Step -1
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstARValues4())
        ReDim PSGInstARValues4(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues4(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri ; get 0.x value
      countershift + counterd                ; 0.x + how it names...
      
    Next
    
  EndIf
  
EndProcedure

Procedure FillDRarray4(DRvalue.i, ALvalue.i, SLvalue.i)
  
  ReDim PSGInstDRValues4(0)
  
  If DRvalue = 32 ; Sustain Level volume immedeatly
    PSGInstDRValues4(0) = SLvalue
  Else
    counterd.d     = 255 / (DRvalue * 16)
    countershift.d = counterd
    
    summoftik = SLvalue - ALvalue
    tmpval    = ALvalue
    If summoftik < 0
      summoftik = ALvalue - SLvalue
      tmpval    = SLvalue
    EndIf
    
    For i = 0 To summoftik
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstDRValues4())
        ReDim PSGInstDRValues4(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstDRValues4(k) = tmpval + i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd               
      
    Next
    
  EndIf
  
EndProcedure

Procedure FillRRarray4(RRvalue.i)
  
  ReDim PSGInstRRValues4(0)
  
  If RRvalue = 32 ; silence immediatly
    PSGInstRRValues4(0) = 15
  Else
    counterd.d     = 255 / (RRvalue * 16)
    countershift.d = counterd
    
    For i = 0 To 15
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstRRValues4())
        ReDim PSGInstRRValues4(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstRRValues4(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd    
      
    Next
    
  EndIf
  
EndProcedure


Structure instr
  type.i ; 0 fm, 1 dac, 2 psg
  id$
  path$
  *image
  registers.i[27]
  algorithm.i
  psgtype.i
  psgnoise.i
  psgatrt.i
  psgsysl.i
  psgatkl.i
  psgdecr.i
  psgrelr.i  
EndStructure
Global Dim CodeInstrArr.instr(3)


Procedure PSGPlay(*Value)
  
  Repeat
    
    Select psgstart1 ;{
      Case 0 ; RR phase
        
        ;start ReliseRate - Fade out
        If curvolume1 < 15
        
          ;Debug "RR"

          For i = 0 To ArraySize(PSGInstRRValues1())
            ;get array tik
            If PSGInstRRValues1(i) >= curvolume1
              startfadeout1 = i
            
              Write(144 + PSGInstRRValues1(i))
            
              Break
            EndIf
          Next
        
          curvolume1 = 16
        
        ElseIf curvolume1 = 16
        
          If startfadeout1 <= ArraySize(PSGInstRRValues1())
          
            Write(144 + PSGInstRRValues1(startfadeout1))
          
            If PSGInstRRValues1(startfadeout1) = 15
              curvolume1 = 17 ; stop RR work
              busyflag01 = 0
            EndIf
          
            startfadeout1 + 1
          
          EndIf
        
        EndIf 
        
        
      Default ; > 0
        ;get position of sound playing
        tmppsgmarker1 = psgmarker1 - psgstart1
        
        Select PhaseOfPSG1
          Case 0 ; Attack Rate
            ;check when phase is ends    
            If PSGInstARValues1(tmppsgmarker1) <= attacklevel1
              PhaseOfPSG1 = 1
              startdecaytik1 = tmppsgmarker1 + 1
            
              ;set volume
              ;%1001000
              Write(144 +  attacklevel1)
              curvolume1 = attacklevel1
            
            Else
            
              ;set volume
              ;%1001000
              Write(144 +  PSGInstARValues1(tmppsgmarker1))
              curvolume1 = PSGInstARValues1(tmppsgmarker1)
            
            EndIf
            
            busyflag01 = 2
            
          Case 1 ; Decay Rate
            ;check when phase is ends    
            ;Debug ArraySize(PSGInstDRValues1())
            ;Debug tmppsgmarker1 - startdecaytik1
            ;Debug PSGInstDRValues1(tmppsgmarker1 - startdecaytik1)
            ;Debug sustainlevel1
            ;Debug ""
            If PSGInstDRValues1(tmppsgmarker1 - startdecaytik1) >= sustainlevel1
              PhaseOfPSG1 = 2
              busyflag01  = 1
            
              ;set volume
              ;%1001000
              Write(144 +  sustainlevel1)
              curvolume1 = sustainlevel1
            Else
            
              ;set volume
              ;%1001000
              Write(144 +  PSGInstDRValues1(tmppsgmarker1 - startdecaytik1))
              curvolume1 = PSGInstDRValues1(tmppsgmarker1 - startdecaytik1)
            
            EndIf 
            
          EndSelect
        
        psgstart1 - 1 
        
    EndSelect ;}
    
    Select psgstart2 ;{
      Case 0 ; RR phase
        
        ;start ReliseRate - Fade out
        If curvolume2 < 15
        
          Debug "RR 2"

          For i = 0 To ArraySize(PSGInstRRValues2())
            ;get array tik
            If PSGInstRRValues2(i) >= curvolume2
              startfadeout2 = i
            
              Write(176 + PSGInstRRValues2(i))
            
              Break
            EndIf
          Next
        
          curvolume2 = 16
        
        ElseIf curvolume2 = 16
        
          If startfadeout2 <= ArraySize(PSGInstRRValues2())
          
            Write(176 + PSGInstRRValues2(startfadeout2))
          
            If PSGInstRRValues2(startfadeout2) = 15
              curvolume2 = 17 ; stop RR work
              busyflag02 = 0
            EndIf
          
            startfadeout2 + 1
          
          EndIf
        
        EndIf 
        
        
      Default ; > 0
        ;get position of sound playing
        tmppsgmarker2 = psgmarker2 - psgstart2

        Select PhaseOfPSG2
          Case 0 ; Attack Rate
            ;check when phase is ends    
            If PSGInstARValues2(tmppsgmarker2) <= attacklevel2
              PhaseOfPSG2 = 1
              startdecaytik2 = tmppsgmarker2 + 1
            
              ;set volume
              ;%1001000
              Write(176 +  attacklevel2)
              curvolume2 = attacklevel2
            
            Else
            
              ;set volume
              ;%1001000
              Write(176 +  PSGInstARValues2(tmppsgmarker2))
              curvolume2 = PSGInstARValues2(tmppsgmarker2)
            
            EndIf
            
            busyflag02 = 2
            
          Case 1 ; Decay Rate
            ;check when phase is ends          
            If PSGInstDRValues2(tmppsgmarker2 - startdecaytik2) >= sustainlevel2
              PhaseOfPSG2 = 2
              busyflag02  = 1
            
              ;set volume
              ;%1001000
              Write(176 +  sustainlevel2)
              curvolume2 = sustainlevel2
            Else
            
              ;set volume
              ;%1001000
              Write(176 +  PSGInstDRValues2(tmppsgmarker2 - startdecaytik2))
              curvolume2 = PSGInstDRValues2(tmppsgmarker2 - startdecaytik2)
            
            EndIf 
            
          EndSelect
        
        psgstart2 - 1 
        
    EndSelect ;}    
    
    If fastshutdown3channel = 0
    Select psgstart3 ;{
      Case 0 ; RR phase
        
        ;start ReliseRate - Fade out
        If curvolume3 < 15
        
          ;Debug "RR"

          For i = 0 To ArraySize(PSGInstRRValues3())
            ;get array tik
            If PSGInstRRValues3(i) >= curvolume3
              startfadeout3 = i
            
              Write(208 + PSGInstRRValues3(i))
            
              Break
            EndIf
          Next
        
          curvolume3 = 16
        
        ElseIf curvolume3 = 16
        
          If startfadeout3 <= ArraySize(PSGInstRRValues3())
          
            Write(208 + PSGInstRRValues3(startfadeout3))
          
            If PSGInstRRValues3(startfadeout3) = 15
              curvolume3 = 17 ; stop RR work
              busyflag03 = 0
            EndIf
          
            startfadeout3 + 1
          
          EndIf
        
        EndIf 
        
        
      Default ; > 0
        ;get position of sound playing
        tmppsgmarker3 = psgmarker3 - psgstart3
        
        Select PhaseOfPSG3
          Case 0 ; Attack Rate
            ;check when phase is ends    
            If PSGInstARValues3(tmppsgmarker3) <= attacklevel3
              PhaseOfPSG3 = 1
              startdecaytik3 = tmppsgmarker3 + 1
            
              ;set volume
              ;%1001000
              Write(208 +  attacklevel3)
              curvolume3 = attacklevel3
            
            Else
            
              ;set volume
              ;%1001000
              Write(208 +  PSGInstARValues3(tmppsgmarker3))
              curvolume3 = PSGInstARValues3(tmppsgmarker3)
            
            EndIf
            
            busyflag03 = 2
            
          Case 1 ; Decay Rate
            ;check when phase is ends          
            If PSGInstDRValues3(tmppsgmarker3 - startdecaytik3) >= sustainlevel3
              PhaseOfPSG3 = 2
              busyflag03  = 1
            
              ;set volume
              ;%1001000
              Write(208 +  sustainlevel3)
              curvolume3 = sustainlevel3
            Else
            
              ;set volume
              ;%1001000
              Write(208 +  PSGInstDRValues3(tmppsgmarker3 - startdecaytik3))
              curvolume3 = PSGInstDRValues3(tmppsgmarker3 - startdecaytik3)
            
            EndIf 
            
          EndSelect
        
        psgstart3 - 1 
        
    EndSelect ;}
    Else
      fastshutdown3channel = 0
      Write(208 + 15)
    EndIf
    
    Select psgstart4 ;{
      Case 0 ; RR phase
        
        ;start ReliseRate - Fade out
        If curvolume4 < 15
        
          ;Debug "RR"

          For i = 0 To ArraySize(PSGInstRRValues4())
            ;get array tik
            If PSGInstRRValues4(i) >= curvolume4
              startfadeout4 = i
            
              Write(240 + PSGInstRRValues4(i))
            
              Break
            EndIf
          Next
        
          curvolume4 = 16
        
        ElseIf curvolume4 = 16
        
          If startfadeout4 <= ArraySize(PSGInstRRValues4())
          
            Write(240 + PSGInstRRValues4(startfadeout4))
          
            If PSGInstRRValues4(startfadeout4) = 15
              curvolume4 = 17 ; stop RR work
              busyflag04 = 0
              If noisetype = 3 Or noisetype = 7
                busyflag03 = 0
              EndIf
            EndIf
          
            startfadeout4 + 1
          
          EndIf
        
        EndIf 
        
        
      Default ; > 0
        ;get position of sound playing
        tmppsgmarker4 = psgmarker4 - psgstart4
        
        Select PhaseOfPSG4
          Case 0 ; Attack Rate
            ;check when phase is ends    
            If PSGInstARValues4(tmppsgmarker4) <= attacklevel4
              PhaseOfPSG4 = 1
              startdecaytik4 = tmppsgmarker4 + 1
            
              ;set volume
              ;%1001000
              Write(240 +  attacklevel4)
              curvolume4 = attacklevel4
            
            Else
            
              ;set volume
              ;%1001000
              Write(240 +  PSGInstARValues4(tmppsgmarker4))
              curvolume4 = PSGInstARValues4(tmppsgmarker4)
 
            EndIf
            
            busyflag04 = 2
            
          Case 1 ; Decay Rate
            ;check when phase is ends          
            If PSGInstDRValues4(tmppsgmarker4 - startdecaytik4) >= sustainlevel4
              PhaseOfPSG4 = 2
              busyflag04  = 1
              If noisetype = 3 Or noisetype = 7
                busyflag03 = 1
              EndIf
            
              ;set volume
              ;%1001000
              Write(240 +  sustainlevel4)
              curvolume4 = sustainlevel4
            Else
            
              ;set volume
              ;%1001000
              Write(240 +  PSGInstDRValues4(tmppsgmarker4 - startdecaytik4))
              curvolume4 = PSGInstDRValues4(tmppsgmarker4 - startdecaytik4)
            
            EndIf 
            
        EndSelect
        
        psgstart4 - 1 
        
    EndSelect ;}

    Delay(17)  ; 16.66666.... let it be 17
    
  ForEver
  
EndProcedure

Procedure GEMSPSG(note.i, instr.i, dur.i)
  
  Select CodeInstrArr(instr)\psgtype
    Case 2
  
    If busyflag01 = 0     ; free, 1 channel
      Debug "get 1 ch"
    ;set note
    writevalue = %10000000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    ;FillARarray1(CodeInstrArr(instr)\psgatrt, CodeInstrArr(instr)\psgatkl)
    ;FillDRarray1(CodeInstrArr(instr)\psgdecr, CodeInstrArr(instr)\psgatkl, CodeInstrArr(instr)\psgsysl)
    ;FillRRarray1(CodeInstrArr(instr)\psgrelr) 
    
    attackrate1   = CodeInstrArr(instr)\psgatrt
    attacklevel1  = CodeInstrArr(instr)\psgatkl
    decayrate1    = CodeInstrArr(instr)\psgdecr
    sustainlevel1 = CodeInstrArr(instr)\psgsysl
    releaserate1  = CodeInstrArr(instr)\psgrelr
    
    FillARarray1(attackrate1, attacklevel1)
    FillDRarray1(decayrate1, attacklevel1, sustainlevel1)
    FillRRarray1(releaserate1)    
    
    busyflag01 = 2
    
    psgstart1   = dur ; duration
    psgmarker1  = psgstart1
    PhaseOfPSG1 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  ElseIf busyflag02 = 0
    Debug "get 2 ch"
    ;set note
    writevalue = %10100000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    attackrate2   = CodeInstrArr(instr)\psgatrt
    attacklevel2  = CodeInstrArr(instr)\psgatkl
    decayrate2    = CodeInstrArr(instr)\psgdecr
    sustainlevel2 = CodeInstrArr(instr)\psgsysl
    releaserate2  = CodeInstrArr(instr)\psgrelr
    
    FillARarray2(attackrate2, attacklevel2)
    FillDRarray2(decayrate2, attacklevel2, sustainlevel2)
    FillRRarray2(releaserate2) 
    
    busyflag02 = 2
    
    psgstart2   = dur ; duration
    psgmarker2  = psgstart2
    PhaseOfPSG2 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  ElseIf busyflag03 = 0
    Debug "get 3 ch"
    ;set note
    writevalue = %11000000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    attackrate3   = CodeInstrArr(instr)\psgatrt
    attacklevel3  = CodeInstrArr(instr)\psgatkl
    decayrate3    = CodeInstrArr(instr)\psgdecr
    sustainlevel3 = CodeInstrArr(instr)\psgsysl
    releaserate3  = CodeInstrArr(instr)\psgrelr
    
    FillARarray3(attackrate3, attacklevel3)
    FillDRarray3(decayrate3, attacklevel3, sustainlevel3)
    FillRRarray3(releaserate3) 
    
    busyflag03 = 2
    
    psgstart3   = dur ; duration
    psgmarker3  = psgstart3
    PhaseOfPSG3 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  ElseIf busyflag01 = 1 ; soft busy
    Debug "get 1 ch soft"
    ;set note
    writevalue = %10000000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    attackrate1   = CodeInstrArr(instr)\psgatrt
    attacklevel1  = CodeInstrArr(instr)\psgatkl
    decayrate1    = CodeInstrArr(instr)\psgdecr
    sustainlevel1 = CodeInstrArr(instr)\psgsysl
    releaserate1  = CodeInstrArr(instr)\psgrelr
    
    FillARarray1(attackrate1, attacklevel1)
    FillDRarray1(decayrate1, attacklevel1, sustainlevel1)
    FillRRarray1(releaserate1)    
    
    busyflag01 = 2
    
    psgstart1   = dur ; duration
    psgmarker1  = psgstart1
    PhaseOfPSG1 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  ElseIf busyflag02 = 1
    Debug "get 2 ch soft"
    ;set note
    writevalue = %10100000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    attackrate2   = CodeInstrArr(instr)\psgatrt
    attacklevel2  = CodeInstrArr(instr)\psgatkl
    decayrate2    = CodeInstrArr(instr)\psgdecr
    sustainlevel2 = CodeInstrArr(instr)\psgsysl
    releaserate2  = CodeInstrArr(instr)\psgrelr
    
    FillARarray2(attackrate2, attacklevel2)
    FillDRarray2(decayrate2, attacklevel2, sustainlevel2)
    FillRRarray2(releaserate2) 
    
    busyflag02 = 2
    
    psgstart2   = dur ; duration
    psgmarker2  = psgstart2
    PhaseOfPSG2 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  ElseIf busyflag03 = 1
    Debug "get 3 ch soft"
    ;set note
    writevalue = %11000000 + GetBits(PSGnote(note), 0, 3)
    Write(writevalue)
    writevalue = GetBits(PSGnote(note), 4, 9)
    Write(writevalue)
    
    ;set instrument
    attackrate3   = CodeInstrArr(instr)\psgatrt
    attacklevel3  = CodeInstrArr(instr)\psgatkl
    decayrate3    = CodeInstrArr(instr)\psgdecr
    sustainlevel3 = CodeInstrArr(instr)\psgsysl
    releaserate3  = CodeInstrArr(instr)\psgrelr
    
    FillARarray3(attackrate3, attacklevel3)
    FillDRarray3(decayrate3, attacklevel3, sustainlevel3)
    FillRRarray3(releaserate3) 
    
    busyflag03 = 2
    
    psgstart3   = dur ; duration
    psgmarker3  = psgstart3
    PhaseOfPSG3 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
    
  EndIf
  
    Case 3 ; noise
      
      ;set data
      writevalue = %11100000 + CodeInstrArr(instr)\psgnoise
      Write(writevalue) 
      
      ;set instrument
      attackrate4   = CodeInstrArr(instr)\psgatrt
      attacklevel4  = CodeInstrArr(instr)\psgatkl
      decayrate4    = CodeInstrArr(instr)\psgdecr
      sustainlevel4 = CodeInstrArr(instr)\psgsysl
      releaserate4  = CodeInstrArr(instr)\psgrelr
    
      FillARarray4(attackrate4, attacklevel4)
      FillDRarray4(decayrate4, attacklevel4, sustainlevel4)
      FillRRarray4(releaserate4) 
      
      If CodeInstrArr(instr)\psgnoise = 3 Or CodeInstrArr(instr)\psgnoise = 7        
        busyflag03 = 2
        writevalue = %11000000 + GetBits(PSGnote(note), 0, 3)
        Write(writevalue)
        writevalue = GetBits(PSGnote(note), 4, 9)
        Write(writevalue)
      EndIf
      
      psgstart4   = dur ; duration
      psgmarker4  = psgstart4
      PhaseOfPSG4 = 0
      
      
      
  EndSelect
  
EndProcedure


SetClock(3579545)



If OpenWindow(#Window, 100, 200, 420, 140, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
  
  ButtonGadget(#Gadget, 10, 40, 50, 20, "play")
  
  ;type1         = 2
  ;noisedata1    = 0
  ;attackrate1   = $10
  ;sustainlevel1 = $05
  ;attacklevel1  = $00
  ;decayrate1    = $05
  ;releaserate1  = $14
  
  ;duration1     = 60
  ;note1         = 56;$40
  
  ;FillARarray1(attackrate1, attacklevel)
  ;FillDRarray1(decayrate1, attacklevel, sustainlevel1)
  ;FillRRarray1(releaserate1) 
  
  CodeInstrArr(1)\psgtype = 2
  CodeInstrArr(1)\psgatrt = $10
  CodeInstrArr(1)\psgsysl = $05
  CodeInstrArr(1)\psgatkl = $00
  CodeInstrArr(1)\psgdecr = $05
  CodeInstrArr(1)\psgrelr = $14
  
  CodeInstrArr(2)\psgtype = 2
  CodeInstrArr(2)\psgatrt = $14
  CodeInstrArr(2)\psgsysl = $07
  CodeInstrArr(2)\psgatkl = $05
  CodeInstrArr(2)\psgdecr = $05
  CodeInstrArr(2)\psgrelr = $14
  
  CodeInstrArr(3)\psgtype = 3
  CodeInstrArr(3)\psgnoise = 7
  CodeInstrArr(3)\psgatrt = 32;$14
  CodeInstrArr(3)\psgsysl = $07
  CodeInstrArr(3)\psgatkl = $01
  CodeInstrArr(3)\psgdecr = $05
  CodeInstrArr(3)\psgrelr = $14
  
  CreateThread(@PSGPlay(), 123)
  
  Repeat
    Event = WaitWindowEvent()
    
    Select Event
      Case #PB_Event_Gadget
        EvGadget = EventGadget()
        Select EvGadget
            
          Case #Gadget
            ;set frequency
            ;0 ch, tone
            ;writevalue = %10000000 + GetBits(PSGnote(note1), 0, 3)
            ;Write(writevalue)
            ;writevalue = GetBits(PSGnote(note1), 4, 9)
            ;Write(writevalue)
            ;psgstart1   = duration1 ; duration
            ;psgmarker1  = psgstart1
            ;PhaseOfPSG1 = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
            
            ;If flag 
            ;  GEMSPSG(56, 1, 60)
            ;  flag = 0
            ;Else
            ;  GEMSPSG(57, 2, 60)
            ;  flag = 1
            ;EndIf
            
            
            
            GEMSPSG(57, 1, 50)
            GEMSPSG(77, 3, 5)
            
            ;writevalue = %11000000 + GetBits(PSGnote(note), 0, 3)
            ;Write(writevalue)
            ;writevalue = GetBits(PSGnote(note), 4, 9)
            ;Write(writevalue)
            
            ;Write(%10010000 + 5)
            ;Write(%10110000 + 5)
            ;Write(%11010000 + 5)
            
            ;writevalue = %11100000 + 7
            ;Write(writevalue)
            ;Write(%11110000 + 10)
            
            
        EndSelect
        
      Case #PB_Event_CloseWindow
        Quit = 1 

    EndSelect    

  Until Quit = 1 
  
EndIf
too ugly as always :) and test shows some cases PSG have only 3 channels, not 4. i mean cases when noise is 3 or 7 - when he need to get frequency from 2 channel, so my system is bussy 2 channels some times, not 1. for show it - change
CodeInstrArr(3)\psgnoise = 7 to CodeInstrArr(3)\psgnoise = 6 or any, exept 3. after this tone will get three channels, not only two. when 7 or 3 - tone will get only 2 channels.

but then, when i plug this into main project - it make me cry :) timers is different... i forgot it. so now it need full remade. duration for GEMS it is not same as duration for PSG. i make a little wrong playing process. Attack Phase and Systain Phase - must play in GEMS duration, Relise Phase must play in PSG duration. but i make all playing in PGS duration. this is make me a lot of cry :)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

this overlimit of arrays is killing me... need to think how to fix it.
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

can you ideas how to teach programm catch algorithm? by eyes i can set instrument with my tool, but how to make it automaticaly? first it is what monitors of VGM song shows. second it is my instrument testing programm. i set closest values, but how to teach programm do it by her self?
Image
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Noob's investigation of VGM

Post by wilbert »

SeregaZ wrote:can you ideas how to teach programm catch algorithm? by eyes i can set instrument with my tool, but how to make it automaticaly? first it is what monitors of VGM song shows. second it is my instrument testing programm. i set closest values, but how to teach programm do it by her self?
I guess just compare with the previous volume.
As long as it is increasing, you are in the attack phase.
When the volume doesn't change, it's the sustain phase.
When the volume is decreasing, it is either the decay (sustain hasn't happened yet) or release (sustain already has happened) phase.
Windows (x64)
Raspberry Pi OS (Arm64)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

easy to say :) attack level can be lower, than systain level :))) this function will need a looooot of thinking...
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

i think to make some trakker programm for it. i think it will help with convert process. i will put some matrix over VGM file. so i start from excel-like window. but i think your OS will not like it... it have winapi for cursors and callback. and midi for demo:

Code: Select all

;ver 1.1
Structure RowData
  Height.i
  HeaderText.s 
EndStructure

Structure ColumnData
  Width.i
  HeaderText.s 
EndStructure

Global Dim Rows.RowData(0)
Global Dim Columns.ColumnData(0)
Global FirstVisibleRow.i,FirstVisibleColumn.i  
Global LastVisibleRow.i,LastVisibleColumn.i  
Global cvsGrid.i,Gridrows.i,GridColumns.i
Global CellTop.i,CellLeft.i,Cellbottom.i,CellRight.i
Global scrVertical.i,scrHorizontal.i
Define MainWindow.i,txtRow.i,cmbRow.i,txtRowHeight.i,btnCommit.i,HScroll.i,VScroll.i,txtCoordinates.i
Define SGridArray
Global Dim SGridArray.s(0,0)

Global cvsGrdH, cvsGrdW

;Cells
Global xw.i = 50, yh.i = 20



Structure rows
  notelength.i
EndStructure
Structure notesarray  
  ;row.rows[30]
  row.i
  notelength.i
  shadow.i
  shadowrow.i
EndStructure
Global Dim Notes.notesarray(26)
Global selectednote.i

Procedure GetRowPix(RowNum.i)
  
  ;Header Row?
  If RowNum = 0
    CellTop = 0
    CellBottom = Rows(0)\Height 
  Else
  
  CellTop = Rows(0)\Height
  CellBottom = 0
  
  For i = FirstVisibleRow To LastVisibleRow ;Grid width
    If i < RowNum
      CellTop = CellTop + Rows(i)\Height
    Else
      CellBottom = CellTop + Rows(i)\Height     
      Break
    EndIf
  Next i
EndIf

EndProcedure

Procedure GetColPix(ColNum.i)
  
  ;Header Column?
  If ColNum = 0
    CellLeft = 0
    CellRight = Columns(0)\Width 
  Else
    CellLeft = Columns(0)\Width
    CellRight = 0
    For i = FirstVisibleColumn To LastVisibleColumn ;Grid width
      If i < ColNum
        CellLeft = CellLeft + Columns(i)\Width
      Else
        CellRight = CellLeft + Columns(i)\Width        
        Break
      EndIf
    Next i
  EndIf
  
EndProcedure

Procedure SetcellText(Row,Column,Text.s)
  
  If (Row => FirstVisibleRow And row <= LastVisibleRow) Or row = 0
    If (Column => FirstVisibleColumn And column <= LastVisibleColumn) Or column = 0
      ;Display Now
      GetColPix(Column) 
      GetRowPix(Row) 
 
      Define Startx = CellLeft + 2 
      Define Starty = CellTop + 2 
      StartDrawing(CanvasOutput(cvsGrid))
      DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent) 
      DrawText(Startx,Starty, Text,RGB(0,0,0))
      StopDrawing()
    EndIf
  EndIf

EndProcedure

Procedure SetRowDefaults()
  
  Define LoopCounter.i = 0

  For LoopCounter = 0 To GridRows
    Rows(Loopcounter)\HeaderText = Str(LoopCounter)
    Rows(Loopcounter)\Height = yh
  Next LoopCounter
  
EndProcedure

Procedure SetColumnDefaults()
  
  Define LoopCounter.i = 0

  For LoopCounter = 0 To GridColumns
    Columns(Loopcounter)\HeaderText = Chr(LoopCounter + 64)
    Columns(Loopcounter)\Width = xw
  Next LoopCounter
  
EndProcedure

Global baseimage
Procedure DrawGrid()
  
  CopyImage(baseimage, gadgetimage)
  
  LastVisibleRow    = FirstVisibleRow    + 18 ; row per page
  LastVisibleColumn = FirstVisibleColumn + 10 ; column per page  
  
  If StartDrawing(ImageOutput(gadgetimage))
    DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent) 
    
    For iLoop = FirstVisibleRow To LastVisibleRow
      
      Column = 0      
      
      If (iLoop => FirstVisibleRow And iLoop <= LastVisibleRow) Or iLoop = 0
        If (Column => FirstVisibleColumn And column <= LastVisibleColumn) Or column = 0
          ;Display Now
          GetColPix(Column) 
          GetRowPix(iLoop) 
 
          Startx = CellLeft + 2 
          Starty = CellTop + 2 

          DrawText(Startx, Starty, Rows(iLoop)\HeaderText, RGB(0,0,0))

        EndIf
      EndIf

    Next iLoop    

    For iLoop = FirstVisibleColumn To LastVisibleColumn
      Row    = 0
      Column = iLoop        
      If (Row => FirstVisibleRow And row <= LastVisibleRow) Or row = 0
        If (Column => FirstVisibleColumn And column <= LastVisibleColumn) Or column = 0
          ;Display Now
          GetColPix(Column) 
          GetRowPix(Row) 
 
          Startx = CellLeft + 2 
          Starty = CellTop + 2 

          DrawText(Startx,Starty, Columns(iLoop)\HeaderText, RGB(0,0,0))
        EndIf
      EndIf
        
    Next iLoop
    
    
    For icolums = FirstVisibleColumn To FirstVisibleColumn + 10
      For irows = FirstVisibleRow To LastVisibleRow
        
        If Notes(icolums)\notelength And Notes(icolums)\row = irows

          Startx = (icolums - FirstVisibleColumn) * xw + xw
          Starty = (irows - FirstVisibleRow) * 20 + 20
          
          If Notes(icolums)\notelength = 1
            If selectednote = icolums
              ; with select - more dark
              Box( Startx + 2,   Starty + 2, 47, 17, RGB(150, 50, 150))
            Else
              ; no select
              Box( Startx + 2,   Starty + 2, 47, 17, RGB(200, 100, 200))
            EndIf
            Line(Startx + 1,  Starty + 19, 49,  1, RGB(170,  40, 170))
            Line(Startx + 49,  Starty + 1, 1,  19, RGB(170,  40, 170))
            Break
          Else
            
            notewidth = (50 * Notes(icolums)\notelength) - 3
            
            If selectednote = icolums
              ; with select - more dark
              Box( Startx + 2,   Starty + 2, notewidth, 17, RGB(150, 50, 150))
            Else
              ; no select
              Box( Startx + 2,   Starty + 2, notewidth, 17, RGB(200, 100, 200))
            EndIf
            Line(Startx + 1,  Starty + 19, notewidth + 2,  1, RGB(170,  40, 170))
            Line(Startx + notewidth + 2,  Starty + 1, 1,  19, RGB(170,  40, 170))
            
            
            icolums + (Notes(icolums)\notelength - 1) ; overjump per note length
            Break
          EndIf
          
        ElseIf Notes(icolums)\shadow And Notes(icolums)\shadowrow = irows

          Startx = (icolums - FirstVisibleColumn) * xw + xw
          Starty = (irows - FirstVisibleRow) * 20 + 20
          
          Box( Startx + 2,   Starty + 2, 47, 17, RGB(200, 200, 200))
          
          ;Break
          
        EndIf
        
      Next
    Next
    
    StopDrawing() 
    
  EndIf
  
  SetGadgetAttribute(cvsGrid, #PB_Canvas_Image, ImageID(gadgetimage)) 
  
EndProcedure


;{ midi
Global hMidiOut

Global midi.MIDIOUTCAPS
Global devices = midiOutGetNumDevs_()

For devnum=-1 To devices-1
  If midiOutGetDevCaps_(devnum,@midi,SizeOf(MIDIOUTCAPS))=0
    If midi\wVoices >0
      Global midiport=devnum
    EndIf
  EndIf
Next

Procedure MidiOutMessage(hMidi,iStatus,iChannel,iData1,iData2)
  dwMessage = iStatus | iChannel | (iData1 << 8 ) | (iData2 << 16)
  ProcedureReturn midiOutShortMsg_(hMidi, dwMessage) ;
EndProcedure
 
Procedure SetInstrument(channel,instrument)
  MidiOutMessage(hMidiOut, $C0,  channel, instrument, 0)
EndProcedure
 
Procedure PlayNote(channel,Note,velocity)
  MidiOutMessage(hMidiOut, $90, channel, Note , velocity)
EndProcedure

Procedure StopNote(channel,Note)
  MidiOutMessage(hMidiOut, $90, channel, Note , 0)
EndProcedure

Procedure MIDIVolume(Channel,Volume)
  midiOutShortMsg_(hMidiOut,$B0 | Channel | $700 | Volume << 16 )
EndProcedure
;}



Global mousewheelmonitoring
Procedure WinCallback(hWnd, uMsg, WParam, LParam) 
  ; Windows fills the parameter automatically, which we will use in the callback...
  
  ;Debug uMsg
  Select uMsg
    Case 522        ; mousewheel
      Select mousewheelmonitoring
        Case 1 ; vertical
          If WParam > 0 ; up
            verticalvalue = GetGadgetState(scrVertical) - 1
            If verticalvalue > 0
              SetGadgetState(scrVertical, verticalvalue)
              FirstVisibleRow = verticalvalue
              DrawGrid()
            EndIf
          Else          ; down
            verticalvalue = GetGadgetState(scrVertical) + 1
            If verticalvalue < 12 ; who knows how it count...
              SetGadgetState(scrVertical, verticalvalue)
              FirstVisibleRow = verticalvalue
              DrawGrid()
            EndIf
          EndIf
        Case 2 ; horizont
          If WParam > 0 ; up
            horizontvalue = GetGadgetState(scrHorizontal) - 1
            If horizontvalue > 0
              SetGadgetState(scrHorizontal, horizontvalue)
              FirstVisibleColumn = horizontvalue
              DrawGrid()
            EndIf
          Else          ; down
            horizontvalue = GetGadgetState(scrHorizontal) + 1
            If horizontvalue < 16 ; again - no idea :)
              SetGadgetState(scrHorizontal, horizontvalue)
              FirstVisibleColumn = horizontvalue
              DrawGrid()
            EndIf
          EndIf
      EndSelect
  EndSelect
  
  ProcedureReturn #PB_ProcessPureBasicEvents 
EndProcedure 


Global treadquit
Procedure PlayProc(*Value)
  
  For i = 1 To 26
    
    If treadquit
      Break
    EndIf
    
    If Notes(i)\notelength
      StopNote(1, oldnote)
      PlayNote(1, 80-Notes(i)\row, 127)
      oldnote = 80-Notes(i)\row
    EndIf

    Delay(100)
    
  Next 
  
  StopNote(1, oldnote)
  
EndProcedure

Procedure scrVertical()
  If FirstVisibleRow <> GetGadgetState(scrVertical)
    FirstVisibleRow = GetGadgetState(scrVertical) 
    DrawGrid()
  EndIf
EndProcedure
 
Procedure scrHorizontal()
  If FirstVisibleColumn <> GetGadgetState(scrHorizontal) 
    FirstVisibleColumn = GetGadgetState(scrHorizontal) 
    DrawGrid()  
  EndIf
EndProcedure

baseimage  = CreateImage(#PB_Any,700,400,32,RGB(255,255,255))
GridWidth  = 600
GridHeight = 400 

GridRows = 30
GridColumns = 26
ReDim Rows(Gridrows)
ReDim Columns(GridColumns)

SetRowDefaults()
SetColumnDefaults()
FirstVisibleRow = 1
FirstVisibleColumn = 1

If StartDrawing(ImageOutput(baseimage))
  DrawingMode(#PB_2DDrawing_Default|#PB_2DDrawing_Transparent)
  
  ;Column Header
  Box(0,0,GridWidth,Rows(0)\Height,RGB(153,204,255))
  startx = Columns(0)\Width
  
  ;Row Header
  Box(0,0,Columns(0)\Width, GridHeight,RGB(153,204,255))
  starty = Rows(0)\Height
  
  DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_Transparent)
  
  ;All Other Columns
  For iLoop = FirstVisibleColumn To GridColumns - 1
    Box(Startx,0,Columns(iLoop)\Width + 1,GridHeight,RGB(0,0,0))
    ;DrawingMode(#PB_2DDrawing_Outlined|#PB_2DDrawing_Transparent)
    Startx = Startx + Columns(iLoop)\Width
    LastVisibleColumn = iLoop
    If Startx > GridWidth
      ;No More Columns Visible
      Break
    EndIf
  Next iLoop 
  
  ;All Other Rows
  For iLoop = FirstVisibleRow To GridRows - 1
    Box(0,Starty,GridWidth,Rows(iLoop)\Height + 1,RGB(0,0,0))
    Starty = Starty + Rows(iLoop)\Height
    LastVisibleRow = iLoop
    If Starty > 400 ;GridHeight
      ;No More Rows Visible After This
      Break
    EndIf
  Next iLoop

  StopDrawing()
EndIf


cur0 = LoadCursor_(0, #IDC_ARROW)
cur1 = LoadCursor_(0, #IDC_SIZEWE) ; left-right
cur2 = LoadCursor_(0, #IDC_SIZENS) ; up-down

MouseRect.RECT

MainWindow      = OpenWindow(#PB_Any, 0, 0, 651, 480, "", #PB_Window_SystemMenu)
If MainWindow And midiOutOpen_(@hMidiOut,midiport,0,0,0) = #MMSYSERR_NOERROR
  
  ;cvsGrid       = CanvasGadget(#PB_Any, 25, 50, 600, 400)
  cvsGrdX1      = 25
  cvsGrdW       = 600
  cvsGrdX2      = cvsGrdX1 + cvsGrdW
  cvsGrdY1      = 50
  cvsGrdH       = 400
  cvsGrdY2      = cvsGrdY1 + cvsGrdH
  cvsGrid       = CanvasGadget(#PB_Any, cvsGrdX1, cvsGrdY1, cvsGrdW, cvsGrdH)
  
  txtRow        = TextGadget(#PB_Any, 20, 10, 30, 20, "Row", #PB_Text_Right)
  cmbRow        = ComboBoxGadget(#PB_Any, 60, 10, 60, 20)
  txtRowHeight  = TextGadget(#PB_Any, 130, 10, 40, 20, "Height")
  strRowHeight  = StringGadget(#PB_Any, 180, 10, 60, 20, "")
  btnCommit     = ButtonGadget(#PB_Any, 250, 10, 70, 20, "Commit")
  DisableGadget(cmbRow, 1)
  DisableGadget(strRowHeight, 1)
  DisableGadget(btnCommit, 1)
  
  ;scrVertical   = ScrollBarGadget(#PB_Any, 625, 50, 20, 400, 1, 30, 10, #PB_ScrollBar_Vertical)
  scrVerX1      = 626
  scrVerW       = 20
  scrVerX2      = scrVerX1 + scrVerW  
  scrVerY1      = 50
  scrVerH       = 400
  scrVerY2      = scrVerY1 + scrVerH
  scrVertical   = ScrollBarGadget(#PB_Any, scrVerX1, scrVerY1, scrVerW, scrVerH, 1, 30, 20, #PB_ScrollBar_Vertical)
  
  ;scrHorizontal = ScrollBarGadget(#PB_Any, 25, 450, 600, 20, 1, 26, 5)
  scrHorX1      = 25
  scrHorW       = 600
  scrHorX2      = scrHorX1 + scrHorW
  scrHorY1      = 450
  scrHorH       = 20
  scrHorY2      = scrHorY1 + scrHorH  
  scrHorizontal = ScrollBarGadget(#PB_Any, scrHorX1, scrHorY1, scrHorW, 20, 1, 26, 12)
  
  ;Number of rows in the grid. This is not the displayed rows but the number of rows in the underlying grid array.
  ;GridRows = 30
  ;GridColumns = 26
  ;ReDim Rows(Gridrows)
  ;ReDim Columns(GridColumns)

  ;SetRowDefaults()
  ;SetColumnDefaults()
  ;FirstVisibleRow = 1
  ;FirstVisibleColumn = 1
  ;DrawGrid()
  
  
  
  
  
  ;SetGadgetAttribute(cvsGrid, #PB_Canvas_Image, ImageID(baseimage)) 
  DrawGrid()

  ;Add row numbers to the row selection combo
  For LoopCounter = 0 To GridRows
    AddGadgetItem(cmbRow,-1,Str(LoopCounter))
  Next LoopCounter 
  
  txtCoordinates  = TextGadget(#PB_Any, 400, 10, 40, 20, "")
  
  btnPlay         = ButtonGadget(#PB_Any, 500, 10, 50, 20, "Play")
  btnStop         = ButtonGadget(#PB_Any, 570, 10, 50, 20, "Stop")
  
  SetWindowCallback(@WinCallback())
  BindGadgetEvent(scrVertical, @scrVertical())
  BindGadgetEvent(scrHorizontal, @scrHorizontal())
  
  Repeat
    
    Event = WaitWindowEvent()
    Select event

      Case #PB_Event_Gadget
        Select EventGadget()
          
          Case btnCommit
            If Len(GetGadgetText(cmbRow)) > 0
              If Val(GetGadgetText(strRowHeight)) > 0
                Rows(Val(GetGadgetText(cmbRow)))\Height = Val(GetGadgetText(strRowHeight)) 
                DrawGrid() 
              EndIf
            EndIf
          
          ;Case scrVertical            
          ;  If FirstVisibleRow <> GetGadgetState(scrVertical)
          ;    FirstVisibleRow = GetGadgetState(scrVertical) 
          ;    DrawGrid()
          ;  EndIf
          
          ;Case scrHorizontal
          ;  If FirstVisibleColumn <> GetGadgetState(scrHorizontal) 
          ;    FirstVisibleColumn = GetGadgetState(scrHorizontal) 
          ;    DrawGrid()  
          ;  EndIf
            
          Case cvsGrid
            EvType = EventType()
            If EvType = #PB_EventType_LeftDoubleClick; #PB_EventType_LeftClick
              If Notes(ColumdId+FirstVisibleColumn)\row = RowId+FirstVisibleRow
                Notes(ColumdId+FirstVisibleColumn)\notelength = 0
                Notes(ColumdId+FirstVisibleColumn)\row = 0
                For i = FirstVisibleColumn To LastVisibleColumn
                  Notes(i)\shadow = 0
                  Notes(i)\shadowrow = 0
                Next
              Else
                Notes(ColumdId+FirstVisibleColumn)\row = RowId+FirstVisibleRow
                Notes(ColumdId+FirstVisibleColumn)\notelength = 1
              EndIf
              DrawGrid()
            ElseIf EvType = #PB_EventType_LeftButtonDown 
              If move = 1 ; probably start move or make longer note
                dragstartflag = 1
                notestart     = ColumdId+FirstVisibleColumn
                SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_LeftRight) 
                StickyWindow(MainWindow, 1)
                GetWindowRect_(GadgetID(cvsGrid),MouseRect.RECT)
                MouseRect\top  + yh
              
                leftlimit = 0
                For i = notestart-1 To FirstVisibleColumn Step -1
                  If Notes(i)\notelength
                    leftlimit = i * xw
                    Break
                  EndIf
                Next
                MouseRect\left + leftlimit + xw + 1 ; from previous note and from 0 column
                                                  ; +1 becouse cant detect column

                rightlimit = 0
                For i = notestart+1 To LastVisibleColumn
                  If Notes(i)\notelength
                    rightlimit = i * xw
                    rightlimit = MouseRect\right - rightlimit 
                    Break
                  EndIf
                Next
                MouseRect\right - rightlimit + 28 ;no idea where this 28 is gets
              
                ClipCursor_(MouseRect) 
                
              ElseIf move = 2
                dragstartflag = 1
                notestart     = ColumdId+FirstVisibleColumn
                SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_LeftRight) 
                StickyWindow(MainWindow, 1)
                GetWindowRect_(GadgetID(cvsGrid),MouseRect.RECT)
                MouseRect\top + yh
                MouseRect\top + RowId * yh
                
                MouseRect\bottom = MouseRect\top + yh               
                
                leftlimit = ColumdId * xw
                MouseRect\left + leftlimit + xw + 1
                
                rightlimit = 0
                For i = notestart+1 To LastVisibleColumn
                  If Notes(i)\notelength
                    rightlimit = i * xw
                    rightlimit = MouseRect\right - rightlimit 
                    Break
                  EndIf
                Next
                MouseRect\right - rightlimit + 28 ;no idea where this 28 is gets
                
                ClipCursor_(MouseRect) 
                
                
              EndIf
            ElseIf EvType = #PB_EventType_LeftClick
              
              If Notes(ColumdId+FirstVisibleColumn)\notelength And Notes(ColumdId+FirstVisibleColumn)\row = RowId+FirstVisibleRow
                selectednote = ColumdId+FirstVisibleColumn
                DrawGrid()
              EndIf

            EndIf
            
          Case btnPlay
            treadquit = 0
            Delay(110)
            CreateThread(@PlayProc(), 1)
            
          Case btnStop
            treadquit = 1
          
        EndSelect
        
      Case 512 ; mouse move
        xmouse = WindowMouseX(MainWindow)
        ymouse = WindowMouseY(MainWindow)
        
        Select xmouse
          Case scrVerX1 To scrVerX2;, cvsGrdX1 To cvsGrdX2
            Select ymouse
              Case scrVerY1 To scrVerY2
                ;Debug "over vert scrollbar" 
                mousewheelmonitoring = 1
            EndSelect
          Case scrHorX1 To scrHorX2 
            Select ymouse
              Case scrHorY1 To scrHorY2
                ;Debug "over horiz scrollbar"  
                mousewheelmonitoring = 2
              Case cvsGrdY1 To cvsGrdY2
                mousewheelmonitoring = 1 ; over canvas field
                                         ; i know canvas have mouse enter and out value
                                         ; but i think it will work not very properly
                                         ; when mouse come from canvas to horizontal gadget
                
                xcolpos = xmouse - 75 ; 75 = from border of window to A column
                yrowpos = ymouse - 70
                If xcolpos > 0 And yrowpos > 0
                  ColumdId = xcolpos / xw
                  RowId    = yrowpos / 20
                  SetGadgetText(txtCoordinates, Columns(ColumdId + FirstVisibleColumn)\HeaderText + Rows(RowId + FirstVisibleRow)\HeaderText)
                  
                  ; move note case
                  If dragstartflag = 1
                    ; paint shadows
                    If move = 1
                      ;single shadow
                      If ColumdId + FirstVisibleColumn <> notestart
                        For i = FirstVisibleColumn To LastVisibleColumn ;notestart - 1
                          Notes(i)\shadow = 0 ; delete all shadows
                        Next
                        
                        ;set single shadow
                        Notes(ColumdId + FirstVisibleColumn)\shadow = 1
                        Notes(ColumdId + FirstVisibleColumn)\shadowrow = RowId + FirstVisibleRow
                      Else
                        For i = FirstVisibleColumn To LastVisibleColumn
                          Notes(i)\shadow = 0 ; delete all shadows
                        Next
                      EndIf
                    ElseIf move = 2
                      ;multipleshadow
                      If ColumdId + FirstVisibleColumn > notestart ; only to right
                        
                        For i = FirstVisibleColumn To LastVisibleColumn
                          Notes(i)\shadow = 0 ; delete all old shadows
                        Next

                        For i = notestart + 1 To ColumdId + FirstVisibleColumn
                          Notes(i)\shadow = 1
                          Notes(i)\shadowrow = RowId + FirstVisibleRow
                        Next
                        
                      Else
                        For i = FirstVisibleColumn To LastVisibleColumn
                          Notes(i)\shadow = 0 ; delete all shadows
                        Next
                      EndIf
                    Else
                      If ColumdId + FirstVisibleColumn < notestart
                        For i = FirstVisibleColumn To notestart - 1
                          Notes(i)\shadow = 0
                          If i >= ColumdId + FirstVisibleColumn
                            Notes(i)\shadow = 1
                            Notes(i)\row    = RowId + FirstVisibleRow
                          EndIf
                        Next
                      EndIf
                    EndIf
                    DrawGrid()
                    
                  ; show arrow cursor case
                  ElseIf Notes(ColumdId + FirstVisibleColumn)\notelength And Notes(ColumdId + FirstVisibleColumn)\row = RowId + FirstVisibleRow
                    arrows = xcolpos - (ColumdId * xw)
                    ;recount move2 case coordinates
                    startcrd = 46
                    endcrd   = 49
                    If Notes(ColumdId + FirstVisibleColumn)\notelength > 1
                      startcrd = (Notes(ColumdId + FirstVisibleColumn)\notelength - 1) * 50 + startcrd
                      endcrd   = startcrd + 3
                    EndIf
                      
                    Select arrows
                      Case 0 To 3
                        ;If ColumdId ; not starts on 1 column, only from 2 - wrong idea
                          SetCursor_(cur1) ; move left
                          ;SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_LeftRight) 
                          move = 1
                        ;EndIf
                      Case startcrd To endcrd ; from scrVerY1, 50
                        SetCursor_(cur1) ; make longer
                        move = 2
                      Default
                        move = 0
                        ;SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_Default) 
                      ;  arrows = yrowpos - (RowId * 20)
                      ;  Select arrows
                      ;    Case 0 To 3, 16 To 19
                      ;      SetCursor_(cur2)
                      ;  EndSelect                        
                    EndSelect
                  EndIf
                Else
                  ColumdId = -1
                  RowId    = -1
                EndIf                
                
            EndSelect
          Default 
            mousewheelmonitoring = 0                        
        EndSelect
        
      Case 514 ;{ mouse relise
        If dragstartflag = 1   ; if dragndrop was turn on...
          If move = 1
            move = 0
            dragstartflag = 0
            SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_Default) 
            ClipCursor_(0) 
            StickyWindow(MainWindow, 0)
            ; reallocate note
            Notes(ColumdId + FirstVisibleColumn)\notelength = Notes(notestart)\notelength
            Notes(ColumdId + FirstVisibleColumn)\row        = RowId + FirstVisibleRow
           
            If ColumdId + FirstVisibleColumn <> notestart 
              Notes(notestart)\notelength = 0
              Notes(notestart)\row        = 0
            EndIf
           
            DrawGrid()
            
          ElseIf move = 2
            move = 0
            dragstartflag = 0
            SetGadgetAttribute(cvsGrid, #PB_Canvas_Cursor, #PB_Cursor_Default) 
            ClipCursor_(0) 
            StickyWindow(MainWindow, 0)
            
            If ColumdId + FirstVisibleColumn <> notestart 
              Notes(notestart)\notelength = (ColumdId + FirstVisibleColumn - notestart) + 1
            EndIf
            
            DrawGrid()
            
          EndIf

         EndIf ;}
    EndSelect
  
  
  Until Event = #PB_Event_CloseWindow
  midiOutClose_(hMidiOut)
  End

EndIf
it have doubleclick for note create, one click for select, near left border of note - dragndrop and move note, near right border - can make larger note (make smaller not work yet). and do not move scrollbars - now it have wrong count :)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

wilbert, you are live? :) have you windows, or you still use another type of OS? i need a little consultation... but probably it will need a windows. it is becouse - timers and dll. that ym2612's dll probably need a windows.
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

i am trying to make play some song from Rock n Roll Racing game. i have asm file for that song, i am parse that file, and send values to registers. everything work fine, exept pitches - bend and follow commands - i cant to recreate same effects, that original driver have.
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Noob's investigation of VGM

Post by wilbert »

SeregaZ wrote:have you windows, or you still use another type of OS?
My main OS is MacOS.
I do have Windows 10 in a VM but don't use it very often.
Windows (x64)
Raspberry Pi OS (Arm64)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

aha! it means you will hear sound? :)

one my friend give some source: https://gist.github.com/realmonster/c11 ... c4396dfb90

but before it he explaine by words main items. so i am try to recreate this and no succes. my bend and follow effects not as original :(

probably i have some mistake with freq_bend(int cn) and bend_to_target(int cn). it code have some ((x>>8)&1) - but probably it always 0 for that song. original code probably have 2 timers, or counters. one is constant value is 200 = probably 16 millisec. second is depend from bpm. for 150 bpm = it some kind of 33 millisec. so i am not make that count, just set delay 16, and flag for miss one tik or that timer. FM part work every 2 tiks, bend and follow part every 1 tik.


i will make arhive to send to you.
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

can you see by one eye? i think to read speed of bend and follow need to be read as byte, not as .a
wilbert
PureBasic Expert
PureBasic Expert
Posts: 3870
Joined: Sun Aug 08, 2004 5:21 am
Location: Netherlands

Re: Noob's investigation of VGM

Post by wilbert »

SeregaZ wrote:can you see by one eye? i think to read speed of bend and follow need to be read as byte, not as .a
To me it doesn't sound bad.
The problem is that I don't know how it should sound.
Do you have a mp3 file or youtube link where I can listen what it should sound like ?
Windows (x64)
Raspberry Pi OS (Arm64)
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

do you have emulator of sega mega drive? i can send to you some kind of disasm version of that driver.
SeregaZ
Enthusiast
Enthusiast
Posts: 617
Joined: Fri Feb 20, 2009 9:24 am
Location: Almaty (Kazakhstan. not Borat, but Triple G)
Contact:

Re: Noob's investigation of VGM

Post by SeregaZ »

and probably this one:
https://www.youtube.com/watch?v=EtceMig ... D9&index=2
problem place i think 23-24-25 seconds, where note need to be go down.
Post Reply