rem MIDI Demo III ....... Rev 3.4 rem A J Tooth // November 2004 rem Modified January 2009 rem ========================================================================= rem This program plays the 4-note extended-triad chords of the key of C Major rem in a random sequence, and also plays the 4 notes in a random sequence. rem It is therefore partially random / partially expected, and so sounds rem quite acceptable to the ear. rem ========================================================================= on error then sys "midiOutClose", hMidiOut% : quit mode 22 : colour 143:cls rem Initialise proc_init rem Select instrument proc_Selinst rem Screen setup proc_screenset rem MIDI INITIALISED FOR USE HERE rem ============================= rem Open MIDI Channel sys "midiOutOpen", ^hMidiOut%, -1, 0, 0, 0 to ret% if ret% error 100, "Failed to open MIDI output device" rem Change instrument proc_ChangeInst(Inst%) lun%=200 : rem Gap between Chords repeat sq&=rnd(24) : rem Random Standard Sequence sel&=rnd(21)-1 : rem Random Root Note over 3 Octaves del%=100*(rnd(5)-1) : rem Arpeggio rate rem Find the right notes proc_FindNotes rem Play the chord proc_NewChord a$=inkey$(1) until a$<>"" rem Finale sequence to resolve using CMaj7 chord. proc_Finale rem Close MIDI Channel on exit. sys "midiOutClose", hMidiOut% quit rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ rem End of Program ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ rem Initialise def proc_init local a&,y&,z& rem Load Notes and Sequence Data dim gap&(7),seq&(24,4), nt%(4) rem Assign gaps between Major Scale notes gap&()=0,2,2,1,2,2,2,1 rem Load all permutations of (1,2,3,4) restore for y&=1 to 24 for z&=1 to 4 read seq&(y&,z&) next z& next y& rem Load Instruments dim Inst$(120) for a&=1 to 120 read Inst$(a&) next a& cls:colour 0:print tab(1,1);"Select an Instrument (Click on the list)" Inst%=-1 endproc rem----------------------------------------------------------------- rem Screen setup def proc_screenset rem Switch to fullscreen proc_fullscreen(xscreen%,yscreen%) rem Provides a celestial backdrop proc_backdrop rem Draw a treble clef based motif proc_clef(512,700,rnd(1),rnd(1),rnd(1)) colour 3,150,120,0 : colour 3 : *FONT Desdemona,18 print tab(10,10);"Press any key to stop." endproc rem----------------------------------------------------------------- rem Enable Polyphonic playing def proc_NewChord event%=176 subevent%=127 dwMsg%=subevent%*256 + event% sys "midiOutShortMsg", hMidiOut%, dwMsg% proc_PlayNewNotes : rem Play new notes proc_StopPlay : rem Stop notes endproc rem----------------------------------------------------------------- rem Play new notes in unison def proc_PlayNewNotes local t&,nn& rem Play in the appropriate sequence for t&=1 to 4 nn&=seq&(sq&,t&) proc_Note(nn&) next t& sys "Sleep",lun% endproc rem----------------------------------------------------------------- rem Stop notes from playing def proc_StopPlay local event%, dwMsg% rem Stop ALL Notes event%=176 subevent%=123 dwMsg%=subevent%*256 + event% sys "midiOutShortMsg", hMidiOut%, dwMsg% endproc rem----------------------------------------------------------------- rem signal a voice change def proc_ChangeInst(voice%) local event%, velocity%, low%, hi%, dwMsg% event%=192 : rem event 192 = change velocity%=120 low%=(voice%*256)+event% hi%=velocity%<<16 dwMsg%=low%+hi% sys "midiOutShortMsg",hMidiOut%, dwMsg% endproc rem----------------------------------------------------------------- rem Play a Note def proc_Note(Nn%) local event%, low%, velocity%, hi%, dwMsg% event%=144 : rem event 144 = play on channel 1 low%=(256*nt%(Nn%))+event% velocity%=120 hi%=velocity%<<16 dwMsg%=low%+hi% sys "midiOutShortMsg", hMidiOut%, dwMsg% sys "Sleep",del% endproc rem----------------------------------------------------------------- rem Note and Sequence Data data 1,2,3,4,1,2,4,3,1,3,2,4,1,3,4,2,1,4,2,3,1,4,3,2,2,1,3,4,2,1,4,3,2,3,1,4,2,3,4,1 data 2,4,1,3,2,4,3,1,3,1,2,4,3,1,4,2,3,2,1,4,3,2,4,1,3,4,1,2,3,4,2,1,4,1,2,3,4,1,3,2 data 4,2,1,3,4,2,3,1,4,3,1,2,4,3,2,1 rem General MIDI Instrument List data "Acoustic Piano","Bright Acoustic Piano","Electric Grand Piano","Honky Tonk Piano" data "Electric Piano 1","Electric Piano 2","Harpsichord","Clavichord" data "Celesta","Glockenspiel","Music Box","Vibraphone" data "Marimba","Xylophone","Tubular Bells","Dulcimer" data "Drawbar Organ","Percussion Organ","Rock Organ","Church Organ" data "Reed Organ","Accordian","Harmonica","Tango Accordian" data "Nylon String Acoustic Guitar","Steel String Acoustic Guitar","Electric Jazz Guitar","Electric Guitar" data "Muted Electric Guitar","Overdriven Guitar","Distortion Guitar","Guitar Harmonics" data "Acoustic Bass","Electric Bass Guitar","Electric Bass Pick","Fretless Bass" data "Slap Bass 1","Slap Bass 2","Synth Bass 1","Synth Bass 2" data "Violin","Viola","Cello","Contra Bass" data "Tremelo Strings","Pizzicato Strings","Orchestral Strings","Timpani" data "String Ensemble 1","String Ensemble 2","Synth Strings 1","Synth strings 2" data "Choir Aaahs","Choir Ooohs","Synth Voice","Orchestra Hit" data "Trumpet","Trombone","Tuba","Muted Trumpet" data "French Horn","Brass Section","Synth Brass 1","Synth Brass 2" data "Soprano Sax","Alto Sax","Tenor Sax","Baritone Sax" data "Oboe","English Horn","Bassoon","Clarinet" data "Piccolo","Flute","Recorder","Pan Flute" data "Blown Bottle","Shakahuchi","Whistle","Ocarina" data "Lead 1 Square","Lead 2 Sawtooth","Lead 3 Calliope","Lead 4 Chiff" data "Lead 5 Charang","Lead 6 Voice","Lead 7 Fifths","Lead 8 Bass" data "Pad:New Age","Pad:Warm","Pad:Polysynth","Pad:Choir" data "Pad:Bowed","Pad:Metallic","Pad:Halo","Pad:Sweep" data "FX:Rain","FX:Soundtrack","FX:Crystal","FX:Atmosphere" data "FX:Brightness","FX:Goblins","FX:Echoes","FX:Sci-Fi" data "Sitar","Banjo","Shamisen","Koto" data "Kalimba","Bagpipe","Fiddle","Shanai" data "TinkerBell","Agogo","SteelDrums","Woodblock" data "TaikoDrum","MelodicDrum","SynthDrum","Reverse Cymbal" rem----------------------------------------------------------------- rem Set up use of Full Screen def proc_fullscreen(return xscreen%,return yscreen%) sys "GetSystemMetrics", 0 to xscreen% sys "GetSystemMetrics", 1 to yscreen% sys "SetWindowLong",@hwnd%,-16,&16000000 sys "SetWindowPos",@hwnd%,-1,0,0,xscreen%,yscreen%,0 vdu 23,22,xscreen%;yscreen%;8,16,16,1 : rem Set fullscreen mode mouse off : off : rem Turns off the Mouse Pointer and the Cursor endproc rem----------------------------------------------------------------- rem Draws a Treble Clef def proc_clef(Xd%,Yd%,F,G,H) local a&,Xc%,Yc% for a&=0 to 200 colour 15,int(F*a&),int(G*a&),int(H*a&) gcol 15 Xc%=Xd%+5*a& : Yc%=Yd%+100*sin(a&*2*pi/127) move Xc%,Yc% : move Xc%,Yc%+10 plot 165,Xc%,Yc%-10 move Xc%,Yc%-30 plot 165,Xc%,Yc%+10 move Xc%,Yc%-7 : move Xc%-20,Yc%+10 plot 165,Xc%,Yc%-30 move Xc%-20,Yc%+10 draw Xc%+20,Yc%+50 move Xc%,Yc%+60 : move Xc%+23,Yc%+50 plot 165,Xc%+10,Yc%+70 move Xc%,Yc%+70 : draw Xc%,Yc%-70 move Xc%+10,Yc%+70 : move Xc%+20,Yc%+70 plot 165,Xc%,Yc%+70 move Xc%-10,Yc%-70 : move Xc%-20,Yc%-80 plot 165,Xc%,Yc%-70 circle fill Xc%-10,Yc%-70,5 next a& endproc rem----------------------------------------------------------------- rem Select Instrument from List def proc_Selinst local Stp%,Row%,k%,p%,Lim%,Ind%,sel& rem Prints entire Instrument list Stp%=0 : Row%=4 : sel&=0 for k&=1 to 120 if Inst%=k& then sel&=1 case sel& of when 0: rem Unselected Instruments are printed in BLACK colour 1:print tab(Stp%,Row%);k&;" " colour 0:print tab(Stp%+4,Row%);Inst$(k&) when 1: rem Selected Instruments are printed in GREEN colour 1:print tab(Stp%,Row%);k&;" " colour 2:print tab(Stp%+4,Row%);Inst$(k&) endcase Stp%+=35 : if Stp%=140 then Stp%=0 : Row%+=1 sel&=0 next k& if (Inst%=-1) then rem Enables selection of each instrument from the list mouse rectangle 0,448,2048,959 StprO%=-1 : StpO%=-1 : RowO%=-1 Swp%=1 : off repeat mouse x%,y%,z& Stpr%=(x% div 512) : Stp%=35*Stpr% Row%=3+30-((y%-448) div 32) k%=4*(Row%-4) + Stpr% sel&=0 if (StprO%>-1 and RowO%>-1) then if (StprO%<>Stpr% or RowO%<>Row%) then Swp%=1 if Inst%=kO% then sel&=1 case sel& of when 0: rem Unselected revert to BLACK colour 1:print tab(StpO%,RowO%);(kO%+1);" " colour 0:print tab(StpO%+4,RowO%);Inst$(kO%+1) when 1: rem Selected revert to GREEN colour 1:print tab(StpO%,RowO%);(kO%+1);" " colour 2:print tab(StpO%+4,RowO%);Inst$(kO%+1) endcase endif endif sel&=0 if Swp%=1 then rem Instrument where the mouse is, is coloured BLUE colour 3:print tab(Stp%,Row%);(k%+1);" " colour 4:print tab(Stp%+4,Row%);Inst$(k%+1) Swp%=0 endif StprO%=Stpr% : StpO%=Stp% : RowO%=Row% : kO%=k% until z&=4 rem BEEP when a selection is confirmed sys "MessageBeep",0 rem Determines Instrument Ref Inst%=kO% mouse rectangle off endif a$=inkey$(50) endproc rem +++++++++++++++++++++++++++++++++++++++++++++++ rem Find the right notes def proc_FindNotes local h&,q& rem 1st note ff%=0 for h&=0 to sel& q&=h& if h&>7 and h&<15 then q&=q&-7 if h&>14 then q&=q&-14 ff%+=gap&(q&) next h& nt%(1)=48+ff% rem 2nd note q&+=1 : if q&>7 then q&=q&-8 nt%(2)=nt%(1)+gap&(q&) q&+=1 : if q&>7 then q&=q&-8 nt%(2)=nt%(2)+gap&(q&) rem 3rd note q&+=1 : if q&>7 then q&=q&-8 nt%(3)=nt%(2)+gap&(q&) q&+=1 : if q&>7 then q&=q&-8 nt%(3)=nt%(3)+gap&(q&) rem 4th note q&+=1 : if q&>7 then q&=q&-8 nt%(4)=nt%(3)+gap&(q&) q&+=1 : if q&>7 then q&=q&-8 nt%(4)=nt%(4)+gap&(q&) Inv&=rnd(2)-1 : rem Invert 7th half the time nt%(4)=nt%(4)-12*Inv& endproc rem +++++++++++++++++++++++++++++++++++++++++++++++ rem Finale sequence def proc_Finale print tab(40,10);"STOPPING SHORTLY." nt%(1)=60 nt%(2)=64 nt%(3)=67 nt%(4)=72 del%=300 : sq&=1 lun%=0 proc_NewChord lun%=1000 nt%(1)=76 nt%(2)=79 nt%(3)=83 nt%(4)=84 del%=300 : sq&=1 proc_NewChord a$=inkey$(100) endproc rem +++++++++++++++++++++++++++++++++++++++++++++++ rem Provides a backdrop def proc_backdrop local x%,y% Num&=40 for s&=1 to 100 x%=rnd(xscreen%)-1 : y%=rnd(yscreen%)-1 r&=rnd(255) g&=rnd(255) b&=rnd(255) for u&=0 to Num& rr&=int(r&*u&/Num&) gg&=int(g&*u&/Num&) bb&=int(b&*u&/Num&) colour 7,rr&,gg&,bb& : colour 7 circle fill 2*x%,2*y%,(Num&-u&) next next endproc rem +++++++++++++++++++++++++++++++++++++++++++++++