PureBasic Forums - English

Posted: **Wed Oct 12, 2016 9:30 pm**

i can see the light! shell say how it is

first 2 bytes - initial pitch, then blocks per 3 bytes: 1b - counter, 2b - delta (some speed... need to test for understand sure). last 0 - becouse 1b counter is 0, last 2b is not writes.

dum dum dum tururum dum dum dum turururm la la la

Posted: **Thu Oct 13, 2016 4:22 am**

SeregaZ wrote:i can see the light! shell say how it is
first 2 bytes - initial pitch, then blocks per 3 bytes: 1b - counter, 2b - delta (some speed... need to test for understand sure). last 0 - becouse 1b counter is 0, last 2b is not writes.

dum dum dum tururum dum dum dum turururm la la la

Great that you solved the mystery

Posted: **Sat Oct 15, 2016 2:47 pm**

this procedure make convert note value from code files into registers values:

Code: Select all

Procedure.i GetOPNNote(Note.i, Pitch.i)
  
  Protected.d FreqHz, CurNote
  Protected.i BlkNum, FNum
  
  CurNote = Note + Pitch / 128
  
  FreqHz = 440 * Pow(2, (CurNote - 69) / 12)
  
  BlkNum = Note / 12 - 1

  If BlkNum < 0
    BlkNum = 0
  ElseIf BlkNum > 7
    BlkNum = 7
  EndIf  
 
  FNum = Round((144 * FreqHz / 7670454) * Pow(2, 21 - BlkNum), #PB_Round_Nearest)
  If FNum < 0
    FNum = 0
  ElseIf FNum > $7FF
    FNum = $7FF
  EndIf 

  ProcedureReturn FNum | (BlkNum * $800)

EndProcedure

Debug Hex(GetOPNNote($13+12, 0))
Debug Hex(GetOPNNote($13+12, 272))

problem is - it make wrong pitch. if note with 0 pitch - all work fine. if not 0, but some value... it count uncorrect.
$13+12, 272 shows as $0C43 but it need to be as $0C01. second problem is limit of pitch. this pitch is $0000 value. but theory is can make up and down, it means value probably as Word type. so it means max value for pitch can be +32767. but for this case $13+12 note it is $FFF. this $FFF shows when i set 1667 as pitch. any higher 1667 make same $FFF. registers can be up to $34BF.

original (visual basic probably)

Code: Select all

Private Function GetOPNNote(ByVal Note As Byte, ByVal Pitch As Integer) As Integer

    Dim FreqHz As Double
    Dim BlkNum As Integer
    Dim FNum As Double
    Dim CurNote As Double
    
    CurNote = Note + Pitch / 128#
    
    FreqHz = 440# * 2# ^ ((CurNote - 69) / 12#)
    
    ' must be Note, not CurNote, to avoid changing octaves
    BlkNum = (Note \ 12) - 1
    If BlkNum < &H0 Then
        BlkNum = &H0
    ElseIf BlkNum > &H7 Then
        BlkNum = &H7
    End If
    'FNum = (144 * FreqHz * 2 ^ 20 / 7670454) / 2 ^ (BlkNum - 1)
    FNum = (144 * FreqHz / 7670454) * 2 ^ (21 - BlkNum)
    FNum = Int(FNum + 0.5)
    If FNum < 0 Then
        FNum = 0
    ElseIf FNum > &H7FF Then
        FNum = &H7FF
    End If
    
    GetOPNNote = FNum Or BlkNum * &H800

End Function

and you help me convert it from vb year ago

))))

have you any idea where it can wrong count?

one problem is solved

CurNote = Note + Pitch / 256;128
it shows as $0C02 - almost $0C01

and limit of pitch is growup from 1667 to 3000+. but anyway final result same $FFF.

aaaaa... this one:

Code: Select all

  ElseIf FNum > $7FF
    FNum = $7FF
  EndIf

probably it is wrong

i try to change it... into... aaa... $34BF?
probably i need to make limit for out value. some kind of:

Code: Select all

  ret = FNum | (BlkNum * $800)
  if ret > $34BF
    ret = $34BF
  endif
  ProcedureReturn ret

