lib/SDL/Video.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Video.pm
   4 #
   5 # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
   6 #
   7 # ------------------------------------------------------------------------------
   8 #
   9 # This library is free software; you can redistribute it and/or
  10 # modify it under the terms of the GNU Lesser General Public
  11 # License as published by the Free Software Foundation; either
  12 # version 2.1 of the License, or (at your option) any later version.
  13 #
  14 # This library is distributed in the hope that it will be useful,
  15 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17 # Lesser General Public License for more details.
  18 #
  19 # You should have received a copy of the GNU Lesser General Public
  20 # License along with this library; if not, write to the Free Software
  21 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
  22 #
  23 # ------------------------------------------------------------------------------
  24 #
  25 # Please feel free to send questions, suggestions or improvements to:
  26 #
  27 #       David J. Goehrig
  28 #       dgoehrig@cpan.org
  29 #
  30
  31 package SDL::Video;
  32
  33 use strict;
  34 use SDL;
  35 use SDL::Surface;
  36 use SDL::MPEG;
  37
  38 sub new {
  39         my $proto = shift;
  40         my $class = ref($proto) || $proto;
  41         my %options = @_;
  42
  43         verify (%options, qw/ -name -audio / ) if $SDL::DEBUG;
  44
  45         my $n = $options{-name} || die "SDL::Video must supply a filename to SDL::Video::new\n";
  46         my $a = $options{'-audio'} ? 1 : 0;
  47         my $info = new SDL::MPEG();
  48
  49         my $self = \SDL::NewSMPEG($n,$$info,$a);
  50         die SDL::GetError() unless $$self;
  51         bless $self,$class;
  52         $self->audio(1);
  53         $self->video(1);
  54         return $self, $info;
  55 }
  56
  57 sub DESTROY {
  58         SDL::FreeSMPEG(${$_[0]});
  59 }
  60
  61 sub error {
  62         SDL::SMPEGError(${$_[0]});
  63 }
  64
  65 sub audio {
  66         SDL::SMPEGEnableAudio( ${$_[0]}, $_[1]);
  67 }
  68
  69 sub video {
  70         SDL::SMPEGEnableVideo( ${$_[0]}, $_[1]);
  71 }
  72
  73 sub volume {
  74         SDL::SMPEGSetVolume( ${$_[0]}, $_[1] );
  75 }
  76
  77 sub display {
  78         die "SDL::Video::Display requires a SDL::Surface\n" unless $_[1]->isa('SDL::Surface');
  79         SDL::SMPEGSetDisplay( ${$_[0]}, ${$_[1]}, 0);
  80 }
  81
  82 sub scale {
  83         return SDL::SMPEGScaleXY(${$_[0]},$_[1],$_[2]) if (@_ == 3 );
  84         return SDL::SMPEGScaleXY(${$_[0]},$_[1]->width(),$_[1]->height()) if $_[1]->isa('SDL::Surface');
  85         SDL::SMPEGScale(${$_[0]},$_[1]);
  86 }
  87
  88 sub play {
  89         SDL::SMPEGPlay(${$_[0]});
  90 }
  91
  92 sub pause {
  93         SDL::SMPEGPause(${$_[0]});
  94 }
  95
  96 sub stop {
  97         SDL::SMPEGStop(${$_[0]});
  98 }
  99
 100 sub rewind {
 101         SDL::SMPEGRewind(${$_[0]});
 102 }
 103
 104 sub seek {
 105         SDL::SMPEGSeek(${$_[0]},$_[1]);
 106 }
 107
 108 sub skip {
 109         SDL::SMPEGSkip(${$_[0]},$_[1]);
 110 }
 111
 112 sub loop {
 113         SDL::SMPEGLoop(${$_[0]},$_[1]);
 114 }
 115
 116 sub region {
 117         die "SDL::Video::region requires a SDL::Rect\n" unless $_[1]->isa('SDL::Rect');
 118         SDL::SMPEGDisplayRegion(${$_[0]},${$_[1]});
 119 }
 120
 121 sub frame {
 122         SDL::SMPEGRenderFrame(${$_[0]},$_[1]);
 123 }
 124
 125 sub info {
 126         new SDL::MPEG -from => $_[0];
 127 }
 128
 129 sub status {
 130         SDL::SMPEGStatus(${$_[0]});
 131 }
 132
 133 1;
 134
 135 __END__;
 136
 137 =pod
 138
 139
 140 =head1 NAME
 141
 142 SDL::Video - a SDL perl extension
 143
 144 =head1 SYNOPSIS
 145
 146   $video = new SDL::Video ( -name => 'pr0n.mpg' );
 147
 148 =head1 DESCRIPTION
 149
 150 C<SDL::Video> adds support for MPEG video to your
 151 SDL Perl application.  Videos are objects bound to
 152 surfaces, whose playback is controled through the
 153 object's interface.
 154
 155 =head2 METHODS
 156
 157
 158 =over 4
 159
 160 =item *
 161
 162 C<SDL::Video::error()> returns any error messages associated with playback
 163
 164 =item *
 165
 166 C<SDL::Video::audio(bool)> enables or disables audio playback, (on by default)
 167
 168 =item *
 169
 170 C<SDL::Video::video(bool)> enables or disable video playback, (on by default)
 171
 172 =item *
 173
 174 C<SDL::Video::loop(bool)> enables or disable playback looping (off by default)
 175
 176 =item *
 177
 178 C<SDL::Video::volume(int)> set the volume as per the mixer volume
 179
 180 =item *
 181
 182 C<SDL::Video:display(surface)> binds the clip to a display surface
 183
 184 =item *
 185
 186 C<SDL::Video::scale([x,y]|[surface]|int)> scales the clip by either x,y
 187 factors, scales to the image dimensions, or a single scalar.
 188
 189 =item *
 190
 191 C<SDL::Video::play()> plays the video clip, call C<SDL::Video::display()> before playing
 192
 193 =item *
 194
 195 C<SDL::Video::pause()> pauses video playback
 196
 197 =item *
 198
 199 C<SDL::Video::stop()> stops video playback
 200
 201 =item *
 202
 203 C<SDL::Video::rewind()> resets the clip to the beginning
 204
 205 =item *
 206
 207 C<SDL::Video::seek(offset)> seeks to a particular byte offset
 208
 209 =item *
 210
 211 C<SDL::Video::skip(time)> skips to a particular time
 212
 213 =item *
 214
 215 C<SDL::Video::region(rect)> takes a SDL::Rect and defines the display area
 216
 217 =item *
 218
 219 C<SDL::Video::frame(int)> renders a specific frame to the screen
 220
 221 =item *
 222
 223 C<SDL::Video::info()> returns a new C<SDL::MPEG> object reflecting the current status
 224
 225 =item *
 226
 227 C<SDL::Video::status()> returns either SMPEG_PLAYING or SMPEG_STOPPED or SMPEG_ERROR
 228
 229 =back
 230
 231 =head1 AUTHOR
 232
 233 David J. Goehrig
 234
 235 =head1 SEE ALSO
 236
 237 perl(1) SDL::Surface(3) SDL::MPEG(3)
 238
 239 =cut
 240