It is currently Fri Sep 20, 2019 12:35 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 117 posts ]  Go to page Previous  1 ... 3, 4, 5, 6, 7, 8  Next
Author Message
 Post subject: Re: Noob's investigation of VGM
PostPosted: Wed Oct 12, 2016 9:30 pm 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Thu Oct 13, 2016 4:22 am 
Offline
PureBasic Expert
PureBasic Expert

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

Great that you solved the mystery :)

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Sat Oct 15, 2016 2:47 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
this procedure make convert note value from code files into registers values:
Code:
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:
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:
  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:
  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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Sat Oct 15, 2016 6:23 pm 
Offline
PureBasic Expert
PureBasic Expert

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

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Sat Oct 15, 2016 6:46 pm 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Sun Oct 16, 2016 2:06 pm 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Mon Oct 17, 2016 9:54 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3442
Location: Netherlands
Great that you are making progress. :)
It's indeed likely the difference is caused by a rounding issue.

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Mon Oct 17, 2016 11:50 am 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Mon Oct 17, 2016 11:58 am 
Offline
PureBasic Expert
PureBasic Expert

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

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Mon Oct 17, 2016 10:24 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
when i try to plug this modulation prototype autor of GEMS combaine programm give this procedure for registers count:
Code:
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Oct 21, 2016 12:01 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
now i start to work with instruments for PSG. it have 7 parametres:
Code:
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:
;$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?


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

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3442
Location: Netherlands
It looks complicated :shock:
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.

_________________
macOS 10.14 Mojave, PB 5.62 x64


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Oct 21, 2016 2:56 pm 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Fri Oct 21, 2016 5:24 pm 
Offline
Enthusiast
Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 561
Location: Almaty (Kazakhstan)
100% match :))))))) I did not expect.

Code:
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Noob's investigation of VGM
PostPosted: Sun Oct 23, 2016 3:26 pm 
Offline
Enthusiast
Enthusiast

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


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

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


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