#!/usr/bin/perl
package Win32::SoundRec;

use strict;
use warnings;
use Win32::API::Prototype;

use vars qw ($VERSION);
$VERSION     = 0.02;

BEGIN
{
   ApiLink( 'winmm.dll', 
             'DWORD mciSendString( LPTSTR lpstrCommand, LPTSTR lpstrReturnString, DWORD uReturnLength, HWND hwndCallBack)' ) 
             || die "Can't register mciSendString";
   ApiLink( 'winmm.dll', 
             'DWORD mciGetErrorString( DWORD dwError, LPTSTR lpstrBuffer, DWORD uLength)' ) 
             || die "Can't register mciGetErrorString";
} 
sub new
{
    my $proto = shift;
    my $char = shift;
    my $self = {};
    my $class = ref($proto) || $proto;
    bless $self, $class;
    $self->{alias} = 'mysound';
    $self->{bitspersample} = 8;
    $self->{samplespersec} = 11025;
    $self->{channels} = 1;
    $self->{filename} = 'test.wav';

    
    return $self;
}

sub record 
{
    my $self = shift;
    my $bitspersample = shift || $self->{bitspersample};
    my $samplespersec = shift || $self->{samplespersec};
    my $channels = shift || $self->{channels};
    
    my $uReturnLength = 1024;
    my $lpstrReturnString = NewString( $uReturnLength );
    my $lpstrBuffer = NewString( $uReturnLength );
        
    my $Result = main::mciSendString( "open new type waveaudio alias ".$self->{alias}, 
                                $lpstrReturnString, 
                                1024, 
                                0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }
    
    
    $Result = main::mciSendString( "set ".$self->{alias}." time format ms bitspersample $bitspersample samplespersec $samplespersec channels $channels", 
                             $lpstrReturnString, 
                             1024, 
                             0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }
    
    
    $Result = main::mciSendString( "record ".$self->{alias}, 
                             $lpstrReturnString, 
                             1024, 
                             0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }

}

sub play 
{
    my $self = shift;

    my $uReturnLength = 1024;
    my $lpstrReturnString = NewString( $uReturnLength );
    my $lpstrBuffer = NewString( $uReturnLength );

    my $Result = main::mciSendString( "play ".$self->{alias}." from 1", 
                                $lpstrReturnString, 
                                1024, 
                                0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }
}


sub stop 
{
    my $self = shift;
    my $uReturnLength = 1024;
    my $lpstrReturnString = NewString( $uReturnLength );
    my $lpstrBuffer = NewString( $uReturnLength );

    my $Result = main::mciSendString( "stop ".$self->{alias}, 
                                $lpstrReturnString, 
                                1024, 
                                0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }
}



sub save 
{
    my $self = shift;
    my $filename = shift || $self->{filename};

    my $uReturnLength = 1024;
    my $lpstrReturnString = NewString( $uReturnLength );
    my $lpstrBuffer = NewString( $uReturnLength );

    my $Result = main::mciSendString( "save ".$self->{alias}." $filename", 
                                $lpstrReturnString, 
                                1024, 
                                0);
    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }

    $Result = main::mciSendString( "close ".$self->{alias}, 
                             $lpstrReturnString, 
                             1024, 
                             0);

    if ( $Result != 0 ) 
    {
       my $eResult = main::mciGetErrorString($Result, $lpstrBuffer, 1024);
       warn CleanString( $lpstrBuffer ) . "\n";
    }
}

=pod

=head1 NAME

Win32::SoundRec - Module for recording sound on Win32 platforms

=head1 SYNOPSIS

    use Win32::SoundRec;
    
    my $r =  Win32::SoundRec->new();
    # start recording...
    $r->record();
    # wait 5 seconds
    sleep(5);
    # Playback the recording buffer
    $r->play();
    sleep(5);
    # stop record or playback
    $r->stop();
    # save the recording
    $r->save('my.wav');

=head1 DESCRIPTION

This module allows recording of sound on Win32 platforms using the MCI interface (which
depends on winmm.dll).

=head1 PREREQUISITES

An MCI compatible soundcard

=head1 USAGE

=head2 new()

The new() method is the constructor. It connects to the mci interface.

=head2 record([$bitspersample, $samplespersec, $channels])

This method starts recording the audio. After calling the record function, you
should sleep() as long as you want to record.
The three parameters are optional. $bitspersample defaults to 8, $samplespersec
defaults to 11025, $channels defaults to 1. 

=head2 play

This method plays back the unsaved recording buffer

=head2 stop

This method stops the playback or record action

=head2 save([$filename])

This methods closes and saves the recording. By default the recording buffer is saved
in 'test.wav'. If you specify a valid $filename, the buffer is saved in that file
    
=head1 SUPPORT

You can email the author for support on this module.

=head1 AUTHOR

	Jouke Visser
	jouke@cpan.org
	http://jouke.pvoice.org

    Based largely on code posted to the perl-win32-users mailinglist by Jeff Slutzky
    
=head1 COPYRIGHT

Copyright (c) 2003-2005 Jouke Visser. All rights reserved.
This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

The full text of the license can be found in the
LICENSE file included with this module.

=head1 SEE ALSO

perl(1).

=cut

"Yet Another True Value";

__END__