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 / MBUG094.ARC / SOUND.PRO < prev    next >
Text File  |  1979-12-31  |  5KB  |  136 lines
  1. {Modified by R.K.Hallworth of Donvale Christian School
  2.  to accept user interupts U+ and simplify use}
  3.  
  4. procedure PLAY(note : integer; note_length : byte);
  5.  
  6. { Procedure developed in Turbo Pascal for the
  7.   MicroBee by Bob Burt, using an algorithm
  8.          developed by Alan Burt                }
  9.  
  10. { This procedure is used in conjunction with
  11.         the procedure SOUND.PRO                }
  12.  
  13. var
  14.   cycles,frequency,duration : integer;
  15.  
  16. procedure SOUND;
  17.  
  18. {    Procedure developed in Turbo Pascal for the
  19.               MicroBee by Bob Burt
  20.  
  21.      Use in conjunction with procedure PLAY.PRO
  22.       to produce selected notes from the normal
  23.         scale (simulation of PLAY command in
  24.                 MicroWorld BASIC )
  25.  
  26.   Note -  It is not necessary to include the
  27.          comments, which represent the assembly
  28.           language instructions from which the
  29.                inline code was derived
  30.           The inline code may be compacted }
  31.  
  32. begin
  33.   inline (245/213/229/     { START:  PUSH AF,DE,HL    }
  34.           237/91/cycles/   {         LD   DE,(CYCLES) }
  35.           62/184/          {         LD   A,0B8H      }
  36.           211/2/           {         OUT  (2),A       }
  37.           205/*+18/        {         CALL PAUSE       }
  38.           62/248/          {         LD   A,0F8H      }
  39.           211/2/           {         OUT  (2),A       }
  40.           205/*+11/        {         CALL PAUSE       }
  41.           27/              {         DEC  DE          }
  42.           122/             {         LD   A,D         }
  43.           179/             {         OR   E           }
  44.           32/237/          {         JR   NZ,LOOP1    }
  45.           225/209/241/     {         POP  HL,DE,AF    }
  46.           201/             {         RET              }
  47.  
  48.           42/duration/     { PAUSE:  LD   HL,(DELAY)  }
  49.           43/              { LOOP2:  DEC  HL          }
  50.           124/             {         LD   A,H         }
  51.           181/             {         OR   L           }
  52.           32/251/          {         JR   NZ,LOOP2    }
  53.           201)             {         RET              }
  54.  
  55. end; {procedure sound}
  56.  
  57. begin
  58.   frequency := round(exp(ln(440)+(note-13)/12*ln(2)));
  59.   duration := round(exp(ln(144)+(13-note)/12*ln(2.028)));
  60.   cycles := frequency*note_length div 8;
  61.   sound
  62. end; {procedure play}
  63.  
  64.  
  65. procedure Sound_Effect(Start_tone,End_tone:byte;
  66.                        Duration           :integer;
  67.                        GoUp,Melodic,Many  :boolean);
  68.  
  69. Var
  70.   up_down,timbre,one_many:byte;
  71.  
  72. procedure GENSND;
  73.  
  74. { Procedure developed in Turbo Pascal
  75.   for sound routines to operate with
  76.       the MicroBee by Bob Burt        }
  77.  
  78. {    Sound generator module to be
  79.      operated in conjunction with
  80.      procedure INITSND.PRO            }
  81.  
  82. begin
  83.   inline(24/14/      { JUMP:    JR   START        }
  84.          62/184/     { ONINT:   LD   A,0B8H       }
  85.          211/2/      { LOOP0:   OUT  (2),A        }
  86.          16/252/     {          DJ   NZ,LOOP0     }
  87.          201/        {          RET               }
  88.  
  89.          62/248/     { OFFINT:  LD   A,0F8H       }
  90.          211/2/      { LOOP1:   OUT  (2),A        }
  91.          16/252/     {          DJ   NZ,LOOP1     }
  92.          201/        {          RET               }
  93.  
  94.          245/        { START:   PUSH AF           }
  95.          197/        {          PUSH BC           }
  96.          229/        {          PUSH HL           }
  97.          $3A/UP_DOWN/{          LD   A,UP_DOWN    }
  98.          $32/*+21 /  {          LD   (POS1),A     }
  99.          $3A/TIMBRE/ {          LD   A,TIMBRE     }
  100.          $32/*+21/   {          LD   (POS2),A     }
  101.          $3A/START_TONE/{         LD   A,START_TONE   }
  102.          $47/        {          LD   B,A          }
  103.          $3A/ONE_MANY/{         LD   A,ONE_MANY   }
  104.          $32/*+26/   {          LD   (POS3),A     }
  105.          $2A/DURATION/{LOOP3:   LD   HL,DURATION  }
  106.          5/          { POS1:    DEC  B (UP_DOWN)  }
  107.          72/         {          LD   C,B          }
  108.          65/         { LOOP2:   LD   B,C          }
  109.          205/*-46/   {          CALL ONINT        }
  110.          65/         {          LD   B,C (TIMBRE) }
  111.          205/*-43/   {          CALL OFFINT       }
  112.          43/         {          DEC  HL           }
  113.          125/        {          LD   A,L          }
  114.          180/        {          OR   H            }
  115.          32/243/     {          JR   NZ,LOOP2     }
  116.          65/         {          LD   B,C          }
  117.          120/        {          LD   A,B          }
  118.          $21/END_TONE/{         LD   HL,END_TONE  }
  119.          $BE/        {          CP   A,(HL)       }
  120.          32/$E6/     { ONE_MANY:JR   NZ,LOOP3     }
  121.          225/        {          POP  HL           }
  122.          193/        {          POP  BC           }
  123.          241/        {          POP  AF           }
  124.          201);       {          RET               }
  125. end; {procedure gensnd}
  126.  
  127.  
  128. begin
  129.      Start_tone:=255-Start_tone;
  130.      End_Tone  :=255-End_Tone;
  131.      if GoUp then up_down:=5 else up_down:=4;
  132.      if Melodic then timbre:=65 else timbre:=69;
  133.      if Many    then one_many:=32 else one_many:=40;
  134.      gensnd;
  135. end;
  136.