POE::Wheel::Audio::Mad - POE Wheel implementing in-session non-blocking mpeg stream playing

  use POE;
  use POE::Wheel::Audio::Mad;

  POE::Session->create(
  	inline_states => {
  		_start  => \&am_start,
  		message => \&am_message
  	}
  );

  sub am_start {
  	my ($kernel, $heap) = @_[KERNEL, HEAP];

	## you may also specify decoder options,  listed below..
  	$heap->{wheel} = new POE::Wheel::Audio::Mad ( message_event => 'message' );

  	$kernel->yield( 'decoder_open', { 
  		filename => '/path/to/some/stream.mp3', 
  		play     => 1 
  	});
  }

  sub am_message {
  	my ($kernel, $message) = @_[KERNEL, ARG0];

  	if ($message->{id} eq 'INPUT_EOF_WARNING') {

  		print "finished..\n";

  		undef $heap->{wheel};

  	} elsif ($message->{id} eq 'DECODER_FRAME_DATA') {

  		if (defined($message->{data}->{played})) {

	  		print "\rplayed: $message->{data}->{played}";

	  	}
  	}
  }

  $poe_kernel->run();
  exit();

  POE::Wheel::Audio::Mad is an attempt to bring a naitive perl mpeg
  decoder into a perl session.  This module was written to work as
  a POE Wheel due to it's nature -- it simply playes mpeg streams --
  you have to do the job of controlling the player and handling 
  updates.  This really isn't your traditional wheel.

  These options may be specified as part of the call to the 
  new() constructor,  and affect decoder behaviour.  

  POE::Wheel::Audio::Mad brings with it a large amount of
  states that get defined in your session.  Most of these
  states are used for controlling the decoder behaviour
  or for querying information,  and they are listed below.
  All of these states take a single hashref as their
  argument,  the keys and expected values (if any) are 
  listed as well.

  This wheel will send messages back to your session via the state
  you specified in the option 'message_event'.  This state will 
  be passed decoder messages,  one at a time,  in hashref format.

  This hashref always has only two keys:  id,  and data.  'id' is
  the identifier for the message.  Every message id used by the
  decoder is listed below.  data is the payload corresponding to
  this type of event.  It could possibly be of any type or value,
  or possibly blank,  but it will always be defined.

package POE::Wheel::Audio::Mad;
require 5.6.0;

use strict;
use warnings;

our $VERSION = '0.3';

## version 0.3 basically means,  I've rewritten this a few times,
## screwed version numbers completely up,  came up with this idea,
## modified it twice,  and just barely documented it.  That means
## there's pod to describe it's usage,  but very little in the
## way of interal comments -- wait for 0.4;  the comment overhaul
## release.

use Carp qw(croak);

use POE;
use POE::Wheel;

use Audio::Mad qw(:all);
use Audio::Mad::Util qw(mad_stream_info mad_parse_xing mad_cbr_seek mad_xing_seek);

use Audio::OSS qw(:funcs :formats :mixer);

## the list of states that we will define in our parent session.
our @STATES = qw(
	decoder_shutdown decoder_close decoder_set decoder_info
	decoder_open decoder_play decoder_pause decoder_stop decoder_seek

	__d_input_open __d_input_read __d_input_close
	__d_output_open __d_output_close
	__d_decoder_reset __d_decoder_cycle
);

##############################################################################

sub new {
	my ($class, %args) = @_;

	croak "$class requires a working POE Kernel" unless (defined($poe_kernel));
	croak "$class requires a message_event paramater" unless (defined($args{message_event}));

	my $self = bless({ 
		message_event => $args{message_event},
		wheel_id      => POE::Wheel::allocate_wheel_id(),
	}, $class);

	$self->{options} = {
		output_close_on_pause  => $args{output_close_on_pause} || 0,
		output_close_on_stop   => $args{output_close_on_stop}  || 1,
		
		decoder_progress_range => $args{decoder_progress_range} || 100,
		decoder_play_on_open   => $args{decoder_play_on_open}   || 0,
	};

	$self->{input} = {
		state    => 'CLOSED',
		
		handle   => undef,
		filename => '',
		stats    => [(0)x13],
		
		buffer   => '',
		info     => {},
	};
	
	$self->{decoder} = {
		state    => 'CLOSED',
		
		stream   => undef,
		frame    => undef,
		synth    => undef,
		resample => undef,
		dither   => undef,

		played   => undef,
		printed  => 0,
		progress => 0,
		frames   => 0,
	};
	
	$self->{output} = {
		state         => 'CLOSED',
		
		handle        => undef,

		device        => $args{output_device}     || '/dev/dsp',
		samplerate    => $args{output_samplerate} || 44100,
		format        => $args{output_format}     || AFMT_S16_LE,
		
		mixer_device  => $args{mixer_device}  || '/dev/mixer',
		mixer_balance => $args{mixer_balance} || 50,
		mixer_volume  => $args{mixer_volume}  || 50,
		mixer_pcm     => $args{mixer_pcm}     || 60
	};
	
	for (@STATES) { 
		croak "$class failed to define state: $_\n" if ($poe_kernel->state( $_ => $self ));
	}
	
	return $self;	
}

