It is currently Fri Jul 19, 2019 10:55 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 117 posts ]  Go to page Previous  1 ... 4, 5, 6, 7, 8  Next
Author Message
 Post subject: Re: Noob's investigation of VGM
PostPosted: Tue Oct 25, 2016 7:01 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3351
Location: Netherlands
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.

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Wed Oct 26, 2016 11:44 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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:
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 :)


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Oct 28, 2016 6:22 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
this overlimit of arrays is killing me... need to think how to fix it.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Nov 11, 2016 9:12 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Nov 11, 2016 1:59 pm 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3351
Location: Netherlands
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.

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Nov 11, 2016 3:00 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
easy to say :) attack level can be lower, than systain level :))) this function will need a looooot of thinking...


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Wed Dec 14, 2016 12:21 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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:
;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 :)


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Wed Apr 24, 2019 10:24 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Thu Apr 25, 2019 11:16 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Thu Apr 25, 2019 11:31 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3351
Location: Netherlands
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.

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Thu Apr 25, 2019 11:51 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Thu Apr 25, 2019 12:24 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
can you see by one eye? i think to read speed of bend and follow need to be read as byte, not as .a


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Apr 26, 2019 9:04 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3351
Location: Netherlands
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 ?

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Apr 26, 2019 9:13 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
do you have emulator of sega mega drive? i can send to you some kind of disasm version of that driver.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Apr 26, 2019 9:24 am 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
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.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 117 posts ]  Go to page Previous  1 ... 4, 5, 6, 7, 8  Next

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 2 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye