Sound in JustBasic

Vragen en opmerkingen over Just BASIC en over RUNBASIC

Sound in JustBasic

Berichtdoor Gordon » ma maart 24, 2008 10:55 pm

Iemand heeft kans gezien om een stuk MIDI geluid in JustBasic te
programmeren. Normaliter gaat het programmeren van de
MIDI device via de WINMM.DLL (Windows Multi Media).

Het is niet mogelijk een DLL te openen in JB. Dat gaat natuurlijk wel
in LB.

Hier is de JB listing met de work around.
Code: Selecteer alles
'© 2008 by cundo.
'Use this code, modify this code, don't sell it, it's free
'and open source.
    nomainwin
    WindowWidth = 550 : WindowHeight = 425
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)
    'UpperLeftX=1 : UpperLeftY=1
    global currentNote$,letter,learnMode,speed,IsMIDIPlays
    learnMode=1
    letter=0
    notelist$(0)="Do Re Mi Fa Sol La Si Do"
    notelist$(1)="C D E F G A B C"
    notes$(1)="la fa re si sol mi do" 'in lines
    notes$(2)="sol mi do la fa re si" 'in spaces
    notes$(3)="a f d b g e c" 'in lines
    notes$(4)="g e c a f d b" 'in spaces

    call genNotes 'creates MID files with notes

    graphicbox  #main.g, 38, 26, 460, 310
    graphicbox  #main.load, 400, 346, 100, 25
    button      #main.c, word$(notelist$(0+letter),1), getnote, UL, 38, 346, 30, 25
    button      #main.d, word$(notelist$(0+letter),2), getnote, UL, 68, 346, 30, 25
    button      #main.e, word$(notelist$(0+letter),3), getnote, UL, 98, 346, 30, 25
    button      #main.f, word$(notelist$(0+letter),4), getnote, UL, 128, 346, 30, 25
    button      #main.g, word$(notelist$(0+letter),5), getnote, UL, 158, 346, 30, 25
    button      #main.a, word$(notelist$(0+letter),6), getnote, UL, 188, 346, 30, 25
    button      #main.b, word$(notelist$(0+letter),7), getnote, UL, 218, 346, 30, 25
    button      #main.c, word$(notelist$(0+letter),8), getnote, UL, 248, 346, 30, 25
    open "Notes" for dialog as #main
    #main.g,"down; fill white; flush"
    #main.load "font Arial 8"
    #main.load,"down; fill white; flush"
    #main, "trapclose [quit.main]"

    gosub [drawlines]
    #main.g "size 1"

    [restart]
    score=0
    #main.g "backcolor white;color blue"
    #main.g "place 16 16"
    #main.g "|- starting new game -"
    timer 850,[game]
    wait
    [game]
    timer 0
    #main.load "cls"
    #main.g "redraw ";mainsegment
    old.randomNote=randomNote

    randomX=int(RND(0)*10)*27  + 156
    randomNote=int(RND(0)*7)
    #main.g "color darkgray"
    if int(rnd(0)*10)+1>5 then
     gosub [inSpace]
    else
     gosub [inLine]
    end if

     #main.g "color red;backcolor white"

    if learnMode=1 then
     #main.g "place 300 16 "
     #main.g "\";UPPER$(currentNote$)
    else
     #main.g "place 300 32 "
     #main.g "\SCORE: ";using("####",score)
    end if
    if score>=100 then
     Notice "Bye :)";CHR$(13);"Stop playing !"
     goto [quit.main]
    end if
    #main.g "color black; backcolor black"
    #main.g "place ";randomX;" ";randomNote*20+80
    #main.g "circlefilled 10"
' adding MIDI sound
    if IsMIDIPlays then stopmidi: IsMIDIPlays = 0
    fname$ = str$(int(13-randomNote*2))+".mid"
    playmidi fname$, dummy
    IsMIDIPlays = 1

    score=score+1
    i=0
    [loading]

    timer 150,[step1]
    wait
    [step1]
    timer 0
       #main.load "color BLUE"
       #main.load "line ";i;" 0 ";i;" 25"
       i=i+3
    if i<100 then
        goto [loading]
        else
        goto [restart]
    end if

[quit.main]
    if IsMIDIPlays then stopmidi: IsMIDIPlays = 0
    Close #main
    END

[drawlines]
    #main.g "down;fill white;color darkgray;backcolor white"
    for i=1 to 5
        #main.g "line 32 ";i*20+80;" 440 ";i*20+80
    next i
        #main.g "size 2"
        #main.g "line 440 101 440 180"
    Gosub [GKEYSIGNATURE]
    #main.g "flush ";mainsegment
    RETURN

[inSpace]
    currentNote$=WORD$(notes$(2+letter*2),randomNote+1)
    randomNote=randomNote+0.5
    #main.g "line ";randomX-20;" ";randomNote*20+70;" ";randomX+20;" ";randomNote*20+70
    #main.g "line ";randomX-20;" ";randomNote*20+90;" ";randomX+20;" ";randomNote*20+90
    RETURN

