midge-0.2.41/0000755000076400007640000000000010457002671011315 5ustar davedavemidge-0.2.41/CHANGELOG0000644000076400007640000002215710457001267012536 0ustar davedave0.2.41 - Jul 17 2006 New head section keyword $bar_strict to check consistency of bars, giving an error or warning unless each track has the same number of bars and numbered bars appear at the same time in each track. (Patch contributed by Gary Wong). Fix for timing in chords. 0.2.40 - Jul 16 2006 Fix for changes in the previous version that were only applied to input files and not standard input. Updated the manual page. 0.2.39 - Jul 16 2006 The '|' symbol can now be used in source files to denote bars. Numbered bars can be noted as '|2' or '|_2'. The lengths of bars are not checked. Fix for timing error when $shorten keyword is used. Fix for midi2mg to prevent fractional note lengths. 0.2.38 - Dec 21 2003 Added a warning if the `$resolution' value is inappropriate. Fixed a bug which prevented resolution values greater than 255 from working. Added `$key_strict' keyword to make the notes automatically sharp or flat as appropriate for the key (this is still experimental). See examples/tutorial/key_strict.mg Fixed a bug in midge and midi2mg that prevented minor keys being set correctly. Major improvements to midge-mode.el contributed by Mario Lang, including: Tab completion in patch/drum/scale selection. Support for M-x comment-region. Many other internal improvements. 0.2.37 - Jul 25 2003 Fixed a bug which prevented midi2mg from writing the source file if the verbose option was used and it received SIGPIPE. midi2mg now adds a `$resolution' directive to the source file to preserve the resolution setting of the original. Fixed a bug which prevented midge recognising the `$resolution' directive. 0.2.36 - Jun 7 2003 Short command line options can be combined eg `midge -vo foo.mid bar.mg' Added syntax highlighting to the emacs mode. 0.2.35 - May 10 2003 midge now adds a `reset all controllers' event at the start of all music tracks, which fixes playback on some external keyboards. Added `-R' switch to prevent reset events being added. Improved error checking for note syntax Fixed a bug which showed up if no weightings were given for a scale in choose blocks (correct behaviour is to use equal weightings). midi2mg: Improved handling of note lengths. 0.2.34 - Jan 4 2003 Extended the $patch and $bank commands to allow the LSB value of the bank to be specified, which is needed for external keyboards. Fixed a bug in the %define code which was triggered by a 0 in the block Added better error checking for note syntax. Fixed a bug in the timing of marker events. midi2mg: Improved parsing of tempo tracks. 0.2.33 - Oct 20 2002 Cleaned up and reorganised the source code. Added a simpler syntax for pitch bends (see examples/tutorial/bend_simple.mg). Added support for text events to midge and midi2mg. Reduced timing drift during long tuplets. midi2mg: added the `-w' switch which makes it ignore events on the wrong track instead of exiting. midi2mg: a list of tracks to include or exclude can be specified on the command line (-n and -N switches). midi2mg: added progress bars in verbose mode. Added more functions to the emacs mode. 0.2.32 - Jul 21 2002 Fixed the line numbers in error messages (except where `%include' is used). Added `-I' switch for include path. Added some include files defining drum patterns and chords. The `l' note length option can be specified in uppercase to distinguish it from number 1. Fixed a bug which stopped some notes being transposed correctly if note options were used. Improved the formatting of source output from midge and midi2mg. Added support for midi2mg to midge-mode.el Fixed a bug in midge-mode.el which broke the midge-*-block functions. 0.2.31 - Jul 12 2002 Fixed -u option which broke in last release. Added -U option to prevent unrolled source being saved to file. Added $print keyword to help debugging midge source files. Added $rpn and $nrpn keywords to adjust rpn and nrpn controllers. midi2mg will now output to stdout if output filename is `-' if you really want verbose output too, put the -v first. Added -F option to midi2mg, to prevent factorisation of time values. 0.2.30 - Apr 10 2002 Performance improved by only unrollong the tracks which need it instead of the whole file. Fixed a bug which caused quoted strings to be written incorrectly in the unrolled source file. midi2mg now automatically finds the midi file resolution and determines whether running status is used. midi2mg now supports raw meta events and sysex events. 0.2.29 - Apr 6 2002 Added a method of inserting separate note on and note off events. (see example on_off.mg) Added %verbatim/%bytes keywords for inserting raw bytes (see verbatim.mg). Added $ctrl keyword to change any controller. Added $pitch keyword for single pitch wheel events. Added a decompiler script, midi2mg (requires MIDI modules from CPAN). 0.2.28 - Feb 19 2002 Minor fixes to midge-mode.el Removed restriction on use of drum names in instrument channels. 0.2.27 - Dec 16 2001 Added support for bank select (see example bank.mg). Added $strum keyword to allow chords to sound strummed (see strum.mg). Fixed a bug in midge-mode.el in the patch choosing code. 0.2.26 - Oct 28 2001 Scales can now be used in %chain blocks (see example chain_scale.mg). Fixed a timing bug with the $shorten keyword. Fixed a bug which caused some markers to be out of time. 0.2.25 - Jun 23 2001 Fixed a bug which made some chord notes sound for too long. 0.2.24 - May 6 2001 Fixed a bug in the scale code. Fixed a bug in the %tuplet code which accumulated rounding errors. Added `%eval' keyword to run perl code. Added $resolution keyword to set midi clicks per quarter note. 0.2.23 - Apr 30 2001 Notes can be added to a %choose block using built in scales. Added --show-scale (or -S) switch to show the notes of a scale, or a list of supported scales. A sequence of note lengths can be specified in a %choose block to allow random pitches to be used in a fixed rhythm. Added `$unquantise' option to apply a random offset to each note. Added --seed (or -s) switch to specify the random seed. 0.2.22 - Feb 25 2001 Added `z' and `Z' note options to allow notes to be offset from the beat by either a specified or randomly chosen ammount. Added `$shorten' keyword to support the offset options. 0.2.21 - Jan 2 2001 Fixed another bug in the repeat code. Fixed a bug in the way input is split into tokens. 0.2.20 - Dec 29 2000 Time signature can now be */{4,8,16,32,64} Time signature can now be changed within a track. Tempo can now be changed within a track. All text events are now written to the tempo track. Fixed a bug in the repeat code which was triggered by repeat blocks containing only rests. unroll-loops is now set if marker events are used, or if tempo, time_sig, or key events are used outside the head section. midge-mode.el now supports %tuplet blocks. Various minor fixes to midge-mode.el 0.2.19 - Dec 1 2000 Added support for tuplets, which may be nested (see man page). Cleaned up the code some more so that it runs under Perl's `strict' pragma. Added menus to midge-mode.el although they will probably only work with FSF emacs (see README.elisp). 0.2.18 - Nov 25 2000 Fixed the pitch bend code so that if the maximum value is required the least significant bit is also used. Cleaned up the code a little and added more comments. midge-mode.el now uses compile-internal instead of shell-command. 0.2.17 - Oct 9 2000 Minor fixes to configure.pl Fixed a couple of bugs in midge-mode.el patch changing code. 0.2.16 - Jul 17 2000 Added pan_all. Added ranges to attack, decay, volume, reverb, chorus, pan. 0.2.15 - Jul 10 2000 Fixed panning. 0.2.14 - Jul 9 2000 (elisp) Added cancel to patch/drum choose menu. Fixed chain bug (riff length was wrong if `start' keyword was used). Moved unroll-loops message to verbose mode. 0.2.13 - Jun 3 2000 Fixed key errors. Added chain blocks. 0.2.12 - Mar 20 2000 Added bend range. Corrected bend error in man page. Added key support. 0.2.11 - Feb 27 2000 (elisp) Added patch name code. (elisp) Added drum name code. Added sanity check on note names. 0.2.10 - Jan 9 2000 Added marker events (demonstrated in bobby_brown.mg). Added a few more examples. Fixed a couple of small bugs in midge-mode.el Cleaned up the code a little. 0.2.9 - Sep 5 1999 Fixed a bug which affected patch changes. Fixed a bug in midge-mode.el Cleaned up some code and error messages. 0.2.8 - Jul 12 1999 Fixed a bug in the looping code. Added a new example and changed some others. 0.2.7 - Jul 11 1999 Rewrote the %define handling code so that %define blocks can contain %repeat and %bend blocks, and other defined riffs. Fixed a bug in patch number handling which made them one patch out. Patch numbers from old source files will need to be increased by 1. Fixed a bug in midge-mode.el which was triggered when a channel block was inserted without specifying an instrument name. 0.2.6 - Jul 4 1999 Extended the `choose' code to generate a sequence of notes of specified length from a weighted list. Added midge-mode.el emacs mode. 0.2.5 - Jun 25 1999 Added the `choose' keyword to choose randomly from a weighted list of notes. [ No record was kept for older versions ] midge-0.2.41/COPYING0000644000076400007640000004311007525276757012373 0ustar davedave GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. midge-0.2.41/INSTALL0000644000076400007640000000033007116061664012347 0ustar davedaveInstallation should go like this: $ perl configure.pl You will be asked for installation directories and the path to your perl executable if it is not found. $ make This will install the executable and man page. midge-0.2.41/README0000644000076400007640000000560410457003207012176 0ustar davedave******* Midge version 0.2.41 ******* ==================================== Midge, for midi generator, is a text to midi translator. It creates type 1 (ie multitrack) midi files from text descriptions of music. The source language used is documented in the man page, and demonstrated in the source files in the examples directory. Midge has been tested with Perl 5.8.0 on GNU/Linux, and with ActiveState Perl 5.8.0 on Windows XP, and should work on any system with a basic installation of Perl 5.005 or higher. The last version tested with Perl 5.005 was version 0.2.27. The included midi2mg script additionally requires the MIDI modules by Sean M. Burke, which are available from CPAN. (type `perldoc CPAN' at your prompt to find out how to install them). Midge is free software and you are welcome to redistribute it under the terms of the GNU General Public Licence. Midge comes with ABSOLUTELY NO WARRANTY. => Current features <= Sections of music can be predefined and reused multiple times, transposing if required. Allows nested loops. Supports setting of reverb and chorus. Supports setting of note on/note off velocity. Supports setting of individual track volume Supports setting of track/instrument names. Supports setting of key signature. Supports tuplets, which may be nested. Supports pitch bending and setting of pitch wheel range. Tempo and time signature can be changed within a track. Can choose a note or riff randomly from a list of notes and/or predefined riffs. Can choose multiple notes randomly from a list of (different length) notes to produce a riff of specified length. Can generate a sequence of notes from a user defined `chain' structure where for each note there is a weighted list of notes which may follow it. Can offset notes from the beat by either a specified or randomly chosen amount. Separate note on and note off events can be used to play simultaneous notes. Ranges (eg `8-64') can be used when setting the volume, pan, reverb, chorus, attack and decay, which causes a random value within the range to be used. Supports text marker events Supports panning events Supports bank changes. Supports rpn and nrpn controllers. An emacs mode with syntax highlighting for editing and compiling midge files and playing the resulting midi files (if you have a command line midi player). See README.elisp => Changes in this release <= New head section keyword $bar_strict to check consistency of bars, giving an error or warning unless each track has the same number of bars and numbered bars appear at the same time in each track. (Patch contributed by Gary Wong). Fix for timing in chords. Installation instructions are in the file INSTALL. Windows instructions are in README.win32 Midge's homepage is at: => http://www.undef.org.uk/code/midge/ <= Please send comments, suggestions or bug reports to: => dave@undef.org.uk <= midge-0.2.41/README.drums0000644000076400007640000000403607116061664013336 0ustar davedave note: midge alias: full name: b2 bd_ac Acoustic Bass Drum c3 bd Bass Drum 1 c+3 stick Side Stick d3 sd_ac Acoustic Snare d+3 clap Hand Clap e3 sd_el Electric Snare f3 ftom_l Low Floor Tom f+3 hh_c Closed Hi-Hat g3 ftom_h High Floor Tom g+3 hh_p Pedal Hi-Hat a3 tom_l Low Tom a+3 hh_o Open Hi-Hat b3 tom_lm Low-Mid Tom c4 tom_hm Hi-Mid Tom c+4 cym_crash Crash Cymbal 1 d4 tom_h High Tom d+4 cym_ride Ride Cymbal 1 e4 cym_chinese Chinese Cymbal f4 ride_bell Ride Bell f+4 tamb Tambourine g4 cym_splash Splash Cymbal g+4 cowbell Cowbell a4 cym_crash_2 Crash Cymbal 2 a+4 vibraslap Vibraslap b4 cym_ride_2 Ride Cymbal 2 c5 bongo_h Hi Bongo c+5 bongo_l Low Bongo d5 conga_h_mute Mute Hi Conga d+5 conga_h_open Open Hi Conga e5 conga_l Low Conga f5 timbale_h High Timbale f+5 timbale_l Low Timbale g5 agogo_h High Agogo g+5 agogo_l Low Agogo a5 cabasa Cabasa a+5 maracas Maracas b5 whistle_sh Short Whistle c6 whistle_lg Long Whistle c+6 guiro_sh Short Guiro d6 guiro_lg Long Guiro d+6 claves Claves e6 wood_h Hi Wood Block f6 wood_l Low Wood Block f+6 cuica_mute Mute Cuica g6 cuica_open Open Cuica g+6 tri_mute Mute Triangle a6 tri_open Open Triangle midge-0.2.41/README.elisp0000644000076400007640000000774007525242724013327 0ustar davedaveThis is my first attempt at elisp so it is probably not very well written (clues will be gratefully received :) but it seems to do a reasonable job. If you put the file in your site-lisp directory (probably in /usr/share/emacs or /usr/local/share/emacs) you can use it be adding this line to your ~/.emacs: (autoload 'midge-mode "midge-mode") Otherwise you need the full path: (autoload 'midge-mode "/some/directory/midge-mode.el") To associate *.mg and *.mgh with midge-mode add this line: (setq auto-mode-alist (cons '("\\.mgh?$" . midge-mode) auto-mode-alist)) The menus have only been tested in FSF emacs and may not work with other versions. If they cause problems, they can be disabled with: (setq midge-use-menus nil) in your ~/.emacs, or the variable can be changed in the elisp source. => Variables <= midge-compiler path to the midge executable default: "midge" midge-decompiler path to the midi2mg executable default: "midi2mg" midge-midi-player path to a command line midi player default: undefined These variables can be set in your ~/.emacs with eg: (setq midge-midi-player "playmidi") => Commands <= Here is a list of keybindings with brief descriptions of the commands: key binding --- ------- TAB midge-indent-line indents current line to the correct level. } midge-close-bracket inserts closing bracket `}' indenting if neccesary. C-c C-c Prefix Command for multi line inserts C-c C-c c midge-choose-block C-c C-c a midge-chain-block C-c C-c t midge-tuplet-block C-c C-c d midge-define-block C-c C-c b midge-bend-block C-c C-c r midge-repeat-block C-c C-c n midge-channel-block C-c C-c g midge-body-block C-c C-c h midge-head-block these functions insert a blank block of the apropriate type, prompting for any variables (eg channel number). The new block is indented to the correct level and point is placed between the `{}' brackets. C-c C-d Prefix Command for single line block inserts C-c C-d c midge-choose-line C-c C-d t midge-tuplet-line C-c C-d d midge-define-line C-c C-d b midge-bend-line C-c C-d r midge-repeat-line These functions do the same as the `block' versions but they put all the inserted text on a single line. C-c C-f Prefix Command for inserting values C-c C-f p midge-select-patch C-c C-f d midge-select-drum C-c C-f s midge-select-scale These functions allow patch, drum and scale names to be chosen from a menu by typing the number of the required selection in the minibuffer. C-c C-f t midge-insert-tempo C-c C-f g midge-insert-time-sig C-c C-f v midge-insert-volume C-c C-f y midge-insert-pan C-c C-f r midge-insert-reverb C-c C-f c midge-insert-chorus These functions insert prompt for a value and insert the relevent keyword and value if it is valid. C-c C-v Prefix Command for compile/play/decompile commands. C-c C-v C-f midge-compile-ask prompt for options C-c C-v C-d midge-compile-debug C-c C-v C-v midge-compile-verbose use debug/verbose options C-c C-v C-c midge-compile use no options note: `midge-compiler' must be set correctly to use any of the compile commands. C-c C-v C-m midge-decompile prompt for a midi file to decompile into a new buffer. note: `midge-decompiler' must be set correctly to use this command. C-c C-v C-p midge-play-background C-c C-v C-l midge-play-foreground play midi file generated from current source file. C-c C-v C-o midge-play-ask-background C-c C-v C-k midge-play-ask-foreground prompt for midi file to play. playing in the foreground causes emacs to wait untill the player process exits (C-g will kill it), whereas playing in the background lets you continue editing but you can't kill the player process as easily (it can be done with "C-c C-c" in the pocess buffer). note: you must have `midge-midi-player' set to a command line midi player to use any of the play commands. midge-0.2.41/README.examples0000644000076400007640000000044107134402517014012 0ustar davedaveAs of version 0.2.16, the examples are split up into the following subdirectories. tutorial/ - examples of how to use various commands covers/ - cover versions orig/ - original music, some of which are used as backing tracks for songs on my mp3 page at www.mp3.com/david_riley midge-0.2.41/README.patches0000644000076400007640000001026407116061664013633 0ustar davedave Patch midge alias: full name: No: 1 piano_grand_ac Acoustic Grand Piano 2 piano_br Bright Acoustic Piano 3 piano_grand_el Electric Grand Piano 4 piano_ht Honky-Tonk Piano 5 piano_el_1 Electric Piano 1 6 piano_el_2 Electric Piano 2 7 harpsichord Harpsichord 8 clavinet Clavinet 9 celesta Celesta 10 glockenspiel Glockenspiel 11 music_box Music Box 12 vibraphone Vibraphone 13 marimba Marimba 14 xylophone Xylophone 15 tubular_bells Tubular Bells 16 dulcimer Dulcimer 17 organ_dbar Drawbar Organ 18 organ_perc Percussive Organ 19 organ_rock Rock Organ 20 organ_church Church Organ 21 organ_reed Reed Organ 22 accordian Accoridan 23 harmonica Harmonica 24 accordian_tango Tango Accordian 25 guitar_nylon Nylon String Guitar 26 guitar_steel Steel String Guitar 27 guitar_jazz Electric Jazz Guitar 28 guitar_clean Electric Clean Guitar 29 guitar_muted Electric Muted Guitar 30 guitar_od Overdriven Guitar 31 guitar_dist Distortion Guitar 32 guitar_harm Guitar Harmonics 33 bass_ac Acoustic Bass 34 bass_fg Electric Bass(finger) 35 bass_pick Electric Bass(pick) 36 bass_fless Fretless Bass 37 bass_slap_1 Slap Bass 1 38 bass_slap_2 Slap Bass 2 39 bass_syn_1 Synth Bass 1 40 bass_syn_2 Synth Bass 2 41 violin Violin 42 viola Viola 43 cello Cello 44 contrabass Contrabass 45 str_trem Tremolo Strings 46 str_pizz Pizzicato Strings 47 str_orch Orchestral Strings 48 timpani Timpani 49 str_ens_1 String Ensemble 1 50 str_ens_2 String Ensemble 2 51 str_syn_1 SynthStrings 1 52 str_syn_2 SynthStrings 2 53 choir_aahs Choir Aahs 54 voice_oohs Voice Oohs 55 voice_syn Synth Voice 56 orch_hit Orchestra Hit 57 trumpet Trumpet 58 trombone Trombone 59 tuba Tuba 60 trumpet_muted Muted Trumpet 61 horn_fr French Horn 62 brass Brass Section 63 brass_syn_1 SynthBrass 1 64 brass_syn_2 SynthBrass 2 65 sax_sop Soprano Sax 66 sax_alt Alto Sax 67 sax_ten Tenor Sax 68 sax_bar Baritone Sax 69 oboe Oboe 70 horn_en English Horn 71 bassoon Bassoon 72 clarinet Clarinet 73 piccolo Piccolo 74 flute Flute 75 recorder Recorder 76 flute_pan Pan Flute 77 bottle Blown Bottle 78 skakuhachi Skakuhachi 79 whistle Whistle 80 ocarina Ocarina 81 lead_sq Lead 1 (square) 82 lead_saw Lead 2 (sawtooth) 83 lead_calliope Lead 3 (calliope) 84 lead_chiff Lead 4 (chiff) 85 lead_charang Lead 5 (charang) 86 lead_voice Lead 6 (voice) 87 lead_fifth Lead 7 (fifths) 88 lead_basslead Lead 8 (bass+lead) 89 pad_new_age Pad 1 (new age) 90 pad_warm Pad 2 (warm) 91 polysynth Pad 3 (polysynth) 92 pad_choir Pad 4 (choir) 93 pad_bowed Pad 5 (bowed) 94 pad_metal Pad 6 (metallic) 95 pad_halo Pad 7 (halo) 96 pad_sweep Pad 8 (sweep) 97 fx_rain FX 1 (rain) 98 fx_strack FX 2 (soundtrack) 99 fx_crystal FX 3 (crystal) 100 fx_atmos FX 4 (atmosphere) 101 fx_bright FX 5 (brightness) 102 fx_goblin FX 6 (goblins) 103 fx_echo FX 7 (echoes) 104 fx_scifi FX 8 (sci-fi) 105 sitar Sitar 106 banjo Banjo 107 shamisen Shamisen 108 koto Koto 109 kalimba Kalimba 110 bagpipe Bagpipe 111 fiddle Fiddle 112 shanai Shanai 113 bell_tinkle Tinkle Bell 114 agogo Agogo 115 drum_steel Steel Drums 116 woodblock Woodblock 117 drum_taiko Taiko Drum 118 tom_melodic Melodic Tom 119 drum_syn Synth Drum 120 cymbal_rev Reverse Cymbal 121 fx_fret Guitar Fret Noise 122 fx_breath Breath Noise 123 fx_sea Seashore 124 fx_tweet Bird Tweet 125 fx_phone Telephone Ring 126 fx_copter Helicopter 12f x_applause Applause 128 fx_gun Gunshot midge-0.2.41/README.win320000644000076400007640000000060207574201007013134 0ustar davedaveIf you don't have Perl installed, you can download it from: http://www.activestate.com/ To install the MIDI modules, open a command prompt and run `ppm.exe', which comes with ActiveState Perl. At the ppm prompt type `search *' to refresh the list of modules, and then `install MIDI-Perl' to install the modules. Then copy the midge.pl and midi2mg.pl scripts to a folder on your PATH. midge-0.2.41/TODO0000644000076400007640000000041710457001511011777 0ustar davedaveallow whole file to be transposed add checking of bar lengths add support for bars to midi2mg provide more accurate line numbers in error messages make better examples/docs/include files improve the install process generate harmonies add better random generation methods midge-0.2.41/configure.pl0000644000076400007640000000470607516615712013652 0ustar davedave#!/usr/bin/perl if ($ARGV[0] eq "--help") { print "There are no command line options.\n"; print "The script will prompt you instead\n\n"; exit; } # find perl print "finding your perl..."; $perl = `which perl`; if (!$perl) { print " can\'t find it\n"; print "Please enter the path to your perl: "; $perl = ; chomp($perl); if (! -x $perl) { die "$perl is not executable\n"; } } else { print $perl; chomp($perl); } print "enter directory to install excutable [/usr/local/bin]: "; $bindir = ; chomp($bindir); if (!$bindir) { $bindir = "/usr/local/bin"; } if (! -d $bindir) { die "$bindir is not a directory\n"; } print "enter directory to install man page [/usr/local/man/man1]: "; $mandir = ; chomp($mandir); if (!$mandir) { $mandir = "/usr/local/man/man1"; } if (! -d $mandir) { die "$mandir is not a directory\n"; } print "enter directory to install midge include files" . " [/usr/local/share/midge]: "; $incdir = ; chomp($incdir); if (!$incdir) { $incdir = "/usr/local/share/midge"; } if (! -d $incdir) { print "\n*** $incdir not found, " . "please create it before running make install\n\n"; } print "Creating midge... "; open(MDG, ">midge") || die "could not open midge for writing: $!\n"; select(MDG); print "#!$perl\n\n"; open(SRC, "midge.pl") || die "could not open midge.pl ($!), archive may be corrupted\n"; while() {print;} close(SRC); close(MDG); select(STDOUT); print "done\n"; print "Creating midi2mg... "; open(M2M, ">midi2mg") || die "could not open midi2mg for writing: $!\n"; select(M2M); print "#!$perl\n\n"; open(SRC, "midi2mg.pl") || die "could not open midi2mg.pl ($!), archive may be corrupted\n"; while() {print;} close(SRC); close(M2M); select(STDOUT); print "done\n"; print "Creating Makefile... "; open(MF, ">Makefile") || die "could not open Makefile for writing: $!\n"; select(MF); print "BINDIR=$bindir\n"; print "MANDIR=$mandir\n"; print "INCDIR=$incdir\n\n"; print "install:\n"; print "\tcp midge \$(BINDIR)\n"; print "\tchmod 755 \$(BINDIR)/midge\n"; print "\tcp midge.1 \$(MANDIR)\n"; print "\tchmod 644 \$(MANDIR)/midge.1\n"; print "\tcp midi2mg \$(BINDIR)\n"; print "\tchmod 755 \$(BINDIR)/midi2mg\n"; print "\tcp midi2mg.1 \$(MANDIR)\n"; print "\tchmod 644 \$(MANDIR)/midi2mg.1\n"; print "\tcp include/* \$(INCDIR)\n"; print "\tchmod 644 \$(INCDIR)/*.mgh\n"; select(STDOUT); close(MF); print "done\n"; print "Type \`make\' to install\n"; midge-0.2.41/examples/0000755000076400007640000000000007246305637013145 5ustar davedavemidge-0.2.41/examples/tutorial/0000755000076400007640000000000010457000732014772 5ustar davedavemidge-0.2.41/examples/tutorial/scales.mg0000644000076400007640000000050007657331310016573 0ustar davedave# This file shows how to define, use and transpose a riff. @head { $time_sig 4/4 $tempo 80 } @body { # C major scale %define scale { /l8/c3 d e f g a b /r2/c4 b3 a g f e d c } @channel 1 { $patch 1 # piano # play scales ascending in whole steps (ie c, d, e, f#) ~scale ~scale/2/ ~scale/4/ ~scale/6/ } } midge-0.2.41/examples/tutorial/chords.mg0000644000076400007640000000107607661463361016623 0ustar davedave# This file demonstrates the use of `()' to make chords. @head { $tempo 120 $time_sig 4/4 } @body { %define minor { ( c e- g ) } # define minor to be a C minor %define major { ( c e g ) } # define major to be a C major %define 7 { ( c e g b- ) } # define 7 to be a C 7th @channel 1 { $patch 1 $length 2 $octave 4 %repeat 4 { ~major } # c major $patch 18 %repeat 4 { ~minor/9/ } # a minor (C minor transposed up 9 steps) $patch 91 %repeat 4 { ~major } # c major $patch 27 %repeat 4 { ~7/7/ } # g 7th (C 7th transposed up 7 steps) } } midge-0.2.41/examples/tutorial/12-bar.mg0000644000076400007640000000413607224224305016311 0ustar davedave# This file generates a simple 12 bar in A. It shows # the use of %define and %repeat, and the use of `()' # to play simultaneous notes. @head { $tempo 140 $time_sig 4/4 $title "twelve bar in A" } @body { # define some chords using `()' %define A { ( a3 c+4 e4 a4 ) } # A major %define A6 { ( a3 c+4 e4 f+4 a4 ) } # A 6th %define D { ~A/5/ } # define D chords as A chords %define D6 { ~A6/5/ } # transposed up 5 semitones %define E { ~A/7/ } # define E chords as A chords %define E6 { ~A6/7/ } # transposed up 7 semitones %define E7 { ( e3 g+3 b3 d4 e4 ) } # E 7th # define the bass line 1 bar long %define bass { /l8r2/a2 /r2/c+3 /r2/e /r2/f+ } @channel 1 "rhythm guitar" { # set volume and patch $volume 96 $patch 26 $length 16 # as no length is specified in the # chord definitions, this default # length will apply to all the chords %repeat 10 { # repeat the whole 12 bar 10 times %repeat 8 { ~A r ~A r ~A6 r ~A6 r } # 4 bars of A %repeat 4 { ~D r ~D r ~D6 r ~D6 r } # 2 bars of D %repeat 4 { ~A r ~A r ~A6 r ~A6 r } # 2 bars of A %repeat 2 { ~E r ~E r ~E6 r ~E6 r } # 1 bar of E %repeat 2 { ~D r ~D r ~D6 r ~D6 r } # 1 bar of D %repeat 2 { ~A r ~A r ~A6 r ~A6 r } # 1 bars of A ~A r %repeat 7 { ~E7 r } # 1 bar of E7 } } @channel 2 bass { # set volume and patch $volume 127 $patch 34 %repeat 10 { # repeat whole 12 bar 10 times %repeat 4 { ~bass } # 4 bars of A %repeat 2 { ~bass/5/ } # 2 bars transposed up to D %repeat 2 { ~bass } # 2 bars of A ~bass/7/ # 1 bar transposed up to E ~bass/5/ # 1 bar transposed up to D %repeat 2 { ~bass } # 2 bars of A } } @channel 10 drums { %repeat 240 { /l8/c3 c d c } # repeat simple drum pattern # all the way through } @channel 10 cymbals { %repeat 240 { /l8/f+3 f+ g+ f+ } # repeat simple cymbal pattern # all the way through } } midge-0.2.41/examples/tutorial/bend.mg0000644000076400007640000000105607670445133016244 0ustar davedave# This file demonstrates the use of %bend and $bend_range. @head { $tempo 120 $time_sig 4/4 } @body { @channel 1 guitar { $patch guitar_steel %repeat 4 { /l8/d4 $bend_range 1 # set bend range to +/- 1 semitones (default is 2) %bend e { 0+64 # bend up 1 semitone to f 8-64 # back down after 1/8 note to e 8+0 # hold for 1/8 } d $bend_range 4 # set bend range to +/- 4 semitone %bend a4 { 0+48 # bend up 3 semitones to c 8-16 # down 1 semitone to b 8+0 # hold for 1/8 } /l8/a+3 a } } } midge-0.2.41/examples/tutorial/drum_pan.mg0000644000076400007640000000200007661754046017135 0ustar davedave# This file demonstrates the use of %pan_all to set the pan values # of a drum kit. @head { $tempo 100 $time_sig 4/4 } @body { @channel 10 "drums" { # set up pan values, 0 is hard left, 127 is hard right # drums not specified get the default which is either # the center (64) or the last value set with the $pan # keyword in the current track %pan_all { hh_c 56 hh_o 56 hh_p 56 cym_crash 80 cym_ride 48 tom_l 40 tom_h 80 tom_hm 48 tom_lm 72 ftom_l 80 ftom_h 56 } $reverb 32 # play randomly for 16 bars %choose 16:1 { 1 /l8/tom_hm 1 /l8/tom_lm 1 /l8/tom_l 1 /l8/tom_h 1 /l8/ftom_h 1 /l8/ftom_l 1 /l8/cym_crash 1 /l8/cym_ride 1 /l8/hh_o 1 /l8/hh_c 1 /l8/hh_p 1 /l8/bd 1 /l8/sd_ac 1 /l8/r 1 /l16/tom_hm 1 /l16/tom_lm 1 /l16/tom_l 1 /l16/tom_h 1 /l16/ftom_h 1 /l16/ftom_l 1 /l16/cym_crash 1 /l16/cym_ride 1 /l16/hh_o 1 /l16/hh_c 1 /l16/hh_p 1 /l16/bd 1 /l16/sd_ac 1 /l16/r } } } midge-0.2.41/examples/tutorial/note_choose.mg0000644000076400007640000000203607116061664017636 0ustar davedave# The first track is completely random. There are two # choose blocks, one choosing from an `a' scale and the # other from a `d' scale, each within a loop which # produces 4 bars of output. Each note has the same # length to fix the length of the loop. See time_choose.mg # to see how to get a fixed length output from different # length notes. @head { $tempo 120 $time_sig 4/4 } @body { # random notes on piano # 4 bars of a, 4 bars of d, repeated 4 times @channel 1 piano { $length 16 $patch 1 $volume 104 %repeat 4 { %repeat 64 { # 4 bars # pick a note from the a scale %choose { 4 a3 2 c4 3 d4 3 e4 3 g4 2 a4 2 e5 2 d5 1 g5 } } %repeat 64 { # 4 bars # pick a note from the d scale %choose { 4 d3 2 f4 3 g4 3 a4 3 c4 2 d4 2 a5 2 g5 1 c5 } } } } # backing chords on organ %define Am { ( a2 c3 e3 a3 c4 e4 ) } %define Dm { ( d2 f3 a3 d3 f4 a4 ) } @channel 2 organ { $length 1 $octave 3 $patch 18 %repeat 4 { %repeat 4 { ~Am } %repeat 4 { ~Dm } } } } midge-0.2.41/examples/tutorial/riff_choose.mg0000644000076400007640000000214407655505773017633 0ustar davedave# The lead guitar part uses a `call & response' style. # There are two `call' riffs, used alternately, and # four `response' riffs, chosen at random each time. @head { $tempo 120 $time_sig 4/4 } @body { # lead guitar %define call_1 { /l8/d4 e r e g e /r2/r } %define call_2 { /l8/d4 e r e d b3 /r2/r } %define response_1 { /l8r2/r g4 a b- a g e } %define response_2 { /l8r2/r g4 e d b3 g4 e } %define response_3 { /l8r2/r d4 e g a g e } %define response_4 { /l8r2/r b4 a g a g e } @channel 1 "lead guitar" { $patch 27 $volume 96 %repeat 12 { ~call_1 %choose { 3 ~response_1 3 ~response_2 2 ~response_3 2 ~response_4 } ~call_2 %choose { 3 ~response_1 3 ~response_2 2 ~response_3 2 ~response_4 } } } # bass %define bass_1 { /l8r4/e2 g /r3/e r /r7/g } @channel 2 bass { $patch 35 $volume 127 %repeat 12 { %repeat 2 { ~bass_1 } } } # drums %define drums_1 { /l3:8/c3 /l8/c /l3:8/d /l8/c /l4/c c /l2/d } @channel 10 drums { $volume 127 $reverb 32 %repeat 12 { %repeat 2 { ~drums_1 } } } } midge-0.2.41/examples/tutorial/time_choose.mg0000644000076400007640000000166507116061664017636 0ustar davedave# This is the same as note_choose.mg except different length # notes are used in the choose blocks, with the time option # used to fix the overall length of the blocks. @head { $tempo 120 $time_sig 4/4 } @body { # random notes on piano # 4 bars of a, 4 bars of d, repeated 4 times @channel 1 piano { $length 16 $patch 2 $volume 104 %repeat 4 { # pick 4 bars' worth of notes from the a scale %choose 4:1 { 4 /l8/a3 2 /l16/c4 3 /l16/d4 3 /l8/e4 3 /l16/g4 2 /l16/a4 2 /l16/e5 2 /l16/d5 1 /l8/g5 1 /l16/r } # pick 4 bars' worth of notes from the d scale %choose 4:1 { 4 /l8/d3 2 /l16/f4 3 /l16/g4 3 /l8/a4 3 /l16/c4 2 /l16/d4 2 /l16/a5 2 /l16/g5 1 /l8/c5 1 /l16/r } } } # backing chords on organ %define Am { ( a2 c3 e3 a3 c4 e4 ) } %define Dm { ( d2 f3 a3 d3 f4 a4 ) } @channel 2 organ { $length 1 $octave 3 $patch 18 %repeat 4 { %repeat 4 { ~Am } %repeat 4 { ~Dm } } } } midge-0.2.41/examples/tutorial/chain.mg0000644000076400007640000000136107661454274016423 0ustar davedave# This file demonstrates the use of the %chain block. @head { $tempo 120 $time_sig 4/4 } @body { @channel 1 "guitar" { $patch guitar_steel # C major scale %chain 4:1 { start c5 # Start on c5 c5 [ 1 e5 4 d5 ] # c5 can be followed by e5 or d5 # The numbers in front of the notes # are weighting factors, ie d5 will # be chosen more often than e5 # set up rest of scale d5 [ 3 e5 1 g5 ] e5 [ 1 f5 ] f5 [ 1 g5 ] g5 [ 1 a5 ] a5 [ 2 b5 1 c5 ] b5 [ 1 a5 2 c6 1 c5 ] c6 [ 1 b5 3 c5 1 g5 ] # Note lengths rhythm [ 1 16 # 16th notes 1/5 probability 4 8 # 6th notes 4/5 probability ] } } } midge-0.2.41/examples/tutorial/random_pan.mg0000644000076400007640000000075007661464143017454 0ustar davedave# This file shows the use of ranges to vary the pan value and # attack (note on velocity). Ranges can be used for volume, pan # reverb, chorus, attack and decay. @head { $tempo 120 $time_sig 4/4 } @body { @channel 1 "synth" { $patch polysynth $length 8 %repeat 8 { %repeat 8 { # 1 bar $pan 8-120 # pan randomly between 8 and 120 $attack 80-127 # vary attack between 80 and 127 %choose { 1 e4 1 g4 1 a4 1 b4 1 d5 1 e6 } } } } } midge-0.2.41/examples/tutorial/pan.mg0000644000076400007640000000025607134374205016107 0ustar davedave# This file shows the use of $pan @head { $time_sig 4/4 $tempo 120 } @body { @channel 1 { $patch guitar_jazz $pan 127 # pan hard right /l4r16/e3 } } midge-0.2.41/examples/tutorial/tuplet.mg0000644000076400007640000000224107715555537016660 0ustar davedave# This example shows how to use the %tuplet keyword # first with a simple 3:2 tuplet, then with a nested # tuplet (3:2 inside of 5:3) @head { $tempo 80 $time_sig 4/4 $resolution 120 # 3 and 5 are factors, so the tuplets divide evenly. } @body { # count out the time in 4/4 # 1 bar repeated 7 times @channel 10 "click" { %repeat 7 { /l4r4/stick } } @channel 1 "piano" { /l4r4/e3 # straight bar # simple tuplet (1 bar played twice) %repeat 2 { e # 1 quarter note %tuplet 3:2 { f+ g f+ } # 3 quarter notes in the space of 2 d # quarter note on 4th beat of the bar } /l4r4/e # straight bar # nested tuplets (1 bar played twice) %repeat 2 { e # 1 quarter note %tuplet 5:3 { # 5:3 tuplet (to end of bar (1+3=4) f+ g a # 3 quarter notes (of 5) in 5:3 %tuplet 3:2 { # nested 3:2 tuplet (to end of 5:3 # tuplet (3+2=5)) g f+ d # 3 quarter notes (of 3) in 3:2 } # end of 3:2 tuplet } # end of 5:3 tuplet } /l4r4/e # straight bar } } midge-0.2.41/examples/tutorial/time_sig.mg0000644000076400007640000000076707212402263017131 0ustar davedave@head { $tempo 80 # set initial tempo to 80 bpm } @body { @channel 1 "bass" { $patch bass_fg $length 4 # play quarter notes /r8/e2 # 2 bars of 4/4 /r6/e2 # 2 bars of 3/4 } @channel 2 "piano" { $patch piano_grand_ac $length 4 $time_sig 4/4 # set time sig to 4/4 (affects all tracks) /r8/e6 # 2 bars $time_sig 3/4 # set time signature to 3/4 (affects all tracks) /r6/e6 # 2 bars of 3/4 } } midge-0.2.41/examples/tutorial/tempo.mg0000644000076400007640000000067507212402203016445 0ustar davedave@head { $tempo 80 # set initial tempo to 80 bpm $time_sig 4/4 # set initial time signature to 4/4 } @body { @channel 1 "bass" { $patch bass_fg $length 4 # play quarter notes /r16/e2 # 4 bars } @channel 2 "piano" { $patch piano_grand_ac $length 4 /r8/e6 # 2 bars $tempo 120 # tempo change to 120 bpm (affects all tracks) /r8/e6 # 2 more bars } } midge-0.2.41/examples/tutorial/offset.mg0000644000076400007640000000111707246057714016623 0ustar davedave# This file demonstrates how to offset notes slightly # using the `z' note option. See also offset_random.mg @head { $time_sig 4/4 $tempo 80 } @body { @channel 10 "bass drum" { $shorten 5 # shorten notes by 5 midi clicks # to leave space for offsets /l4r4/bd # 4 straight beats bd /z+5/bd /r2/bd # beat 2 played 5 midi clicks late /r4/bd # 4 straight beats bd /z-5/bd /r2/bd # beat 2 played 5 midi clicks early } @channel 10 "hi hat" { %repeat 4 { %repeat 4 { /l8/r hh_c } } } } midge-0.2.41/examples/tutorial/offset_random.mg0000644000076400007640000000170707246075142020163 0ustar davedave# This file demonstrates how to offset notes by a random amount # using the `Z' note option. The last bass drum should line up # with the crash cymbal. @head { $time_sig 4/4 $tempo 80 } @body { @channel 10 "drums" { $shorten 8 # shorten notes by 8 midi clicks # to leave space for offsets %repeat 2 { /l4r4/bd # straight bar bd # start on the beat /Z-8/bd # 2nd up to 8 clicks early bd # 3rd on the beat /Z+8/bd # 4th up to 8 clicks late /r4/bd # straight bar bd # start on the beat %repeat 3 { /Z8/bd } # offset remaining 3 beats # by + or - 8 midi clicks } bd # end on the one } @channel 10 "hi hat" { %repeat 8 { %repeat 4 { /l8/r hh_c } } /l4/cym_crash # end on the one } } midge-0.2.41/examples/tutorial/choose_scale.mg0000644000076400007640000000230107661471336017761 0ustar davedave# This file demonstrates the scale keyword in a choose block # and the rhythm keyword to specify note lengths to go with # the random pitches. @head { $tempo 120 $time_sig 4/4 } @body { @channel 1 "piano" { $patch piano_grand_ac # the `-' shows it's a non time-limited block, ie contains # a `rhythm' block. (`0' can also be used). %choose - { # c major scale, two octaves starting on c4 scale major c4-6 [ 4 2 3 2 4 3 2 3 # weightings for c4..c5 3 4 2 3 3 2 4 # weightings for d5..c6 ] # specify the note lengths rhythm { 4 4 8 8 4 # lengths are specified the same `n:d' # format as in the note options. 4 4 /l8/r # other tokens are passed through so rests 16 3:16 8 # and predefined riffs etc can be included. $chorus _64 # to set a numerical value this syntax # must be used to prevent the number # being parsed as a note length 8x4 # 4 eighth notes with pitches chosen separately /r2/16 # 2 16th notes with the same pitch 8x3 16 16 8 # some more notes... 4 4 8 8 } } } } midge-0.2.41/examples/tutorial/chain_scale.mg0000644000076400007640000000315407367076653017600 0ustar davedave# This files shows how to use a scale to specify the notes # in a chain block, and how to add additional notes. @head { $time_sig 4/4 $tempo 120 } @body { @channel 1 "piano" { $patch piano_grand_ac $volume 96 %chain 16:1 { # improvise for 16 bars scale major c5 # use notes from c major scale, octave 5 # scale can only be used once, and must # come first. [ # begin weighting matrix # to # c4 d4 e4 f4 g4 a4 b4 c5 # from 0 0 1 0 4 0 2 1 # c4 3 0 2 0 1 0 0 0 # d4 2 1 0 1 0 4 0 0 # e4 0 0 2 0 4 0 3 0 # f4 4 0 0 2 1 0 0 2 # g4 0 0 1 0 2 0 2 1 # a4 0 0 0 1 2 2 0 4 # b4 2 0 0 0 3 0 2 0 # c5 ] r # add a rest to the chain [ 4 0 2 0 3 0 1 1 0 ] # weightings for rest->scale notes # last value is for rest->rest # each additional note will need # one extra value [ 2 0 3 0 2 1 0 3 ] # weightings for scale notes->rest # rhythm block rhythm [ # mostly eigth notes, some quarters # weighting # value 4 8 1 4 ] } } @channel 2 "synth" { $patch organ_rock $volume 80 $length 1 %repeat 2 { # chord sequence | F | C | F | C | F | C | G | C | %repeat 3 { ( f3 a c4 f a c5 ) ( c3 e g c4 e g c5 ) } ( g3 b d4 g b ) ( c3 e g c4 e g c5 ) } } } midge-0.2.41/examples/tutorial/strum.mg0000644000076400007640000000067507376132425016514 0ustar davedave# this file demonstrates the $strum keyword @head { $tempo 80 $time_sig 4/4 } @body { # define E and A chords %define E { ( e2 b e3 g+ b e4 ) } %define A { ( a2 e3 a c+4 e ) } @channel 1 "guitar" { $patch guitar_nylon $strum 4 # 4 midi clicks between each note in chords $length 4 # quarter notes %repeat 4 { ~E r ~E ~E ~A r ~A ~A } $strum 12 # slower strum for last chord $length 1 ~E } } midge-0.2.41/examples/tutorial/bank.mg0000644000076400007640000000070307661462056016250 0ustar davedave# This file shows how to use a bank select, if your hardware supports it. @head { $tempo 100 $time_sig 4/4 } @body { @channel 1 { $length 4 $octave 3 $marker "patch 4; no bank (should use bank 1)" $patch 4 /r4/e r $marker "patch 4; bank 2" $patch 2,4 /r4/e r $marker "patch 5; no bank (should stay on bank 2)" $patch 5 /r4/e r $marker "patch 5; bank 1" $bank 1 /r4/e r $marker "patch 5; bank 2" $bank 2 /r4/e r } } midge-0.2.41/examples/tutorial/verbatim.mg0000644000076400007640000000056107450177101017136 0ustar davedave@head { $tempo 120 $time_sig 4/4 } @body { @channel 1 { $patch cello # note on c5 %verbatim { 0 # delta time 0x90 # note on ch1 (in hex) 60 # note c5 127 # velocity } /l4/r # next note starts 1/4 note later e4 g e %verbatim { 96 # delta time (1/4 note) 0x80 # note off ch1 60 # note c5 32 # velocity } } } midge-0.2.41/examples/tutorial/on_off.mg0000644000076400007640000000070007661464030016572 0ustar davedave# This file shows how to play simultaneous notes using separate # note-on and note-off events @head { $tempo 120 $time_sig 4/4 } @body { @channel 1 { $patch cello $length 4 +/a127/c5 # note on c5 (w/ attack 127) r # c5 plays for 1/4 note before other notes start e4 g e # play e4, g4, e4 over the c5 r # c5 plays for 1/4 note after other notes -/d32/c5 # note off c5 (w/ decay 32) } } midge-0.2.41/examples/tutorial/bend_simple.mg0000644000076400007640000000122007554342236017607 0ustar davedave@head { $tempo 120 $time_sig 4/4 } @body { @channel 1 "bass" { $patch bass_fg %repeat 4 { /l3:8/a3=>b-3=>a3 # Bend from a3 up to b-3 and back down to a3 # with the bend amount increasing/decreasing # linearly over the duration of 3 eighth notes. # By default, the bend is done over 16 steps # per quarter note (giving 24 here). This can # be changed using the `-b' command line switch. /l8/g3 r /l32/d /l3:32/e /l8/g a } } @channel 10 "tamborine" { %repeat 4 { /l4r4/tamb } } } midge-0.2.41/examples/tutorial/key_strict.mg0000644000076400007640000000135107771132512017506 0ustar davedave# This file demonstrates the $key_strict keyword, which makes the # notes automatically sharp or flat as appropriate for the key. # # This feature is experimental and will probably not work correctly # in all cases. @head { $key_strict G # f defaults to f sharp and octave changes at g. # An octave of 3 gives a note from the same octave # that contains the regular c3. } @body { @channel 1 "piano" { $patch piano_grand_ac /l4/g3 a b c d e f g4 # G major scale (f is sharp). /l4/g3 a b- c d e f= g4 # G with flattened 3rd (b flat) # and flattened 7th (f natural). $key B-m b3 c d e f g a b4 # B flat minor (b, d, e, g and a are flat). } } midge-0.2.41/examples/tutorial/bars.mg0000644000076400007640000000055510457000732016253 0ustar davedave@head { $bar_strict warn # Print a warning for inconsistent bars. # $bar_strict error # Exit with an error for inconsistent bars. $tempo 120 $time_sig 4/4 } @body { @channel 1 { $length 4 $patch 1,1,1 $volume 64 |_1 c4 d e f |_2 g f e d } @channel 2 { $length 8 $patch 1,1,1 $volume 64 |_1 c5 d e f g f e d |_2 c d e f g f e d } } midge-0.2.41/examples/covers/0000755000076400007640000000000010456763673014453 5ustar davedavemidge-0.2.41/examples/covers/stir_it_up.mg0000644000076400007640000000270507771330433017153 0ustar davedave# Artist: the Wailers # Album: catch a fire # Song: stir it up @head { $tempo 160 $time_sig 4/4 $key a $title "The Wailers - stir it up" } @body { %define major { ( a c+ e ) } # A major chord %define bass_1 { /l4/a2 r c+3 /l8/r c+ /l4/d r c+ /l8/r c+ d r f+ r /l4/a /l8/r d e r g+ r /l4/b r } %define bass_2 { /l8/a2 r b r c+3 r a2 r /r8/r d3 r e r f+ r d r /r8/r } @channel 1 bass { $patch bass_fg $volume 48 %repeat 4 { ~bass_1 } %repeat 2 { ~bass_2 } %repeat 4 { ~bass_1 } } @channel 2 "rhythm guitar" { $patch guitar_muted $length 16 $octave 4 $volume 32 %repeat 10 { %repeat 4 { /r4/r %repeat 2 { ~major r } # A chords } %repeat 2 { /r4/r %repeat 2 { ~major/5/ r } # D chords } %repeat 2 { /r4/r %repeat 2 { ~major/7/ r } # E chords } } } @channel 10 "drums" { $volume 127 $reverb 32 $attack 104-127 %repeat 4 { %repeat 4 { /l2/r bd } } /l8:1/r %repeat 4 { %repeat 4 { /l2/r bd } } } @channel 10 "hats" { $attack 80-127 %choose 16:1 { 32 /l4/hh_c 4 /l4/hh_o 1 /l4/r } /l8:1/r %choose 16:1 { 32 /l4/hh_c 6 /l4/hh_p 1 /l4/r } } @channel 10 "percussion" { $attack 64-96 %choose 16:1 { 1 /l8/tom_h 1 /l8/conga_h_mute 1 /l8/conga_h_open 1 /l8/conga_l 20 /l8/r } /l8:1/r %choose 16:1 { 1 /l8/tom_h 1 /l8/conga_h_mute 1 /l8/conga_h_open 1 /l8/conga_l 1 /l8/wood_l 20 /l8/r } } } midge-0.2.41/examples/covers/too_much_to_dream.mg0000644000076400007640000000577410374471547020477 0ustar davedave# Artist: the electric prunes # Song: I had too much to dream (last night) # Composers: Annette Tucker / Nancy Mantz # based on too_much_to_dream.crd transcribed by Andrew Rogers @head { $tempo 140 $time_sig 4/4 } @body { # bass %define bass_1 { /l8/c3 g3 c3 g3 c3 g3 c3 g3 } @channel 1 "bass" { $patch 36 $volume 127 # intro %repeat 2 { ~bass_1/2/ } %repeat 2 { # verse %repeat 2 { %repeat 2 { ~bass_1/2/ } %repeat 2 { ~bass_1 } } %repeat 2 { ~bass_1/7/ } %repeat 2 { ~bass_1/2/ } %repeat 2 { ~bass_1/7/ } ~bass_1/2/ /l1/g3 r # rest for drum count in %repeat 2 { ~bass_1/2/ } %repeat 2 { ~bass_1/1/ } /l3:8/g3 f e- /l4r5/r # chorus %repeat 3 { ~bass_1/2/ ~bass_1/7/ } ~bass_1/2/ /l1/a3 %repeat 2 { /l2/d3 c b-2 c3 } } # repeat chorus to end %repeat 3 { ~bass_1/2/ ~bass_1/7/ } ~bass_1/2/ /l1/a3 %repeat 6 { /l2/d3 c b-2 c3 } } # guitar chords %define Dm { ( d3 f3 a3 d4 f4 a4 ) } %define C { ( c3 e3 g3 c4 e4 g4 ) } %define Gm { ( g3 b-3 d4 g4 b-4 d3 ) } %define G { ( g3 b3 d4 g4 b4 d3 ) } %define F { ( f3 a3 c4 f4 a4 c3 ) } %define E- { ( e-3 g3 b-3 e-4 g4 b-4 ) } %define C+m { ( c+3 e3 g+3 c+4 e4 g+4 ) } %define A { ( a2 e3 a3 c+4 e4 ) } %define B- { ( b-2 f3 b-3 d4 f4 ) } @channel 2 "guitar" { $patch 27 $volume 32 /l1r2/r # rest for intro $strum 5 %repeat 2 { # verse %repeat 2 { %repeat 2 { ~Dm } %repeat 2 { ~C } } %repeat 2 { ~Gm } %repeat 2 { ~Dm } %repeat 2 { ~Gm } ~Dm ~G r # rest for drum count in # bridge %repeat 2 { ~Dm } %repeat 2 { ~C+m } $length 3:8 ~G ~F $length 2 ~E- /l8r9/r # chorus $length 1 %repeat 3 { ~Dm ~G } ~Dm ~A $length 2 %repeat 2 { ~Dm ~C ~B- ~C } } # repeat chorus to end $length 1 %repeat 3 { ~Dm ~G } ~Dm ~A $length 2 %repeat 6 { ~Dm ~C ~B- ~C } } # drums %define drums_1 { /l8r2/c3 d c } @channel 10 "drums" { $volume 127 $reverb 32 /l1r18/r # rest for first verse /l4r2/d3 /l8/d c d c # count in # bridge %repeat 8 { ~drums_1 } /l3:8r3/d3 /l4/r /r2/d3 /l8/d c d c # chorus %repeat 16 { ~drums_1 } %repeat 8 { /l4/d3 c } # 2nd time round # verse %repeat 30 { ~drums_1 } /l1/r /l4r2/d3 /l8/d c d c # count in # bridge %repeat 8 { ~drums_1 } /l3:8r3/d3 /l4/r /r2/d3 /l8/d c d c # chorus %repeat 16 { ~drums_1 } %repeat 8 { /l4/d3 c } # repeat chorus to end %repeat 16 { ~drums_1 } %repeat 24 { /l4/d3 c } } # cymbals %define cymbals_1 { /l8r2/f+3 g+ f+ /r2/f+ g+ f+ } @channel 10 "cymbals" { $volume 48 /l1r2/r # rest for intro %repeat 2 { %repeat 15 { /l8r8/f+3 } /l1/c+4 /l4r2/c+4 /r2/f+3 # drum count in # bridge %repeat 4 { /l8r8/f+3 } /l3:8r3/c+4 /l4/r /r2/c+4 /r2/f+3 # chorus %repeat 3 { /l4/r f+3 r f+3 r f+3 r c+4 } /l4/r f+3 r c+4 /l1/r /l2r8/c+4 } # repeat chorus to end %repeat 3 { /l4/r f+3 r f+3 r f+3 r c+4 } /l4/r f+3 r c+4 /l1/r /l2r24/c+4 } } midge-0.2.41/examples/covers/wish_you_were_here.mg0000644000076400007640000000266107134443344020665 0ustar davedave# Artist: Pink Floyd # Album: Wish you were here # Song: Wish you were here @head { $time_sig 4/4 $tempo 120 $title "Pink Floyd - wish you were here" } @body { # bass notes on piano %define g_riff { /l4/g3 /l8/a b /l4/d4 /l1/e /l4/r } %define em_riff { /l4/e4 g e /l1/d /l4/r } %define a_riff { /l4/e4 d b3 /l1/a /l4/r } @channel 1 piano { $patch 2 /l4r5/r # rest for count in %repeat 4 { %repeat 2 { ~g_riff ~em_riff } %repeat 2 { ~g_riff ~a_riff } /l2/r /l4/r $length 1 %repeat 3 { ( g3 b d4 ) } /l8/g3 /l8/r } } # lead acoustic guitar @channel 2 "acoustic guitar" { $patch 27 /l4r5/r # rest for count in %repeat 4 { /l1/r /l8/a4 b /l2/d5 /l8/e b4 /l2/d5 /l16/b4 a /l16/g /l2/d /l32/r /l4/r /l32/a+3 /l8/b d4 /l4/d /l1/r ( /l4/e5 a ) ( /l8/d g ) r ( /l4/a4 d5 ) ( /l8/b4 e5 ) r ( a4 d5 ) r ( b4 e5 ) r /l8/a4 g /l1/g3 /l4/r /l1/r /l8/a4 b d5 b4 e5 /l2/r %bend e5 { 64+32 # bend up to f+ 7:64-32 # back down to e 8+0 # hold for 1/8 } /l8/d e r /l2/a4 %bend b4 { 64+8 # bend up 1/2 a step 7:64+0 # hold } /l8/r d5 e %bend b4 { 64+8 7:64+0 } # same as previous bend r /l4/a /l4r3/r /l8/a4 b d5 b4 e5 /r3/r %bend e5 { 64+32 7:64+0 } /l8/r /l8/e d e r /l1/a4 /l2/r /l8/b a g /l1r3/r /l3:8/r # rest before repeat } } # click @channel 10 click { /l4r340/c+3 } } midge-0.2.41/examples/covers/paranoid.mg0000644000076400007640000000120607661441254016564 0ustar davedave# Artist: Black Sabbath # Album: Paranoid # Song: Paranoid @head { $time_sig 4/4 $tempo 160 $title "Black Sabbath - paranoid" } @body { %define main_riff { /l8r12/e3 a2 b d3 e /r8/d g /l4/d /l8/r e r /l4/d } %define drum_riff { /l8/c3 c d c } %define cymbals1 { /l8/f+3 f+ a+ f+ } %define cymbals2 { /l4/c+4 r c+ c+ } @channel 1 bass { $patch 35 %repeat 4 { ~main_riff } } @channel 10 drums { $patch 1 %repeat 32 { ~drum_riff } } @channel 10 cymbals { $patch 17 %repeat 6 { ~cymbals1 } ~cymbals2 %repeat 6 { ~cymbals1 } ~cymbals2 %repeat 6 { ~cymbals1 } ~cymbals2 %repeat 6 { ~cymbals1 } ~cymbals2 } } midge-0.2.41/examples/covers/motorhead.mg0000644000076400007640000000261707661246053016760 0ustar davedave# Artist: Hawkwind # Song: Motorhead @head { $tempo 86 $time_sig 4/4 $title "Hawkwind - motorhead" } @body { # bass %define main { /l8/e3 /l16/e /r2/r e /r2/r e /r2/r e /r2/r d d+ } %define main2 { /l8/e3 /l16/e /r2/r e /r2/r /l8/d d d /l16/d d+ } %define bridge { /l8/c3 c /l16/c c b2 /l8/a /l16/a /l8/a /l16/a a a b } %define bridge2 { /l8/c3 c /l16/c c /l8/c /l16/c c /l8/c /l16/c c /l8/c /l16/b2 b /l8/b /l16/b b /l8/b /l16/b b /l8/b /l16/b b /l8/b } %define chorus { /l8/e2 e /l16/e e /l8/e b2 b /l16/b b /l8/b } %define chorus2 { /l8/b2 b /l16/b b /l8/b } %define chorus3 { /l16/b2 b c3 c c+ c+ d d } @channel 1 bass { $patch 34 $volume 112 /l16/d3 d+ # lead in %repeat 2 { ~main ~main2 } # intro %repeat 3 { %repeat 6 { ~main } # verse (1st 2 bars no words) %repeat 2 { ~bridge } # "i should be tired" etc ~bridge2 # "ain't...for an hour" etc %repeat 2 { ~chorus } # "motorhead..." %repeat 2 { ~chorus2 } # "...alright" ~chorus3 # run back up to e } } # Drums %define drum_main { /l16/c3 r d r } @channel 10 drums { $volume 127 $reverb 64 /l8/r /l1r4/r # rest for count in & intro %repeat 162 { ~drum_main } } # Cymbals %define cym_main { /l16/f+3 f+ g+ f+ } @channel 10 cymbals { $volume 64 /l8/r /l1r4/r # rest for count in & intro %repeat 162 { ~cym_main } } } midge-0.2.41/examples/covers/bobby_brown.mg0000644000076400007640000000351707661731761017307 0ustar davedave# Artist: Frank Zappa # Album: Sheik Yerbouti # Song: Bobby Brown @head { $tempo 124 $time_sig 4/4 $title "Frank Zappa - Bobby Brown" } @body { # drums %define drum_main { /l8/c3 c /l4/r d c c c d r } %define drum_verse { %repeat 8 { ~drum_main } } %define drum_chorus { %repeat 3 { ~drum_main } /l1r2/r $volume 64 /l2r4/c+3 $volume 96 } %define drum_end { %repeat 2 { %repeat 3 { ~drum_main } /l1r2/r } %repeat 2 { ~drum_main /l1r2/r } } @channel 10 "drums" { $reverb 32 $volume 96 $pan 96 /l4r4/c+3 $marker "Verse 1" ~drum_verse $marker Chorus ~drum_chorus $marker "Verse 2" ~drum_verse $marker Chorus ~drum_chorus $marker "Verse 3" ~drum_verse $marker "Chorus & end" ~drum_end } # rhythm %define C { ( c3 e3 g3 c4 ) } %define Am { ( e2 a2 e3 a3 c4 ) } %define Dm { ( d3 a3 d4 f4 ) } %define Em { ( e2 b2 e3 g3 b3 e4 ) } %define F { ( f2 c3 f3 a3 c4 f4 ) } %define G { ( g2 b2 d3 g3 d4 g4 ) } @channel 1 "rhythm" { $patch 91 $length 1 $chorus 48 /l1/r %repeat 2 { %repeat 2 { ~C ~C ~Am ~Am ~Dm ~Dm ~G ~G } ~F ~F ~Em ~Am ~Dm %repeat 5 { ~G } } %repeat 2 { ~C ~C ~Am ~Am ~Dm ~Dm ~G ~G } ~F ~F ~Em ~Am ~Dm %repeat 3 { ~G } ~F ~F ~Em ~Am %repeat 3 { ~F %repeat 3 { ~G } } } # bass %define bass_verse { %repeat 2 { /l8/c2 c /l4r3/r /l1/c /l8/a2 a /l4r3/r /l1/a /l8/d2 d /l4r3/r /l1/d /l8/g2 g /l4r3/r /l1/g } } %define bass_chorus { /l1r2/f2 e3 a2 d3 /r3/g2 %repeat 4 { /l16/f+ /r2/g /r5/r } } %define bass_end { /l1r2/f2 e3 a2 d3 /r3/g2 /l1r2/f2 e3 a2 %repeat 3 { f2 %repeat 3 { g2 } } } @channel 2 "bass" { $patch 34 $volume 127 /l1/r %repeat 2 { ~bass_verse ~bass_chorus } ~bass_verse ~bass_end } } midge-0.2.41/examples/covers/dont_fear_the_reaper.mg0000644000076400007640000000135407224221142021115 0ustar davedave# Artist: Blue \"{O}yster Cult # Album: ? # Song: Don't fear the reaper @head { $tempo 69 $time_sig 4/4 $title "Blue Oyster Cult - don't fear the reaper" } @body { # Bass @channel 1 bass { $patch 35 $volume 127 %repeat 12 { /l16r4/b3 /r4/a /r4/g /r4/a } } # Drums @channel 10 drums { %repeat 48 { /l16/c3 c d c } } # Cymbals %define cym_main { /l16/f+3 f+ g+ f+ } %define cym_break { /l16/c+4 f+3 f+ c+4 } @channel 10 cymbals { %repeat 12 { %repeat 3 { ~cym_main } ~cym_break } } # rhythm guitar %define rhythm_main { # b a g a arpegios /l16/b3 f+4 b /l8/a3 /l16/e4 a e g3 d4 g /l8/a3 /l16/e4 a e } @channel 2 "rhythm guitar" { $patch 31 $chorus 96 $volume 80 %repeat 12 { ~rhythm_main } } } midge-0.2.41/examples/covers/wieh.mg0000644000076400007640000000215007224213513015710 0ustar davedave# Artist: Frank Zappa # Album: Joe's Garage # Song: Watermelon In Easter Hay # backing track only # as this track takes a long time to compile # I have shortened it here. To get the full # length to play along to, change `repeat 62' # in each track to `repeat 24' @head { $tempo 60 $title "Frank Zappa - Watermelon In Easter Hay" $key e } @body { # backing guitar @channel 1 "guitar" { $patch 27 %repeat 24 { $time_sig 4/4 /l4/c+5 a4 e g+3 $time_sig 5/4 /l4/e b f+4 b d+5 } } # bass @channel 2 "bass" { $patch 34 $volume 127 %repeat 24 { /l1/a2 /l5:4/e2 } } # drums %define drum_main { $length 4 %repeat 4 { c3 ( c3 d3 ) } c3 } @channel 10 "drums" { $reverb 80 %repeat 24 { ~drum_main } } # cymbals @channel 10 "cymbals" { $length 4 %repeat 24 { cym_crash /r2/r %choose { 4 cym_crash 2 cym_ride 1 cym_splash 12 r } /r2/r %repeat 2 { %choose { 2 cym_crash 1 cym_ride 7 r } } r } } # hi hat @channel 10 "hi hat" { $volume 72 %repeat 24 { /l16/r %choose 35:16 { 4 /l16/hh_c 1 /l8/hh_o 2 /l8/hh_p 6 /l16/r } } } } midge-0.2.41/examples/covers/one_drop.mg0000644000076400007640000000260107701537006016570 0ustar davedave# Artist: Bob Marley & The Wailers # Album: Survival # Song: One Drop # Based on the bass tab by Andre Torrez @head { $tempo 122 $time_sig 4/4 $key a $title "Bob Marley & The Wailers - One Drop" } @body { @channel 1 "bass" { $patch bass_fg $volume 120 %repeat 32 { /l6/r /l12/a2 /l6/a /l12/a /l6/c+3 /l12/c+ /l6/e /l12/r # A /l4/b2 /l6/r /l12/b /l6/d+3 /l12/d+ /l6/f+ /l12/r # B /l6/r /l12/d3 /l6/d /l12/d /l6/f+ /l12/f+ /l6/a /l12/r # D /l4/e /l6/r /l12/e /l6/g+ /l12/e /l6/b2 /l12/r # E } } %define major { ( a3 c+4 e4 a4 ) } # A major chord %define minor { ( a3 c4 e4 a4 ) } # A minor chord @channel 2 "rhythm guitar" { $patch guitar_muted $volume 64 $reverb 32 $length 32 %repeat 32 { %repeat 2 { /r8/r ~major /r7/r } # A %repeat 2 { /r8/r ~minor/-3/ /r7/r } # F#m %repeat 2 { /r8/r ~minor/2/ /r7/r } # Bm %repeat 2 { /r8/r ~major/-5/ /r7/r } # E } } @channel 3 "organ" { $patch organ_perc $volume 48 $chorus 48 $length 32 %repeat 32 { %repeat 2 { /r8/r ~major/-12/ /r7/r } # A %repeat 2 { /r8/r ~minor/-15/ /r7/r } # F#m %repeat 2 { /r8/r ~minor/-10/ /r7/r } # Bm %repeat 2 { /r8/r ~major/-17/ /r7/r } # E } } @channel 10 "hats" { %repeat 32 { /l4r16/hh_c } } @channel 10 "kick" { %repeat 32 { %repeat 4 { /l4r2/r bd r } } } } midge-0.2.41/examples/orig/0000755000076400007640000000000007661734654014113 5ustar davedavemidge-0.2.41/examples/orig/techno.mg0000644000076400007640000000237007655524441015714 0ustar davedave# This files generates a techno song with fixed drums, bass # and organ and a random synth part. @head { $tempo 136 $time_sig 3/4 } @body { # bass %define bass_1 { # 1 bar long /l8/e2 /l16r2/e /l8r2/e /l16/r e /l8r2/e r } @channel 1 "bass" { $patch 35 %repeat 16 { # 64 bars %repeat 2 { ~bass_1 } %repeat 2 { ~bass_1/-2/ } # transposed down 1 tone } } # cymbals %define cym_1 { # 4 bars %repeat 16 { /l8/r f+3 } } @channel 10 "cymbals" { $volume 80 /l1r4/r # rest for 4 bars %repeat 15 { # 60 bars ~cym_1 } } # drums @channel 10 "drums" { /l1r8/r # rest for 8 bars %repeat 14 { # 56 bars %repeat 4 { /l4r4/c3 } } } # random notes on polysynth @channel 2 "synth" { $patch polysynth $chorus 64 $volume 96 /l1r16/r # rest for 16 bars %repeat 12 { # 48 bars %repeat 2 { %choose 1 { # 1 bar at random over E chord 1 /l8/e4 1 /l8/g+4 3 /l16/e5 2 /l16/g5 1 /l16/a5 1 /l16/a4 2 /l16/b4 2 /l16/d5 1 /l8/d4 2 /l16/r } } /l1r2/r # rest over D chord } } # chords on organ %define E { ( e3 g+ b e4 g+ b ) } @channel 3 "organ" { $patch 19 $volume 48 /l1r12/r # rest for 12 bars %repeat 13 { %repeat 2 { ~E } %repeat 2 { ~E/-2/ } # D chord } } } midge-0.2.41/examples/orig/rock.mg0000644000076400007640000000375707134401105015363 0ustar davedave# This file plays random bass and drums with chords on a synth @head { $tempo 110 $time_sig 4/4 } @body { %define F_SH { ( f+3 c+4 f+4 ) } %define G_SH { ~F_SH/2/ } @channel 1 "rhythm" { $patch 100 $volume 64 $length 1 %repeat 4 { %repeat 4 { ~F_SH } %repeat 4 { ~G_SH } } } @channel 2 "bass" { $patch 37 $volume 127 %repeat 4 { /l4/f+2 # play the root note on chord change # random for rest of 4 bars %choose 3:4 { 2 /l16/f+2 1 /l8/a2 3 /l16/a2 2 /l16/b2 1 /l16/c+3 } %choose 2 { 2 /l16/f+3 3 /l16/e3 2 /l16/a2 2 /l16/c+3 } %choose 1 { 4 /l8/f+2 3 /l16/a2 3 /l16/b2 2 /l16/c+2 3 /l16/f+3 2 /l16/e3 1 /l16/c3 } %choose 2 { 2 /l16/f+3 3 /l16/e3 2 /l16/a2 2 /l16/c+3 } %choose 1 { 4 /l8/f+2 3 /l16/a2 3 /l16/b2 2 /l16/c+2 3 /l16/f+3 2 /l16/e3 1 /l16/c3 } /l4/g+2 # play root note on chord change # random for rest of 4 bars %choose 3:4 { 2 /l16/g+2 1 /l8/b2 3 /l16/b2 2 /l16/c+2 1 /l16/d+3 } %choose 2 { 2 /l16/g+3 3 /l16/e3 2 /l16/b2 2 /l16/d+3 } %choose 1 { 4 /l8/g+2 3 /l16/b2 3 /l16/c+2 2 /l16/d+2 3 /l16/g+3 2 /l16/e3 1 /l16/c3 } %choose 2 { 2 /l16/g+3 3 /l16/e3 2 /l16/b2 2 /l16/d+3 } %choose 1 { 4 /l8/g+2 3 /l16/b2 3 /l16/c+2 2 /l16/d+2 3 /l16/g+3 2 /l16/e3 1 /l16/c+3 } } } # some drum defines to be used in the %choose block %define HH_C { /l32/g+3 r } %define HH_O { /l32/f+3 r } %define TOM_1 { /l16/g3 /l16/a3 } %define TOM_2 { /l16/a3 /l16/g3 } @channel 10 "percussion" { %repeat 32 { %choose 1 { 9 /l16/~HH_O 10 /l16/~HH_C 12 /l16/r 1 /l4/c+4 1 /l8/~TOM_1 1 /l8/~TOM_2 } } } @channel 10 "drums" { %repeat 8 { /l2/c3 # bass drum on first beat # random for rest of two bars %choose 3:2 { 4 /l2/c3 3 /l2/d3 2 /l8/c3 1 /l8/d3 } /l4/c3 # bass drum on first beat # random for rest of two bars %choose 7:4 { 4 /l2/c3 3 /l2/d3 2 /l8/c3 1 /l8/d3 } } } } midge-0.2.41/examples/orig/in_the_winter_and_the_night.mg0000644000076400007640000000477107661470650022153 0ustar davedave# This is a rock backing track with bass and drums, using # %choose and %chain blocks to play drum fills and random # cymbals. It can be heard with a guitar part on my mp3 page. @head { $tempo 120 $time_sig 4/4 } @body { %define drum_1 { # 1 bar /l8r2/bd_ac sd_ac bd_ac /l4/sd_ac /l8/bd_ac sd_ac } %define drum_2 { # 1 bar /l8r2/bd_ac sd_ac /l4/bd_ac /l8/bd_ac /l4/sd_ac } %define drum_3 { # 1 bar /l8r2/bd_ac sd_ac /l4/bd_ac /l8r2/sd_ac bd_ac } @channel 10 "drums" { $reverb 48 $volume 127 # 1 bar intro /l2r2/stick /l4r4/stick %repeat 8 { # 128 bars # 6 bars ~drum_2 %choose { 3 ~drum_2 1 ~drum_1 } %repeat 4 { ~drum_2 } # 6 bars ~drum_2 %choose { 3 ~drum_2 1 ~drum_1 } %repeat 3 { ~drum_2 } ~drum_3 # 3 bars %repeat 3 { ~drum_2 } # 1 bar drum roll %chain 1 { start sd_ac bd_ac [ 1 bd_ac 3 sd_ac 1 tom_h ] sd_ac [ 1 sd_ac 2 tom_l 2 bd_ac ] tom_l [ 2 tom_lm 1 tom_h 1 sd_ac ] tom_lm [ 6 tom_hm 2 bd_ac ] tom_hm [ 4 tom_h 1 sd_ac 2 bd_ac 1 tom_lm ] tom_h [ 1 tom_l 1 tom_hm 1 bd_ac 1 sd_ac ] rhythm { 8 } } } /l1/bd } @channel 10 "hi_hat" { $volume 127 /l1r2/r # rest for intro %repeat 128 { %repeat 4 { /l8/r %choose { 4 /l8/hh_c 1 /l8/r 1 /l8/hh_p } } } } @channel 10 "cymbals" { $volume 127 /l1r2/r # rest for intro %repeat 8 { # 128 bars # 10 bars ( EE / DD / EE / DD / EE ) %repeat 5 { /l4/r %choose { 1 cym_ride 3 r 1 cym_crash } /r2/r # 1 bar /l4r3/r %choose { 1 cym_crash 3 r } # 1 bar } /l4/r %choose { 1 cym_crash 3 r 1 cym_ride } /r2/r # 1 bar (D) # 1 bar (D) /l8r5/r %choose { 2 cym_crash_2 3 r } r %choose { 2 cym_crash 3 r } # 4 bars (CC / BB) /l4/r %choose { 1 cym_crash 1 cym_chinese 3 r } /r2/r /l4r2/r %choose { 1 cym_ride 3 r } r $length 4 %repeat 2 { %choose { 1 r 3 cym_crash 1 cym_chinese } r } %choose 1 { 3 /l8/cym_crash 1 /l8/cym_ride 5 /l8/r 1 /l8/cym_splash } } /l1/cym_crash } %define bass_main { # 16 bars %repeat 2 { /l8r14/e2 e3 b2 /r13/d3 b2 d3 e } /l8r14/e2 e3 b2 /r14/d3 e3 d /l8r14/c3 g2 c4 /r14/b2 g f+ } @channel 1 "bass" { $patch bass_fg $volume 127 /l1r2/r # rest for intro %repeat 8 { ~bass_main } # 128 bars /l8/e2 } %define B_5 { ( b3 f+4 b4 ) } @channel 2 "chords" { $volume 56 $patch pad_sweep $length 1 /r2/r # rest for count in %repeat 8 { # 128 bars %repeat 3 { ~B_5/5/ ~B_5/5/ ~B_5/3/ ~B_5/3/ } ~B_5/1/ ~B_5/1/ ~B_5 ~B_5 } } } midge-0.2.41/examples/orig/under_the_sun.mg0000644000076400007640000001044007134400220017247 0ustar davedave# This is a reggae song using random drums and fixed bass, # trumpet, organ and flute. It can be heard with a guitar # part added on my mp3 page. @head { $tempo 80 $time_sig 4/4 } @body { # define chords %define E { ( e3 b3 e4 ) } %define E_wide { ( e3 b3 e4 b4 e5 ) } %define Am { ( a3 c4 e4 a4 ) } # chords on percussive organ @channel 1 "rhythm" { $patch organ_perc $length 32 %repeat 3 { # 72 bars %repeat 4 { # verse, 16 bars %repeat 3 { %repeat 2 { /r4/r ~Am /r3/r } %repeat 2 { /r4/r ~E/3/ /r3/r } } %repeat 2 { /r4/r ~E_wide/-2/ /r3/r } %repeat 2 { /r4/r ~E_wide /r3/r } } # chorus, 8 bars %repeat 3 { %repeat 4 { /r4/r ~E_wide/1/ /r3/r } %repeat 4 { /r4/r ~E_wide /r3/r } } %repeat 4 { /r4/r ~E_wide/-2/ /r3/r } %repeat 4 { /r4/r ~E_wide /r3/r } } $length 2 ~Am } # bass drum on beats 1 and 3 (of 4) @channel 10 "drums_4_on" { $volume 104 %repeat 3 { # 72 bars %repeat 4 { # verse, 16 bars %repeat 8 { /l4/bd r } # 4 bars } %repeat 2 { # chorus, 8 bars %repeat 8 { /l4/bd r } # 4 bars } } $length 1 ( bd cym_crash ) } # random drum on beats 2 and 4 (of 4) @channel 10 "drums_4_off" { %repeat 3 { # 72 bars %repeat 4 { # verse, 16 bars %repeat 8 { # 4 bars /l4/r %choose { 5 tom_l 3 tom_lm 3 tom_hm 1 sd_ac } } } %repeat 2 { # chorus, 8 bars %repeat 7 { # 3.5 bars /l4/r %choose { 5 tom_l 3 tom_lm 3 tom_hm 1 tom_h } } /l8/hh_p tom_hm tom_lm tom_l # 0.5 bars } } } # random hi hat or rest on every second eighth note @channel 10 "drums_8" { %repeat 3 { # 72 bars %repeat 4 { # verse, 16 bars %repeat 16 { # 4 bars /l8/r %choose { 4 hh_c 1 hh_p 1 hh_o 2 r } } } %repeat 2 { # chorus, 8 bars %repeat 16 { # 4 bars /l8/r %choose { 4 hh_c 1 hh_p 1 hh_o 2 r } } } } } # random drum on every second sixteenth note @channel 10 "drums_16" { $length 16 %repeat 3 { # 72 bars %repeat 24 { %repeat 8 { # 1 bar r # offset the beat %choose { 6 hh_c 20 r 1 tom_h 1 bongo_h 3 conga_h_mute 2 conga_h_open } } } } } # define bass lines %define bass_amg { # 1 bar /l16/g2 /r2/a r /l8/a3 a2 /r2/g g3 d } %define bass_de_1 { # 1 bar /l16/c3 /r2/d r /l8/a2 d3 e2 e3 b2 e3 } %define bass_de_2 { # 2 bars /l16/c3 /r2/d r /l8/a2 d3 d2 d3 a2 d3 /l16/d3 /r2/e r /l8/b2 e3 e2 d3 c b2 } %define bass_fe { # 2 bars %repeat 2 { /l16r2/f2 f3 r /l8/c f } %repeat 2 { /l16r2/e2 e3 r /l8/b2 e3 } } @channel 2 "bass" { $patch bass_fg $volume 104 %repeat 3 { # 72 bars %repeat 4 { # verse, 16 bars %repeat 3 { ~bass_amg } ~bass_de_1 } %repeat 3 { ~bass_fe } ~bass_de_2 # 8 bars } /l1/a2 } # define trumpet part all in one block %define trumpet_main { /l16r2/r /r4/a4 /l4/a /l16/g r g /r3/r /l16r2/r /r4/a4 c5 /l3:16/b4 /l16/g /r5/r /l16r2/r /r4/a4 /l4/a /l16/g r g /r3/r /l16r2/r /r2/d5 /r2/a4 d5 /l5:16/e /l4/r /l16r2/r /r2/a4 e a /r4/r /r2/g4 d g /r2/c /l16r2/r /r2/a4 e a r c5 /l8/b4 /l16/g /r5/r /l16r2/r /r2/a4 e a /r4/r /r2/g4 d g /r2/c /l16r2/r a4 /r6/d5 /l3:16/e /l4/r /l16r2/r /r2/a4 /r2/r /r4/a /l16/g /r5/r /l16r2/r /r2/a4 r a b c5 /l8/b4 /l16/g /r5/r /l16r2/r /r2/a4 /r2/r /r4/a /l16/g /r5/r /l16r2/r /r5/d5 /l5:16/e /l4/r /l16r2/r /r4/a4 /l4/a /l16/g r g /r3/r /l16r2/r /r4/a4 c5 /l3:16/b4 /l16/g /r5/r /l16r2/r /r4/a4 /l4/a /l16/g r g /r3/r /l16r2/r /r2/d5 /r2/a4 d5 /l5:16/e /l4/r } @channel 3 "trumpet" { $patch trumpet $volume 56 ~trumpet_main /l8:1/r # rest for chorus /l24:1/r # rest for guitar solo ~trumpet_main } # define flute part all in one block %define flute_main { /l16r2/r /r2/f5 /r2/c f5 r /l16r2/r /r2/f5 /l8/g /l16/f /l3:16/f /l16/e /l5:16/r /l2/r /l16r2/r /r2/f5 /r2/c f5 r /l16r2/r /r2/f5 /l8/g /l16/f /l3:16/f /l16/e /l16/e /l16/f /l3:16/e /l2/r /l16r2/r /r2/f5 /r2/c f5 r /l16r2/r /r2/f5 c /l8/f /l3:16/f /l16/e /l5:16/r /l2/r /l16r2/r /r2/d5 /r2/a4 d5 r /l16r2/r /r2/d5 /r2/a4 d5 /l3:16/f /l16/e /l13:16/r } @channel 4 "flute" { $patch flute $volume 64 /l16:1/r # rest for verse ~flute_main /l24:1/r # rest for guitar solo /l16:1/r # rest for verse ~flute_main } } midge-0.2.41/include/0000755000076400007640000000000007516360130012737 5ustar davedavemidge-0.2.41/include/chords.mgh0000644000076400007640000000121707516360130014717 0ustar davedave########################################### ## ## These chords can be used with code like: ## ## $length 4 $octave 3 ## ## ~major/-3/ # A major ## ~minor/7/ # E minor # C major triad %define major { ( c e g ) } # C minor triad %define minor { ( c e- g ) } # C seventh %define seventh { ( c e g b- ) } # C major seventh %define majseventh { ( c e g b ) } # C sus4 %define sus4 { ( c e f g ) } # C power chord starting on 3rd octave %define power3 { ( c3 g c4 ) } # C major covering 2 octaves starting on 3rd %define major3 { ( c3 e g c4 e g ) } # C hendrix (7th +#9th) starting on 3rd octave %define hendrix3 { ( c3 e g b- d+4 ) } midge-0.2.41/include/drums.mgh0000644000076400007640000000107207516360130014566 0ustar davedave##################################################################### ## ## Some patterns with no length defined. The first number is the ## number of beats in the pattern, so if you use: ## ## $length 4 ~drum_4_1 ## ## you will get one bar, and: ## ## $length 8 ~drum_4_2 ## ## you will get half a bar. ## %define drum_4_1 { bd bd sd_ac bd } %define drum_4_2 { bd sd_ac bd sd_ac } %define drum_8_1 { bd r sd_ac r bd bd sd_ac r } %define drum_3_1 { bd /r2/bd } %define drum_6_1 { bd r %repeat 2 { sd_ac bd } } %define drum_5_1 { bd %repeat 2 { sd_ac bd } } midge-0.2.41/include/hats.mgh0000644000076400007640000000266607516360130014405 0ustar davedave##################################################################### ## ## Some fixed hi hat patterns. The first number is the ## number of beats in the pattern, so if you use: ## ## $length 8 ~hats_8_1 ## ## you will get one bar, and: ## ## $length 8 ~hats_16_2 ## ## you will get two bars. ## %define hats_8_1 { hh_o /r7/hh_c } %define hats_8_2 { /r7/hh_c hh_p } %define hats_16_1 { hh_o /r12/hh_c hh_p /r2/hh_c } # Off the beat %define hats_4_off { %repeat 2 { r hh_c } } %define hats_8_off { %repeat 4 { r hh_c } } %define hats_16_off { %repeat 8 { r hh_c } } ######################################################################### ## ## Some random patterns. The first number is the note length and the ## second is the number of bars. ## %define rhats_8_1 { %choose 1 { 2 /l8/r 1 /l8/hh_p 1 /l8/hh_o 12 /l8/hh_c } } %define rhats_16_1 { %choose 1 { 2 /l16/r 1 /l16/hh_p 1 /l16/hh_o 12 /l16/hh_c } } %define rhats_8_4 { %choose 4:1 { 2 /l8/r 1 /l8/hh_p 1 /l8/hh_o 12 /l8/hh_c } } %define rhats_16_4 { %choose 4:1 { 2 /l16/r 1 /l16/hh_p 1 /l16/hh_o 12 /l16/hh_c } } %define hats_16_funk_1 { %chain 1 { hh_o [ 8 hh_c 1 hh_p 1 r ] hh_c [ 8 hh_c 1 hh_p 2 hh_o 1 r ] hh_p [ 1 hh_o 3 hh_c ] r [ 1 hh_o 1 hh_c ] rhythm [ 8 16 1 8 ] } } %define hats_16_funk_4 { %chain 4:1 { hh_o [ 8 hh_c 1 hh_p 1 r ] hh_c [ 8 hh_c 1 hh_p 2 hh_o 1 r ] hh_p [ 1 hh_o 3 hh_c ] r [ 1 hh_o 1 hh_c ] rhythm [ 8 16 1 8 ] } } midge-0.2.41/midge-mode.el0000644000076400007640000010251007770715002013650 0ustar davedave;; Midge mode - for writing midge(1) source files (require 'compile) (require 'regexp-opt) (require 'skeleton) ;;; Code: (defvar midge-mode-map (let ((map (make-sparse-keymap))) (define-key map "}" 'midge-close-bracket) (define-key map "\t" 'midge-indent-line) (define-key map "\C-c\C-ch" 'midge-head-block) (define-key map "\C-c\C-cg" 'midge-body-block) (define-key map "\C-c\C-cn" 'midge-channel-block) (define-key map "\C-c\C-cr" 'midge-repeat-block) (define-key map "\C-c\C-cb" 'midge-bend-block) (define-key map "\C-c\C-cd" 'midge-define-block) (define-key map "\C-c\C-cc" 'midge-choose-block) (define-key map "\C-c\C-ca" 'midge-chain-block) (define-key map "\C-c\C-ct" 'midge-tuplet-block) (define-key map "\C-c\C-dr" 'midge-repeat-line) (define-key map "\C-c\C-db" 'midge-bend-line) (define-key map "\C-c\C-dd" 'midge-define-line) (define-key map "\C-c\C-dc" 'midge-choose-line) (define-key map "\C-c\C-dt" 'midge-tuplet-line) (define-key map "\C-c\C-fp" 'midge-select-patch) (define-key map "\C-c\C-fd" 'midge-select-drum) (define-key map "\C-c\C-fs" 'midge-select-scale) (define-key map "\C-c\C-ft" 'midge-insert-tempo) (define-key map "\C-c\C-fg" 'midge-insert-time-sig) (define-key map "\C-c\C-fv" 'midge-insert-volume) (define-key map "\C-c\C-fy" 'midge-insert-pan) (define-key map "\C-c\C-fr" 'midge-insert-reverb) (define-key map "\C-c\C-fc" 'midge-insert-chorus) (define-key map "\C-c\C-v\C-c" 'midge-compile) (define-key map "\C-c\C-v\C-b" 'midge-compile-background) (define-key map "\C-c\C-v\C-v" 'midge-compile-verbose) (define-key map "\C-c\C-v\C-d" 'midge-compile-debug) (define-key map "\C-c\C-v\C-f" 'midge-compile-ask) (define-key map "\C-c\C-v\C-m" 'midge-decompile) (define-key map "\C-c\C-v\C-p" 'midge-play-background) (define-key map "\C-c\C-v\C-l" 'midge-play-foreground) (define-key map "\C-c\C-v\C-o" 'midge-play-ask-background) (define-key map "\C-c\C-v\C-k" 'midge-play-ask-foreground) map) "Local keymap for midge mode buffers.") (defconst midge-drum-names '("agogo_h" "agogo_l" "bd" "bd_ac" "bongo_h" "bongo_l" "cabasa" "clap" "claves" "conga_h_mute" "conga_h_open" "conga_l" "cowbell" "cuica_mute" "cuica_open" "cym_chinese" "cym_crash" "cym_crash_2" "cym_ride" "cym_ride_2" "cym_splash" "ftom_h" "ftom_l" "guiro_lg" "guiro_sh" "hh_c" "hh_o" "hh_p" "maracas" "ride_bell" "sd_ac" "sd_el" "stick" "tamb" "timbale_h" "timbale_l" "tom_h" "tom_hm" "tom_l" "tom_lm" "tri_mute" "tri_open" "vibraslap" "whistle_lg" "whistle_sh" "wood_h" "wood_l")) (defconst midge-instrument-names '("accordian" "accordian_tango" "agogo" "bagpipe" "banjo" "bass_ac" "bass_fg" "bass_fless" "bass_pick" "bass_slap_1" "bass_slap_2" "bass_syn_1" "bass_syn_2" "bassoon" "bell_tinkle" "bottle" "brass" "brass_syn_1" "brass_syn_2" "celesta" "cello" "choir_aahs" "clarinet" "clavinet" "contrabass" "cymbal_rev" "drum_steel" "drum_syn" "drum_taiko" "dulcimer" "fiddle" "flute" "flute_pan" "fx_atmos" "fx_breath" "fx_bright" "fx_copter" "fx_crystal" "fx_echo" "fx_fret" "fx_goblin" "fx_gun" "fx_phone" "fx_rain" "fx_scifi" "fx_sea" "fx_strack" "fx_tweeet" "glockenspiel" "guitar_clean" "guitar_dist" "guitar_harm" "guitar_jazz" "guitar_muted" "guitar_nylon" "guitar_od" "guitar_steel" "harmonica" "harpsichord" "hornen" "hornfr" "kalimba" "koto" "lead_basslead" "lead_calliope" "lead_charang" "lead_chiff" "lead_fifth" "lead_saw" "lead_sq" "lead_voice" "marimba" "music_box" "oboe" "ocarina" "orch_hit" "organ_church" "organ_dbar" "organ_perc" "organ_reed" "organ_rock" "pad_bowed" "pad_choir" "pad_halo" "pad_metal" "pad_new_age" "pad_sweep" "pad_warm" "piano_br" "piano_el_1" "piano_el_2" "piano_grand_ac" "piano_grand_el" "piano_ht" "piccolo" "polysynth" "recorder" "saxalt" "saxbar" "saxsop" "saxten" "shamisen" "shenai" "sitar" "skakuhachi" "str_ens_1" "str_ens_2" "str_orch" "str_pizz" "str_syn_1" "str_syn_2" "str_trem" "timpani" "tom_melodic" "trombone" "trombone_muted" "trumpet" "tuba" "tubular_bells" "vibraphone" "viola" "violin" "voice_oohs" "voice_syn" "whistle" "woodblock" "xylophone")) (defconst midge-scale-names '("aeolian" "arabian" "bebop" "bebop_dorian" "bebop_mixolydian" "chromatic" "dorian" "gypsy" "ionian" "locrian" "lydian" "major" "major_pentatonic" "minor" "minor_harmonic" "minor_jazz" "minor_pentatonic" "mixolydian" "phrygian" "spanish" "whole_tone")) (defconst midge-simple-keywords '("attack" "bank" "bend_range" "chorus" "ctrl" "decay" "key" "key_strict" "length" "marker" "nrpn" "octave" "pan" "patch" "pitch" "print" "resolution" "reverb" "rpn" "shorten" "strum" "tempo" "time_sig" "title" "unquantise" "volume") "Simple midge keywords. All strings in this list should be prefixed with '$'.") ;; syntax highlighting (defvar midge-font-lock-keywords `(; Main blocks ("\\@\\(head\\|body\\|channel\\)" 1 font-lock-builtin-face) ; Unquoted track title ("\\@channel[[:blank:]]+[0-9]+[[:blank:]]+\\([^{[:blank:]]+\\)\\([[:blank:]]\\|$\\)" 1 font-lock-string-face) ; "-" before "{" modifies the behaviour of the block. ("[[:blank:]]+\\(-\\)[[:blank:]]+{" 1 font-lock-warning-face) ; Note on and note off ("\\(^\\|[[:blank:]]\\)\\([-+]\\)" 2 font-lock-warning-face) ; Block keywords ("\\%\\(repeat\\|pan_all\\|bend\\|choose\\|chain\\|eval\\|include\\|tuplet\\|verbatim\\|bytes\\)" 1 font-lock-function-name-face) ("\\%\\(define\\)[[:blank:]]+\\([^[:blank:]]\\)+" 1 font-lock-function-name-face) ("\\(\\%define\\)[[:blank:]]+\\([^[:blank:]]+\\)" 2 font-lock-variable-name-face) ; Simple keywords (,(concat "\\$\\(" (regexp-opt midge-simple-keywords) "\\)") 1 font-lock-keyword-face) ; Unquoted marker or title text ("\\$\\(marker\\|title\\)[[:blank:]]+\\([^[:blank:]]+\\)\\([[:blank:]]\\|$\\)" 2 font-lock-string-face) ; Riff names ("\\~\\([^/[:blank:]]+\\)" 1 font-lock-variable-name-face) ; Scales (,(concat "\\(^\\| \\|\t\\)\\(" (regexp-opt midge-scale-names) "\\)\\($\\| \\|\t\\)") . font-lock-reference-face) ; Drum names (,(concat "\\(^\\|[/[:blank:]]\\)\\(" (regexp-opt midge-drum-names) "\\)") 2 font-lock-constant-face) ; Instrument names (,(concat "\\$patch[[:blank:]]+[,0-9]*\\(" (regexp-opt midge-instrument-names) "\\)\\([[:blank:]]\\|$\\)") 1 font-lock-constant-face) ; Hex values ("\\(^\\|[[:blank:]]\\)\\(0x[0-9]+\\)\\([[:blank:]]\\|$\\)" 2 font-lock-string-face) ; Ranges, bend values etc ("\\(^\\|:\\|[[:blank:]]\\)[0-9]+\\([-+x]\\)[0-9]+\\([[:blank:]]\\|$\\)" 2 font-lock-warning-face) ; Transpose numbers ("/\\(-?[0-9]+\\)/" 1 font-lock-type-face) ; Note options ("\\(\\(^\\|[[:blank:]]\\|[-+]\\)/\\|[0-9]\\)\\([a-yA-Y]\\|[zZ][-+]?\\)" 3 font-lock-keyword-face) ; Keywords inside blocks ("\\(scale\\|rhythm\\|times\\|start\\)" . font-lock-builtin-face) ; Start and end of chords ("[()]" . font-lock-warning-face) ; Simple bend syntax ("=>" . font-lock-warning-face) ; "[length]x[repeat]" in rhythm blocks ; ("\\(^\\|[[:blank:]]\\)[0-9]+\\(x\\)[0-9]+\\([[:blank:]]\\|$\\)" 2 font-lock-warning-mode) ; Ranges ; ("\\$[^[:blank:]]+[[:blank:]]\\([0-9]+-[0-9]+\\)" 2 font-lock-string-face) ; Bend values ; ("\\(^\\|[[:blank:]]\\)[0-9]+\\([-+]\\)[0-9]+\\([[:blank:]]\\|$\\)" 2 font-lock-warning-face) ; Numbers and time values ; ("\\(^\\|[,[:blank:]]\\)\\([0-9]+\\([:/][0-9]+\\)?\\)" 2 font-lock-string-face) ; Comma separated lists ; ("[a-zA-Z0-9]+\\(,\\)" 1 font-lock-warning-face) ; Fractional time values ; ("[0-9]+\\(:\\)[0-9]+" 1 font-lock-warning-face) ) "Highlighting expressions for midge-mode.") (defvar midge-mode-syntax-table (let ((table (make-syntax-table))) (modify-syntax-entry ?\# "<" table) (modify-syntax-entry ?\n ">" table) table) "Syntax table for midge-mode.") (defgroup midge () "Midge generates MIDI files from text input. Most General MIDI features are supported, and there are some basic methods of randomly generating sequences. Also included is a decompiler." :group 'external) (defcustom midge-compiler (executable-find "midge") "*Path to the midge executable." :group 'midge :type 'file) (defcustom midge-decompiler (executable-find "midi2mg") "*Path to the midi2mg executable." :group 'midge :type 'file) (defcustom midge-options nil "*Options to pass to midge." :group 'midge :type '(choice (const nil) (list (string :tag "Arg")))) (defcustom midge-midi-player (or (executable-find "playmidi") (executable-find "timidity")) "*Command to play midi files." :group 'midge :type '(choice (const nil) file)) (defcustom midge-use-menus t "*Whether to use the menus." :group 'midge :type 'boolean) (defconst midge-comment-regexp "#[^ \n]*" "Regular expression for recognizing comments.") (defconst midge-open-regexp "[^{}#\n]*{" "Regular expression for opening bracket.") (defconst midge-close-regexp "[^{}#\n]*}" "Regular expression for closing bracket.") (defconst midge-close-first-regexp "^[ \t]*}" "Regular expression to match a closing bracket as the first non whitespace char.") (defconst midge-whitespace-regexp "[ \t]+" "Regular expression to match whitespace.") (defconst midge-blank-line-regexp "^[ \t]*$" "Regular expression to match a blank line.") (defconst midge-tuplet-ratio-regexp "^[0-9]+:[0-9]+$" "Regular expression to match time ratio in tuplet blocks.") (defconst midge-time-sig-regexp "^[0-9]+/[0-9]+$" "Regular expression to match time signature.") (defconst midge-integer-regexp "^[0-9]+$" "Regular expression to match an integer") ;; beep and print an error message (defun midge-error-message (str) (ding) (message str) nil) ;; calculate indent level (defun midge-indent-level () "Calculate the indent level of the current line." (let ((indent 0) (maxpos (line-beginning-position))) (save-excursion (goto-char (point-min)) (while (< (point) maxpos) (cond ((looking-at midge-open-regexp) (goto-char (match-end 0)) (setq indent (1+ indent))) ((looking-at midge-close-regexp) (goto-char (match-end 0)) (if (> indent 0) (setq indent (1- indent)))) ((looking-at midge-comment-regexp) (end-of-line)) ((eolp) (if (< (point) maxpos) (progn (next-line 1) (end-of-line) (if (< (point) maxpos) (beginning-of-line))))) (t (end-of-line))))) indent)) (defun midge-indent-line () "Indent the current line." (interactive) (let ((indent (midge-indent-level)) (start-pos (point)) (current 0) (safe-indent 0)) (beginning-of-line) (if (looking-at midge-close-first-regexp) (if (> indent 0) (setq indent (1- indent)))) (setq safe-indent indent) (if (looking-at midge-whitespace-regexp) (setq current (- (match-end 0) (point)))) (if (not (= current (* tab-width indent))) (progn (delete-char current 't) (while (> indent 0) (insert "\t") (setq indent (1- indent))))) (goto-char start-pos)) (if (looking-at midge-whitespace-regexp) (goto-char (match-end 0)))) (defun midge-close-bracket () "Insert a closing bracket, indenting if neccesary." (interactive) (let ((start-pos (point))) (beginning-of-line) (if (looking-at midge-blank-line-regexp) (progn (let ((indent 0)) (if (looking-at midge-whitespace-regexp) (progn (goto-char (match-end 0)) (if (>= (point) start-pos) (setq indent 1)))) (if (eolp) (setq indent 1)) (if (= indent 1) (progn (beginning-of-line) (if (looking-at midge-whitespace-regexp) (progn (kill-line) (insert "\n") (next-line -1))) (setq indent (1- (midge-indent-level))) (while (> indent 0) (insert "\t") (setq indent (1- indent)))))) (insert "}")) (goto-char start-pos) (insert "}")))) (defun midge-head-block () "Insert a head block." (interactive) (midge-indent-line) (insert "@head {\n\n") (midge-close-bracket) (insert "\n") (next-line -2) (midge-indent-line)) (defun midge-body-block () "Insert a body block." (interactive) (midge-indent-line) (insert "@body {\n\n") (midge-close-bracket) (insert "\n") (next-line -2) (midge-indent-line)) (defun midge-channel-block (number name) "Insert a channel block, prompting for channel number and instrument name, indenting and placing point apropriately." (interactive "nChannel number: \nsInstrument name: ") (if (or (< number 1) (> number 16)) (midge-error-message (concat "Bad channel number: " (number-to-string number))) (midge-indent-line) (if (equal name "") (insert (concat "@channel " (number-to-string number) " {\n\n")) (insert (concat "@channel " (number-to-string number) " \"" name "\" {\n\n"))) (midge-close-bracket) (insert "\n") (next-line -2) (midge-indent-line))) (defun midge-repeat-block (count) "Insert a multiline repeat block, indenting as neccesary, prompting for repeat count and placing point between the brackets." (interactive "nRepeat count: ") (midge-indent-line) (insert "%repeat ") (insert (number-to-string count)) (insert " {\n") (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1)) (defun midge-choose-block (time) "Insert a multiline choose block, indenting as neccesary and placing point between the brackets." (interactive "sRiff length: ") (midge-indent-line) (insert "%choose ") (if (equal time "") (insert "{\n") (insert (concat time " {\n"))) (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1)) (defun midge-chain-block (time) "Insert a chain block, indenting as neccesary and placing point between the brackets." (interactive "sRiff length: ") (midge-indent-line) (insert "%chain ") (insert (concat time " {\n")) (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1)) ;; This does not work because the current indent function does behave ;; strangely and non-intuitively. ;; (define-skeleton midge-bend-block ;; "" ;; "Initial note: " ;; > "%bend " str " {" \n _ \n "}\n") (defun midge-bend-block (note) "Insert a multiline bend block, indenting as neccesary, prompting for initial note and placing point between the brackets." (interactive "sInitial note: ") (midge-indent-line) (insert "%bend ") (insert note) (insert " {\n") (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1)) (defun midge-define-block (name) "Insert a multiline define block, indenting as neccesary, prompting for riff name and placing point between the brackets." (interactive "sRiff name: ") (midge-indent-line) (insert "%define ") (insert name) (insert " {\n") (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1)) (defun midge-tuplet-block (ratio) "Insert a multiline tuplet block, indenting as neccesary, prompting for time ratio and placing point between the brackets." (interactive "sTime ratio: ") (if (not (string-match midge-tuplet-ratio-regexp ratio)) (midge-error-message (concat "bad time ratio `" ratio "\' (should be n:d)")) (midge-indent-line) (insert "%tuplet ") (insert ratio) (insert " {\n") (midge-indent-line) (insert "\n") (midge-close-bracket) (insert "\n") (next-line -1) (beginning-of-line) (backward-char 1))) (define-skeleton midge-repeat-line "Add a repeat block on a single line, prompting for number of repeats and positioning point apropriately." "Repeat count: " "%repeat " str " { " _ " }\n") (define-skeleton midge-bend-line "Add a bend block on a single line, prompting for initial note and positioning point apropriately." "Initial note: " "%bend " str " { " _ " }\n") (define-skeleton midge-define-line "Add a define block on a single line, prompting for riff name and positioning point apropriately." "Name of riff: " "%define " str " { " _ " }" \n) (define-skeleton midge-choose-line "Add a choose block on a single line, positioning point apropriately." "Riff length: " "%choose" (unless (string= (eval str) "") (concat " " str)) " { " _ " }\n") (define-skeleton midge-tuplet-line "Add a tuplet block on a single line, prompting for time ratio and positioning point apropriately." "Time ratio: " (unless (string-match midge-tuplet-ratio-regexp (eval str)) (error "bad time ratio %s (should be n:d)" str)) "%tuplet " str " { " _ " }\n") (define-skeleton midge-insert-tempo "Add a $tempo event, promptimg for the bpm value." "Tempo (bpm): " "$tempo " str) (define-skeleton midge-insert-time-sig "Add a $time_sig event, promptimg for the time signature." "Time signature (n/m): " (unless (string-match midge-time-sig-regexp (eval str)) (error "bad time signature value %s (expected n/m)" str)) "$time_sig " str) (defun midge-insert-reverb (value) "Add a $reverb event, promptimg for the value." (interactive "nReverb (0-127): ") (if (and (> 0 value) (< 128 value)) (midge-error-message (concat "bad reverb value " value " (expected 0-127)")) (insert (concat "$reverb " value)))) (defun midge-insert-chorus (value) "Add a $chorus event, promptimg for the value." (interactive "nChorus (0-127): ") (if (and (> 0 value) (< 128 value)) (midge-error-message (concat "bad chorus value " value " (expected 0-127)")) (insert (concat "$chorus " value)))) (defun midge-insert-volume (value) "Add a $volume event, promptimg for the value." (interactive "nVolume (0-127): ") (if (or (> 0 value) (< 127 value)) (midge-error-message (concat "bad volume value " value " (expected 0-127)")) (insert (concat "$volume " value)))) (defun midge-insert-pan (value) "Add a $pan event, promptimg for the value." (interactive "nPan (0-127): ") (if (and (> 0 value) (< 128 value)) (midge-error-message (concat "bad pan value " value " (expected 0-127)")) (insert (concat "$pan " value)))) (defun midge-compile () "Compile the current file." (interactive) (save-some-buffers) (let ((command (concat midge-compiler " " buffer-file-name))) (compile-internal command "No more errors"))) (defun midge-compile-background () "Compile the current file." (interactive) (save-some-buffers) (let ((command (concat midge-compiler " " buffer-file-name "&"))) (compile-internal command "No more errors"))) (defun midge-compile-debug () "Compile the current file with debug option." (interactive) (save-some-buffers) (let ((command (concat midge-compiler " -d " buffer-file-name))) (compile-internal command "No more errors"))) (defun midge-compile-verbose () "Compile the current file with verbose option." (interactive) (save-some-buffers) (let ((command (concat midge-compiler " -v " buffer-file-name))) (compile-internal command "No more errors"))) (defun midge-compile-ask (options) "Compile the current file with verbose option." (interactive "sOptions: ") (save-some-buffers) (let ((command (concat midge-compiler " " options " " buffer-file-name))) (compile-internal command "No more errors"))) (defun midge-play-background () "play the midi file generated from the current midge source file." (interactive) (let ((filename (concat (file-name-sans-extension buffer-file-name) ".mid"))) (if (not (file-exists-p filename)) (midge-error-message "Current file has not been compiled") (shell-command (concat midge-midi-player " " filename "&"))))) (defun midge-play-foreground () "play the midi file generated from the current midge source file." (interactive) (let ((filename (concat (file-name-sans-extension buffer-file-name) ".mid"))) (if (not (file-exists-p filename)) (midge-error-message "Current file has not been compiled") (shell-command (concat midge-midi-player " " filename))))) (defun midge-play-ask-background (file) "play the midi file chosen by the user in the background." (interactive "fMidi file: ") (let ((command (concat midge-midi-player " " file "&"))) (shell-command command))) (defun midge-play-ask-foreground (file) "play the midi file chosen by the user in the foreground." (interactive "fMidi file: ") (let ((command (concat midge-midi-player " " file))) (shell-command command))) (defun midge-decompile (file) "Decompile the midi file chosen by the user into a new buffer." (interactive "fMidi file: ") (message (concat "decompiling " file " in background...")) (sleep-for 2) (let ((command (concat midge-decompiler " -o - " file "&"))) (shell-command command "*midi2mg output*"))) (defcustom midge-scale-alist '(("Major" . "major") ("Minor" . "minor") ("Modes..." ("Ionian (major)" . "ionian") ("Dorian" . "dorian") ("Phrygian" . "phrygian") ("Lydian" . "lydian") ("Mixolydian" . "mixolydian") ("Aeolian" . "aeolian") ("Locrian" . "locrian")) ("Jazz/Blues..." ("Harmonic Minor" . "minor_harmonic") ("Jazz Minor (ascending melodic minor)" . "minor_jazz") ("Bebop" . "bebop") ("Bebop Dorian" . "bebop_dorian") ("Bebop Mixolydian" . "bebop_mixolydian") ("Minor Pentatonic" . "minor_pentatonic") ("Major Pentatonic" . "major_pentatonic")) ("Misc..." ("Chromatic (half tone)" . "chromatic") ("Whole Tone" . "whole_tone") ("Arabian" . "arabian") ("Spanish" . "spanish") ("Gypsy" . "gypsy"))) "" :group 'midge :type `(repeat (choice (cons :tag "Scale group" (string :tag "Group name") (repeat (cons :format "%v" (string :tag "Verbose name") (choice :tag "Scale name" ,@(mapcar (lambda (s) (list 'const s)) midge-scale-names) (string :tag "Undefined"))))) (cons :tag "Scale mapping" (string :tag "Verbose name") (string :tag "Scale name"))))) (defun midge-select (alist prompt &optional alt-prompt) "Allow the user to choose something interactively." (let* ((completion-ignore-case t) (family (cdr (assoc (completing-read prompt alist) alist)))) (cond ((and family (listp family)) (let ((sym (cdr (assoc (completing-read (or alt-prompt prompt) family) family)))) (and sym (insert sym)))) ((stringp family) (insert family))))) (defun midge-select-scale () "Allow the user to choose a scale interactively." (interactive) (midge-select midge-scale-alist "Select sclae (`TAB' for a list): ")) (defcustom midge-drum-alist '(("Bass & Snare Drums" ("Acoustic Bass Drum" . "bd_ac") ("Bass Drum" . "bd") ("Acoustic Snare" . "sd_ac") ("Electric Snare" . "sd_el")) ("Cymbals" ("Closed Hi-Hat" . "hh_c") ("Pedal Hi-Hat" . "hh_p") ("Open Hi-Hat" . "hh_o") ("Crash Cymbal 1" . "cym_crash") ("Crash Cymbal 2" . "cym_crash_2") ("Ride Cymbal 1" . "cym_ride") ("Ride Cymbal 2" . "cym_ride_2") ("Chinese Cymbal" . "cym_chinese") ("Splash Cymbal" . "cym_splash")) ("Toms" ("Low Floor Tom" . "ftom_l") ("High Floor Tom" . "ftom_h") ("Low Tom" . "tom_l") ("Low Mid Tom" . "tom_lm") ("High Mid Tom" . "tom_hm") ("High Tom" . "tom_h")) ("Bongos & Congas etc." ("High Bongo" . "bongo_h") ("Low Bongo" . "bongo_l") ("Mute High Conga" . "conga_h_mute") ("Open High conga" . "conga_h_open") ("Low Conga" . "conga_l") ("High Timbale" . "timbale_h") ("Low Timbale" . "timbale_l")) ("Bells & Whistles etc." ("Ride Bell" . "ride_bell") ("Cowbell" . "cowbell") ("High Agogo" . "agogo_h") ("Low Agogo" . "agogo_l") ("Muted Triangle" . "tri_mute") ("Open Triangle" . "tri_open") ("Short Whistle" . "whistle_sh") ("Long Whistle" . "whistle_lg")) ("Misc" ("Side Stick" . "stick") ("Hand Clap" . "clap") ("Tambourine" . "tamb") ("Vibraslap" . "vibraslap") ("Cabasa" . "cabasa") ("Maracas" . "maracas") ("Short Guiro" . "guiro_sh") ("Long Guiro" . "guiro_lg") ("Claves" . "claves") ("High Wood Block" . "wood_h") ("Low Wood Block" . "wood_l") ("Muted Cuica" . "cuica_mute") ("Open Cuica" . "cuica_open"))) "" :group 'midge :type `(repeat (choice (cons :tag "Percusion group" (string :tag "Group name") (repeat (cons :format "%v" (string :tag "Verbose name") (choice :tag "GM name" ,@(mapcar (lambda (s) (list 'const s)) midge-drum-names) (string :tag "Undefined"))))) (cons :tag "Drum mapping" (string :tag "Verbose name") (string :tag "GM name"))))) (defun midge-select-drum () "Allow the user to choose a drum interactively." (interactive) (midge-select midge-drum-alist "Select percusion group (`TAB' for a list): " "Select instrument: ")) (defcustom midge-patch-alist '(("Pianos" ("Acoustic Grand Piano" . "piano_grand_ac") ("Bright Acoustic Piano" . "piano_br") ("Electric Grand Piano" . "piano_grand_el") ("Honky Tonk Piano" . "piano_ht") ("Electric Piano 1" . "piano_el_1") ("Electric Piano 2" . "piano_el_2") ("Harpsichord" . "harpsichord") ("Clavinet" . "clavinet")) ("Chromatic Percussion" ("Celesta" . "celesta") ("Glockenspiel" . "glockenspiel") ("Music Box" . "music_box") ("Vibraphone" . "vibraphone") ("Marimba" . "marimba") ("Xylophone" . "xylophone") ("Tubular Bells" . "tubular_bells") ("Dulcimer" . "dulcimer")) ("Organs" ("Drawbar Organ" . "organ_dbar") ("Percussive Organ" . "organ_perc") ("Rock Organ" . "organ_rock") ("Church Organ" . "organ_church") ("Reed Organ" . "organ_reed") ("Accoridan" . "accordian") ("Harmonica" . "harmonica") ("Tango Accordian" . "accordian_tango")) ("Guitars" ("Nylon String Guitar" . "guitar_nylon") ("Steel String Guitar" . "guitar_steel") ("Electric Jazz Guitar" . "guitar_jazz") ("Electric Clean Guitar" . "guitar_clean") ("Electric Muted Guitar" . "guitar_muted") ("Overdriven Guitar" . "guitar_od") ("Distortion Guitar" . "guitar_dist") ("Guitar Harmonics" . "guitar_harm")) ("Basses" ("Acoustic Bass" . "bass_ac") ("Electric Bass (finger)" . "bass_fg") ("Electric Bass (pick)" . "bass_pick") ("Fretless Bass" . "bass_fless") ("Slap Bass 1" . "bass_slap_1") ("Slap Bass 2" . "bass_slap_2") ("Synth Bass 1" . "bass_syn_1") ("Synth Bass 2" . "bass_syn_2")) ("Solo Strings" ("Violin" . "violin") ("Viola" . "viola") ("Cello" . "cello") ("Contrabass" . "contrabass") ("Tremolo Strings" . "str_trem") ("Pizzicato Strings" . "str_pizz") ("Orchestral Strings" . "str_orch") ("Timpani" . "timpani")) ("String Ensembles" ("String Ensemble 1" . "str_ens_1") ("String Ensemble 2" . "str_ens_2") ("SynthStrings 1" . "str_syn_1") ("SynthStrings 2" . "str_syn_2") ("Choir Aahs" . "choir_aahs") ("Voice Oohs" . "voice_oohs") ("Synth Voice" . "voice_syn") ("Orchestra Hit" . "orch_hit")) ("Brass" ("Trumpet" . "trumpet") ("Trombone" . "trombone") ("Tuba" . "tuba") ("Muted Trumpet" . "trumpet_muted") ("French Horn" . "horn_fr") ("Brass Section" . "brass") ("SynthBrass 1" . "brass_syn_1") ("SynthBrass 2" . "brass_syn_2")) ("Reed" ("Soprano Sax" . "sax_sop") ("Alto Sax" . "sax_alt") ("Tenor Sax" . "sax_ten") ("Baritone Sax" . "sax_bar") ("Oboe" . "oboe") ("English Horn" . "horn_en") ("Bassoon" . "bassoon") ("Clarinet" . "clarinet")) ("Pipe" ("Piccolo" . "piccolo") ("Flute" . "flute") ("Recorder" . "recorder") ("Pan Flute" . "flute_pan") ("Blown Bottle" . "bottle") ("Skakuhachi" . "skakuhachi") ("Whistle" . "whistle") ("Ocarina" . "ocarina")) ("Synth Leads" ("Lead 1 (square)" . "lead_sq") ("Lead 2 (sawtooth)" . "lead_saw") ("Lead 3 (calliope)" . "lead_calliope") ("Lead 4 (chiff)" . "lead_chiff") ("Lead 5 (charang)" . "lead_charang") ("Lead 6 (voice)" . "lead_voice") ("Lead 7 (fifths)" . "lead_fifth") ("Lead 8 (bass+lead)" . "lead_basslead")) ("Synth Pads" ("Pad 1 (new age)" . "pad_new_age") ("Pad 2 (warm)" . "pad_warm") ("Pad 3 (polysynth)" . "polysynth") ("Pad 4 (choir)" . "pad_choir") ("Pad 5 (bowed)" . "pad_bowed") ("Pad 6 (metallic)" . "pad_metal") ("Pad 7 (halo)" . "pad_halo") ("Pad 8 (sweep)" . "pad_sweep")) ("Synth Effects" ("FX 1 (rain)" . "fx_rain") ("FX 2 (soundtrack)" . "fx_strack") ("FX 3 (crystal)" . "fx_crystal") ("FX 4 (atmosphere)" . "fx_atmos") ("FX 5 (brightness)" . "fx_bright") ("FX 6 (goblins)" . "fx_goblin") ("FX 7 (echoes)" . "fx_echo") ("FX 8 (sci-fi)" . "fx_scifi")) ("Ethnic" ("Sitar" . "sitar") ("Banjo" . "banjo") ("Shamisen" . "shamisen") ("Koto" . "koto") ("Kalimba" . "kalimba") ("Bagpipe" . "bagpipe") ("Fiddle" . "fiddle") ("Shanai" . "shanai")) ("Percussive" ("Tinkle Bell" . "bell_tinkle") ("Agogo" . "agogo") ("Steel Drums" . "drum_steel") ("Woodblock" . "woodblock") ("Taiko Drum" . "drum_taiko") ("Melodic Tom" . "tom_melodic") ("Synth Drum" . "drum_syn") ("Reverse Cymbal" . "cymbal_rev")) ("Sound Effects" ("Guitar Fret Noise" . "fx_fret") ("Breath Noise" . "fx_breath") ("Seashore" . "fx_sea") ("Bird Tweet" . "fx_tweet") ("Telephone Ring" . "fx_phone") ("Helicopter" . "fx_copter") ("Applause" . "fx_applause") ("Gunshot" . "fx_gun"))) "A mapping from verbose instrument names to GM patch names." :group 'midge :type `(repeat (choice (cons :tag "Instrument group" (string :tag "Group name") (repeat (cons :format "%v" (string :tag "Verbose name") (choice :tag "GM name" ,@(mapcar (lambda (s) (list 'const s)) midge-instrument-names) (string :tag "Undefined"))))) (cons :tag "Instrument mapping" (string :tag "Verbose name") (string :tag "GM name"))))) (defun midge-select-patch () "Allow the user to choose a patch interactively." (interactive) (midge-select midge-patch-alist "Choose patch family (`TAB' for a list): " "Instrument: ")) (defvar midge-menu (list "Midge" (list "Block..." ["head" midge-head-block t] ["body" midge-body-block t] ["channel" midge-channel-block t] "-" ["define" midge-define-block t] ["repeat" midge-repeat-block t] ["bend" midge-bend-block t] ["choose" midge-choose-block t] ["chain" midge-chain-block t] ["tuplet" midge-tuplet-block t] ) (list "Line..." ["repeat" midge-repeat-line t] ["bend" midge-bend-line t] ["choose" midge-choose-line t] ["chain" midge-chain-line t] ["tuplet" midge-tuplet-line t] ) (list "value..." ["tempo" midge-insert-tempo t] ["time sig" midge-insert-time-sig t] ["volume" midge-insert-volume t] ["pan" midge-insert-pan t] ["reverb" midge-insert-reverb t] ["chorus" midge-insert-chorus t] ) "-" ["Drum" midge-select-drum t] ["Patch" midge-select-patch t] ["Scale" midge-select-scale t] "-" (list "Compile..." ["Simple" midge-compile t] ["Verbose" midge-compile-verbose t] ["Debug" midge-compile-debug t] ["Prompt for args" midge-compile-ask t] ) (list "Play..." ["Current foreground" midge-play-foreground t] ["Current background" midge-play-background t] ["Prompt foreground" midge-play-ask-foreground t] ["Prompt background" midge-play-ask-background t] ) ["Decompile" midge-decompile t])) (when midge-use-menus (require 'easymenu) (easy-menu-do-define 'midge-menu1 midge-mode-map "Menu for midge-mode." midge-menu)) (defun midge-mode () "Midge mode, for writing midge(1) source files. \\{midge-mode-map}" (interactive) (kill-all-local-variables) (set-syntax-table midge-mode-syntax-table) (set (make-local-variable 'comment-start) "# ") (set (make-local-variable 'comment-start-skip) "#+\\s-*") (set (make-local-variable 'indent-line-function) #'midge-indent-line) (set (make-local-variable 'font-lock-defaults) '(midge-font-lock-keywords)) (setq major-mode 'midge-mode) (setq mode-name "Midge") (use-local-map midge-mode-map) (setq tab-width 4) (run-hooks 'midge-mode-hook)) (provide 'midge-mode) ;;; midge-mode.el ends here midge-0.2.41/midge.10000644000076400007640000005256710457003212012473 0ustar davedave.TH MIDGE 1 "17 July 2006" .SH NAME midge - generate midi file from text description of music .SH SYNOPSIS \fBmidge\fR [options] [filename] .SH DESCRIPTION \fBmidge\fR generates a type 1 midi file from a text description of music. \fBmidge\fR takes it's input from stdin unless \fBfilename\fR is specified. .SH OPTIONS .HP \fB-h or --help\fR .IP Show help text. .HP \fB--version\fR or \fB--warranty\fR or --\fBabout\fR .IP Show version and license info. .HP \fB-v\fR or \fB--verbose\fR .IP Print verbose output to stdout. .HP \fB-d\fR or \fB--debug\fR .IP Print debugging output to stdout (sets verbose mode automatically). .HP \fB-q\fR or \fB--quiet\fR .IP Quiet. no stdout. .HP \fB-o file\fR or \fB--outfile file\fR .IP Midi output to \fBfile\fR. Otherwise to a.out.mid .HP \fB-c\fR or \fB--check\fR .IP Check input only; No midi output. .HP \fB-u\fR or \fB--unroll-loops\fR .IP Unroll all the repeat blocks before parsing and save the unrolled source code to a new file (*.long.mg). Should be set automatically if needed. .HP \fB-U\fR or \fB--no-unroll-save\fR .IP Don't save unrolled source to file. .HP \fB-R\fR or \fB--no-reset\fR .IP Don't insert `reset all controllers' event at start of tracks. .HP \fB-t bpm\fR or \fB--tempo bpm\fR .IP Set tempo to \fBbpm\fR beats per minute, overriding value set in input file. .HP \fB-b steps\fR or \fB--bend-steps steps\fR .IP Set the number of steps per quarter note for the simple bend syntax. .HP \fB--unsafe\fR .IP Do not use Safe.pm to run Perl code from \fB%eval\fR blocks. .HP \fB-s number\fR or \fB--seed number\fR .IP Use \fBnumber\fR as the seed for the random number generator. .HP \fB-S [scale [root]]\fR or \fB--show-scale [scale [root]]\fR .IP List notes in \fBscale\fR starting from \fBroot\fR. If \fBroot\fR is omitted c4 is used. If \fBscale\fR is omitted, a list of suported scales is shown. .HP \fB-I path\fR or \fB--include path\fR .IP Add \fBpath\fR to include paths. Can be specified multiple times or \fBpath\fP can be a list separated by colons or commas. .SH INPUT LANGUAGE Sample source file to play a scale of E. ================start file====================== # this line is a comment \fB@head\fR { # there must be exactly 1 @head section # set time signature \fB$time_sig\fR 4/4 # set tempo in BPM \fB$tempo\fR 120 } # end of @head section \fB@body\fR { # there must be exactly 1 @body section # start a music track on channel 1 # multiple tracks can use the same channel \fB@channel\fR 1 { # set patch to electric bass \fB$patch\fR 34 # notes. see below for explanation. /l4/e3 # quarter note e in third octave f\fB+\fR # f sharp same octave same length # use `\fB-\fR' for flat g+ a b # rest of notes c+\fB4\fR d+ e # octave changes at c } # end of track } # end of @body section ========================end file==================== More examples are included in the examples/ directory of the archive. In the following, is a required parameter and [name] is an optional parameter. Notes. The format of a note is: [\fB/options/\fR]<\fBname\fR>[\fB+\fR|\fB-\fR][\fBoctave\fR] The \fB/options/\fR section can contain the following: \fBl\fR[numerator:] Sets the length of the note to (\fBnumerator\fR or one) divided by \fBdenominator\fR. ie. l4 = quarter note, l1 = whole note, l3:4 = 3/4 note (3 quarter notes tied). An uppercase `\fBL\fR' may be used instead to distinguish it from a `1'. \fBr\fR Sets the number of times to repeat the note. For example /\fBl\fR8\fBr\fR16/ makes the note duration 1/8 and repeats the note 16 times. \fBa\fR Sets the note's note on velocity (attack) \fBd\fR Sets the note's note off velocity (decay) \fBz\fR[+|-][%] Offsets the note by \fBnumber\fR midi clicks. Positive values play the note late and negative values play it early. If \fBnumber\fR is followed by a \`\fB%\fR\' character it is taken as a percentage of the current note length. Offset values are \fBnot\fR inherited by subsequent notes. \fBZ\fR[+|-][%] As the above \`\fBz\fR\' option but a random value is used. If \fBnumber\fR is negative or positive (plus sign \fBrequired\fR), a value between zero and \fBnumber\fR is used. If there is no sign, a value between plus and minus \fBnumber\fR is used. The offset option will not work with the \fBr\fRepeat note option, but the same effect can be achieved using a \fB%repeat\fR block. Notes cannot be offset backwards (ie played early) unless they are preceded by a rest. To work around this I have added the \fB$shorten\fR keyword, described below. See also \fB$unquantise\fR. \fBname\fR is the name of the note ie. [a-g] \fBrequired\fR. \fB+\fR sharp. \fB-\fR flat. \fBoctave\fR is the midi octave ie. [1-11]. Although most midi software uses 0 for the lowest octave, I have used 1 for consistency with the midi channels and instrument names which both count from 1. If not specified, the length, octave, attack and decay are inherited from the previous note. In a drum track, instead of the note names, aliases can be used. For example, to get an open hi hat, instead of `\fBf+3\fR' you can use `\fBhh_o\fR'. See README.drums for a full list of aliases. Rests. Rests are written as note `\fBr\fR', with \fB/options/\fR the same as for notes, but with only the length and repeat options used. The length value is inherited from note to rest and vice versa. Bars. The pipe symbol (`|') can be used to denote bars. The lengths of bars are not checked -- this is only to allow more readable source files. Bars can be numbered by appending a number to the pipe symbol. They may be separated by an underscore but not by spaces. Simple bar example: | c d e f | g a b c Numbered bar examples: |1 c d e f |2 g a b c |_1 c d e f |_2 g a b c The consistency of bars can be checked by using the \fB$bar_strict\fR keyword in the \fB@head\fR section. This gives an error or warning unless all tracks have the same number of bars and numbered bars appear at the same time in each track: $bar_strict \fBwarn\fR # Print a warning message for inconsistent bars. $bar_strict \fBerror\fR # Exit with an error message for inconsistent bars. Top level keywords. \fB@head\fR { content } There must be exactly one \fB@head\fR section. See below for description of \fBcontent\fR. \fB@body\fR { content } There must be exactly one \fB@body\fR section. See below for description of \fBcontent\fR. Keywords in the \fB@head\fR section. \fB$time_sig\fR The \fBb\fR value must be one of 4, 8, 16, 32, 64. \fB$tempo\fR \fBt\fR is the tempo in BPM. Both \fB$time_sig\fR and \fB$tempo\fR are also allowed within an @channel block (described below). \fB$title\fR Sets the title of the song to \fBtitle\fR. If \fBtitle\fR contains spaces it must be inside double quotes. \fB$resolution\fR <n> Sets the number of midi clicks per quarter note to \fBn\fR. The default is 96. Keywords in the \fB@body\fR section. \fB%define\fR <name> { notes } Define a sequence of \fBnotes\fR, assigning it to \fBname\fR to be recalled in a music track. Defined sequences are used by including: \fB~\fR<name>[/transpose/] within a track to include the sequence \fBname\fR, transposed by \fBtranspose\fR semitones. Previously defined sequences can be used in subsequent \fB%define\fR blocks. for instance: \fB%define\fR a_riff { a3 a c4 d } \fB%define\fR d_riff { d4 d f g } \fB%define\fR main_riff { \fB~\fRa_riff \fB~\fRd_riff } Although we could achieve the same result by transposing the first riff to make the second: \fB%define\fR a_riff { a3 a c4 d } \fB%define\fR main_riff { \fB~\fRa_riff \fB~\fRa_riff\fB/5/\fR } \fBdefine\fR blocks may also contain repeat blocks, bend blocks and $volume/patch/reverb etc. \fB@channel\fR <number> [name] { content } Begin a midi track on channel \fBnumber\fR, optionally setting the instrument name to \fBname\fR. If \fBname\fR contains spaces it must be inside double quotes. \fBcontent\fR can include notes, rests, previously defined sequences, and the following keywords: \fB$time_sig\fR <a/b> Changes the time signature for the song (affects all tracks). The \fBb\fR value must be one of 4, 8, 16, 32, 64. \fB$tempo\fR <t> Changes the song tempo (affects all tracks). \fBt\fR is in BPM. \fB$patch\fR [[bank_LSB,]bank_MSB,]<number|name> Set patch number for this channel to \fBnumber\fR or \fBname\fR. Where \fBnumber\fR is from 1 to 128 and \fBname\fR is an alias as defined in README.patches. Optionally select bank number \fBbank_MSB\fR. Optionally select bank LSB number \fBbank_LSB\fR (used for external midi keyboards). Each value must be in the range 1-128. \fB$bank\fR [LSB,]<MSB> Select bank number \fBMSB\fR. Optionally setting the LSB value (used for external midi keyboards) to \fBLSB\fR. Both values must be in the range 1-128. \fB$length\fR [n:]<d> Set default note length. The value is specified in the same format as in the note options. \fB$shorten\fR <number> Shorten each note by \fBnumber\fR midi clicks, to allow space for notes to be offset backwards. \fB$unquantise\fR [+|-]<number>[%] Apply a random offset to each note. \fBnumber\fR has the same meaning as for the \fBZ\fR note option above. \fB$octave\fR <number> Set default octave to \fBnumber\fR \fB$volume\fR <number> Set the track volume to \fBnumber\fR \fB$attack\fR <number> Set the note's attack to \fBnumber\fR \fB$decay\fR <number> Set the note's decay to \fBnumber\fR \fB$reverb\fR <number> Set the reverb depth to \fBnumber\fR on the current channel. \fB$chorus\fR <number> Set the chorus depth to \fBnumber\fR on the current channel. \fB$pan\fR <number> Set the pan value to \fBnumber\fR. 0 is left 127 is right. The volume, attack, decay, reverb, chorus and pan values must be integers from 0 to 127. They can also be specified as a range (eg `\fB8-64\fR'), in which case a random value within the range is used. \fB%pan_all\fR { note value ... } Sets the pan value for each subsequent instance of \fBnote\fR in the current track. This is mainly intended for panning a drum kit, but could be used on another track. \fBvalue\fR can be an integer or a range (eg `\fB8-64\fR'). Multiple \fBnote value\fR pairs are allowed. If two notes with different pan_all values are played at the same time anything could happen. To affect every note in the channel with a range, use `\fB*\fR' or `\fBany\fR' for \fBnote\fR. The \fB/r4/\fR<note> method of repeating notes will not work with this option, but the same effect can be achieved using a repeat block. \fB$marker\fR <text> Adds a marker event with \fBtext\fR as it's content. If \fBtext\fR contains spaces it must be quoted using double-quote characters. \fB%repeat\fR <number> { notes } Repeat \fBnotes number\fR times. \fBnotes\fR can include notes, rests, predefined sequences and other \fB%repeat\fR blocks. \fB%bend\fR <note> { event ... } Play \fBnote\fR and move the pitch wheel in the manner described by multiple \fBevent\fRs, which have the following format: [n:]<d><+|-><value> where \fBn\fR and \fBd\fR specify the time from the start of the note or from the previous event, in the same format as the note lengths, and \fBvalue\fR is the amount to bend the note by (the plus or minus sign is required). With the default pitch wheel range of +/- 2 semitones a value of 32 equates to one semitone. Note that the bend amount is relative. The maximum \fBcumulative\fR bend amount is plus or minus 64. For example the following: %bend a3 { 4+32 4-32 2+0 } Plays the note a3 for 1/4 note, bends up a whole tone for 1/4 then returns down to a3 and holds for 1/2 note. \fB$bend_range\fR <number> Changes the pitch wheel range to +/- \fBnumber\fR. This sets the maximum bend up and down, so if it is set to 4, a bend value of 64 will bend up 4 semitones and -64 will bend down 4 semitones. The default range for most midi devices is 2 semitones. \fB$pitch\fR <val> Set the pitch wheel value to \fBval\fR. This can be used in conjunction with separate note on and note off events (see below under `simultaneous notes') to create complex bending effects. Unlike the \fB%bend\fR syntax above, this does \fBnot\fR reset the pitch wheel to the neutral position (64) Simpler pitch bends can be created with this syntax: /l8/e4\fB=>\fRg4\fB=>\fRe4 This bends from e4 up to g4 and back down to e4 in linear steps over the duration of an eighth note. By default there are 16 steps per quarter note duration (8 steps in this example), but a different value can be set using the `-b' command line switch. Any number of notes can be used, but the first one must have a length value and each of them must have an octave value. \fB%choose\fR [time] { weighting item ... } where time is a length value in the format [n:]<d> the same as used in the length options, with the `l' omitted. If \fBtime\fR is not specified: Choose one \fBitem\fR from a list, where each \fBitem\fR can be a note, rest, or predefined riff, and each item has a \fBweighting\fR which defines how likely it is to be chosen. For example: %choose { 2 a3 4 c5 3 e4 1 g3 } gives a3 a 20% chance, c5 - 40% ; e4 - 30% and g3 - 10% Each item \fBmust\fR have a weighting. See also scales below. if \fBtime\fR is specified: Choose multiple \fBitem\fRs from the list up to a length of \fBtime\fR. If all the \fBitem\fRs are too long to end the riff exactly at \fBtime\fR, the remainder is filled with a rest. When choose is used in this way each note or rest must have a length value and any predefined riffs used must have a fixed length (ie the first note must have a length value), and the length of the whole riff must be specified in the choose block in the same format as for notes. for example: %define riff_1 { /l2/a3 /l4/b c4 } # riff is 1 bar long %choose \fB4:1\fR { # choose 4 bars 1 /l8/d4 3 /l8/e4 2 /l4/g4 1 \fB/l1/~riff_1\fR } If \fBtime\fR is \fB0\fR or \fB-\fR then midge looks for a block of the form: \fBrhythm\fR { n[:d] ... } which is taken as a series of note length values for which the pitches are chosen from the list. Other tokens are passed through, so you can insert specific notes, predefined riffs or rests. Any token in the block begining with an underscore will be passed through, with the underscore removed. See examples/tutorial/choose_scale.mg for an example. Another way to specify the list of notes/weightings is with the \fBscale\fR keyword: \fBscale\fR minor /l8/g4-6 [ weight ... ] This selects a G Minor scale from the 4th to 6th octaves (ie g4 to g6). The length value is unnecesary if you are using a rhythm block. If the \fB-6\fR is omitted a single octave is used. The weight block specifies the note weightings in order. If omitted all weightings are equal. To ingore a note use a weighting of 0, but there \fBmust\fR be a weighting for each note if the block is present at all. The \fB-S\fR switch can be used to show the notes in a scale or a list of supported scales. \fB%chain\fR <time> { start <note> note1 [ weight note ... ] ... rhythm [ weight length ... ] \fBor\fR rhythm { length ... } } Define a `chain' structure where for each note there is a weighted list of notes which may follow it. A starting point is picked randomly from all the notes used, or specified with the \fBstart\fR keyword, and then subsequent notes are chosen from the appropriate list up to a total length of \fBtime\fR. The \fBrhythm\fR keyword has two forms: Using square brackets `[]', a weighted list of note lengths can be defined, which will be chosen from randomly. Using braces `{}', a list of length values can be defined which will be used in sequence (repeating as neccessary). To play through the rhythm block just once, set the \fBtime\fR to \fB0\fR or \fB-\fR. In this case the rhythm block is parsed in the same way as described above for \fB%choose\fR with time set to zero. The keyword \fBtimes\fR can be used as a synonym for \fBrhythm\fR. The \fBstart\fR keyword specifies the note to start from when using the chain. If \fBstart\fR is omitted, the start note is chosen randomly. Another way define the notes in a \fBchain\fR block is to use one of the built in scales. Then the weightings are specified in the form of a matrix, with a row for each "from" note (one for each note of the scale) and a column for each "to" note. An example of this form can be found in the file examples/tutorial/chain_scale.mg To use the choose or chain blocks, the file must be compiled with the unroll-loops option (it is set automatically when a choose or chain block is found). This option saves the unrolled source code in a new file, so if it produces particularly good output you have an exact copy which you can make other changes to without losing the generated track. Note that a choose and chain blocks cannot be inside a %define or inside another choose or chain block. \fB%eval\fR { Perl code } Run a block of Perl code and replace the %eval block with the value returned from the Perl code. \fB%eval -\fR { Perl Code } Run a block of Perl code without reading the return value. Perl code is run using the Safe module if it is present, with :base_core, :base_math and :base_mem allowed. If Safe.pm is not available or more permissions are needed the --unsafe option causes midge to run the %eval blocks in it's own perl process. Keywords allowed at any point in the source. \fB%include\fR <file> Includes the contents of \fBfile\fR as if they had been written at that point in the source file. \fBMust\fR be on a line of it's own in the source file. Simultaneous Notes. The most flexible way to play simultaneous notes is by using separate tracks (you can use the same channel/patch), or by using separate note on and note off events (see below). However, there is a simpler way with some limitations. For example: \fB( c e g )\fR will play the notes c, e and g simultaneously, making a C chord. The length of all the simultaneous notes is the same as the first one (determined by it's own length value or the one inherited from the previous note, rest, or $length declaration. One way to use this to make chords is as follows: \fB%define minor { ( c e- g ) }\fR # define minor to be a c-minor \fB%define major { ( c e g ) }\fR # define major to be a c-major \fB%define 7th { ( c e g b- ) }\fR # define 7th to be a c-7th Then you can use the in your music tracks: $length 4 $octave 4 # set default length and octave \fB~major\fR # play a c-major \fB~minor/9/\fR # play an a-minor \fB~7th/5/\fR # play an f-7th To make chords sound strummed, the \fBstrum\fR keyword can be used: \fB$strum\fR 5 This sets the interval between each note in subsequent chords to 5 midi clicks. To create complex patterns of simultaneous notes on one track, separate note on and note off events can be used. These are specified in the same way as normal notes, but with a \fB+\fR prepended for note on and a \fB-\fR prepended for note off. The length and repeat options cannot be used. The length of notes entered this way is controlled by putting rests or other notes between the note on and note off events. eg: \fB+\fRc4 /l4/r \fB+\fRe r \fB+\fRg /l2/r \fB-\fRc \fB-\fRe \fB-\fRg plays and holds c4, after a 1/4 note plays and holds e4 and after another 1/4 note plays and holds g4, releasing all three after a further 1/2 note. Tuplets. While it is possible to create tuplets by choosing a suitable note length, they can also be written in a more conventional way using the \fB%tuplet\fR keyword: \fB%tuplet\fR n:d { notes... } plays \fBn\fR notes in the space of \fBd\fR. \fBnotes\fR can contain anything allowed in a @channel block. The note values are then automatically altered to create the tuplet. For example: %tuplet 5:3 { /l8/e4 f g f e } plays five eigth notes in the space of three. Tuplets can be nested to any depth. See examples/tutorial/tuplet.mg for an example. Midge does \fBnot\fR check that the length of music inside the tuplet block is correct. Keys. If you want to import your midi file into a notation editor you will want to set the key. This is done with: \fB$key\fR <name>[+|-][m] Where \fBname\fR is a-g, +|- are sharp and flat, and m is minor. If the whole piece stays in the same key you can set it in the @head section, otherwise it can appear anywhere in a @channel section, and will affect all tracks. If you are used to regular music notation and want notes to be sharp or flat automatically depending on the key, use the \fB$key_strict\fP keyword instead. To get a natural note use the \fB=\fP sign, eg in G, \fBf=\fP plays an f natural. The \fB$key_strict\fP keyword can only be used in the @head section. The key can still be changed using the regular \fB$key\fP keyword. \fB$ctrl\fR <num,val> Set controller number \fBnum\fR to \fBval\fR. \fB$rpn\fR [num-msb,]<num-lsb,val-msb>[,val-lsb] Set the rpn controller \fBnum\fR to \fBval\fR \fB$nrpn\fR [num-msb,]<num-lsb,val-msb>[,val-lsb] Set the nrpn controller \fBnum\fR to \fBval\fR \fB%verbatim\fR { byteval... } Insert a string of bytes into the midi file. Each \fBbyteval\fR can be in either decimal (0-255) or hex (0x00-0xFF). The keyword \fBbytes\fR can be used instead of \fBverbatim\fR. \fB$print\fR <text> Print \fBtext\fR to stdout. If \fBtext\fR contains spaces it must be quoted using double quotes (\fB"\fR). .SH BUGS When building scales, although the pitches are correct, the note names may be technically wrong, eg `a sharp' instead of `b flat'. If there is an error in a %repeat or %define block the error message only gives the line number of the %repeat or %define keyword. No commercial potential. If you find any other bugs, please let me know. .SH "SEE ALSO" midi2mg(1), emacs(1), playmidi(1), drvmidi(1), timidity(1). .SH AUTHOR David Riley <dave@dmriley.demon.co.uk> �����������������������������������������������������������������������������������������������������������������������������������������midge-0.2.41/midge.pl�������������������������������������������������������������������������������0000644�0000764�0000764�00000510132�10457003212�012731� 0����������������������������������������������������������������������������������������������������ustar �dave����������������������������dave�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; ############################################################################# ## ## ## midge - generate a midi file from text description of music ## ## ## ## usage: midge [options] [infile] ## ## ## ## see `--help' output or man page for list of options ## ## ## ## author: David Riley <dave@dmriley.demon.co.uk> ## ## ## ############################################################################# ## ## ## This program is free software; you can redistribute it and/or modify ## ## it under the terms of the GNU General Public License as published by ## ## the Free Software Foundation; either version 2 of the License, or ## ## (at your option) any later version. ## ## ## ## This program is distributed in the hope that it will be useful, ## ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## ## GNU General Public License for more details. ## ## ## ## You should have received a copy of the GNU General Public License ## ## along with this program; if not, write to the Free Software ## ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ## ## ## ############################################################################# ## ## Setup global variables ## # Version info my $progname = "midge"; my $version = "0.2.41"; my $year = "1999-2006"; my $author = "David Riley"; # Midi codes my $midi_header_tag = pack("CCCC", 0x4d, 0x54, 0x68, 0x64); my $midi_track_tag = pack("CCCC", 0x4d, 0x54, 0x72, 0x6b); my $midi_track_end = pack("CCC", 0xff, 0x2f, 0x00); my $midi_time_sig = pack("CC", 0xff, 0x58); my $midi_tempo = pack("CC", 0xff, 0x51); # Program related variables my @include_paths = qw( /usr/lib/midge /usr/share/midge /usr/local/lib/midge /usr/local/share/midge /opt/lib/midge /opt/share/midge ); @include_paths = grep -d $_, @include_paths; my $sandbox; # sandbox for running eval code my $seed; # seed for random number generator my $unroll_loops = 0; # whether loops should be unrolled my $error_quote_level = 8; # how many tokens to quote in an error message # File related variables my $infile; # input source file my $outfile; # output midi file my $source_outfile; # source output file (if $unroll_loops is set) # Command line option variables my $unroll_save = 1; # whether unrolled source should be saved to file my $check_only = 0; # whether midi output should not be written my $verbose = 0; # verbose output messages my $debug = 0; # debug output messages my $quiet = 0; # no output messages my $unsafe = 0; # whether to run eval code outside sandbox my $do_reset = 1; # whether to reset all controllers at track start # Lookup hashes my %patches; # list of patch name/number pairs my %drums; # list of drum/note pairs my %scales; # an array of intervals for each scale type my $relative_majors; # reference to hash to lookup relative majors # Song related variables my %header_info; # hash of data for midi header + other meta data my %tempo_track; # array used to build tempo track my @unroll; # which tracks need to be unrolled my $end_of_channel; # flag set when end of track is found my %riffs; # hash of user defined riffs (note patterns) my $strict_key = 0; # whether sharps/flats are implied by the key # by default they must be explicitly notated my $strict_bar = 0; # whether bar lines must be consistent between # tracks (by default, bar lines are silently # ignored) # Track related variables my %pan_all; # hash of note => pan_value my $last_pan = 64; # value of last pan event my $tempo; # tempo of track my $current_track_length; # current track length my $current_track_type = 0; # flag set for tempo tracks my @current_track_bars; # bar lines recorded in current track my $current_channel; # midi channel of current track my $current_instrument; # text name of current patch my $unquantise; # random offset used for each note my $strum; # 0-127 strummimg speed for chords my $bend_steps = 16; # number of steps per quarter note # for the simple bend syntax my $repeat_start_rest; # rest length at start of repeat block # needs to be global so all recursive # instances of get_repeat_bytes can use it # Note related variables my %old; # hash to hold old note related values; my $transpose; # number of semitones + or - to transpose by my $shorten; # number of midi clicks to shorten notes by # used to leave space for note offsets # Tuplet related variabbles my @tuplets; # stack of tuplet values my $tuplet = 1; # current tuplet value my $done_tuplet_warning = 0; # to prevent the warning being repeated. # Input token related variables my @tokens; # array to hold the source code my $current_token = -1; # token number used to match with line number my @line_refs; # used for mapping of tokens to line numbers my %riff_refs; # holds the starting line number for each riff # set initial %old values $old{'rest_length'} = 0; # accumulated rest length since last event $old{'note_length'} = 0; # length of previous note $old{'octave'} = 0; # octave of previous note # Ignore SIGPIPE $SIG{'PIPE'} = sub { 1; }; ############################################################################# ## # ## ## Run # ------------------## ## # _='| ## # -----='--|----|---## &get_options; # parse command line args | _| | ## &init_sandbox; # prepare sandbox for eval ----|--(@|---_|---## &init_patch_list; # set up patch list _| (_| ## &init_drum_list; # set up drum list --(@|-------------## &init_scales; # set up scale data ## &get_tokens($infile); # split input into tokens ------------------## # ## &init_rand; # seed random generator if needed _ ## &pre_parse; # check input and unroll loops if required {:} ## &write_source_file # write unrolled source file if required H ## if ($source_outfile); # H ## # _ H ## &make_midi_file; # generate midi data and write to file //\H/\ ## # \\ = / ## ## # //f-f\ ## ## End # \\_=_/ ## ## # ## ############################################################################# ########################################## ## ## ## @@@SECTION: Song related subroutines ## ## ## ########################################## ## ## generate midi file ## sub make_midi_file { my $data; # midi data to write my $header_data; # header data without length my $header_size; # header size my $header; # header including length my @tracks; # data for each track my $channel; # current channel my $counter; # track counter my $i; # loop counter my @bars; # bar line positions for each track # make header if ($verbose) { print "making header\n"; } $header_data = &make_header_content; $header_size = &get_data_size($header_data); $header = $midi_header_tag . $header_size . $header_data; # set initial tempo & time_sig in tempo track $tempo_track{'0'} = &get_tempo_bytes; if (defined $header_info{'time_sig'}) { $tempo_track{'0'} .= pack("C1", 0) . &get_time_sig_bytes; } # set key in tempo track if declared in head section if (defined($header_info{'key'})) { $tempo_track{'0'} .= pack("C1", 0) . &get_key_bytes($header_info{'key'}); } elsif (defined($header_info{'key_strict'})) { $header_info{'key'} = $header_info{'key_strict'}; $strict_key = 1; $tempo_track{'0'} .= pack("C1", 0) . &get_key_bytes($header_info{'key_strict'}); } # set title in tempo track if defined if ($header_info{'title'}) { print "writing title $header_info{'title'}\n" if $debug; $tempo_track{'0'} .= pack("C3", 0, 0xFF, 0x03) . &get_data_size($header_info{'title'}, 1) . $header_info{'title'}; } # make tracks if ($verbose) { print "making tracks\n"; } &find_body; $counter = 0; while (1) { &find_next_channel; if ($current_channel == -1) { last; } else { if ($verbose) { my $tnum = 1 + $counter; print "making channel $current_channel track $tnum\n"; } $end_of_channel = 0; $tracks[$counter] = &make_track_data; $bars[$counter] = [ @current_track_bars ]; if ($current_track_type eq 'tempo') { @tracks = @tracks[0..$counter-1]; $current_track_type = 0; next; } $counter++; } } # printf "DBG: got %s tracks\n", scalar @tracks; # check that bar lines are consistent across all tracks if ($strict_bar) { my $len = @{$bars[0]} / 2; TRACK: for (my $i = 1; $i<=@tracks-1; $i++) { my $thislen = @{$bars[$i]} / 2; if ($thislen != $len) { my $msg = "track " . ($i + 1) . " has $thislen " . "bar lines (track 1 has $len).\n"; if ($header_info{bar_strict} eq 'error') { die "Error: $msg"; } else { warn "Warning: $msg"; } last; } BAR: for (my $j = 0; $j<=@{$bars[0]}-1; $j++) { if ($bars[$i]->[$j] ne $bars[0]->[$j]) { my $k = int $j / 2; my $msg = "bar line " . ($k + 1) . " in " . "track " . ($i + 1) . " ($bars[$i]->[$k*2])" . " is inconsistent.\n"; if ($header_info{bar_strict} eq 'error') { die "Error: $msg"; } else { warn "Warning: $msg"; } last TRACK; } } } } # add MTrk and length bytes to tracks for ($i=0; $i<=@tracks-1; $i++) { $tracks[$i] = $midi_track_tag . &get_data_size($tracks[$i]) . $tracks[$i]; } # make tempo track my $tempo_track; my $pos = 0; foreach my $key (sort {$a <=> $b} keys(%tempo_track)) { $tempo_track .= &get_delta_time($key-$pos) . $tempo_track{$key}; $pos = $key; } $tempo_track .= pack("C", 0) . $midi_track_end; $tempo_track = $midi_track_tag . &get_data_size($tempo_track) . $tempo_track; # put them together if ($verbose) { print "putting tracks together\n"; } $data = $header . $tempo_track; foreach (@tracks) {$data .= $_;} # write file if ($check_only) { if (!$quiet) { print "input parses ok\n"; } } else { if ($verbose) { print "opening output file $outfile\n"; } open(OUTFILE, ">$outfile") || die "could not open $outfile for writing\n"; binmode(OUTFILE); select(OUTFILE); print "$data"; select(STDOUT); close(OUTFILE); print "midi output written to $outfile\n" unless $quiet; } } ## ## make a track ## sub make_track_data { my $data; # data to return my $token; # current token my $rpt; # repeat count my $block; # temp bytes for repeat # Reset variables $old{'rest_length'} = 0; $old{'note_length'} = 0; $old{'octave'} = 0; $old{'attack'} = 127; $old{'decay'} = 64; $tuplet = 1; undef %pan_all; $last_pan = 64; @current_track_bars = (); $current_track_length = 0; $shorten = 0; $unquantise = undef; # set instrument name if we have one if ($current_instrument) { $data .= pack("C3", 0, 0xff, 0x04) . &get_data_size($current_instrument, 1) . $current_instrument; } # insert a `reset all controllers' message $data .= pack("C4", 0, 0xaf + $current_channel, 121, 0) if $do_reset; # loop thru the tokens until end of channel while ($token = &get_next_token) { # print "DBG: token=$token\n"; # print '@@@ERROR@@@' . " transpose=$transpose\n" if $transpose != 0; $transpose = 0; # FIXME: this must be broken! $data .= &get_token_bytes($token); last if $end_of_channel; } if ($debug) { print "returning track data\n"; } $data .= pack("C", 0) . $midi_track_end; return $data; } ## ## create the main header data ## sub make_header_content { my $content; # data to return if ($debug) { print "make_header_content()\n"; } &parse_header_info; $content = pack("CC", 0, 1); # format 1 midi file $content .= pack("CC", 0, $header_info{'num_tracks'}); my $msb = int($header_info{'ticksperquarter'} / 256); my $lsb = int($header_info{'ticksperquarter'} % 256); $content .= pack("CC", $msb, $lsb); return $content; } ## ## write the tokens array out to a new source file ## sub write_source_file { unless ($unroll_save) { print 'not saving unrolled source', "\n" if $verbose; return; } my $line = 1; # current line of src file my $col = 0; # current column my $indent = 0; # current indent level my $i; # loop counter my @tmp; # temp array my $max = 60; # max cols before a newline open(SRC, ">$source_outfile") || die "$source_outfile: $!\n"; select(SRC); for ($i=0; $i<=@tokens-1; $i++) { if ($tokens[$i] eq '{') { print "{\n"; $line_refs[$i] .= " ($line in unrolled source)"; $line++; $col = 0; $indent++; } elsif ($tokens[$i] eq '}') { unless ($col == 0) { print "\n"; $line++; $col = 0; } $indent-- unless ($indent == 0); if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "}\n"; $line_refs[$i] .= " ($line in unrolled source)"; $line++; $col = 0; } elsif ($tokens[$i] =~ /^@/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $line_refs[$i] .= " ($line in unrolled source)"; $col += 1 + length $tokens[$i]; } elsif ($tokens[$i] =~ /^\$/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $line_refs[$i] .= " ($line in unrolled source)"; $i++; if ($tokens[$i] =~ /^\"/) { my ($j, $tmp); for ($j=$i; $j<=@tokens-1; $j++) { if ($tokens[$j] =~ /\"$/) { $tmp .= $tokens[$j]; $line_refs[$j] .= " ($line in unrolled source)"; $i = $j; last; } else { $tmp .= "$tokens[$j] "; $line_refs[$j] .= " ($line in unrolled source)"; } } print "$tmp\n"; } else { print "$tokens[$i]\n"; $line_refs[$i] .= " ($line in unrolled source)"; } $line++; $col = 0; } elsif ($tokens[$i] =~ /^\%/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $line_refs[$i] .= " ($line in unrolled source)"; $col += 1 + length $tokens[$i]; } elsif ($tokens[$i] eq '(') { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $line_refs[$i] .= " ($line in unrolled source)"; } elsif ($tokens[$i] eq ')') { print ")\n"; $line_refs[$i] .= " ($line in unrolled source)"; $line++; $col = 0; } else { if ($col > $max) { print "\n"; $line++; $col = 0; } if (($col == 0) && ($indent)) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $line_refs[$i] .= " ($line in unrolled source)"; $col += 1 + length $tokens[$i]; } } select(STDOUT); close(SRC); print "unrolled source written to $source_outfile\n" unless $quiet; } ########################################### ## ## ## @@@SECTION: Track related subroutines ## ## ## ########################################### ## ## save a riff as a string of tokens ## used by the %define keyword ## sub define_riff { my $riff_name; # name of riff to define my @tokens; # array to hold tokens my $token; # current token my $bracket = 0; # counts level of brackets $riff_name = &get_next_token || die "$line_refs[$current_token]: " . "missing riff name after \%define\n"; $riff_refs{$riff_name} = $line_refs[$current_token]; foreach (keys(%riffs)) { if ($_ eq $riff_name) { die "$line_refs[$current_token]: " . "duplicate riff name: $_\n"; } } if ($verbose) { print "defining riff \`$riff_name'\n"; } (&get_next_token eq '{') || die "$line_refs[$current_token]: " . "after \%define: expected '{' ; found $_\n"; while (defined ($token = &get_next_token)) { if ($token eq '{') { @tokens = (@tokens, $token); $bracket++; } elsif ($token eq '}') { if ($bracket == 0) { last; } else { @tokens = (@tokens, $token); $bracket--; } } elsif ($token eq '%choose') { die "$line_refs[$current_token]: " . "cannot use \%choose within a define\n"; } else { @tokens = (@tokens, $token); } } if ($debug) { print "define_riff() \@tokens = @tokens\n"; } $riffs{$riff_name} = join(" ", @tokens); } ## ## add the tokens for a predefined riff to the ## front of the tokens array ## sub prepend_riff_tokens { my $name = shift; # name of %defined riff my $transpose = shift; # number of semitones to transpose riff my @riff; # temp array to store riff my $note; # note name my $num; # note number my $riff_name; # name of nested riff my $riff_trans; # transpose value of nested riff my $i; # loop counter if ($debug) { print "prepend_riff_tokens(): looking for $name\n"; } if ($debug) { print "prepend_riff_tokens(): "; print " riff=$riffs{$name} \$transpose=$transpose\n"; } die "$line_refs[$current_token]: riff `$name' has not been defined\n" unless defined $riffs{$name}; @riff = split(/\s+/, $riffs{$name}); # Fix the line_refs my @tmp_refs = @line_refs[0..$current_token]; map $_ = $riff_refs{$name}, @tmp_refs[@tmp_refs..@tmp_refs + @riff - 1]; push @tmp_refs, @line_refs[$current_token+1..@line_refs - 1]; @line_refs = @tmp_refs; # transpose riff if (!($transpose == 0)) { for ($i=0; $i<=@riff - 1; $i++) { $note = $riff[$i]; # transpose note if ($note =~ /^[-+]?(\/.+\/)?[a-g]([-+=])?([0-9])?$/) { $num = $transpose + ¬e_to_int($note); $_ = $note; $note = &int_to_note($num); s/([-+]?\/.+\/)?[a-g]([-+=])?([0-9])?/$1$note/; $riff[$i] = $_; } # add to transpose value of nested riff if ($note =~ /^(~[^\/]+)(\/(-)?([0-9]+)\/)?/) { $riff_name = $1; $riff_trans = $4; if ($3) {$riff_trans = 0 - $4;} if (!$2) {$riff_trans = 0;} $riff_trans += $transpose; if ($riff_trans == 0) { $riff[$i] = $riff_name; } elsif ($riff_trans > 0) { $riff[$i] = $riff_name . '/' . $riff_trans . '/'; } else { $riff_trans = 0 - $riff_trans; $riff[$i] = $riff_name . '/-' . $riff_trans . '/'; } } } } @tokens = (@riff, @tokens); } ## ## parse a %pan_all block ## sub parse_pan_all { my $value; my $flag = 0; $_ = &get_next_token; unless ($_ eq '{') { die "$line_refs[$current_token]: expected `{' found $_\n"; } while (my $token = &get_next_token) { if ($token eq '}') { print 'PAN_ALL: got end of block\n' if $debug; $flag = 1; last; } if ($token eq '*') {$token = 'any';} $value = &get_next_token; unless (defined($value)) { die "$line_refs[$current_token]:" . " bad pan value $value after \%pan_all\n"; } $pan_all{$token} = $value; } unless ($flag) { die "$line_refs[$current_token]:" . " unexpected eof looking for \`}' in pan_all block\n"; } } ## ## return bytes from a token ## ie could be note, rest, repeat, defined riff etc ## sub get_token_bytes { my $token = shift; # token to process my $data; # data to return my $chord; # holds note tokens (space separated) for a chord my $num = 1; # temp numerator of note length my $value; # temp var for reading values my $transpose; # used if we find a predefined riff undef $data; if ($debug) { print "get_token_bytes($token)\n"; } if ($token eq '}') { if ($verbose) { print "got end of channel\n"; } $end_of_channel = 1; } # set tempo elsif ($token eq '$tempo') { $token = &get_next_token || die "$line_refs[$current_token]: missing tempo after \$tempo\n"; my $dtime = $current_track_length + $old{'rest_length'}; $tempo_track{$dtime} .= pack("C*", 0) if (defined $tempo_track{$dtime}); $tempo_track{$dtime} .= &get_tempo_bytes($token); } # set time signature elsif ($token eq '$time_sig') { $token = &get_next_token || die "$line_refs[$current_token]:" . " missing value after \$time_sig\n"; my $dtime = $current_track_length + $old{'rest_length'}; if (defined $tempo_track{$dtime}) { $tempo_track{$dtime} .= pack("C*", 0); } $tempo_track{$dtime} .= &get_time_sig_bytes($token); } # set key elsif ($token eq '$key') { $token = &get_next_token || die "$line_refs[$current_token]: missing key after \$key\n"; my $dtime = $current_track_length + $old{'rest_length'}; $tempo_track{$dtime} .= pack("C*", 0) if (defined $tempo_track{$dtime}); $tempo_track{$dtime} .= &get_key_bytes($token); } # set default length elsif ($token eq '$length') { $token = &get_next_token; if ($token =~ /(([0-9]+):)?([0-9]+)/) { if ($2) { $num = $2; } $old{'note_length'} = ( 4 * $num * $header_info{'ticksperquarter'}) / $3; } else { die "$line_refs[$current_token]: " . "bad length value `$token'\n"; } } # shorten value (to leave space for note offsets) elsif ($token eq '$shorten') { $token = &get_next_token; if ($token =~ /^(\d+)$/) { $shorten = $1; } else { die "$line_refs[$current_token]: bad shorten value `$1'\n"; } } # unquantise value (to offset each note randomly) elsif ($token eq '$unquantise') { $token = &get_next_token; if ($token =~ /^[-+]?(\d+)\%?$/) { if ($1 == 0) { undef $unquantise; print "unquantise set to 0\n" if $debug; } else { $unquantise = $token; print "unquantise set to $token\n" if $debug; } } else { die "$line_refs[$current_token]: bad unquantise value `$1'\n"; } } # strum value (speed of strumming for chords 0-127) elsif ($token eq '$strum') { $token = &get_next_token; if ($token =~ /^(\d+)$/) { $strum = $1; } else { die "$line_refs[$current_token]: bad strum value `$1'\n"; } if (($strum < 0) or ($strum > 127)) { die "$line_refs[$current_token]: bad strum value `$strum'\n"; } } # set patch (and bank) Format: [[bank_lsb,]bank_msb,]patch elsif ($token eq '$patch') { # FIXME: this needs a separate subroutine my ($bank_msb, $bank_lsb); my $patch = &get_next_token || die "$line_refs[$current_token]:" . " missing number after \$patch\n"; # check for bank number if ($patch =~ /^(((\d+),)?(\d+),)?(\S+)$/) { # lsb=3, msb=4, patch=5 if (defined $1) { # bank included if (defined $2) { # bank_lsb included $bank_lsb = $3; if (($bank_lsb < 1) || ($bank_lsb > 128)) { die "$line_refs[$current_token]: " . "bad bank LSB: $bank_lsb\n"; } $bank_lsb--; } $bank_msb = $4; if (($bank_msb < 1) || ($bank_msb > 128)) { die "$line_refs[$current_token]: " . "bad bank MSB: $bank_msb\n"; } $bank_msb--; } $patch = $5; } if (!($patch =~ /^\d+$/)) { # patch specified by name if ($debug) { print "got patch name $patch\n"; } $patch = $patches{$patch}; } if (($patch < 1) || ($patch > 128)) { die "$line_refs[$current_token]: bad patch: $patch\n"; } $patch--; if ($debug) { print "setting \$patch to " . "[bank_LSB=$bank_lsb ; bank_MSB=$bank_msb] patch=$patch\n"; } if (defined $bank_msb) { $data .= &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 | ($current_channel - 1), 0, $bank_msb); if (defined $bank_lsb) { $data .= &get_delta_time(0); $data .= pack("C*", 0xb0 | ($current_channel - 1), 32, $bank_lsb); } $data .= &get_delta_time(0); } else { $data .= &get_delta_time($old{'rest_length'}); } $data .= pack("CC", 0xbf + $current_channel, $patch); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; } # bank only. Format [lsb,]msb elsif ($token eq '$bank') { my ($bank_msb, $bank_lsb); my $bank = &get_next_token || die "$line_refs[$current_token]:" . " missing bank number after \$bank\n"; if ($bank =~ /^((\d+),)?(\d+)$/) { if (defined $1) { $bank_lsb = $2; if (($bank_lsb < 1) or ($bank_lsb > 128)) { die "$line_refs[$current_token]:" . " bad bank LSB value `$bank_msb'\n"; } $bank_lsb--; } $bank_msb = $3; if (($bank_msb < 1) or ($bank_msb > 128)) { die "$line_refs[$current_token]:" . " bad bank MSB value `$bank_msb'\n"; } $bank_msb--; } else { die "line_refs[$current_token]: " . "Error in bank format `$bank': expected [LSB,]MSB\n"; } if ($debug) { print "setting bank to LSB=$bank_lsb ; MSB=$bank_msb\n"; } $data .= &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 | ($current_channel - 1), 0, $bank_msb); if (defined $bank_lsb) { $data .= pack("C*", 0, 0xb0 | ($current_channel - 1), 32, $bank_lsb); } $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; } # set default octave elsif ($token eq '$octave') { $old{'octave'} = &get_next_token; if (!(($old{'octave'} >= 0) && ($old{'octave'} <= 10))) { die "$line_refs[$current_token]: bad octave `$old{'octave'}'\n"; } } # volume elsif ($token eq '$volume') { $value = &get_next_token || die "$line_refs[$current_token]:" . " missing volume value after \$volume\n"; $value = &get_range_value($value); if (!(($value >= 0) && ($value <= 127))) { die "$line_refs[$current_token]: bad volume `$value'\n"; } if ($debug) { print "setting volume to $value\n"; } $data .= &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 | ($current_channel - 1), 7, $value); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; } # note on velocity elsif ($token eq '$attack') { $value = &get_next_token; $value = &get_range_value($value); if (!(($value >= 0) && ($value <= 127))) { die "$line_refs[$current_token]: bad attack value `$value'\n"; } if ($debug) { print "setting attack to $value\n"; } $old{'attack'} = $value; } # note off velocity elsif ($token eq '$decay') { $value = &get_next_token; $value = &get_range_value($value); if (!(($value >= 0) && ($value <= 127))) { die "$line_refs[$current_token]: bad decay value `$value'\n"; } if ($debug) { print "setting decay to $value\n"; } $old{'decay'} = $value; } # chorus elsif ($token eq '$chorus') { $value = &get_next_token; $value = &get_range_value($value); if (!(($value >= 0) && ($value <= 127))) { die "$line_refs[$current_token]: bad chorus value `$value'\n"; } if ($debug) { print "setting chorus to $value\n"; } $data .= &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 + $current_channel - 1, 93, $value); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; } # reverb elsif ($token eq '$reverb') { $value = &get_next_token; $value = &get_range_value($value); if (!(($value >= 0) && ($value <= 127))) { die "$line_refs[$current_token]: bad reverb value `$value'\n"; } if ($debug) { print "setting reverb to $value\n"; } $data .= &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 + $current_channel - 1, 91, $value); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; } # chord elsif ($token eq '(') { if ($debug) { print "g_t_b(): found chord\n"; } while ($token = &get_next_token) { if ($token eq ')') { print "found end of chord\n" if $debug; last; } else { print "CHORD: $token\n" if $debug; $chord .= "$token "; } } if ($debug) { print "g_t_b(): chord=$chord\n"; } $data .= &get_chord_bytes($chord); } # tuplet elsif ($token eq '%tuplet') { $data .= &get_tuplet_bytes; } # pitch bend elsif ($token eq '%bend') { $data .= &get_bend_bytes; } # simple pitch wheel event elsif ($token eq '$pitch') { $data .= &get_pitch_bytes; } # pitch bend range elsif ($token eq '$bend_range') { $data .= &get_bend_range_bytes(&get_next_token); } # predefined riff transposed elsif ($token =~ /~(\S+)\/(-)?([0-9]+)\//) { if ($debug) { print "get_token_bytes($token)\n"; } if ($2) { $transpose = 0 - $3; } else { $transpose = $3; } &prepend_riff_tokens($1, $transpose); } # predefined riff elsif ($token =~ /^~(\S+)/) { if ($debug) { print "get_token_bytes($token)\n"; } &prepend_riff_tokens($1, 0); } # repeat block elsif ($token eq '%repeat') { $data .= &get_repeat_bytes; } # Marker elsif ($token eq '$marker') { my $dtime = $current_track_length + $old{'rest_length'}; $tempo_track{$dtime} .= pack("C*", 0) if (defined $tempo_track{$dtime}); $tempo_track{$dtime} .= &get_marker_bytes; } # Text event elsif ($token eq '$text') { $data .= &get_text_bytes; } # pan elsif ($token eq '$pan') { my $value = &get_next_token; $data .= &get_pan_bytes($value, 1); } # pan_all elsif ($token eq '%pan_all') { &parse_pan_all; } # controller event elsif ($token eq '$ctrl') { $data .= &get_ctrl_bytes; } # verbatim elsif ($token eq '%verbatim' or $token eq '%bytes') { $data .= &get_verbatim_bytes; } # rpn elsif ($token eq '$rpn') { $data .= &get_rpn_bytes; } # nrpn elsif ($token eq '$nrpn') { $data .= &get_nrpn_bytes; } # print elsif ($token eq '$print') { my $msg = &get_quoted_string; print "$msg\n"; } # track type (used by midi2mg) elsif ($token eq '$track_type') { $current_track_type = &get_next_token; } # bar line elsif ($token =~ /^\|_?\d*$/) { my $dtime = $current_track_length + $old{'rest_length'}; push @current_track_bars, ( $token, $dtime ); if ($debug) { print "bar line: $token at $dtime\n"; } } # note or rest else { # pan if note has a pan_all value my $tmp = $token; my $return_pan = 0; $tmp =~ s/^[-+]?.*\///; if (defined($pan_all{$tmp})) { $data .= &get_pan_bytes($pan_all{$tmp}); $return_pan = 1; } elsif (defined($pan_all{'any'})) { $data .= &get_pan_bytes($pan_all{'any'}); $return_pan = 1; } $data .= &get_note_bytes($token, 0); if ($return_pan) {$data .= &get_pan_bytes($last_pan);} } return $data; } ## ## return a reference to an array of notes, given a scale type, ## root note and number of octaves ## sub get_scale { my ($type, $root, $range, $opts) = @_; die "$type: unknown scale\n" unless defined $scales{$type}; die "$root: bad root note\n" unless $root =~ /^[a-g][-+]?\d+$/; $range = 1 unless ($range > 1); $root = $opts . $root if defined $opts; my @scale = ($root); my $note_num = ¬e_to_int($root); my $count = 0; if ($debug) { print "get_scale() starting loop for $type, $root, $range:\n"; } { foreach (@{$scales{$type}}) { $count += $_; $note_num += $_; my $note = &int_to_note($note_num); $note = $opts . $note if defined $opts; push(@scale, $note); last if $count >= 12 * $range; } redo unless $count >= 12 * $range; } return \@scale; } ## ## return a string of bytes representing a note ## sub get_note_bytes { my $token = shift; # input token representing note my $flag = shift; # 0=normal # other values used for chords # 11=note on only # 12=note on with specified dtime # 21=note off # 22=note off with specified dtime my $delta = shift; # for use with 12 and 22 above $delta = 0 unless $delta > 0; my $meta; # meta info for note my $note; # note value my $length; # length of note my $real_length; # set if above is changed by tuplet my $repeat = 1; # number of times to play the note my $name; # note name my $sharp; # sharp or flat my $octave; # octave note is in my $attack; # note on velocity my $decay; # note off velocity my $data; # data bytes to return my $rest; # flag set if note is a rest my $i; # loop counter my $value; # temp value my $offset = 0; # note offset in midi clicks my $onoff = 0; # flag for note on/off only events my $is_drum_name = 0; # Whether the note is specified as a drum name. if ($debug) { print "g_n_b(): getting note bytes for $token ; \$flag=$flag\n"; } # note on/off only flag if ($token =~ /^([-+])(\S+)/) { if ($1 eq '+') {$onoff = 1;} else {$onoff = -1} $token = $2; } # deal with meta info if ($token =~ /^\/(\S+)\//) { $meta = $1; # Sanity check if ($meta !~ /^(([adr]|[zZ][-+]?)\d+|l(\d+:)?\d+)+$/) { die "$line_refs[$current_token]: error in note options `$meta'\n"; } # repeat if ($meta =~ /r(\d*)/ and not $onoff) { $repeat = $1; print "note repeat = $repeat\n" if $debug; } # length specified if ($meta =~ /l((\d+(\.\d+)?):)?(\d+)/ and not $onoff) { my $num = 1; if (defined $2) { $num = $2; } $real_length = ($header_info{'ticksperquarter'} * 4 * $num) / $4; } # inherit old length else { $real_length = $old{'note_length'}; } if ($tuplet != 1) { $length = $real_length / $tuplet; if (not $done_tuplet_warning and $length != int $length) { $done_tuplet_warning = 1; warn <<EOF; Warning: lost some midi clicks due to tuplet. your \$resolution value should be a multiple of each tuplet factor. EOF } } else { $length = $real_length; } if ($debug) { print "length of note = $length ($real_length)\n"; } # attack if ($meta =~ /a([0-9]+)/) { $attack = $1; print "note attack = $attack\n" if $debug; } # decay if ($meta =~ /d([0-9]+)/) { $decay = $1; print "note decay = $decay\n" if $debug; } # offset if ((defined $unquantise) and ($meta !~ /z/i)) { $meta =~ s/^/Z$unquantise/; print "note opts changed to $meta by unquantise\n" if $debug; } if ($meta =~ /(z)([-+])?(\d+)(\%)?/i) { my $type = $1; my $sign = $2; my $value = $3; my $unit = $4; # convert % values to midi clicks if ($unit eq '%') { $value = int(($length * $value) / 100); } # pick a value if using random type (Z) if ($type eq 'Z') { if (!(defined $sign)) { $offset = int(rand(2 * $value) - $value); } elsif ($sign eq '+') { $offset = int(rand($value)); } else { $offset = 0 - int(rand($value)); } } else { if ((defined $sign) && ($sign eq '-')) { $offset = 0 - $value; } else { $offset = $value; } } if ($debug) { print "OFFSET: using $offset for $token\n"; } } } elsif ($token =~ /(\S)?\//) { my $slash = (defined $1)? 'leading' : 'trailing'; die "$line_refs[$current_token]: note options missing $slash slash\n"; } # if there were no note options... if (!(defined $length)) { $real_length = $old{'note_length'}; if ($tuplet != 1) { $length = $real_length / $tuplet; if (not $done_tuplet_warning and $length != int $length) { $done_tuplet_warning = 1; warn <<EOF; Warning: lost some midi clicks due to tuplet. your \$resolution value should be a multiple of each tuplet factor. EOF } } else { $length = $real_length; } if ($debug) { print "length of note = $length ($real_length)\n"; } } if (!$attack) { $attack = $old{'attack'}; } if (!$decay) { $decay = $old{'decay'}; } $token =~ s/.*\///; # find note pitch if (!($token =~ /^([a-gr])([-+=])?([0-9])?$/)) { # bad note? check if we have a drum name print "checking for drum name \`$token'\n" if $debug; if (defined($drums{$token})) { $token = $drums{$token}; $is_drum_name = 2; } else { die "$line_refs[$current_token]:" . " bad note or drum name: $token\n"; } print "found drum note: $token\n" if $debug; } if ($token =~ /^([a-gr])([-+=])?([0-9])?$/) { $name = $1; $sharp = $2; $octave = $3; } else { die "$line_refs[$current_token]: bad note token $token\n"; } if ($debug) { print "name = $name ; sharp = $sharp ; octave = $octave\n"; } # rest if ($name eq 'r') { $old{'rest_length'} += $length; $old{'note_length'} = $real_length; $rest = 1; if ($debug) { print "g_n_b() old_rest_length changed to $length by rest\n"; } } # note else { $length -= $shorten; if (!$octave) { $octave = $old{'octave'}; } $note = ¬e_to_int("$name$sharp$octave", $is_drum_name); $note += $transpose; # convert note data to bytes (first note) printf("rest carried over = %d\n", $old{'rest_length'}) if $debug; if ($onoff == 1) { # note on, inherited rest length $data = &get_delta_time($old{'rest_length'}); $data .= pack("CCC", $current_channel + 0x8f, $note, $attack); $current_track_length += $old{'rest_length'}; } elsif ($onoff == -1) { # note off, inherited rest length $data = &get_delta_time($old{'rest_length'}); $data .= pack("CCC", $current_channel + 0x7f, $note, $decay); $current_track_length += $old{'rest_length'}; } elsif (($flag == 0) || ($flag == 11)) { # note on if (($old{'rest_length'} + $offset) < 0) { my $bad = $offset; $offset = 0 - $old{'rest_length'}; warn "$line_refs[$current_token]:" . " cannot use offset $bad; using $offset\n"; } if ($offset > $length) { die "$line_refs[$current_token]:" . "offset $offset is greater than note length\n"; } $old{'rest_length'} += $offset; $length -= $offset; $data = &get_delta_time($old{'rest_length'}); $data .= pack("CCC", $current_channel + 0x8f, $note, $attack); $current_track_length += $old{'rest_length'}; } elsif ($flag == 12) { # note on specified dtime $data = &get_delta_time($delta); $data .= pack("CCC", $current_channel + 0x8f, $note, $attack); } if (($flag == 0 and not $onoff) || ($flag == 21)) { # note off $data .= &get_delta_time($length); $data .= pack("CCC", $current_channel + 0x7f, $note, $decay); $current_track_length += $length; } elsif ($flag == 22) { # note off specified dtime $data .= &get_delta_time($delta); $data .= pack("CCC", $current_channel + 0x7f, $note, $decay); $current_track_length += $delta; } # save values in %old $old{'note_length'} = $real_length; $old{'note_pitch'} = $note; $old{'rest_length'} = 0 + $shorten; $old{'octave'} = $octave; $old{'attack'} = $attack; $old{'decay'} = $decay; } # add repeat notes if needed if ($repeat > 1) { for (2..$repeat) { if ($rest) { $old{'rest_length'} += $length; } else { $data .= &get_delta_time($old{'rest_length'} + $offset); $data .= pack("CCC", $current_channel + 0x8f, $note, $attack); $data .= &get_delta_time($length); $data .= pack("CCC", $current_channel + 0x7f, $note, $decay); $current_track_length += $length; } } } print "leaving get_note_bytes()\n" if $debug; return $data; } ## ## return a string of bytes from a repeat block ## recursing if neccesary ## sub get_repeat_bytes { my $parent_got_start = shift; # ref to parent's got_start flag my $parent_start_rest = $repeat_start_rest; # copy of s_r to pass back # $repeat_start_rest (global) stores any leading rests in the block. my $start_rest = 0; # how long to rest at start of repeat my $first_dtime; # start dtime first time thru the block my $rpt_dtime; # start dtime when repeating the block my $got_start = 0; # flag set when leading rests are complete my $end_rest = 0; # stores any trailing rests in the block my $rpt_count; # number of times to repeat my $token; # holds current token my $block; # the block of bytes to repeat my $data; # data to return my $rest; # holds length of current rest my @tmp; # temp variable used stripping first dtime my $tmp; # temp var to hold block while stripping dtime my $dtime_stripped = 0; # flag my $num; # numerator of length value $rpt_count = &get_next_token || die "$line_refs[$current_token]: " . "missing repeat count after \%repeat\n"; if ($rpt_count < 1) { die "$line_refs[$current_token]: " . "bad repeat count: $rpt_count\n"; } (&get_next_token eq '{') || die "$line_refs[$current_token]: " . "after \`\%repeat', expected {, found $_\n"; # loop thru the block of tokens my $i = 0; # loop counter while (1) { $token = &get_next_token; # break out at end of block if ($token eq '}') { print "RPT: end of block\n" if $debug; last; } # recurse if a nested block is found if ($token eq '%repeat') { my $old_got_start = $got_start; print "RPT: recursing\n" if $debug; if (!$got_start) { $repeat_start_rest = $start_rest; } $block .= &get_repeat_bytes(\$got_start); $end_rest = $old{'rest_length'}; $start_rest = $repeat_start_rest unless $old_got_start; if (($got_start) and (!$old_got_start)) { if (defined $parent_got_start) { unless ($$parent_got_start) { $parent_start_rest += $start_rest; $$parent_got_start = 1; } } } next; } # else add normal token to the block else { $block .= &get_token_bytes($token); } # add up the leading/trailing rests if ($token =~ /^(\/(l(([0-9]+):)?([0-9]+))?(r([0-9]+))?\/)?r$/) { if ($2) { if ($4) {$num = $4;} else {$num = 1;} $rest = ($header_info{'ticksperquarter'} * 4 * $num) / $5; print "num=$num den=$5\n" if $debug; print "RPT: got_start=$got_start\n" if $debug; } else { $rest = $old{'note_length'}; } if ($7) { $rest *= $7; print "RPT: rest *= $7\n" if $debug; } # add rest length to start_rest if (!$got_start) { $start_rest += $rest; print "RPT: start_rest+=$rest [$token]\n" if $debug; } # add rest length to end_rest print "RPT: END+=$rest\n" if ($debug); $end_rest += $rest; } # chord elsif ($token eq '(') { if (!$got_start) { if (defined $parent_got_start) { unless ($$parent_got_start) { $parent_start_rest += $start_rest; $$parent_got_start = 1; } } $got_start = 1; } $end_rest = 0; print "RPT: end_rest=0 [$token]\n" if $debug; } # predefined riff or tempo track event elsif ($token =~ /^(~\S+|\$(tempo|time_sig|key|marker))/) { # do nothing } # else it's a note (or pan/chorus etc) # so reset the end_rest counter and set start flag else { if (!$got_start) { if (defined $parent_got_start) { unless ($$parent_got_start) { $parent_start_rest += $start_rest; $$parent_got_start = 1; } } $got_start = 1; } $end_rest = 0; print "RPT: end_rest=0 [$token]\n" if $debug; } } # add the block with original dtime to $data $data = $block; # set the repeat dtime if ($debug) { print "RPT: start_rest=$start_rest end_rest=$end_rest\n"; } if ($block) { $rpt_dtime = &get_delta_time($start_rest + $end_rest); # remove the first dtime from the block @tmp = split(//, $block); for ($i=0; $i<=@tmp-1; $i++) { if ($dtime_stripped) { $tmp .= $tmp[$i]; } elsif ((unpack("C", $tmp[$i])) < 0x80) { printf ("RPT: stripped %d bytes of dtime\n", $i+1) if $debug; $dtime_stripped = 1; } } print "RPT: replacing stripped dtime with $rpt_dtime\n" if $debug; $block = $rpt_dtime . $tmp; # add the ammended block the required number of times for (2..$rpt_count) {$data .= $block;} $old{'rest_length'} = $end_rest; } else { if ($start_rest != $end_rest) { warn "RPT: start_rest != end_rest in empty block\n"; } $old{'rest_length'} += ($rpt_count - 1) * $start_rest; } # set the repeat_start_rest back to parent's value if needed if (defined $parent_got_start) { if ($$parent_got_start) { if ($debug) { print "RPT: returning original parent start rest" . " $parent_start_rest\n"; } $repeat_start_rest = $parent_start_rest; } else { $repeat_start_rest = $parent_start_rest; if ($block) { $repeat_start_rest += $end_rest; } else { $repeat_start_rest += $rpt_count * $start_rest; } if ($debug) { print "RPT: returning ammended start rest" . " $repeat_start_rest to parent\n"; } } } else { $repeat_start_rest = 0; } return $data; } ## ## return a string of bytes representing a note with pitch bends ## sub get_bend_bytes { my $values; # value of pitch bend my $dtime; # dtime of pitch bend my $note; # start note my $token; # to store current token my $data; # data to return my $i; # loop counter my $num; # numerator of length values my ($current, $min, $max); # current, min and max values of bend my $lsb; # least significant byte of bend amount my $pre_bend; # amount to pre bend if bending downwards my $bend_unit = 127; # scale factor for bend value <=> semitone my $transpose; # amount to transpose to cancel out pre_bend $token = &get_next_token; if ($token =~ /^[a-g]([-+=])?([0-9])?$/) { $note = $token; } else { die "$line_refs[$current_token]: unknown note $token\n"; } # note on $data .= &get_note_bytes($note, 11); (&get_next_token eq '{') || die "$line_refs[$current_token]: expected \`{' ; found $_\n"; $i = 0; $current = 64; while ($token = &get_next_token) { if ($token eq '}') { last; } elsif ($token =~ /^(([0-9]+):)?([0-9]+)(\+|-)([0-9]+)$/) { if ($5 > 128) { die "$line_refs[$current_token]: " . "bad bend value: $5\n"; } if ($2) { $num = $2; } else { $num = 1; } if ($3 == 0) { $dtime = 0; } else { $dtime = ($header_info{'ticksperquarter'} * 4 * $num) / $3; } if ($4 eq '-') { $current -= $5; } else { $current += $5; } $data .= &get_delta_time($dtime); # use lsb if we need to reach the max value if ($current == 128) { $lsb = 127; $current = 127; } else { $lsb = 0; } # sanity check if (($current > 127) || ($current < 0)) { die "$line_refs[$current_token]: " . "current bend amount $current is outside range 0-128\n"; } $data .= pack("C*", 0xDF + $current_channel, $lsb, $current); } else { die "$line_refs[$current_token]: " . "bad token $token in \%bend block\n"; } if ($debug) { print "BEND: dtime = $dtime ; value = $current\n"; } $i++; } # note off (zero dtime) $data .= &get_note_bytes($note, 22); # reset pitch wheel if needed if ($current != 64) { $data .= pack("C*", 0, 0xDF + $current_channel, 0, 64); } return $data; } ## ## return a string of bytes representing a chord ## sub get_chord_bytes { my $tokens = shift; # chord string my @chord = split(/\s+/, $tokens); # tokens representing the chord my $data; # data to return my $i; # loop counter if ($debug) { print "get_chord_bytes(): chord=@chord\n"; } # Append octave to first note if unspecified unless ($chord[0] =~ /\d$/) { my $note = $chord[0]; $note =~ s/^.*\///; unless (grep { $note =~ /^$_$/; } keys %drums) { print "appending octave $old{'octave'} to first note" . " $chord[0] in chord\n" if ($debug); $chord[0] .= $old{'octave'}; } } $data = &get_note_bytes($chord[0], 11); my $length = $old{'note_length'}; if ($strum * (scalar @chord) >= $length) { die "$line_refs[$current_token]:" . "strum value $strum too high for current chord\n"; } for ($i=1; $i<=@chord-1; $i++) { $data .= &get_note_bytes($chord[$i], 12, $strum); } $data .= &get_note_bytes($chord[0], 22, $length - ($strum * (@chord-1)) - $shorten); for ($i=1; $i<=@chord-1; $i++) { $data .= &get_note_bytes($chord[$i], 22, 0); } return $data; } ## ## return a string of bytes representing a tuplet ## sub get_tuplet_bytes { my $token; # current token my $data; # data to return $token = &get_next_token; if ($token =~ /^(\d+):(\d+)$/) { push @tuplets, $tuplet; $tuplet *= $1/$2; print "TUPLET: got value $token\n" if $debug; } else { die "$line_refs[$current_token]: bad tuplet time \`$token\'\n"; } $token = &get_next_token; die "$line_refs[$current_token]: after \%tuplet," . "expected \`{\'; found $token\n" unless $token eq '{'; while ($token = &get_next_token) { if ($token eq '}') { $tuplet = pop @tuplets; print "TUPLET: got end of block;" . " retrieved old tuplet $tuplet\n" if $debug; last; } else { $data .= &get_token_bytes($token); } } return $data; } ## ## return a string of bytes entered verbatim in hex or decimal ## sub get_verbatim_bytes { my @bytes; my $token = &get_next_token; die "after \%verbatim, expected `{'; found $token" unless $token eq '{'; print "GVB(): " if $debug; while (defined ($token = &get_next_token)) { print "$token " if $debug; last if $token eq '}'; my $byte = $token; $byte = oct $byte if $byte =~ /^0/; die "bad byte value in verbatim: $token" unless $byte >= 0 and $byte < 256; push @bytes, $byte; } print "\n" if $debug; return pack "C*", @bytes; } ################################################ ## ## ## @@@SECTION: MIDI event related subroutines ## ## ## ################################################ ## ## return a string of bytes representing a pitch bend sensitivity event ## sub get_bend_range_bytes { my $token = shift; # token to process my $data; # data to return if (!($token >= 0)) { die "$line_refs[$current_token]: bad pitch bend range: $token\n"; } $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xaf + $current_channel, 100, 0); $data .= pack("C*", 0, 0xaf + $current_channel, 101, 0); $data .= pack("C*", 0, 0xaf + $current_channel, 6, $token); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } ## ## Return a string of bytes representing an rpn controller adjustment ## sub get_rpn_bytes { my $data; # data to return my ($ctrl_h, $ctrl_l, $val_h, $val_l); my $token = &get_next_token; if ($token =~ /^((\d+),)?(\d+),(\d+)(,(\d+))?$/) { ($ctrl_h, $ctrl_l, $val_h, $val_l) = ($2, $3, $5, $6); $ctrl_h = 0 unless defined $ctrl_h; } else { warn "$line_refs[$current_token]: error parsing rpn arguments\n"; die "...expected [ctrl-msb,]ctrl-lsb,value-msb[,value-lsb])\n"; } $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xaf + $current_channel, 100, $ctrl_l); $data .= pack("C*", 0, 0xaf + $current_channel, 101, $ctrl_h); $data .= pack("C*", 0, 0xaf + $current_channel, 6, $val_h); if (defined $val_l) { $data .= pack("C*", 0xaf + $current_channel, 100, $ctrl_l); $data .= pack("C*", 0, 0xaf + $current_channel, 101, $ctrl_h); $data .= pack("C*", 0, 0xaf + $current_channel, 38, $val_l); } $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } ## ## Return a string of bytes representing an nrpn controller adjustment ## sub get_nrpn_bytes { my $data; # data to return my ($ctrl_h, $ctrl_l, $val_h, $val_l); my $token = &get_next_token; if ($token =~ /^((\d+),)?(\d+),(\d+)(,(\d+))?$/) { ($ctrl_h, $ctrl_l, $val_h, $val_l) = ($2, $3, $5, $6); $ctrl_h = 0 unless defined $ctrl_h; } else { warn "$line_refs[$current_token]: error parsing nrpn arguments\n"; die "...expected [ctrl-msb,]ctrl-lsb,value-msb[,value-lsb])\n"; } $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xaf + $current_channel, 98, $ctrl_l); $data .= pack("C*", 0, 0xaf + $current_channel, 99, $ctrl_h); $data .= pack("C*", 0, 0xaf + $current_channel, 6, $val_h); if (defined $val_l) { $data .= pack("C", 0); $data .= pack("C*", 0xaf + $current_channel, 98, $ctrl_l); $data .= pack("C*", 0, 0xaf + $current_channel, 99, $ctrl_h); $data .= pack("C*", 0, 0xaf + $current_channel, 38, $val_l); } $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } ## ## return a string of bytes representing a pitch wheel adjustment ## sub get_pitch_bytes { my $value = &get_next_token; my $lsb = 0; my $data; die "$line_refs[$current_token]: bad \$pitch value `$value'\n" unless $value >= 0 and $value <= 128; # use lsb if we need to reach the max value if ($value == 128) { $lsb = 127; $value = 127; } # sanity check if (($value > 127) || ($value < 0)) { die "$line_refs[$current_token]: " . "current bend amount $value is outside range 0-128\n"; } $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xDF + $current_channel, $lsb, $value); $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } ## ## return a string of byte representing a key event ## sub get_key_bytes { my $token = shift; # token to process my $note; # note name of key my $sharp; # sharp/flat character if present my $minor; # `m' for minor if present my $sf; # number of sharps/flats (defines key) my $mi; # whether key is minor my $data; # data to return if ($token =~ /^([a-g])(\+|-)?(m)?$/i) { $note = lc $1; $sharp = $2; $minor = $3; $header_info{'key'} = "$note$sharp$minor"; my $key = $header_info{'key'}; # Temporary copy. # Fix for minor keys if ($key =~ s/m//) { $key = &relative_major("${key}m"); ($note, $sharp) = split //, $key; } if ($note eq 'a') { if ($sharp eq '+') { warn "A sharp: no such key: using B flat\n" unless defined $minor; $sf = -2; } elsif ($sharp eq '-') { $sf = -4; } else { $sf = 3; } } elsif ($note eq 'b') { if ($sharp eq '+') { warn "B sharp: no such key: using C\n" unless defined $minor; $sf = 0; } elsif ($sharp eq '-') { $sf = -2; } else { $sf = 5; } } elsif ($note eq 'c') { if ($sharp eq '+') { $sf = 7; } elsif ($sharp eq '-') { $sf = -7; } else { $sf = 0; } } elsif ($note eq 'd') { if ($sharp eq '+') { warn "D sharp: no such key: using E flat\n" unless defined $minor; $sf = -3; } elsif ($sharp eq '-') { $sf = -5; } else { $sf = 2; } } elsif ($note eq 'e') { if ($sharp eq '+') { warn "E sharp: no such key: using F\n" unless defined $minor; $sf = -1; } elsif ($sharp eq '-') { $sf = -3; } else { $sf = 4; } } elsif ($note eq 'f') { if ($sharp eq '+') { $sf = -6; } elsif ($sharp eq '-') { warn "F flat: no such key: using E\n" unless defined $minor; $sf = 4; } else { $sf = -1; } } elsif ($note eq 'g') { if ($sharp eq '+') { warn "G sharp: no such key: using A flat\n" unless defined $minor; $sf = -4; } elsif ($sharp eq '-') { $sf = -6; } else { $sf = 1; } } } else { die "$line_refs[$current_token]: bad key: $token\n"; } if (defined($minor)) {$mi = 1;} else {$mi = 0;} print "adding key \`$token' ($sf, $mi)\n" if $debug; $data = pack("C*", 0xFF, 0x59, 2, $sf, $mi); return $data; } ## ## return bytes representing a text marker event (without delta time) ## sub get_marker_bytes { my $data; # data to return my $token; # current token my $text; # marker text $token = &get_next_token; if ($token =~ /^\"[^\"]*$/) { $_ = $token; s/^.//; $text = $_; while ($token = &get_next_token) { if ($token =~ /\"/) { $_ = $token; s/\"$//; $text .= " $_"; last; } $text .= " $token"; } } else { $text = $token; } $data = pack("C2", 0xff, 0x06) . &get_data_size($text, 1) . $text; return $data; } ## ## Return a string of bytes representing a text event. ## sub get_text_bytes { my $text = &get_quoted_string; my $length = &get_data_size($text, 1); my $data = pack "C*", 0, 0xff, 1; $data .= $length . $text; return $data; } ## ## return a string of bytes representing a pan event ## takes a range `n-m' or single value ## sub get_pan_bytes { my $data; # data to return my ($token, $save) = @_; my $pan = &get_range_value($token); # pan value if (($pan > 127) || ($pan < 0)) { die "$line_refs[$current_token]: bad pan value $token\n"; } $last_pan = $pan if $save; $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 + $current_channel-1, 10, $pan); if ($debug) { print "PAN: data=$data"; } $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } ## ## return a string of bytes representing a controller event ## sub get_ctrl_bytes { my $data; my $token = &get_next_token; if ($token =~ /^(\d+),(\d+)$/) { my ($ctrl, $value) = ($1, $2); die "$line_refs[$current_token]: bad controller value $value\n" unless $value >= 0 and $value < 128; $data = &get_delta_time($old{'rest_length'}); $data .= pack("C*", 0xb0 + $current_channel-1, $ctrl, $value); if ($debug) { print "CTRL: set ctrl $ctrl to $value\n"; } $current_track_length += $old{'rest_length'}; $old{'rest_length'} = 0; return $data; } else { die "$line_refs[$current_token]: " . "bad \$ctrl parameter $token (expected `ctrl#,value')\n"; } } ########################################### ## ## ## @@@SECTION: Input related subroutines ## ## ## ########################################### ## ## add tokens from a file or stdin to @tokens ## sub get_tokens { my $input = shift; # input file my $parent = shift; # the file which included this one, if any my $bol_token = shift; # token number at beginning of line my @tmp_tokens; # temporary array of tokens my $marker = 0; # marks current line in source my $i; # loop counter my $unused; # throwaway string my $num_tokens; # number of tokens we already have my $tmp; # temp var my $in_body = 0; # flag set when in body section my $track_num = 0; # keeps trck of track number $bol_token = 0 unless defined $bol_token; $parent = 0 unless defined $parent; if ($debug) { print "get_tokens($input)\n"; } $num_tokens = @tokens; if ($input) { # Find the input file if it's an include file if ($parent) { my $infile = $input; my $i = 0; $input = "$include_paths[$i++]/$infile" while (not -e $input and $i < @include_paths); die "could not locate `$infile'" . " included from $parent" unless -e $input; } open(INFILE, $input) or die "could not open $input for input\n"; while (<INFILE>) { $marker++; chomp(); s/#.*//; s/^\s*//; s/\s*$//; if (/^$/) {next;} if (/\@channel/) { $track_num++; } elsif (/\%(choose|chain|eval)/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found \%choose or \%chain or \%eval:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\b\d+-\d+\b/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found range value or pan_all:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\$marker|\$shorten/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found marker or shorten:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif ((/\$(tempo|time_sig|key)/) && ($in_body)) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found tempo, time or key:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif ($_ =~ m@/.*Z.*/\S+|\$unquantise@i) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found note offset:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\|_?\d*/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found bar line:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\@body/) { $in_body = 1; } elsif (/\%include\s+(\S+)/) { if ($debug) { print "looking for include file $1\n"; } close(INFILE); # read an include file &get_tokens($1, $input, $bol_token); $bol_token = @tokens; # re open previous file and skip to last position open(INFILE, $input) || die "could not reopen $input for reading\n"; for ($i=0; $i<$marker; $i++) { $unused = <INFILE>; } next; } @tokens = (@tokens, split(/\s+/)); for ($bol_token..@tokens - 1) { $line_refs[$_] = "$input:$marker"; } $bol_token = @tokens; } close(INFILE) } else { while (<STDIN>) { # FIXME: This shouldn't be duplicated $marker++; chomp(); s/#.*//; s/^\s*//; s/\s*$//; if (/^$/) {next;} if (/\@channel/) { $track_num++; } elsif (/\%(choose|chain|eval)/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found \%choose or \%chain or \%eval:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\b\d+-\d+\b/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found range value or pan_all:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\$marker|\$shorten/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found marker or shorten:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif ((/\$(tempo|time_sig|key)/) && ($in_body)) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found tempo, time or key:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif ($_ =~ m@/.*Z.*/\S+@i) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found note offset:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\|_?\d*/) { $unroll[$track_num] = 1; if (!$unroll_loops) { if ($verbose) { print "found bar line:" . " setting unroll-loops option\n"; } $unroll_loops = 1; $source_outfile = $outfile; $source_outfile =~ s/(\.mid)?$/.long.mg/; } } elsif (/\@body/) { $in_body = 1; } elsif (/\%include\s+(\S+)/) { if ($debug) { print "looking for include file $1\n"; } &get_tokens($1, 'STDIN', $bol_token); $bol_token = @tokens; next; } @tokens = (@tokens, split(/\s+/)); for ($bol_token..@tokens - 1) { $line_refs[$_] = "STDIN:$marker"; } $bol_token = @tokens; } } if ($verbose) { if ($input) { printf("found %d tokens in $input\n", @tokens - $num_tokens); } else { printf("found %d tokens in <STDIN>\n", @tokens - $num_tokens); } } } ## ## check the source code for errors ## sub pre_parse { my $bracket = 0; # counter for {} brackets my $got_head = 0; # flag set when @head section found my $got_body = 0; # flag set when @body section found my $got_channel = 0; # flag set when @channel section found my $i; # loop counter my $max; # max value for counter my $tmp; # tmp var $header_info{'num_tracks'} = 1; for ($i=0; $i<=@tokens-1; $i++) { $_ = $tokens[$i]; if ($_ eq '@head') { if ($got_head) { die "$line_refs[$i]: found second \@head section\n"; } else { $got_head = 1; } } elsif ($_ eq '@body') { if ($got_body) { die "$line_refs[$i]: found second \@body section\n"; } else { $got_body = 1; } } elsif ($_ eq '{') { $bracket++; } elsif ($_ eq '}') { $bracket--; if ($bracket < 0) { die "$line_refs[$i]: mismatched parenthesis\n"; } } elsif ($_ eq '@channel') { if ($bracket != 1) { die "$line_refs[$i]:" . " parse error before \`$tokens[$i] $tokens[$i+1]\'\n"; } $got_channel = 1; $header_info{'num_tracks'}++; } elsif ($_ eq '%define') { if ($bracket != 1) { die "$line_refs[$i]:" . " parse error before \`$tokens[$i] $tokens[$i+1]\'\n"; } } # convert L to l in note options elsif (/(\/\S*)L(\S+\/)/) { $tokens[$i] =~ s/L/l/; } # ignore tempo tracks if ($_ eq '$track_type' and $tokens[++$i] eq 'tempo') { $header_info{'num_tracks'}--; } # convert simple bend syntax elsif (/^\/(\S+)\/[a-g][-+=]?(\d+)?=>[a-g][-+=]?(\d+)?/) { my @bend_tokens = &get_bend_tokens($_, $i); @tokens = (@tokens[0..$i - 1], @bend_tokens, @tokens[$i + 1..@tokens]); # Fix the line_refs array my @bend_refs; for my $j (0..@bend_tokens) { $bend_refs[$j] = $line_refs[$i]; } @line_refs = (@line_refs[0..$i], @bend_refs, @line_refs[$i+1..@line_refs-1]); $i = $i + @bend_tokens - 1; } } if (!$got_head) { die "no \@head section found\n"; } if (!$got_channel) { die "no \@channel sections found\n"; } if ($bracket != 0) { die "unexpected EOF while searching for \`}'\n"; } printf("found %d music tracks\n", $header_info{'num_tracks'} - 1) unless $quiet; # source is ok - unroll repeat blocks now if option is set if ($unroll_loops) { my @unroll_line_refs; $header_info{'ticksperquarter'} = 96; # tmp resolution value my $track_num = 0; $max = @tokens-1; $tmp = ''; for ($i=0; $i<=$max; $i++) { if (($unroll_loops == 2 or $unroll[$track_num]) and $tokens[$i] eq '%repeat') { my $newtokens = &get_repeat_tokens($i+1) . ' '; my $ref_count = 0; map { $ref_count++; push @unroll_line_refs, $line_refs[$i]; } split /\s+/, $newtokens; $tmp .= $newtokens; $i = $current_token; } elsif ($tokens[$i] eq '%define') { my $newtokens = "$tokens[$i] $tokens[$i+1] "; $newtokens .= '{ ' . &unroll_define($i+2). ' } '; map { push @unroll_line_refs, $line_refs[$i]; } split /\s+/, $newtokens; $tmp .= $newtokens; $i = $current_token; } elsif ($tokens[$i] eq '@channel') { $tmp .= "$tokens[$i] "; push @unroll_line_refs, $line_refs[$i]; $track_num++; } else { $tmp .= $tokens[$i] . ' '; push @unroll_line_refs, $line_refs[$i]; } } @tokens = split(/\s+/, $tmp); @line_refs = @unroll_line_refs; @unroll_line_refs = (); # run eval blocks $max = @tokens-1; $tmp = ''; for ($i=0; $i<=$max; $i++) { if ($tokens[$i] eq '%eval') { if ($tokens[$i+1] eq '-') { $i++; &get_eval_tokens($i+1); } else { my $newtokens = &get_eval_tokens($i+1) . " "; map { push @unroll_line_refs, $line_refs[$i]; } split /\s+/, $newtokens; $tmp .= $newtokens; } $i = $current_token; } else { $tmp .= "$tokens[$i] "; push @unroll_line_refs, $line_refs[$i]; } } @tokens = split(/\s+/, $tmp); @line_refs = @unroll_line_refs; @unroll_line_refs = (); # handle any %choose or %chain blocks $max = @tokens-1; $tmp = ''; for ($i=0; $i<=$max; $i++) { if ($tokens[$i] eq '%choose') { if ($tokens[$i+1] eq '{') { my $newtokens = &get_choose_token($i+1); map { push @unroll_line_refs, $line_refs[$i]; } split /\s+/, $newtokens; $tmp .= $newtokens . ' '; } else { my $newtokens = &get_time_choose_tokens($i+1); map { push @unroll_line_refs, $line_refs[$i] if /\S/; } split /\s+/, $newtokens; $tmp .= $newtokens . ' '; } $i = $current_token; } elsif ($tokens[$i] eq '%chain') { print "found chain block\n" if ($debug); my $newtokens = &get_chain_tokens($i+1); map { push @unroll_line_refs, $line_refs[$i] if /\S/; } split /\s+/, $newtokens; $tmp .= $newtokens . ' '; $i = $current_token; } else { $tmp .= "$tokens[$i] "; push @unroll_line_refs, $line_refs[$i]; } } @tokens = split(/\s+/, $tmp); @line_refs = @unroll_line_refs; @unroll_line_refs = (); $current_token = -1; } } ## ## expand the simple bend syntax ## sub get_bend_tokens { my ($token, $current_token) = @_; my @bend_tokens = ('%bend'); # tokens to return my $orig_token = $token; my @bend_notes = split '=>', $token; #print "first=$bend_notes[0]\n"; if ($bend_notes[0] =~ /^\/.*l((\d+):)?(\d+).*\/([a-g][-+=]?\d+)$/) { my $num = (defined $1)? $2 : 1; my $denom = $3; my $note = $4; my $first_note = $4; @bend_tokens[1..2] = ($note, '{'); my $divisions = ($bend_steps * 4 * $num) / $denom; $denom *= $divisions; my $range = 2; # find max bend amount before setting range foreach my $i (1..@bend_notes - 1) { my $last_note = $note; $note = $bend_notes[$i]; #print "note=$note ; last_note=$last_note\n"; my $amount = ¬e_to_int($note) - ¬e_to_int($last_note); $amount = 0 - $amount if $amount < 0; $range = $amount if $amount > $range; } #print "range=$range\n"; $note = $first_note; @bend_tokens = ('$bend_range', $range, @bend_tokens); foreach my $i (1..@bend_notes - 1) { my $last_note = $note; $note = $bend_notes[$i]; my $total = ¬e_to_int($note) - ¬e_to_int($last_note); $total = int(($total * 64) / $range); #print "total bend amount = $total\n"; my $bent = 0; my $num_steps = int(int($divisions) / (@bend_notes - 1)); #print "num_steps = $num_steps\n"; for my $j (1..$divisions / (@bend_notes - 1)) { my $amount = int(($total - $bent) / (($num_steps) + 1 - $j)); $bent += $amount; $amount = "+$amount" if $amount >= 0; #print "amount per step = $amount\n"; push @bend_tokens, "$num:$denom" . $amount; } } @bend_tokens = (@bend_tokens, '}', '$bend_range', 2); } else { die "$line_refs[$current_token]: " . "error in first note of `$orig_token'\n"; } #print "@bend_tokens\n"; exit; return @bend_tokens; } ## ## unroll a repeat block ## sub get_repeat_tokens { my $i = shift; # position counter my $tokens; # string of tokens to return my $tmp; # tmp var my $token; # current token my $repeat; # number of times to repeat my $count = 1; # to count {} brackets $repeat = $tokens[$i] || die "$line_refs[$current_token]: missing number after \%repeat\n"; $i++; ($tokens[$i] eq '{') || die "$line_refs[$current_token]: missing { after \%repeat\n"; $i++; while (1) { if ($tokens[$i] eq '%repeat') { $tokens .= &get_repeat_tokens($i+1) . " "; $i = $current_token; } elsif ($tokens[$i] eq '{') { $tokens .= " $tokens[$i]"; $count++; } elsif ($tokens[$i] eq '}') { $count--; if ($count == 0) { for (1..$repeat) { $tmp .= "$tokens "; } $tokens = $tmp; $current_token = $i; last; } else { $tokens .= " $tokens[$i]"; } } else { $tokens .= " $tokens[$i]"; } $i++; } return $tokens; } ## ## unroll a define block ## sub unroll_define { my $i = shift; # position counter my $tokens; # string of tokens to return my $tmp; # tmp var my $token; # current token my $count = 1; # to count {} brackets ($tokens[$i] eq '{') || die "$line_refs[$current_token]: missing `{'" . " after \%define $tokens[$i-1]\n"; $i++; while (1) { if ($tokens[$i] eq '%repeat') { $tokens .= &get_repeat_tokens($i+1) . " "; $i = $current_token; } elsif ($tokens[$i] eq '{') { $tokens .= " $tokens[$i]"; $count++; } elsif ($tokens[$i] eq '}') { $count--; if ($count == 0) { $current_token = $i; last; } else { $tokens .= " $tokens[$i]"; } } else { $tokens .= " $tokens[$i]"; } $i++; } return $tokens; } ## ## Search for and parse the @head section ## sub parse_header_info { my $line; # current line my $token; # current token if ($debug) { print "parse_header_info()\n"; } while ($token = &get_next_token) { if ($token eq '@head') { if ($debug) { print "got \@head\n"; } (&get_next_token eq '{') || die "$line_refs[$current_token]:" . " after \@head: expected { ; found $_\n"; last; } } while ($token = &get_next_token) { if ($token eq '}') { if ($debug) { print "parse_h_i() got }\n"; } last; } else { $token =~ s/^\$//; if ($token eq 'title') { $token = &get_next_token; if ($token =~ /^\"[^\"]*$/) { $_ = $token; s/^.//; $header_info{'title'} = $_; while ($token = &get_next_token) { if ($token =~ /\"/) { $_ = $token; s/\"$//; $header_info{'title'} .= " $_"; last; } $header_info{'title'} .= " $token"; } } else { $header_info{'title'} = $token; } } elsif ($token eq 'resolution') { $header_info{'ticksperquarter'} = &get_next_token; } else { $header_info{$token} = &get_next_token || die "$line_refs[$current_token]:" . " missing value for $token\n"; if ($debug) { print "got header value $token = $header_info{$token}\n"; } } } } if ($tempo) { $header_info{'tempo'} = $tempo; } if (!$header_info{'tempo'}) { $header_info{'tempo'} = 80; } if (!$header_info{'ticksperquarter'}) { $header_info{'ticksperquarter'} = 96; } if ($header_info{'bar_strict'}) { $strict_bar = 1; } } ## ## Find the @body section of source ## sub find_body { my $token; # current token while ($token = &get_next_token) { if ($token eq '@body') { (&get_next_token eq '{') || die "$line_refs[$current_token]:" . " after \@body: expected { ; found $token\n"; last; } } } ## ## Find and parse @channel and %define blocks until end of the @body section ## sub find_next_channel { my $token; # current token undef $current_instrument; # text name of instrument while ($token = &get_next_token) { # print "DBG: token=$token\n"; if ($debug) { print "find_next_channel(): token = $token\n"; } if ($token eq '@channel') { $current_channel = &get_next_token || die "$line_refs[$current_token]:" . " missing channel number after \@channel\n"; if ($verbose) { print "found channel $current_channel\n"; } $token = &get_next_token; if ($token eq '{') { last; } elsif ($token =~ /^\"[^\"]*$/) { $_ = $token; s/^\"//; $current_instrument = $_; while ($token = &get_next_token) { if ($token =~ /\"/) { $_ = $token; s/\"$//; $current_instrument .= " $_"; last; } else { $current_instrument .= " $token"; } } (&get_next_token eq '{') || die "$line_refs[$current_token]:" . " expected \`{' ; found $_\n"; last; } else { $_ = $token; s/\"//g; $current_instrument = $_; (&get_next_token eq '{') || die "$line_refs[$current_token]:" . " expected \`{' ; found $_\n"; last; } } elsif ($token eq '%define') { &define_riff; } elsif ($token eq '}') { if ($verbose) { print "got end of body\n"; } $current_channel = -1; last; } else { die "$line_refs[$current_token]: Error parsing `$token'\n"; } } if (!$token) { $current_channel = -1; } } ## ## return the next token ## sub get_next_token { my $token; # next token to return ($token, @tokens) = @tokens; $current_token++; if ($debug) { print "current_token = $current_token ($token)\n"; } return $token; } ############################################ ## ## ## @@@SECTION: Random related subroutines ## ## ## ############################################ ## ## run eval code and return the output ## sub get_eval_tokens { my $i = shift; # position counter my $tokens; # string of tokens to return my $tmp; # tmp var my $token; # current token my $count = 1; # to count {} brackets unless ((defined $sandbox) or ($unsafe)) { die 'Can\'t run eval block without Safe.pm unless' . ' `--unsafe\' option is set.', "\n"; } ($tokens[$i] eq '{') || die "$line_refs[$current_token]: missing { after \%eval\n"; $i++; while (1) { if ($tokens[$i] eq '{') { $tokens .= " $tokens[$i]"; $count++; } elsif ($tokens[$i] eq '}') { $count--; if ($count == 0) { my $output; if (defined $sandbox) { print 'running eval code in sandbox', "\n" if $debug; $output = $sandbox->reval($tokens); die "Error during sandbox eval: $@\n" if $@; } else { print 'running eval code', "\n" if $debug; $output = eval($tokens); die "Error during eval: $@\n" if $@; } $tokens = ' ' . $output . ' '; $current_token = $i; last; } else { $tokens .= " $tokens[$i]"; } } else { $tokens .= " $tokens[$i]"; } $i++; } print "eval returned $tokens\n" if $debug; return $tokens; } ## ## choose from a list of weighted riffs/notes ## sub get_choose_token { my $pos = shift; # position counter my $token; # holds current token my @choices; # array of note/riff tokens to choose from my @weights; # array of weightings corresponding to choices my $weight; # total of weightings my $choice; # chosen token my $i; # loop counter my @tmp; # tmp array to use in rand() call print "get_choose_token()\n" if $debug; ($tokens[$pos] eq '{') || die "error: after \%choose: expected \`{' ; found $_\n"; $pos++; while (1) { if ($tokens[$pos] eq '}') { print "CHOOSE: got end of choose block\n" if $debug; $current_token = $pos; last; } else { if ($tokens[$pos] eq 'scale') { my $type = $tokens[$pos+1]; my $range = $tokens[$pos+2]; my $root; my $opts; if ($debug) { print 'CHOOSE: found scale keyword', "\n"; } if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) { $opts = $1; $root = $2; if (defined $5) { if ($3 > $5) { $root .= $5; $range = $3 - $5; } else { $root .= $3; $range = $5 - $3; } } else { $root .= $3; $range = 1; } } else { die 'error in choose block near' . " `@tokens[$pos..$pos+2]'\n"; } $pos += 3; unless ((defined $opts) and ($opts =~ /l\d+/)) { warn 'Warning: no length specified for scale in choose ' . 'block near ' . "`@tokens[$pos..$pos+2]'\n"; } if ($debug) { print 'SCALE: calling get_scale(' . "$type, $root, $range, $opts)\n"; } my $scale = &get_scale($type, $root, $range, $opts); if ($tokens[$pos] eq '[') { if ($debug) { print 'SCALE: parsing weight block', "\n"; } while (!($tokens[++$pos] eq ']')) { my $note = undef; if (@{@$scale} == 0) { die 'too many weighting values in choose block' . ", after scale $root\n"; } if ($tokens[$pos] =~ /^\d+$/) { ($note, @$scale) = @$scale; unless ($tokens[$pos] == 0) { push(@choices, $note); push(@weights, $tokens[$pos]); } } else { die "bad weighting value `$tokens[$pos]'" . " in choose block after scale $root\n"; } } if ($debug) { print 'SCALE: end of weighting block', "\n"; } $pos++; } else { push (@weights, 1) for (0..@{@$scale}-1); @choices = (@choices, @$scale); if ($debug) { print 'SCALE: used default weight for each note', "\n"; } } } else { if (!$tokens[$pos] =~ /^[0-9]+$/) { die "bad weighting value in choose block: $tokens[$pos]\n"; } @weights = (@weights, $tokens[$pos]); $pos++; if ($tokens[$pos] eq '}') { die "error: missing last item in choose block\n"; } @choices = (@choices, $tokens[$pos]); $pos++; if ($debug) { print "CHOOSE: got choice: " . "$weights[@weights-1] ; $choices[@choices-1]\n"; } } } } for ($i=1; $i<=@weights-1; $i++) { $weights[$i] += $weights[$i-1]; } $tmp[$weights[@weights-1]] = 1; $choice = int(rand(@tmp)); for ($i=0; $i<=@weights-1; $i++) { if ($weights[$i] >= $choice) { $choice = $choices[$i]; last; } } print "CHOOSE: returning $choice\n" if $debug; return $choice; } ## ## choose from a list of weighted riffs/notes ## sub get_time_choose_tokens { my $pos = shift; # position counter my $time; # amount of time to play for my $time_count = 0; # amount of time played so far my $length; # length of current note my $lastlength; # saves length of previous note my $token; # holds current token my @choices; # array of note/riff tokens to choose from my @weights; # array of weightings corresponding to choices my $weight; # total of weightings my $choices; # chosen tokens my $choice; # temp var for current choice my $rejects; # number of notes rejected as too long my $max_rejects; # max rejects before we give up and use a rest my $i; # loop counter my @tmp; # tmp array to use in rand() call my $tmp; # temp scalar print "get_time_choose_tokens()\n" if $debug; # read time value & translate to midi clicks if ($tokens[$pos] =~ /^0|-$/) { $time = 0; } elsif ($tokens[$pos] =~ /^\d+(:\d+)?$/) { $time = &time_to_clicks($tokens[$pos]); } else { die "bad time value in choose block " . "at \`\%choose $tokens[$pos]\n"; } $pos++; ($tokens[$pos] eq '{') || die "error: after \%choose $time: expected \`{' ; found $_\n"; $pos++; while (1) { if ($tokens[$pos] eq '}') { print "CHOOSE: got end of choose block\n" if $debug; $current_token = $pos; last; } elsif ($tokens[$pos] =~ /^(rhythm|times)$/) { ($tokens[++$pos] eq '{') || die "after $tokens[$pos-1]: expected \`{' ; found $_\n"; print "CHOOSE: got start of rhythm block\n" if $debug; $pos++; last; } else { if ($tokens[$pos] eq 'scale') { my $type = $tokens[$pos+1]; my $range = $tokens[$pos+2]; my $root; my $opts; if ($debug) { print 'CHOOSE: found scale keyword', "\n"; } if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) { $opts = $1; $root = $2; if (defined $5) { if ($3 > $5) { $root .= $5; $range = $3 - $5; } else { $root .= $3; $range = $5 - $3; } } else { $root .= $3; $range = 1; } } else { die 'error in choose block near' . " \`@tokens[$pos..$pos+2]\'\n"; } if ($time) { unless ((defined $opts) and ($opts =~ /l\d+/)) { #FIXME warn 'Warning: no length specified for scale in' . " choose block near `@tokens[$pos..$pos+2]'\n"; } } $pos += 3; if ($debug) { print 'SCALE: calling get_scale(' . "$type, $root, $range, $opts)\n"; } my $scale = &get_scale($type, $root, $range, $opts); if ($tokens[$pos] eq '[') { if ($debug) { print 'SCALE: parsing weight block', "\n"; } while (!($tokens[++$pos] eq ']')) { my $note = undef; if (@{$scale}-1 == -1) { die 'too many weighting values in choose block' . ", after scale $root\n"; } if ($tokens[$pos] =~ /^\d+$/) { ($note, @$scale) = @$scale; unless ($tokens[$pos] == 0) { push(@choices, $note); push(@weights, $tokens[$pos]); } } else { die "bad weighting value \`$tokens[$pos]\'" . " in choose block after scale $root\n"; } } if ($debug) { print 'SCALE: end of weighting block', "\n"; } $pos++; } else { push (@weights, 1) for (0..@$scale-1); @choices = (@choices, @$scale); if ($debug) { print 'SCALE: used default weight for each note', "\n"; } } } else { unless ($tokens[$pos] =~ /^[0-9]+$/) { die "bad weighting value in choose block: $tokens[$pos]\n"; } @weights = (@weights, $tokens[$pos]); $pos++; if ($tokens[$pos] eq '}') { die "error: missing last item in choose block\n"; } @choices = (@choices, $tokens[$pos]); $pos++; if ($debug) { print "CHOOSE: got choice: " . "$weights[@weights-1] ; $choices[@choices-1]\n"; } } } } for ($i=1; $i<=@weights-1; $i++) { $weights[$i] += $weights[$i-1]; } $tmp[$weights[@weights-1]] = 1; $max_rejects = (@weights-1) * 0.75; while (1) { # if not time limited get the next rhythm token if ($time == 0) { if ($tokens[$pos] eq '}') { print "CHOOSE: got end of rhythm block\n" if $debug; $pos++; last; } # pick a note if needed elsif ($tokens[$pos] =~ /^(\/\S+\/)?(\d+(:\d+)?)(x(\d+))?$/) { my $opts = $1; my $len = $2; my $rpt = $5; $opts = '//' unless (defined $opts); if ($opts =~ /l\d+/) { warn "removing length from $tokens[$pos]" . " in choose block\n"; $opts =~ s/l\d+(:\d+)?//; } $opts =~ s/^\//\/l$len/; $rpt = 1 unless ($rpt > 1); for (1..$rpt) { $choice = -1; my $rand = int(rand(@tmp)); for ($i=0; $i<=@weights-1; $i++) { if ($weights[$i] >= $rand) { $choices .= ' ' . $opts . $choices[$i]; last; } } } $pos++; } # otherwise pass the token through else { $tokens[$pos] =~ s/^_//; $choices .= ' ' . $tokens[$pos++]; } } # else pick a note and check it fits withing the time limit else { $choice = -1; my $rand = int(rand(@tmp)); for ($i=0; $i<=@weights-1; $i++) { if ($weights[$i] >= $rand) { $choice = $choices[$i]; last; } } # make sure we picked a note next if ($choice == -1); # check if note fits within $time if ($choice =~ /\/l(([0-9]+:)?[0-9]+)/) { $length = &time_to_clicks($1); } else { die "in choose block, item \`$choice' has no length\n"; } # remove the length value if the item is a predefined riff if ($choice =~ /\/\S+\/(~\S+)$/) { $choice = $1; } if ($debug) { print "TIMECHOOSE: count,length,time = " . "$time_count ; $length ; $time\n"; } if (($time_count + $length) <= $time) { print "TIMECHOOSE: chosen $choice\n" if $debug; $choices .= " $choice"; $time_count += $length; if ($time_count == $time) { last; } } else { print "TIMECHOOSE: rejected $choice\n" if $debug; $rejects++; if ($rejects >= $max_rejects) { # fill remaining time with a rest & give up $choice = &clicks_to_time($time - $time_count); $choices .= " /l$choice/r"; last; } $weights[$i] = $weights[$i-1]; } } } $current_token = $pos; return $choices; } ## ## return a string of tokens from a %chain block ## sub get_chain_tokens { my $pos = shift; # position counter my $choices; # tokens to return my $chain; # reference to the chain structure my $chain_start; # note to start from my $time; # how long to play for if limited my $needlength; # whether note length needs to be specified print "get_chain_tokens()\n" if $debug; # read time value & translate to midi clicks if ($tokens[$pos] =~ /^[-0]$/) { $time = 0; } elsif ($tokens[$pos] =~ /^(([0-9]+:)?[0-9]+)$/) { $time = &time_to_clicks($tokens[$pos]); } else { die "bad time value in chain block " . "at \`\%chain $tokens[$pos]\n"; } $pos++; ($tokens[$pos] eq '{') || die "error: after \%chain $time: expected \`{' ; found $_\n"; $pos++; print "CHAIN: parsing chain structure\n" if ($debug); while (1) { if (!(defined($tokens[$pos]))) { die "unexpected EOF in chain block\n"; } elsif ($tokens[$pos] eq '}') { print "CHAIN: got end of chain block\n" if $debug; $current_token = $pos; last; } elsif ($tokens[$pos] =~ /^(rhythm|times)$/) { # parse the rhythm tokens $pos++; if ($time > 0) { ($choices, $pos) = &get_closed_chain_tokens($pos, $chain, $time, $chain_start); } else { ($choices, $pos) = &get_open_chain_tokens($pos, $chain, $time, $chain_start); } } elsif ($tokens[$pos] eq 'start') { $pos++; $chain_start = $tokens[$pos]; print "CHAIN: got start note $chain_start\n" if $debug; $pos++; } elsif ($tokens[$pos] eq 'scale') { if (scalar keys %{$$chain{'notes'}} > 0) { die "cannot add scale to existing chain\n"; } else { ($chain, $pos, $needlength) = &get_scale_chain($pos, $time); $needlength = ($needlength != 0); die "error building chain structure\n" unless (defined $$chain{'notes'}); } } else { ($chain, $pos) = &get_chain($pos); die "error building chain structure\n" unless (defined $$chain{'notes'}); } } return $choices; } ## ## Build a chain structure from individual notes. ## Return the chain and current position. ## sub get_chain { my $pos = shift; my %chain; my $start_note; while (1) { if (!(defined($tokens[$pos]))) { die "unexpected EOF in chain block\n"; } if ($tokens[$pos] =~ /^(rhythm|times)$/) { print "CHAIN: got start of rhythm block\n" if $debug; last; } else { $start_note = $tokens[$pos]; $pos++; ($tokens[$pos] eq '[') || die "in chain block, after \`$tokens[$pos-1]':" . "expected \`[' ; found $tokens[$pos]\n"; $pos++; my $lcount = 0; if ($debug) { print "CHAIN: looking for links for $start_note\n"; } while (my $token = $tokens[$pos]) { my $weights; if ($token eq ']') { if ($debug) { print "CHAIN: got last link for $start_note\n"; } $weights = \@{$chain{'notes'}{$start_note}{'weights'}}; for my $i (1..@$weights-1) { $$weights[$i] += $$weights[$i-1]; } $pos++; last; } elsif ($token =~ /^\d+$/) { $chain{'notes'}{$start_note}{'weights'}[$lcount] = $token; } else { die "in chain block, bad weighting value \`$token'\n"; } $pos++; # if we get a bad note here it will be picked # up in get_note_bytes() $chain{'notes'}{$start_note}{'links'}[$lcount] = $tokens[$pos]; $lcount++; $pos++; } } } return (\%chain, $pos); } ## ## Build a chain structure from a scale. ## Return the chain and current position. ## sub get_scale_chain { my ($pos, $time) = @_; my $chain; # structure to return my $got_length = 0; # whether the note length is specified my $type = $tokens[$pos+1]; my $range = $tokens[$pos+2]; my $root; my $opts; if ($range =~ /^(\/\S+\/)?([a-g][-+]?)(\d+)(-(\d+))?$/) { $opts = $1; $root = $2; if (defined $5) { if ($3 > $5) { $root .= $5; $range = $3 - $5; } else { $root .= $3; $range = $5 - $3; } } else { $root .= $3; $range = 1; } } else { die 'bad scale range in chain block near' . " `@tokens[$pos..$pos+2]'\n"; } if ($time) { unless ((defined $opts) and ($opts =~ /l\d+/)) { #FIXME warn 'Warning: no length specified for scale in chain ' . 'block near ' . "`@tokens[$pos..$pos+2]'\n"; } } $pos += 3; if ($debug) { print 'CHAIN_SCALE: calling get_scale(' . "$type, $root, $range, $opts)\n"; } my $scale = &get_scale($type, $root, $range, $opts); # Parse the weighting matrix ($tokens[$pos] eq '[') or die "in chain block, after scale @tokens[$pos-2..$pos-1]," . "expected `['; found $tokens[$pos]\n"; $pos++; my $max = @{$scale}-1; my %chain; my @extras; for my $i (0..$max) { for my $j (0..$max) { my $value = $tokens[$pos++]; die "bad weighting value $tokens[$pos-1]\n" unless ($value =~ /^\d+$/); if ($value > 0) { push @{$$chain{'notes'}{$$scale[$i]}{'links'}}, $$scale[$j]; push @{$$chain{'notes'}{$$scale[$i]}{'weights'}}, $value; } } } ($tokens[$pos] eq ']') or die "in chain block, expected closing `]' of scale" . " weighting matrix; found $tokens[$pos]\n"; $pos++; print "CHAIN_SCALE: got end of weighting matrix\n" if ($debug); # add any extra notes to the chain while (1) { if ($tokens[$pos] =~ /^(rhythm|times)$/) { print "CHAIN_SCALE: got start of rhythm block\n" if ($debug); last; } elsif ($tokens[$pos] =~ /^(\/\S+\/)?[a-gr][-+=]?(\d+)?$/) { my $note = $tokens[$pos++]; # add links from new note to existing notes # link to new note itself is last. ($tokens[$pos] eq '[') or die "in chain block, after $note" . " expected weighting block (`['); found $tokens[$pos]\n"; $pos++; my $max = scalar keys %{$$chain{'notes'}}; my $ns = @{$scale}-1; my $ne = $ns + scalar @extras; for my $i (0..$max) { my $value = $tokens[$pos++]; die "bad weighting value $tokens[$pos-1]\n" unless ($value =~ /^\d+$/); if ($value > 0) { if ($i <= $ns) { push @{$$chain{'notes'}{$note}{'links'}}, $$scale[$i]; } elsif ($i <= $ne) { push @{$$chain{'notes'}{$note}{'links'}}, $extras[$i]; } else { push @{$$chain{'notes'}{$note}{'links'}}, $note; } push @{$$chain{'notes'}{$note}{'weights'}}, $value; } } ($tokens[$pos] eq ']') or die "in chain block, after $note expected end of" . " weighting block; found $tokens[$pos]\n"; $pos++; # add links from existing notes to new note ($tokens[$pos] eq '[') or die "in chain block, after $note expected 2nd " . "weighting block (`['); found $tokens[$pos]\n"; $pos++; $max--; # one less link as -->self already known for my $i (0..$max) { my $value = $tokens[$pos++]; die "bad weighting value $tokens[$pos-1]\n" unless ($value =~ /^\d+$/); if ($value > 0) { if ($i <= $ns) { push @{$$chain{'notes'}{$$scale[$i]}{'links'}}, $note; } elsif ($i <= $ne) { push @{$$chain{'notes'}{$$scale[$i]}{'links'}}, $extras[$i]; } else { die "tried to add too many backward links" . "while adding `$note' to chain\n"; } push @{$$chain{'notes'}{$$scale[$i]}{'weights'}}, $value; } } ($tokens[$pos] eq ']') or die "in chain block, after $note expected end of" . " 2nd weighting block (`]'); found $tokens[$pos]\n"; print "CHAIN_SCALE: added note $note to chain\n" if $debug; push @extras, $note; $pos++; } else { die "bad token `$tokens[$pos]' in chain block" . " (expected note or `rhythm')\n"; } } # make the weightings cumulative foreach my $note (keys %{$$chain{'notes'}}) { my $weights = \@{$$chain{'notes'}{$note}{'weights'}}; for my $i (1..@{$weights}-1) { $$weights[$i] += $$weights[$i-1]; } } # use Data::Dumper; # my $d = Data::Dumper->new([$chain]); # $d->Purity(1)->Terse(1)->Deepcopy(1); # print $d->Dump; # exit; return ($chain, $pos, $got_length); } ## ## Parse and run a time limited rhythm block ## sub get_closed_chain_tokens { my ($pos, $chain, $time, $chain_start) = @_; my $start_note; my $rcount = 0; my $choices; # tokens to return my $time_count; my $sequential; my $rejects = 0; my $max_rejects; # parse the rhythm block if ($tokens[$pos] eq '{') { if ($debug) { print "CHAIN: found sequential rhythm section\n"; } $sequential = 1; $pos++; while (my $token = $tokens[$pos]) { if ($token eq '}') { if ($debug) { print "CHAIN: got end of rhythm block\n"; } $pos++; last; } push @{$$chain{'rhythm'}}, $token; $pos++; } } elsif ($tokens[$pos] eq '[') { print "CHAIN: found random rhythm section\n" if $debug; $pos++; my $rlinks = \@{$$chain{'rhythm'}{'links'}}; my $rweights = \@{$$chain{'rhythm'}{'weights'}}; while (my $token = $tokens[$pos]) { if ($token eq ']') { if ($debug) { print "CHAIN: got end of rhythm block\n"; } for my $i (1..@{$rweights}-1) { $$rweights[$i] += $$rweights[$i-1]; } $pos++; last; } elsif ($token =~ /^\d+$/) { $$rweights[$rcount] = $token; } else { die "in chain block, bad rhythm weighting:" . " $token\n"; } $pos++; $token = $tokens[$pos]; if ($token =~ /^(\d+:)?\d+$/) { $$rlinks[$rcount] = $token; } else { die "in chain block, bad time value: $token\n"; } $pos++; $rcount++; } } else { die "in chain block, expecting \`{' or \`['" . " ; found \`$tokens[$pos]'\n"; } # sanity check on rhythm if (!$sequential) { if ((!defined($$chain{'rhythm'}{'links'}[0])) || (!defined($$chain{'rhythm'}{'weights'}[0]))) { die "in chain block, rhythm section missing or incomplete\n"; } } else { if (!defined($$chain{'rhythm'}[0])) { die "in chain block, rhythm section missing or incomplete\n"; } } # choose a start note if (defined($chain_start)) { $start_note = $chain_start; } else { my @allnotes = keys(%{$$chain{'notes'}}); $start_note = $allnotes[rand(@allnotes-1)]; } print "CHAIN: starting loop from note `$start_note'\n" if $debug; # loop thru the chain while (1) { my $weights = \@{$$chain{'notes'}{$start_note}{'weights'}}; my $links = \@{$$chain{'notes'}{$start_note}{'links'}}; my $choice; my $rtoken; my $length; my $i; # sanity check if ((!defined($$links[0])) || (!defined($$weights[0]))) { die "in chain block, $start_note is a dead end\n"; } # start from chain_start if defined if (defined($chain_start)) { $choice = $start_note; undef $chain_start; } # else pick a random start note else { $choice = -1; my $rand = int(rand($$weights[@{$weights}-1]+1)); for $i (0..@{$weights}-1) { if ($$weights[$i] >= $rand) { $choice = $$links[$i]; last; } } } # make sure we picked a note if ($choice == -1) {next;} elsif ($debug) { print "CHAIN: chose $choice, checking length\n"; } # get length and check if it fits if ($sequential) { $rtoken = $$chain{'rhythm'}[$rcount]; } else { my $rlinks = \@{$$chain{'rhythm'}{'links'}}; my $rweights = \@{$$chain{'rhythm'}{'weights'}}; my $rand = int(rand($$rweights[@{$rweights}-1]+1)); for $i (0..@{$rweights}-1) { if ($$rweights[$i] >= $rand) { $rtoken = $$rlinks[$i]; last; } } } $length = &time_to_clicks($rtoken); if ($debug) { print "CHAIN: count,rcount,length,time = " . "$time_count ; $rcount ; $length ; $time\n"; } if (($time_count + $length) <= $time) { print "CHAIN: chosen $choice\n" if ($debug); $choices .= " /l$rtoken/$choice"; $time_count += $length; if ($sequential) { $rcount++; $rcount = 0 if ($rcount > @{$$chain{'rhythm'}}-1); } $start_note = $choice; if ($time_count == $time) { last; } } else { print "CHAIN: rejected $choice\n" if ($debug); $rejects++; if ($rejects >= $max_rejects) { # fill remaining time with a rest & give up $choice = &clicks_to_time($time - $time_count); $choices .= " /l$choice/r"; last; } $$weights[$i] = $$weights[$i-1]; } } return ($choices, $pos); } ## ## Parse and run a non time limited chain rhythm block ## Return the chosen tokens and current position ## sub get_open_chain_tokens { my ($pos, $chain, $chain_start) = @_; my $start_note; # note to start on my $choice; # current choice my $choices; # tokens to return # parse the rhythm tokens $pos++; ($tokens[$pos] eq '{') || die "after $tokens[$pos-1]:" . " expected \`{' ; found $_\n"; print "CHAIN-OPEN: start of rhythm block\n" if $debug; $pos++; # choose a start note if (defined($chain_start)) { $start_note = $chain_start; } else { my @allnotes = keys(%{$$chain{'notes'}}); $start_note = $allnotes[rand(@allnotes-1)]; } while (1) { my $weights = \@{$$chain{'notes'}{$start_note}{'weights'}}; my $links = \@{$$chain{'notes'}{$start_note}{'links'}}; # sanity check if ((!defined($$links[0])) || (!defined($$weights[0]))) { die "in chain block, $start_note is a dead end\n"; } # start from chain_start if defined if (defined($chain_start)) { $choice = $start_note; undef $chain_start; } if ($tokens[$pos] eq '}') { print "CHAIN-OPEN: got end of rhythm block\n" if ($debug); $pos++; last; } # pick a note if needed elsif ($tokens[$pos] =~ /^(\/\S+\/)?(\d+(:\d+)?)(x(\d+))?$/) { my $opts = $1; my $len = $2; my $rpt = $5; $opts = '//' unless (defined $opts); if ($opts =~ /l\d+/) { warn "removing length from $tokens[$pos]" . " in chain block\n"; $opts =~ s/l\d+(:\d+)?//; } $opts =~ s/^\//\/l$len/; $rpt = 1 unless ($rpt > 1); for (1..$rpt) { $choice = -1; my $rand = int(rand($$weights[@{$weights}-1]+1)); for my $i (0..@{$weights}-1) { if ($$weights[$i] >= $rand) { $choice = $$links[$i]; $start_note = $choice; $choices .= ' ' . $opts . $choice; $weights = \@{$$chain{'notes'} {$start_note}{'weights'}}; $links = \@{$$chain{'notes'} {$start_note}{'links'}}; if ((!defined($$links[0])) || (!defined($$weights[0]))) { die "in chain block, $start_note" . " is a dead end\n"; } last; } } } $pos++; } # otherwise pass the token through else { $tokens[$pos] =~ s/^_//; $choices .= ' ' . $tokens[$pos++]; } } return ($choices, $pos); } ## ## compose some serial(ish) music (unfinished) ## sub get_serial_tokens { my $pos = shift; my $time; # length of output if ($tokens[$pos] =~ /^[-0]$/) { $time = 0; } elsif ($tokens[$pos] =~ /^(\d+)(:(\d+))?$/) { $time = &time_to_clicks($tokens[$pos]); } else { die "bad time value `$tokens[$pos] after \%serial\n"; } $pos++; my $root; # root note my $range; # mumber of octaves if ($tokens[$pos++] =~ /^([a-g][-+]?)(\d+)(-(\d+))?$/) { if (defined $4) { if ($4 > $2) { $range = $4 - $2; $root = $1 . $2; } elsif ($2 > $4) { $range = $2 - $4; $root = $1 . $4; } } else { $root = $1 . $2; $range = 1; } } ($tokens[$pos] eq '{') || die "after \%serial $tokens[$pos-2] $tokens[$pos-1]\n"; my $scale = &get_scale('chromatic', $root, $range); pop(@$scale) ; # lose the last note my @flags; # { style rhythm block if ($time == 0) { # copy code from g_t_c_t() } # [ style rhythm block elsif ($tokens[$pos] eq '[') { # copy code from g_chain_t() } # no rhythm block else { # copy code from g_t_c_t() } return undef; } ##################################### ## ## ## @@@SECTION: Utility subroutines ## ## ## ##################################### ## ## return the size of a section of data ## ## @param 1 - the data ## @param 2 - flag 1 = return a variable length quantity ## 0 = return a number ## sub get_data_size { if ($debug) { print "get_data_size()\n"; } my $data = shift; # data we want the length of my $varlen = shift; # wether we want $size as a variable length quantity my $size; # data size to return my @temp; # tmp array $size = length $data; if ($debug) { print "data:\n@temp\n"; print "data_size = $size\n"; } if ($varlen) { $size = &get_delta_time($size); } else { $size = &get_four_bytes($size); } return $size; } ## ## return bytes from int (for dtime) ## sub get_delta_time { my $dtime = shift; # delta time as an int my @bytes; # array to hold the bytes my $result = $dtime; # result of division my $remainder; # remainder after division my $i = 0; # counter my $data; # data to return if ($debug) { print "dtime=$dtime\n"; } if ($dtime < 128) { $data = pack("C", $dtime); } else { # will need to reverse bytes after while (1) { $dtime = $result; # makes sense second time around :) if ($result < 1) { last; } else { $result = $dtime / 128; $bytes[$i] = $dtime % 128; if ($debug) { print "\nres=$result ; rem=$bytes[$i]\n"; } if ($i > 0) { $bytes[$i] |= 0x80; } $i++; } } for ($i=0; $i<=@bytes-1; $i++) { $data = pack("C", $bytes[$i]) . $data; } } return $data; } ## ## get the midi style denominator for the time sig ## sub get_time_denom { my $sig_denom = shift; # denominator as an int my $denom; # encoded denominator to return if ($sig_denom == 4) { $denom = 2; } elsif ($sig_denom == 8) { $denom = 3; } elsif ($sig_denom == 16) { $denom = 4; } elsif ($sig_denom == 32) { $denom = 5; } elsif ($sig_denom == 64) { $denom = 6; } return $denom; } ## ## return the tempo in bytes (without delta time) ## sub get_tempo_bytes { my $tempo = shift; # tempo $tempo = $header_info{'tempo'} unless defined $tempo; $tempo = 60000000 / $tempo; if ($debug) { print "tempo is $tempo\n"; } return $midi_tempo . pack("C", 3) . &get_three_bytes($tempo); } ## ## return the time signature in bytes (without delta time) ## sub get_time_sig_bytes { my $time = shift; $time = $header_info{'time_sig'} unless defined $time; my $data = $midi_time_sig; if ($time =~ /([0-9]+)\/([0-9]+)/) { $data .= pack("CCCCC", 4, $1, &get_time_denom($2), 24, 8); } else { die "bad \$time_sig: $time\n"; } return $data; } ## ## convert int to three bytes ## sub get_three_bytes { my $data; # data to return my $number = shift; # number to encode my @bytes; # encoded bytes $bytes[0] = $number / 0x10000; $number %= 0x10000; $bytes[1] = $number / 0x100; $number %= 0x100; $bytes[2] = $number; $data = pack("CCC", $bytes[0], $bytes[1], $bytes[2]); return $data; } ## ## convert 32 bit integer to four bytes ## sub get_four_bytes { my $number = shift; # number to encode my @bytes; # encoded bytes my $data; # data to return $bytes[0] = $number / 0x1000000; #16777216 $number %= 0x1000000; $bytes[1] = $number / 0x10000; #65536 $number %= 0x10000; $bytes[2] = $number / 0x100; #256 $number %= 0x100; $bytes[3] = $number; $data = pack("CCCC", $bytes[0], $bytes[1], $bytes[2], $bytes[3]); return $data; } sub get_quoted_string { my $string = &get_next_token; if ($string =~ /^\"/) { my $quote_start = $line_refs[$current_token]; my $quote_first = $string; while ($string !~ /\"$/) { my $token = &get_next_token; unless (defined $token) { die 'hit EOF while looking for end of quote' . " starting with $quote_first at $quote_start\n"; } $string .= " $token"; } $string =~ s/^.(.*).$/$1/; } return $string; } ## ## return note number for a note string. ## ## @param 1: The note token. ## @param 2: Flag (0=normal, 2=no strict). ## sub note_to_int { my ($note, $flag) = @_; # note string my ($name, $sharp); # note name and sharp/flat character if present my $octave = 0; # note octave my $int; # note number to return return ¬e_to_int_strict($note, $flag) if $strict_key and not (defined $flag and $flag == 2); if ($note =~ /([a-g])(\+|-)?([0-9])?$/) { $name = $1; $sharp = $2; if ($3) { $octave = $3; $old{'octave'} = $3; } } else { die "$line_refs[$current_token]: " . "bad note: $note\n"; } if (!$octave) { $octave = $old{'octave'}; } $int = 12 * $octave; if ($name =~ /^a$/i) {$int += 9;} elsif ($name =~ /^b$/i) {$int += 11;} elsif ($name =~ /^d$/i) {$int += 2;} elsif ($name =~ /^e$/i) {$int += 4;} elsif ($name =~ /^f$/i) {$int += 5;} elsif ($name =~ /^g$/i) {$int += 7;} if ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } print "NTI(): $note ; $int\n" if $debug; return $int; } ## ## return note number for a note string with sharps and flats implied ## by the key ## ## @param 1: The note token. ## @param 2: Flag (0=normal, 1=no recurse). ## @return: The MIDI note number. ## sub note_to_int_strict { my ($note, $flag) = @_; # note string my ($name, $sharp); # note name and sharp/flat token my $octave = 0; # note octave my $int; # note number to return my $key = $header_info{'key'}; # temporary copy of the key if ($note =~ /([a-g])(\+|-|=)?([0-9])?$/) { $name = $1; $sharp = $2; if ($3) { $octave = $3; $old{'octave'} = $3; } } else { die "$line_refs[$current_token]: " . "bad note: $note\n"; } if (!$octave) { $octave = $old{'octave'}; } # Fix for minor keys if ($key =~ s/m//) { $key = &relative_major("${key}m"); print "NTIS($note, $key)\n" if $debug; } $int = 12 * $octave; if ($name =~ /^a$/i) { $int += 9; if ($key =~ /[eadg]-/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($key =~ /^b$|f\+/i) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^b$/i) { $int += 11; if ($key =~ /^f$|[beadg]-/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^c$/i) { if ($key =~ /^[daeb]$|f\+/i) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($key =~ /^g-$/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^d$/i) { $int += 2; if ($key =~ /^[eb]$|f\+/i) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($key =~ /[adg]-/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^e$/i) { $int += 4; if ($key =~ /[beadg]-/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($key =~ /f\+/) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^f$/i) { $int += 5; if ($key =~ /^[gdaeb]$|f\+/i) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } elsif ($name =~ /^g$/i) { $int += 7; if ($key =~ /^[aeb]$|f\+/i) { $int++ unless $sharp eq '='; if ($sharp eq '-') { $int -= 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($key =~ /[dg]-/i) { $int-- unless $sharp eq '='; if ($sharp eq '+') { $int += 2; warn "Warning: $line_refs[$current_token]: " . "$name$sharp specified in key $header_info{'key'}\n"; } } elsif ($sharp eq '+') { $int++; } elsif ($sharp eq '-') { $int--; } } if ($key =~ /c-/i) {$int--;} elsif ($key =~ /c\+/) {$int++;} # Fix the octave unless (defined $flag and $flag == 1) { my $root_int = $header_info{'key'}; $root_int =~ s/m//i; $root_int .= $octave; $root_int = ¬e_to_int($root_int, 1); $int += 12 if $root_int > $int and $int >= 12 * $octave; print "NTIS(): $note ; $int\n" if $debug; } return $int; } ## ## return the relative major of the given minor key. ## sub relative_major { my $key = shift; die "$line_refs[$current_token]: " . "major key $key passed to sub relative_major()\n" if $key !~ /m/; &init_relative_majors unless defined $relative_majors; $key = $relative_majors->{"$key"}; die "$line_refs[$current_token]: " . "cannot find relative major for key $key\n" unless defined $key; return $key; } ## ## return a note string from a note number ## sub int_to_note { my ($orig_int, $no_strict) = @_; # number to convert to note string my ($name, $octave); # name and octave of note my $note; # note string to return my $int = $orig_int; # copy of int which gets changed in # the calculation return &int_to_note_strict($orig_int) if $strict_key and not $no_strict; $octave = int($int / 12); $int = $int % 12; if ($int == 11) {$name = 'b';} elsif ($int == 10) {$name = 'a+';} elsif ($int == 9) {$name = 'a';} elsif ($int == 8) {$name = 'g+';} elsif ($int == 7) {$name = 'g';} elsif ($int == 6) {$name = 'f+';} elsif ($int == 5) {$name = 'f';} elsif ($int == 4) {$name = 'e';} elsif ($int == 3) {$name = 'd+';} elsif ($int == 2) {$name = 'd';} elsif ($int == 1) {$name = 'd-';} else {$name = 'c';} $note = "$name$octave"; print "ITN(): $orig_int ; $note\n" if $debug; return $note; } ## ## return a note string from a note number with sharps and flats implied ## by the key ## sub int_to_note_strict { my $orig_int = shift; # number to convert to note string my ($name, $octave); # name and octave of note my $note; # note string to return my $int = $orig_int; # copy of int which gets changed in the calculation $octave = int($int / 12); $int = $int % 12; if ($int == 11) { $name = 'b'; if ($header_info{'key'} =~ /g-/i) { $name = 'c-'; } } elsif ($int == 10) { $name = 'a+'; if ($header_info{'key'} =~ /^f$|[beadg]-/i) { $name = 'b-'; } } elsif ($int == 9) { $name = 'a'; } elsif ($int == 8) { $name = 'g+'; if ($header_info{'key'} =~ /[eadg]-/i) { $name = 'a-'; } } elsif ($int == 7) { $name = 'g'; } elsif ($int == 6) { $name = 'f+'; if ($header_info{'key'} =~ /[gd]-/i) { $name = 'g-'; } } elsif ($int == 5) { $name = 'f'; if ($header_info{'key'} =~ /f\+/i) { $name = 'e+'; } } elsif ($int == 4) { $name = 'e'; } elsif ($int == 3) { $name = 'd+'; if ($header_info{'key'} =~ /[beadg]-/i) { $name = 'e-'; } } elsif ($int == 2) { $name = 'd'; } elsif ($int == 1) { $name = 'c+'; if ($header_info{'key'} =~ /[adg]-/i) { $name = 'd-'; } } else { $name = 'c'; } $note = "$name$octave"; print "ITNS(): $orig_int ; $note\n" if $debug; return $note; } ## ## return time in midi clicks given n:d ## sub time_to_clicks { my $time = shift; # time in n:d my $clicks; # No. of clicks, to return my $tmp; # temp var if ($debug) { print "time_to_clicks($time)\n"; } if ($time =~ /((\d+(\.\d+)?):)?([0-9]+)/) { if ($1) { $tmp = $2; } else { $tmp = 1; } $clicks = ($header_info{'ticksperquarter'} * 4 * $tmp) / $4; } else { print "TIME2CLICKS: error\n" if $debug; $clicks = -1; } print "time_to_clicks: returning $clicks\n" if $debug; return $clicks; } ## ## return an `n:d' format time from a number of clicks ## sub clicks_to_time { my $clicks = shift; # time in clicks my $time; # n:d value to return my $res = 256; # resolution to work to (256 => 1/256th note) $time = ($clicks * ($res / 4)) / $header_info{'ticksperquarter'}; if ($res / $time == int($res / $time)) { $time = $res / $time; } else { foreach my $i (2, 3, 5, 7, 11, 13, 17, 19) { while (($time / $i == int($time / $i)) and ($res / $i == int($res / $i))) { $time /= $i; $res /= $i; } } $time = "$time:$res"; } return $time; } ## ## return a random value from a range string `n-m' ## or return unchanged arg if it is a single value ## sub get_range_value { $_ = shift; if (/^(\d+)-(\d+)$/) { my $val = $1 + int(rand($2-$1)); return $val; } return $_; } ## ## Print an error message with appropriate line reference and qoute, ## exiting unless the caller signals that this is only a warning. ## ## Not used and won't work without changes to other line_refs code. ## ## @param 1: The error message. ## @param 2: True if this is only a warning, otherwise we exit. ## sub midge_error { my $point = $current_token; my $line_ref = undef; my @real_quote; my @gen_quote; while (1) { last if $point < 0; last if defined $line_ref and @real_quote >= $error_quote_level; if (defined $line_refs[$point]) { $line_ref = $line_refs[$point] unless defined $line_ref; push @real_quote, $tokens[$line_ref]; } else { push @gen_quote, $tokens[$point] if @gen_quote < $error_quote_level; } $point--; } my $real_quote = undef; $real_quote = join ' ', @real_quote if @real_quote; my $gen_quote = undef; $gen_quote = join ' ', @gen_quote if @gen_quote; my $msg = undef; if (defined $line_ref) { $msg = "$line_ref: $_[0]\nnear "; if (defined $gen_quote) { $msg .= "`$gen_quote' \ngenerated from `$real_quote'"; } elsif (defined $real_quote) { $msg .= "`$real_quote'"; } else { $msg .= '(unable to find source)'; } } else { $msg = "Error: $_[0]\n(unable to find source)"; } warn $msg if defined $_[1] and $_[1]; die $msg; } ########################################## ## ## ## @@@SECTION: Initialising subroutines ## ## ## ########################################## ## ## seed the random number generator if needed ## sub init_rand { if (defined $seed) { srand $seed; } elsif ($] < 5.004) { srand; } } ## ## try to load Safe.pm ## sub init_sandbox { unless ($unsafe) { eval " use Safe; "; unless ($@) { $sandbox = Safe->new; $sandbox->permit_only(qw(:base_core :base_math :base_mem)); } } } ## ## set up scale data ## sub init_scales { %scales = ( major => [2,2,1,2,2,2,1], minor => [2,1,2,2,1,2,2], minor_harmonic => [2,1,2,2,1,3,1], minor_jazz => [2,1,2,2,2,2,1], # =ascending melodic minor bebop => [2,2,1,2,1,1,2,1], bebop_dorian => [2,1,1,1,2,2,1,2], bebop_mixolydian => [2,2,1,2,2,1,1,1], ionian => [2,2,1,2,2,2,1], # =major dorian => [2,1,2,2,2,1,2], phrygian => [1,2,2,2,1,2,2], lydian => [2,2,2,1,2,2,1], mixolydian => [2,2,1,2,2,1,2], aeolian => [2,1,2,2,1,2,2], locrian => [1,2,2,1,2,2,2], minor_pentatonic => [3,2,2,3,2], major_pentatonic => [2,2,3,2,3], chromatic => [1,1,1,1,1,1,1,1,1,1,1,1], whole_tone => [2,2,2,2,2,2], arabian => [2,2,1,1,2,2,2], spanish => [1,3,1,2,1,2,2], gypsy => [1,3,1,2,1,3,1], ); } ## ## set up patch list ## sub init_patch_list { $patches{'piano_grand_ac'} = 1; $patches{'piano_br'} = 2; $patches{'piano_grand_el'} = 3; $patches{'piano_ht'} = 4; $patches{'piano_el_1'} = 5; $patches{'piano_el_2'} = 6; $patches{'harpsichord'} = 7; $patches{'clavinet'} = 8; $patches{'celesta'} = 9; $patches{'glockenspiel'} = 10; $patches{'music_box'} = 11; $patches{'vibraphone'} = 12; $patches{'marimba'} = 13; $patches{'xylophone'} = 14; $patches{'tubular_bells'} = 15; $patches{'dulcimer'} = 16; $patches{'organ_dbar'} = 17; $patches{'organ_perc'} = 18; $patches{'organ_rock'} = 19; $patches{'organ_church'} = 20; $patches{'organ_reed'} = 21; $patches{'accordian'} = 22; $patches{'harmonica'} = 23; $patches{'accordian_tango'} = 24; $patches{'guitar_nylon'} = 25; $patches{'guitar_steel'} = 26; $patches{'guitar_jazz'} = 27; $patches{'guitar_clean'} = 28; $patches{'guitar_muted'} = 29; $patches{'guitar_od'} = 30; $patches{'guitar_dist'} = 31; $patches{'guitar_harm'} = 32; $patches{'bass_ac'} = 33; $patches{'bass_fg'} = 34; $patches{'bass_pick'} = 35; $patches{'bass_fless'} = 36; $patches{'bass_slap_1'} = 37; $patches{'bass_slap_2'} = 38; $patches{'bass_syn_1'} = 39; $patches{'bass_syn_2'} = 40; $patches{'violin'} = 41; $patches{'viola'} = 42; $patches{'cello'} = 43; $patches{'contrabass'} = 44; $patches{'str_trem'} = 45; $patches{'str_pizz'} = 46; $patches{'str_orch'} = 47; $patches{'timpani'} = 48; $patches{'str_ens_1'} = 49; $patches{'str_ens_2'} = 50; $patches{'str_syn_1'} = 51; $patches{'str_syn_2'} = 52; $patches{'choir_aahs'} = 53; $patches{'voice_oohs'} = 54; $patches{'voice_syn'} = 55; $patches{'orch_hit'} = 56; $patches{'trumpet'} = 57; $patches{'trombone'} = 58; $patches{'tuba'} = 59; $patches{'trumpet_muted'} = 60; $patches{'horn_fr'} = 61; $patches{'brass'} = 62; $patches{'brass_syn_1'} = 63; $patches{'brass_syn_2'} = 64; $patches{'sax_sop'} = 65; $patches{'sax_alt'} = 66; $patches{'sax_ten'} = 67; $patches{'sax_bar'} = 68; $patches{'oboe'} = 69; $patches{'horn_en'} = 70; $patches{'bassoon'} = 71; $patches{'clarinet'} = 72; $patches{'piccolo'} = 73; $patches{'flute'} = 74; $patches{'recorder'} = 75; $patches{'flute_pan'} = 76; $patches{'bottle'} = 77; $patches{'skakuhachi'} = 78; $patches{'whistle'} = 79; $patches{'ocarina'} = 80; $patches{'lead_sq'} = 81; $patches{'lead_saw'} = 82; $patches{'lead_calliope'} = 83; $patches{'lead_chiff'} = 84; $patches{'lead_charang'} = 85; $patches{'lead_voice'} = 86; $patches{'lead_fifth'} = 87; $patches{'lead_basslead'} = 88; $patches{'pad_new_age'} = 89; $patches{'pad_warm'} = 90; $patches{'polysynth'} = 91; $patches{'pad_choir'} = 92; $patches{'pad_bowed'} = 93; $patches{'pad_metal'} = 94; $patches{'pad_halo'} = 95; $patches{'pad_sweep'} = 96; $patches{'fx_rain'} = 97; $patches{'fx_strack'} = 98; $patches{'fx_crystal'} = 99; $patches{'fx_atmos'} = 100; $patches{'fx_bright'} = 101; $patches{'fx_goblin'} = 102; $patches{'fx_echo'} = 103; $patches{'fx_scifi'} = 104; $patches{'sitar'} = 105; $patches{'banjo'} = 106; $patches{'shamisen'} = 107; $patches{'koto'} = 108; $patches{'kalimba'} = 109; $patches{'bagpipe'} = 110; $patches{'fiddle'} = 111; $patches{'shanai'} = 112; $patches{'bell_tinkle'} = 113; $patches{'agogo'} = 114; $patches{'drum_steel'} = 115; $patches{'woodblock'} = 116; $patches{'drum_taiko'} = 117; $patches{'tom_melodic'} = 118; $patches{'drum_syn'} = 119; $patches{'cymbal_rev'} = 120; $patches{'fx_fret'} = 121; $patches{'fx_breath'} = 122; $patches{'fx_sea'} = 123; $patches{'fx_tweet'} = 124; $patches{'fx_phone'} = 125; $patches{'fx_copter'} = 126; $patches{'fx_gun'} = 128; } ## ## set up drum list ## sub init_drum_list { $drums{'bd_ac'} = "b2"; $drums{'bd'} = "c3"; $drums{'stick'} = "c+3"; $drums{'sd_ac'} = "d3"; $drums{'clap'} = "d+3"; $drums{'sd_el'} = "e3"; $drums{'ftom_l'} = "f3"; $drums{'hh_c'} = "f+3"; $drums{'ftom_h'} = "g3"; $drums{'hh_p'} = "g+3"; $drums{'tom_l'} = "a3"; $drums{'hh_o'} = "a+3"; $drums{'tom_lm'} = "b3"; $drums{'tom_hm'} = "c4"; $drums{'cym_crash'} = "c+4"; $drums{'tom_h'} = "d4"; $drums{'cym_ride'} = "d+4"; $drums{'cym_chinese'} = "e4"; $drums{'ride_bell'} = "f4"; $drums{'tamb'} = "f+4"; $drums{'cym_splash'} = "g4"; $drums{'cowbell'} = "g+4"; $drums{'cym_crash_2'} = "a4"; $drums{'vibraslap'} = "a+4"; $drums{'cym_ride_2'} = "b4"; $drums{'bongo_h'} = "c5"; $drums{'bongo_l'} = "c+5"; $drums{'conga_h_mute'} = "d5"; $drums{'conga_h_open'} = "d+5"; $drums{'conga_l'} = "e5"; $drums{'timbale_h'} = "f5"; $drums{'timbale_l'} = "f+5"; $drums{'agogo_h'} = "g5"; $drums{'agogo_l'} = "g+5"; $drums{'cabasa'} = "a5"; $drums{'maracas'} = "a+5"; $drums{'whistle_sh'} = "b5"; $drums{'whistle_lg'} = "c6"; $drums{'guiro_sh'} = "c+6"; $drums{'guiro_lg'} = "d6"; $drums{'claves'} = "d+6"; $drums{'wood_h'} = "e6"; $drums{'wood_l'} = "f6"; $drums{'cuica_mute'} = "f+6"; $drums{'cuica_open'} = "g6"; $drums{'tri_mute'} = "g+6"; $drums{'tri_open'} = "a6"; } ## ## Setup the hash used to lookup relative majors. ## sub init_relative_majors { $relative_majors = { 'am' => 'c', 'em' => 'g', 'bm' => 'd', 'fm' => 'a-', 'cm' => 'e-', 'gm' => 'b-', 'dm' => 'f', 'f+m' => 'a', 'g+m' => 'c-', 'd+m' => 'g-', 'a+m' => 'c+', 'b+m' => 'd+', 'c+m' => 'e', 'e+m' => 'g+', 'd-m' => 'e', 'a-m' => 'b', 'e-m' => 'f+', 'b-m' => 'd-', 'c-m' => 'd', 'f-m' => 'g', 'g-m' => 'a', }; } ################################################### ## ## ## @@@SECTION: Option / Info related subroutines ## ## ## ################################################### ## ## parse the command line options ## sub get_options { my $i = 0; while ($i <= @ARGV-1) { if ($ARGV[$i] =~ /^--(version|warranty|about)$/) { &print_prog_info; exit; } elsif ($ARGV[$i] =~ /^(-h|--help)$/) { &print_help_info; exit; } elsif ($ARGV[$i] =~ /^(-v|--verbose)$/) { $verbose = 1; } elsif ($ARGV[$i] =~ /^(-d|--debug)$/) { $debug = 1; } elsif ($ARGV[$i] =~ /^(-q|--quiet)$/) { $quiet = 1; } elsif ($ARGV[$i] =~ /^(-t|--tempo)$/) { $tempo = $ARGV[$i+1] || die "missing tempo value after `$ARGV[$i]'\n"; $i++; } elsif ($ARGV[$i] =~ /^(-b|--bend-steps)$/) { $bend_steps = $ARGV[++$i]; die "bend-steps must be an integer > 0\n" unless $bend_steps =~ /^\d+$/ and $bend_steps > 0; } elsif ($ARGV[$i] =~ /^(-c|--check)$/) { $check_only = 1; } elsif ($ARGV[$i] eq '--unsafe') { $unsafe = 1; } elsif ($ARGV[$i] =~ /^(-u|--unroll-loops)$/) { $unroll_loops = 2; } elsif ($ARGV[$i] =~ /^(-U|--no-unroll-save)$/) { $unroll_save = 0; } elsif ($ARGV[$i] =~ /^(-R|--no-reset)$/) { $do_reset = 0; } elsif ($ARGV[$i] =~ /^(-o|--outfile)$/) { $outfile = $ARGV[$i+1] || die "missing filename after `$ARGV[$i]'\n"; $i++; } elsif ($ARGV[$i] =~ /^(-s|--seed)$/) { $seed = $ARGV[$i+1] || die "missing number after `$ARGV[$i]'\n"; $i++; } elsif ($ARGV[$i] =~ /^(-S|--show-scale)$/) { &init_scales; &show_scale(@ARGV[$i+1,$i+2]); exit; } elsif ($ARGV[$i] =~ /^(-I|--include)$/) { unshift @include_paths, split /[,:]/, $ARGV[$i+1]; $i++; } elsif ($ARGV[$i] =~ /^-([a-zA-Z]{2})/) { @ARGV = (@ARGV[0..$i], map($_ = "-$_", split(//, $1)), @ARGV[$i+1..@ARGV-1]); } elsif ($ARGV[$i] =~ /^-/) { die "$ARGV[$i]: unknown option, use --help for help\n"; } elsif (defined $infile) { die "too many arguments, use --help for help\n"; } else { $infile = $ARGV[$i]; } $i++; } if ($quiet) { if (($verbose) || ($debug)) { die "`-q' doesn't make sense with `-v' or `-d'\n"; } } if ($debug) { $verbose = 1; } if (!$outfile) { if (defined $infile) { $_ = $infile; s/.*\///; s/(\.mg)?$/.mid/; $outfile = $_; } else { $outfile = "a.out.mid"; } } if ($unroll_loops) { $_ = $outfile; s/(\.mid)?$/.long.mg/; $source_outfile = $_; } if ($debug) { print "options:"; if ($verbose) { print " verbose"; } if ($debug) { print " debug"; } if ($quiet) { print " quiet"; } if ($unroll_loops) { print " unroll-loops"; } if ($tempo) { print " tempo=$tempo"; } if (defined $infile) { print " in=$infile"; } else { print " in=stdin"; } print " out=$outfile\n"; } } ## ## print information about the program ## sub print_prog_info { print "$progname version $version Copyright (C) $year $author\n"; print "$progname comes with ABSOLUTELY NO WARRANTY\n"; print "This is free software, and you are welcome to redistribute\n"; print "it under the terms of the GNU General Public License\n"; } ## ## print out a help message ## sub print_help_info { print <<EOF usage: midge [options] [infile] options: -h or --help Display this help text. --version or --warranty or --about Show version/license info. -q or --quiet Suppress output. -v or --verbose Produce verbose output. -d or --debug Produce debugging output. -o file or --outfile file Direct output to file. -c or --check Check input only; no midi output. -u or --unroll-loops Unroll repeat blocks before parsing and save the unrolled source to a new file. Should be set automatically if needed. -U or --no-unroll-save Do not save unrolled source to file. -R or --no-reset Do not insert `reset all controllers' events at start of tracks. -t bpm or --tempo bpm Set tempo to bpm beats per minute, overriding value in inupt file. -b steps or --bend-steps steps Set the number of steps per quarter note for the simple bend syntax. --unsafe Do not use Safe.pm to run Perl code from %eval blocks. -s number or --seed number Use `number' as random seed. -S [scale [root]] or --show-scale [scale [root]] List notes in scale starting from root. If root is omitted c4 is used. If scale is omitted, a list of suported scales is shown. -I path or --include path Prepend `path' to include paths. Can be specified multiple times or `path' can be a list separated by colons or commas. infile Read input from `infile'. See the man page and examples for details of the input language EOF } ## ## show scale notes or list supported scales ## sub show_scale { my ($type, $root) = @_; if (defined $type) { $root = 'c4' unless (defined $root); $root .= '4' unless ($root =~ /\d+$/); my $scale = &get_scale($type, $root); local $, = ' '; printf "$root $type has %d notes:\n", scalar @$scale; print @$scale, "\n"; } else { print "supported scales:\n"; my $col = 0; foreach (sort(keys(%scales))) { print ', ' unless ($col == 0); $col += length($_) + 2; print; if ($col > 64) { print ",\n"; $col = 0; } } print "\n"; } } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������midge-0.2.41/midi2mg.1������������������������������������������������������������������������������0000644�0000764�0000764�00000003324�10457003212�012721� 0����������������������������������������������������������������������������������������������������ustar �dave����������������������������dave�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������.TH MIDI2MG 1 "17 July 2006" .SH NAME midi2mg - convert a midi file into midge(1) text format. .SH SYNOPSIS \fBmidi2mg\fP [ options ] midi_file .SH DESCRIPTION \fBmidi2mg\fP reads a midi file and writes its contents to a file in midge(1) text format. It prints a message to stdout for any midi events it can't handle. .SH OPTIONS .HP \fB-h\fP or \fB--help\fP .IP Display help text. .HP \fB-v\fP or \fB--verbose\fP .IP Print verbose messages to stdout. .HP \fB-q\fP or \fB--quiet\fP .IP Quiet. No stdout. .HP \fB-o file\fP or \fB--outfile file\fP .IP Write output to \fBfile\fP. Otherwise converts file.mid to file.mg Outputs to stdout if \fBfile\fP is `\fB-\fP'. When outputting to stdout quiet mode is automatically set unless verbose mode is set earlier on the command line. .HP \fB-w\fP or \fB--ignore-wrong-track\fP .IP Ignore MIDI events on the wrong channel instead of exiting. .HP \fB-n i[,j...]\fP or \fB--include-tracks i[,j...]\fP .IP Only convert the tracks in the comma separated list, with track numbers starting from 1. .HP \fB-N i[,j...]\fP or \fB--exclude-tracks i[,j...]\fP .IP Convert all tracks \fBexcept\fP those specified in the comma separated list. .HP \fB-t\fP n or \fB--tuplet-factor\fP n .IP An additional factor for files with odd note lengths, to prevent them being translated as decimals (\fBn\fP should be a prime number greater than 3). .HP \fB-F\fP or \fB--no-factorise\fB .IP Do not factorise time values (may help to decipher unusual tuplet values). .SH BUGS Does not correctly handle some text events. Does not handle SMTPE style tempo events. Does not handle changes of tempo/time_sig/key if these are on a separate tempo track. .SH "SEE ALSO" midge(1) .SH AUTHOR David Riley <dave@dmriley.demon.co.uk> ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������midge-0.2.41/midi2mg.pl�����������������������������������������������������������������������������0000644�0000764�0000764�00000102772�10457003212�013203� 0����������������������������������������������������������������������������������������������������ustar �dave����������������������������dave�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������use strict; ########################################################################### ## ## midi2mg - convert a midi file to midge text format ## ## usage: midi2mg [ options ] midi_file ## ## `--help' switch gives a list of options ## ## author: David Riley <dave@dmriley.demon.co.uk> ## ########################################################################### ## ## This program is free software; you can redistribute it and/or modify ## it under the terms of the GNU General Public License as published by ## the Free Software Foundation; either version 2 of the License, or ## (at your option) any later version. ## ## This program is distributed in the hope that it will be useful, ## but WITHOUT ANY WARRANTY; without even the implied warranty of ## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ## GNU General Public License for more details. ## ## You should have received a copy of the GNU General Public License ## along with this program; if not, write to the Free Software ## Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA ## ########################################################################### eval "use MIDI"; if ($@) { print <<EOF; You don't appear to have the MIDI modules installed. Your Perl said: $@ You can install them easily by typing `perl -MCPAN -e shell' at your prompt (you will need to answer a few questions if you haven't used CPAN before) and then typing `install MIDI' at the cpan> prompt. To RTFM first, type `perldoc CPAN' or visit www.cpan.org EOF exit 1; } my $mg_file; my $midi_file; my @tokens; my $last_event; my $current_channel; my $current_track = 0; my $track_list; my @track_list; my $track_ignore_list; my @track_ignore_list; my $outfile_specified = 0; my $progress_length = 30; my $quiet = 0; my $verbose = 0; my $fix_rs = 0; my $ctt_do_factorise = 1; my $ignore_wrong_track = 0; $| = 1; $SIG{'PIPE'} = sub { 1; }; while (my $arg = shift) { if ($arg =~ /^(-o|--outfile)$/) { $mg_file = shift; $quiet = 1 if $mg_file eq '-' and not $verbose; die "missing output file after $arg\n" unless defined $mg_file; $outfile_specified = 1; } elsif ($arg =~ /^(-w|--ignore-wrong-track)$/) { $ignore_wrong_track = 1; } elsif ($arg =~ /^(-F|--no-factorise)$/) { $ctt_do_factorise = 0; } elsif ($arg =~ /^(-f|--fix-rs)$/) { $fix_rs = 1; } elsif ($arg =~ /^(-N|--exclude-tracks)$/) { if (defined $track_list) { die "Can't use both `tracks' and `ignore-tracks' together\n"; } $track_ignore_list = shift; die "expected list of numbers after $arg\n" unless $track_ignore_list =~ /^(\d+,?)+$/; @track_ignore_list = split ',', $track_ignore_list; } elsif ($arg =~ /^(-n|--include-tracks)$/) { if (defined $track_ignore_list) { die "Can't use both `tracks' and `ignore-tracks' together\n"; } $track_list = shift; die "expected list of numbers after $arg\n" unless $track_list =~ /^(\d+,?)+$/; @track_list = split ',', $track_list; } elsif ($arg =~ /^(-v|--verbose)$/) { die "can't be verbose AND quiet\n" if $quiet; $verbose = 1; } elsif ($arg =~ /^(-q|--quiet)$/) { die "can't be quiet AND verbose\n" if $verbose; $quiet = 1; } elsif ($arg =~ /^(-h|--help)$/) { print <<EOF; usage: midi2mg [ options ] midi_file options: -h or --help Display this help text -v or --verbose Print verbose messages to stdout -q or --quiet Quiet. No stdout. -o file or --outfile file Write output to `file'. Otherwise file.mid -> file.mg Outputs to stdout if filename is `-'. When outputting to stdout quiet mode is automatically set unless verbose mode is set earlier on the command line. -w or --ignore-wrong-track Ignore MIDI events on the wrong channel instead of exiting. -n or --include-tracks i[,j...] Only convert the tracks in the comma separated list, with track numbers starting from 1. -N or --exclude-tracks i[,j...] As `-n' but excludes the listed tracks -F or --no-factorise Do not factorise time values. EOF exit 0; } elsif ($arg =~ /^-([a-zA-Z]{2})/) { unshift @ARGV, map($_ = "-$_", split(//, $1)); } elsif ($arg =~ /^-/) { die "unknown option `$arg'\n"; } else { die "too many arguments\n" if defined $midi_file; $midi_file = $arg; } } die "no midi file specified\n" unless defined $midi_file; unless (defined $mg_file) { $mg_file = $midi_file; $mg_file =~ s/^.*\///; $mg_file =~ s/(\.midi?)?$/.mg/; } if ($verbose) { print "Reading MIDI file $midi_file... "; } my $opus = MIDI::Opus->new({ 'from_file' => $midi_file }) or die "$midi_file: $!\n"; die "\nCan't handle format 0 midi files\n" if $opus->format == 0; print "done\n" if $verbose; my $now = localtime; my $resolution = $opus->ticks; print "resolution = $resolution\n" if $verbose; my $tempo; my $time_sig; my $key; my $title; # get a list of tracks my @tracks = $opus->tracks; if (defined $track_list) { my @newtracks; foreach my $index (@track_list) { $newtracks[@newtracks] = $tracks[$index - 1] unless $index > @tracks; } die "no valid tracks specified in include list\n" if @newtracks == 0; @tracks = @newtracks; } elsif (defined $track_ignore_list) { my @newtracks; for my $i (0..@tracks - 1) { $newtracks[@newtracks] = $tracks[$i] unless grep $_ == $i + 1, @track_ignore_list; } die "all valid tracks excluded\n" if @newtracks == 0; @tracks = @newtracks; } my $track_num = 0; foreach my $track (@tracks) { $track_num++; printf("Track $track_num of %s:\n", scalar @tracks) if $verbose; my @track_tokens; my @events = $track->events; if (not $fix_rs) { if (grep $_->[0] eq 'note_on', @events and not grep $_->[0] eq 'note_off', @events) { print " looks like a running status file\n" if $verbose; $fix_rs = 1; } } $current_track++; undef $current_channel; my $instrument; my $track_name; my $count = 1; print " parsing events...\n" if $verbose; foreach my $event (@events) { if ($event->[0] eq 'instrument_name') { $instrument = $event->[2]; next; } elsif ($event->[0] eq 'track_name') { $track_name = $event->[2]; next; } my $tokens = &get_event_string($event); next unless defined $tokens; my @event_tokens = split ' ', $tokens; @track_tokens = (@track_tokens, @event_tokens) unless $event_tokens[0] eq '$ctrl' and $event_tokens[1] eq '121,0' and @track_tokens == 0; if ($verbose) { my $pg = int(($count * $progress_length) / @events); my $pg_pc = int(($count * 100) / @events); my $pg_msg = sprintf(" event: %d/%d [$pg_pc%%] <[", $count, scalar @events); $pg_msg .= '#' x $pg; $pg_msg .= '=' x ($progress_length - $pg); $pg_msg .= "]>"; print "$pg_msg\r"; $count++; } } if ($verbose) { print "\r"; print " " x 79; print "\r"; printf(" parsed %s events\n", scalar @events); } if ((not defined $current_channel) or (@events < 8 and not grep $_->[0] eq 'note_on', @events)) { my $i; my $keep = 0; for ($i=0; $i<@track_tokens; $i++) { if ($track_tokens[$i] eq '$tempo') { # if (defined $tempo) { # $tempo = ''; # $keep = 1; # last; # } $tempo = $track_tokens[$i+1] unless defined $tempo; $i++; } elsif ($track_tokens[$i] eq '$time_sig') { # if (defined $time_sig) { # $time_sig = ''; # $keep = 1; # last; # } $time_sig = $track_tokens[$i+1] unless defined $time_sig; $i++; } elsif ($track_tokens[$i] eq '$key') { # if (defined $key) { # $key = ''; # $keep = 1; # last; # } $key = $track_tokens[$i+1] unless defined $key; $i++; } elsif ($track_tokens[$i] eq '$marker') { $keep = 1; last; } } if (not defined $title) { if (defined $track_name) { $title = $track_name; print " ignoring instrument name\n" if defined $instrument; } elsif (defined $instrument) { $title = $instrument; } elsif ((my $event) = grep $_->[0] eq 'text_event', @events) { $title = $event->[2]; } } my $tempos = grep /^\$tempo$/, @track_tokens; my $sigs = grep /^\$time_sig$/, @track_tokens; my $keys = grep /^\$key$/, @track_tokens; if ($tempos > 1 or $sigs > 1 or $keys > 1 or $keep) { $keep = 1; if (defined $instrument) { $instrument .= " (tempo track)"; } else { $instrument = "tempo track"; } if (defined $tempo and $track_tokens[0] eq '$tempo' and $track_tokens[1] eq $tempo) { @track_tokens = @track_tokens[2..@track_tokens-1]; } if (defined $time_sig and $track_tokens[0] eq '$time_sig' and $track_tokens[1] eq $time_sig) { @track_tokens = @track_tokens[2..@track_tokens-1]; } if (defined $key and $track_tokens[0] eq '$key' and $track_tokens[1] eq $key) { @track_tokens = @track_tokens[2..@track_tokens-1]; } } if ($keep) { @track_tokens = (@track_tokens, '$track_type', 'tempo'); $current_channel = 15; } else { print " removing track as no notes found (probably tempo track)\n" if $verbose; next; } } if (not defined $instrument) { $instrument = $track_name if defined $track_name; } if (defined $title) { $title =~ s/\"//g; $title = '"' . $title . '"'; } if (defined $instrument) { $instrument =~ s/\"//g; } print " merging notes... " if $verbose; if ($fix_rs) { @track_tokens = @{&fix_running_status(\@track_tokens)}; } else { @track_tokens = @{&merge_note_tokens(\@track_tokens)}; } print "done\n simplifying note options... " if $verbose; @track_tokens = @{&simplify_note_options(\@track_tokens)}; print "done\n" if $verbose; my @start = ('@channel', $current_channel+1); push @start, '"' . $instrument . '"' if defined $instrument; push @start, '{'; @tokens = (@tokens, @start, @track_tokens, '}'); } my @head = ('@head', '{'); @head = (@head, '$tempo', $tempo) if $tempo; @head = (@head, '$time_sig', $time_sig) if $time_sig; @head = (@head, '$key', $key) if $key; @head = (@head, '$title', $title) if defined $title; @head = (@head, '$resolution', $resolution); @tokens = (@head, '}', '@body', '{', @tokens, '}'); &write_mg_file; ########################## End of main() ############################## ## ## return a string of midge tokens from a single MIDI event ## sub get_event_string { my $event = shift; if ($event->[0] eq 'note_on') { my (undef, $dtime, $channel, $note, $attack) = @$event; $current_channel = $channel unless defined $current_channel; unless ($channel == $current_channel) { die "got event for channel $channel in channel $current_channel\n" unless $ignore_wrong_track; } if ($dtime > 0) { my $length = &clicks_to_time($dtime); $note = &int_to_note($note); return "/l${length}/r +/a${attack}/${note}"; } else { $note = &int_to_note($note); return "+/a${attack}/${note}"; } } elsif ($event->[0] eq 'note_off') { my (undef, $dtime, $channel, $note, $decay) = @$event; $current_channel = $channel unless defined $current_channel; unless ($channel == $current_channel) { die "got event for channel $channel in channel $current_channel\n" unless $ignore_wrong_track; } if ($dtime > 0) { my $length = &clicks_to_time($dtime); $note = &int_to_note($note); return "/l${length}/r -/d${decay}/${note}"; } else { $note = &int_to_note($note); return "-/d${decay}/${note}"; } } elsif ($event->[0] eq 'patch_change') { my (undef, $dtime, $channel, $patch) = @$event; $current_channel = $channel unless defined $current_channel; unless ($channel == $current_channel) { die "got event for channel $channel in channel $current_channel\n" unless $ignore_wrong_track; } $patch++; if ($dtime > 0) { return sprintf "/l%s/r \$patch $patch", &clicks_to_time($dtime); } else { return "\$patch $patch"; } } elsif ($event->[0] eq 'pitch_wheel_change') { my (undef, $dtime, $channel, $value) = @$event; $current_channel = $channel unless defined $current_channel; unless ($channel == $current_channel) { die "got event for channel $channel in channel $current_channel\n" unless $ignore_wrong_track; } $value++ if $value == 8191; $value = int((8192.5 + $value) / 128); if ($dtime > 0) { return sprintf "/l%s/r \$pitch $value", &clicks_to_time($dtime); } else { return "\$pitch $value"; } } elsif ($event->[0] eq 'set_tempo') { my (undef, $dtime, $tempo) = @$event; if ($dtime > 0) { return sprintf "/l%s/r \$tempo %s", &clicks_to_time($dtime), int(60000000 / $tempo); } else { return sprintf "\$tempo %s", int(60000000 / $tempo); } } elsif ($event->[0] eq 'time_signature') { my (undef, $dtime, $num, $den) = @$event; if ($dtime > 0) { return sprintf "/l%s/r \$time_sig $num/%s", &clicks_to_time($dtime), $den * $den; } else { return sprintf "\$time_sig $num/%s", $den * $den; } } elsif ($event->[0] eq 'key_signature') { my (undef, $dtime, $sf, $mi) = @$event; my $key = &get_key($sf, $mi); if ($dtime > 0) { return sprintf "/l%s/r \$key $key", &clicks_to_time($dtime); } else { return "\$key $key"; } } elsif ($event->[0] eq 'text_event') { my (undef, $dtime, $text) = @$event; return undef if length $text == 0; if ($dtime > 0) { return sprintf "/l%s/r \$text $text", &clicks_to_time($dtime); } else { return '$text "' . $text . '"'; } } elsif ($event->[0] eq 'raw_meta_event') { my (undef, $dtime, $cmd, $data) = @$event; my @data = unpack "C*", $data; if ($dtime > 0) { return sprintf "/l%s/r ", &clicks_to_time($dtime) . "\%verbatim \{ ". join(' ', &get_delta_time($dtime)) . " 0xff $cmd " . &get_length_bytes(scalar @data) . ' ' . join(' ', @data) . ' }'; } else { return "\%verbatim \{ ". join(' ', &get_delta_time($dtime)) . " 0xff $cmd " . &get_length_bytes(scalar @data) . ' ' . join(' ', @data) . ' }'; } } elsif ($event->[0] =~ /^sysex_(f\d)$/) { my $type = $1; my (undef, $dtime, $data) = @$event; my @data = unpack "C*", $data; if ($dtime > 0) { return sprintf "/l%s/r ", &clicks_to_time($dtime) . "\%verbatim \{ " . join(' ', &get_delta_time($dtime)) . " 0x$type " . &get_length_bytes(scalar @data) . ' ' . join(' ', @data) . ' }'; } else { return "\%verbatim \{ " . join(' ', &get_delta_time($dtime)) . " 0x$type " . &get_length_bytes(scalar @data) . ' ' . join(' ', @data) . ' }'; } } elsif ($event->[0] eq 'control_change') { my (undef, $dtime, $channel, $ctrl, $value) = @$event; $current_channel = $channel unless defined $current_channel; unless ($channel == $current_channel) { die "got event for channel $channel in channel $current_channel\n" unless $ignore_wrong_track; } if ($dtime > 0) { return sprintf "/l%s/r \$ctrl $ctrl,$value", &clicks_to_time($dtime); } else { return "\$ctrl $ctrl,$value"; } } elsif ($event->[0] eq 'marker') { my (undef, $dtime, $text) = @$event; return undef if length $text == 0; if ($dtime > 0) { return sprintf "/l%s/r \$marker \"$text\"", &clicks_to_time($dtime); } else { return "\$marker \"$text\""; } } else { if ($verbose) { print "\r"; print " " x 79; print "\r "; } print " ignoring @$event\n" unless $quiet; return ''; } } ## ## Try to merge groups of `note_on rest note_off' into simple notes ## sub merge_note_tokens { my $tokens = shift; my @newtokens; my $i; for ($i=0; $i<@$tokens; $i++) { if ($tokens->[$i] =~ /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) { my $on_opts = $2; my $on_note = $3; if (defined $tokens->[$i+1] and $tokens->[$i+1] =~ /^\/(\S+)\/r$/) { my $length = $1; if (defined $tokens->[$i+2] and $tokens->[$i+2] =~ /^-(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) { my $off_opts = $2; my $off_note = $3; if ($off_note eq $on_note) { push @newtokens, "/$length$on_opts$off_opts/$on_note"; $i += 2; next; } } } } push @newtokens, $tokens->[$i]; } return \@newtokens; } ## ## repair broken handling of running status ## sub fix_running_status { my $tokens = shift; my @newtokens; my %last; my $i; for ($i=0; $i<@$tokens; $i++) { if ($tokens->[$i] =~ /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) { my $on_opts = $2; my $on_note = $3; if (defined $last{$on_note} and $last{$on_note}) { my $token = $tokens->[$i]; $token =~ s/^./-/; $token =~ s/^(-\/[^\/]*)a/$1d/; push @newtokens, $token; undef $last{$on_note}; next; } elsif (defined $tokens->[$i+1] and $tokens->[$i+1] =~ /^\/(\S+)\/r$/) { my $length = $1; if (defined $tokens->[$i+2] and $tokens->[$i+2] =~ /^\+(\/(\S+)\/)?([a-g][-+]?(\d+)?)$/) { my $off_opts = $2; my $off_note = $3; if ($off_note eq $on_note) { $off_opts =~ s/a/d/; push @newtokens, "/$length$on_opts$off_opts/$on_note"; $i += 2; next; } } } $last{$on_note} = 1; } push @newtokens, $tokens->[$i]; } return \@newtokens; } ## ## Try to remove unnecessary note options and replace them with a default ## sub simplify_note_options { my $tokens = shift; my @newtokens; my $last_length; my $last_octave; my %attack; my %decay; my $i; for ($i=0; $i<@$tokens; $i++) { if ($tokens->[$i] =~ /^([-+])?\/(l\d+(\.\d+)?(:\d+)?)?(a\d+)?(d\d+)?\/([a-gr][-+]?)(\d+)?$/) { my $onoff = ''; $onoff = $1 if defined $1; my $note = $7; my ($length, $attack, $decay, $octave) = ('', '', '', ''); if (defined $5) { $attack{$5}++; $attack = $5; } if (defined $6) { $decay{$6}++; $decay = $6; } $length = $2 if defined $2; $octave = $8 if defined $8; my $saved_length = $length if $length; my $saved_octave = $octave if $octave; $length = '' if defined $last_length and $last_length eq $length; $octave = '' if defined $last_octave and $last_octave eq $octave; $newtokens[$i] = "$onoff/$length$attack$decay/$note$octave"; $newtokens[$i] = "$onoff$note$octave" if $newtokens[$i] =~ /^[-+]?\/\//; $last_length = $saved_length if defined $saved_length; $last_octave = $saved_octave if defined $saved_octave; } else { $newtokens[$i] = $tokens->[$i]; } } my $attack; my $max = 0; foreach my $key (keys %attack) { if ($attack{$key} > $max) { $max = $attack{$key}; $attack = $key; } } my $decay; $max = 0; foreach my $key (keys %decay) { if ($decay{$key} > $max) { $max = $decay{$key}; $decay = $key; } } if (defined $decay) { $decay =~ s/^d//; @newtokens = ('$decay', $decay, @newtokens); for ($i=0; $i<@newtokens; $i++) { if ($newtokens[$i] =~ /^([-+])?\/([^d]*)(d(\d+))?([^\/]*)\/(([a-gr][-+]?)(\d+)?)$/) { my $onoff = ''; $onoff = $1 if defined $1; my $first = $2; my $last = $5; my $note = $6; my $dec = ''; $dec = $4 if defined $4; $dec = '' if $dec =~ /^\d+$/ and $dec == $decay; $dec = "d$dec" if $dec =~ /^\d+$/; $newtokens[$i] = "$onoff/$first$dec$last/$note"; $newtokens[$i] = "$onoff$note" if $newtokens[$i] =~ /^[-+]?\/\//; } } } if (defined $attack) { $attack =~ s/^a//; @newtokens = ('$attack', $attack, @newtokens); for ($i=0; $i<@newtokens; $i++) { if ($newtokens[$i] =~ /^([-+])?\/([^a]*)(a(\d+))?([^\/]*)\/(([a-gr][-+]?)(\d+)?)$/) { my $onoff = ''; $onoff = $1 if defined $1; my $first = $2; my $last = $5; my $note = $6; my $att = ''; $att = $4 if defined $4; $att = '' if $att =~ /^\d+$/ and $att == $attack; $att = "a$att" if $att =~ /^\d+$/; $newtokens[$i] = "$onoff/$first$att$last/$note"; $newtokens[$i] = "$onoff$note" if $newtokens[$i] =~ /^[-+]?\/\//; } } } return \@newtokens; } ## ## Try to move tempo/time_sig/key etc info into the @head section, ## remove empty tempo track ## sub final_parse { my $tokens = shift; my @newtokens; my $tempo; my $time_sig; my $key; my $ct = 0; # current track @$tokens = ('@body', '{', @$tokens, '}'); print " pass 1 of 2... " if $verbose; my $i; for ($i=0; $i<@$tokens; $i++) { if ($tokens->[$i] eq '$tempo') { $tempo = $tokens->[$i+1] unless defined $tempo; $tempo = '' unless $tempo == $tokens->[$i+1]; $i++; } elsif ($tokens->[$i] eq '$time_sig') { $time_sig = $tokens->[$i+1] unless defined $time_sig; $time_sig = '' unless $time_sig eq $tokens->[$i+1]; $i++; } elsif ($tokens->[$i] eq '$key') { $key = $tokens->[$i+1] unless defined $key; $key = '' unless $key eq $tokens->[$i+1]; $i++; } elsif ($tokens->[$i] eq '@channel') { $ct++; print " track $ct\n" if $verbose; } } print "done\n" if $verbose; $tempo = '' unless defined $tempo; $time_sig = '' unless defined $time_sig; $key = '' unless defined $key; $ct = 0; # current track print " pass 2 of 2:\n" if $verbose; for ($i=0; $i<@$tokens; $i++) { if ($tokens->[$i] eq '$tempo') { if ($tempo and ($tokens->[$i+1] == $tempo)) { $i++; next; } } elsif ($tokens->[$i] eq '$time_sig') { if ($time_sig and ($tokens->[$i+1] eq $time_sig)) { $i++; next; } } elsif ($tokens->[$i] eq '$key') { if ($key and ($tokens->[$i+1] eq $key)) { $i++; next; } } elsif ($tokens->[$i] eq '@channel') { $ct++; if ($tokens->[$i+1] eq '0') { print " removing empty track #$ct\n" if $verbose; $i += 2; while (not $tokens->[$i] eq '}') { $i++; } next; } else { print " track $ct\n" if $verbose; @newtokens = (@newtokens, $tokens->[$i]); } } else { @newtokens = (@newtokens, $tokens->[$i]); } } my @head = ('@head', '{'); @head = (@head, '$tempo', $tempo) if $tempo; @head = (@head, '$time_sig', $time_sig) if $time_sig; @head = (@head, '$key', $key) if $key; @head = (@head, '$title', $title) if defined $title; @newtokens = (@head, '}', @newtokens); return \@newtokens; } ## ## return the key from MIDI sf and mi values ## sub get_key { my ($sf, $mi) = @_; my $key; my @sharps = qw/ c g d a e b f+ c+ /; my @flats = qw/ c f b- e- a- d- g- c- /; if ($sf =~ /^-(\d)/) { my $idx = $1; if ($mi) { $idx -= 3; $idx += 8 if $idx < 0; } $key = $flats[$idx]; } else { my $idx = $1; if ($mi) { $idx -= 3; $idx += 8 if $idx < 0; } $key = $sharps[$sf]; } $key .= 'm' if $mi; return $key; } ## ## return bytes from int (for dtime) ## sub get_delta_time { my $dtime = shift; # delta time as an int my @bytes; # array to hold the bytes my $result = $dtime; # result of division my $i = 0; # counter if ($dtime < 128) { return $dtime; } else { # will need to reverse bytes after while (1) { $dtime = $result; # makes sense second time around :) if ($result < 1) { last; } else { $result = $dtime / 128; $bytes[$i] = $dtime % 128; if ($i > 0) { $bytes[$i] |= 0x80; } $i++; } } } return reverse @bytes; } sub get_length_bytes { my $length = shift; my @bytes = ($length % 128); while ($length > 127) { @bytes = (80 + $length % 128, @bytes); } return join ' ', @bytes; } ############### Subs copied from midge ################## ## ## write the tokens array out to the .mg file ## sub write_mg_file { my $line = 1; # current line of src file my $col = 0; # current column my $indent = 0; # current indent level my $i; # loop counter my @tmp; # temp array my $max = 60; # max cols before a newline unless ($mg_file =~ '-') { open MG, ">$mg_file" or die "$mg_file: $!\n"; select MG; } print "# Converted from $midi_file\n# by $0 on $now\n\n"; for ($i=0; $i<=$#tokens; $i++) { if ($tokens[$i] eq '{') { print "{\n"; $line++; $col = 0; $indent++; } elsif ($tokens[$i] eq '}') { unless ($col == 0) { print "\n"; $line++; $col = 0; } $indent-- unless ($indent == 0); if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "}\n"; $line++; $col = 0; } elsif ($tokens[$i] =~ /^@/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $col += 1 + length $tokens[$i]; } elsif ($tokens[$i] =~ /^\$/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $i++; if ($tokens[$i] =~ /^\"/) { my ($j, $tmp); for ($j=$i; $j<=$#tokens; $j++) { if ($tokens[$j] =~ /\"$/) { $tmp .= $tokens[$j]; $i = $j; last; } else { $tmp .= "$tokens[$j] "; } } print "$tmp\n"; } else { print "$tokens[$i]\n"; } $line++; $col = 0; } elsif ($tokens[$i] =~ /^\%/) { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $col += 1 + length $tokens[$i]; } elsif ($tokens[$i] eq '(') { unless ($col == 0) { print "\n"; $line++; $col = 0; } if ($indent) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; } elsif ($tokens[$i] eq ')') { print ")\n"; $line++; $col = 0; } else { if ($col > $max) { print "\n"; $line++; $col = 0; } if (($col == 0) && ($indent)) { for (1..$indent) { print "\t"; $col += 8; } } print "$tokens[$i] "; $col += 1 + length $tokens[$i]; } } unless ($mg_file eq '-') { select STDOUT; close MG; print "midge source written to $mg_file\n" unless ($quiet); } } ## ## return a note string from a note number ## sub int_to_note { my $orig_int = shift; # number to convert to note string my ($name, $octave); # name and octave of note my $note; # note string to return my $int = $orig_int; # copy of int which gets changed in the calculation $octave = int($int / 12); $int = $int % 12; if ($int == 11) {$name = 'b';} elsif ($int == 10) {$name = 'a+';} elsif ($int == 9) {$name = 'a';} elsif ($int == 8) {$name = 'g+';} elsif ($int == 7) {$name = 'g';} elsif ($int == 6) {$name = 'f+';} elsif ($int == 5) {$name = 'f';} elsif ($int == 4) {$name = 'e';} elsif ($int == 3) {$name = 'd+';} elsif ($int == 2) {$name = 'd';} elsif ($int == 1) {$name = 'c+';} else {$name = 'c';} $note = "$name$octave"; return $note; } ## ## return an `n:d' format time from a number of clicks ## sub clicks_to_time { my $clicks = $_[0]; # time in clicks my $whole = 4 * $resolution; my $hcf = &get_hcf($clicks, $whole); $clicks /= $hcf; $whole /= $hcf; return ($clicks == 1)? $whole : "$clicks:$whole"; } ## ## Return the highest common factor of the two integer arguments. ## sub get_hcf { my ($v1, $v2) = @_; die "Error: get_hcf(): both arguments must be integers" unless $v1 == int $v1 and $v2 == int $v2; my $f1 = &get_factors($v1); my $f2 = &get_factors($v2); my $hcf = 1; my @fa; foreach my $f (@$f1) { shift @$f2 while @$f2 > 0 and $f2->[0] < $f; if (@$f2 > 0 and $f2->[0] == $f) { $hcf *= $f; shift @$f2 } } return $hcf; } ## ## Return the prime factors of the integer argument. ## sub get_factors { my $v = shift; die "Error: get_factors(): argument must be an integer\n" unless $v == int $v; my @factors; for my $prime (qw(2 3 5 7 11 13 17 19 23 29 31)) { last if $v == 1; while ($v / $prime == int($v / $prime)) { last if $v == 1; $v /= $prime; push @factors, $prime; } } push @factors, $v unless $v == 1; return \@factors; } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������