sub DESTROY {
	my ($self) = @_;
	
	for (@STATES) { $poe_kernel->state( $_ ) }
	POE::Wheel::free_wheel_id( $self->{wheel_id} );
}

sub decoder_shutdown {
	my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];

	## we ->call() the next few functions to make sure that
	## they finish before we disappear as a session..
	
	$kernel->call($session, '__d_output_close');
	$kernel->call($session, '__d_input_close');
	$kernel->call($session, '__d_decoder_reset');

	## let everyone know that we're dying..
	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_SHUTDOWN_SUCCESS',
		data => ''
	});
	
	$kernel->yield('shutdown');
}

##############################################################################

sub decoder_open {
	my ($self, $kernel, $session, $args) = @_[OBJECT, KERNEL, SESSION, ARG0];
	
	my ($filename, $play) = @{$args}{qw(filename play)};

	## call deeper to accomplish the actual opening
	## and scanning of the stream..
	$kernel->call($session, '__d_input_open', $filename);

	## we couldn't find or open the file,  or we scanned
	## it and didn't get any valid stream information..
	return undef unless (
		$self->{input}->{state} eq 'OPEN'        &&
		$self->{input}->{filename} eq $filename
	);
	
	## reset the decoder..
	$kernel->call($session, '__d_decoder_reset');
	
	## and start playing if that's what we're supposed to do..
	$kernel->yield('decoder_play') if ($play || $self->{options}->{decoder_play_on_open});
}

sub decoder_close { 
	my ($kernel, $session) = @_[KERNEL, SESSION];
	
	## close is rather heavy handed,  it does everything a
	## shudown does without actually disappearing..

	$kernel->call($session, '__d_output_close');
	$kernel->call($session, '__d_input_close');
	$kernel->call($session, '__d_decoder_reset');
}

sub decoder_play {
	my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];
	
	## check to see if we have a file to play,  and generate
	## an event if we don't..
	
	unless ($self->{input}->{state} eq 'OPEN') {
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_PLAY_FAILED',
			data => 'no input file open'
		});
		return undef;
	}
	
	## make sure that the output is open,  or at least try really hard to open it..
	
	$kernel->call($session, '__d_output_open') unless ($self->{output}->{state} eq 'OPEN');
	return undef unless ($self->{output}->{state} eq 'OPEN');

	## update our state to indicate that we are playing,  and generate 
	## an event to tell everyone we are playing..	

	$self->{decoder}->{state} = 'PLAYING';
	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_STATUS_DATA',
		data => { state => 'PLAYING' }
	});
	
	## let decoder_cycle spin off on it's chore..
	
	$kernel->yield('__d_decoder_cycle');
}

sub decoder_pause {
	my ($self, $kernel) = @_[OBJECT, KERNEL];
	
	## check to see that we are currently playing a file
	## and generate an event if we aren't..
	unless ($self->{decoder}->{state} eq 'PLAYING') {
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_PAUSE_FAILED',
			data => 'not playing file'
		});
		return undef;
	}
	
	## close down the output device if we're told to do so..
	
	$kernel->yield('__d_output_close') if ($self->{options}->{output_close_on_pause});

	## indicate we are paused,  and tell everyone about it..	

	$self->{decoder}->{state} = 'PAUSED';
	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_STATUS_DATA',
		data => { state => 'PAUSED' }
	});
}

