home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 2 / crawlyvol2.bin / program / pascal / passrc / sound.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-18  |  3.5 KB  |  128 lines
  1. { -----------------------------------------------------------------------------
  2.  
  3.                                  NOTICE:
  4.  
  5.       THESE MATERIALS are UNSUPPORTED by OSS!  If you do not understand how to
  6.       use them do not contact OSS for help!  We will not teach you how to 
  7.       program in Pascal.  If you find an error in these materials, feel free
  8.       to SEND US A LETTER explaining the error, and how to fix it.
  9.  
  10.       THE BOTTOM LINE:
  11.  
  12.          Use it, enjoy it, but you are on your own when using these materials!
  13.  
  14.  
  15.                                DISCLAIMER:
  16.  
  17.       OSS makes no representations or warranties with respect to the contents
  18.       hereof and specifically disclaim all warranties of merchantability or
  19.       fitness for any particular purpose.   This document is subject to change
  20.       without notice.
  21.       
  22.       OSS provides these materials for use with Personal Pascal.  Use them in
  23.       any way you wish.
  24.  
  25.    -------------------------------------------------------------------------- }
  26.  
  27.  
  28. (* sound_demo - A simple Personal Pascal sound demo program.
  29.  
  30.     You must turn off key-clicks using the control panel before running this
  31.     program, as the key-click routine in the OS will mess up your sound!  We
  32.     hope soon to add to this demo an XBIOS call to turn off the keyclicks. *)
  33.  
  34. PROGRAM sound_demo ;
  35.  
  36.   CONST
  37.     cmd_write = 128 ;
  38.     cmd_read  = 0 ;
  39.     chana_lo = 0 ;
  40.     chana_hi = 1 ;
  41.     chana_vol = 8 ;
  42.     chan_enable = 7 ;
  43.     enable_sound = 7 ;
  44.  
  45.   TYPE
  46.     channel = 0..2 ;
  47.  
  48.   VAR
  49.     volume, note : integer ;
  50.  
  51.  
  52.  
  53. (* Two XBIOS functions (actually one call with two definitions!) needed to
  54.   access the General Instruments sound chip. *)
  55.  
  56.   FUNCTION gia_read( data, register : integer ) : integer ;
  57.     XBIOS( 28 ) ;
  58.  
  59.   PROCEDURE gia_write( data, register : integer ) ;
  60.     XBIOS( 28 ) ;
  61.  
  62.  
  63.  
  64. (* Call this routine to enable sound to be generated. *)
  65.  
  66.   PROCEDURE Sound_Init ;
  67.  
  68.     VAR
  69.       port_state : integer ;
  70.  
  71.     BEGIN
  72.       port_state := gia_read( 0, chan_enable+cmd_read ) ;
  73.       gia_write( port_state&(~enable_sound), chan_enable+cmd_write ) ;
  74.     END ;
  75.  
  76.  
  77.  
  78. (* This routine turns on a particular note on one of the three channels. *)
  79.  
  80.   PROCEDURE Sound( ch : channel ; pitch : integer ; vol : integer ) ;
  81.  
  82.     BEGIN
  83.       gia_write( vol, chana_vol+ch+cmd_write ) ;
  84.       gia_write( pitch&$FF, chana_lo+ch*2+cmd_write ) ;
  85.       gia_write( shr(pitch,8), chana_hi+ch*2+cmd_write ) ;
  86.     END ;
  87.  
  88.  
  89.  
  90. (* Call this routine to turn off sound after you're finished. *)
  91.  
  92.   PROCEDURE Sound_Off ;
  93.  
  94.     VAR
  95.       port_state : integer ;
  96.  
  97.     BEGIN
  98.       Sound( 0, 0, 0 ) ;        (* First, make sure all volumes are zero. *)
  99.       Sound( 1, 0, 0 ) ;
  100.       Sound( 2, 0, 0 ) ;
  101.       (* Now disable sound production on all three channels. *)
  102.       port_state := gia_read( 0, chan_enable+cmd_read ) ;
  103.       gia_write( port_state|enable_sound, chan_enable+cmd_write ) ;
  104.     END ;
  105.  
  106.  
  107.   BEGIN
  108.     (* Main program loop-- ask user for a volume to use... should be 0-15. *)
  109.     LOOP
  110.       write( 'volume: ' ) ;
  111.       readln( volume ) ;
  112.  
  113.       EXIT IF volume = 0 ;
  114.  
  115.       sound_init ;      (* Enable sound. *)
  116.  
  117.       (* Sub-loop-- keep generating notes until user enters 0 as a pitch. *)
  118.       LOOP
  119.           write( 'note: ' ) ;
  120.           readln( note ) ;
  121.           EXIT IF note = 0 ;
  122.           sound( 0, note, volume ) ;
  123.       END ;
  124.  
  125.       sound_off ;       (* Disable the sound. *)
  126.     END ;
  127.   END.
  128.