home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / misc / piano1.zip / PLAYIT.PAS < prev    next >
Pascal/Delphi Source File  |  1988-04-15  |  3KB  |  105 lines
  1. UNIT PlayIt;
  2. (*****************************************************)
  3. (* Copyright (c) 1988 by Neil J. Rubenking           *)
  4. (* Demonstrates how to play a PIANOMAN MUZ file from *)
  5. (* Turbo Pascal version 4.0.  You may freely include *)
  6. (* and distribute this Unit in your programs.        *)
  7. (*                                                   *)
  8. (* To use the Unit, first create a MUZ file using    *)
  9. (* PIANOMAN.  Then call on the BINOBJ utility that   *)
  10. (* comes with TP4 to turn the MUZ file into an OBJ   *)
  11. (* file.  Finally, declare a TP4 Procedure as an     *)
  12. (* EXTERNAL using that OBJ file.  Now you can call   *)
  13. (* the Procedure PlayOBJ in this Unit.               *)
  14. (*                                                   *)
  15. (* See PLAYDEMO.PAS for demonstration.               *)
  16. (*****************************************************)
  17.  
  18. (**********************)
  19. (**)   INTERFACE    (**)
  20. (**********************)
  21. Uses CRT;
  22. PROCEDURE PlayOBJ(
  23.          P : Pointer; {Pointer to "fake External" procedure containing tune}
  24.    KeyStop : Boolean; {If true, tune will stop when key is pressed.}
  25.     VAR CH : char);   {^Returns pressed key if stopped.}
  26.  
  27. (**********************)
  28. (**) IMPLEMENTATION (**)
  29. (**********************)
  30. TYPE
  31.   FiledNote = RECORD
  32.                 O, NS : Byte;
  33.                 D : Word;
  34.               END;
  35.   NotePt = ^FiledNote;
  36. VAR
  37.   Oct_Val : ARRAY[0..8] OF Real;
  38.   Freq_Val : ARRAY[1..12] OF Real;
  39.  
  40.   PROCEDURE Set_Frequencies;
  41.   VAR N : Byte;
  42.   BEGIN
  43.     Freq_Val[1] := 1;
  44.     Freq_Val[2] := 1.0594630944;
  45.     FOR N := 3 TO 12 DO
  46.       Freq_Val[N] := Freq_Val[N - 1] * Freq_Val[2];
  47.     Oct_Val[0] := 32.70319566;
  48.     FOR N := 1 TO 8 DO
  49.       Oct_Val[N] := Oct_Val[N - 1] * 2;
  50.   END;
  51.  
  52.  
  53.   PROCEDURE PlayOne(Octave, NoteStaccato : Byte; Duration : Integer);
  54.   CONST
  55.     factor : ARRAY[0..10] OF Real = (0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0);
  56.   VAR
  57.     Frequency : Real;
  58.     Note, Staccato : Byte;   (*!*)
  59.   BEGIN
  60.     Note := NoteStaccato SHR 4;
  61.     Staccato := NoteStaccato AND $F;
  62.     IF Staccato > 10 THEN Staccato := 10;
  63.     IF Staccato < 0 THEN Staccato := 0;
  64.     IF Octave > 8 THEN Octave := 8;
  65.     IF Octave < 1 THEN Octave := 1;
  66.     CASE Note OF
  67.       1..12 : BEGIN
  68.                 Frequency := Oct_Val[Octave] * Freq_Val[Note];
  69.                 Sound(Round(Frequency));
  70.                 Delay(Round(Duration * factor[10 - Staccato]));
  71.                 IF Duration > 0 THEN NoSound;
  72.                 Delay(Round(Duration * factor[Staccato]));
  73.               END;
  74.       13 : BEGIN NoSound; Delay(Duration); END;
  75.     END;                     {case}
  76.   END;
  77.  
  78.   PROCEDURE PlayOBJ(P : Pointer; KeyStop : Boolean; VAR CH : char);
  79.   VAR T : NotePt;
  80.     N, Num : Word;
  81.   BEGIN
  82.     T := NotePt(P);
  83.     Inc(LongInt(T), SizeOf(FiledNote) * 5);
  84.     Num := LongInt(T^) AND $FFFF;
  85.     Inc(LongInt(T), SizeOf(FiledNote) * 4);
  86.     FOR N := 1 TO Num DO
  87.       BEGIN
  88.         WITH T^ DO
  89.           PlayOne(O, NS, D);
  90.         Inc(LongInt(T), SizeOf(FiledNote));
  91.         IF KeyStop AND KeyPressed THEN
  92.           BEGIN
  93.             CH := ReadKey;
  94.             Exit;
  95.           END;
  96.       END;
  97.   END;
  98.  
  99. (**********************)
  100. (*   INITIALIZATION   *)
  101. (**********************)
  102. BEGIN
  103.   Set_Frequencies;
  104. END.
  105.