sub decoder_stop {
	my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];

	## make sure we can stop and generate something if not..
	
	unless (
	    $self->{decoder}->{state} eq 'PLAYING' ||
	    $self->{decoder}->{state} eq 'PAUSED'
	) {
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_STOP_FAILED',
			data => 'not playing file'
		});
		return undef;
	}

	## save and indicate our current status..

	$self->{decoder}->{state} = 'STOPPED';
	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_STATUS_DATA',
		data => { state => 'STOPPED' }
	});

	## here we seek the input file back to the beginning,  and close
	## the output device if that's what we're supposed to do.	

	$kernel->yield('decoder_seek', { position => 0, range => 1 });
	$kernel->yield('__d_output_close') if ($self->{options}->{output_close_on_stop});
}

sub decoder_seek {
	my ($kernel, $self, $session, $args) = @_[KERNEL, OBJECT, SESSION, ARG0];
	my ($position, $range) = @{$args}{qw(position range)};
	my ($input, $decoder) = @{$self}{qw(input decoder)};

	## check that we have an open file,  and generate something if not..

	unless ($input->{state} eq 'OPEN') {
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_SEEK_FAILED',
			data => 'no input file open'
		});	
		return undef;
	}

	## seeking is kind of tricky..  so we use some support 
	## functions that tell us how to seek.  pos is the
	## file position to seek to,  and frame is the frame
	## that will be played next..
	
	my ($pos, $frame);
	if ($input->{info}->{s_vbr} == 0) {
		## cbr seeking is easy,  see the referenced
		## function (below)..
	   	($pos, $frame) = mad_cbr_seek(
	   		position => $position, 
	   		range    => $range, 
	   		frames   => $input->{info}->{s_frames}, 
	   		size     => $input->{info}->{f_size}
	   	);
	} else {
		## vbr seeking isn't soo easy,  and requires us to use
		## an automatically generated toc from the mad_stream_info
		## routine..
		($pos, $frame) = mad_xing_seek(
			position => $position, 
			range    => $range, 
			frames   => $input->{info}->{s_frames}, 
			toc      => $input->{info}->{xing_toc}
		);
	}
	
	## if it's not a valid place to seek,  just forget it..
	
	return undef unless (defined($pos) && $pos > -1);

	## if we're seeking somewhere other than the beginning,  take
	## a copy of the frame duration,  and multiply it by our
	## destination frame -- this keeps DECODER_FRAME_DATA accurate.
	
	if (defined($frame) && $frame > 0) {
		$decoder->{played} = $input->{info}->{s_frame_duration}->new_copy();
		$decoder->{played}->multiply($frame);
	} else {
	
		## otherwise,  it's the beginning and we can just use a
		## zeroed out timer..
	
		$decoder->{played} = new Audio::Mad::Timer;
	}
	
	## force our 'printed' and 'progress' values out of date
	## so that they are updated and events get generated as
	## soon as we return to playing..
	
	$decoder->{printed}  = -1;
	$decoder->{progress} = -1;
	
	## actually perform the seek..
	
	CORE::seek($input->{handle}, $pos, 0);
	
	## clear our stream buffer,  avoids having to drain the 
	## buffer before we seek,  and helps prevent the audio 
	## from skipping and popping..
	
	$input->{buffer}    = '';

	## tell the decoder to bleed off three frames before
	## synthesizing audio data from the stream..  helps
	## prevent audio skips and pops..

	$decoder->{seeking} = 3;
	
	## reset the stream buffer completely..
	
	$decoder->{stream}  = new Audio::Mad::Stream(MAD_OPTION_IGNORECRC);

	## generate an event to let everyone know that the
	## stream position was just moved..
	
	$kernel->yield($self->{message_event}, {
		id   => 'INPUT_SEEK_SUCCESS',
		data => $pos
	});
	
	## and jump into decoder_cycle unless we would already 
	## do that soon..

	$kernel->yield('__d_decoder_cycle') unless ($decoder->{state} eq 'PLAYING');
}

## ugly,  ugly,  ugly..  but,  it was quick.  this is just an outpost for all 
## those abandoned options seen earlier,  there are lots of problems with
## the sub below,  and they'll be fixed as soon as I come up with a good
## options system,  that allows us to be notified when particular options
## get changed on us..