no... again stuck:
Debug Hex(GetOPNNote($13+12, 3335)) shows $FFF and then 3335 shows $800...

can i change FNum | (BlkNum * $800) into ret = FNum + (BlkNum * $800)?

i am sure will curse this sega mega drive developers

Debug Hex(GetOPNNote($14+12, 256)) by idea will up to next note. i is same value as Debug Hex(GetOPNNote($15+12, 0))

but when it change octave:
Debug Hex(GetOPNNote($17+12, 256)) it is not same as Debug Hex(GetOPNNote($18 + 12, 0)) i will kill some one

))) how to fix this octave? i mean how to recount correct this +shift pitch?

this modulation have 3 params. 1 initial pitch, 2 counter, 3 pitch value per 1 tik of counter.
counter is 2 for example, pitch value 256.
start note
delay 1
start note + 256
delay 1
start note + 512
delay 1
start note + 768
and etc...

i am even dont know how to correct make question

)))) so big mess in my head becouse it

it need to correct recount.

probably i will need to make some table of octaves. where is start, where is end. and make compare values.

Posted: **Sat Oct 15, 2016 6:23 pm**

I'm having a hard time understanding everything

Are you sure the Note + Pitch / 128 is wrong and should be 256 ?
Do you still have the complete source where this procedure came from ?

Posted: **Sat Oct 15, 2016 6:46 pm**

https://www.dropbox.com/s/kx77t8n49p406 ... t.zip?dl=1

but it is for another case programm. i use this procedure for get registers value, but this programm make another thing

i just apply GEMS experience with pitch into this function. for this GEMS i have sure correct work combaine programm. it make rom from this code files. so i set in this code file pitch x and note n, then make rom, then start this rom at emulator of SMD, then make log file for sound chip, then read this log. that way i know pitch 256 it is +1 to note. not 128, as that procedure do.

Posted: **Sun Oct 16, 2016 2:06 pm**

Code: Select all

Procedure.i GetOPNNote(Note.i, Pitch.w)
  
  Protected.d FreqHz, CurNote, PitchCoef
  Protected.i BlkNum, FNum, CurBlkNum
  
  PitchCoef = Pitch / 256
  If PitchCoef < 1 And PitchCoef > -1
    
    If PitchCoef < 0 And (Note = 12 Or Note = 24 Or Note = 36 Or Note = 48 Or Note = 60 Or Note = 72 Or Note = 84)
      
      Note = Note - 1
      Pitch = 256 + Pitch ;(Pitch is a - value, so 256 + Pitch means 256 - Pitch) 
      
      ret = GetOPNNote(Note, Pitch)
      
    Else
      
      CurNote = Note + Pitch / 256
  
      FreqHz = 440 * Pow(2, (CurNote - 69) / 12)
  
      BlkNum = Note / 12 - 1 ; octave without pitch

      If BlkNum < 0
        BlkNum = 0
      ElseIf BlkNum > 7
        BlkNum = 7
      EndIf  
  
      FNum = Round((144 * FreqHz / 7670454) * Pow(2, 21 - BlkNum), #PB_Round_Nearest)
      If FNum < 0
        FNum = 0
      EndIf 
  
      ;count main value
      ret = FNum + (BlkNum * $800)
      
    EndIf
    
  Else
    
    Note + Pitch / 256
    Pitch - (Int(Pitch / 256) * 256)
    
    ret = GetOPNNote(Note, Pitch)
    
  EndIf
  
  ;set gems limit
  If ret > $3CBF
    ret = $3CBF
  ElseIf ret < $0142
    ret = $0142
  EndIf
  
  ProcedureReturn ret

EndProcedure

now it is almost perfect

but:

Code: Select all

Debug "$" + RSet(Hex(GetOPNNote($13+12, 272)), 4, "0")

shows as $0C02, but GEMS shows as $0C01. can it be fixed? some values is fine, but some this 1 is wrong

and it have toooo many "or" inside if... but select cant to apply, becouse first part check.

and i will need some backconvert procedure too. when at input i set registers value $0C02 - and it must to return me note and pitch values.

Code: Select all

FNum = Round((144 * FreqHz / 7670454) * Pow(2, 21 - BlkNum), #PB_Round_Down);#PB_Round_Nearest)

now $0C01 as emulators play

)))) la la la la la la la

