XProfan

Français

Findus

Professor chaos (27.02.2013)

une 2 Jahre vieille Spielerei trop einem (peut-être zurecht) seltenen Programmierthema...

Genauer dit:
un Nachbau des dans XProfan eingebauten Befehls "Music" - qui avec qui Makrosprache aus dem alten MS-DOS-QBasic.
cela besondere daran ist, dass qui Musik mehrstimmig son darf et cela Hauptprogramm au cours de qui Musikwiedergabe et avec ca d'autre faire peux.
Konzipiert wurde cela ganze comme Include pour XProfan 9 (et neuer).

une Demo en supplément:
Kompilieren Marque Séparation

 $I PolyMusic.inc
declare a$,b$,c$,d$,e$
usermessages 16' Fensterschließen abfangen
windowtitle "Ludwig van Beethoven - Rondo a Capriccio Op. 129 (Die Wut über den verlorenen Groschen)"
windowstyle 26
cls
a$="T160 K0 O5"
a$=a$+"L8 B4 MS >DDGG MN B4 L16"
a$=a$+">DCDC MS <A8 P8 MN"
a$=a$+">DCDC MS <A8 P8 MN <"
a$=a$+"L8 B4 MS >DDGG MN B4 L16"
a$=a$+">DCDC MS <A8 MN ABG4P4 L16"
a$=a$+"BAGF#EF#GA L8 MS BB MN >E4 L16"
a$=a$+"ED#ED# MS <B8 P8 MN >"
a$=a$+"ED#ED# MS <B8 P8 MN"
a$=a$+"BAGF#EF#GA L8 MS BB MN >E4"
a$=a$+"L32 C#C#C#C#C#C#C#C#C#C#C#C# L16 <B>C# L4 D<D"
b$="T160 K1 O4 L8 GGGG GGGG GGGG GGGG GGGG GGGG GGGG GGGG EEEE EEEE<BBBB BBBB>EEEE EEEE<AAAA>DDDD"
c$="T160 K2 O4 L8 BBBB BBBB>CCCC CCCC<BBBB BBBB>CCCC<BBBB GGGG GGGG EEEE EEEE GGGG GGGG EEEE F#F#F#F#"
d$="T160 K3 O5 L8 DDDD DDDD DDDD DDDD DDDD DDDD DDDD DP.4<BBBB BBBB AAAA AAAA BBBB BBBB GGGG AAAA"
e$="T160 K4 O5 L8 P1 F#F#F#F#F#F#F#F# P1    F#F#F#F# GP.4 P1       <BBBB BBBB P1        AAAA"
polymusic_start a$,b$,c$,d$,e$
' Bis jemand das Fenster schließt oder das Stück zu Ende ist, regelmäßig...
settimer 10

while (%umessage<>16) and polymusic_playing()

    waitinput
    ' ...das Stück spielen...
    polymusic_run' (Diese Prozedur möglichst oft aufrufen!)
    ' ...und dabei irgendwas tun. Bunte Kreise malen zum Beispiel.
    usebrush 1,rnd(255)*257
    ellipse rnd(640),rnd(480)-rnd(640),rnd(480)

endwhile

' Ressourcen freigeben
killtimer
polymusic_stop

qui wichtigen Befehle et Funktionen sommes:

polymusic_start S[,S[,S]...]
Initialisiert un mehrstimmiges Musikstück. Pour chacun Stimme dans diesem Stück übergibt on une String. cela Format eines solchen Cordes ist kompatibel avec dem XProfan-Befehl Music. Siehe XProfan-Aider.
polymusic_run
Muss souvent et régulier - z.B. alle 20 Millisekunden - aufgerufen volonté, avec cela qui Musik venez.
polymusic_stop
Stoppt alle laufenden Noten et gibt sämtliche Ressourcen libre.
polymusic_playing()
Gibt 1 zurück, solange cela Stück fonctionne, ansonsten 0.

ah oui, et naturellement qui PolyMusic.inc selbst:
Kompilieren Marque Séparation

declare _dev%,_hmo&,_trx%,_lat&,_key%[6]
declare _dur&[14],_dly&[14],_trk$[14],_pos%[14]
declare _k%[14],_t%[14],_l%[14],_o%[14],_m%[14]
_dev%=-1
_key%[0]=9
_key%[1]=11
_key%[2]=0
_key%[3]=2
_key%[4]=4
_key%[5]=5
_key%[6]=7
def midiOutGetNumDevs(0) !"WINMM","midiOutGetNumDevs"
def midiOutGetDevCaps(3) !"WINMM","midiOutGetDevCapsA"
def midiOutOpen(5)       !"WINMM","midiOutOpen"
def midiOutShortMsg(2)   !"WINMM","midiOutShortMsg"
def midiOutClose(1)      !"WINMM","midiOutClose"
'def SetTimer(4)          !"User32","SetTimer"
'def KillTimer(2)         !"User32","KillTimer"
def polymusic_playing(0) _hmo&<>0

