PureBasic Forum

 It is currently Thu Oct 29, 2020 4:53 pm

 All times are UTC + 1 hour

 Page 6 of 8 [ 117 posts ] Go to page Previous  1 ... 3, 4, 5, 6, 7, 8  Next
 Print view Previous topic | Next topic
Author Message
 Post subject: Re: Noob's investigation of VGMPosted: Wed Oct 12, 2016 9:30 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

Top

 Post subject: Re: Noob's investigation of VGMPosted: Thu Oct 13, 2016 4:22 am
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3683
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

Great that you solved the mystery

_________________
macOS 10.15 Catalina, Windows 10

Top

 Post subject: Re: Noob's investigation of VGMPosted: Sat Oct 15, 2016 2:47 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Sat Oct 15, 2016 6:23 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3683
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.15 Catalina, Windows 10

Top

 Post subject: Re: Noob's investigation of VGMPosted: Sat Oct 15, 2016 6:46 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Sun Oct 16, 2016 2:06 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Mon Oct 17, 2016 9:54 am
 PureBasic Expert

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

_________________
macOS 10.15 Catalina, Windows 10

Top

 Post subject: Re: Noob's investigation of VGMPosted: Mon Oct 17, 2016 11:50 am
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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:
ReDim ModBlock(0)
Repeat
If tmp

oldsize  = ArraySize(ModulValues())
curpitch = ModulValues(oldsize)
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

 Post subject: Re: Noob's investigation of VGMPosted: Mon Oct 17, 2016 11:58 am
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3683
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.15 Catalina, Windows 10

Top

 Post subject: Re: Noob's investigation of VGMPosted: Mon Oct 17, 2016 10:24 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Fri Oct 21, 2016 12:01 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Fri Oct 21, 2016 1:29 pm
 PureBasic Expert

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

_________________
macOS 10.15 Catalina, Windows 10

Top

 Post subject: Re: Noob's investigation of VGMPosted: Fri Oct 21, 2016 2:56 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Fri Oct 21, 2016 5:24 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

 Post subject: Re: Noob's investigation of VGMPosted: Sun Oct 23, 2016 3:26 pm
 Enthusiast

Joined: Fri Feb 20, 2009 9:24 am
Posts: 573
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

#Img01
#Img02

#AtRP
#AtRG
#AtRM

#AtLP
#AtLG
#AtLM

#DcRP
#DcRG
#DcRM

#SyLP
#SyLG
#SyLM

#RrRP
#RrRG
#RrRM

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()

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

If curvolume < 15

;Debug "RR"

For i = 0 To ArraySize(PSGInstRRValues())
;get array tik
If PSGInstRRValues(i) >= curvolume

Write(144 + PSGInstRRValues(i))

PaintSin(PSGInstRRValues(i))

Break
EndIf
Next

curvolume = 16

ElseIf curvolume = 16

curvolume = 17 ; stop RR work
EndIf

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)

;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)

x = 70
ButtonGadget(#AtRP, x+40, 10, 20, 20, "+")
ButtonGadget(#AtRM, x, 10, 20, 20, "-")

x + 70
ButtonGadget(#AtLP, x+40, 10, 20, 20, "+")
ButtonGadget(#AtLM, x, 10, 20, 20, "-")

x + 70
ButtonGadget(#DcRP, x+40, 10, 20, 20, "+")
ButtonGadget(#DcRM, x, 10, 20, 20, "-")

x + 70
ButtonGadget(#SyLP, x+40, 10, 20, 20, "+")
ButtonGadget(#SyLM, x, 10, 20, 20, "-")

x + 70
ButtonGadget(#RrRP, x+40, 10, 20, 20, "+")
ButtonGadget(#RrRM, x, 10, 20, 20, "-")

CreateImage(#Img01, 280, 70)
CreateImage(#Img02, 280, 70)

Repeat
Event = WaitWindowEvent()

Select Event
;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
tmppath\$ = OpenFileRequester("enter path to RAW file", "", "RAW Files (*.raw)|*.raw;", 0)
If tmppath\$
If FileSize(tmppath\$) = 7
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)

EndIf
Else
MessageRequester("attention!", "probably it is not PSG instrument file.")
EndIf
EndIf

Case #AtRP
If attackrate < 32
attackrate + 1
FillARarray(attackrate, attacklevel)
EndIf

Case #AtRM
If attackrate > 1
attackrate - 1
FillARarray(attackrate, attacklevel)
EndIf

Case #AtLP
If attacklevel > 0
attacklevel - 1
FillARarray(attackrate, attacklevel)
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #AtLM
If attacklevel < 15
attacklevel + 1
FillARarray(attackrate, attacklevel)
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #DcRP
If decayrate < 32
decayrate + 1
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #DcRM
If decayrate > 1
decayrate - 1
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #SyLP
If sustainlevel > 0
sustainlevel - 1
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #SyLM
If sustainlevel < 15
sustainlevel + 1
FillDRarray(decayrate, attacklevel, sustainlevel)
EndIf

Case #RrRP
If releaserate < 32
releaserate + 1
FillRRarray(releaserate)
EndIf

Case #RrRM
If releaserate > 1
releaserate - 1
FillRRarray(releaserate)
EndIf

EndSelect

Case #PB_Event_CloseWindow
Quit = 1

EndSelect

Until Quit = 1

EndIf

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 6 of 8 [ 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 10 guests

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

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite