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