Any C programmers wanna help convert code to convert between MIDI + CSV?

[TempodiBasic]

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/viewtopi...14#p248014

Waiting feedbacks

[Jack]

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

[SMcNeill]

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/viewtopi...14#p248014

Waiting feedbacks

At first glance, isn't WriteFourBytes just MKL$??

[Jack]

it uses asm with interrupts to play the sound

[mnrvovrfc]

:
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/viewtopi...14#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.

[mnrvovrfc]

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.

[madscijr]

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-game.../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?

[mnrvovrfc]

"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.

[madscijr]

"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...

[mnrvovrfc]

"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...