I just checked your code and it seems Ok.
One thing:
The formula for a keyboard is
Code: Select all
freq.f = 440 * Pow(2, (KeyNo - 49) / 12)
Key 88 is 4186.01Hz (C8)
That's valid for an 88 key piano.
Bernd
Code: Select all
freq.f = 440 * Pow(2, (KeyNo - 49) / 12)
Code: Select all
Global Dim tiks.i(12)
tiks(1) = 7
tiks(2) = 7
tiks(3) = 6
tiks(4) = 6
tiks(5) = 6
tiks(6) = 5
tiks(7) = 5
tiks(8) = 5
tiks(9) = 5
tiks(10) = 4
tiks(11) = 4
tiks(12) = 4
Structure RegistersVal
note.i ; C
A4A0.i ;
ptik.f ;
EndStructure
Global Dim RegistersDataBase.RegistersVal(0)
Structure notptc
note.i
pitch.i
EndStructure
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
Procedure.i RetNotAndPithc(A4A0.i)
For i = ArraySize(RegistersDataBase()) To 1 Step -1
If RegistersDataBase(i)\A4A0 < A4A0
;Debug "$" + RSet(Hex(RegistersDataBase(i)\note), 2, "0")
;Debug "$" + RSet(Hex((A4A0 - RegistersDataBase(i)\A4A0) * RegistersDataBase(i)\ptik), 4, "0")
tmp$ = RSet(Bin((A4A0 - RegistersDataBase(i)\A4A0) * RegistersDataBase(i)\ptik), 16, "0")
tmp$ = Bin(RegistersDataBase(i)\note) + tmp$
tmp = Val("%" + tmp$)
Break
EndIf
Next
ProcedureReturn tmp
EndProcedure
;FNum = GetOPNNote($0C, 0)
;Debug "$A4 " + RSet(Hex(FNum >> 8), 2, "0")
;Debug "$A0 " + RSet(Hex(FNum & $FF), 2, "0")
tik = 1
For n = $0C To $5F
FNum = GetOPNNote(n, 0)
ReDim RegistersDataBase(ArraySize(RegistersDataBase())+1)
RegistersDataBase(ArraySize(RegistersDataBase()))\note = n
RegistersDataBase(ArraySize(RegistersDataBase()))\A4A0 = FNum
RegistersDataBase(ArraySize(RegistersDataBase()))\ptik = tiks(tik)
tik = tik + 1
If tik = 13
tik = 1
EndIf
Next
NAP = RetNotAndPithc($2B9F)
I'm not sure that I understand your problem right. But if you work with MIDI you should know that some companies use note no. 60 as C3 and some as C4.SeregaZ wrote:for my case i get note value from midi as $xx, then from this procedure get 2 value for 2 registers of cpu and send to this cpu.
and in this days i make rom for emulator sega mega drive and start it and make dump of sound cpu command and see it difference ((( but now some man says it is shift of octaves. and sure $10 + 12 = $1C and this $1C shows correct values $A4 = B and $A0 = 2B
false alarm i am as always - dubmass...
Code: Select all
tmp$ = RSet(Bin((A4A0 - RegistersDataBase(i)\A4A0) * RegistersDataBase(i)\ptik), 16, "0")
tmp$ = Bin(RegistersDataBase(i)\note) + tmp$
tmp = Val("%" + tmp$)
Code: Select all
tmp = RegistersDataBase(i)\note << 16 + ((A4A0 - RegistersDataBase(i)\A4A0) * RegistersDataBase(i)\ptik)
Code: Select all
Debug tmp >> 16
Debug tmp & $FF
Code: Select all
128# - # marks "double" number in VB6, kind of variable extensions like String$ in PB. Should be translated as 128.0
^ - equivalent of Pow ()
\ - in VB6 it was "integer division", division with always rounding result down, unlike / which returns floating result and rounding it to nearest integer. PB equivalent for \ is /
And - in VB6 logical AND, both used in comparing and calculating. PB has more stupid mess with it, it uses AND with IF statements and "&" to calculate something
Code: Select all
Structure DWORD
LOWORD.u ; represents the first 2 bytes of LONG
HIWORD.u ; the second part of LONG
EndStructure
Structure ALLTHESTUFF
StructureUnion
LONG.l
_LONG.DWORD
EndStructureUnion
EndStructure
Hey!
Code: Select all
OPNhdll = OpenLibrary(#PB_Any, "OPN_DLL.dll")
If OPNhdll
Prototype.a Prototype_OpenOPNDriver(Chips.a)
Prototype Prototype_CloseOPNDriver()
Prototype Prototype_OPNWrite(ChipID.a, Register.u, Dat.a)
Global OpenOPNDriver.Prototype_OpenOPNDriver = GetFunction(OPNhdll, "OpenOPNDriver")
Global CloseOPNDriver.Prototype_CloseOPNDriver = GetFunction(OPNhdll, "CloseOPNDriver")
Global OPN_Write.Prototype_OPNWrite = GetFunction(OPNhdll, "OPN_Write")
EndIf
Code: Select all
EnableExplicit
; https://newt.phys.unsw.edu.au/jw/notes.html
Enumeration 60 ; middle C key on a MIDI kbd (C4)
#Note_Do
#Note_Do_
#Note_Re
#Note_Re_
#Note_Mi
#Note_Fa
#Note_Fa_
#Note_Sol
#Note_Sol_
#Note_La
#Note_La_
#Note_Si
EndEnumeration
#YM2612_CLOCK = 7670454
Procedure.i GetOPNNote(MidiKey.i, Pitch.i)
Protected.d FreqHz, CurNote
Protected.i BlkNum, FNum
CurNote = MidiKey + Pitch / 128
FreqHz = 440 * Pow(2, (MidiKey - 69) / 12)
BlkNum = MidiKey / 12 - 1
If BlkNum < 0
BlkNum = 0
ElseIf BlkNum > 7
BlkNum = 7
EndIf
FNum = Round((144 * FreqHz / #YM2612_CLOCK) * Pow(2, 21 - BlkNum), #PB_Round_Nearest)
If FNum < 0
FNum = 0
ElseIf FNum > $7FF
FNum = $7FF
EndIf
ProcedureReturn FNum | (BlkNum * $800)
EndProcedure
; Resampling Modes
#OPT_RSMPL_HIGH = $00 ; high quality linear resampling [Default]
#OPT_RSMPL_LQ_DOWN = $01 ; low quality downsampling, high quality upsampling
#OPT_RSMPL_LOW = $02 ; low quality resampling
; Chip Sample Rate Modes
#OPT_CSMPL_NATIVE = $00 ; native chip sample rate [Default]
#OPT_CSMPL_HIGHEST = $01 ; highest sample rate (native Or custom)
#OPT_CSMPL_CUSTOM = $02 ; custom sample rate
Define.i OPNhdll, Event, Quit, KeyNo, FNum
OPNhdll = OpenLibrary(#PB_Any, "OPN_DLL.dll")
If OPNhdll
Prototype Prototype_SetOPNOptions(OutSmplRate.l, ResmplMode.a, ChipSmplMode.a, ChipSmplRate.l)
Prototype.a Prototype_OpenOPNDriver(Chips.a)
Prototype Prototype_CloseOPNDriver()
Prototype Prototype_OPN_Write(ChipID.a, Register.u, Dat.a)
Prototype Prototype_OPN_Mute(ChipID.a, MuteMask.a)
Prototype Prototype_PlayDACSample(ChipID.a, DataSize.l, *Data.Ascii, SmplFreq.l)
Prototype Prototype_SetDACFrequency(ChipID.a, SmplFreq.l)
Prototype Prototype_SetDACVolume(ChipID.a, Volume.u) ; $100 = 100%
Global SetOPNOptions.Prototype_SetOPNOptions = GetFunction(OPNhdll, "SetOPNOptions")
Global OpenOPNDriver.Prototype_OpenOPNDriver = GetFunction(OPNhdll, "OpenOPNDriver")
Global CloseOPNDriver.Prototype_CloseOPNDriver = GetFunction(OPNhdll, "CloseOPNDriver")
Global OPN_Write.Prototype_OPN_Write = GetFunction(OPNhdll, "OPN_Write")
Global OPN_Mute.Prototype_OPN_Mute = GetFunction(OPNhdll, "OPN_Mute")
Global PlayDACSample.Prototype_PlayDACSample = GetFunction(OPNhdll, "PlayDACSample")
Global SetDACFrequency.Prototype_SetDACFrequency = GetFunction(OPNhdll, "SetDACFrequency")
Global SetDACVolume.Prototype_SetDACVolume = GetFunction(OPNhdll, "SetDACVolume")
;- Setup
If OpenOPNDriver(1) = 0
; https://plutiedev.com/ym2612-registers
OPN_Write(0, $30, $74) ; multiplier and detune
OPN_Write(0, $34, $72) ; multiplier and detune
OPN_Write(0, $38, $74) ; multiplier And detune
OPN_Write(0, $3C, $71) ; multiplier And detune
OPN_Write(0, $40, $23) ; total level
OPN_Write(0, $44, $26) ; total level
OPN_Write(0, $48, $2A) ; total level
OPN_Write(0, $4C, $00) ; total level
OPN_Write(0, $50, $1F) ; attack rate an rate scaling
OPN_Write(0, $54, $1F) ; attack rate an rate scaling
OPN_Write(0, $58, $19) ; attack rate an rate scaling
OPN_Write(0, $5C, $12) ; attack rate an rate scaling
OPN_Write(0, $60, $00) ; decay rate and am enable
OPN_Write(0, $64, $00) ; decay rate and am enable
OPN_Write(0, $68, $0E) ; decay rate and am enable
OPN_Write(0, $6C, $07) ; decay rate and am enable
OPN_Write(0, $70, $00) ; sustain rate
OPN_Write(0, $74, $00) ; sustain rate
OPN_Write(0, $78, $00) ; sustain rate
OPN_Write(0, $7C, $00) ; sustain rate
OPN_Write(0, $80, $07) ; release rate and sustain level
OPN_Write(0, $84, $08) ; release rate and sustain level
OPN_Write(0, $88, $24) ; release rate and sustain level
OPN_Write(0, $8C, $18) ; release rate and sustain level
OPN_Write(0, $90, $00) ; SSG-EG (better set to 0)
OPN_Write(0, $94, $00) ; SSG-EG (better set to 0)
OPN_Write(0, $98, $00) ; SSG-EG (better set to 0)
OPN_Write(0, $9C, $00) ; SSG-EG (better set to 0)
OPN_Write(0, $B0, $3B) ; algorithm and feedback
OPN_Write(0, $B4, $04) ; panning, PMS, AMS
OPN_Write(0, $B4, $C0) ; panning, PMS, AMS
If OpenWindow(0, 100, 100, 430, 160, "Piano", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered)
CanvasGadget(#Note_Do, 20, 30, 30, 90)
CanvasGadget(#Note_Do_, 55, 30, 20, 60)
CanvasGadget(#Note_Re, 80, 30, 30, 90)
CanvasGadget(#Note_Re_, 115, 30, 20, 60)
CanvasGadget(#Note_Mi, 140, 30, 30, 90)
CanvasGadget(#Note_Fa, 200, 30, 30, 90)
CanvasGadget(#Note_Fa_, 235, 30, 20, 60)
CanvasGadget(#Note_Sol, 260, 30, 30, 90)
CanvasGadget(#Note_Sol_, 295, 30, 20, 60)
CanvasGadget(#Note_La, 320, 30, 30, 90)
CanvasGadget(#Note_La_, 355, 30, 20, 60)
CanvasGadget(#Note_Si, 380, 30, 30, 90)
If StartDrawing(CanvasOutput(#Note_Do_))
Box(0, 0, 20, 60, 0)
StopDrawing()
EndIf
If StartDrawing(CanvasOutput(#Note_Re_))
Box(0, 0, 20, 60, 0)
StopDrawing()
EndIf
If StartDrawing(CanvasOutput(#Note_Fa_))
Box(0, 0, 20, 60, 0)
StopDrawing()
EndIf
If StartDrawing(CanvasOutput(#Note_Sol_))
Box(0, 0, 20, 60, 0)
StopDrawing()
EndIf
If StartDrawing(CanvasOutput(#Note_La_))
Box(0, 0, 20, 60, 0)
StopDrawing()
EndIf
Repeat
Event = WaitWindowEvent()
Select Event
Case #PB_Event_Gadget
Select EventType()
Case #PB_EventType_LeftButtonDown
KeyNo = EventGadget()
Debug KeyNo
FNum = GetOPNNote(KeyNo, 0)
OPN_Write(0, $A4, FNum >> 8) ; frequency first channel high
OPN_Write(0, $A0, FNum & $FF) ; frequency first channel low
OPN_Write(0, $28, $F0) ; Note On - Resume Stream
Case #PB_EventType_LeftButtonUp
OPN_Write(0, $28, $00)
EndSelect
Case #PB_Event_CloseWindow
Quit = 1
EndSelect
Until Quit = 1
CloseOPNDriver()
CloseLibrary(OPNhdll)
EndIf
EndIf
EndIf
Small suggestion for improvement:infratec wrote: ↑Fri Mar 17, 2023 11:00 pmCode: Select all
#Note_Do = 66 #Note_Do_ = #Note_Do + 1 #Note_Re = #Note_Do_ + 1 #Note_Re_ = #Note_Re + 1 #Note_Mi = #Note_Re_ + 1 #Note_Fa = #Note_Mi + 1 #Note_Fa_ = #Note_Fa + 1 #Note_Sol = #Note_Fa_ + 1 #Note_Sol_ = #Note_Sol + 1 #Note_La = #Note_Sol_ + 1 #Note_La_ = #Note_La + 1 #Note_Si = #Note_La_ + 1
Code: Select all
Enumeration 66
#Note_Do
#Note_Do_
#Note_Re
#Note_Re_
#Note_Mi
#Note_Fa
#Note_Fa_
#Note_Sol
#Note_Sol_
#Note_La
#Note_La_
#Note_Si
EndEnumeration