Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'SDLx_sound'

  • Loading branch information...
commit c25576f5559e45266c5d09af2bab3fbc48d87382 2 parents c0f86ef + f2dab7b
@kthakore kthakore authored
View
1  CHANGELOG
@@ -14,6 +14,7 @@ Revision history for Perl extension SDL_perl.
- Added drawing for circles in SDLx::Surface [kthakore]
- Fixed test issues [FROGGS]
- Added Layer and Layer Managers [FROGGS]
+ - Added SDLx::Sound [rflipo]
* 2.511 06 August 2010
- Added fixes for image and gfx uses in Surface [kthakore, garu]
View
5 README
@@ -23,6 +23,9 @@ The SDL Perl 2009 Development Team
Nick: nferraz
Name: Nelson Ferraz
+
+ Nick: monsenhor
+ Name: Ricardo Filipo
Maintainance
Nick: kthakore
@@ -47,4 +50,4 @@ MacOSX Experimental Usage
Use the SDLPerl executable made in the bundle and call your scripts
- %SDLPerl.app/Contents/MacOS/SDLPerl yourScript.pl
+ %SDLPerl.app/Contents/MacOS/SDLPerl yourScript.pl
View
62 examples/SDLx/SDLx_Sound.pl
@@ -0,0 +1,62 @@
+#!/usr/bin/perl
+#==========================================================================
+#
+# FILE: SDLx_Sound.pl
+#
+# USAGE: ./examples/SDLx_Sound.pl
+#
+#
+# DESCRIPTION: Sound tests
+# A SDLx::Sound can play, pause, resume and stop
+#
+# OPTIONS: ---
+# REQUIREMENTS: ---
+# BUGS: ---
+# NOTES: ---
+# AUTHOR: Ricardo Filipo (rf), ricardo.filipo@gmail.com
+# COMPANY: Mito-Lógica design e soluções de comunicação ltda
+# VERSION: 1.0
+# CREATED: 16-08-2010 21:47:33
+# REVISION: ---
+#==========================================================================
+
+use strict;
+use warnings;
+
+use lib 'lib';
+use SDL;
+use SDLx::Sound;
+use SDLx::App;
+use SDL::Event;
+use SDL::Events;
+
+my $app = SDLx::App->new(
+ height => 120,
+ width => 480,
+ depth => 16,
+ title => 'Sound example',
+);
+my $snd = SDLx::Sound->new();
+
+# load and play a sound
+my $play = $snd->play('test/data/sample.wav');
+
+# pause or resume on keydown
+my %actions = (
+ SDL_QUIT() => sub { exit(0); },
+ SDL_KEYDOWN() =>
+ sub {
+ print "Ai\n";
+ if($play){
+ $snd->pause;
+ $play=0;
+ }else{
+ $snd->resume;
+ $play=1;
+ }
+ },
+);
+
+$app->loop( \%actions );
+
+
View
102 lib/SDLx/Sound.pm
@@ -0,0 +1,102 @@
+package SDLx::Sound;
+
+use Carp;
+
+use SDL;
+#use SDL::Audio;
+#use SDL::AudioSpec;
+use SDL::Mixer;
+use SDL::Mixer::Music;
+#use SDL::Mixer::Channels;
+#use SDL::Mixer::Samples;
+#use SDL::Mixer::MixChunk;
+
+# SDL::Mixer must be inited only one time
+my $audioInited = undef;
+
+sub new {
+ my $class = shift;
+ my $self = {@_};
+ bless ($self, $class);
+ _initAudio() unless $audio_ok;
+ $self->{supported} = _initMixer();
+ return $self;
+}
+
+sub _initAudio {
+ SDL::Mixer::open_audio( 44100, AUDIO_S16SYS, 2, 4096 );
+ my ($status, $freq, $format, $channels) = @{ SDL::Mixer::query_spec() };
+ $audioInited = 1 if $status == 1;
+ return ($status, $freq, $format, $channels); #TODO: Save this information in $self;
+}
+
+sub _initMixer {
+ my $init_flags = SDL::Mixer::init( MIX_INIT_MP3 | MIX_INIT_MOD | MIX_INIT_FLAC | MIX_INIT_OGG );
+
+ my %init = ();
+
+ $init{ mp3 } = 1 if $init_flags & MIX_INIT_MP3;
+ $init{ mod } = 1 if $init_flags & MIX_INIT_MOD;
+ $init{ flac } = 1 if $init_flags & MIX_INIT_FLAC;
+ $init{ ogg } = 1 if $init_flags & MIX_INIT_OGG;
+
+ return \%$init
+}
+
+sub load {
+ my $self = shift;
+ $self->{files} = {@_};
+}
+
+sub unload {
+ my $self = shift;
+ $self->{files} = {};
+}
+
+sub play {
+ my $self = shift;
+ $self->{files} = {@_} if @_;
+ my $play = 1;
+ if (-e $_[0]) {
+ my $music = SDL::Mixer::Music::load_MUS($_[0])
+ or Carp::croak 'Sound file not found: ' . SDL::get_error();
+ SDL::Mixer::Music::volume_music(85);
+ if (SDL::Mixer::Music::play_music($music, -1)<0) {
+ print("Can't play!\n". SDL::get_error()."\n");
+ $play = 0;
+ }
+ } else {
+ carp("No newline ".$self->{files}."\n".$_[0]."\n");
+ $play = 0;
+ }
+ return $play;
+}
+
+sub loud {
+}
+
+sub pause {
+ my $self = shift;
+ SDL::Mixer::Music::pause_music();
+
+}
+
+sub resume {
+ my $self = shift;
+ SDL::Mixer::Music::resume_music();
+
+}
+
+
+sub stop {
+ my $self = shift;
+ SDL::Mixer::Music::halt_music();
+ #SDL::Mixer::quit();
+}
+
+sub fade {
+}
+
+
+
+1; # End of SDLx::Sound
View
125 lib/pods/SDLx/Sound.pod
@@ -0,0 +1,125 @@
+
+=head1 NAME
+
+SDLx::Sound
+
+=head1 CATEGORY
+
+Extension
+
+=head1 SYNOPSIS
+
+ use SDLx::Sound;
+
+ my $snd = SDLx::Sound->new();
+
+ # loads and plays a single sound now
+ $snd->play('myfile.wav');
+
+ # load a single file
+ $snd->load('theSound.aif');
+
+ # plays it or all loaded files
+ $snd->play();
+
+ # more sounds
+ my %files = (
+ chanell_01 => "/my_sound1.wav",
+ chanell_02 => "/my_sound2.ogg"
+ );
+
+ # times sounds bangs
+ my %times = (
+ chanell_01 => 0, # start
+ chanell_01 => 1256, # miliseconds
+ chanell_02 => 2345
+ );
+
+ # Load files in channels for realtime play
+ $snd->load(%files);
+
+ # sets sound channel_01 loudness
+ $snd->loud('channel_01', 80); # loud at 80%
+ $snd->play(%times); # play loaded files at times
+ $snd->play; # play again
+
+ # plays sound channel_01 at 578 miliseconds from now
+ $snd->play('channel_01', 578);
+
+ # fades sound
+ $snd->fade('channel_02', 2345, 3456, -20);
+
+ # in a single act do the wole Sound
+ my $snd = SDLx::Sound->new(
+ files => (
+ chanell_01 => "/my_sound1.wav",
+ chanell_02 => "/my_sound2.ogg"
+
+ ),
+ loud => (
+ channel_01 => 80,
+ channel_02 => 75
+ ),
+ times => (
+ chanell_01 => 0, # start
+ chanell_01 => 1256, # miliseconds
+ chanell_02 => 2345
+ ),
+ fade => (
+ chanell_02 => [2345, 3456, -20]
+ )
+ )->play();
+
+=head1 DESCRIPTION
+
+
+You can think about the SDLx::Sound at 2 aproaches.
+
+=over 4
+
+=item * A simple sound or
+
+=item * The sound of your game or app.
+
+=back
+
+Your application will say what the best aproach.
+
+In a taste that resembles to perl and to SDL, our SDLx:Sound hooks at SDL::Audio and SDL::Mixer with a gracefull and simple interface that can offer to monks a modern perlish way to manage sounds.
+
+An SDLx::Sound object can load sounds from filesystem, play it, adjust this loudness level or stops the sound.
+
+Each sound will play in the next available channel, so it can be handled isolately.
+
+=head1 METHODS
+
+=head2 new
+
+Returns a new instance of SDLx::Sound
+
+=head2 load
+
+
+=head2 play
+
+ $sdlx_sound->play('file.wav');
+
+Play a file
+
+=head2 pause
+
+=head2 resume
+
+=head2 stop
+
+
+=head1 AUTHORS
+
+See L<SDL/AUTHORS>.
+
+=head1 COPYRIGHT & LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+
View
122 status
@@ -0,0 +1,122 @@
+[Alien::SDL] Build option used:
+ Source code build: SDL-1.2.14 & co. (RECOMMENDED)
+ builds: SDL, SDL_(image|mixer|ttf|net|gfx|Pango)
+ needs preinstalled: (freetype2|pango)-devel
+Building SDL
+RGBA on surface is 0xffffffffffffffff at t/sdlx_surface.t line 126.
+Color we put in is 0xffffffff at t/sdlx_surface.t line 127.
+
+# Failed test 'draw_rect uses correct red for 0xffffffff'
+# at t/sdlx_surface.t line 128.
+# got: '0xffffffffffffffff'
+# expected: '0xffffffff'
+RGBA on surface is 0xffffffffffff00ff at t/sdlx_surface.t line 126.
+Color we put in is 0xffff00ff at t/sdlx_surface.t line 127.
+
+# Failed test 'draw_rect uses correct red for 0xffff00ff'
+# at t/sdlx_surface.t line 128.
+# got: '0xffffffffffff00ff'
+# expected: '0xffff00ff'
+RGBA on surface is 0xffffffffff00ffff at t/sdlx_surface.t line 126.
+Color we put in is 0xff00ffff at t/sdlx_surface.t line 127.
+
+# Failed test 'draw_rect uses correct red for 0xff00ffff'
+# at t/sdlx_surface.t line 128.
+# got: '0xffffffffff00ffff'
+# expected: '0xff00ffff'
+RGBA on surface is 0x00ffffff at t/sdlx_surface.t line 126.
+Color we put in is 0x00ffffff at t/sdlx_surface.t line 127.
+RGBA on surface is 0xffffffffff0000ff at t/sdlx_surface.t line 126.
+Color we put in is 0xff0000ff at t/sdlx_surface.t line 127.
+
+# Failed test 'draw_rect uses correct red for 0xff0000ff'
+# at t/sdlx_surface.t line 128.
+# got: '0xffffffffff0000ff'
+# expected: '0xff0000ff'
+RGBA on surface is 0x00ff00ff at t/sdlx_surface.t line 126.
+Color we put in is 0x00ff00ff at t/sdlx_surface.t line 127.
+RGBA on surface is 0x0000ffff at t/sdlx_surface.t line 126.
+Color we put in is 0x0000ffff at t/sdlx_surface.t line 127.
+RGBA on surface is 0x000000ff at t/sdlx_surface.t line 126.
+Color we put in is 0x000000ff at t/sdlx_surface.t line 127.
+RGBA on surface is 0x204080ff at t/sdlx_surface.t line 126.
+Color we put in is 0x204080ff at t/sdlx_surface.t line 127.
+RGBA on surface is 0xffffffff802040ff at t/sdlx_surface.t line 126.
+Color we put in is 0x802040ff at t/sdlx_surface.t line 127.
+
+# Failed test 'draw_rect uses correct red for 0x802040ff'
+# at t/sdlx_surface.t line 128.
+# got: '0xffffffff802040ff'
+# expected: '0x802040ff'
+RGBA on surface is 0x408020ff at t/sdlx_surface.t line 126.
+Color we put in is 0x408020ff at t/sdlx_surface.t line 127.
+# Looks like you failed 5 tests of 56.
+t/sdlx_surface.t ..
+ok 1 - [display] works
+ok 2 - The object isa SDLx::Surface
+ok 3 - The object isa SDL::Surface
+ok 4 - Right color returned
+ok 5 - Right color returned
+ok 6 - Correct Y value
+ok 7 - Correct X value
+ok 8 - The object isa SDLx::Surface
+ok 9 - The object isa SDL::Surface
+ok 10 - Right color returned
+ok 11 - Right color returned
+ok 12 - Correct Y value
+ok 13 - Correct X value
+ok 14 - The object isa SDLx::Surface
+ok 15 - The object isa SDL::Surface
+ok 16 - Right color returned
+ok 17 - Right color returned
+ok 18 - Correct Y value
+ok 19 - Correct X value
+ok 20 - The object isa SDLx::Surface
+ok 21 - The object isa SDL::Surface
+ok 22 - Right color returned
+ok 23 - Right color returned
+ok 24 - Correct Y value
+ok 25 - Correct X value
+ok 26 - Checking source pixel is 0
+ok 27 - Checking dest pixel is 0
+ok 28 - Checking that source pixel got written
+ok 29 - Pixel blitted from one surface to another
+ok 30 - Pixel by_blitted to another surface with offset
+ok 31 - Fill color worked
+ok 32 - Fliped the surface
+ok 33 - update all surface
+ok 34 - Single rect update
+ok 35 - SDL::Rect array update
+not ok 36 - draw_rect uses correct red for 0xffffffff
+not ok 37 - draw_rect uses correct red for 0xffff00ff
+not ok 38 - draw_rect uses correct red for 0xff00ffff
+ok 39 - draw_rect uses correct red for 0x00ffffff
+not ok 40 - draw_rect uses correct red for 0xff0000ff
+ok 41 - draw_rect uses correct red for 0x00ff00ff
+ok 42 - draw_rect uses correct red for 0x0000ffff
+ok 43 - draw_rect uses correct red for 0x000000ff
+ok 44 - draw_rect uses correct red for 0x204080ff
+not ok 45 - draw_rect uses correct red for 0x802040ff
+ok 46 - draw_rect uses correct red for 0x408020ff
+ok 47 - draw_line works
+ok 48 - draw_gfx_text works
+ok 49
+ok 50 - draw_circle works
+ok 51 - draw_circle_filled works
+ok 52 - Duplicate surf has same width
+ok 53 - Duplicate surf has same flags
+ok 54 - Duplicate surf has same flags
+ok 55 - Duplicate surf has same bpp
+ok 56 - Final SegFault test
+1..56
+Dubious, test returned 5 (wstat 1280, 0x500)
+Failed 5/56 subtests
+
+Test Summary Report
+-------------------
+t/sdlx_surface.t (Wstat: 1280 Tests: 56 Failed: 5)
+ Failed tests: 36-38, 40, 45
+ Non-zero exit status: 5
+Files=1, Tests=56, 0 wallclock secs ( 0.04 usr 0.01 sys + 0.10 cusr 0.01 csys = 0.16 CPU)
+Result: FAIL
+Failed 1/1 test programs. 5/56 subtests failed.
View
2  t/00-load.t
@@ -68,6 +68,8 @@ BEGIN {
SDLx::Controller::State
SDLx::Controller::Timer
+ SDLx::Sound
+
/;
plan tests => scalar @modules;
View
90 t/sdlx_sound.t
@@ -0,0 +1,90 @@
+#!perl -T
+# basic testing of SDLx::Sound
+
+BEGIN {
+ use Config;
+ if ( !$Config{'useithreads'} ) {
+ print("1..0 # Skip: Perl not compiled with 'useithreads'\n");
+ exit(0);
+ }
+
+ use Test::More tests => 7;
+ use lib 't/lib';
+ use lib 'lib';
+ use SDL;
+ use SDL::TestTool;
+ use SDL::Config;
+ use SDLx::Sound;
+
+ $audiodriver = $ENV{SDL_AUDIODRIVER};
+ $ENV{SDL_AUDIODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
+
+ if ( !SDL::TestTool->init(SDL_INIT_AUDIO) ) {
+ plan( skip_all => 'Failed to init sound' );
+ } elsif ( !SDL::Config->has('SDL_mixer') ) {
+ plan( skip_all => 'SDL_mixer support not compiled' );
+ }
+}
+my $fase2 = 0;
+
+# load
+# NOTE: use ok is tested in t/00-load.t so we can bail out
+
+# methods
+can_ok(
+ 'SDLx::Sound', qw/
+ new
+ load
+ unload
+ play
+ stop
+ loud
+ fade
+ /
+ );
+
+ok (my $snd = SDLx::Sound->new(), 'Can be instantiated');
+ok (my $snd2 = SDLx::Sound->new(), 'Can be instantiated again');
+
+isa_ok( $snd, 'SDLx::Sound', 'snd' );
+isa_ok( $snd2, 'SDLx::Sound', 'snd2' );
+
+# load and play a sound
+ok ($snd->play('test/data/sample.wav'), 'Can play a wav');
+
+SKIP:
+{
+ skip 'complex tests', 1 unless $fase2;
+# in a single act do the wole Sound
+ ok( my $snd2 = SDLx::Sound->new(
+ files => (
+ chanell_01 => "test/data/sample.wav",
+ chanell_02 => "test/data/tribe_i.wav"
+
+ ),
+ loud => (
+ channel_01 => 80,
+ channel_02 => 75
+ ),
+ bangs => (
+ chanell_01 => 0, # start
+ chanell_01 => 1256, # miliseconds
+ chanell_02 => 2345
+ ),
+ fade => (
+ chanell_02 => [2345, 3456, -20]
+ )
+ )->play()
+ );
+}
+
+#diag( "Testing SDLx::Sound $SDLx::Sound::VERSION, Perl $], $^X" );
+
+
+if ($audiodriver) {
+ $ENV{SDL_AUDIODRIVER} = $audiodriver;
+} else {
+ delete $ENV{SDL_AUDIODRIVER};
+}
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.