# set option <option> <value>
# set mixer <volume|pcm|balance> <value>
sub decoder_set {
	my ($self, $kernel, $session, $args) = @_[OBJECT, KERNEL, SESSION, ARG0];
	
	my ($type, $key, $value) = @{$args}{qw(type key value)};
	$type = '' unless (defined($type));
	
	if (lc($type) eq 'option') {
		unless (defined($self->{options}->{$key})) {
			$kernel->yield($self->{message_event}, {
				id   => 'IPC_COMMAND_FAILED',
				data => "OPTION unknown key $key"
			});
			return undef;
		} 
		
		## FIXME: gag,  need better option system..
		if ($key eq 'decoder_progress_range') { $self->{decoder}->{progress} = -1 }

		$self->{options}->{$key} = $value;
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_OPTION_DATA',
			data => { lc($key) => $value }
		});
	}
	elsif (lc($type) eq 'mixer') {
		   if ($key eq 'volume')  { $self->{output}->{mixer_volume}  = $value }
		elsif ($key eq 'pcm')     { $self->{output}->{mixer_pcm}     = $value }
		elsif ($key eq 'balance') { $self->{output}->{mixer_balance} = $value }
		else {
			$kernel->yield($self->{message_event}, {
				id   => 'IPC_COMMAND_FAILED',
				data => "MIXER unknown key $key"
			});
		}

		_mixer_update($self->{output});
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_MIXER_DATA',
			data => { 
				balance => $self->{output}->{mixer_balance},
				volume  => $self->{output}->{mixer_volume},
				pcm     => $self->{output}->{mixer_pcm}
			}
		});
	} else {
		$kernel->yield($self->{message_event}, {
			id   => 'IPC_COMMAND_FAILED',
			data => "SET unknown type $type"
		});
	}
}

sub decoder_info {
	my ($self, $kernel, $args) = @_[OBJECT, KERNEL, ARG0];
	my $type = $args->{type};

	## this is a simple routine,  designed to coherce the decoding
	## engine into immediately giving up some information about one
	## of it's subsystems..  pretty simple stuff here.  

	if (lc($type) eq 'decoder') {
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_OPTION_DATA',
			data => $self->{options}
		});
		
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_STATUS_DATA',
			data => { state => $self->{decoder}->{state} }
		});
		
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_FRAME_DATA',
			data => { 
				played   => $self->{decoder}->{printed},
				progress => $self->{decoder}->{progress}
			}
		});
	} elsif (lc($type) eq 'input') {
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_STATUS_DATA',
			data => { state => $self->{input}->{state} }
		});
		
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_INFO_DATA',
			data => $self->{input}->{info}
		}) if ($self->{input}->{state} eq 'OPEN');
	} elsif (lc($type) eq 'dsp') {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_MIXER_DATA',
			data => { 
				balance => $self->{output}->{mixer_balance},
				volume  => $self->{output}->{mixer_volume},
				pcm     => $self->{output}->{mixer_pcm}
			}
		});
		
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_STATUS_DATA',
			data => { state => $self->{output}->{state} }
		});
	} else {
		$kernel->yield($self->{message_event}, {
			id   => 'IPC_COMMAND_FAILED',
			data => "INFO unknown type $type"
		});	
	}
}

##############################################################################

## okay,  here's the gritty subsystem kind of stuff.  this is where all the 
## work actually happens -- and most of the logic is.  stay close,  it's
## dark down here...

sub __d_input_open {
	my ($kernel, $self, $session, $filename) = @_[KERNEL, OBJECT, SESSION, ARG0];

	## alias a hashref because we are lazy..

	my $input = $self->{input};
	
	## attempt to acquire a filehandle for our specified
	## file,  if not,  generate an event and quit..

	my ($handle);
	CORE::open($handle, '<'.$filename) || do {
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_OPEN_FAILED',
			data => "$filename: $!",
		});
		return undef;
	};
	
	## no we try to get some information on the stream,  and
	## tell mad_stream_info to generate a toc so we can seek.
	## if we fail,  tell everyone about it,  and close the
	## stream..
	
	my $info;
	unless (defined($info = mad_stream_info($handle, 1))) {
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_OPEN_FAILED',
			data => "$filename: unable to find mpeg stream"
		});
		CORE::close($handle);
		return undef;
	};
	
	## we close down the old input handle unless it already is..
	
	$kernel->call($session, '__d_input_close') unless ($input->{state} eq 'CLOSED');
	
	## after mad_stream_info runs the file position needs to be
	## moved back to the beginning..
	
	CORE::seek($handle, 0, 0);
	
	## now we can track all the extra little information about our 
	## new stream..
	
	$input->{handle} = $handle;

	$input->{filename} = $filename;
	$input->{stats}    = [stat($input->{handle})];
	$input->{info}     = $info;

	## mark that the input system is open,  and send events to
	## everyone so they know about it too..

	$input->{state}    = 'OPEN';

	$kernel->yield($self->{message_event}, {
		id   => 'INPUT_STATUS_DATA',
		data => { 
			state    => 'OPEN',
			filename => $filename
		}
	});

	## we make a copy of our stream information,  drop out
	## the table of contents (can be very large)..

	my %info = %{$input->{info}};
	delete $info{xing_toc};
	
	## and send it out to interested customers..
	
	$kernel->yield($self->{message_event}, {
		id   => 'INPUT_INFO_DATA',
		data => \%info
	});
}

sub __d_input_read {
	my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];

	## alias a hashref (lazy) and requisition a temp variable..
	
	my ($input, $temp) = ($self->{input}, '');

	## keep track of everything from the end of the last fully
	## available frame to the end of the buffer..

	$temp = substr($input->{buffer}, $self->{decoder}->{stream}->next_frame())
		if ($input->{buffer} ne '');

	## attempt to read from our input handle..
	
	if (sysread($input->{handle}, $input->{buffer}, 256000) == 0) {
	
		## the read returned 0,  so we are at end of
		## file,  generate an event to tell everyone,
		## and take appropriate action..
	
		$kernel->yield($self->{message_event}, {
			id   => 'INPUT_EOF_WARNING',
			data => $input->{filename}
		});
		
		$kernel->yield('__d_input_close');
		$kernel->yield('__d_decoder_reset');
	} else {
	
		## otherwise,  we still have more stream to go.
		## reform the buffer with the end fragment from the
		## old buffer,  and the newly read data..
	
		$input->{buffer} = $temp . $input->{buffer};
		
		## tell the stream object about our new buffer..
		
		$self->{decoder}->{stream}->buffer($input->{buffer});
		
		## and go back to work..
		
		$kernel->yield('__d_decoder_cycle');
	}
}

sub __d_input_close {
	my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION];

	## shortcut a few variables..

	my $input = $self->{input};
	my $filename = $input->{filename};

	## leave unless there's something we could do..
	
	return undef unless ($input->{state} eq 'OPEN');

	## if we have a handle,  try to close it,  and warn users
	## if we can't..
	
	if (defined($input->{handle})) {
		CORE::close($input->{handle}) || $kernel->yield($self->{message_event}, {
			id   => 'INPUT_CLOSE_WARNING',
			data => 'failed to close file handle'
		});
	}
	
	## reset our internal state data..
	
	$input->{handle}   = undef;
	$input->{filename} = '';
	$input->{stats}    = [(0)x13];
	
	$input->{buffer}   = '';
	$input->{info}     = {};
	
	$input->{state}    = 'CLOSED';
	
	## and tell everyone about the new state..
	
	$kernel->yield($self->{message_event}, {
		id   => 'INPUT_CLOSE_SUCCESS',
		data => $filename
	});
	
	$kernel->yield($self->{message_event}, {
		id   => 'INPUT_STATUS_DATA',
		data => { state => 'CLOSED' }
	});
}