proc polymusic_adddevices

    declare a#
    dim a#,52

    whileloop 0,midiOutGetNumDevs()-1

        midiOutGetDevCaps(&loop,a#,52)
        addstring char$(a#,8,32)

    endwhile

    dispose a#

endproc

proc polymusic_usedevice

    _dev%=%(1)

endproc

proc polymusic_stop

    casenot _hmo&:return
    'KillTimer(%hwnd,1)

    whileloop 0,15

        midiOutShortMsg(_hmo&,$78B0 | &loop)' AllSoundsOff

    endwhile

    midiOutClose(_hmo&)
    clear _hmo&,_lat&,_dly&[],_k%[]

endproc

proc polymusic_run

    'set("Fastmode",1)
    'parameters wnd%,msg%,evt%,tim&
    declare a%,b%,c%,trk%,tim&

    proc _polychar

        declare a%
        a%=ord(mid$(_trk$[trk%],_pos%[trk%],1))
        _pos%[trk%]=_pos%[trk%]+1
        return a%

    endproc

    proc _polyint

        declare a%,b%,c%
        b%=0
        c%=-1

        tandis que 1

            a%=_polychar()

            si (a%<48) or (a%>57)

                _pos%[trk%]=_pos%[trk%]-1
                pause

            endif

            b%=b%*10+en%-48
            c%=b%

        endwhile

        return c%

    endproc

    tim&=&gettickcount
    casenot _lat&:_lat&=tim&
    tim&=tim&-_lat&
    trk%=15

    tandis que trk%

        dec trk%
        casenot _pos%[trk%]:continue

        si _dur&[trk%] and (tim&>=_dur&[trk%])

            midiOutShortMsg(_hmo&,$7BB0 | _k%[trk%])' AllNotesOff
            _dur&[trk%]=0

        endif

        cas tim&<_dly&[trk%]:continue

        tandis que 1

            a%=_polychar()

            si (abs(en%-68)<4) or (en%=80)

                b%=_polychar()

                ifnot a%=80

                    a%=_key%[en%-65]+_o%[trk%]

                    si abs(b%-39)=4

                        inc a%
                        b%=_polychar()

                    elseif b%=45

                        dec a%
                        b%=_polychar()

                    endif

                    midiOutShortMsg(_hmo&,$7F0090 | _k%[trk%] | (a% << 8))' NoteOn

                endif

                casenot b%=46:_pos%[trk%]=_pos%[trk%]-1
                a%=_polyint()
                cas a%<0:a%=_l%[trk%]
                a%=240000\_t%[trk%]\a%
                cas b%=46:a%=en%+a% >> 1
                _dur&[trk%]=_dly&[trk%]+en%*_m%[trk%]\8
                _dly&[trk%]=_dly&[trk%]+a%
                pause

            elseif a%=62

                cas _o%[trk%]<96:_o%[trk%]=_o%[trk%]+12' > (1 octave hoch)

            elseif a%=60

                cas _o%[trk%]>0:_o%[trk%]=_o%[trk%]-12' < (1 octave runter)

            elseif a%<>77

                si a%=32

                    _pos%[trk%]=0
                    dec _trx%
                    pause

                endif

                b%=_polyint()

                si b%>=0

                    si a%=76

                        _l%[trk%]=b%' Longueur

                    elseif a%=79

                        _o%[trk%]=b%*12' octave

                    elseif a%=86

                        midiOutShortMsg(_hmo&,$7B0 | _k%[trk%] | (b% << 16))' Volume

                    elseif a%=73

                        midiOutShortMsg(_hmo&,$C0 | _k%[trk%] | (b% << 8))' instrument

                    elseif a%=84

                        _t%[trk%]=b%' Tempo

                    elseif a%=75

                        _k%[trk%]=b%' canal

                    endif

                endif

            d'autre

                a%=_polychar()

                si a%=78

                    _m%[trk%]=7' MNormal

                elseif a%=83

                    _m%[trk%]=4' MStaccato

                elseif a%=76

                    _m%[trk%]=8' MLegato

                endif

            endif

        endwhile

    endwhile

    casenot _trx%:polymusic_stop
    'set("Fastmode",0)

endproc

proc polymusic_start

    declare a$,pcount%,p$[14]
    pcount%=%pcount

    whileloop 1,pcount%

        p$[&loop-1]=$(&loop)

    endwhile

    polymusic_stop
    casenot pcount%:return 1
    casenot midiOutOpen(addr(_hmo&),_dev%,0,0,0)=0:return 0

    whileloop 0,15

        midiOutShortMsg(_hmo&,$79B0 | &loop)' ResetAllControllers
        midiOutShortMsg(_hmo&,$C0 | &loop)' ProgramChange := Acoustic Grand Piano
        midiOutShortMsg(_hmo&,$6407B0 | &loop)' Channel Volume := 100

    endwhile

    _trx%=pcount%

    whileloop 0,_trx%-1

        a$=translate$(p$[&loop]," ",»)
        _trk$[&loop]=translate$(upper$(a$),"H","B")+" "
        _pos%[&loop]=1
        _t%[&loop]=120
        _l%[&loop]=4
        _o%[&loop]=48
        _m%[&loop]=7

    endwhile

    'SetTimer(%hwnd,1,10,procaddr(_polymusic_run,4))
    return 1

endproc