| |
| |
|
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: KompilierenMarqueSé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: KompilierenMarqueSéparationdeclare _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
|
|
| |
| |
| |
|
(903)
Deutsch
English
Français
Español
Italia