sub __d_decoder_reset {
	my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];
	my ($input, $output, $decoder) = @{$self}{qw(input output decoder)};

	## first step:  stop the decoder,  and let everyone know
	## that's what just happened..

	$decoder->{state} = 'STOPPED';
	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_STATUS_DATA',
		data => { state => 'STOPPED' }
	});

	## unless we have a file already open,  there's not much
	## more to a reset..
	
	return undef unless ($input->{state} eq 'OPEN');
	
	## otherwise,  we have all kinds of neat stuff to setup..
	## fix: mad_dither_s16_le is an assumption,  and a
	## non-portable one at that..  
	
	$decoder->{stream}   = new Audio::Mad::Stream(MAD_OPTION_IGNORECRC);
	$decoder->{frame}    = new Audio::Mad::Frame;
	$decoder->{synth}    = new Audio::Mad::Synth;
	$decoder->{dither}   = new Audio::Mad::Dither(MAD_DITHER_S16_LE);

	$decoder->{played}   = new Audio::Mad::Timer;
	$decoder->{printed}  = 0;
	$decoder->{progress} = 0;
	$decoder->{seeking}  = 0;
	
	## update everyones idea of our progress on this stream..

	$kernel->yield($self->{message_event}, {
		id   => 'DECODER_FRAME_DATA',
		data => { played => 0, progress => 0 }
	});

	$decoder->{frames}   = 0;
	
	## setup output if available..
	if ($output->{state} eq 'OPEN') {
	
		## reset the dsp device..
	
		dsp_reset($output->{handle});
		
		## turn stereo on or off depending on the 
		## number of channels in our input stream..
		
		if ($input->{info}->{s_mode} == 0) {
			set_stereo($output->{handle}, 0);
		} else {
			set_stereo($output->{handle}, 1);
		}
		
		## here we try to match the stream sampling rate to 
		## the dsp sampling rate..  
		
		if ($output->{samplerate} == $input->{info}->{s_samplerate}) {

			## resampling rates equal,  we need to do nothing..
			$decoder->{resample} = undef;

		} elsif (set_sps($output->{handle}, $input->{info}->{s_samplerate}) != $input->{info}->{s_samplerate}) {

			## couldn't set the soundcard rate,  so we need to
			## create ourselvs a Resample object..
			$decoder->{resample} = new Audio::Mad::Resample($input->{info}->{s_samplerate}, $output->{samplerate});

		} else {

			## succeded updating soundcard rate

			$output->{samplerate}  =
			$decoder->{samplerate} = $input->{info}->{s_samplerate};
			
			$decoder->{resample}   = undef;
		}
	} else {
		## the output device is not yet open,  so the least we can
		## do is to see if our sampling rates our equal,  and if not,
		## just create a resample object and use the default dsp
		## sampling rate..

		$decoder->{resample} = (
			$input->{info}->{s_samplerate} != $output->{samplerate}
			? new Audio::Mad::Resample($input->{info}->{s_samplerate}, $output->{samplerate})
			: undef
		);
	}
}

## here's where all the magic happens..  when I was first writing this
## module I spent a lot of time trying to figure out an efficient
## algorithm for calling this part of the state machine.  My thinking
## was that if I call this state once for each frame in a stream,  and
## this state makes a bunch of function calls (especially through XS 
## into Audio::Mad) that I would end up with HUGE overheads.  I tried
## everything I could to keep calls in here minimal,  including
## processing 3 or 5 frames per cycle,  instead of one.

## truth is,  I was wrong.  premature optimization,  I guess.  Every
## attempt I made at thinning calls to this state down,  I still
## ended up with huge amounts of CPU time being eaten.  So I gave in
## and went for the simplest solution:  just try to do one frame
## per cycle,  and see what happens.  Amazingly enough,  my CPU
## times settled right down,  the playback was smooth,  and I
## was only seeing about a 2%-5% CPU time gain over mpg321.

## my thinking goes along these lines..  my computer can easily
## decode more stream per second than my soundcard can play per
## second..  so the solution was to let blocking slow me down..
## We use a blocking write to the dsp below.  If the DSP is 
## empty,  we'll spin real fast here a few times and quickly
## fill up the buffer -- at that point,  we block for just a
## few milliseconds every frame,  enough to slow us down,  but
## not too much that it destroys interactivity.  CPU times 
## stay in check,  and we still have time left in the same
## process to accomplish other tasks..

## I have written a curses based GUI on top of this module,  and
## it runs smoothly and without unexpected delays.  Even holding
## down a key to scroll the song list,  I do not get skips or
## pops in my playback -- but the CPU utilization gets as high
## as 70%.  So,  the method may not be perfect,  but it's enough
## to make this a capable in-process mpeg decoder.

