home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / pmos2002.zip / SRC / MUSIC.MOD < prev    next >
Text File  |  1996-10-14  |  13KB  |  324 lines
  1. IMPLEMENTATION MODULE Music;
  2.  
  3.         (********************************************************)
  4.         (*                                                      *)
  5.         (*              Module to play music.                   *)
  6.         (*                                                      *)
  7.         (*  Programmer:         P. Moylan                       *)
  8.         (*  Last edited:        14 October 1996                 *)
  9.         (*  Status:             Just started OS/2 port          *)
  10.         (*                                                      *)
  11.         (********************************************************)
  12.  
  13. IMPORT Keyboard;                (* To enable Ctrl/Alt/Del detection *)
  14.  
  15. FROM SoundEffects IMPORT
  16.     (* type *)  Note,
  17.     (* proc *)  Play;
  18.  
  19. FROM Semaphores IMPORT
  20.     (* type *)  Semaphore,
  21.     (* proc *)  CreateSemaphore, Wait, Signal;
  22.  
  23. (************************************************************************)
  24.  
  25. CONST
  26.     Rest = 1;                   (* code for no sound *)
  27.     irrelevantnote = 12;        (* used when remembering last note      *)
  28.  
  29. TYPE
  30.     buffersubscript = [0..10];
  31.     ZeroToEleven = [0..11];
  32.     Octave = [0..8];
  33.     buffernumber = [0..1];
  34.  
  35. VAR
  36.     (* CurrentDuration and CurrentOctave are the current duration of a  *)
  37.     (* note and the octave in which we are playing, respectively.       *)
  38.  
  39.     CurrentDuration: CARDINAL;
  40.     CurrentOctave: Octave;
  41.  
  42.     (* NoteTable performs the mapping C -> 0, D -> 2, E -> 4, F -> 5,   *)
  43.     (* etc.  The gaps in this sequence are accounted for by sharps and  *)
  44.     (* flats, which are handled elsewhere.                              *)
  45.  
  46.     NoteTable: ARRAY ["A".."G"] OF ZeroToEleven;
  47.  
  48.     (* LastNote is either the ZeroToEleven code for the last note       *)
  49.     (* played, or it has the special value "irrelevantnote".  It is     *)
  50.     (* used when deciding when to change octaves.                       *)
  51.  
  52.     LastNote: CARDINAL;
  53.  
  54.     (* PeriodTable converts the ZeroToEleven note code into a period    *)
  55.     (* code as required by module SoundEffects.                         *)
  56.  
  57.     PeriodTable: ARRAY ZeroToEleven OF CARDINAL;
  58.  
  59.     (* The arrays buffer[0] and buffer[1] each hold data to be send to  *)
  60.     (* module SoundEffects.  We use them alternately, so that one can   *)
  61.     (* be filling up while the other is being emptied.  This frees the  *)
  62.     (* caller from having to worry about synchronisation problems, and  *)
  63.     (* lets the caller stay far enough ahead of the actual playing to   *)
  64.     (* make it unlikely that there will be gaps in the sound output due *)
  65.     (* to delays in the caller task.                                    *)
  66.     (* We have to make the buffers global, even though they are used by *)
  67.     (* only one procedure in this module, because they remain in use    *)
  68.     (* between calls to PlayMusic.                                      *)
  69.  
  70.     buffer: ARRAY buffernumber OF ARRAY buffersubscript OF Note;
  71.  
  72.     (* Variable currentbuffer keeps track of whether we are currently   *)
  73.     (* putting data in buffer[0] or buffer[1].                          *)
  74.  
  75.     currentbuffer: buffernumber;
  76.  
  77.     (* FreeBuffer is a counting semaphore, which keeps track of how     *)
  78.     (* many empty output buffers are currently available.               *)
  79.  
  80.     FreeBuffer: Semaphore;
  81.  
  82. (************************************************************************)
  83.  
  84. PROCEDURE SetNoteDuration (D: CARDINAL);
  85.  
  86.     (* Sets the duration of each of the following notes, until further  *)
  87.     (* notice, to D milliseconds.  The precision of this setting is     *)
  88.     (* limited by the clock interrupt frequency used in module Timer;   *)
  89.     (* the resolution can be as poor as 1/9 second.  The duration can   *)
  90.     (* subsequently be modified by the * and / options (see PlayMusic), *)
  91.     (* or by another call to SetNoteDuration.                           *)
  92.  
  93.     BEGIN
  94.         CurrentDuration := D;
  95.     END SetNoteDuration;
  96.  
  97. (************************************************************************)
  98.  
  99. PROCEDURE Translate (VAR (*IN*) notes: ARRAY OF CHAR;
  100.                         VAR (*INOUT*) place: CARDINAL;
  101.                         VAR (*OUT*) period: CARDINAL);
  102.  
  103.     (* Translates a note code in the conventional notation (C,D,etc.),  *)
  104.     (* as stored in notes[place], into the numeric period code expected *)
  105.     (* by module SoundEffects.  Parameter place is updated, so that on  *)
  106.     (* return notes[place] is the first character not processed by this *)
  107.     (* procedure.                                                       *)
  108.  
  109.     VAR note: ZeroToEleven;
  110.         j: Octave;
  111.  
  112.     BEGIN
  113.         IF notes[place] = "R" THEN
  114.             period := Rest;  INC (place);
  115.         ELSE
  116.             note := NoteTable[notes[place]];
  117.             INC (place);
  118.             IF place <= HIGH(notes) THEN
  119.  
  120.                 (* Check for sharp or flat. *)
  121.  
  122.                 IF notes[place] = "#" THEN
  123.                     INC(note);  INC(place);
  124.                 ELSIF notes[place] = "b" THEN
  125.                     DEC(note);  INC(place);
  126.                 END (*IF*);
  127.  
  128.             END (*IF*);
  129.  
  130.             (* We now have the note in the form of a ZeroToEleven code, *)
  131.             (* but we still have to decide the octave.  The criterion   *)
  132.             (* we use is to minimise the distance from the last note    *)
  133.             (* played.  This can be overridden by the "u" and "d" codes.*)
  134.  
  135.             IF LastNote <> irrelevantnote THEN
  136.                 IF VAL(INTEGER,note)-VAL(INTEGER,LastNote) > 6 THEN
  137.                     IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
  138.                 ELSIF  VAL(INTEGER,LastNote) -  VAL(INTEGER,note) > 6 THEN
  139.                     IF CurrentOctave < MAX(Octave) THEN
  140.                         INC(CurrentOctave)
  141.                     END (*IF*);
  142.                 END (*IF*);
  143.             END (*IF*);
  144.             LastNote := note;
  145.             period := PeriodTable[note];
  146.             FOR j := 1 TO CurrentOctave DO
  147.                 period := period DIV 2;
  148.             END (*FOR*);
  149.         END (*IF*);
  150.     END Translate;
  151.  
  152. (************************************************************************)
  153.  
  154. PROCEDURE PlayMusic (notes: ARRAY OF CHAR);
  155.  
  156.     (* Plays the tune specified in array "notes".  The playing is done  *)
  157.     (* asynchronously; that is, this procedure returns before the music *)
  158.     (* is over.  However, a return from this procedure does imply that  *)
  159.     (* array "notes" can be re-used or destroyed; the notes might not   *)
  160.     (* yet have been played, but the data necessary to play them have   *)
  161.     (* been processed and the necessary information stored.             *)
  162.  
  163.     VAR inplace: CARDINAL;  outplace: buffersubscript;
  164.  
  165.     BEGIN
  166.         inplace := 0;
  167.  
  168.         (* On entry to this procedure, currentbuffer is the number of   *)
  169.         (* the last buffer which was last sent to procedure Play.  The  *)
  170.         (* Wait(FreeBuffer) which we are about to execute is, because   *)
  171.         (* we are using a double-buffered approach, a wait for the      *)
  172.         (* second-last buffer which was sent to Play.  After the Wait,  *)
  173.         (* we can be sure that that alternate buffer is available.      *)
  174.  
  175.         Wait (FreeBuffer);
  176.         currentbuffer := 1 - currentbuffer;  outplace := 0;
  177.  
  178.         (* The following loop translates from letter codes in array     *)
  179.         (* "notes" to numeric codes in array buffer[currentbuffer],     *)
  180.         (* calling SoundEffects.Play each time the output buffer fills  *)
  181.         (* up.  At such times, we switch to the other buffer (after     *)
  182.         (* waiting for it to be emptied).                               *)
  183.  
  184.         REPEAT
  185.  
  186.             IF notes[inplace] = " " THEN INC(inplace)   (* ignore spaces *)
  187.  
  188.             (* Check for duration changes.      *)
  189.  
  190.             ELSIF notes[inplace] = "*" THEN
  191.                 CurrentDuration := 2*CurrentDuration;  INC(inplace);
  192.             ELSIF notes[inplace] = "3" THEN
  193.                 CurrentDuration := CurrentDuration DIV 3;  INC(inplace);
  194.             ELSIF notes[inplace] = "/" THEN
  195.                 CurrentDuration := CurrentDuration DIV 2;  INC(inplace);
  196.  
  197.             (* Check for octave changes.        *)
  198.  
  199.             ELSIF notes[inplace] = "u" THEN
  200.                 IF CurrentOctave < MAX(Octave) THEN
  201.                     INC(CurrentOctave);
  202.                 END (*IF*);
  203.                 INC (inplace);
  204.             ELSIF notes[inplace] = "d" THEN
  205.                 IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
  206.                 INC (inplace);
  207.             ELSE
  208.  
  209.                 (* We have a note to play.                      *)
  210.                 (* N.B. procedure Translate updates inplace.    *)
  211.  
  212.                 Translate (notes, inplace,
  213.                                 buffer[currentbuffer][outplace].period);
  214.                 buffer[currentbuffer][outplace].duration := CurrentDuration;
  215.  
  216.                 IF outplace = MAX(buffersubscript) (*HIGH(buffer[currentbuffer])*) THEN
  217.  
  218.                     (* The current buffer is full, so send that batch   *)
  219.                     (* of data to procedure Play.                       *)
  220.  
  221.                     Play (buffer[currentbuffer], FreeBuffer);
  222.  
  223.                     (* Wait, if necessary, for the other buffer to      *)
  224.                     (* become available, and switch to using it.        *)
  225.  
  226.                     Wait (FreeBuffer);
  227.                     currentbuffer := 1 - currentbuffer;  outplace := 0;
  228.  
  229.                 ELSE
  230.                     INC (outplace);
  231.                 END (*IF*);
  232.  
  233.             END (*IF*);
  234.         UNTIL (inplace > HIGH(notes)) OR (notes[inplace] = CHR(0));
  235.  
  236.         (* On exit from the above loop, we still have a partially       *)
  237.         (* filled final buffer to send to Play.  There is a special     *)
  238.         (* case where the "partially filled buffer" is in fact empty,   *)
  239.         (* but Play can handle that case.                               *)
  240.  
  241.         buffer[currentbuffer][outplace].duration := 0;(* to mark end of data*)
  242.         Play (buffer[currentbuffer], FreeBuffer);
  243.  
  244.     END PlayMusic;
  245.  
  246. (************************************************************************)
  247.  
  248. PROCEDURE WaitForMusicFinished;
  249.  
  250.     (* Blocks the calling task until there is no more music playing.    *)
  251.     (* This is a guard against things like premature task termination.  *)
  252.  
  253.     BEGIN
  254.  
  255.         (* Put in a claim for both of the output buffers, i.e. wait     *)
  256.         (* until they are both unused.                                  *)
  257.  
  258.         Wait (FreeBuffer);  Wait (FreeBuffer);
  259.  
  260.         (* Now release them, because we didn't really want to use them. *)
  261.  
  262.         Signal (FreeBuffer);  Signal (FreeBuffer);
  263.  
  264.     END WaitForMusicFinished;
  265.  
  266. (************************************************************************)
  267. (*                      MODULE INITIALISATION                           *)
  268. (************************************************************************)
  269.  
  270. PROCEDURE Initialise;
  271.  
  272.     (* Sets the initial duration and octave, and sets up the tables     *)
  273.     (* for translating from music notation to duration codes.           *)
  274.  
  275.     CONST scale = 0.943874313;          (*  2^(-1/12)   *)
  276.  
  277.     VAR period: REAL;  j: ZeroToEleven;
  278.  
  279.     BEGIN
  280.         CurrentDuration := 3;  CurrentOctave := 4;
  281.         LastNote := irrelevantnote;
  282.  
  283.         (* NoteTable translates from letter codes into a numeric code   *)
  284.         (* consistent with a well-tempered tuning.                      *)
  285.  
  286.         NoteTable["C"] := 0;  NoteTable["D"] := 2;
  287.         NoteTable["E"] := 4;  NoteTable["F"] := 5;
  288.         NoteTable["G"] := 7;  NoteTable["A"] := 9;
  289.         NoteTable["B"] := 11;
  290.  
  291.         (* For PeriodTable, we give the lowest (octave 0) C a frequency *)
  292.         (* which is the lowest frequency which can be handled, and then *)
  293.         (* derive all other frequencies by successive scaling by the    *)
  294.         (* twelfth root of 2.  Our base frequency is about one note out *)
  295.         (* when compared with the standard A4 = 440Hz tuning, but in    *)
  296.         (* this version I take that as an acceptable imperfection.      *)
  297.         (* To repair this flaw, we would have to take into account the  *)
  298.         (* fact that C in octave 0 cannot be played, which suggests     *)
  299.         (* that an improved version of this module would need to be     *)
  300.         (* "tuned" to a key other than C major.                         *)
  301.  
  302.         period := 65535.0;
  303.         PeriodTable[0] := 65535;
  304.         FOR j := 1 TO 11 DO
  305.             period := scale*period;
  306.             PeriodTable[j] := TRUNC(period + 0.5);
  307.         END (*FOR*);
  308.  
  309.         (* We initially have two empty output buffers, so initialise    *)
  310.         (* semaphore FreeBuffer to record this fact; and arbitrarily    *)
  311.         (* choose one of the buffers as the initially active buffer.    *)
  312.  
  313.         CreateSemaphore (FreeBuffer, 2);
  314.         currentbuffer := 0;
  315.  
  316.     END Initialise;
  317.  
  318. (************************************************************************)
  319.  
  320. BEGIN
  321.     Initialise;
  322. END Music.
  323. 
  324.