home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / MBUG / MBUG039.ARC / TUNE.PAS < prev    next >
Pascal/Delphi Source File  |  1979-12-31  |  2KB  |  51 lines
  1. PROGRAM Tune ;      { Change 'PROGRAM' to 'PROCEDURE' for your program }
  2.  
  3.   VAR   Tone       : ARRAY[1..24] OF integer ;
  4.  
  5.   PROCEDURE NoteCalc ;    {     Calculates 24 note periods and
  6.                                 puts them in array 'Tone'        }
  7.     VAR i          : integer ;
  8.         period, n  : real ;
  9.  
  10.     BEGIN
  11.       period := 161.0 ; n := 1.0585 ; { period = 161 for lowest note (A) }
  12.       FOR i := 1 TO 24 DO
  13.         BEGIN
  14.           Tone[i] := Round(period) ;
  15.           period := period / n ;   { calculate succeeding periods }
  16.           n := n + 0.00046
  17.         END
  18.     END ;
  19.  
  20.   PROCEDURE P(note, time : integer) ; { Play 'note' for 'time' }
  21.  
  22.     VAR  duration, up, down, i, j  : integer ;
  23.  
  24.     BEGIN
  25.       IF note = 0 THEN
  26.         Delay(time * (1000 DIV 8))   { Rest }
  27.       ELSE
  28.         BEGIN
  29.           duration := time * (4210 DIV Tone[note]) ;è          up := Tone[note] DIV 2 ;
  30.           down := Tone[note] - up ;
  31.           FOR i := 1 TO duration DO
  32.             BEGIN
  33.               inline ($3E/$F8/        { LD     A,248  }
  34.                       $D3/$02);       { OUT    (2),A  } { Speaker bit 'up'}
  35.               FOR j := 1 TO up DO ;   { up time }
  36.               inline ($3E/$B8/        { LD     A,184  }
  37.                       $D3/$02);       { OUT    (2),A  } { Speaker bit 'down'}
  38.               FOR j := 1 TO down DO ; { down time }
  39.             END
  40.         END
  41.     END ;
  42.  
  43.   BEGIN  { Tune }
  44.     NoteCalc ;
  45.     { 'SAINTS...' }
  46.     P(4,2); P(8,2); P(9,2); P(11,8); P(4,2); P(8,2); P(9,2); P(11,8);
  47.     P(4,2); P(8,2); P(9,2); P(11,4); P(8,4); P(4,2); P(8,4); P(6,8); P(0,2);
  48.     P(8,2); P(8,2); P(6,2); P(4,8);  P(8,4); P(11,4); P(11,2); P(9,8); P(0,2);
  49.     P(8,2); P(9,2); P(11,4); P(8,4); P(4,4); P(6,4); P(4,10);
  50.   END.    { *** Dont forget to change '.' to ';' *** }
  51.