SDL::Video - a SDL perl extension


SDL_Perl documentation Contained in the SDL_Perl distribution.

Index


Code Index:

NAME

Top

SDL::Video - a SDL perl extension

SYNOPSIS

Top

  $video = new SDL::Video ( -name => 'pr0n.mpg' );

DESCRIPTION

Top

SDL::Video 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.

METHODS

AUTHOR

Top

David J. Goehrig

SEE ALSO

Top

perl(1) SDL::Surface(3) SDL::MPEG(3)


SDL_Perl documentation Contained in the SDL_Perl distribution.

#!/usr/bin/env perl
#
# Video.pm
#
# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
#
# ------------------------------------------------------------------------------
#
# 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__;