to early i start sing

now another place have uncorrect. i think it need one my round procedure... i need to remember where it is lay...

Posted: **Mon Oct 17, 2016 9:54 am**

Great that you are making progress.

It's indeed likely the difference is caused by a rounding issue.

Posted: **Mon Oct 17, 2016 11:50 am**

no, round not helped. some times it is 0.55 values and it need to round into 1, but some times it is 0.65 for example and it need to round into 0. formulas values probably is not same as GEMS have. i dont know what they means and ValleyBell is missed - i cant ask him about this values, where they from and etc questions. but i think it will be ok for me. for hear it is so small "shift", that probably i cant to hear. it is not 100% match into GEMS, but i think for me it is big victory anyway.

so now i read this modulation file like this:

Code: Select all

  If ReadFile(0, "C:\Games\SMD\gammatest\My\modulation_07.mod")
    startpitch.w = ReadWord(0)
    ReDim ModBlock(0)
    Repeat
      tmp.a = ReadAsciiCharacter(0)
      If tmp
        
        oldsize  = ArraySize(ModulValues())
        curpitch = ModulValues(oldsize)
        pitch    = ReadWord(0)
        ReDim ModulValues(oldsize + tmp)
        For i = oldsize To oldsize + tmp
          ModulValues(i) = curpitch + pitch * (i - oldsize)
          Debug Str(ModulValues(i)) + " " + Str(pitch)
        Next

      Else
        Break
      EndIf
    ForEver
    CloseFile(0)
  EndIf

and it plays some kind of this:

Code: Select all

Procedure Modulation(*Value)
  
  Repeat
    
    If modulationstart      
      
      tikofarray = fulllength - modulationstart
      
      FNum = GetOPNNote(note, ModulValues(tikofarray)) 
      A4 = FNum >> 8
      A0 = FNum & $FF  
      OPN_Write(0, $A4, A4)
      OPN_Write(0, $A0, A0)
      Debug Hex(FNum)
      
      modulationstart - 1
    
    EndIf
    
    Delay(80) ; let's image it as delay 1
    
  ForEver
  
EndProcedure

by comparing both variant my and that make GEMS - same

exept that cases with $0001 difference for some times, but most values is same. and it is prototype of playing. i need to make some apply this method of playing into main code of playing. and case even worse - becouse my main playing it a little incorrect

GEMS can have a lot of tracks, but channels is only 6 for FM, 4 for PSG. but tracks can be 15 or 16 or how many... i dont remember, but it is sure more than 10. if we read note for 1 channel for example - we play note in 1 channel, but GEMS do not like this... it check before: 1 channels is free or it still plays previos note? if still play - have GEMS any free channel in this time? if yes - note come into this free channel, if it is not and all 6 channels for FM is busy - check prioritet of tracks. if new note's track have higher prioritet - it is break one of 6 channels sounds with lowest prioritet and start play this new one in this channels. before it it need to set instrument in this channels, and all of this happen so fast - user think it plays in one channel.

so for me it is a little dificult for repeat in PB, so first i deside just take first 6 tracks and play them as they are 1 track per 1 channel, 2 track per 2 channel. PSG is still not plug yet - it have some dificult too

but system of note behavior very similar as modulation do - instrument for PSG it is plan of note. so i think to some how finish modulation, then start to plug PSG part.

sory for so lot of text and ideas and so small ready code

i am still not capture it from my head... but it is fly near

i just need capture and write.

Posted: **Mon Oct 17, 2016 11:58 am**

I understand it makes things more difficult to implement but in itself such a priority system sounds like a good idea.
If you have a sound effect inside a game, it can have a high priority and suppress unimportant notes. When it is done, the other notes are playing again.
This way you can have better sound tracks since you don't have to keep one channel available all the time for sound effects.

Posted: **Mon Oct 17, 2016 10:24 pm**

when i try to plug this modulation prototype autor of GEMS combaine programm give this procedure for registers count:

Code: Select all

Global Dim table(12)

