#!/usr/bin/env perl # # Video.pm # # Copyright (C) 2005 David J. Goehrig # # ------------------------------------------------------------------------------ # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # ------------------------------------------------------------------------------ # # Please feel free to send questions, suggestions or improvements to: # # David J. Goehrig # dgoehrig@cpan.org # package SDL::Video; use strict; use warnings; use Carp; use SDL; use SDL::Surface; use SDL::MPEG; sub new { my $proto = shift; my $class = ref($proto) || $proto; my %options = @_; verify (%options, qw/ -name -audio / ) if $SDL::DEBUG; my $n = $options{-name} || die "SDL::Video must supply a filename to SDL::Video::new\n"; my $a = $options{'-audio'} ? 1 : 0; my $info = new SDL::MPEG(); my $self = \SDL::NewSMPEG($n,$$info,$a); croak SDL::GetError() unless $$self; bless $self,$class; $self->audio(1); $self->video(1); return $self, $info; } sub DESTROY { SDL::FreeSMPEG(${$_[0]}); } sub error { SDL::SMPEGError(${$_[0]}); } sub audio { SDL::SMPEGEnableAudio( ${$_[0]}, $_[1]); } sub video { SDL::SMPEGEnableVideo( ${$_[0]}, $_[1]); } sub volume { SDL::SMPEGSetVolume( ${$_[0]}, $_[1] ); } sub display { croak "SDL::Video::Display requires a SDL::Surface\n" unless $_[1]->isa('SDL::Surface'); SDL::SMPEGSetDisplay( ${$_[0]}, ${$_[1]}, 0); } sub scale { return SDL::SMPEGScaleXY(${$_[0]},$_[1],$_[2]) if (@_ == 3 ); return SDL::SMPEGScaleXY(${$_[0]},$_[1]->width(),$_[1]->height()) if $_[1]->isa('SDL::Surface'); SDL::SMPEGScale(${$_[0]},$_[1]); } sub play { SDL::SMPEGPlay(${$_[0]}); } sub pause { SDL::SMPEGPause(${$_[0]}); } sub stop { SDL::SMPEGStop(${$_[0]}); } sub rewind { SDL::SMPEGRewind(${$_[0]}); } sub seek { SDL::SMPEGSeek(${$_[0]},$_[1]); } sub skip { SDL::SMPEGSkip(${$_[0]},$_[1]); } sub loop { SDL::SMPEGLoop(${$_[0]},$_[1]); } sub region { croak "SDL::Video::region requires a SDL::Rect\n" unless $_[1]->isa('SDL::Rect'); SDL::SMPEGDisplayRegion(${$_[0]},${$_[1]}); } sub frame { SDL::SMPEGRenderFrame(${$_[0]},$_[1]); } sub info { new SDL::MPEG -from => $_[0]; } sub status { SDL::SMPEGStatus(${$_[0]}); } 1; __END__; =pod =head1 NAME SDL::Video - a SDL perl extension =head1 SYNOPSIS $video = new SDL::Video ( -name => 'pr0n.mpg' ); =head1 DESCRIPTION C adds support for MPEG video to your SDL Perl application. Videos are objects bound to surfaces, whose playback is controled through the object's interface. =head2 METHODS =over 4 =item * C returns any error messages associated with playback =item * C enables or disables audio playback, (on by default) =item * C enables or disable video playback, (on by default) =item * C enables or disable playback looping (off by default) =item * C set the volume as per the mixer volume =item * C binds the clip to a display surface =item * C scales the clip by either x,y factors, scales to the image dimensions, or a single scalar. =item * C plays the video clip, call C before playing =item * C pauses video playback =item * C stops video playback =item * C resets the clip to the beginning =item * C seeks to a particular byte offset =item * C skips to a particular time =item * C takes a SDL::Rect and defines the display area =item * C renders a specific frame to the screen =item * C returns a new C object reflecting the current status =item * C returns either SMPEG_PLAYING or SMPEG_STOPPED or SMPEG_ERROR =back =head1 AUTHOR David J. Goehrig =head1 SEE ALSO perl(1) SDL::Surface(3) SDL::MPEG(3) =cut