| |
| |
|
Findus | Professor chaos (27.02.2013)
an 2 year old Spielerei to a (Perhaps zurecht) rare Programmierthema... Accurate said: One Nachbau the in XProfan installed Befehls "Music" - the with the Makrosprache from the middle-aged MS-DOS-QBasic. the particular on it is, that The music mehrstimmig his must and the Hauptprogramm during the Musikwiedergabe yet something other can make. Konzipiert watts the whole as Include for XProfan 9 (and new). an demonstration moreover: CompileMarkSeparation $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
The important command and functions are: polymusic_start s[,s[,s]...] Initialisiert one mehrstimmiges Musikstück. for each voice in this Piece commit one a String. the stature one such Strings is compatible with the XProfan-commands Music. See XProfan-Help. polymusic_run must often and regularly - z.B. any 20 Millisekunden - called go, so The music comes. polymusic_stop Stoppt any ongoing notes and gives all Ressourcen spare. polymusic_playing() gives 1 back, as long as the Piece runs, otherwise 0. alas Yes, and naturally The PolyMusic.inc self: CompileMarkSeparationdeclare _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
while 1
a%=_polychar()
if (a%<48) or (a%>57)
_pos%[trk%]=_pos%[trk%]-1
break
endif
b%=b%*10+a%-48
c%=b%
endwhile
return c%
endproc
tim&=&gettickcount
casenot _lat&:_lat&=tim&
tim&=tim&-_lat&
trk%=15
while trk%
dec trk%
casenot _pos%[trk%]:continue
if _dur&[trk%] and (tim&>=_dur&[trk%])
midiOutShortMsg(_hmo&,$7BB0 | _k%[trk%])' AllNotesOff
_dur&[trk%]=0
endif
case tim&<_dly&[trk%]:continue
while 1
a%=_polychar()
if (abs(a%-68)<4) or (a%=80)
b%=_polychar()
ifnot a%=80
a%=_key%[a%-65]+_o%[trk%]
if 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()
case a%<0:a%=_l%[trk%]
a%=240000\_t%[trk%]\a%
case b%=46:a%=a%+a% >> 1
_dur&[trk%]=_dly&[trk%]+a%*_m%[trk%]\8
_dly&[trk%]=_dly&[trk%]+a%
break
elseif a%=62
case _o%[trk%]<96:_o%[trk%]=_o%[trk%]+12' > (1 Oktave high)
elseif a%=60
case _o%[trk%]>0:_o%[trk%]=_o%[trk%]-12' < (1 Oktave down)
elseif a%<>77
if a%=32
_pos%[trk%]=0
dec _trx%
break
endif
b%=_polyint()
if b%>=0
if a%=76
_l%[trk%]=b%' length
elseif a%=79
_o%[trk%]=b%*12' Oktave
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%' channel
endif
endif
else
a%=_polychar()
if 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
|
|
| |
| |
| |
|
(931)
Deutsch
English
Français
Español
Italia