sub __d_decoder_cycle {
	my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];
	
	## shortcut..  lazy..  stuff..
	my $decoder = $self->{decoder};
	
	## start of our frame decoding bonanza..
	FRAME: {
		
		## we only engage in this loop for two reasons,  one:  we wish
		## to play sound from the stream,  or two:  we wish to seek to
		## a specific point in the stream..
		return undef unless ($decoder->{state} eq 'PLAYING' || $decoder->{seeking});
	
		## call mad_frame_decode(stream)..
		if ($decoder->{frame}->decode($decoder->{stream}) == -1) {
		
			## immediately goto next frame if we got an
			## error that was recoverable..
			
			redo FRAME if ($decoder->{stream}->err_ok());
			
			## shortcut the errorcode..
			
			my $error = $decoder->{stream}->error();

			## if we got an error because the buffer has
			## run try (BUFLEN) or the buffer hasn't been
			## set yet (BUFPTR)...			

			if ($error == MAD_ERROR_BUFLEN || $error == MAD_ERROR_BUFPTR) {
			
				## then call the input subsystem to
				## read some data from our stream..
			
				$kernel->yield('__d_input_read');
				
				## input_read will yield back to us to
				## resume playing if necessary..
				
				return undef;
			} else {
				
				## otherwise,  we had a strange fatal error,
				## do our best to say something about it..
			
				$kernel->yield($self->{message_event}, {
					id   => 'DECODER_FRAME_ERROR',
					data => "unkown error: $error"
				});
				
				## try to continue processing on the frame,
				## fix:  eventually we should keep an error
				## counter and error out after x consecutive
				## errors..
				
				redo FRAME;
			}
		}
		
		## keep track of some data,  increment the frame
		## count,  and our timer.
		
		$decoder->{frames}++;
		$decoder->{played}->add($decoder->{frame}->duration());

		## data is defined in case we have any new DECODER_FRAME_DATA
		## we need to report,  plus snatch the current time in miliseconds.

		my ($data, $ms) = ({}, $decoder->{played}->count(MAD_UNITS_MILLISECONDS));
		
		## if we haven't printed an update in the last half a second,  or if
		## we haven't printed anything at all yet..
		
		if ($ms - 500 > $decoder->{printed} || $decoder->{printed} == -1) {
		
			## then make a mark in our temporary data packet
			## about the current playtime in seconds.  as well 
			## as track the fact that we printed something
			## on this millisecond..
		
			$data->{played}     =
			int(($decoder->{printed} = $ms) / 1000);
		}
		
		## if we've played at least one second of the file -and-
		## the current progress number is greater than the old
		## one,  or we haven't printed progress yet..
		
		if (
		    $self->{input}->{info}->{s_seconds} && 
		    int(
		        (
		            $self->{options}->{decoder_progress_range} / 
		            ($self->{input}->{info}->{s_seconds} * 1000)
		        ) 
		        * $ms
		    ) 
		    > $decoder->{progress} || $decoder->{progress} == -1
		) {
		
			## then set the progress in both the data packet
			## and our internal state..
			
			## to get the progress number (releative to the
			## decoder_progress_range option):  divide the
			## progress_range by the number of milliseconds 
			## in the file,  then multiply the result by the
			## number of milliseconds currently played.
		
			$data->{progress}    = 
			$decoder->{progress} = int(
			    (
			        $self->{options}->{decoder_progress_range} / 
			        ($self->{input}->{info}->{s_seconds} * 1000)
			    ) * $ms
			);
		}
		
		## if any updated data was stashed in our temporary container,
		## make sure we generate an event and send that data out..
		
		$kernel->yield($self->{message_event}, {
			id   => 'DECODER_FRAME_DATA',
			data => $data
		}) if (scalar(keys(%{$data})) > 0);
		
		## equivalant to:  mad_synth_frame(frame);
		
		$decoder->{synth}->synth($decoder->{frame});
		
		## then we gather up the pcm audio for this
		## frame..  this requires us to run the samples
		## through Audio::Mad::Dither..  and potentially
		## Audio::Mad::Resample -- that's all automatically
		## handled right here..

		my $pcm = $decoder->{dither}->dither(
			defined($decoder->{resample}) 
			? $decoder->{resample}->resample($decoder->{synth}->samples())
			: $decoder->{synth}->samples()
		);
		
		## immediately do another frame if we currently in the
		## process of seeking.  once the seek counter hits
		## zero,  we will resume normal mode of operation..
		
		redo FRAME if ($decoder->{seeking} && $decoder->{seeking}--);

		## we did it!  write that pcm data out to the
		## dsp..

		syswrite($self->{output}->{handle}, $pcm);
	}
	
	## make sure we get called again..
	
	$kernel->yield('__d_decoder_cycle');
}