table(0) = $0284
table(1) = $02AA
table(2) = $02D3
table(3) = $02FE
table(4) = $032B
table(5) = $035B
table(6) = $038E
table(7) = $03C5
table(8) = $03FE
table(9) = $043B
table(10) = $047B
table(11) = $04BF
table(12) = $0508

  Procedure.i GetFreq(note.i, pitch.w)
    note_p = pitch / 256    
    pitch = pitch - note_p * 256
    
    If pitch < 0
      note_p = note_p - 1;
      pitch = pitch + 256;
    EndIf 
    
    note = note + note_p
    If note < 0
      pitch = 0;
      note = 0 ;
    ElseIf note > 95
      note = 95
      pitch = 255      
    EndIf
    Block = note / 12
    note = note - Block * 12;
    a = table(note)
    b = table(note+1)
    FNum = a + ((b-a)*pitch)/256 + Block * 2048
    
    ProcedureReturn FNum
    
  EndProcedure

it count correct that cursed $13 note with 272 pitch. and this procedure no need to +12 for note

same as GEMS logs file note value.

modulation is almost pluged, but it need to more test. by sounds it is a little wrong

i am not sure it is modulation problem, or it is replasing 2-3 operators of chip. now i fill registers, as they lay in a file, but probably i will need to replace 2 on 3 and 3 on 2, as some documents says.

Posted: **Fri Oct 21, 2016 12:01 pm**

now i start to work with instruments for PSG. it have 7 parametres:

Code: Select all

0 Type	2 Or 3	        (02 - PSG tone, 03 - PSG noise)
1 Noise Data	[0,7]	    
2 Attack Rate	[0,$FF]	 
3 Sustain Level	[0,$F]
4 Attack Level	[0,$F]	 
5 Decay Rate	[0,$FF]	
6 Release Rate	[0,$FF]

so i study Attack Rate - it is some speed for reach Attack Level value. this Attack Rate can be 1 to 31 values and 32 = $FF = it means no Attack Rate, but max volume immediately. so when i start read this values it shows this volumes:

Code: Select all

;$1F - 31 - 14, 12, 10,  8,  6   4   2   0   0 
;$1E - 30 - 14, 12, 10,  8,  6,  4,  2,  0 p 0
;$1D - 29 - 14, 12, 10,  8,  6,  5,  3,  1,  0
;$1C - 28 - 14, 12, 10,  8,  7,  5,  3,  1,  0,  0
;$1B - 27 - 14, 12, 10,  9,  7,  5,  4,  2,  0,  0

;$0A - 10 - 15, 14  14  13, 12, 12, 11, 10, 10,  9,  9,  8,  7,  7,  6,  5,  5,  4,  4,  3,  2,  2,  1,  0,  0,  0

;$08 - 08 - 15  15  14  14  13  13  12  12  11  11  10  10   9   9   8  8  7  7  6  6  5  5  4  4  3  3  2  2  1  1  0
;$07 - 07 - 15  15  15  14  14  13  13  12  12  12  11  11  10  10   9  9  8  8  8  7  7  6  6  5  5  5  4  4  3  3  2  2  1  1  1  0
;$06 - 06 - 15  15  14  14  14  13  13  12  12  12  11  11  11  10  10  9  9  9  8  8  8  7  7  6  6  6  5  5  5  4  4  3  3  3  2  2  2  1  1  0
;$05 - 05 - 15  15  15  14  14  14  13  13  13  12  12  12  12
;$04 - 04 - 15  15  15  14  14  14  14  13  13  13  13  12  12  12  12  12
;$03 - 03 - 15  15  15  15  15  14  14  14  14  14  13  13  13  13  13  12  12  12  12  12  12
;$02 - 02 - 15  15  15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 13, 13, 13, 13, 13, 13, 13, 13, 12, 12, 12, 12, 12, 12, 12, 12, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 
;$01 - 01 - 15  15  15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13,

probably system of count some kind of this:
256 / (attack rate value * 15) and then repeat values of volume by this value.
256 / (10 * 15) = 1.7
it means one time 15, then 0.7 go is to next 1.7 = 2.4 - twice 14 value, 0.4 + 1.7 = 2.1 = twice 13 value (but original once 13), 0.1 + 1.7 = 1.8 - once 12, 0.8 + 1.7 = 2.6 twice 11
it is not 100% as this array. but close. how to make formula and fill array?

