RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - TempodiBasic - 09-03-2022
Code: (Select All) FUNCTION WriteVarLen(Value as integer) as string
dim a as string
a=chr(Value AND 127)
DO WHILE (Value > 127)
Value = Value shr 7
a=chr((Value AND 127)or 128)+a
LOOP
return a
END FUNCTION
FUNCTION WriteFourBytes(Value as integer) as string
dim a as string
a=chr(Value and 255)
Value shr= 8
a=chr(Value and 255)+a
Value shr= 8
a=chr(Value and 255)+a
Value shr= 8
a=chr(Value and 255)+a
return a
end function
function _fbplay_internal_translateNote(toTranslate as string) as ubyte
select case toTranslate
case "c" : return 0
case "cs" : return 1
case "db" : return 1
case "d" : return 2
case "ds" : return 3
case "eb" : return 3
case "e" : return 4
case "fb" : return 4
case "f" : return 5
case "es" : return 5
case "fs" : return 6
case "gb" : return 6
case "g" : return 7
case "gs" : return 8
case "ab" : return 8
case "a" : return 9
case "as" : return 10
case "bb" : return 10
case "b" : return 11
case "cb" : return 11
end select
end function
function _fbplay_internal(channel as ubyte, playstr as string) as string
'default tempo is 120 quarter notes per minute
'default note is a quarter note
'as default notes play their full length
'default octave is the 4th
'default instrument is acoustic grand piano |TODO: Find a instrument closer to QB's PLAY sound.
'maximum volume is default
dim Track as string
dim tempo as uinteger = 120
dim note_len as ubyte = 4
dim note_len_mod as double = 1
dim octave as ubyte = 4
dim volume as ubyte = 127
dim note_stack(128) as ubyte
dim chord as ubyte
dim next_event as double
dim duration as double
dim idx as ubyte
dim number as string
dim char as string*1
dim tChar as string*1
dim toTranslate as string
dim p as integer=1
do while p < len(playstr)
char=lcase(mid(playstr, p, 1))
p+=1
select case char
'basic playing
case "n" 'plays note with next-comming number, if 0 then pause
number=""
do
tchar=mid(playstr, p, 1)
if asc(tchar)>=48 and asc(tchar)<=57 then
p+=1
number+=tchar
else
exit do
end if
loop
idx=val(number)
if idx=0 then 'pause
next_event+=60/tempo*(4/note_len)/60
else 'note
duration=60/tempo*(4/note_len)
Track=Track+WriteVarLen(240*next_event)+chr(&H90 + channel)+chr(idx)+chr(volume)
next_event=duration*(1-note_len_mod)
'stop_note(channel)=t+duration*note_len_mod(channel)
note_stack(0)+=1
note_stack(note_stack(0))=idx
end if
case "a" to "g" 'plays a to g in current octave
duration=60/tempo*(4/note_len)
toTranslate=char
number=""
char=mid(playstr, p, 1)
if char="-" then
toTranslate+="b"
p+=1
elseif char="+" or char="#" then
toTranslate+="s"
p+=1
end if
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
if val(number)<>0 then duration=duration*4/val(number)
if char="." then duration=duration*1.5
idx=12*octave+_fbplay_internal_translateNote(toTranslate)
Track=Track+WriteVarLen(240*next_event)+chr(&H90 + channel)+chr(idx)+chr(volume)
next_event=duration*(1-note_len_mod)
note_stack(0)+=1
note_stack(note_stack(0))=idx
case "p" 'pauses for next-comming number of quarter notes
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
next_event+=60/tempo*4/val(number)
'octave handling
case ">" 'up one octave
if octave<7 then octave+=1
case "<" 'down one octave
if octave>1 then octave-=1
case "o" 'changes octave to next-comming number
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
octave=val(number)
'play control
case "t" 'changes tempo (quarter notes per minute)
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
tempo=val(number)
case "l" 'changes note length (1=full note, 4=quarter note, 8 eigth(?) note aso)
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
note_len=val(number)
case "m" 'MS makes note last 3/4, MN is 7/8 and ML sets to normal length
char=lcase(mid(playstr, p, 1))
p+=1
if char="s" then note_len_mod=3/4
if char="n" then note_len_mod=7/8
if char="l" then note_len_mod=1
'new midi fucntions
case "i"
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
Track=Track+WriteVarLen(0)+chr(&HC0 + channel)+chr(val(number))
case "v"
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
volume=val(number)
Case "{" 'enable chords (notes play simultaneously)
chord=1
Case "}" 'disable chords (notes play simultaneously)
chord=0
case else
end select
if chord then
if chord=2 then next_event=0 else chord=2
else
'Stop current note, if still playing
for i as integer=1 to note_stack(0)
Track=Track+WriteVarLen(240*duration*note_len_mod)+chr(&H80 + channel)+chr(note_stack(i))+chr(0)
duration=0
next
note_stack(0)=0
end if
loop
return Track
end function
sub play (playstr as string, playstr1 as string="", playstr2 as string="", playstr3 as string="", _
playstr4 as string="", playstr5 as string="", playstr6 as string="", playstr7 as string="", _
playstr8 as string="", playstr9 as string="", playstr10 as string="", playstr11 as string="", _
playstr12 as string="", playstr13 as string="", playstr14 as string="", playstr15 as string="")
'if lcase(left(_fbplay_internal_playstr(0),2))="mb" then 'supposed to play in foreground
dim Tracks as integer
dim midi as string
dim Track as string
Track=_fbplay_internal (0,playstr)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (1,playstr1)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (2,playstr2)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (3,playstr3)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (4,playstr4)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (5,playstr5)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (6,playstr6)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (7,playstr7)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (8,playstr8)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (9,playstr9)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (10,playstr10)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (11,playstr11)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (12,playstr12)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (13,playstr13)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (14,playstr14)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (15,playstr15)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
open "output.mid" for output as #2
?#2,"MThd"+chr(0)+chr(0)+chr(0)+chr(6)+chr(0)+chr(iif(Tracks>1,1,0))+chr(0)+chr(Tracks)+chr(0)+chr(120)+Midi;
close
end sub
PLAY " i48 t200l4mneel2el4eel2el4egl3cl8dl1el4ffl3fl8fl4fel2el8eel4eddel2dgl4eel2el4eel2el4egl3cl8dl1el4ffl3fl8fl4fel2el8efl4ggfdl2cl8"
Moreover I have found this FreeBasic program that translate into MIDI a PLAY sound/song
It can be used to understand how MIDI file is built and so how to manage it!
And if this is interesting it can be translated into QB64.
Here original link https://www.freebasic.net/forum/viewtopic.php?p=248014#p248014
Waiting feedbacks
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - Jack - 09-03-2022
using Segment and Peek/Poke may need a rewrite, _offset and _mem may be useful to make it work
[edit]
not so easy, it uses hackish assembly
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - SMcNeill - 09-03-2022
(09-03-2022, 02:28 PM)TempodiBasic Wrote: Code: (Select All) FUNCTION WriteVarLen(Value as integer) as string
dim a as string
a=chr(Value AND 127)
DO WHILE (Value > 127)
Value = Value shr 7
a=chr((Value AND 127)or 128)+a
LOOP
return a
END FUNCTION
FUNCTION WriteFourBytes(Value as integer) as string
dim a as string
a=chr(Value and 255)
Value shr= 8
a=chr(Value and 255)+a
Value shr= 8
a=chr(Value and 255)+a
Value shr= 8
a=chr(Value and 255)+a
return a
end function
function _fbplay_internal_translateNote(toTranslate as string) as ubyte
select case toTranslate
case "c" : return 0
case "cs" : return 1
case "db" : return 1
case "d" : return 2
case "ds" : return 3
case "eb" : return 3
case "e" : return 4
case "fb" : return 4
case "f" : return 5
case "es" : return 5
case "fs" : return 6
case "gb" : return 6
case "g" : return 7
case "gs" : return 8
case "ab" : return 8
case "a" : return 9
case "as" : return 10
case "bb" : return 10
case "b" : return 11
case "cb" : return 11
end select
end function
function _fbplay_internal(channel as ubyte, playstr as string) as string
'default tempo is 120 quarter notes per minute
'default note is a quarter note
'as default notes play their full length
'default octave is the 4th
'default instrument is acoustic grand piano |TODO: Find a instrument closer to QB's PLAY sound.
'maximum volume is default
dim Track as string
dim tempo as uinteger = 120
dim note_len as ubyte = 4
dim note_len_mod as double = 1
dim octave as ubyte = 4
dim volume as ubyte = 127
dim note_stack(128) as ubyte
dim chord as ubyte
dim next_event as double
dim duration as double
dim idx as ubyte
dim number as string
dim char as string*1
dim tChar as string*1
dim toTranslate as string
dim p as integer=1
do while p < len(playstr)
char=lcase(mid(playstr, p, 1))
p+=1
select case char
'basic playing
case "n" 'plays note with next-comming number, if 0 then pause
number=""
do
tchar=mid(playstr, p, 1)
if asc(tchar)>=48 and asc(tchar)<=57 then
p+=1
number+=tchar
else
exit do
end if
loop
idx=val(number)
if idx=0 then 'pause
next_event+=60/tempo*(4/note_len)/60
else 'note
duration=60/tempo*(4/note_len)
Track=Track+WriteVarLen(240*next_event)+chr(&H90 + channel)+chr(idx)+chr(volume)
next_event=duration*(1-note_len_mod)
'stop_note(channel)=t+duration*note_len_mod(channel)
note_stack(0)+=1
note_stack(note_stack(0))=idx
end if
case "a" to "g" 'plays a to g in current octave
duration=60/tempo*(4/note_len)
toTranslate=char
number=""
char=mid(playstr, p, 1)
if char="-" then
toTranslate+="b"
p+=1
elseif char="+" or char="#" then
toTranslate+="s"
p+=1
end if
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
if val(number)<>0 then duration=duration*4/val(number)
if char="." then duration=duration*1.5
idx=12*octave+_fbplay_internal_translateNote(toTranslate)
Track=Track+WriteVarLen(240*next_event)+chr(&H90 + channel)+chr(idx)+chr(volume)
next_event=duration*(1-note_len_mod)
note_stack(0)+=1
note_stack(note_stack(0))=idx
case "p" 'pauses for next-comming number of quarter notes
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
next_event+=60/tempo*4/val(number)
'octave handling
case ">" 'up one octave
if octave<7 then octave+=1
case "<" 'down one octave
if octave>1 then octave-=1
case "o" 'changes octave to next-comming number
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
octave=val(number)
'play control
case "t" 'changes tempo (quarter notes per minute)
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
tempo=val(number)
case "l" 'changes note length (1=full note, 4=quarter note, 8 eigth(?) note aso)
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
note_len=val(number)
case "m" 'MS makes note last 3/4, MN is 7/8 and ML sets to normal length
char=lcase(mid(playstr, p, 1))
p+=1
if char="s" then note_len_mod=3/4
if char="n" then note_len_mod=7/8
if char="l" then note_len_mod=1
'new midi fucntions
case "i"
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
Track=Track+WriteVarLen(0)+chr(&HC0 + channel)+chr(val(number))
case "v"
number=""
do
char=mid(playstr, p, 1)
if asc(char)>=48 and asc(char)<=57 then
p+=1
number+=char
else
exit do
end if
loop
volume=val(number)
Case "{" 'enable chords (notes play simultaneously)
chord=1
Case "}" 'disable chords (notes play simultaneously)
chord=0
case else
end select
if chord then
if chord=2 then next_event=0 else chord=2
else
'Stop current note, if still playing
for i as integer=1 to note_stack(0)
Track=Track+WriteVarLen(240*duration*note_len_mod)+chr(&H80 + channel)+chr(note_stack(i))+chr(0)
duration=0
next
note_stack(0)=0
end if
loop
return Track
end function
sub play (playstr as string, playstr1 as string="", playstr2 as string="", playstr3 as string="", _
playstr4 as string="", playstr5 as string="", playstr6 as string="", playstr7 as string="", _
playstr8 as string="", playstr9 as string="", playstr10 as string="", playstr11 as string="", _
playstr12 as string="", playstr13 as string="", playstr14 as string="", playstr15 as string="")
'if lcase(left(_fbplay_internal_playstr(0),2))="mb" then 'supposed to play in foreground
dim Tracks as integer
dim midi as string
dim Track as string
Track=_fbplay_internal (0,playstr)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (1,playstr1)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (2,playstr2)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (3,playstr3)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (4,playstr4)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (5,playstr5)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (6,playstr6)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (7,playstr7)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (8,playstr8)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (9,playstr9)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (10,playstr10)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (11,playstr11)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (12,playstr12)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (13,playstr13)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (14,playstr14)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
Track=_fbplay_internal (15,playstr15)
if len(Track)>0 then
Midi=Midi +"MTrk"+WriteFourBytes(len(Track)+4)+Track+chr(0)+chr(255)+chr(47)+chr(0)
Tracks+=1
end if
open "output.mid" for output as #2
?#2,"MThd"+chr(0)+chr(0)+chr(0)+chr(6)+chr(0)+chr(iif(Tracks>1,1,0))+chr(0)+chr(Tracks)+chr(0)+chr(120)+Midi;
close
end sub
PLAY " i48 t200l4mneel2el4eel2el4egl3cl8dl1el4ffl3fl8fl4fel2el8eel4eddel2dgl4eel2el4eel2el4egl3cl8dl1el4ffl3fl8fl4fel2el8efl4ggfdl2cl8"
Moreover I have found this FreeBasic program that translate into MIDI a PLAY sound/song
It can be used to understand how MIDI file is built and so how to manage it!
And if this is interesting it can be translated into QB64.
Here original link https://www.freebasic.net/forum/viewtopic.php?p=248014#p248014
Waiting feedbacks
At first glance, isn't WriteFourBytes just MKL$??
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - Jack - 09-03-2022
it uses asm with interrupts to play the sound
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - mnrvovrfc - 09-03-2022
(09-03-2022, 02:28 PM)TempodiBasic Wrote: :
Moreover I have found this FreeBasic program that translate into MIDI a PLAY sound/song
It can be used to understand how MIDI file is built and so how to manage it!
And if this is interesting it can be translated into QB64.
Here original link https://www.freebasic.net/forum/viewtopic.php?p=248014#p248014
Waiting feedbacks The "WriteFourBytes" I needed to write in Lua v5.1 a few years ago so I could process wave files:
Code: (Select All) function longintencode(num)
return string.char(bit32.extract(num, 0, 8)) ..
string.char(bit32.extract(num, 8, 8)) ..
string.char(bit32.extract(num, 16, 8)) ..
string.char(bit32.extract(num, 24, 8))
end -- longintencode
It doesn't work anymore on the latest Lua because "bit32" module was removed. Maybe the person who created the Freebasic program which was posted, was translating from another language and didn't have extensive knowledge of a BASIC dialect, or didn't care for it.
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - mnrvovrfc - 09-03-2022
I noticed the code from "QMIDI" which would work on 16-bit systems but not 32-bit and 64-bit because the "CALL INTERRUPT" system was either extensively modified into the Win32 API or was removed entirely. QB64 could emulate only a few things out of it such as the mouse driver. Galleon made a valiant effort to emulate "conventional memory" and CPU registers and stuff like that, toward how GW-BASIC stored configuration in a few "low" addresses of 16-bit space but there was just too much to consider for like less than 5% of ancient BASIC programs to make work.
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - madscijr - 09-03-2022
(09-03-2022, 02:20 PM)TempodiBasic Wrote: Hi QB64 friends
...
I have found very interesting and reach of information the published work of Utah in VB6
moreover many links have talked about a unfoundable QMIDI.BAS written in Qbasic.
After different googled researches I got it...
Here it is and I post it in Codebox tool
Code: (Select All) ...
'538 lines (511 sloc) 20.5 KB
...
DECLARE SUB GetIntVector (IntNum%, Segment%, Offset%)
'Loads and plays a file using SBSIM
...
Sub GetIntVector (IntNum%, Segment%, Offset%) Static
'If the code hasn't been loaded already, do it now.
If GetIntVCodeLoaded% = 0 Then
asm$ = asm$ + Chr$(&H55)
asm$ = asm$ + Chr$(&H89) + Chr$(&HE5)
asm$ = asm$ + Chr$(&H8B) + Chr$(&H5E) + Chr$(&HA)
asm$ = asm$ + Chr$(&H8A) + Chr$(&H7)
asm$ = asm$ + Chr$(&HB4) + Chr$(&H35)
asm$ = asm$ + Chr$(&HCD) + Chr$(&H21)
asm$ = asm$ + Chr$(&H8C) + Chr$(&HC1)
asm$ = asm$ + Chr$(&H89) + Chr$(&HDA)
asm$ = asm$ + Chr$(&H8B) + Chr$(&H5E) + Chr$(&H8)
asm$ = asm$ + Chr$(&H89) + Chr$(&HF)
asm$ = asm$ + Chr$(&H8B) + Chr$(&H5E) + Chr$(&H6)
asm$ = asm$ + Chr$(&H89) + Chr$(&H17)
asm$ = asm$ + Chr$(&H5D)
asm$ = asm$ + Chr$(&HCB)
asm$ = asm$ + Chr$(&H34) + Chr$(&H0)
asm$ = asm$ + Chr$(&H60)
asm$ = asm$ + Chr$(&H23) + Chr$(&H0)
GetIntVCodeLoaded% = 1
End If
'Execute the code
Def Seg = VarSeg(asm$)
Call Absolute(IntNum%, Segment%, Offset%, SAdd(asm$))
End Sub
...
you can got it from here or if you prefer from https://github.com/creationix/basic-games/blob/master/RPG2/QMIDI.BAS
If you copy and paste the code into QB64 IDE you get this error tha I don't know how to solve to try to run the code.
Any suggestions?
Thanks for sharing that Tempodi!
I'm not sure yet what is causing the error, as I am not at my PC, however something I have been seeing that I am curious about is, what are those DECLARE FUNCTION and DECLARE SUB statements at the top, when the actual routine definitions are included in the code? What purpose does it serve including an additional DECLARE statement for them at the top? Is this some requirement of old QuickBasic that QB64 supports for backwards compatibility, but is optional in QB64, or does it serve some other purpose, like help optimize the compiler, or serve as a heads up to other programmers that these routines are included below?
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - mnrvovrfc - 09-03-2022
"DECLARE" is not needed in QB64 unless you define routines in mixed-language programming, such as the "direntry.h" file contributed by Steve. Otherwise is what I told you and what @Jack told you LOL, it uses "CALL ABSOLUTE" to load up machine language which works in 16-bit but not in our present time. Would have to run that code in M$QB or QBasic inside DOSBOX or something like that.
It's "DECLARE LIBRARY" specific to QB64, although it does ignore any "DECLARE SUB" or "DECLARE FUNCTION" given from old QB programs.
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - madscijr - 09-03-2022
(09-03-2022, 03:19 PM)mnrvovrfc Wrote: "DECLARE" is not needed in QB64 unless you define routines in mixed-language programming, such as the "direntry.h" file contributed by Steve. Otherwise is what I told you and what @Jack told you LOL, it uses "CALL ABSOLUTE" to load up assembly which works in 16-bit but not in our present time. Would have to run that code in M$QB or QBasic inside DOSBOX or something like that.
Ah, thanks. I don't see any inline assembly code around that GetIntVector, but this being old QuickBasic (or is it classic VB?) code, from the 32 or 16-bit era, we may want to check all the variable types and make sure they are updated for QB64 & modern 64-bit PCs?
UPDATE: I just saw your earlier answer above. Yeah, the whole module probably needs to be updated or reworked for modern 64-bit Windows compatibility...
RE: Any C programmers wanna help convert code to convert between MIDI + CSV? - mnrvovrfc - 09-03-2022
(09-03-2022, 03:25 PM)madscijr Wrote: (09-03-2022, 03:19 PM)mnrvovrfc Wrote: "DECLARE" is not needed in QB64 unless you define routines in mixed-language programming, such as the "direntry.h" file contributed by Steve. Otherwise is what I told you and what @Jack told you LOL, it uses "CALL ABSOLUTE" to load up assembly which works in 16-bit but not in our present time. Would have to run that code in M$QB or QBasic inside DOSBOX or something like that.
Ah, thanks. I don't see any inline assembly code around that GetIntVector, but this being old QuickBasic (or is it classic VB?) code, from the 32 or 16-bit era, we may want to check all the variable types and make sure they are updated for QB64 & modern 64-bit PCs?
UPDATE: I just saw your earlier answer above. Yeah, the whole module probably needs to be updated or reworked for modern 64-bit Windows compatibility... Maybe it's not worth the effort. We have to try something else.
From this page:
https://qb64phoenix.com/qb64wiki/index.php/INTERRUPT
Registers are emulated in QB64 and there is no support for intNum 33h mouse functions above 3 or intNum requests other than 33.
If the routine has to do "INT 21h" which was the popular MS-DOS interrupt it wouldn't work, either with "CALL ABSOLUTE" or with "CALL INTERRUPT". I don't know if an MS-DOS interrupt needed to be called to generate sound, that's new to me...
|