home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _a4a6cd42f09b12a4ef98ad3f92530fee < prev    next >
Text File  |  2004-06-01  |  15KB  |  583 lines
  1. #######################################################################
  2. #
  3. # Win32::Sound - An extension to play with Windows sounds
  4. # 
  5. # Author: Aldo Calpini <dada@divinf.it>
  6. # Version: 0.47
  7. # Info:
  8. #       http://www.divinf.it/dada/perl
  9. #       http://www.perl.com/CPAN/authors/Aldo_Calpini
  10. #
  11. #######################################################################
  12. # Version history: 
  13. # 0.01 (19 Nov 1996) file created
  14. # 0.03 (08 Apr 1997) first release
  15. # 0.30 (20 Oct 1998) added Volume/Format/Devices/DeviceInfo
  16. #                    (thanks Dave Roth!)
  17. # 0.40 (16 Mar 1999) added the WaveOut object
  18. # 0.45 (09 Apr 1999) added $! support, documentation et goodies
  19. # 0.46 (25 Sep 1999) fixed small bug in DESTROY, wo was used without being
  20. #             initialized (Gurusamy Sarathy <gsar@activestate.com>)
  21. # 0.47 (22 May 2000) support for passing Unicode string to Play()
  22. #                    (Doug Lankshear <dougl@activestate.com>)
  23.  
  24. package Win32::Sound;
  25.  
  26. # See the bottom of this file for the POD documentation.  
  27. # Search for the string '=head'.
  28.  
  29. require Exporter;       # to export the constants to the main:: space
  30. require DynaLoader;     # to dynuhlode the module.
  31.  
  32. @ISA= qw( Exporter DynaLoader );
  33. @EXPORT = qw(
  34.     SND_ASYNC
  35.     SND_NODEFAULT
  36.     SND_LOOP
  37.     SND_NOSTOP
  38. );
  39.  
  40. #######################################################################
  41. # This AUTOLOAD is used to 'autoload' constants from the constant()
  42. # XS function.  If a constant is not found then control is passed
  43. # to the AUTOLOAD in AutoLoader.
  44. #
  45.  
  46. sub AUTOLOAD {
  47.     my($constname);
  48.     ($constname = $AUTOLOAD) =~ s/.*:://;
  49.     #reset $! to zero to reset any current errors.
  50.     local $! = 0;
  51.     my $val = constant($constname, @_ ? $_[0] : 0);
  52.     if ($! != 0) {
  53.  
  54.     # [dada] This results in an ugly Autoloader error
  55.  
  56.     #if ($! =~ /Invalid/) {
  57.     #    $AutoLoader::AUTOLOAD = $AUTOLOAD;
  58.     #    goto &AutoLoader::AUTOLOAD;
  59.     #} else {
  60.     
  61.     # [dada] ... I prefer this one :)
  62.  
  63.         ($pack, $file, $line) = caller;
  64.         undef $pack; # [dada] and get rid of "used only once" warning...
  65.         die "Win32::Sound::$constname is not defined, used at $file line $line.";
  66.  
  67.     #}
  68.     }
  69.     eval "sub $AUTOLOAD { $val }";
  70.     goto &$AUTOLOAD;
  71. }
  72.  
  73.  
  74. #######################################################################
  75. # STATIC OBJECT PROPERTIES
  76. #
  77. $VERSION="0.47"; 
  78. undef unless $VERSION; # [dada] to avoid "possible typo" warning
  79.  
  80. #######################################################################
  81. # METHODS
  82. #
  83.  
  84. sub Version { $VERSION }
  85.  
  86. sub Volume {
  87.     my(@in) = @_;
  88.     # Allows '0%'..'100%'   
  89.     $in[0] =~ s{ ([\d\.]+)%$ }{ int($1*100/255) }ex if defined $in[0];
  90.     $in[1] =~ s{ ([\d\.]+)%$ }{ int($1*100/255) }ex if defined $in[1];
  91.     _Volume(@in);
  92. }
  93.  
  94. #######################################################################
  95. # dynamically load in the Sound.dll module.
  96. #
  97.  
  98. bootstrap Win32::Sound;
  99.  
  100. #######################################################################
  101. # Win32::Sound::WaveOut
  102. #
  103.  
  104. package Win32::Sound::WaveOut;
  105.  
  106. sub new {
  107.     my($class, $one, $two, $three) = @_;
  108.     my $self = {};
  109.     bless($self, $class);
  110.     
  111.     if($one !~ /^\d+$/ 
  112.     and not defined($two)
  113.     and not defined($three)) {
  114.         # Looks like a file
  115.         $self->Open($one);
  116.     } else {
  117.         # Default format if not given
  118.         $self->{samplerate} = ($one   or 44100);
  119.         $self->{bits}       = ($two   or 16);
  120.         $self->{channels}   = ($three or 2);
  121.         $self->OpenDevice();
  122.     }
  123.     return $self;
  124. }
  125.  
  126. sub Volume {
  127.     my(@in) = @_;
  128.     # Allows '0%'..'100%'   
  129.     $in[0] =~ s{ ([\d\.]+)%$ }{ int($1*255/100) }ex if defined $in[0];
  130.     $in[1] =~ s{ ([\d\.]+)%$ }{ int($1*255/100) }ex if defined $in[1];
  131.     _Volume(@in);
  132. }
  133.  
  134. sub Pitch {
  135.     my($self, $pitch) = @_;
  136.     my($int, $frac);
  137.     if(defined($pitch)) {
  138.         $pitch =~ /(\d+).?(\d+)?/;
  139.         $int = $1;
  140.         $frac = $2 or 0;
  141.         $int = $int << 16;
  142.         $frac = eval("0.$frac * 65536");
  143.         $pitch = $int + $frac;
  144.         return _Pitch($self, $pitch);
  145.     } else {
  146.         $pitch = _Pitch($self);
  147.         $int = ($pitch & 0xFFFF0000) >> 16;
  148.         $frac = $pitch & 0x0000FFFF;
  149.         return eval("$int.$frac");
  150.     }
  151. }
  152.  
  153. sub PlaybackRate {
  154.     my($self, $rate) = @_;
  155.     my($int, $frac);
  156.     if(defined($rate)) {
  157.         $rate =~ /(\d+).?(\d+)?/;
  158.         $int = $1;
  159.         $frac = $2 or 0;
  160.         $int = $int << 16;
  161.         $frac = eval("0.$frac * 65536");
  162.         $rate = $int + $frac;
  163.         return _PlaybackRate($self, $rate);
  164.     } else {
  165.         $rate = _PlaybackRate($self);
  166.         $int = ($rate & 0xFFFF0000) >> 16;
  167.         $frac = $rate & 0x0000FFFF;
  168.         return eval("$int.$frac");
  169.     }
  170. }
  171.  
  172. # Preloaded methods go here.
  173.  
  174. #Currently Autoloading is not implemented in Perl for win32
  175. # Autoload methods go after __END__, and are processed by the autosplit program.
  176.  
  177. 1;
  178. __END__
  179.  
  180.  
  181. =head1 NAME
  182.  
  183. Win32::Sound - An extension to play with Windows sounds
  184.  
  185. =head1 SYNOPSIS
  186.  
  187.     use Win32::Sound;
  188.     Win32::Sound::Volume('100%');
  189.     Win32::Sound::Play("file.wav");
  190.     Win32::Sound::Stop();
  191.     
  192.     # ...and read on for more fun ;-)
  193.  
  194. =head1 FUNCTIONS
  195.  
  196. =over 4
  197.  
  198. =item B<Win32::Sound::Play(SOUND, [FLAGS])>
  199.  
  200. Plays the specified sound: SOUND can the be name of a WAV file
  201. or one of the following predefined sound names:
  202.  
  203.     SystemDefault
  204.     SystemAsterisk
  205.     SystemExclamation
  206.     SystemExit
  207.     SystemHand
  208.     SystemQuestion
  209.     SystemStart
  210.  
  211. Additionally, if the named sound could not be found, the 
  212. function plays the system default sound (unless you specify the 
  213. C<SND_NODEFAULT> flag). If no parameters are given, this function 
  214. stops the sound actually playing (see also Win32::Sound::Stop).
  215.  
  216. FLAGS can be a combination of the following constants:
  217.  
  218. =over 4
  219.  
  220. =item C<SND_ASYNC>
  221.  
  222. The sound is played asynchronously and the function 
  223. returns immediately after beginning the sound
  224. (if this flag is not specified, the sound is
  225. played synchronously and the function returns
  226. when the sound ends).
  227.  
  228. =item C<SND_LOOP>
  229.  
  230. The sound plays repeatedly until it is stopped.
  231. You must also specify C<SND_ASYNC> flag.
  232.  
  233. =item C<SND_NODEFAULT>
  234.  
  235. No default sound is used. If the specified I<sound>
  236. cannot be found, the function returns without
  237. playing anything.
  238.  
  239. =item C<SND_NOSTOP>
  240.  
  241. If a sound is already playing, the function fails.
  242. By default, any new call to the function will stop
  243. previously playing sounds.
  244.  
  245. =back
  246.  
  247. =item B<Win32::Sound::Stop()>
  248.  
  249. Stops the sound currently playing.
  250.  
  251. =item B<Win32::Sound::Volume()>
  252.  
  253. Returns the wave device volume; if 
  254. called in an array context, returns left
  255. and right values. Otherwise, returns a single
  256. 32 bit value (left in the low word, right 
  257. in the high word).
  258. In case of error, returns C<undef> and sets
  259. $!.
  260.  
  261. Examples:
  262.  
  263.     ($L, $R) = Win32::Sound::Volume();
  264.     if( not defined Win32::Sound::Volume() ) {
  265.         die "Can't get volume: $!";
  266.     }
  267.  
  268. =item B<Win32::Sound::Volume(LEFT, [RIGHT])>
  269.  
  270. Sets the wave device volume; if two arguments
  271. are given, sets left and right channels 
  272. independently, otherwise sets them both to
  273. LEFT (eg. RIGHT=LEFT). Values range from
  274. 0 to 65535 (0xFFFF), but they can also be
  275. given as percentage (use a string containing 
  276. a number followed by a percent sign).
  277.  
  278. Returns C<undef> and sets $! in case of error,
  279. a true value if successful.
  280.  
  281. Examples:
  282.  
  283.     Win32::Sound::Volume('50%');
  284.     Win32::Sound::Volume(0xFFFF, 0x7FFF);
  285.     Win32::Sound::Volume('100%', '50%');
  286.     Win32::Sound::Volume(0);
  287.  
  288. =item B<Win32::Sound::Format(filename)>
  289.  
  290. Returns information about the specified WAV file format;
  291. the array contains:
  292.  
  293. =over
  294.  
  295. =item * sample rate (in Hz)
  296.  
  297. =item * bits per sample (8 or 16)
  298.  
  299. =item * channels (1 for mono, 2 for stereo)
  300.  
  301. =back
  302.  
  303. Example:
  304.  
  305.     ($hz, $bits, $channels) 
  306.         = Win32::Sound::Format("file.wav");
  307.  
  308.  
  309. =item B<Win32::Sound::Devices()>
  310.  
  311. Returns all the available sound devices;
  312. their names contain the type of the
  313. device (WAVEOUT, WAVEIN, MIDIOUT,
  314. MIDIIN, AUX or MIXER) and 
  315. a zero-based ID number: valid devices
  316. names are for example:
  317.  
  318.     WAVEOUT0
  319.     WAVEOUT1
  320.     WAVEIN0
  321.     MIDIOUT0
  322.     MIDIIN0
  323.     AUX0
  324.     AUX1
  325.     AUX2
  326.  
  327. There are also two special device
  328. names, C<WAVE_MAPPER> and C<MIDI_MAPPER>
  329. (the default devices for wave output
  330. and midi output).
  331.  
  332. Example:
  333.  
  334.     @devices = Win32::Sound::Devices();
  335.  
  336. =item Win32::Sound::DeviceInfo(DEVICE)
  337.  
  338. Returns an associative array of information 
  339. about the sound device named DEVICE (the
  340. same format of Win32::Sound::Devices).
  341.  
  342. The content of the array depends on the device
  343. type queried. Each device type returns B<at least> 
  344. the following information:
  345.  
  346.     manufacturer_id
  347.     product_id
  348.     name
  349.     driver_version
  350.  
  351. For additional data refer to the following
  352. table:
  353.  
  354.     WAVEIN..... formats
  355.                 channels
  356.     
  357.     WAVEOUT.... formats
  358.                 channels
  359.                 support
  360.                 
  361.     MIDIOUT.... technology
  362.                 voices
  363.                 notes
  364.                 channels
  365.                 support
  366.                 
  367.     AUX........ technology
  368.                 support
  369.                 
  370.     MIXER...... destinations
  371.                 support
  372.  
  373. The meaning of the fields, where not
  374. obvious, can be evinced from the 
  375. Microsoft SDK documentation (too long
  376. to report here, maybe one day... :-).
  377.  
  378. Example:
  379.  
  380.     %info = Win32::Sound::DeviceInfo('WAVE_MAPPER');
  381.     print "$info{name} version $info{driver_version}\n";
  382.  
  383. =back
  384.  
  385. =head1 THE WaveOut PACKAGE
  386.  
  387. Win32::Sound also provides a different, more
  388. powerful approach to wave audio data with its 
  389. C<WaveOut> package. It has methods to load and
  390. then play WAV files, with the additional feature
  391. of specifying the start and end range, so you
  392. can play only a portion of an audio file.
  393.  
  394. Furthermore, it is possible to load arbitrary
  395. binary data to the soundcard to let it play and
  396. save them back into WAV files; in a few words,
  397. you can do some sound synthesis work.
  398.  
  399. =head2 FUNCTIONS
  400.  
  401. =over
  402.  
  403. =item new Win32::Sound::WaveOut(FILENAME)
  404.  
  405. =item new Win32::Sound::WaveOut(SAMPLERATE, BITS, CHANNELS)
  406.  
  407. =item new Win32::Sound::WaveOut()
  408.  
  409. This function creates a C<WaveOut> object; the
  410. first form opens the specified wave file (see
  411. also C<Open()> ), so you can directly C<Play()> it.
  412.  
  413. The second (and third) form opens the
  414. wave output device with the format given
  415. (or if none given, defaults to 44.1kHz,
  416. 16 bits, stereo); to produce something
  417. audible you can either C<Open()> a wave file
  418. or C<Load()> binary data to the soundcard
  419. and then C<Write()> it.
  420.  
  421. =item Close()
  422.  
  423. Closes the wave file currently opened.
  424.  
  425. =item CloseDevice()
  426.  
  427. Closes the wave output device; you can change
  428. format and reopen it with C<OpenDevice()>.
  429.  
  430. =item GetErrorText(ERROR)
  431.  
  432. Returns the error text associated with
  433. the specified ERROR number; note it only
  434. works for wave-output-specific errors.
  435.  
  436. =item Load(DATA)
  437.  
  438. Loads the DATA buffer in the soundcard.
  439. The format of the data buffer depends
  440. on the format used; for example, with
  441. 8 bit mono each sample is one character,
  442. while with 16 bit stereo each sample is
  443. four characters long (two 16 bit values
  444. for left and right channels). The sample
  445. rate defines how much samples are in one
  446. second of sound. For example, to fit one
  447. second at 44.1kHz 16 bit stereo your buffer
  448. must contain 176400 bytes (44100 * 4).
  449.  
  450. =item Open(FILE)
  451.  
  452. Opens the specified wave FILE.
  453.  
  454. =item OpenDevice()
  455.  
  456. Opens the wave output device with the
  457. current sound format (not needed unless
  458. you used C<CloseDevice()>).
  459.  
  460. =item Pause()
  461.  
  462. Pauses the sound currently playing; 
  463. use C<Restart()> to continue playing.
  464.  
  465. =item Play( [FROM, TO] )
  466.  
  467. Plays the opened wave file. You can optionally
  468. specify a FROM - TO range, where FROM and TO
  469. are expressed in samples (or use FROM=0 for the
  470. first sample and TO=-1 for the last sample).
  471. Playback happens always asynchronously, eg. in 
  472. the background.
  473.  
  474. =item Position()
  475.  
  476. Returns the sample number currently playing;
  477. note that the play position is not zeroed
  478. when the sound ends, so you have to call a
  479. C<Reset()> between plays to receive the
  480. correct position in the current sound.
  481.  
  482. =item Reset()
  483.  
  484. Stops playing and resets the play position
  485. (see C<Position()>).
  486.  
  487. =item Restart()
  488.  
  489. Continues playing the sound paused by C<Pause()>.
  490.  
  491. =item Save(FILE, [DATA])
  492.  
  493. Writes the DATA buffer (if not given, uses the 
  494. buffer currently loaded in the soundcard) 
  495. to the specified wave FILE.
  496.  
  497. =item Status()
  498.  
  499. Returns 0 if the soundcard is currently playing,
  500. 1 if it's free, or C<undef> on errors.
  501.  
  502. =item Unload()
  503.  
  504. Frees the soundcard from the loaded data.
  505.  
  506. =item Volume( [LEFT, RIGHT] )
  507.  
  508. Gets or sets the volume for the wave output device.
  509. It works the same way as Win32::Sound::Volume.
  510.  
  511. =item Write()
  512.  
  513. Plays the data currently loaded in the soundcard;
  514. playback happens always asynchronously, eg. in 
  515. the background.
  516.  
  517. =back
  518.  
  519. =head2 THE SOUND FORMAT
  520.  
  521. The sound format is stored in three properties of
  522. the C<WaveOut> object: C<samplerate>, C<bits> and
  523. C<channels>.
  524. If you need to change them without creating a 
  525. new object, you should close before and reopen 
  526. afterwards the device.
  527.  
  528.     $WAV->CloseDevice();
  529.     $WAV->{samplerate} = 44100; # 44.1kHz
  530.     $WAV->{bits}       = 8;     # 8 bit
  531.     $WAV->{channels}   = 1;     # mono
  532.     $WAV->OpenDevice();
  533.  
  534. You can also use the properties to query the
  535. sound format currently used.
  536.  
  537. =head2 EXAMPLE
  538.  
  539. This small example produces a 1 second sinusoidal
  540. wave at 440Hz and saves it in F<sinus.wav>:
  541.  
  542.     use Win32::Sound;
  543.     
  544.     # Create the object
  545.     $WAV = new Win32::Sound::WaveOut(44100, 8, 2);
  546.     
  547.     $data = ""; 
  548.     $counter = 0;
  549.     $increment = 440/44100;
  550.     
  551.     # Generate 44100 samples ( = 1 second)
  552.     for $i (1..44100) {
  553.  
  554.         # Calculate the pitch 
  555.         # (range 0..255 for 8 bits)
  556.         $v = sin($counter/2*3.14) * 128 + 128;    
  557.  
  558.         # "pack" it twice for left and right
  559.         $data .= pack("cc", $v, $v);
  560.  
  561.         $counter += $increment;
  562.     }
  563.     
  564.     $WAV->Load($data);       # get it
  565.     $WAV->Write();           # hear it
  566.     1 until $WAV->Status();  # wait for completion
  567.     $WAV->Save("sinus.wav"); # write to disk
  568.     $WAV->Unload();          # drop it
  569.  
  570. =head1 VERSION
  571.  
  572. Win32::Sound version 0.46, 25 Sep 1999.
  573.  
  574. =head1 AUTHOR
  575.  
  576. Aldo Calpini, C<dada@divinf.it>
  577.  
  578. Parts of the code provided and/or suggested by Dave Roth.
  579.  
  580. =cut
  581.  
  582.  
  583.