[inLine]
    currentNote$=WORD$(notes$(1+letter*2),randomNote+1)
    #main.g "line ";randomX-20;" ";randomNote*20+80;" ";randomX+20;" ";randomNote*20+80
    RETURN

[GKEYSIGNATURE]
    print #main.g, "COLOR 70 70 70"
    #main.g "place 60 160"
    size=3
    #main.g "down;size ";size;";turn -75 ; go ";3
    for i=1 to 15
    size=size+ INT(i/8)
    #main.g "size ";size;";turn 26 ; go ";1+i
    next i
    for i=1 to 4
    size=size - INT(i/2)
    #main.g "size ";size;";turn 20 ; go ";5+i
    next i
    #main.g "turn 10 ; go ";62+i
    for i=1 to 4
    size=size - 1
    #main.g "size ";size;";turn -25 ; go ";14+i
    next i
    size=2
    #main.g "turn -129 ; go 200"
    for i=1 to 4
    size=size + i
    #main.g "size ";size;";turn 25 ; go ";5+i
    next i
    RETURN


SUB getnote h$
timer 0
#main.load "cls"

 if letter=1 then
  button$ = right$(h$,1)
 else
  p = instr( lower$(notelist$(1)),right$(h$,1))+1
  solf$= WORD$(lower$(notelist$(0)),INT(p/2) )
  button$ = solf$
 end if

  if button$ = currentNote$ then
      playwave "isabeep" ':)
    #main.load "color blue"
    #main.load "place 18 14"
    #main.load "\Correct!"
    if IsMIDIPlays then stopmidi: IsMIDIPlays = 0
    timer 100, [game]
     else
    #main.load "color red"
    #main.load "place 10 14"
    #main.load "\Wrong, is ";upper$(currentNote$)
    if IsMIDIPlays then stopmidi: IsMIDIPlays = 0
    timer 1000, [restart]
  end if
[game]
[restart]
END SUB

'-added by Tsh73-------------------
'----------------------------------
sub genNotes
   hexThing$= _
   "4D 54 68 64 00 00 00 06 00 01 00 02 00 78 4D 54 " + _
   "72 6B 00 00 00 19 00 FF 58 04 04 02 18 08 00 FF " + _
   "59 02 00 00 00 FF 51 03 09 27 C0 00 FF 2F 00 4D " + _
   "54 72 6B 00 00 00 14 00 FF 21 01 00 00 C0 49 00 " + _
   "90 ## 64 87 3F ## 00 00 FF 2F 00"

   notes$ = "3B 3C 3E 40 41 43 45 47 48 4A 4C 4D 4F 51 53"

   'PRINT hexThing$
   for i = 0 to 14
        repl2$ = word$(notes$, i+1)
        hexThing2$ = hexThing$
        call replaceAll hexThing2$, "##", repl2$
        'PRINT hexThing2$
        binThing$ = hex2binary$(hexThing2$)
        'print len(binThing$)
        'print binThing$
        open i;".mid" for binary as #1
        print #1, binThing$
        close #1
   next

end sub

'----------------------------------
sub replaceAll byRef workSring$, ChangeFrom$, ChangeTo$
    p = 1
    p =  instr(workSring$, ChangeFrom$, p)
    while p <> 0
        workSring$ = left$( workSring$, p-1 ) + ChangeTo$ +  mid$( workSring$, p+len(ChangeFrom$) )
        p = p+len(ChangeFrom$)
        if p>len(workSring$) then exit while
        p =  instr(workSring$, ChangeFrom$, p)
    wend
end sub

'----------------------------------
function hex2binary$(a$)
    cnt = 1
    res$ = ""
    t$ = word$(a$, cnt)
    do while t$ <> ""
        res$ = res$ + chr$(hex2Dec(t$))
        cnt = cnt+1
        t$ = word$(a$, cnt)
    loop
    hex2binary$ = res$
end function

'----------------------------------
function hex2Dec(s$)
    hex2Dec = 0
    'supposed valid value - up to 4 digits
    If Len(s$) > 4 Then Exit Function
    For I = 1 To Len(s$)
        c$ = upper$(Mid$(s$, I, 1))
        'safeguard?
        If InStr("0123456789ABCDEF", c$) = 0 Then c$ = "0"
        hex2Dec = hex2Dec * 16 + InStr("0123456789ABCDEF", c$) - 1
    Next I
End Function



Werkelijk knap.
Je kunt de hele discussie natuurlijk volgen op
http://justbasic.conforums.com/index.cgi?board=games

Gordon
Avatar gebruiker
Gordon
Site Admin
 
Berichten: 684
Geregistreerd: zo mei 22, 2005 12:50 am

Keer terug naar Just BASIC en RUNBASIC

Wie is er online

Gebruikers op dit forum: Geen geregistreerde gebruikers. en 1 gast

cron