sub __d_output_open {
	my ($self, $kernel, $session, $cycle) = @_[OBJECT, KERNEL, SESSION, ARG0];
	my $output = $self->{output};

	## skip it if we are already open..
		
	return undef if ($output->{state} eq 'OPEN');
	
	my ($handle, $mixer);
	
	## try to open up the dsp device itself..
	
	CORE::open($handle, ">$output->{device}") || do {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_OPEN_FAILED',
			data => "failed to open $output->{device}: $!"
		});
		return undef;
	};
	
	## try to get a mixer device..  I think we can a bit more
	## gracefully if this dosen't work..
	
	CORE::open($mixer, "+<$output->{mixer_device}") || do {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_OPEN_FAILED',
			data => "failed to open $output->{mixer_device}: $!"
		});
	};
	
	## do the things necessary to setup a modern dsp
	## device..  generate events if anything dosen't
	## work as expected..
	
	dsp_reset($handle) || do {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_OPEN_FAILED',
			data => "failed to reset $output->{device}: $!"
		});
		return undef;
	};
	
	## fix:  we're still making x86 linux centric decisions here..  
	## this needs to be better configured.  perhaps just adding
	## in an output_? option to PCAM would do..
	
	set_fmt($handle, AFMT_S16_LE) || do {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_OPEN_FAILED',
			data => "failed to set format on $output->{device}: $!"
		});
		return undef;
	};
	
	## set the sample rate or whine about it..
	
	set_sps($handle, $output->{samplerate}) == $output->{samplerate} || do {
		$kernel->yield($self->{message_event}, {
			id   => 'DSP_OPEN_FAILED',
			data => "failed to set samplerate on $output->{device}: failed"
		});
		return undef;
	};
	
	## figure out if we want stereo or not..

	if ($self->{input}->{state} eq 'OPEN' && $self->{input}->{info}->{s_mode} == 0) {
		set_stereo($handle, 0);
	} else {
		set_stereo($handle, 1);
	}

	## update some internal information..
	
	$output->{handle} = $handle;	
	$output->{state}  = 'OPEN';

	$output->{mixer}         = $mixer;
	$output->{mixer_volume}  = mixer_read($mixer, SOUND_MIXER_VOLUME) & 0x000000ff;
	_mixer_update($output);
	
	## sing to the world about what we have done..
	
	$kernel->yield($self->{message_event}, {
		id   => 'DSP_OPEN_SUCCESS',
		data => $output->{device}
	});
	
	$kernel->yield($self->{message_event}, {
		id   => 'DSP_STATUS_DATA',
		data => { state => 'OPEN' }
	});
	
	$kernel->yield($self->{message_event}, {
		id   => 'DSP_MIXER_DATA',
		data => { 
			balance => $output->{mixer_balance},
			volume  => $output->{mixer_volume},
			pcm     => $output->{mixer_pcm}
		}
	});
}

sub __d_output_close {
	my ($self, $kernel, $session) = @_[OBJECT, KERNEL, SESSION];
	my $output = $self->{output};

	## exit out if we have no reason to be here..
	
	return undef unless ($output->{state} eq 'OPEN');
	
	## attempt to close our dsp device,  or issue a 
	## warning telling people.  (shouldn't /dev/mixer)
	## be closed too?
	
	CORE::close($output->{handle}) || $kernel->yield($self->{message_event}, {
		id   => 'DSP_CLOSE_WARNING',
		data => "failed to close $output->{device}"
	});
	
	## update state..

	$output->{handle} = undef;
	$output->{state}  = 'CLOSED';
	
	## tell everyone..
	
	$kernel->yield($self->{message_event}, {
		id   => 'DSP_CLOSE_SUCCESS',
		data => $output->{device},
	});
	
	$kernel->yield($self->{message_event}, {
		id   => 'DSP_STATUS_DATA',
		data => { state => 'CLOSED' }
	});
}

##############################################################################

## cheap,  cheap utility method to prevent code duplication.. 
## and handle a little maths for us.

sub _mixer_update {
	my ($o) = @_;

	## exit out unless we have reason to work..
	return undef unless ($o->{state} eq 'OPEN');

	## there is no balance,  only left and right
	## volumes..  
	my ($vl, $vr) = ($o->{mixer_volume})x2;
	my ($pl, $pr) = ($o->{mixer_pcm})x2;
	
	## a little algorithm to smoothly scale the volumes
	## off as we adjust the balance.  the ear percives
	## volume changes logarithmically,  so that's why
	## we do this here..  not that I understand that,
	## I just read a perldoc and a webpage about the Nth
	## log of a number..  let me know if this is stupid,
	## but it works for me..
	my $b = 50 - $o->{mixer_balance};
	   if ($b < 0) { $vl = int($vl * (log(50 + $b + 1)/log(50))) }
	elsif ($b > 0) { $vr = int($vr * (log(50 - $b + 1)/log(50))) }	   
	
	## actually pump out our new volumes to the
	## mixer device..
	mixer_write($o->{mixer}, SOUND_MIXER_PCM,    $vl, $vr);
	mixer_write($o->{mixer}, SOUND_MIXER_VOLUME, $pl, $pr);	
}
	
##############################################################################
1;
__END__