Posted: **Fri Oct 21, 2016 1:29 pm**

It looks complicated

Maybe it's similar to the YM2612 attack rate.
When I googled, I noticed someone on the DefleMask forum was working on converting from GEMS format to the DefleMask format.
Maybe you can find some answers there.

Posted: **Fri Oct 21, 2016 2:56 pm**

super programm, first look i am very like it... but... i am not sure it is GEMS audio driver for create SMD rom for emulator. probably it is some another audio driver.

Posted: **Fri Oct 21, 2016 5:24 pm**

100% match

)))))) I did not expect.

Code: Select all

Global Dim PSGInstARValues(0)

Procedure FillARarray(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues(0) 
  
  If ARvalue = 32 ; 0 AR, top volume, no need to fade in
    PSGInstARValues(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(PSGInstARValues())
        ReDim PSGInstARValues(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri 
      countershift + counterd 
      
    Next
    
  EndIf
  
EndProcedure

FillARarray($1B, 0)
;FillARarray($1F, 0)
;FillARarray($0A, 0)

For i = 0 To ArraySize(PSGInstARValues())
  Debug PSGInstARValues(i)
Next

as tests shows: Decoy Rate and Relise Rate - have same mehanic, just not 15, 14, 13, but 13, 15, 15. so tomorrow i will think how to glue all this into one procedure.

Posted: **Sun Oct 23, 2016 3:26 pm**

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.

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
  
EndEnumeration

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

Global type   
Global noisedata   
Global attackrate   
Global sustainlevel 
Global attacklevel  
Global decayrate   
Global releaserate

Global psgstart ; means duration
Global psgmarker

Global PhaseOfPSG

Global curvolume = 17

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 PSGInstrActionsKeyOn.i(1)
Global Dim PSGInstrActionsKeyOff.i(0)

Global Dim PSGInstARValues(0) ; Attack Rate
Global Dim PSGInstDRValues(0) ; Decoy Rate
Global Dim PSGInstRRValues(0) ; Relise Rate

;{
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 FillARarray(ARvalue.i, ALvalue.i)
  
  ReDim PSGInstARValues(0)
  
  If ARvalue = $FF Or ARvalue = 32; 0 AR, top volume immediatly
    PSGInstARValues(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(PSGInstARValues())
        ReDim PSGInstARValues(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstARValues(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri ; get 0.x value
      countershift + counterd                ; 0.x + how it names...
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillDRarray(DRvalue.i, ALvalue.i, SLvalue.i)
  
  ReDim PSGInstDRValues(0)
  
  If DRvalue = 32 ; Sustain Level volume immedeatly
    PSGInstDRValues(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(PSGInstDRValues())
        ReDim PSGInstDRValues(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstDRValues(k) = tmpval + i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd               
      
    Next
    
  EndIf
  
EndProcedure
Procedure FillRRarray(RRvalue.i)
  
  ReDim PSGInstRRValues(0)
  
  If RRvalue = 32 ; silence immediatly
    PSGInstRRValues(0) = 15
  Else
    counterd.d     = 255 / (RRvalue * 16)
    countershift.d = counterd
    
    For i = 0 To 15
      
      counteri = Int(countershift)
      
      If counteri > 0
        startnumarray = ArraySize(PSGInstRRValues())
        ReDim PSGInstRRValues(startnumarray + counteri)
        For k = startnumarray To startnumarray + counteri
          PSGInstRRValues(k) = i
        Next
      EndIf
      
      countershift = countershift - counteri
      countershift + counterd    
      
    Next
    
  EndIf
  
EndProcedure

Procedure PaintSin(volume)
  
  GrabImage(#Img01, #Img02, 1, 0, 279, 70) 
  CopyImage(#Img02, #Img01)
  If StartDrawing(ImageOutput(#Img01))
    
    Plot(278, (volume * 4)+4, RGB(0, 200, 0))

    StopDrawing()
    
    SetGadgetState(#Gadget2, ImageID(#Img01))
    
  EndIf
  
EndProcedure

Procedure PSGPlay(*Value)
  
  Repeat
    
    If psgstart > 0     
      
      ;1. Attack Phase [volume up With Attack Rate until Attack Level], 
      ;2. Decay Phase [volume down With Decay Rate until Sustain Level], 
      ;3. Sustain Phase [volume down With SustainRate Until 0]
      ;actually... no, the Sustain Rate is fixed To 0 in GEMS, so the volume 
      ;stays at its level there.

      ;Anywhere in this, a "Key Off" breaks into the 
      ;4. Release Phase [volume down With Release Rate Until 0]
      ;With "volume 0" I mean "silence" here, so For the PSG it's actually value $F
      
      
      
      ;frequency is sets. i means instrument is rule of volume in a time
      
      ;get position of sound playing
      tmppsgmarker = psgmarker - psgstart
      
      Select PhaseOfPSG
        Case 0 ; Attack Rate
          
          ;check when phase is ends    
          ;Debug tmppsgmarker
          If PSGInstARValues(tmppsgmarker) <= attacklevel
            PhaseOfPSG = 1
            startdecaytik = tmppsgmarker + 1
            
            ;set volume
            ;%1001000
            Write(144 + attacklevel)
            curvolume = attacklevel
            
          Else
            
            ;set volume
            ;%1001000
            Write(144 + PSGInstARValues(tmppsgmarker))
            curvolume = PSGInstARValues(tmppsgmarker)
            
          EndIf
          
        Case 1 ; Decay Rate
          ;check when phase is ends          
          If PSGInstDRValues(tmppsgmarker - startdecaytik) >= sustainlevel
            PhaseOfPSG = 2
            startreliserate = tmppsgmarker
            
            ;set volume
            ;%1001000
            Write(144 + sustainlevel)
            curvolume = sustainlevel
          Else
            
            ;set volume
            ;%1001000
            Write(144 + PSGInstDRValues(tmppsgmarker - startdecaytik))
            curvolume = PSGInstDRValues(tmppsgmarker - startdecaytik)
            
          EndIf          
          
      EndSelect
      
      PaintSin(curvolume)
      
      psgstart - 1 
      
    Else
      
      ;start ReliseRate - Fade out
      If curvolume < 15
        
        ;Debug "RR"

        For i = 0 To ArraySize(PSGInstRRValues())
          ;get array tik
          If PSGInstRRValues(i) >= curvolume
            startfadeout = i
            
            Write(144 + PSGInstRRValues(i))
            
            PaintSin(PSGInstRRValues(i))
            
            Break
          EndIf
        Next
        
        curvolume = 16
        
      ElseIf curvolume = 16
        
        If startfadeout <= ArraySize(PSGInstRRValues())
          
          Write(144 + PSGInstRRValues(startfadeout))
          
          PaintSin(PSGInstRRValues(startfadeout))
          
          If PSGInstRRValues(startfadeout) = 15
            curvolume = 17 ; stop RR work
          EndIf
          
          startfadeout + 1
          
        EndIf
        
      EndIf 
      
    EndIf
    
    ;Delay(80) ; let's image it as gems's delay 1. 
               ; but, as test shows, it cant be delay 1, but 1/60sec
    Delay(17)  ; 16.66666.... let it be 17
    
  ForEver
  
EndProcedure

;FillARarray($1B, 0)
;FillARarray($1F, 0)
;FillARarray($0A, 0)

;For i = 0 To ArraySize(PSGInstARValues())
;  text$ + "  " +  Str(PSGInstARValues(i))
;Next
;Debug ";         " + text$

;FillDRarray($0A, 15)

;For i = 0 To ArraySize(PSGInstDRValues())
;  text$ + "  " +  Str(PSGInstDRValues(i))
;Next
;Debug ";         " + text$

SetClock(3579545) 

If OpenWindow(#Window, 100, 200, 420, 140, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
  
  ;If ReadFile(0, "G:\DISTR\SEREGASOFT\MIDI\PSGinstrum\patch_0F.raw")
    ;02 00 FF 0A 09 0A 14
    ;0 Type	2 Or 3	          02               02 - PSG tone, 03 - PSG noise
    ;1 Noise Data	[0,7]	      00
    ;2 Attack Rate	[0,$FF]	  FF
    ;3 Sustain Level	[0,$F]	0A
    ;4 Attack Level	[0,$F]	  09
    ;5 Decay Rate	[0,$FF]	    0A
    ;6 Release Rate	[0,$FF]	  14 
    ;CloseFile(0)
  ;EndIf
  
  ;lets image that was read as:
  type         = 2
  noisedata    = 0
  attackrate   = $10
  sustainlevel = $05
  attacklevel  = $00
  decayrate    = $05
  releaserate  = $14
  
  FillARarray(attackrate, attacklevel)
  FillDRarray(decayrate, attacklevel, sustainlevel)
  FillRRarray(releaserate)  
  
  ButtonGadget(#Load, 10, 10, 50, 20, "load")
  
  ButtonGadget(#Gadget, 10, 40, 50, 20, "play")
  
  x = 70
  ButtonGadget(#AtRP, x+40, 10, 20, 20, "+")
  StringGadget(#AtRG, x+20, 10, 20, 20, Str(attackrate), #PB_String_Numeric | #PB_String_ReadOnly)
  ButtonGadget(#AtRM, x, 10, 20, 20, "-")
  GadgetToolTip(#AtRG, "Attack Rate")
  
  x + 70
  ButtonGadget(#AtLP, x+40, 10, 20, 20, "+")
  StringGadget(#AtLG, x+20, 10, 20, 20, Str(attacklevel), #PB_String_Numeric | #PB_String_ReadOnly)
  ButtonGadget(#AtLM, x, 10, 20, 20, "-")
  GadgetToolTip(#AtLG, "Attack Level")
  
  x + 70
  ButtonGadget(#DcRP, x+40, 10, 20, 20, "+")
  StringGadget(#DcRG, x+20, 10, 20, 20, Str(decayrate), #PB_String_Numeric | #PB_String_ReadOnly)
  ButtonGadget(#DcRM, x, 10, 20, 20, "-")
  GadgetToolTip(#DcRG, "Decay Rate")
  
  x + 70
  ButtonGadget(#SyLP, x+40, 10, 20, 20, "+")
  StringGadget(#SyLG, x+20, 10, 20, 20, Str(sustainlevel), #PB_String_Numeric | #PB_String_ReadOnly)
  ButtonGadget(#SyLM, x, 10, 20, 20, "-")
  GadgetToolTip(#SyLG, "Systain Level")
  
  x + 70
  ButtonGadget(#RrRP, x+40, 10, 20, 20, "+")
  StringGadget(#RrRG, x+20, 10, 20, 20, Str(releaserate), #PB_String_Numeric | #PB_String_ReadOnly)
  ButtonGadget(#RrRM, x, 10, 20, 20, "-")
  GadgetToolTip(#RrRG, "Relise Rate")
  
  
  
  CreateImage(#Img01, 280, 70)
  CreateImage(#Img02, 280, 70)
  ImageGadget(#Gadget2, 100, 40, 280, 70, ImageID(#Img01), #PB_Image_Border)
  
  
  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($22), 0, 3)
            Write(writevalue)
            writevalue = GetBits(PSGnote($22), 4, 7)
            Write(writevalue)
            psgstart  = 60 ; duration
            psgmarker = psgstart
            PhaseOfPSG = 0 ; 0 - Attack Rate, 1 - Decay Rate, 2 - Relise Rate
          Case #Load
            tmppath$ = OpenFileRequester("enter path to RAW file", "", "RAW Files (*.raw)|*.raw;", 0)
            If tmppath$
              If FileSize(tmppath$) = 7
                If ReadFile(0, tmppath$)
                  type         = ReadAsciiCharacter(0)
                  noisedata    = ReadAsciiCharacter(0)
                  attackrate   = ReadAsciiCharacter(0)
                  sustainlevel = ReadAsciiCharacter(0)
                  attacklevel  = ReadAsciiCharacter(0)
                  decayrate    = ReadAsciiCharacter(0)
                  releaserate  = ReadAsciiCharacter(0)
                  CloseFile(0)
                  
                  If attackrate > 32
                    attackrate = 32
                  ElseIf attackrate < 1
                    attackrate = 1
                  EndIf
                  
                  If decayrate > 32
                    decayrate = 32
                  ElseIf decayrate < 1
                    decayrate = 1
                  EndIf
                  
                  If releaserate > 32
                    releaserate = 32
                  ElseIf releaserate < 1
                    releaserate = 1
                  EndIf
                  
                  FillARarray(attackrate, attacklevel)
                  FillDRarray(decayrate, attacklevel, sustainlevel)
                  FillRRarray(releaserate)
                  
                  SetGadgetText(#AtRG, Str(attackrate))
                  SetGadgetText(#SyLG, Str(sustainlevel))
                  SetGadgetText(#AtLG, Str(attacklevel))
                  SetGadgetText(#DcRG, Str(decayrate))
                  SetGadgetText(#RrRG, Str(releaserate))
                  
                EndIf
              Else
                MessageRequester("attention!", "probably it is not PSG instrument file.")
              EndIf
            EndIf
            
          Case #AtRP
            attackrate = Val(GetGadgetText(#AtRG))
            If attackrate < 32
              attackrate + 1
              FillARarray(attackrate, attacklevel)
              SetGadgetText(#AtRG, Str(attackrate))
            EndIf
            
          Case #AtRM
            attackrate = Val(GetGadgetText(#AtRG))
            If attackrate > 1
              attackrate - 1
              FillARarray(attackrate, attacklevel)
              SetGadgetText(#AtRG, Str(attackrate))
            EndIf
            
          Case #AtLP
            attacklevel = Val(GetGadgetText(#AtLG))
            If attacklevel > 0
              attacklevel - 1
              FillARarray(attackrate, attacklevel)
              FillDRarray(decayrate, attacklevel, sustainlevel)
              SetGadgetText(#AtLG, Str(attacklevel))
            EndIf
            
          Case #AtLM
            attacklevel = Val(GetGadgetText(#AtLG))
            If attacklevel < 15
              attacklevel + 1
              FillARarray(attackrate, attacklevel)
              FillDRarray(decayrate, attacklevel, sustainlevel)
              SetGadgetText(#AtLG, Str(attacklevel))
            EndIf            
            
          Case #DcRP
            decayrate = Val(GetGadgetText(#DcRG))
            If decayrate < 32
              decayrate + 1
              FillDRarray(decayrate, attacklevel, sustainlevel)              
              SetGadgetText(#DcRG, Str(decayrate))
            EndIf
            
          Case #DcRM
            decayrate = Val(GetGadgetText(#DcRG))
            If decayrate > 1
              decayrate - 1
              FillDRarray(decayrate, attacklevel, sustainlevel)   
              SetGadgetText(#DcRG, Str(decayrate))
            EndIf
            
          Case #SyLP
            sustainlevel = Val(GetGadgetText(#SyLG))
            If sustainlevel > 0
              sustainlevel - 1
              FillDRarray(decayrate, attacklevel, sustainlevel)
              SetGadgetText(#SyLG, Str(sustainlevel))
            EndIf
            
          Case #SyLM
            sustainlevel = Val(GetGadgetText(#SyLG))
            If sustainlevel < 15
              sustainlevel + 1
              FillDRarray(decayrate, attacklevel, sustainlevel)
              SetGadgetText(#SyLG, Str(sustainlevel))
            EndIf 
            
          Case #RrRP
            releaserate = Val(GetGadgetText(#RrRG))
            If releaserate < 32
              releaserate + 1
              FillRRarray(releaserate)              
              SetGadgetText(#RrRG, Str(releaserate))
            EndIf
            
          Case #RrRM
            releaserate = Val(GetGadgetText(#RrRG))
            If releaserate > 1
              releaserate - 1
              FillRRarray(releaserate)
              SetGadgetText(#RrRG, Str(releaserate))
            EndIf
            
        EndSelect
        
      Case #PB_Event_CloseWindow
        Quit = 1 

    EndSelect
    

  Until Quit = 1 

  
EndIf

PureBasic Forums - English

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

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM

Re: Noob's investigation of VGM