├── .gitignore ├── .travis.yml ├── BUGS ├── Build.PL ├── CHANGELOG ├── COPYING ├── INSTALL ├── MANIFEST.SKIP ├── MacOSX ├── Info.plist ├── Makefile.test ├── SDLPerl.icns └── main.c ├── OFL-FAQ.txt ├── OFL.txt ├── README.md ├── SDL_perl.supp ├── TODO ├── examples ├── GFX │ └── script_roto.pl ├── SDLx │ ├── SDLx_C_Interface.pl │ ├── SDLx_LayerManager_Chess.pl │ ├── SDLx_Sound.pl │ ├── SDLx_controller_two_squares.pl │ ├── SDLx_sprite.pl │ ├── SDLx_sprite_animated.pl │ ├── SDLx_text.pl │ ├── SDLx_text_shadow.pl │ ├── SDLx_text_styles.pl │ ├── SDLx_text_wordwrap.pl │ ├── SDLx_text_zoom.pl │ ├── app.pl │ ├── music.pl │ └── pong.pl ├── cookbook │ ├── 1.pl │ ├── openglapp.pl │ ├── pdl.pl │ └── pogl_sdl_texture.pl └── pixel_operations │ ├── fast_pixel_write.pl │ ├── sols │ └── ch02.pl │ ├── starry.pl │ └── tie_matrix.pl ├── inc └── My │ ├── Builder.pm │ └── Builder │ ├── Darwin.pm │ ├── Unix.pm │ └── Windows.pm ├── lib ├── Module │ └── Build │ │ └── SDL.pm ├── SDL.pm ├── SDL │ ├── Audio.pm │ ├── AudioCVT.pm │ ├── AudioSpec.pm │ ├── CD.pm │ ├── CDROM.pm │ ├── CDTrack.pm │ ├── Color.pm │ ├── Config.pm │ ├── Constants.pm │ ├── Cursor.pm │ ├── Event.pm │ ├── Events.pm │ ├── GFX.pm │ ├── GFX │ │ ├── BlitFunc.pm │ │ ├── FPSManager.pm │ │ ├── Framerate.pm │ │ ├── ImageFilter.pm │ │ ├── Primitives.pm │ │ └── Rotozoom.pm │ ├── Image.pm │ ├── Internal │ │ └── Loader.pm │ ├── Joystick.pm │ ├── Mixer.pm │ ├── Mixer │ │ ├── Channels.pm │ │ ├── Effects.pm │ │ ├── Groups.pm │ │ ├── MixChunk.pm │ │ ├── MixMusic.pm │ │ ├── Music.pm │ │ └── Samples.pm │ ├── Mouse.pm │ ├── MultiThread.pm │ ├── Net.pm │ ├── Net │ │ ├── .gitignore │ │ ├── IPaddress.pm │ │ ├── TCP.pm │ │ └── UDP.pm │ ├── Overlay.pm │ ├── Palette.pm │ ├── Pango.pm │ ├── Pango │ │ └── Context.pm │ ├── PixelFormat.pm │ ├── RWOps.pm │ ├── Rect.pm │ ├── SMPEG.pm │ ├── SMPEG │ │ └── Info.pm │ ├── Surface.pm │ ├── TTF.pm │ ├── TTF │ │ └── Font.pm │ ├── TTFont.pm │ ├── Time.pm │ ├── Tutorial.pm │ ├── Tutorial │ │ ├── Animation.pm │ │ └── LunarLander.pm │ ├── Version.pm │ ├── Video.pm │ └── VideoInfo.pm ├── SDL_perl.pm ├── SDLx │ ├── App.pm │ ├── Controller.pm │ ├── Controller │ │ ├── Interface.pm │ │ ├── State.pm │ │ └── Timer.pm │ ├── FPS.pm │ ├── Layer.pm │ ├── LayerManager.pm │ ├── Music.pm │ ├── Music │ │ ├── Data.pm │ │ └── Default.pm │ ├── Rect.pm │ ├── SFont.pm │ ├── Sound.pm │ ├── Sprite.pm │ ├── Sprite │ │ └── Animated.pm │ ├── Surface.pm │ ├── Surface │ │ ├── TiedMatrix.pm │ │ └── TiedMatrixRow.pm │ ├── TTF.pm │ ├── Text.pm │ └── Validate.pm └── pods │ ├── SDL.pod │ ├── SDL │ ├── Audio.pod │ ├── AudioCVT.pod │ ├── AudioSpec.pod │ ├── CD.pod │ ├── CDROM.pod │ ├── CDTrack.pod │ ├── Color.pod │ ├── Cookbook.pod │ ├── Cookbook │ │ ├── OpenGL.pod │ │ └── PDL.pod │ ├── Credits.pod │ ├── Cursor.pod │ ├── Deprecated.pod │ ├── Event.pod │ ├── Events.pod │ ├── GFX │ │ ├── BlitFunc.pod │ │ ├── FPSManager.pod │ │ ├── Framerate.pod │ │ ├── ImageFilter.pod │ │ ├── Primitives.pod │ │ └── Rotozoom.pod │ ├── Image.pod │ ├── Joystick.pod │ ├── MPEG.pod │ ├── Mixer.pod │ ├── Mixer │ │ ├── Channels.pod │ │ ├── Effects.pod │ │ ├── Groups.pod │ │ ├── MixChunk.pod │ │ ├── MixMusic.pod │ │ ├── Music.pod │ │ └── Samples.pod │ ├── Mouse.pod │ ├── MultiThread.pod │ ├── Overlay.pod │ ├── Palette.pod │ ├── Pango.pod │ ├── Pango │ │ └── Context.pod │ ├── PixelFormat.pod │ ├── Platform.pod │ ├── RWOps.pod │ ├── Rect.pod │ ├── SMPEG.pod │ ├── Surface.pod │ ├── TTF.pod │ ├── TTF │ │ └── Font.pod │ ├── Time.pod │ ├── Tutorial.pod │ ├── Tutorial │ │ ├── Animation.jpg │ │ ├── Animation.pod │ │ ├── Images_1.jpg │ │ ├── Images_2.jpg │ │ └── LunarLander.pod │ ├── Version.pod │ ├── Video.pod │ └── VideoInfo.pod │ └── SDLx │ ├── App.pod │ ├── Controller.pod │ ├── Controller │ ├── Interface.pod │ └── State.pod │ ├── Layer.pod │ ├── LayerManager.pod │ ├── Music.pod │ ├── Rect.pod │ ├── SFont.pod │ ├── Sound.pod │ ├── Sprite.pod │ ├── Sprite │ └── Animated.pod │ ├── Surface.pod │ └── Text.pod ├── logo ├── sdl_perl_logo_large.png └── sdl_perl_logo_small.png ├── perltidyrc ├── scripts ├── MultiThreadPOC.pl ├── OpenGL │ └── Constants.pm ├── README ├── SDL │ └── Constants.pm ├── SDLpp.pl ├── auto_constants.pl ├── const.pl ├── gl_const.pl ├── opengl_words.txt ├── sdl_const.pl ├── sdl_module_maker.pl └── sdl_words.txt ├── share └── GenBasR.ttf ├── src ├── Core │ ├── Audio.xs │ ├── CDROM.xs │ ├── Events.xs │ ├── Joystick.xs │ ├── Mouse.xs │ ├── MultiThread.xs │ ├── Time.xs │ ├── Video.xs │ └── objects │ │ ├── AudioCVT.xs │ │ ├── AudioSpec.xs │ │ ├── CD.xs │ │ ├── CDTrack.xs │ │ ├── Color.xs │ │ ├── Cursor.xs │ │ ├── Event.xs │ │ ├── Overlay.xs │ │ ├── Palette.xs │ │ ├── PixelFormat.xs │ │ ├── RWOps.xs │ │ ├── Rect.xs │ │ ├── Surface.xs │ │ ├── Version.xs │ │ ├── VideoInfo.xs │ │ ├── keysym.xs │ │ └── typemap ├── GFX │ ├── BlitFunc.xs │ ├── CHANGELOG │ ├── FPSManager.xs │ ├── Framerate.xs │ ├── GFX.xs │ ├── ImageFilter.xs │ ├── Primitives.xs │ ├── README │ └── Rotozoom.xs ├── Image.xs ├── Mixer │ ├── Channels.xs │ ├── Effects.xs │ ├── Groups.xs │ ├── Mixer.xs │ ├── Music.xs │ ├── README │ ├── Samples.xs │ └── objects │ │ ├── MixChunk.xs │ │ └── MixMusic.xs ├── Pango │ ├── Pango.xs │ └── objects │ │ └── Context.xs ├── SDL.xs ├── SDLx │ ├── Controller │ │ ├── Interface.h │ │ ├── Interface.xs │ │ └── State.xs │ ├── Layer.h │ ├── Layer.xs │ ├── LayerManager.h │ ├── LayerManager.xs │ ├── SFont.h │ ├── SFont.xs │ ├── Surface.xs │ ├── Timer.h │ ├── Timer.xs │ ├── Validate.h │ └── Validate.xs ├── SMPEG.xs ├── SMPEG │ └── Info.xs ├── TTF │ ├── README │ ├── TTF.xs │ └── objects │ │ └── Font.xs ├── defines.h ├── helper.h ├── ppport.h └── support │ ├── darwin_support.h │ ├── darwin_support.m │ └── win32.c ├── t ├── 00-load.t ├── colorpm.t ├── config.t ├── core.t ├── core_audio.t ├── core_audiospec.t ├── core_cd.t ├── core_error.t ├── core_events.t ├── core_joystick.t ├── core_mouse.t ├── core_multi.t ├── core_overlay.t ├── core_palette.t ├── core_rect.t ├── core_rwops.t ├── core_surface.t ├── core_timer.t ├── core_version.t ├── core_video.t ├── core_video_convert_surface.t ├── core_video_gamma.t ├── extendingrect.t ├── gfx.t ├── gfx_fpsmanager.t ├── gfx_framerate.t ├── gfx_imagefilter.t ├── gfx_primitives.t ├── gfx_primitives2.t ├── gfx_rotozoom.t ├── image.t ├── image_xpm_array.t ├── lib │ └── SDL │ │ └── TestTool.pm ├── mixer.t ├── mixer_channels.t ├── mixer_effects.t ├── mixer_groups.t ├── mixer_mixchunk.t ├── mixer_mixmusic.t ├── mixer_music.t ├── mixer_samples.t ├── pango.t ├── sdlgamerect.t ├── sdlx_app.t ├── sdlx_controller.t ├── sdlx_controller_interface.t ├── sdlx_fps.t ├── sdlx_layermanager.t ├── sdlx_music.t ├── sdlx_rect.t ├── sdlx_sfont.t ├── sdlx_sound.t ├── sdlx_sprite.t ├── sdlx_sprite_animated.t ├── sdlx_surface.t ├── sdlx_text.t ├── sdlx_validate.t ├── smpeg.t ├── ttf.t └── ttf_font.t ├── t_backcompat ├── 64encode.pl ├── Font.pm ├── MoP │ ├── .gitignore │ ├── Build.PL │ ├── Changes │ ├── LICENSE │ ├── README │ ├── Todo │ ├── data │ │ ├── 18.gif │ │ ├── 18.png │ │ ├── main.bmp │ │ ├── main.map │ │ ├── tiles.bmp │ │ └── tiles.png │ ├── lib │ │ └── SDL │ │ │ └── Tutorial │ │ │ ├── MoP.pm │ │ │ └── MoP │ │ │ ├── Base.pm │ │ │ ├── Controller │ │ │ ├── CPUSpinner.pm │ │ │ ├── Game.pm │ │ │ └── Keyboard.pm │ │ │ ├── EventManager.pm │ │ │ ├── Model │ │ │ └── Map.pm │ │ │ ├── Models.pm │ │ │ ├── View.pm │ │ │ └── View │ │ │ └── Map.pm │ └── t │ │ ├── 001_load.t │ │ └── run.t ├── OpenGL │ ├── README │ ├── test1.pl │ ├── test2.pl │ ├── test3.pl │ ├── test4.pl │ ├── test5.pl │ └── tutorial │ │ ├── Data │ │ ├── NeHe.png │ │ ├── Star.bmp │ │ ├── crate.png │ │ ├── cube.bmp │ │ ├── glass.bmp │ │ ├── tim.jpg │ │ └── world.txt │ │ ├── lesson02.pl │ │ ├── lesson03.pl │ │ ├── lesson04.pl │ │ ├── lesson05.pl │ │ ├── lesson06.pl │ │ ├── lesson07.pl │ │ ├── lesson08.pl │ │ └── lesson18.pl ├── Timer.pm ├── checkkeys.pl ├── core_event_filter.pl ├── fontpm.t ├── graywin.pl ├── loopwave.pl ├── palettepm.t ├── soundpm.t ├── testcolor.pl ├── testcolor.spl ├── testfonttool.pl ├── testgfxprim.pl ├── testgfxroto.pl ├── testgraphictool.pl ├── testjoystick.pl ├── testsprite.pl ├── testtimer.pl ├── toolfontpm.t ├── toolgraphicpm.t ├── ttfontpm.t └── wave.pl ├── test ├── README ├── checkkeys.pl ├── data │ ├── 24P_Arial_NeonYellow.png │ ├── 24P_Copperplate_Blue.png │ ├── 5x7.fnt │ ├── LargeFont.bmp │ ├── README │ ├── button_dark.png │ ├── button_light.png │ ├── chest.png │ ├── electrohar.ttf │ ├── font.bmp │ ├── font.png │ ├── hero.bmp │ ├── hero.png │ ├── highlight.png │ ├── icon.bmp │ ├── logo.png │ ├── menu.png │ ├── pattern_red_white_2x2.bmp │ ├── picture.bmp │ ├── picture.jpg │ ├── picture.tif │ ├── sample.wav │ ├── silence.wav │ ├── test-mpeg.mpg │ ├── tribe_i.wav │ ├── wood_dark.png │ └── wood_light.png ├── graywin.pl └── testmenu.pl ├── tools ├── GFX_headers_digest.pl ├── SDLBot.pl ├── evalSDL.run ├── make_XS_stub.pl ├── nopaste.pl ├── perltidy.pl ├── smokeNsend.pl ├── smolder_smoke_signal └── stubPod.pl ├── typemap └── xt ├── 01_podspell.t ├── 02_perlcritic.t ├── 03_pod.t ├── 04_podcoverage.t ├── 05_manifest.t ├── 06_surfaceML.t ├── 07_core_memleak.t ├── constantspm.t ├── net.t └── perlcriticrc /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | *.o 3 | Build 4 | blib 5 | nytprof* 6 | lib/SDLx/*.c 7 | lib/SDLx/*.xs 8 | lib/SDLx/Controller/*.c 9 | lib/SDLx/Controller/*.xs 10 | lib/SDL/*.c 11 | lib/SDL/*.xs 12 | lib/SDL/GFX/*.c 13 | lib/SDL/GFX/*.xs 14 | lib/SDL/Mixer/*.c 15 | lib/SDL/Mixer/*.xs 16 | lib/SDL/Net/*.c 17 | lib/SDL/Net/*.xs 18 | lib/SDL/Pango/*.c 19 | lib/SDL/Pango/*.xs 20 | lib/SDL/TTF/*.c 21 | lib/SDL/TTF/*.xs 22 | SDLPerl.app 23 | SDL_perl.c 24 | SDL_perl.xs 25 | stage 26 | MANIFEST 27 | !MANIFEST.skip 28 | *META.yml 29 | *META.json 30 | *.tar.gz 31 | *.swp 32 | *~ 33 | *.bak 34 | *_def.old 35 | *.ERR 36 | *Thumbs.db 37 | Build.bat 38 | *.base 39 | *.def 40 | *.exp 41 | *.lds 42 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - "5.8" 4 | - "5.10" 5 | - "5.12" 6 | - "5.14" 7 | - "5.16" 8 | - "5.18" 9 | 10 | before_install: 11 | # install Alien:SDL 12 | - sudo apt-get install automake 13 | - git clone https://github.com/PerlGameDev/Alien-SDL 14 | - cd Alien-SDL 15 | - cat ./cpan-deps | cpanm --sudo --notest 16 | - perl ./Build.PL --travis 17 | - sudo ./Build install 18 | - prove -v 19 | - cd .. 20 | # success!! 21 | 22 | # install SDL_Perl 23 | install: 24 | - cpanm --sudo --notest Test::Most Tie::Simple 25 | - perl ./Build.PL 26 | - sudo ./Build install 27 | 28 | script: prove -v 29 | 30 | notifications: 31 | irc: 32 | channels: 33 | - "irc.perl.org#sdl" 34 | on_success: change 35 | on_failure: always 36 | -------------------------------------------------------------------------------- /BUGS: -------------------------------------------------------------------------------- 1 | BUGS and Outstanding Issues 2 | 3 | See http://sdlperl.ath.cx/projects/SDLPerl/report -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | ~$ 2 | \.o$ 3 | \.bak$ 4 | ^(?!typemap|share|scripts/\w+\.pl|src/[^\.]|test/data/[^\.]|MacOSX/[^\.]|examples/[^\.]+|lib/[\/\w]+\.p(m|od)|inc/|t/[\w\d-]+\.t|t/lib/SDL/TestTool\.pm|Build.PL$|INSTALL$|README$|MANIFEST$|CHANGELOG$|TODO$|CONTRIBUTORS$|COPYING$|OFL-FAQ.txt|OFL.txt|META.yml|$) 5 | -------------------------------------------------------------------------------- /MacOSX/Info.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | CFBundleDisplayName 6 | SDLPerl 7 | CFBundleDocumentTypes 8 | 9 | 10 | CFBundleTypeExtensions 11 | 12 | spl 13 | 14 | CFBundleTypeIconFile 15 | SDLPerl.icns 16 | CFBundleTypeName 17 | SDL Perl Script 18 | CFBundleTypeRole 19 | Shell 20 | 21 | 22 | CFBundleExecutable 23 | SDLPerl 24 | CFBundleGetInfoString 25 | Multimedia for Perl 26 | CFBundleIconFile 27 | SDLPerl.icns 28 | CFBundleIdentifier 29 | org.perl.sdl 30 | CFBundleName 31 | SDLPerl 32 | CFBundlePackageType 33 | APPL 34 | CFBundleShortVersionString 35 | 2.2.0 36 | CFBundleVersion 37 | 2.2.0 38 | CSBundleSignature 39 | sdpl 40 | LSEnvironment 41 | 42 | LSHasLocalizedDisplayName 43 | 44 | NSAppleScriptEnabled 45 | 46 | NSHumanReadableCopyright 47 | Copyright © 2009-2010, Kartik Thakore. 48 | NSMainNibFile 49 | 50 | 51 | 52 | -------------------------------------------------------------------------------- /MacOSX/Makefile.test: -------------------------------------------------------------------------------- 1 | #!/bin/make -f 2 | 3 | BUILD=build 4 | APP_PARTS=\ 5 | $(BUILD)/SDLPerl.app/Contents/Info.plist \ 6 | $(BUILD)/SDLPerl.app/Contents/MacOS/SDLPerl \ 7 | $(BUILD)/SDLPerl.app/Contents/Resources/SDLPerl.rsrc \ 8 | $(BUILD)/SDLPerl.app/Contents/PkgInfo 9 | 10 | all: $(BUILD)/SDLPerl.app 11 | 12 | clean: 13 | rm -rf $(BUILD) 14 | 15 | $(BUILD)/SDLPerl.app: $(APP_PARTS) 16 | 17 | $(BUILD)/SDLPerl.app/Contents: 18 | mkdir -p $@ 19 | 20 | $(BUILD)/SDLPerl.app/Contents/MacOS: 21 | mkdir -p $@ 22 | 23 | $(BUILD)/SDLPerl.app/Contents/Resources: 24 | mkdir -p $@ 25 | 26 | $(BUILD)/SDLPerl.app/Contents/PkgInfo: $(BUILD)/SDLPerl.app/Contents 27 | echo -n "BNDL????" > $@ 28 | 29 | $(BUILD)/SDLPerl.app/Contents/Info.plist: $(BUILD)/SDLPerl.app/Contents 30 | cp Info.plist $@ 31 | 32 | $(BUILD)/SDLPerl.app/Contents/MacOS/SDLPerl: $(BUILD)/SDLPerl.app/Contents/MacOS 33 | gcc -o $@ $(ARCH_FLAGS) main.c 34 | 35 | $(BUILD)/SDLPerl.app/Contents/Resources/SDLPerl.rsrc: $(BUILD)/SDLPerl.app/Contents/Resources 36 | /Developer/Tools/Rez -d __DARWIN__ -useDF -o $(BUILD)/SDLPerl.rsrc $(ARCH_FLAGS) SDLPerl.r 37 | /Developer/Tools/ResMerger -dstIs DF $(BUILD)/SDLPerl.rsrc -o $@ 38 | -------------------------------------------------------------------------------- /MacOSX/SDLPerl.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/MacOSX/SDLPerl.icns -------------------------------------------------------------------------------- /MacOSX/main.c: -------------------------------------------------------------------------------- 1 | #include /* from the Perl distribution */ 2 | #include /* from the Perl distribution */ 3 | #include 4 | 5 | extern char **environ; 6 | 7 | static PerlInterpreter *my_perl; /* ** The Perl interpreter ***/ 8 | static void xs_init (pTHX); 9 | 10 | EXTERN_C void boot_DynaLoader (pTHX_ CV* cv); 11 | 12 | EXTERN_C void 13 | xs_init(pTHX) 14 | { 15 | char *file = __FILE__; 16 | /* DynaLoader is a special case */ 17 | newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); 18 | } 19 | 20 | 21 | 22 | int main(int argc, char *argv[]) 23 | { 24 | char **env = environ; 25 | PERL_SYS_INIT3(&argc,&argv, &env); 26 | my_perl = perl_alloc(); 27 | perl_construct(my_perl); 28 | PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 29 | perl_parse(my_perl, xs_init, argc, argv, (char **)NULL); 30 | perl_run(my_perl); 31 | perl_destruct(my_perl); 32 | perl_free(my_perl); 33 | PERL_SYS_TERM(); 34 | } 35 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # SDL [![Build Status](https://travis-ci.org/PerlGameDev/SDL.svg?branch=master)](https://travis-ci.org/PerlGameDev/SDL) 2 | 3 | NAME 4 | SDL Perl - Simple DirectMedia Layer for Perl 5 | 6 | SYNOPSIS 7 | use SDL; 8 | 9 | DESCRIPTION 10 | SDL Perl is a package of Perl modules that provide both functional and 11 | object oriented interfaces to the Simple DirectMedia Layer for Perl 5. 12 | This package takes some liberties with the SDL API, and attempts to adhere 13 | to the spirit of both the SDL and Perl. 14 | 15 | The SDL Perl Development Team 16 | Please see: HTTPS://GitHub.Com/PerlGameDev/SDL/contributors 17 | 18 | 19 | -------------------------------------------------------------------------------- /TODO: -------------------------------------------------------------------------------- 1 | TODO for SDL_perl 2 | 3 | Release 2.4 4 | - Clean up the source tree 5 | - Make test/* work with new code 6 | - Make tutorials work 7 | - Make the cook book prgressive (maybe dupe lazyfoo) 8 | - Sugar for Core SDL objects 9 | - Make SDL work with Frozen Bubble 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /examples/GFX/script_roto.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Carp; 5 | use SDL; 6 | use SDL::Rect; 7 | use SDL::Config; 8 | use SDL::Video; 9 | use SDL::Surface; 10 | use SDL::GFX::Rotozoom; 11 | 12 | my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE ); 13 | my $pixel = SDL::Video::map_RGB( $display->format, 0, 0, 0 ); 14 | SDL::Video::fill_rect( 15 | $display, 16 | SDL::Rect->new( 0, 0, $display->w, $display->h ), $pixel 17 | ); 18 | 19 | Carp::confess SDL::get_error if !$display; 20 | 21 | my $src = SDL::Video::load_BMP('test/data/picture.bmp'); 22 | my $temp_surf; 23 | 24 | sub draw { 25 | SDL::Video::fill_rect( 26 | $display, 27 | SDL::Rect->new( 0, 0, $display->w, $display->h ), $pixel 28 | ); 29 | 30 | my $surface = $_[0]; 31 | SDL::Video::blit_surface( 32 | $surface, SDL::Rect->new( 0, 0, $surface->w, $surface->h ), 33 | $display, SDL::Rect->new( 0, 0, $display->w, $display->w ) 34 | ); 35 | 36 | SDL::Video::update_rect( $display, 0, 0, 640, 480 ); 37 | 38 | SDL::delay( $_[1] ) if $_[1]; 39 | 40 | } 41 | 42 | # Note: new surface should be less than 16384 in width and height 43 | foreach ( 1 .. 360 ) { 44 | 45 | $temp_surf = SDL::GFX::Rotozoom::surface( $src, $_, $_ / 180, 1 ); 46 | Carp::confess SDL::get_error if !$temp_surf; 47 | draw( $temp_surf, 2 ); 48 | } 49 | 50 | $temp_surf = SDL::GFX::Rotozoom::surface_xy( $src, 1, 1, 1, 1 ); 51 | Carp::confess SDL::get_error if !$temp_surf; 52 | draw( $temp_surf, 1000 ); 53 | 54 | $temp_surf = SDL::GFX::Rotozoom::zoom_surface( $src, 1, 1, 1 ); 55 | Carp::confess SDL::get_error if !$temp_surf; 56 | draw( $temp_surf, 1000 ); 57 | 58 | $temp_surf = SDL::GFX::Rotozoom::shrink_surface( $src, 1, 1 ); 59 | Carp::confess SDL::get_error if !$temp_surf; 60 | draw( $temp_surf, 1000 ); 61 | 62 | SDL::delay(1000); 63 | 64 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_C_Interface.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Time::HiRes qw( time sleep ); 4 | use SDL; 5 | use SDLx::App; 6 | use SDL::Event; 7 | use SDL::Events; 8 | 9 | use SDLx::Controller::Interface; 10 | my $app = SDLx::App->new( w => 200, h => 200, title => "timestep", delay => 10 ); 11 | 12 | #The initial x and y for this object. 13 | my $spring = SDLx::Controller::Interface->new( x => 100, y => 100 ); 14 | 15 | #we have a constant x velocity of 20 16 | my $constant = SDLx::Controller::Interface->new( x => 0, y => 20, v_x => 20 ); 17 | 18 | #NO need to send an acceleration for x,y or rotation 19 | $constant->set_acceleration( sub { return ( 0, 0, 0 ) } ); 20 | 21 | #a hooke's law acceleration for the spring 22 | my $accel = sub { 23 | my ( $t, $state ) = @_; 24 | my $k = 10; 25 | my $b = 1; 26 | my $ax = ( ( -1 * $k ) * ( $state->x ) - $b * $state->v_x ); 27 | return ( $ax, 0, 0 ); 28 | }; 29 | $spring->set_acceleration($accel); 30 | 31 | #This is how we will render the spring. Notice the x, and y are not tied to how they will show on the screen 32 | my $render = sub { 33 | my $state = shift; 34 | $app->draw_rect( [ 100 - $state->x, $state->y, 2, 2 ], 0xFF0FFF ); 35 | }; 36 | 37 | #an event handler to exit 38 | my $event = sub { 39 | $_[1]->stop if $_[0]->type == SDL_QUIT; 40 | }; 41 | 42 | 43 | $app->add_event_handler($event); 44 | 45 | #clear the screen 46 | $app->add_show_handler( sub { $app->draw_rect( [ 0, 0, $app->w, $app->h ], 0x000000 ) } ); 47 | 48 | #add the spring 49 | $spring->attach($app, $render ); 50 | 51 | #add the constant_velocity 52 | $constant->attach( $app, 53 | sub { 54 | my $state = shift; 55 | $app->draw_rect( [ $state->x, $state->y, 4, 4 ], 0xFFFFFF ); 56 | } 57 | ); 58 | 59 | #add the final update 60 | $app->add_show_handler( sub { $app->update() } ); 61 | 62 | $app->run(); 63 | 64 | 65 | 66 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_Sound.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | #========================================================================== 3 | # 4 | # FILE: SDLx_Sound.pl 5 | # 6 | # USAGE: ./examples/SDLx_Sound.pl 7 | # 8 | # 9 | # DESCRIPTION: Sound tests 10 | # A SDLx::Sound can play, pause, resume and stop 11 | # 12 | # OPTIONS: --- 13 | # REQUIREMENTS: --- 14 | # BUGS: --- 15 | # NOTES: --- 16 | # AUTHOR: Ricardo Filipo (rf), ricardo.filipo@gmail.com 17 | # COMPANY: Mito-Lógica design e soluções de comunicação ltda 18 | # VERSION: 1.0 19 | # CREATED: 16-08-2010 21:47:33 20 | # REVISION: --- 21 | #========================================================================== 22 | 23 | use strict; 24 | use warnings; 25 | 26 | use lib 'lib'; 27 | use SDL; 28 | use SDLx::Sound; 29 | use SDLx::App; 30 | use SDL::Event; 31 | use SDL::Events; 32 | 33 | my $app = SDLx::App->new( 34 | height => 120, 35 | width => 480, 36 | depth => 16, 37 | title => 'Sound example', 38 | ); 39 | my $snd = SDLx::Sound->new(); 40 | 41 | # load and play a sound 42 | my $play = $snd->play('test/data/sample.wav'); 43 | 44 | # pause or resume on keydown 45 | $app->add_event_handler( sub{ 46 | my $e = $_[0]; 47 | $_[1]->stop() if $e->type == SDL_QUIT; 48 | if( $e->type == SDL_KEYDOWN ) 49 | { 50 | print "Ai\n"; 51 | if($play){ 52 | $snd->pause; 53 | $play=0; 54 | }else{ 55 | $snd->resume; 56 | $play=1; 57 | } 58 | } 59 | } ); 60 | 61 | $app->run(); 62 | 63 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_sprite.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use SDL; 3 | use SDL::Video; 4 | use SDL::Color; 5 | use SDL::Rect; 6 | use SDL::Surface; 7 | use SDL::GFX::Rotozoom; 8 | use lib '../lib'; 9 | use SDLx::Sprite; 10 | 11 | SDL::init(SDL_INIT_VIDEO); 12 | 13 | my $disp = SDL::Video::set_video_mode( 300, 300, 32, SDL_ANYFORMAT ); 14 | 15 | my $pixel = SDL::Video::map_RGB( $disp->format, rand(255), rand(255), rand(255) ); 16 | SDL::Video::fill_rect( 17 | $disp, SDL::Rect->new( 0, 0, $disp->w, $disp->h ), 18 | $pixel 19 | ); 20 | 21 | my $sprite = SDLx::Sprite->new( image => 'test/data/chest.png' ); 22 | 23 | $sprite->alpha_key( SDL::Color->new( 0xfc, 0x00, 0xff ) ); 24 | $sprite->alpha(0.8); 25 | 26 | my $angle = 0; 27 | while ( $angle++ < 360 ) { 28 | SDL::Video::fill_rect( 29 | $disp, SDL::Rect->new( 0, 0, $disp->w, $disp->h ), 30 | $pixel 31 | ); 32 | 33 | $sprite->rotation($angle); 34 | 35 | # 36 | $sprite->draw_xy( 37 | $disp, 38 | $disp->w / 2 - ( $sprite->w / 2 ), 39 | $disp->h / 2 - ( $sprite->h / 2 ) 40 | ); 41 | 42 | SDL::Video::update_rect( $disp, 0, 0, 300, 300 ); 43 | 44 | SDL::delay(2); 45 | } 46 | SDL::delay(2000); 47 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_sprite_animated.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use SDL; 3 | use SDL::Video; 4 | use SDL::Color; 5 | use SDL::Rect; 6 | 7 | use SDLx::Sprite::Animated; 8 | 9 | SDL::init(SDL_INIT_VIDEO); 10 | 11 | my $disp = SDL::Video::set_video_mode( 300, 300, 32, SDL_ANYFORMAT ); 12 | 13 | my $pixel = SDL::Video::map_RGB( $disp->format, 0, 0, 0 ); 14 | SDL::Video::fill_rect( 15 | $disp, SDL::Rect->new( 0, 0, $disp->w, $disp->h ), 16 | $pixel 17 | ); 18 | 19 | my $sprite = SDLx::Sprite::Animated->new( 20 | image => 'test/data/hero.bmp', 21 | rect => SDL::Rect->new( 48, 0, 48, 48 ), 22 | ticks_per_frame => 6, 23 | ); 24 | $sprite->set_sequences( left => [ [ 1, 0 ], [ 1, 1 ], [ 1, 2 ] ], ); 25 | $sprite->alpha_key( SDL::Color->new( 0xff, 0x00, 0xff ) ); 26 | $sprite->sequence('left'); 27 | $sprite->start(); 28 | my $x = 0; 29 | my $ticks = 0; 30 | 31 | while ( $x++ < 30 ) { 32 | SDL::Video::fill_rect( 33 | $disp, SDL::Rect->new( 0, 0, $disp->w, $disp->h ), 34 | $pixel 35 | ); 36 | 37 | $sprite->x( $x * 10 ); 38 | $sprite->next(); 39 | $sprite->draw($disp); 40 | 41 | SDL::Video::update_rect( $disp, 0, 0, 0, 0 ); 42 | 43 | SDL::delay(100); 44 | } 45 | 46 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_text.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib '../lib'; 4 | use SDL; 5 | use SDLx::App; 6 | use SDLx::Text; 7 | 8 | my $app = SDLx::App->new( eoq => 1 ); 9 | 10 | my $text = SDLx::Text->new; 11 | 12 | $app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff ); 13 | $text->write_to( $app, 'Hello, World!' ); 14 | $app->update; 15 | 16 | $app->run; 17 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_text_shadow.pl: -------------------------------------------------------------------------------- 1 | #TODO: shadow, shadow_color, shadow_offset 2 | 3 | use strict; 4 | use warnings; 5 | use lib '../lib'; 6 | use SDL; 7 | use SDLx::App; 8 | use SDLx::Text; 9 | 10 | my $app = SDLx::App->new( eoq => 1 ); 11 | 12 | my $normal = SDLx::Text->new; 13 | my $shadow = SDLx::Text->new( shadow => 1 ); 14 | 15 | # other variations 16 | my $shadow_off = SDLx::Text->new( shadow => 1, shadow_offset => 4 ); 17 | my $shadow_color = SDLx::Text->new( shadow => 1, shadow_color => [150, 150, 0] ); 18 | 19 | $app->add_show_handler( sub { 20 | $app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff ); 21 | 22 | $normal->write_xy( $app, 10, 0, 'Hello, World!' ); 23 | $shadow->write_xy( $app, 10, 50, 'Hello, Shadow!' ); 24 | 25 | $shadow_off->write_xy( $app, 10, 100, 'Hello, Shadow with offset!' ); 26 | $shadow_color->write_xy( $app, 10, 150, 'Hello, colored Shadow!' ); 27 | 28 | $app->update; 29 | }); 30 | 31 | $app->run; 32 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_text_styles.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib '../lib'; 4 | use SDL; 5 | use SDLx::App; 6 | use SDLx::Text; 7 | 8 | my $app = SDLx::App->new( eoq => 1 ); 9 | 10 | my $text = SDLx::Text->new; 11 | 12 | $app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff ); 13 | 14 | $text->write_xy( $app, 300, 10, 'Normal Text' ); 15 | 16 | $text->bold(1); 17 | $text->write_xy( $app, 300, 50, 'Bold Text' ); 18 | 19 | $text->italic(1); 20 | $text->write_xy( $app, 300, 90, 'Bold/Italic Text' ); 21 | 22 | $text->bold(0); 23 | $text->write_xy( $app, 300, 130, 'Italic Text' ); 24 | 25 | $text->italic(0); 26 | $text->underline(1); 27 | $text->write_xy( $app, 300, 170, 'Underline Text' ); 28 | 29 | $text->underline(0); 30 | $text->strikethrough(1); 31 | $text->write_xy( $app, 300, 210, 'Strikethrough Text' ); 32 | 33 | $text->underline(1); 34 | $text->bold(1); 35 | $text->italic(1); 36 | $text->write_xy( $app, 300, 250, 'All in one!' ); 37 | 38 | my $another = SDLx::Text->new( 39 | bold => 1, 40 | italic => 1, 41 | underline => 1, 42 | strikethrough => 1, 43 | shadow => 1, 44 | ); 45 | 46 | $another->write_xy( $app, 50, 300, 'Can even be set with others (like shadow), during startup!' ); 47 | 48 | $app->update; 49 | 50 | $app->run; 51 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_text_wordwrap.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib '../lib'; 4 | use SDL; 5 | use SDLx::App; 6 | use SDLx::Text; 7 | 8 | my $app = SDLx::App->new( eoq => 1 ); 9 | 10 | my $text = SDLx::Text->new( word_wrap => 450 ); 11 | 12 | $app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff ); 13 | 14 | my $message = <<'EOT'; 15 | All lines come from a single string. 16 | 17 | - Really? 18 | Yup. 19 | 20 | - But... but... what if I say a lot of things in a single line. Won't that become trucated or something? 21 | 22 | Not if you set "word_wrap" to a particular width, like we do here :-) 23 | EOT 24 | 25 | $text->write_to( $app, $message ); 26 | $app->update; 27 | 28 | $app->run; 29 | -------------------------------------------------------------------------------- /examples/SDLx/SDLx_text_zoom.pl: -------------------------------------------------------------------------------- 1 | #TODO: shadow, shadow_color, shadow_offset 2 | 3 | use strict; 4 | use warnings; 5 | use lib '../lib'; 6 | use SDL; 7 | use SDLx::App; 8 | use SDLx::Text; 9 | 10 | my $app = SDLx::App->new( eoq => 1, width => 400, height => 100 ); 11 | 12 | my $text = SDLx::Text->new; 13 | 14 | my $size = 1; 15 | my $direction = 1; 16 | $app->add_move_handler( sub { 17 | $size += $direction; 18 | $text->size( $size ); 19 | 20 | if ($direction == 1) { 21 | $direction = -1 if $size > 60; 22 | } 23 | else { 24 | $direction = 1 if $size < 2; 25 | } 26 | }); 27 | 28 | $app->add_show_handler( sub { 29 | $app->draw_rect( [0, 0, $app->w, $app->h], 0x00ffff ); 30 | $text->write_to( $app, 'Hello, World!' ); 31 | $app->update; 32 | }); 33 | 34 | $app->run; 35 | -------------------------------------------------------------------------------- /examples/SDLx/app.pl: -------------------------------------------------------------------------------- 1 | use SDL::Event; 2 | use SDLx::App; 3 | 4 | my $app = SDLx::App->new( 5 | title => "Lines", 6 | width => 640, 7 | height => 480, 8 | ); 9 | 10 | 11 | 12 | sub draw_lines { $app->draw_line( [ 0, 0 ], [ rand( $app->w ), rand( $app->h ) ], 0xFFFFFFFF ); $app->update(); } 13 | 14 | sub event_handle { my $e = shift; $_[0]->stop if ( $e->type == SDL_QUIT ); } 15 | 16 | $app->add_event_handler( \&event_handle ); 17 | $app->add_show_handler( \&draw_lines ); 18 | 19 | $app->run(); 20 | 21 | 22 | -------------------------------------------------------------------------------- /examples/SDLx/music.pl: -------------------------------------------------------------------------------- 1 | use SDL; 2 | use SDLx::Music; 3 | $music = SDLx::Music->new; 4 | $music->data( sam => "test/data/sample.wav" ); 5 | $sam = $music->data("sam"); 6 | $music->play($sam); 7 | while ( $music->playing ) { print "playing\n" } 8 | -------------------------------------------------------------------------------- /examples/cookbook/1.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | use SDL; 5 | use SDL::Rect; 6 | use SDL::Event; 7 | use SDL::Video; 8 | use SDL::Events; 9 | use SDL::Surface; 10 | 11 | SDL::init(SDL_INIT_VIDEO); 12 | 13 | my $display = SDL::Video::set_video_mode( 320, 320, 32, SDL_SWSURFACE ); 14 | 15 | my $quit = 0; 16 | while ( !$quit ) { 17 | my $event = SDL::Event->new(); 18 | 19 | SDL::Events::pump_events(); 20 | 21 | while ( SDL::Events::poll_event($event) ) { 22 | 23 | $quit = 1 if ( $event->type == SDL_QUIT ); 24 | 25 | } 26 | 27 | } 28 | -------------------------------------------------------------------------------- /examples/pixel_operations/sols/ch02.pl: -------------------------------------------------------------------------------- 1 | package SDL::Tutorial::Sol::Two; 2 | use strict; 3 | use warnings; 4 | use Carp; 5 | 6 | use SDL v2.3; 7 | use SDL::Video; 8 | use SDL::Event; 9 | use SDL::Events; 10 | use SDL::Surface; 11 | 12 | my $screen; 13 | 14 | sub putpixel { 15 | my ( $x, $y, $color ) = @_; 16 | my $lineoffset = $y * ( $screen->pitch / 4 ); 17 | $screen->set_pixels( $lineoffset + $x, $color ); 18 | } 19 | 20 | sub render { 21 | if ( SDL::Video::MUSTLOCK($screen) ) { 22 | return if ( SDL::Video::lock_surface($screen) < 0 ); 23 | } 24 | 25 | my $ticks = SDL::get_ticks(); 26 | my ( $i, $y, $yofs, $ofs ) = ( 0, 0, 0, 0 ); 27 | for ( $i = 0; $i < 480; $i++ ) { 28 | for ( my $j = 0, $ofs = $yofs; $j < 640; $j++, $ofs++ ) { 29 | $screen->set_pixels( $ofs, ( $i * $i + $j * $j + $ticks ) ); 30 | } 31 | $yofs += $screen->pitch / 4; 32 | } 33 | 34 | putpixel( 10, 10, 0xff0000 ); 35 | putpixel( 11, 10, 0xff0000 ); 36 | putpixel( 10, 11, 0xff0000 ); 37 | putpixel( 11, 11, 0xff0000 ); 38 | 39 | SDL::Video::unlock_surface($screen) if ( SDL::Video::MUSTLOCK($screen) ); 40 | 41 | SDL::Video::update_rect( $screen, 0, 0, 640, 480 ); 42 | 43 | return 0; 44 | } 45 | 46 | sub main { 47 | Carp::cluck 'Unable to init SDL: ' . SDL::get_error() 48 | if ( SDL::init(SDL_INIT_VIDEO) < 0 ); 49 | 50 | $screen = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE ); 51 | 52 | Carp::cluck 'Unable to set 640x480x32 video' . SDL::get_error() if ( !$screen ); 53 | 54 | while (1) { 55 | 56 | render(); 57 | 58 | my $event = SDL::Event->new(); 59 | 60 | while ( SDL::Events::poll_event($event) ) { 61 | my $type = $event->type; 62 | return 0 if ( $type == SDL_KEYDOWN ); 63 | return 0 if ( $type == SDL_QUIT ); 64 | 65 | } 66 | SDL::Events::pump_events(); 67 | 68 | } 69 | 70 | } 71 | 72 | main; 73 | 74 | SDL::quit; 75 | 76 | -------------------------------------------------------------------------------- /examples/pixel_operations/starry.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use SDL; 4 | use SDL::Rect; 5 | use SDL::Event; 6 | use SDL::Events; 7 | use SDL::Image; 8 | use SDL::Surface; 9 | use SDLx::Surface; 10 | use SDLx::App; 11 | 12 | my $app = SDLx::App->new( width => 300, height => 400, depth => 32 ); 13 | 14 | my $quit = 0; 15 | my $rot = 0; 16 | my $event = SDL::Event->new(); 17 | my @stars = (); 18 | 19 | foreach ( 0 .. 40 ) { 20 | my $x = rand( $app->w ); 21 | my $y = rand( $app->h ); 22 | my $speed = rand(4) + 1; 23 | 24 | push( @stars, { x => $x, y => $y, speed => $speed } ); 25 | } 26 | 27 | my $display_matrix = SDLx::Surface->new( surface => $app ); 28 | 29 | while ( !$quit ) { 30 | 31 | SDL::Events::pump_events(); 32 | while ( SDL::Events::poll_event($event) ) { 33 | $quit = 1 if $event->type == SDL_QUIT; 34 | if ( $event->type == SDL_KEYDOWN 35 | || ( $event->key_sym && $event->type != SDL_KEYUP ) ) 36 | { 37 | $rot += 0.1 if $event->key_sym == SDLK_UP; 38 | $rot -= 0.1 if $event->key_sym == SDLK_DOWN; 39 | 40 | } 41 | } 42 | 43 | my @update_rects = (); 44 | 45 | foreach (@stars) { 46 | 47 | $display_matrix->[ $_->{x} ][ $_->{y} ] = 0xFF000000; 48 | 49 | $_->{x} += $_->{speed}; 50 | $_->{y} += $_->{speed} * $rot; 51 | $_->{x} = 0 if ( $_->{x} >= $app->w ); 52 | $_->{y} = 0 if ( $_->{y} >= $app->h ); 53 | $_->{x} = $app->w if ( $_->{x} < 0 ); 54 | $_->{y} = $app->h if ( $_->{y} < 0 ); 55 | 56 | $display_matrix->[ $_->{x} ][ $_->{y} ] = 0xFFFFFFFF; 57 | 58 | # push @update_rects, SDL::Rect->new($_->{x}, $_->{y}, 2, 2); 59 | 60 | } 61 | 62 | $display_matrix->update(); 63 | 64 | } 65 | 66 | -------------------------------------------------------------------------------- /inc/My/Builder/Unix.pm: -------------------------------------------------------------------------------- 1 | package My::Builder::Unix; 2 | use base 'My::Builder'; 3 | use Config; 4 | 5 | if($^O eq 'cygwin') { 6 | my $ccflags = $Config{ccflags}; 7 | $ccflags =~ s/-fstack-protector//; 8 | $My::Builder::config = { ld => 'gcc', cc => 'gcc', ccflags => $ccflags }; 9 | } 10 | 11 | 1; 12 | -------------------------------------------------------------------------------- /inc/My/Builder/Windows.pm: -------------------------------------------------------------------------------- 1 | package My::Builder::Windows; 2 | use base 'My::Builder'; 3 | 4 | sub process_xs { 5 | my ( $self, $file ) = @_; 6 | 7 | $file =~ s/\\/\//g; 8 | 9 | $self->SUPER::process_xs($file); 10 | } 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/SDL/Audio.pm: -------------------------------------------------------------------------------- 1 | package SDL::Audio; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Audio'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Audio; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/AudioCVT.pm: -------------------------------------------------------------------------------- 1 | package SDL::AudioCVT; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Audio'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::AudioCVT; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/AudioSpec.pm: -------------------------------------------------------------------------------- 1 | package SDL::AudioSpec; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Audio'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::AudioSpec; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/CD.pm: -------------------------------------------------------------------------------- 1 | package SDL::CD; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::CDROM'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::CD; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::CDROM'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/default'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/status'}, 23 | track_type => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/track_type'} 24 | ); 25 | 26 | # Conversion functions from frames to Minute/Second/Frames and vice versa 27 | sub FRAMES_TO_MSF { 28 | my $frames = shift; 29 | my $F = $frames % CD_FPS; 30 | $frames /= CD_FPS; 31 | my $S = $frames % 60; 32 | $frames /= 60; 33 | my $M = $frames; 34 | 35 | return ( $M, $S, $F ); 36 | } 37 | 38 | sub MSF_TO_FRAMES { 39 | my $M = shift; 40 | my $S = shift; 41 | my $F = shift; 42 | 43 | return ( $M * 60 * CD_FPS + $S * CD_FPS + $F ); 44 | } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/SDL/CDROM.pm: -------------------------------------------------------------------------------- 1 | package SDL::CDROM; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::CDROM'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::CDROM; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::CDROM'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/default'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/status'}, 23 | track_type => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/track_type'} 24 | ); 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/SDL/CDTrack.pm: -------------------------------------------------------------------------------- 1 | package SDL::CDTrack; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::CDROM'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::CDTrack; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::CDROM'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | format => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/default'}, 22 | status => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/status'}, 23 | track_type => $SDL::Constants::EXPORT_TAGS{'SDL::CDROM/track_type'} 24 | ); 25 | 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/SDL/Color.pm: -------------------------------------------------------------------------------- 1 | package SDL::Color; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Color; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | 32 | -------------------------------------------------------------------------------- /lib/SDL/Config.pm: -------------------------------------------------------------------------------- 1 | package SDL::Config; 2 | 3 | use strict; 4 | use warnings; 5 | use SDL::ConfigData; 6 | 7 | our $VERSION = 2.548; 8 | 9 | sub has { 10 | my ( $class, $define ) = @_; 11 | my $sdl_config = SDL::ConfigData->config('SDL_cfg'); 12 | my $n = scalar grep { $$sdl_config{$_}{'libs'}{$define} } keys %$sdl_config; 13 | return ( $n > 0 ) ? 1 : 0; 14 | } 15 | 16 | 1; 17 | -------------------------------------------------------------------------------- /lib/SDL/Cursor.pm: -------------------------------------------------------------------------------- 1 | package SDL::Cursor; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Cursor; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Event.pm: -------------------------------------------------------------------------------- 1 | package SDL::Event; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Events'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Event; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Events'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Events/type'}, 22 | mask => $SDL::Constants::EXPORT_TAGS{'SDL::Events/mask'}, 23 | action => $SDL::Constants::EXPORT_TAGS{'SDL::Events/action'}, 24 | state => $SDL::Constants::EXPORT_TAGS{'SDL::Events/state'}, 25 | hat => $SDL::Constants::EXPORT_TAGS{'SDL::Events/hat'}, 26 | app => $SDL::Constants::EXPORT_TAGS{'SDL::Events/app'}, 27 | button => $SDL::Constants::EXPORT_TAGS{'SDL::Events/button'}, 28 | keysym => $SDL::Constants::EXPORT_TAGS{'SDL::Events/keysym'}, 29 | keymod => $SDL::Constants::EXPORT_TAGS{'SDL::Events/keymod'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Events.pm: -------------------------------------------------------------------------------- 1 | package SDL::Events; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Events'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Events; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Events'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Events/type'}, 22 | mask => $SDL::Constants::EXPORT_TAGS{'SDL::Events/mask'}, 23 | action => $SDL::Constants::EXPORT_TAGS{'SDL::Events/action'}, 24 | state => $SDL::Constants::EXPORT_TAGS{'SDL::Events/state'}, 25 | hat => $SDL::Constants::EXPORT_TAGS{'SDL::Events/hat'}, 26 | app => $SDL::Constants::EXPORT_TAGS{'SDL::Events/app'}, 27 | button => $SDL::Constants::EXPORT_TAGS{'SDL::Events/button'}, 28 | keysym => $SDL::Constants::EXPORT_TAGS{'SDL::Events/keysym'}, 29 | keymod => $SDL::Constants::EXPORT_TAGS{'SDL::Events/keymod'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/GFX.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | init => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/init'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/BlitFunc.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::BlitFunc; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::BlitFunc; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | smoothing => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/smoothing'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/FPSManager.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::FPSManager; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::FPSManager; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | smoothing => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/smoothing'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/Framerate.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::Framerate; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::Framerate; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | smoothing => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/smoothing'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/ImageFilter.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::ImageFilter; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::ImageFilter; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | smoothing => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/smoothing'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/Primitives.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::Primitives; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::Primitives; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | init => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/init'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/GFX/Rotozoom.pm: -------------------------------------------------------------------------------- 1 | package SDL::GFX::Rotozoom; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::GFX'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::GFX::Rotozoom; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::GFX'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | smoothing => $SDL::Constants::EXPORT_TAGS{'SDL::GFX/smoothing'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/Image.pm: -------------------------------------------------------------------------------- 1 | package SDL::Image; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Image'; 8 | use SDL::Surface; 9 | our @ISA = qw(Exporter DynaLoader); 10 | 11 | use SDL::Internal::Loader; 12 | internal_load_dlls(__PACKAGE__); 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDL::Image; 17 | 18 | use base 'Exporter'; 19 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Image'} }; 20 | our %EXPORT_TAGS = ( 21 | all => \@EXPORT, 22 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Video/init'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/Joystick.pm: -------------------------------------------------------------------------------- 1 | package SDL::Joystick; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Joystick; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Mixer.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/Channels.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::Channels; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::Channels; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/Effects.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::Effects; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::Effects; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/Groups.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::Groups; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::Groups; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/MixChunk.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::MixChunk; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::MixChunk; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/MixMusic.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::MixMusic; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::MixMusic; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/Music.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::Music; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::Music; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mixer/Samples.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mixer::Samples; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants qw(:SDL::Mixer :SDL::Audio); 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Mixer::Samples; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = ( 19 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Mixer'} }, 20 | @{ $SDL::Constants::EXPORT_TAGS{'SDL::Audio'} } 21 | ); 22 | our %EXPORT_TAGS = ( 23 | all => \@EXPORT, 24 | init => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/init'}, 25 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/defaults'}, 26 | fading => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/fading'}, 27 | type => $SDL::Constants::EXPORT_TAGS{'SDL::Mixer/type'}, 28 | format => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/format'}, 29 | status => $SDL::Constants::EXPORT_TAGS{'SDL::Audio/status'} 30 | ); 31 | 32 | 1; 33 | -------------------------------------------------------------------------------- /lib/SDL/Mouse.pm: -------------------------------------------------------------------------------- 1 | package SDL::Mouse; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | our $VERSION = 2.548; 9 | 10 | bootstrap SDL::Mouse; 11 | 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/SDL/MultiThread.pm: -------------------------------------------------------------------------------- 1 | package SDL::MultiThread; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::MultiThread; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Net.pm: -------------------------------------------------------------------------------- 1 | package SDL::Net; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Net'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Net; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Net'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::Net/defaults'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/Net/.gitignore: -------------------------------------------------------------------------------- 1 | *.c 2 | *.o 3 | *.xs 4 | -------------------------------------------------------------------------------- /lib/SDL/Net/IPaddress.pm: -------------------------------------------------------------------------------- 1 | package SDL::Net::IPaddress; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Net::IPaddress; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Net/TCP.pm: -------------------------------------------------------------------------------- 1 | package SDL::Net::TCP; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Net::TCP; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Net/UDP.pm: -------------------------------------------------------------------------------- 1 | package SDL::Net::UDP; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Net::UDP; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Overlay.pm: -------------------------------------------------------------------------------- 1 | package SDL::Overlay; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Overlay; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | 32 | -------------------------------------------------------------------------------- /lib/SDL/Palette.pm: -------------------------------------------------------------------------------- 1 | package SDL::Palette; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | use SDL::Color; 9 | our @ISA = qw(Exporter DynaLoader); 10 | 11 | use SDL::Internal::Loader; 12 | internal_load_dlls(__PACKAGE__); 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDL::Palette; 17 | 18 | use base 'Exporter'; 19 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 20 | our %EXPORT_TAGS = ( 21 | all => \@EXPORT, 22 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 23 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 24 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 25 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 26 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 27 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 28 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 29 | ); 30 | 31 | 1; 32 | 33 | -------------------------------------------------------------------------------- /lib/SDL/Pango.pm: -------------------------------------------------------------------------------- 1 | package SDL::Pango; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Pango'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Pango; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Pango'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | direction => $SDL::Constants::EXPORT_TAGS{'SDL::Pango/direction'}, 22 | align => $SDL::Constants::EXPORT_TAGS{'SDL::Pango/align'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/Pango/Context.pm: -------------------------------------------------------------------------------- 1 | package SDL::Pango::Context; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Pango'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Pango::Context; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Pango'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | direction => $SDL::Constants::EXPORT_TAGS{'SDL::Pango/direction'}, 22 | align => $SDL::Constants::EXPORT_TAGS{'SDL::Pango/align'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/PixelFormat.pm: -------------------------------------------------------------------------------- 1 | package SDL::PixelFormat; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::PixelFormat; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/SDL/RWOps.pm: -------------------------------------------------------------------------------- 1 | package SDL::RWOps; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::RWOps'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::RWOps; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::RWOps'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | defaults => $SDL::Constants::EXPORT_TAGS{'SDL::RWOps/defaults'} 22 | ); 23 | 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/SDL/Rect.pm: -------------------------------------------------------------------------------- 1 | package SDL::Rect; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Rect; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/SDL/Surface.pm: -------------------------------------------------------------------------------- 1 | package SDL::Surface; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | use SDL::PixelFormat; 9 | our @ISA = qw(Exporter DynaLoader); 10 | 11 | use SDL::Internal::Loader; 12 | internal_load_dlls(__PACKAGE__); 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDL::Surface; 17 | 18 | use base 'Exporter'; 19 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 20 | our %EXPORT_TAGS = ( 21 | all => \@EXPORT, 22 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 23 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 24 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 25 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 26 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 27 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 28 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 29 | ); 30 | 31 | 1; 32 | -------------------------------------------------------------------------------- /lib/SDL/TTF.pm: -------------------------------------------------------------------------------- 1 | package SDL::TTF; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::TTF'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::TTF; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::TTF'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | hinting => $SDL::Constants::EXPORT_TAGS{'SDL::TTF/hinting'}, 22 | style => $SDL::Constants::EXPORT_TAGS{'SDL::TTF/style'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/TTF/Font.pm: -------------------------------------------------------------------------------- 1 | package SDL::TTF::Font; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::TTF'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::TTF::Font; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::TTF'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | hinting => $SDL::Constants::EXPORT_TAGS{'SDL::TTF/hinting'}, 22 | style => $SDL::Constants::EXPORT_TAGS{'SDL::TTF/style'} 23 | ); 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/SDL/Time.pm: -------------------------------------------------------------------------------- 1 | package SDL::Time; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | our $VERSION = 2.548; 12 | 13 | bootstrap SDL::Time; 14 | 15 | 1; 16 | -------------------------------------------------------------------------------- /lib/SDL/Tutorial.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # Tutorial.pm 4 | # 5 | # Copyright (C) 2005 David J. Goehrig 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::Tutorial; 32 | 33 | use strict; 34 | use warnings; 35 | 36 | use SDL; 37 | use SDLx::App; 38 | 39 | our $VERSION = 2.548; 40 | 41 | # change these values as necessary 42 | my $title = 'My SDL App'; 43 | my ( $width, $height, $depth ) = ( 640, 480, 16 ); 44 | 45 | my $app = SDLx::App->new( 46 | width => $width, 47 | height => $height, 48 | depth => $depth, 49 | title => $title, 50 | ); 51 | 52 | # your code here; remove the next line 53 | sleep 2; 54 | 55 | 1; 56 | 57 | -------------------------------------------------------------------------------- /lib/SDL/Version.pm: -------------------------------------------------------------------------------- 1 | package SDL::Version; 2 | use strict; 3 | use warnings; 4 | require Exporter; 5 | require DynaLoader; 6 | our @ISA = qw(Exporter DynaLoader); 7 | 8 | use SDL::Internal::Loader; 9 | internal_load_dlls(__PACKAGE__); 10 | 11 | use overload '<=>' => \&my_cmp, 12 | '""' => \&stringify; 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDL::Version; 17 | 18 | sub stringify { 19 | my $self = shift; 20 | return sprintf "%s%s%s", chr($self->major), chr($self->minor), chr($self->patch); 21 | } 22 | 23 | sub my_cmp { 24 | my ($left, $right) = @_; 25 | return "$left" cmp "$right"; 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/SDL/Video.pm: -------------------------------------------------------------------------------- 1 | package SDL::Video; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::Video; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/SDL/VideoInfo.pm: -------------------------------------------------------------------------------- 1 | package SDL::VideoInfo; 2 | use strict; 3 | use warnings; 4 | use vars qw(@ISA @EXPORT @EXPORT_OK); 5 | require Exporter; 6 | require DynaLoader; 7 | use SDL::Constants ':SDL::Video'; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | use SDL::Internal::Loader; 11 | internal_load_dlls(__PACKAGE__); 12 | 13 | our $VERSION = 2.548; 14 | 15 | bootstrap SDL::VideoInfo; 16 | 17 | use base 'Exporter'; 18 | our @EXPORT = @{ $SDL::Constants::EXPORT_TAGS{'SDL::Video'} }; 19 | our %EXPORT_TAGS = ( 20 | all => \@EXPORT, 21 | color => $SDL::Constants::EXPORT_TAGS{'SDL::Video/color'}, 22 | surface => $SDL::Constants::EXPORT_TAGS{'SDL::Video/surface'}, 23 | video => $SDL::Constants::EXPORT_TAGS{'SDL::Video/video'}, 24 | overlay => $SDL::Constants::EXPORT_TAGS{'SDL::Video/overlay'}, 25 | grab => $SDL::Constants::EXPORT_TAGS{'SDL::Video/grab'}, 26 | palette => $SDL::Constants::EXPORT_TAGS{'SDL::Video/palette'}, 27 | gl => $SDL::Constants::EXPORT_TAGS{'SDL::Video/gl'} 28 | ); 29 | 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/SDL_perl.pm: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # SDL_perl.pm 4 | # 5 | # Copyright (C) 2005 David J. Goehrig 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_perl; 32 | 33 | use strict; 34 | use warnings; 35 | 36 | our @ISA = qw/ DynaLoader /; 37 | require DynaLoader; 38 | 39 | use SDL::Internal::Loader; 40 | internal_load_dlls(__PACKAGE__); 41 | 42 | our $VERSION = 2.548; 43 | 44 | bootstrap SDL_perl; 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/SDLx/Controller/Interface.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Controller::Interface; 2 | use strict; 3 | use warnings; 4 | use Carp qw/confess/; 5 | use Scalar::Util 'refaddr'; 6 | 7 | our @ISA = qw(Exporter DynaLoader); 8 | 9 | use SDL::Internal::Loader; 10 | 11 | our $VERSION = 2.548; 12 | 13 | my %_controller; 14 | 15 | sub new { 16 | shift; 17 | my %foo = @_; 18 | 19 | my @args; 20 | push @args, ( $foo{x} || 0 ); 21 | push @args, ( $foo{y} || 0 ); 22 | push @args, ( $foo{v_x} || 0 ); 23 | push @args, ( $foo{v_y} || 0 ); 24 | push @args, ( $foo{rot} || 0 ); 25 | push @args, ( $foo{ang_v} || 0 ); 26 | 27 | return SDLx::Controller::Interface->make(@args); 28 | } 29 | 30 | 31 | sub attach { 32 | my ( $self, $controller, $render, @params ) = @_; 33 | 34 | Carp::confess "An SDLx::Controller is needed" unless $controller && $controller->isa('SDLx::Controller'); 35 | 36 | $_controller{ refaddr $self } = [ $controller ]; 37 | my $move = sub { $self->update( $_[2], $_[1]->dt )}; 38 | $_controller{ refaddr $self }->[1] = $controller->add_move_handler($move); 39 | 40 | if ($render) { 41 | my $show = sub { my $state = $self->interpolate( $_[0] ); $render->( $state, @params ); }; 42 | $_controller{ refaddr $self }->[2] = $controller->add_show_handler($show); 43 | } else { 44 | Carp::confess "Render callback not provided"; 45 | 46 | } 47 | } 48 | 49 | sub detach { 50 | my ( $self) = @_; 51 | my $controller = $_controller{ refaddr $self }; 52 | return unless $controller; 53 | $controller->[0]->remove_move_handler($controller->[1]); 54 | $controller->[0]->remove_show_handler($controller->[2]); 55 | } 56 | 57 | internal_load_dlls(__PACKAGE__); 58 | bootstrap SDLx::Controller::Interface; 59 | 60 | 61 | 1; 62 | -------------------------------------------------------------------------------- /lib/SDLx/Controller/State.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Controller::State; 2 | use strict; 3 | use warnings; 4 | 5 | our @ISA = qw(Exporter DynaLoader); 6 | 7 | use SDL::Internal::Loader; 8 | internal_load_dlls(__PACKAGE__); 9 | 10 | our $VERSION = 2.548; 11 | 12 | bootstrap SDLx::Controller::State; 13 | 14 | 1; 15 | -------------------------------------------------------------------------------- /lib/SDLx/Controller/Timer.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Controller::Timer; 2 | 3 | # Implementation of lesson 13 and 14 from http://lazyfoo.net/SDL_tutorials/index.php 4 | # 5 | use strict; 6 | use warnings; 7 | use SDL; 8 | 9 | our $VERSION = 2.548; 10 | 11 | sub new { 12 | my $class = shift; 13 | my $self = bless {@_}, $class; 14 | 15 | $self->{started_ticks} = 0; 16 | $self->{paused_ticks} = 0; 17 | $self->{started} = 0; 18 | $self->{paused} = 0; 19 | 20 | return $self; 21 | } 22 | 23 | sub start { 24 | my $self = shift; 25 | $self->{started} = 1; 26 | $self->{started_ticks} = SDL::get_ticks(); 27 | } 28 | 29 | sub stop { 30 | my $self = shift; 31 | 32 | $self->{started} = 0; 33 | $self->{paused} = 0; 34 | } 35 | 36 | sub pause { 37 | my $self = shift; 38 | if ( $self->{started} && !$self->{paused} ) { 39 | $self->{paused} = 1; 40 | $self->{paused_ticks} = SDL::get_ticks() - $self->{started_ticks}; 41 | } 42 | } 43 | 44 | sub unpause { 45 | my $self = shift; 46 | if ( $self->{paused} ) { 47 | $self->{paused} = 0; 48 | 49 | $self->{started_ticks} = SDL::get_ticks() - $self->{started_ticks}; 50 | 51 | $self->{paused_ticks} = 0; 52 | } 53 | } 54 | 55 | sub get_ticks { 56 | my $self = shift; 57 | if ( $self->{started} ) { 58 | if ( $self->{paused} ) { 59 | return $self->{paused_ticks}; 60 | } else { 61 | my $update = SDL::get_ticks(); 62 | my $diff = $update - $self->{started_ticks}; 63 | return $diff; 64 | } 65 | } 66 | return 0; 67 | } 68 | 69 | sub is_started { 70 | my $self = shift; 71 | return $self->{started}; 72 | } 73 | 74 | sub is_paused { 75 | my $self = shift; 76 | return $self->{paused}; 77 | } 78 | 79 | 1; 80 | -------------------------------------------------------------------------------- /lib/SDLx/Layer.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Layer; 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDLx::Surface; 6 | use SDLx::Sprite; 7 | use SDL::Events; 8 | 9 | our @ISA = qw(Exporter DynaLoader); 10 | 11 | use SDL::Internal::Loader; 12 | internal_load_dlls(__PACKAGE__); 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDLx::Layer; 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/SDLx/LayerManager.pm: -------------------------------------------------------------------------------- 1 | package SDLx::LayerManager; 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDLx::Surface; 6 | use SDLx::Sprite; 7 | use SDL::Events; 8 | 9 | our @ISA = qw(Exporter DynaLoader); 10 | 11 | use SDL::Internal::Loader; 12 | internal_load_dlls(__PACKAGE__); 13 | 14 | our $VERSION = 2.548; 15 | 16 | bootstrap SDLx::LayerManager; 17 | 18 | 1; 19 | -------------------------------------------------------------------------------- /lib/SDLx/Music/Data.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Music::Data; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | our $VERSION = 2.548; 7 | 8 | sub volume 9 | { 10 | $_[0]->{volume} = $_[1] if $_[1]; 11 | return $_[0]; 12 | } 13 | 14 | sub file 15 | { 16 | if( $_[1] ) 17 | { 18 | $_[0]->{file} = $_[1]; 19 | $_[0]->{to_load} = 1; 20 | } 21 | return $_[0]; 22 | } 23 | 24 | 25 | sub fade_in 26 | { 27 | $_[0]->{fade_in} = $_[1] if $_[1]; 28 | return $_[0]; 29 | } 30 | 31 | sub loops 32 | { 33 | $_[0]->{loops} = $_[1] if $_[1]; 34 | return $_[0]; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/SDLx/Music/Default.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Music::Default; 2 | use strict; 3 | use warnings; 4 | 5 | our $VERSION = 2.548; 6 | 7 | sub ext 8 | { 9 | 10 | $_[0]->{ext} = $_[1] if $_[1]; 11 | return $_[0]->{ext}; 12 | } 13 | 14 | sub dir 15 | { 16 | $_[0]->{dir} = $_[1] if $_[1]; 17 | return $_[0]->{dir}; 18 | } 19 | 20 | 1; 21 | -------------------------------------------------------------------------------- /lib/SDLx/SFont.pm: -------------------------------------------------------------------------------- 1 | package SDLx::SFont; 2 | use strict; 3 | use warnings; 4 | use SDL::Image; 5 | use vars qw(@ISA @EXPORT @EXPORT_OK); 6 | require Exporter; 7 | require DynaLoader; 8 | use SDL::Constants ':SDL::TTF'; 9 | our @ISA = qw(Exporter DynaLoader SDL::Surface); 10 | 11 | use base 'Exporter'; 12 | our @EXPORT = ('SDL_TEXTWIDTH'); 13 | 14 | our $VERSION = 2.548; 15 | 16 | sub SDL_TEXTWIDTH { 17 | return SDLx::SFont::TextWidth( join( '', @_ ) ); 18 | } 19 | 20 | sub print_text { #print is a horrible name for this 21 | my ( $surf, $x, $y, @text ) = @_; 22 | SDLx::SFont::print_string( $surf, $x, $y, join( '', @text ) ); 23 | } 24 | 25 | bootstrap SDLx::SFont; 26 | 27 | 1; 28 | 29 | -------------------------------------------------------------------------------- /lib/SDLx/Surface/TiedMatrix.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Surface::TiedMatrix; 2 | use strict; 3 | use warnings; 4 | use SDLx::Surface::TiedMatrixRow; 5 | use base 'Tie::Array'; 6 | 7 | our $VERSION = 2.548; 8 | 9 | sub new { 10 | my $class = shift; 11 | my $matrix = shift; 12 | my $self = { 13 | matrix => $matrix, 14 | rows => [], 15 | }; 16 | return bless $self, $class; 17 | } 18 | 19 | sub TIEARRAY { 20 | return SDLx::Surface::TiedMatrix->new( $_[1] ); 21 | } 22 | 23 | sub FETCH { 24 | my ( $self, $y ) = @_; 25 | 26 | unless ( $self->{rows}[$y] ) { 27 | tie my @row, 'SDLx::Surface::TiedMatrixRow', $self->{matrix}, $y; 28 | $self->{rows}[$y] = \@row; 29 | } 30 | return $self->{rows}[$y]; 31 | } 32 | 33 | sub FETCHSIZE { 34 | my ( $self, $x ) = @_; 35 | return $self->{matrix}->surface->h; 36 | } 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/SDLx/Surface/TiedMatrixRow.pm: -------------------------------------------------------------------------------- 1 | package SDLx::Surface::TiedMatrixRow; 2 | use strict; 3 | use warnings; 4 | use base 'Tie::Array'; 5 | 6 | our $VERSION = 2.548; 7 | 8 | sub new { 9 | my $class = shift; 10 | my $matrix = shift; 11 | my $y = shift; 12 | 13 | my $self = { 14 | matrix => $matrix, 15 | y => $y, 16 | }; 17 | 18 | return bless $self, $class; 19 | } 20 | 21 | sub TIEARRAY { 22 | return SDLx::Surface::TiedMatrixRow->new( $_[1], $_[2] ); 23 | } 24 | 25 | sub FETCH { 26 | my ( $self, $x ) = @_; 27 | $self->{matrix}->get_pixel( $x, $self->{y} ); 28 | } 29 | 30 | sub FETCHSIZE { 31 | 32 | my ( $self, $x ) = @_; 33 | return $self->{matrix}->surface->w; 34 | 35 | } 36 | 37 | sub STORE { 38 | my ( $self, $x, $new_value ) = @_; 39 | $self->{matrix}->set_pixel( $x, $self->{y}, $new_value ); 40 | } 41 | 42 | 1; 43 | -------------------------------------------------------------------------------- /lib/SDLx/TTF.pm: -------------------------------------------------------------------------------- 1 | package SDLx::TTF; 2 | use strict; 3 | use warnings; 4 | use Carp; 5 | 6 | use SDL; 7 | use SDL::TTF; 8 | use SDL::TTF::Font; 9 | 10 | our $VERSION = 2.548; 11 | 12 | sub new 13 | { 14 | my ($class, $font) = @_; 15 | 16 | my $self = {}; 17 | 18 | unless ( SDL::Config->has('SDL_ttf') ) { 19 | Carp::cluck("SDL_ttf support has not been compiled"); 20 | } 21 | unless ( SDL::TTF::was_init() ) 22 | { 23 | Carp::cluck ("Cannot init TTF: " . SDL::get_error() ) unless SDL::TTF::init() == 0; 24 | $self->{inited} = 1; 25 | $self->{style} = { 26 | normal => TTF_STYLE_NORMAL, 27 | bold => TTF_STYLE_BOLD, 28 | italic => TTF_STYLE_ITALIC, 29 | underline => TTF_STYLE_UNDERLINE, 30 | strikethrough => TTF_STYLE_STRIKETHROUGH 31 | }; 32 | } 33 | 34 | my $ttf_font; 35 | unless ( $ttf_font = SDL::TTF::open_font($font, $size )) 36 | { 37 | 38 | Carp::cluck ("Cannot make a TTF font from location ($font) or size($size), due to: ". SDL::get_error ); 39 | 40 | } 41 | 42 | $self->{ttf_font} = $ttf_font; 43 | 44 | if ( $style && ( my $t_style = $self->{style}->{$style} ) ) 45 | { 46 | SDL::TTF::set_font_style($ttf_font, $t_style); 47 | } 48 | 49 | 50 | return bless $self, $class; 51 | 52 | } 53 | 54 | 55 | sub DESTROY { 56 | my $self = shift; 57 | SDL::TTF::quit if $self->{inited}; 58 | 59 | } 60 | 61 | 1; 62 | -------------------------------------------------------------------------------- /lib/SDLx/Validate.pm: -------------------------------------------------------------------------------- 1 | #Interal Module to validate SDLx types 2 | package SDLx::Validate; 3 | use strict; 4 | use warnings; 5 | use vars qw(@ISA @EXPORT @EXPORT_OK); 6 | require Exporter; 7 | require DynaLoader; 8 | our @ISA = qw(Exporter DynaLoader); 9 | 10 | $SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /Use of uninitialized value in subroutine entry/}; 11 | 12 | use Carp (); 13 | use Scalar::Util (); 14 | 15 | use SDL::Internal::Loader; 16 | internal_load_dlls(__PACKAGE__); 17 | 18 | our $VERSION = 2.548; 19 | 20 | sub surfacex { 21 | my ($arg) = @_; 22 | if ( Scalar::Util::blessed($arg)) { 23 | if ( $arg->isa("SDLx::Surface") ) { 24 | return $arg; 25 | } 26 | if( $arg->isa("SDL::Surface") ) { 27 | require SDLx::Surface; 28 | return SDLx::Surface->new( surface => $arg ); 29 | } 30 | } 31 | Carp::confess("Surface must be SDL::Surface or SDLx::Surface"); 32 | } 33 | 34 | sub color { 35 | require SDL::Color; 36 | return SDL::Color->new( @{ list_rgb(@_) } ); 37 | } 38 | 39 | bootstrap SDLx::Validate; 40 | 41 | 1; 42 | 43 | -------------------------------------------------------------------------------- /lib/pods/SDL/CDROM.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::CDROM -- SDL Bindings for the CDROM device 7 | 8 | =head1 CATEGORY 9 | 10 | Core, CDROM 11 | 12 | =head1 SYNOPSIS 13 | 14 | use SDL ':init'; 15 | use SDL::CDROM; 16 | 17 | SDL::init(SDL_INIT_CDROM); 18 | 19 | print SDL::CDROM::num_drives(); 20 | 21 | print SDL::CDROM::name(0); 22 | 23 | SDL::quit(); 24 | 25 | =head1 METHODS 26 | 27 | =head2 num_drives 28 | 29 | my $drives = SDL::CDROM::num_drives(); 30 | 31 | Returns number of drives available on the system 32 | 33 | =head2 name 34 | 35 | my $drive_name = SDL::CDROM::name($drive_num); 36 | 37 | Returns human readable name for CDROM device 38 | 39 | Examples: 40 | 41 | =over 42 | 43 | =item * 44 | 45 | '/dev/cdrom' 46 | 47 | =item * 48 | 49 | 'E:' 50 | 51 | =item * 52 | 53 | '/dev/disk/ide/1/master' 54 | 55 | =back 56 | 57 | =head1 See Also 58 | 59 | L, L 60 | 61 | =head1 AUTHORS 62 | 63 | See L. 64 | 65 | =cut 66 | -------------------------------------------------------------------------------- /lib/pods/SDL/CDTrack.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::CDTrack -- SDL Bindings for structure SDL_CDTrack 7 | 8 | =head1 CATEGORY 9 | 10 | Core, CDROM, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | use SDL; 15 | use SDL::CDROM; 16 | use SDL::CD ':status'; 17 | use SDL::CDTrack; 18 | 19 | SDL::init( SDL_INIT_CDROM ); 20 | 21 | my $drives = SDL::CDROM::num_drives(); 22 | 23 | if( $drives > 0 ) 24 | { 25 | my $CD = SDL::CD->new(0); #first drive's CD 26 | 27 | if($CD) 28 | { 29 | if( $CD->status != CD_TRAYEMPTY ) 30 | { 31 | my $track = SDL::CD->track(0); 32 | } 33 | } 34 | } 35 | 36 | =head1 CONSTANTS 37 | 38 | The constants are exported by default. You can avoid this by doing: 39 | 40 | use SDL::CDTrack (); 41 | 42 | and access them directly: 43 | 44 | SDL::CDTrack::SDL_AUDIO_TRACK; 45 | 46 | or by choosing the export tags below: 47 | 48 | Export tag: ':type' 49 | 50 | SDL_AUDIO_TRACK 51 | SDL_DATA_TRACK 52 | 53 | =head1 METHOD 54 | 55 | =head2 id 56 | 57 | $track->id() # 0-99 58 | 59 | Track number 60 | 61 | =head2 type 62 | 63 | $track->type() # SDL_AUDIO_TRACK or SDL_DATA_TRACK 64 | 65 | Type of track 66 | 67 | =head2 length 68 | 69 | $track->length() 70 | 71 | Length, in frames, of this track 72 | 73 | =head2 offset 74 | 75 | $track->offset() 76 | 77 | Frame offset to the beginning of this track 78 | 79 | =head1 SEE ALSO 80 | 81 | L, L 82 | 83 | =head1 AUTHORS 84 | 85 | See L. 86 | 87 | =cut 88 | -------------------------------------------------------------------------------- /lib/pods/SDL/Color.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Color - Format independent color description 7 | 8 | =head2 CATEGORY 9 | 10 | Core, Video, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | my $black = SDL::Color->new(0, 0, 0); 15 | my $color = SDL::Color->new(255, 0, 0); 16 | my $r = $color->r; # 255 17 | my $g = $color->g; # 0 18 | my $b = $color->b; # 0 19 | $color->g(255); 20 | $color->b(255); 21 | # $color is now white 22 | 23 | =head1 DESCRIPTION 24 | 25 | C describes a color in a format independent way. 26 | 27 | =head1 METHODS 28 | 29 | =head2 new 30 | 31 | my $color = SDL::Color->new(255, 0, 0); 32 | 33 | The constructor creates a new color with the specified red, green and blue values. 34 | 35 | =head2 r 36 | 37 | my $r = $color->r; 38 | $color->r(128); 39 | 40 | If passed a value, this method sets the red component of the color; 41 | if not, it returns the red component of the color. 42 | 43 | =head2 g 44 | 45 | my $g = $color->g; 46 | $color->g(128); 47 | 48 | If passed a value, this method sets the green component of the color; 49 | if not, it returns the green component of the color. 50 | 51 | =head2 b 52 | 53 | my $b = $color->b; 54 | $color->b(128); 55 | 56 | If passed a value, this method sets the blue component of the color; 57 | if not, it returns the blue component of the color. 58 | 59 | =head1 SEE ALSO 60 | 61 | L 62 | 63 | =head1 AUTHORS 64 | 65 | See L. 66 | 67 | 68 | =cut 69 | -------------------------------------------------------------------------------- /lib/pods/SDL/Cookbook.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | SDL::Cookbook 5 | 6 | =head2 CATEGORY 7 | 8 | Cookbook 9 | 10 | =head2 First Steps 11 | 12 | see L 13 | 14 | =head2 PDL with SDL 15 | 16 | Attaching a PDL piddle object to SDL. L 17 | 18 | =head2 POGL with SDL 19 | 20 | Starting an OpenGL app with SDLx::App. L 21 | 22 | Sending textures to Perl OpenGL. L 23 | 24 | =head1 AUTHORS 25 | 26 | See L. 27 | 28 | -------------------------------------------------------------------------------- /lib/pods/SDL/Credits.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Credits - Authors and contributors of the SDL Perl project 7 | 8 | =head1 CATEGORY 9 | 10 | Core 11 | 12 | =head1 The SDL Perl 2010 Development Team 13 | 14 | =head2 Core Developers 15 | 16 | See the L on our github repository. 17 | 18 | Also see L. 19 | 20 | =head2 Maintenance 21 | 22 | Please contact the following individuals regarding questions and problems with SDL Perl. 23 | 24 | Nick: FROGGS 25 | Name: Tobias Leich 26 | 27 | Nick: kthakore 28 | Name: Kartik Thakore 29 | 30 | They can be reached on the sdl-devel@perl.org mailing list and the #sdl channel on the irc.perl.org network. 31 | 32 | =cut 33 | -------------------------------------------------------------------------------- /lib/pods/SDL/Deprecated.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Deprecated - Log of Deprecated items per release 7 | 8 | =head1 CATEGORY 9 | 10 | Core 11 | 12 | =head1 RELEASES 13 | 14 | =head2 2.517 15 | 16 | Major changes to C. 17 | 18 | C is now C. Event handlers no longer end C on returning false. Call C explicitly instead. 19 | 20 | The first argument to move handlers is the step portion instead of C
. 21 | The second argument to move handlers, the C value, is now the third argument. 22 | 23 | C will limit apps to a framerate of 60 by default. 24 | 25 | =head2 2.513 26 | 27 | =over 28 | 29 | =item SDLx::App 30 | 31 | C is deprecated. 32 | 33 | =back 34 | 35 | =head2 2.502 36 | 37 | =over 38 | 39 | =item SDLx::App 40 | 41 | Now depends on L. To get the SDL::Surface, use C< ->surface() >. Alternatively L. 42 | 43 | =item SDLx::Surface 44 | 45 | C< get_display > is now called L. 46 | 47 | =item SDLx::Sprite::Animated 48 | 49 | Has drastically changed, and is still volatile. 50 | 51 | =back 52 | 53 | =head2 2.500 54 | 55 | =over 56 | 57 | =item SDL::App 58 | 59 | SDL::App has migrated to SDLx::App namespace. The reason for this is because it is an extension and not a 1:1 XS/Constant Module to the c library. 60 | 61 | =item SDL::Game::Rect 62 | 63 | SDL::Game::Rect has migrated to SDLx::Rect namespace. Same reasoning as above. 64 | 65 | =back 66 | 67 | =head1 AUTHORS 68 | 69 | See L. 70 | 71 | =cut 72 | -------------------------------------------------------------------------------- /lib/pods/SDL/GFX/BlitFunc.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | SDL::GFX::BlitFunc - blitting functions 5 | 6 | =head1 CATEGORY 7 | 8 | TODO, GFX 9 | 10 | =head1 METHODS 11 | 12 | =head1 AUTHORS 13 | 14 | See L. 15 | 16 | -------------------------------------------------------------------------------- /lib/pods/SDL/GFX/FPSManager.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | SDL::GFX::FPSManager - data structure used by SDL::GFX::Framerate 5 | 6 | =head1 CATEGORY 7 | 8 | GFX, Structure 9 | 10 | =head1 METHODS 11 | 12 | =head2 new 13 | 14 | use SDL; 15 | use SDL::GFX::Framerate; 16 | use SDL::GFX::FPSManager; 17 | 18 | my $fps = SDL::GFX::FPSManager->new(0, 0, 0, 0); 19 | 20 | Initialize the framerate manager object. Arguments: framecount, rateticks, lastticks, rate. 21 | 22 | =head2 framecount 23 | 24 | my $fc = $fps->framecount; 25 | 26 | Returns the C. 27 | 28 | =head2 rateticks 29 | 30 | my $rt = $fps->rateticks; 31 | 32 | Returns the C. 33 | 34 | =head2 lastticks 35 | 36 | my $lt = $fps->lastticks; 37 | 38 | Returns the C. 39 | 40 | =head2 rate 41 | 42 | my $r = $fps->rate; 43 | 44 | Returns the C. 45 | 46 | =head1 AUTHORS 47 | 48 | See L. 49 | 50 | -------------------------------------------------------------------------------- /lib/pods/SDL/GFX/Framerate.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | SDL::GFX::Framerate - framerate calculating functions 5 | 6 | =head1 CATEGORY 7 | 8 | GFX 9 | 10 | =head1 DESCRIPTION 11 | 12 | The framerate functions are used to insert delays into the graphics loop to maintain a constant framerate. 13 | 14 | =head1 METHODS 15 | 16 | =head2 init 17 | 18 | use SDL; 19 | use SDL::GFX::Framerate; 20 | use SDL::GFX::FPSManager; 21 | 22 | my $fps = SDL::GFX::FPSManager->new(0, 0, 0, 0); 23 | 24 | SDL::GFX::Framerate::init($fps); 25 | 26 | Initialize the framerate manager, set default framerate of 30Hz and reset delay interpolation. 27 | 28 | =head2 set 29 | 30 | SDL::GFX::Framerate::set($fps, 60); 31 | 32 | Sets the new desired framerate to 60 frames per second. 33 | 34 | =head2 get 35 | 36 | my $rate = SDL::GFX::Framerate::get($fps); 37 | 38 | Get the currently set framerate of the manager. 39 | 40 | =head2 delay 41 | 42 | SDL::GFX::Framerate::delay($fps); 43 | 44 | Generate a delay to accommodate the currently set framerate. Call once in the graphics/rendering loop. 45 | If the computer cannot keep up with the rate (i.e. drawing too slow), the delay is zero and the delay interpolation is reset. 46 | 47 | =head1 AUTHORS 48 | 49 | See L. 50 | 51 | -------------------------------------------------------------------------------- /lib/pods/SDL/MPEG.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::MPEG - a SDL perl extension 7 | 8 | =head1 CATEGORY 9 | 10 | TODO 11 | 12 | =head1 SYNOPSIS 13 | 14 | $info = SDL::MPEG->new( -from => $mpeg ); 15 | 16 | =head1 DESCRIPTION 17 | 18 | C provides an interface to querying the status 19 | of a SMPEG stream. 20 | 21 | =head2 METHODS 22 | 23 | =over 4 24 | 25 | =item * 26 | 27 | C returns true if it has audio track 28 | 29 | =item * 30 | 31 | C returns true if it has a video track 32 | 33 | =item * 34 | 35 | C returns the width of the video in pixels 36 | 37 | =item * 38 | 39 | C returns the height of the video in pixels 40 | 41 | =item * 42 | 43 | C returns the total size of the clip in bytes 44 | 45 | =item * 46 | 47 | C returns the offset into the clip in bytes 48 | 49 | =item * 50 | 51 | C returns the offset into the clip in frames 52 | 53 | =item * 54 | 55 | C returns the play rate in frames per second 56 | 57 | =item * 58 | 59 | C returns the current play time in seconds 60 | 61 | =item * 62 | 63 | C returns the total play time in seconds 64 | 65 | =back 66 | 67 | =head1 AUTHOR 68 | 69 | David J. Goehrig 70 | 71 | =head1 SEE ALSO 72 | 73 | perl(1) SDL::Video(3) 74 | 75 | =cut 76 | 77 | -------------------------------------------------------------------------------- /lib/pods/SDL/Mixer/MixChunk.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Mixer::MixChunk -- SDL Bindings for structure SDL_MixChunk 7 | 8 | =head1 CATEGORY 9 | 10 | Mixer, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | use SDL; 15 | use SDL::Mixer::MixChunk; 16 | 17 | my $mix_chunk = SDL::Mixer::Music::load_WAV('sample.wav'); 18 | 19 | printf("length of audio data is %d bytes\n", $mix_chunk->alen); 20 | printf("volume is %d\n", $mix_chunk->volume); 21 | 22 | =head1 DESCRIPTION 23 | 24 | Stores audio data in memory. 25 | 26 | B It's a bad idea to free a chunk that is still being played... 27 | 28 | =head1 METHODS 29 | 30 | =head2 alen 31 | 32 | length of audio data in bytes 33 | 34 | =head2 volume 35 | 36 | Per-sample volume, 0-128 (normally C after loading) 37 | 38 | =head1 AUTHORS 39 | 40 | See L. 41 | 42 | =cut 43 | -------------------------------------------------------------------------------- /lib/pods/SDL/Mixer/MixMusic.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Mixer::MixMusic - SDL Bindings for structure SDL_MixMusic 7 | 8 | =head1 CATEGORY 9 | 10 | Mixer, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | This structure is not directly usable. SDL Perl bindings handle the construction and destruction for you. 15 | 16 | =head1 AUTHORS 17 | 18 | See L. 19 | 20 | =cut 21 | -------------------------------------------------------------------------------- /lib/pods/SDL/MultiThread.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::MultiThread - Bindings to the MultiThread category in SDL API 7 | 8 | =head2 CATEGORY 9 | 10 | TODO, Core, MultiThread 11 | 12 | =head1 SYNOPSIS 13 | 14 | This module is not an object. 15 | 16 | =head1 AUTHORS 17 | 18 | See L. 19 | 20 | =cut 21 | -------------------------------------------------------------------------------- /lib/pods/SDL/Palette.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Palette -- Color palette for 8-bit pixel formats 7 | 8 | =head1 CATEGORY 9 | 10 | Core, Video, Structure 11 | 12 | =head1 DESCRIPTION 13 | 14 | Each pixel in an 8-bit surface is an index into the colors field of the C object stored in its C. 15 | A C is created automatically when SDL allocates a C for a surface. 16 | This class has methods for returning the colors in a palette object. 17 | The colors can be set with L and L. 18 | 19 | =head1 METHODS 20 | 21 | =head2 ncolors 22 | 23 | $ncolors = $palette->ncolors(); 24 | 25 | Returns the number of colors in palette. 26 | 27 | =head2 colors 28 | 29 | @colors = @{ $palette->colors() }; 30 | 31 | Returns an array, C in length, of the Ls in the palette. 32 | 33 | =head2 color_index 34 | 35 | $color = $palette->color_index( $index ); 36 | 37 | Returns the L at the provided index of the palette. 38 | 39 | =head1 SEE ALSO 40 | 41 | L L L L 42 | 43 | =head1 AUTHORS 44 | 45 | See L. 46 | 47 | =cut 48 | -------------------------------------------------------------------------------- /lib/pods/SDL/Pango/Context.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Pango::Context - Context object for SDL::Pango 7 | 8 | =head1 CATEGORY 9 | 10 | Pango, Structure 11 | 12 | =head1 METHODS 13 | 14 | =head2 new 15 | 16 | my $context = SDL::Pango::Context->new; 17 | 18 | Creates a new SDL::Pango context object. See L. 19 | 20 | =head1 AUTHORS 21 | 22 | See L. 23 | 24 | =head1 SEE ALSO 25 | 26 | L, L, L, L 27 | 28 | =cut 29 | -------------------------------------------------------------------------------- /lib/pods/SDL/Rect.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Rect - Defines a rectangular area 7 | 8 | =head2 CATEGORY 9 | 10 | Core, Video, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | my $rect = SDL::Rect->new(0, 0, 50, 4); 15 | $rect->x(1); 16 | $rect->y(2); 17 | $rect->w(3); 18 | my $x = $rect->x; # 1 19 | my $y = $rect->y; # 2 20 | my $w = $rect->w; # 3 21 | my $h = $rect->h; # 4 22 | 23 | =head1 DESCRIPTION 24 | 25 | An C defines a rectangular area of pixels. 26 | 27 | =head1 METHODS 28 | 29 | =head2 new 30 | 31 | my $rect = SDL::Rect->new( $x, $y, $w, $h ); 32 | 33 | The constructor creates a new rectangle with the specified x, y, width and height values. 34 | 35 | =head2 x 36 | 37 | my $x = $rect->x; 38 | $rect->x(128); 39 | 40 | If passed a value, this method sets the x component of the rectangle; 41 | if not, it returns the x component of the rectangle. 42 | 43 | =head2 y 44 | 45 | my $y = $rect->y; 46 | $rect->y(128); 47 | 48 | If passed a value, this method sets the y component of the rectangle; 49 | if not, it returns the y component of the rectangle. 50 | 51 | =head2 w 52 | 53 | my $w = $rect->w; 54 | $rect->w(128); 55 | 56 | If passed a value, this method sets the w component of the rectangle; 57 | if not, it returns the w component of the rectangle. 58 | 59 | =head2 h 60 | 61 | my $h = $rect->h; 62 | $rect->h(128); 63 | 64 | If passed a value, this method sets the h component of the rectangle; 65 | if not, it returns the h component of the rectangle. 66 | 67 | =head1 SEE ALSO 68 | 69 | L 70 | 71 | =head1 AUTHORS 72 | 73 | See L. 74 | 75 | =cut 76 | -------------------------------------------------------------------------------- /lib/pods/SDL/TTF/Font.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::TTF::Font - Font object type for SDL_ttf 7 | 8 | =head1 CATEGORY 9 | 10 | TTF, Structure 11 | 12 | =head1 METHODS 13 | 14 | =head1 CONSTRUCTOR 15 | 16 | my $font = SDL::TTF::Font->new($font_file, $point_size); 17 | 18 | my $font = SDL::TTF::Font->new($font_file, $point_size, $face_index); 19 | 20 | Load file for use as a font, at the given size. This can load TTF, OTF and 21 | FON files. You can specify the face index of a font file containing multiple 22 | faces. 23 | 24 | Returns: a L object. C is returned on errors. 25 | 26 | Example: 27 | 28 | use SDL::TTF::Font; 29 | 30 | my $font = SDL::TTF::Font->new('arial.ttf', 24); 31 | 32 | =head1 AUTHORS 33 | 34 | See L. 35 | 36 | =head1 SEE ALSO 37 | 38 | L 39 | 40 | =cut 41 | -------------------------------------------------------------------------------- /lib/pods/SDL/Tutorial/Animation.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/lib/pods/SDL/Tutorial/Animation.jpg -------------------------------------------------------------------------------- /lib/pods/SDL/Tutorial/Images_1.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/lib/pods/SDL/Tutorial/Images_1.jpg -------------------------------------------------------------------------------- /lib/pods/SDL/Tutorial/Images_2.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/lib/pods/SDL/Tutorial/Images_2.jpg -------------------------------------------------------------------------------- /lib/pods/SDL/Version.pod: -------------------------------------------------------------------------------- 1 | 2 | =pod 3 | 4 | =head1 NAME 5 | 6 | SDL::Version - SDL Bindings for structure SDL_Version 7 | 8 | =head1 CATEGORY 9 | 10 | Core, Structure 11 | 12 | =head1 SYNOPSIS 13 | 14 | use SDL; 15 | use SDL::Version; 16 | 17 | # print compile-time version 18 | printf("SDL::version is %d.%d.%d\n", SDL::version->major, 19 | SDL::version->minor, 20 | SDL::version->patch); 21 | 22 | # print linked version 23 | printf("SDL::linked_version is %d.%d.%d\n", SDL::linked_version->major, 24 | SDL::linked_version->minor, 25 | SDL::linked_version->patch); 26 | 27 | =head1 DESCRIPTION 28 | 29 | The C structure is used by the C function and the C macro. 30 | The C function returns the link-time SDL version whereas C returns the compile-time SDL version. 31 | B This is the SDL version, not the SDL_Perl version. 32 | The SDL_Perl version is in C<$SDL::VERSION>. 33 | 34 | =head1 METHODS 35 | 36 | =head2 major 37 | 38 | Returns the major version number. 39 | 40 | =head2 minor 41 | 42 | Returns the minor version number. 43 | 44 | =head2 patch 45 | 46 | Returns the patch version number. 47 | 48 | =head1 AUTHORS 49 | 50 | See L. 51 | 52 | =cut 53 | -------------------------------------------------------------------------------- /lib/pods/SDLx/SFont.pod: -------------------------------------------------------------------------------- 1 | 2 | =head1 NAME 3 | 4 | SDLx::SFont - Extension making fonts out of images and printing them 5 | 6 | =head1 CATEGORY 7 | 8 | Extension 9 | 10 | =head1 SYNOPSIS 11 | 12 | use SDLx::SFont; 13 | use SDLx::App; 14 | 15 | #Make a surface 16 | #Select a font 17 | my $d = SDLx::App->new( title => 'app', width => 200, height => 200, depth => 32 ); 18 | 19 | my $font = SDLx::SFont->new('t/font.png'); 20 | 21 | #print using $font 22 | 23 | SDLx::SFont::print_text( $d, 10, 10, 'Huh' ); 24 | 25 | my $font2 = SDLx::SFont->new('t/font2.png'); 26 | 27 | #print using font2 28 | 29 | SDLx::SFont::print_text( $d, 10, 10, 'Huh' ); 30 | 31 | $font->use(); 32 | 33 | #print using $font 34 | 35 | SDLx::SFont::print_text( $d, 10, 10, 'Huh' ); 36 | 37 | #that is it folks .. 38 | 39 | =head1 DESCRIPTION 40 | 41 | a simpler print function for old SDL::SFont dependency on Frozen-Bubble and Pangzero. 42 | 43 | =head1 USAGE 44 | 45 | see synopsis 46 | 47 | =head1 BUGS 48 | 49 | You tell me! at sdlperl.ath.cx 50 | 51 | =head1 SUPPORT 52 | 53 | #sdl irc.perl.org 54 | 55 | =head1 AUTHORS 56 | 57 | See L. 58 | 59 | =head1 COPYRIGHT 60 | 61 | This program is free software; you can redistribute 62 | it and/or modify it under the same terms as Perl itself. 63 | 64 | The full text of the license can be found in the 65 | LICENSE file included with this module. 66 | 67 | 68 | =head1 SEE ALSO 69 | 70 | perl(1), SDL(2). 71 | 72 | =cut 73 | 74 | -------------------------------------------------------------------------------- /logo/sdl_perl_logo_large.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/logo/sdl_perl_logo_large.png -------------------------------------------------------------------------------- /logo/sdl_perl_logo_small.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/logo/sdl_perl_logo_small.png -------------------------------------------------------------------------------- /scripts/MultiThreadPOC.pl: -------------------------------------------------------------------------------- 1 | use Inline C => DATA => LIBS => `sdl-config --libs` => INC => `sdl-config --cflags`; 2 | 3 | my $fp = get_function_pointer(); 4 | print '[Perl] In perl we got :' . $fp . "\n"; 5 | print '[Perl] Making Thread.'; 6 | 7 | make_thread( get_function_pointer(), 'I AM THE OVERLOARD XENU!!!' ); 8 | 9 | __END__ 10 | __C__ 11 | 12 | #include 13 | #include 14 | 15 | char DoIt(char* c){ 16 | int threadID = SDL_ThreadID(); 17 | printf("[C-Thread] we are in %d \n", &threadID); 18 | printf("[C-Thread] Called with %s \n", c); 19 | return c; 20 | } 21 | 22 | int get_function_pointer() { 23 | printf("[C] Function Pointer is at %d!\n", &DoIt); 24 | return PTR2IV(&DoIt); 25 | } 26 | 27 | 28 | int make_thread(IV pointer, char* c) 29 | { 30 | void * fp = INT2PTR( void *, pointer); 31 | void * data = c; 32 | SDL_CreateThread( fp, data ); 33 | printf("[C] Created thread: \n"); 34 | } 35 | 36 | -------------------------------------------------------------------------------- /scripts/README: -------------------------------------------------------------------------------- 1 | README 2 | 3 | I couldn't get the scripts to work at all, so I added const.pl and uses this 4 | to generate the scripts. const.pl is also responsible for making the constant 5 | exporting backwards-compatible to SDL_perl 1.x. 6 | 7 | Tels 2003/03/21 8 | 9 | This directory contains a set of scripts for generating the 10 | SDL::Constants and SDL::OpenGL::Constants modules. They 11 | work by using the C preprocessor and gcc to extract defined 12 | values and enumerated field's numerical values and create 13 | constant subroutines that are exported into the main namespace. 14 | 15 | To add a new constant, simply add the name of the constant 16 | to the *_words.txt file and run the applicable script. 17 | This will overwrite the lib/SDL/* file in question. 18 | 19 | Dave Tue Mar 11 21:58:03 EST 2003 20 | -------------------------------------------------------------------------------- /scripts/gl_const.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | 4 | open XS, "< opengl_words.txt"; 5 | open CPP, "| cpp - > OpenGL.cx"; 6 | 7 | print CPP < 9 | #include 10 | 11 | --cut-- 12 | HEADER 13 | 14 | while () { 15 | chomp(); 16 | print CPP "#$_ $_\n"; 17 | $words{$_} = 0; 18 | } 19 | 20 | close XS; 21 | close CPP; 22 | 23 | my $text; 24 | open FP, "< OpenGL.cx" 25 | or die "Couldn't open OpenGL.cx\n"; 26 | { 27 | local $/ = undef; 28 | $text = ; 29 | } 30 | 31 | my ( $junk, $goodstuff ) = split "--cut--", $text; 32 | 33 | $goodstuff =~ s/#(GL[U]?_[A-Z0-9_]+)\s+([0-9xa-fA-F]+)/sub main::$1 { $2 }/g; 34 | 35 | for ( split "\n", $goodstuff ) { 36 | if (/sub main::(GL[U]?_[A-Z0-9_]+)/) { 37 | push @words, $1; 38 | } 39 | } 40 | 41 | for (@words) { 42 | $words{$_} = 1; 43 | } 44 | 45 | for ( keys %words ) { 46 | print STDERR "Failed to find word $_" unless ( $words{$_} ); 47 | } 48 | 49 | open OGL, "> ../lib/SDL/OpenGL/Constants.pm"; 50 | 51 | $words = join( " ", @words ); 52 | 53 | print OGL < 60 | 61 | package SDL::OpenGL::Constants; 62 | 63 | $goodstuff 64 | 65 | 1; 66 | 67 | HERE 68 | 69 | system("rm OpenGL.cx"); 70 | -------------------------------------------------------------------------------- /scripts/sdl_module_maker.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 'lib'; 4 | use Module::Build::SDL; 5 | 6 | Module::Build::SDL::generate_sdl_module( @ARGV ); 7 | 8 | -------------------------------------------------------------------------------- /share/GenBasR.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/share/GenBasR.ttf -------------------------------------------------------------------------------- /src/Core/CDROM.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::CDROM PACKAGE = SDL::CDROM PREFIX = cd_ 13 | 14 | int 15 | cd_num_drives() 16 | CODE: 17 | RETVAL = SDL_CDNumDrives(); 18 | OUTPUT: 19 | RETVAL 20 | 21 | char * 22 | cd_name( drive ) 23 | int drive 24 | CODE: 25 | RETVAL = strdup(SDL_CDName(drive)); 26 | OUTPUT: 27 | RETVAL 28 | 29 | 30 | -------------------------------------------------------------------------------- /src/Core/Mouse.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::Mouse PACKAGE = SDL::Mouse PREFIX = mouse_ 13 | 14 | void 15 | mouse_warp_mouse ( x, y ) 16 | Uint16 x 17 | Uint16 y 18 | CODE: 19 | SDL_WarpMouse(x,y); 20 | 21 | void 22 | mouse_set_cursor ( cursor ) 23 | SDL_Cursor *cursor 24 | CODE: 25 | SDL_SetCursor(cursor); 26 | 27 | SDL_Cursor * 28 | mouse_get_cursor () 29 | PREINIT: 30 | char* CLASS = "SDL::Cursor"; 31 | CODE: 32 | RETVAL = SDL_GetCursor(); 33 | OUTPUT: 34 | RETVAL 35 | 36 | int 37 | mouse_show_cursor ( toggle ) 38 | int toggle 39 | CODE: 40 | RETVAL = SDL_ShowCursor(toggle); 41 | OUTPUT: 42 | RETVAL 43 | 44 | 45 | 46 | -------------------------------------------------------------------------------- /src/Core/MultiThread.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | #include 12 | 13 | MODULE = SDL::MultiThread PACKAGE = SDL::MultiThread PREFIX = multi_ 14 | 15 | =for documentation 16 | 17 | The Following are XS bindings to the MultiThread category in the SDL API v2.1.13 18 | 19 | Describe on the SDL API site. 20 | 21 | See: L */ 22 | 23 | =cut 24 | 25 | Uint32 26 | multi_threadID() 27 | CODE: 28 | warn(" ... " ); 29 | -------------------------------------------------------------------------------- /src/Core/Time.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "defines.h" 6 | 7 | #include 8 | 9 | Uint32 add_timer_cb (Uint32 interval, void* param ) 10 | { 11 | Uint32 ret_interval; 12 | ENTER_TLS_CONTEXT; 13 | dSP; 14 | 15 | int count; 16 | 17 | ENTER; 18 | SAVETMPS; 19 | PUSHMARK(SP); 20 | XPUSHs(sv_2mortal(newSViv(interval))); 21 | PUTBACK; 22 | 23 | count = call_pv(param,G_SCALAR); 24 | 25 | SPAGAIN; 26 | 27 | if (count != 1 ) croak("callback returned more than 1 value\n"); 28 | ret_interval = POPi; 29 | 30 | PUTBACK; 31 | FREETMPS; 32 | LEAVE; 33 | LEAVE_TLS_CONTEXT; 34 | 35 | return ret_interval; 36 | } 37 | 38 | MODULE = SDL::Time PACKAGE = SDL::Time PREFIX = time_ 39 | 40 | SDL_TimerID 41 | time_add_timer ( interval, cmd ) 42 | Uint32 interval 43 | char *cmd 44 | CODE: 45 | GET_TLS_CONTEXT; 46 | RETVAL = SDL_AddTimer(interval, add_timer_cb, (void *)cmd); 47 | OUTPUT: 48 | RETVAL 49 | 50 | int 51 | time_remove_timer ( id) 52 | SDL_TimerID id 53 | CODE: 54 | RETVAL = SDL_RemoveTimer((SDL_TimerID) id); 55 | OUTPUT: 56 | RETVAL 57 | 58 | -------------------------------------------------------------------------------- /src/Core/objects/CDTrack.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::CDTrack PACKAGE = SDL::CDTrack PREFIX = cdt_ 13 | 14 | Uint8 15 | cdt_id( track ) 16 | SDL_CDtrack *track 17 | CODE: 18 | RETVAL = track->id; 19 | OUTPUT: 20 | RETVAL 21 | 22 | Uint8 23 | cdt_type( track ) 24 | SDL_CDtrack *track 25 | CODE: 26 | RETVAL = track->type; 27 | OUTPUT: 28 | RETVAL 29 | 30 | Uint16 31 | cdt_length( track ) 32 | SDL_CDtrack *track 33 | CODE: 34 | RETVAL = track->length; 35 | OUTPUT: 36 | RETVAL 37 | 38 | Uint32 39 | cdt_offset( track ) 40 | SDL_CDtrack *track 41 | CODE: 42 | RETVAL = track->offset; 43 | OUTPUT: 44 | RETVAL 45 | -------------------------------------------------------------------------------- /src/Core/objects/Color.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #ifndef aTHX_ 8 | #define aTHX_ 9 | #endif 10 | 11 | #include 12 | 13 | MODULE = SDL::Color PACKAGE = SDL::Color PREFIX = color_ 14 | 15 | =for documentation 16 | 17 | SDL_Color -- Format independent color description 18 | 19 | typedef struct{ 20 | Uint8 r; 21 | Uint8 g; 22 | Uint8 b; 23 | Uint8 unused; 24 | } SDL_Color; 25 | 26 | =cut 27 | 28 | SDL_Color * 29 | color_new (CLASS, r, g, b ) 30 | char* CLASS 31 | Uint8 r 32 | Uint8 g 33 | Uint8 b 34 | CODE: 35 | RETVAL = (SDL_Color *) safemalloc(sizeof(SDL_Color)); 36 | RETVAL->r = r; 37 | RETVAL->g = g; 38 | RETVAL->b = b; 39 | OUTPUT: 40 | RETVAL 41 | 42 | Uint8 43 | color_r ( color, ... ) 44 | SDL_Color *color 45 | CODE: 46 | if (items > 1 ) color->r = SvIV(ST(1)); 47 | RETVAL = color->r; 48 | OUTPUT: 49 | RETVAL 50 | 51 | Uint8 52 | color_g ( color, ... ) 53 | SDL_Color *color 54 | CODE: 55 | if (items > 1 ) color->g = SvIV(ST(1)); 56 | RETVAL = color->g; 57 | OUTPUT: 58 | RETVAL 59 | 60 | Uint8 61 | color_b ( color, ... ) 62 | SDL_Color *color 63 | CODE: 64 | if (items > 1 ) color->b = SvIV(ST(1)); 65 | RETVAL = color->b; 66 | OUTPUT: 67 | RETVAL 68 | 69 | void 70 | color_DESTROY ( bag ) 71 | SV *bag 72 | CODE: 73 | objDESTROY(bag, safefree); 74 | -------------------------------------------------------------------------------- /src/Core/objects/Cursor.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::Cursor PACKAGE = SDL::Cursor PREFIX = cursor_ 13 | 14 | =for documentation 15 | 16 | SDL_Cursor -- Cursor object 17 | 18 | =cut 19 | 20 | SDL_Cursor * 21 | cursor_new(CLASS, data, mask, w, h, x ,y ) 22 | char* CLASS 23 | AV* data 24 | AV* mask 25 | int w 26 | int h 27 | int x 28 | int y 29 | CODE: 30 | int len = av_len(data); 31 | Uint8 *_data = (Uint8 *)safemalloc(sizeof(Uint8)*(len)); 32 | Uint8 *_mask = (Uint8 *)safemalloc(sizeof(Uint8)*(len)); 33 | int i; 34 | for ( i = 0; i < len + 1; i++ ) 35 | { 36 | SV ** temp1 = av_fetch(data,i,0); 37 | SV ** temp2 = av_fetch(mask,i,0); 38 | if( temp1 != NULL) 39 | { 40 | _data[i] = (Uint8)SvIV( *temp1 ); 41 | } 42 | else 43 | { 44 | _data[i] = 0; 45 | } 46 | 47 | if( temp2 != NULL) 48 | { 49 | _mask[i] = (Uint8)SvIV( *temp2 ); 50 | } 51 | else 52 | { 53 | _mask[i] = 0; 54 | } 55 | } 56 | 57 | RETVAL = SDL_CreateCursor(_data, _mask, w, h, x, y); 58 | safefree(_data); 59 | safefree(_mask); 60 | OUTPUT: 61 | RETVAL 62 | 63 | void 64 | cursor_DESTROY(self) 65 | SDL_Cursor *self 66 | CODE: 67 | SDL_FreeCursor(self); 68 | -------------------------------------------------------------------------------- /src/Core/objects/Overlay.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::Overlay PACKAGE = SDL::Overlay PREFIX = overlay_ 13 | 14 | =for documentation 15 | 16 | SDL_Overlay -- YUV video overlay 17 | 18 | typedef struct{ 19 | Uint32 format; 20 | int w, h; 21 | int planes; 22 | Uint16 *pitches; 23 | Uint8 **pixels; 24 | Uint32 hw_overlay:1; 25 | } SDL_Overlay; 26 | 27 | 28 | =cut 29 | 30 | SDL_Overlay * 31 | overlay_new(CLASS, width, height, format, display) 32 | char* CLASS 33 | int width 34 | int height 35 | Uint32 format 36 | SDL_Surface *display; 37 | CODE: 38 | RETVAL = SDL_CreateYUVOverlay(width, height, format, display); 39 | OUTPUT: 40 | RETVAL 41 | 42 | int 43 | overlay_w( overlay ) 44 | SDL_Overlay* overlay 45 | CODE: 46 | RETVAL = overlay->w; 47 | OUTPUT: 48 | RETVAL 49 | 50 | int 51 | overlay_h( overlay ) 52 | SDL_Overlay* overlay 53 | CODE: 54 | RETVAL = overlay->h; 55 | OUTPUT: 56 | RETVAL 57 | 58 | int 59 | overlay_planes( overlay ) 60 | SDL_Overlay* overlay 61 | CODE: 62 | RETVAL = overlay->planes; 63 | OUTPUT: 64 | RETVAL 65 | 66 | Uint32 67 | overlay_hwoverlay( overlay ) 68 | SDL_Overlay* overlay 69 | CODE: 70 | RETVAL = overlay->hw_overlay; 71 | OUTPUT: 72 | RETVAL 73 | 74 | Uint32 75 | overlay_format( overlay ) 76 | SDL_Overlay* overlay 77 | CODE: 78 | RETVAL = overlay->format; 79 | OUTPUT: 80 | RETVAL 81 | 82 | 83 | void 84 | overlay_DESTROY(overlay) 85 | SDL_Overlay *overlay 86 | CODE: 87 | SDL_FreeYUVOverlay(overlay); 88 | -------------------------------------------------------------------------------- /src/Core/objects/Palette.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #ifndef aTHX_ 8 | #define aTHX_ 9 | #endif 10 | 11 | #include 12 | 13 | MODULE = SDL::Palette PACKAGE = SDL::Palette PREFIX = palette_ 14 | 15 | =for documentation 16 | 17 | SDL_Palette -- Color palette for 8-bit pixel formats 18 | 19 | typedef struct{ 20 | int ncolors; 21 | SDL_Color *colors 22 | } SDL_Palette; 23 | 24 | =cut 25 | 26 | int 27 | palette_ncolors ( palette ) 28 | SDL_Palette *palette 29 | CODE: 30 | RETVAL = palette->ncolors; 31 | OUTPUT: 32 | RETVAL 33 | 34 | AV * 35 | palette_colors ( palette ) 36 | SDL_Palette *palette 37 | CODE: 38 | RETVAL = (AV*)sv_2mortal((SV*)newAV()); 39 | int i; 40 | for(i = 0; i < palette->ncolors; i++) 41 | av_push( RETVAL, cpy2bag( (SDL_Color *)(palette->colors + i), sizeof(SDL_Color *), sizeof(SDL_Color), "SDL::Color" ) ); 42 | OUTPUT: 43 | RETVAL 44 | 45 | SV * 46 | palette_color_index ( palette, index ) 47 | SDL_Palette *palette 48 | int index 49 | PREINIT: 50 | char * CLASS = "SDL::Color"; 51 | CODE: 52 | RETVAL = cpy2bag( (SDL_Color *)(palette->colors + index), sizeof(SDL_Color *), sizeof(SDL_Color), "SDL::Color" ); 53 | OUTPUT: 54 | RETVAL 55 | 56 | void 57 | palette_DESTROY ( bag ) 58 | SV *bag 59 | CODE: 60 | objDESTROY(bag, safefree); 61 | -------------------------------------------------------------------------------- /src/Core/objects/Rect.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #ifndef aTHX_ 8 | #define aTHX_ 9 | #endif 10 | 11 | #include 12 | 13 | MODULE = SDL::Rect PACKAGE = SDL::Rect PREFIX = rect_ 14 | 15 | =for documentation 16 | 17 | SDL_Rect -- Defines a rectangular area 18 | 19 | typedef struct{ 20 | Sint16 x, y; 21 | Uint16 w, h; 22 | } SDL_Rect; 23 | 24 | =cut 25 | 26 | SDL_Rect * 27 | rect_new (CLASS, x, y, w, h) 28 | char* CLASS 29 | Sint16 x 30 | Sint16 y 31 | Uint16 w 32 | Uint16 h 33 | CODE: 34 | RETVAL = (SDL_Rect *) safemalloc (sizeof(SDL_Rect)); 35 | RETVAL->x = x; 36 | RETVAL->y = y; 37 | RETVAL->w = w; 38 | RETVAL->h = h; 39 | OUTPUT: 40 | RETVAL 41 | 42 | Sint16 43 | rect_x ( rect, ... ) 44 | SDL_Rect *rect 45 | CODE: 46 | if (items > 1 ) rect->x = SvIV(ST(1)); 47 | RETVAL = rect->x; 48 | OUTPUT: 49 | RETVAL 50 | 51 | Sint16 52 | rect_y ( rect, ... ) 53 | SDL_Rect *rect 54 | CODE: 55 | if (items > 1 ) rect->y = SvIV(ST(1)); 56 | RETVAL = rect->y; 57 | OUTPUT: 58 | RETVAL 59 | 60 | Uint16 61 | rect_w ( rect, ... ) 62 | SDL_Rect *rect 63 | CODE: 64 | if (items > 1 ) rect->w = SvIV(ST(1)); 65 | RETVAL = rect->w; 66 | OUTPUT: 67 | RETVAL 68 | 69 | Uint16 70 | rect_h ( rect, ... ) 71 | SDL_Rect *rect 72 | CODE: 73 | if (items > 1 ) rect->h = SvIV(ST(1)); 74 | RETVAL = rect->h; 75 | OUTPUT: 76 | RETVAL 77 | 78 | 79 | void 80 | rect_DESTROY(bag) 81 | SV *bag 82 | CODE: 83 | objDESTROY(bag, safefree); 84 | -------------------------------------------------------------------------------- /src/Core/objects/Version.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #ifndef aTHX_ 8 | #define aTHX_ 9 | #endif 10 | 11 | #include 12 | #include 13 | 14 | MODULE = SDL::Version PACKAGE = SDL::Version PREFIX = version_ 15 | 16 | =for documentation 17 | 18 | SDL_Version -- Version structure 19 | 20 | typedef struct SDL_version { 21 | Uint8 major; 22 | Uint8 minor; 23 | Uint8 patch; 24 | } SDL_version; 25 | 26 | =cut 27 | 28 | SDL_version * 29 | version_new( CLASS ) 30 | char* CLASS 31 | CODE: 32 | RETVAL = safemalloc( sizeof( SDL_version) ); 33 | OUTPUT: 34 | RETVAL 35 | 36 | 37 | Uint8 38 | version_major ( version, ... ) 39 | SDL_version *version 40 | CODE: 41 | RETVAL = version->major; 42 | OUTPUT: 43 | RETVAL 44 | 45 | Uint8 46 | version_minor ( version, ... ) 47 | SDL_version *version 48 | CODE: 49 | RETVAL = version->minor; 50 | OUTPUT: 51 | RETVAL 52 | 53 | Uint8 54 | version_patch ( version, ... ) 55 | SDL_version *version 56 | CODE: 57 | RETVAL = version->patch; 58 | OUTPUT: 59 | RETVAL 60 | 61 | void 62 | version_DESTROY ( bag ) 63 | SV *bag 64 | CODE: 65 | objDESTROY(bag, safefree); 66 | -------------------------------------------------------------------------------- /src/Core/objects/keysym.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | MODULE = SDL::keysym PACKAGE = SDL::keysym PREFIX = keysym_ 13 | 14 | =for documentation 15 | 16 | SDL_keysym -- keysym structure 17 | 18 | typedef struct{ 19 | Uint8 scancode; 20 | SDLKey sym; 21 | SDLMod mod; 22 | Uint16 unicode; 23 | } SDL_keysym; 24 | 25 | 26 | =cut 27 | 28 | SDL_keysym * 29 | keysym_new ( CLASS ) 30 | char* CLASS 31 | CODE: 32 | RETVAL = safemalloc(sizeof(SDL_keysym)); 33 | OUTPUT: 34 | RETVAL 35 | 36 | Uint8 37 | keysym_scancode ( keysym, ... ) 38 | SDL_keysym *keysym 39 | CODE: 40 | if( items > 1 ) 41 | { 42 | keysym->scancode = SvIV( ST(1) ); 43 | } 44 | 45 | RETVAL = keysym->scancode; 46 | OUTPUT: 47 | RETVAL 48 | 49 | SDLKey * 50 | keysym_sym ( keysym, ... ) 51 | SDL_keysym *keysym 52 | PREINIT: 53 | char* CLASS = "SDL::Key"; 54 | CODE: 55 | if( items > 1 ) 56 | { 57 | SDLKey *kp = (SDLKey * )SvPV( ST(1), PL_na) ; 58 | keysym->sym = *kp; 59 | } 60 | 61 | RETVAL = &(keysym->sym); 62 | OUTPUT: 63 | RETVAL 64 | 65 | SDLMod * 66 | keysym_mod ( keysym, ... ) 67 | SDL_keysym *keysym 68 | PREINIT: 69 | char* CLASS = "SDL::Mod"; 70 | CODE: 71 | if( items > 1 ) 72 | { 73 | SDLMod *mp = (SDLMod * )SvPV( ST(1), PL_na) ; 74 | keysym->mod = *mp; 75 | } 76 | 77 | RETVAL = &(keysym->mod); 78 | OUTPUT: 79 | RETVAL 80 | 81 | Uint16 82 | keysym_unicode ( keysym, ... ) 83 | SDL_keysym *keysym 84 | CODE: 85 | if( items > 1 ) 86 | { 87 | keysym->unicode = SvIV( ST(1) ); 88 | } 89 | 90 | RETVAL = keysym->unicode; 91 | OUTPUT: 92 | RETVAL 93 | 94 | void 95 | keysym_DESTROY(self) 96 | SDL_keysym *self 97 | CODE: 98 | safefree( (char *)self ); 99 | -------------------------------------------------------------------------------- /src/Core/objects/typemap: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/src/Core/objects/typemap -------------------------------------------------------------------------------- /src/GFX/BlitFunc.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | #ifdef HAVE_SDL_GFX_BLITFUNC 13 | #include 14 | #endif 15 | 16 | MODULE = SDL::GFX::BlitFunc PACKAGE = SDL::GFX::BlitFunc PREFIX = gfx_blit_ 17 | 18 | =for documentation 19 | 20 | The Following are XS bindings to the SDL_gfx Library 21 | 22 | Described here: 23 | 24 | See: L 25 | 26 | =cut 27 | 28 | #ifdef HAVE_SDL_GFX_BLITFUNC 29 | 30 | #endif 31 | -------------------------------------------------------------------------------- /src/GFX/Framerate.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | #ifdef HAVE_SDL_GFX_FRAMERATE 13 | #include 14 | #endif 15 | 16 | MODULE = SDL::GFX::Framerate PACKAGE = SDL::GFX::Framerate PREFIX = gfx_frame_ 17 | 18 | =for documentation 19 | 20 | The Following are XS bindings to the SDL_gfx Library 21 | 22 | Described here: 23 | 24 | See: L */ 25 | 26 | =cut 27 | 28 | #ifdef HAVE_SDL_GFX_FRAMERATE 29 | 30 | void 31 | gfx_frame_init(manager) 32 | FPSmanager * manager 33 | CODE: 34 | SDL_initFramerate(manager); 35 | 36 | int 37 | gfx_frame_set(manager, rate) 38 | FPSmanager * manager 39 | int rate 40 | CODE: 41 | RETVAL = SDL_setFramerate(manager, rate); 42 | OUTPUT: 43 | RETVAL 44 | 45 | int 46 | gfx_frame_get(manager) 47 | FPSmanager * manager 48 | CODE: 49 | RETVAL = SDL_getFramerate(manager); 50 | OUTPUT: 51 | RETVAL 52 | 53 | void 54 | gfx_frame_delay(manager) 55 | FPSmanager * manager 56 | CODE: 57 | SDL_framerateDelay(manager); 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /src/GFX/GFX.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | 5 | #include 6 | #ifdef HAVE_SDL_GFX_PRIMITIVES 7 | #include 8 | #endif 9 | SDL_version *linked_version = NULL; 10 | 11 | 12 | #ifndef SDL_GFXPRIMITIVES_MAJOR 13 | #define SDL_GFXPRIMITIVES_MAJOR 0 14 | #endif 15 | 16 | #ifndef SDL_GFXPRIMITIVES_MINOR 17 | #define SDL_GFXPRIMITIVES_MINOR 0 18 | #endif 19 | 20 | #ifndef SDL_GFXPRIMITIVES_MICRO 21 | #define SDL_GFXPRIMITIVES_MICRO 0 22 | #endif 23 | 24 | #ifndef SDL_GFXPRIMITIVES_VERSION 25 | #define SDL_GFXPRIMITIVES_VERSION(X) \ 26 | { \ 27 | (X)->major = SDL_GFXPRIMITIVES_MAJOR; \ 28 | (X)->minor = SDL_GFXPRIMITIVES_MINOR; \ 29 | (X)->patch = SDL_GFXPRIMITIVES_MICRO; \ 30 | } 31 | #endif 32 | 33 | MODULE = SDL::GFX PACKAGE = SDL::GFX PREFIX = gfx_ 34 | 35 | =for documentation 36 | 37 | The Following are XS bindings to the SDL_gfx Library 38 | 39 | Described here: 40 | 41 | See: L */ 42 | 43 | =cut 44 | 45 | const SDL_version * 46 | gfx_linked_version() 47 | PREINIT: 48 | char* CLASS = "SDL::Version"; 49 | CODE: 50 | if(linked_version == NULL) 51 | { 52 | linked_version = safemalloc(sizeof(SDL_version)); 53 | } 54 | SDL_GFXPRIMITIVES_VERSION(linked_version); 55 | 56 | RETVAL = linked_version; 57 | OUTPUT: 58 | RETVAL 59 | 60 | 61 | -------------------------------------------------------------------------------- /src/GFX/README: -------------------------------------------------------------------------------- 1 | Docs: 2 | http://www.ferzkopp.net/joomla/content/view/19/14/ -------------------------------------------------------------------------------- /src/Mixer/README: -------------------------------------------------------------------------------- 1 | C Docs are here: 2 | http://jcatki.no-ip.org:8080/SDL_mixer/SDL_mixer_frame.html 3 | -------------------------------------------------------------------------------- /src/Mixer/objects/MixChunk.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | #include "defines.h" 7 | 8 | #ifndef aTHX_ 9 | #define aTHX_ 10 | #endif 11 | 12 | #include 13 | 14 | #ifdef HAVE_SDL_MIXER 15 | #include 16 | 17 | void _free_mixchunk(void *object) 18 | { 19 | /* int allocated: if 1 struct has its own allocated buffer, if 0 abuf should not be freed */ 20 | if(((Mix_Chunk *)object)->allocated) 21 | Mix_FreeChunk((Mix_Chunk *)object); 22 | } 23 | 24 | #endif 25 | 26 | MODULE = SDL::Mixer::MixChunk PACKAGE = SDL::Mixer::MixChunk PREFIX = mixchunk_ 27 | 28 | =for documentation 29 | 30 | SDL_MixChunk - Stores audio data in memory 31 | 32 | typedef struct { 33 | int allocated; 34 | Uint8 *abuf; 35 | Uint32 alen; 36 | Uint8 volume; 37 | } Mix_Chunk; 38 | 39 | =cut 40 | 41 | #ifdef HAVE_SDL_MIXER 42 | 43 | Uint32 44 | mixchunk_alen ( mixchunk ) 45 | Mix_Chunk *mixchunk 46 | CODE: 47 | RETVAL = mixchunk->alen; 48 | OUTPUT: 49 | RETVAL 50 | 51 | Uint8 52 | mixchunk_volume ( mixchunk, ... ) 53 | Mix_Chunk *mixchunk 54 | CODE: 55 | if (items > 1 ) mixchunk->volume = SvIV(ST(1)); 56 | RETVAL = mixchunk->volume; 57 | OUTPUT: 58 | RETVAL 59 | 60 | void 61 | mixchunk_DESTROY(bag) 62 | SV *bag 63 | CODE: 64 | objDESTROY(bag, _free_mixchunk); 65 | 66 | #endif 67 | -------------------------------------------------------------------------------- /src/Mixer/objects/MixMusic.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | 6 | #ifndef aTHX_ 7 | #define aTHX_ 8 | #endif 9 | 10 | #include 11 | 12 | #ifdef HAVE_SDL_MIXER 13 | #include 14 | #endif 15 | 16 | MODULE = SDL::Mixer::MixMusic PACKAGE = SDL::Mixer::MixMusic PREFIX = mixmusic_ 17 | 18 | =for documentation 19 | 20 | SDL_mixmusic - This is an opaque data type used for Music data 21 | 22 | typedef struct _Mix_Music Mix_Music; 23 | 24 | =cut 25 | 26 | #ifdef HAVE_SDL_MIXER 27 | 28 | void 29 | mixmusic_DESTROY(mixmusic) 30 | Mix_Music *mixmusic 31 | CODE: 32 | Mix_FreeMusic(mixmusic); 33 | 34 | #endif 35 | -------------------------------------------------------------------------------- /src/Pango/objects/Context.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #include 8 | 9 | #ifdef HAVE_SDL_PANGO 10 | #include 11 | void _free_context(void *object) 12 | { 13 | SDLPango_FreeContext((SDLPango_Context *)object); 14 | } 15 | #endif 16 | 17 | MODULE = SDL::Pango::Context PACKAGE = SDL::Pango::Context PREFIX = context_ 18 | 19 | =for documentation 20 | 21 | See L */ 22 | 23 | =cut 24 | 25 | #ifdef HAVE_SDL_PANGO 26 | 27 | SDLPango_Context * 28 | context_new(CLASS, ...) 29 | char* CLASS 30 | CODE: 31 | if(items > 1) 32 | RETVAL = SDLPango_CreateContext_GivenFontDesc((char *)SvPV(ST(1), PL_na)); 33 | else 34 | RETVAL = SDLPango_CreateContext(); 35 | OUTPUT: 36 | RETVAL 37 | 38 | void 39 | context_DESTROY(bag) 40 | SV *bag 41 | CODE: 42 | objDESTROY(bag, _free_context); 43 | 44 | #endif 45 | -------------------------------------------------------------------------------- /src/SDLx/Controller/Interface.h: -------------------------------------------------------------------------------- 1 | /* Defines Controller Interface structs */ 2 | /* */ 3 | #include "EXTERN.h" 4 | #include "perl.h" 5 | #include "XSUB.h" 6 | 7 | 8 | typedef struct SDLx_State 9 | { 10 | /* Position */ 11 | float x; 12 | float y; 13 | /* Velocity */ 14 | float v_x; 15 | float v_y; 16 | /* Rotation */ 17 | float rotation; 18 | float ang_v; 19 | /* owned by an object or not? */ 20 | int owned; 21 | 22 | } SDLx_State; 23 | 24 | typedef struct Derivative 25 | { 26 | float dx; 27 | float dy; 28 | float dv_x; 29 | float dv_y; 30 | float drotation; 31 | float dang_v; 32 | 33 | } SDLx_Derivative; 34 | 35 | typedef struct SDLx_Interface 36 | { 37 | 38 | /* states to hold */ 39 | SDLx_State* previous; 40 | SDLx_State* current; 41 | 42 | /* subs to callback */ 43 | SV* acceleration; 44 | SV* evaluate; 45 | SV* interpolate; 46 | SV* integrate; 47 | 48 | } SDLx_Interface; 49 | 50 | void copy_state( SDLx_State * a, SDLx_State * b ) 51 | { 52 | 53 | a->x = b->x; 54 | a->y = b->y; 55 | a->v_x = b->v_x; 56 | a->v_y = b->v_y; 57 | a->rotation = b->rotation; 58 | a->ang_v = b->ang_v; 59 | } 60 | 61 | 62 | void interpolate( SDLx_Interface* obj, SDLx_State* out, float alpha ) 63 | { 64 | out->x = obj->current->x * alpha + obj->previous->x * (1 - alpha); 65 | out->y = obj->current->y * alpha + obj->previous->y * (1 - alpha); 66 | out->v_x = obj->current->v_x * alpha + obj->previous->v_x * (1 - alpha); 67 | out->v_y = obj->current->v_y * alpha + obj->previous->v_y * (1 - alpha); 68 | out->rotation = obj->current->rotation * alpha + obj->previous->rotation * (1 - alpha); 69 | out->ang_v = obj->current->ang_v * alpha + obj->previous->ang_v * (1 - alpha); 70 | 71 | } 72 | 73 | 74 | -------------------------------------------------------------------------------- /src/SDLx/Layer.h: -------------------------------------------------------------------------------- 1 | 2 | typedef struct SDLx_Layer 3 | { 4 | int index; 5 | SDL_Surface *surface; 6 | SDL_Rect *clip; 7 | SDL_Rect *pos; 8 | HV *data; 9 | } SDLx_Layer; 10 | -------------------------------------------------------------------------------- /src/SDLx/Timer.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Controller Timer Header 3 | */ 4 | 5 | 6 | typedef struct TIMER { 7 | 8 | int started_ticks; 9 | int paused_ticks; 10 | int started; 11 | int paused; 12 | 13 | } sdlx_timer; 14 | -------------------------------------------------------------------------------- /src/TTF/README: -------------------------------------------------------------------------------- 1 | Docs are here: 2 | http://jcatki.no-ip.org:8080/SDL_ttf/ 3 | -------------------------------------------------------------------------------- /src/TTF/objects/Font.xs: -------------------------------------------------------------------------------- 1 | #include "EXTERN.h" 2 | #include "perl.h" 3 | #include "XSUB.h" 4 | #include "ppport.h" 5 | #include "helper.h" 6 | 7 | #ifndef aTHX_ 8 | #define aTHX_ 9 | #endif 10 | 11 | 12 | #include 13 | #ifdef HAVE_SDL_TTF 14 | #include 15 | void _free_font(void *object) 16 | { 17 | TTF_CloseFont((TTF_Font *)object); 18 | } 19 | #endif 20 | 21 | 22 | MODULE = SDL::TTF::Font PACKAGE = SDL::TTF::Font PREFIX = ttf_font_ 23 | 24 | =for documentation 25 | 26 | SDL_TTF_Font - The opaque holder of a loaded font 27 | 28 | =cut 29 | 30 | #ifdef HAVE_SDL_TTF 31 | 32 | TTF_Font * 33 | ttf_font_new(CLASS, file, ptsize, index = 0) 34 | char* CLASS 35 | char *file 36 | int ptsize 37 | long index 38 | CODE: 39 | RETVAL = TTF_OpenFontIndex(file, ptsize, index); 40 | OUTPUT: 41 | RETVAL 42 | 43 | void 44 | ttf_font_DESTROY(bag) 45 | SV *bag 46 | CODE: 47 | objDESTROY(bag, _free_font); 48 | 49 | #endif 50 | -------------------------------------------------------------------------------- /src/support/darwin_support.h: -------------------------------------------------------------------------------- 1 | void init_ns_application(); 2 | void quit_ns_application(); 3 | 4 | -------------------------------------------------------------------------------- /src/support/darwin_support.m: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | @interface perl_SDLMain : NSObject 6 | @end 7 | 8 | @interface SDLApplication : NSApplication 9 | @end 10 | 11 | static jmp_buf jmpbuf; 12 | 13 | @implementation perl_SDLMain 14 | 15 | - (void) applicationDidFinishLaunching: (NSNotification *) note 16 | { 17 | fprintf(stderr,"Finished launching\n"); 18 | // longjmp(jmpbuf,1); 19 | } 20 | 21 | @end 22 | 23 | extern void setApplicationMenu(void); 24 | extern void setupWindowMenu(void); 25 | 26 | static NSAutoreleasePool* pool = NULL; 27 | static perl_SDLMain* perl_sdlMain = NULL; 28 | 29 | 30 | void 31 | init_ns_application() 32 | { 33 | // Allocate pool so Cocoa can refcount 34 | pool = [[NSAutoreleasePool alloc] init]; 35 | 36 | // Create the application 37 | [SDLApplication sharedApplication]; 38 | 39 | [NSApp setMainMenu: [[NSMenu alloc] init]]; 40 | // setApplicationMenu(); 41 | // setupWindowMenu(); 42 | 43 | perl_sdlMain = [[perl_SDLMain alloc] init]; 44 | [NSApp setDelegate: perl_sdlMain]; 45 | 46 | // fprintf(stderr,"Calling [NSapp run]\n"); 47 | // if (0 == setjmp(jmpbuf)) { 48 | [NSApp run]; 49 | // } else { 50 | // fprintf(stderr, "Returned from that nasty [NSApp run]"); 51 | // } 52 | } 53 | 54 | void 55 | quit_ns_application() 56 | { 57 | [perl_sdlMain release]; 58 | [pool release]; 59 | } 60 | 61 | -------------------------------------------------------------------------------- /src/support/win32.c: -------------------------------------------------------------------------------- 1 | 2 | 3 | #ifdef MSWIN32 4 | int dummy() 5 | { 6 | return 0; 7 | } 8 | #endif 9 | -------------------------------------------------------------------------------- /t/colorpm.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 15; 5 | use_ok('SDL::Color'); 6 | 7 | # check empty: black 8 | my $black = SDL::Color->new( 0, 0, 0 ); 9 | isa_ok( $black, 'SDL::Color' ); 10 | is( $black->r(), 0, 'black r is 0' ); 11 | is( $black->g(), 0, 'black g is 0' ); 12 | is( $black->b(), 0, 'black b is 0' ); 13 | 14 | # check full: white 15 | my $white = SDL::Color->new( 0xff, 0xff, 0xff ); 16 | isa_ok( $white, 'SDL::Color' ); 17 | is( $white->r(), 255, 'white r is 255' ); 18 | is( $white->g(), 255, 'white g is 255' ); 19 | is( $white->b(), 255, 'white b is 255' ); 20 | 21 | # check setting a value 22 | my $orange = $white; 23 | $orange->r(254); 24 | $orange->g(153); 25 | $orange->b(0); 26 | is( $orange->r(), 254, 'orange_notcloned r is 254' ); 27 | is( $orange->g(), 153, 'orange_notcloned g is 153' ); 28 | is( $orange->b(), 0, 'orange_notcloned b is 0' ); 29 | 30 | # check that copies also change 31 | is( $white->r(), 254, 'white (now orange) r is 254' ); 32 | is( $white->g(), 153, 'white (now orange) g is 154' ); 33 | is( $white->b(), 0, 'white (now orange) b is 0' ); 34 | 35 | sleep(2); 36 | -------------------------------------------------------------------------------- /t/config.t: -------------------------------------------------------------------------------- 1 | # t/002_config.t - test config() functionality 2 | 3 | use strict; 4 | use warnings; 5 | use Test::More tests => 2; 6 | 7 | BEGIN { use_ok('SDL::Config'); } 8 | 9 | print "Testing SDL::Config\n"; 10 | print "Has SDL = " . SDL::Config->has('SDL') . "\n"; 11 | print "Has SDL_mixer = " . SDL::Config->has('SDL_mixer') . "\n"; 12 | print "Has SDL_image = " . SDL::Config->has('SDL_image') . "\n"; 13 | print "Has SDL_ttf = " . SDL::Config->has('SDL_ttf') . "\n"; 14 | print "Has SDL_gfx_framerate = " . SDL::Config->has('SDL_gfx_framerate') . "\n"; 15 | print "Has SDL_gfx_imagefilter = " . SDL::Config->has('SDL_gfx_imagefilter') . "\n"; 16 | print "Has SDL_gfx_primitives = " . SDL::Config->has('SDL_gfx_primitives') . "\n"; 17 | print "Has SDL_gfx_rotozoom = " . SDL::Config->has('SDL_gfx_rotozoom') . "\n"; 18 | print "Has SDL_net = " . SDL::Config->has('SDL_net') . "\n"; 19 | print "Has SDL_Pango = " . SDL::Config->has('SDL_Pango') . "\n"; 20 | print "Has SDL_sound = " . SDL::Config->has('SDL_sound') . "\n"; 21 | print "Has SDL_svg = " . SDL::Config->has('SDL_svg') . "\n"; 22 | print "Has smpeg = " . SDL::Config->has('smpeg') . "\n"; 23 | print "Has png = " . SDL::Config->has('png') . "\n"; 24 | print "Has jpeg = " . SDL::Config->has('jpeg') . "\n"; 25 | print "Has tiff = " . SDL::Config->has('tiff') . "\n"; 26 | 27 | # we assume that the following are always present 28 | is( SDL::Config->has('SDL'), 1 ); 29 | -------------------------------------------------------------------------------- /t/core_error.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use Test::More tests => 5; 6 | 7 | use lib 't/lib'; 8 | use SDL::TestTool; 9 | 10 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 11 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 12 | 13 | SKIP: 14 | { 15 | skip "Video fail", 1 unless SDL::TestTool->init(SDL_INIT_VIDEO); 16 | is( SDL::init(SDL_INIT_VIDEO), 0, '[init] returns 0 on success' ); 17 | } 18 | SDL::set_error('Hello'); 19 | is( SDL::get_error, 'Hello', '[get_error] returns Hello' ); 20 | 21 | SDL::set_error( 'Hello %s!', 'SDL' ); 22 | is( SDL::get_error, 'Hello SDL!', '[get_error] returns Hello SDL!' ); 23 | 24 | SDL::set_error( 'Hello %s! Three is %d.', 'SDL', 3 ); 25 | is( SDL::get_error, 26 | 'Hello SDL! Three is 3.', 27 | '[get_error] returns Hello SDL! Three is 3.' 28 | ); 29 | 30 | SDL::clear_error(); 31 | is( SDL::get_error, '', '[get_error] returns no error' ); 32 | sleep(2); 33 | 34 | if ($videodriver) { 35 | $ENV{SDL_VIDEODRIVER} = $videodriver; 36 | } else { 37 | delete $ENV{SDL_VIDEODRIVER}; 38 | } 39 | -------------------------------------------------------------------------------- /t/core_joystick.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use Test::More; 6 | use SDL::Joystick; 7 | my @done = qw/num_joysticks/; 8 | can_ok( "SDL::Joystick", @done ); 9 | 10 | SDL::init(SDL_INIT_JOYSTICK); 11 | 12 | is( SDL::Joystick::num_joysticks() >= 0, 1, "[num_joysticks] ran" ); 13 | 14 | SKIP: 15 | { 16 | skip "Need a joystick for below tests", 1 17 | unless ( SDL::Joystick::num_joysticks() > 0 ); 18 | 19 | my $joy = SDL::Joystick->new(0); 20 | pass "[new] can open joystick"; 21 | 22 | } 23 | 24 | my @left = qw/ 25 | name 26 | opened 27 | index 28 | num_axes 29 | num_balls 30 | num_hats 31 | num_buttons 32 | update 33 | get_axis 34 | get_hat 35 | get_button 36 | get_ball 37 | /; 38 | 39 | my $why = 40 | '[Percentage Completion] ' 41 | . int( 100 * ( $#done + 1 ) / ( $#done + $#left + 2 ) ) 42 | . "\% implementation. " 43 | . ( $#done + 1 ) . " / " 44 | . ( $#done + $#left + 2 ); 45 | 46 | TODO: 47 | { 48 | local $TODO = $why; 49 | fail "Not Implmented $_" foreach (@left) 50 | 51 | } 52 | print "$why\n"; 53 | 54 | done_testing(); 55 | sleep(2); 56 | -------------------------------------------------------------------------------- /t/core_mouse.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use Test::More; 6 | use SDL::Mouse; 7 | use SDL::Cursor; 8 | use SDL::Surface; 9 | 10 | my @done = qw/ 11 | /; 12 | 13 | my @left = qw/ 14 | warp_mouse 15 | set_cursor 16 | get_cursor 17 | show_cursor 18 | /; 19 | can_ok( 'SDL::Mouse', @left ); #change to @done later ... after tests 20 | can_ok( 'SDL::Cursor', qw/new DESTROY/ ); 21 | 22 | my $why = 23 | '[Percentage Completion] ' 24 | . int( 100 * ( $#done + 1 ) / ( $#done + $#left + 2 ) ) 25 | . "\% implementation. " 26 | . ( $#done + 1 ) . " / " 27 | . ( $#done + $#left + 2 ); 28 | 29 | TODO: 30 | { 31 | local $TODO = $why; 32 | fail "Not Implmented $_" foreach (@left) 33 | 34 | } 35 | print "$why\n"; 36 | 37 | done_testing; 38 | sleep(2); 39 | -------------------------------------------------------------------------------- /t/core_multi.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use Test::More; 6 | 7 | plan( tests => 4 ); 8 | 9 | my @done = qw/ none /; 10 | 11 | use_ok('SDL::MultiThread'); 12 | SKIP: 13 | { 14 | skip 'Not implemented', 1; 15 | 16 | can_ok( 'SDL::MultiThread ', @done ); 17 | } 18 | 19 | my @left = qw/ 20 | create_thread 21 | thread_id 22 | get_thread_id 23 | wait_thread 24 | kill_thread 25 | create_mutex 26 | destroy_mutex 27 | mutex_P 28 | mutex_V 29 | create_semaphore 30 | destroy_semaphore 31 | sem_wait 32 | sem_try_wait 33 | sem_wait_timeout 34 | sem_post 35 | sem_value 36 | create_cond 37 | destroy_cond 38 | cond_signal 39 | cond_broadcast 40 | cond_wait 41 | cond_wait_timeout 42 | /; 43 | 44 | my $why = 45 | '[Percentage Completion] ' 46 | . int( 100 * $#done / ( $#done + $#left ) ) 47 | . "\% implementation. $#done / " 48 | . ( $#done + $#left ); 49 | 50 | TODO: 51 | { 52 | local $TODO = $why; 53 | pass "\nThe following functions:\n" . join ",", @left; 54 | } 55 | if ( $done[0] eq 'none' ) { print '0% done 0/' . $#left . "\n" } 56 | else { print "$why\n" } 57 | 58 | pass 'Are we still alive? Checking for segfaults'; 59 | sleep(2); 60 | -------------------------------------------------------------------------------- /t/core_overlay.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | use SDL; 6 | use SDL::Surface; 7 | use SDL::Video; 8 | 9 | use lib 't/lib'; 10 | use SDL::TestTool; 11 | 12 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 13 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 14 | 15 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 16 | plan( skip_all => 'Failed to init video' ); 17 | } else { 18 | plan( tests => 2 ); 19 | } 20 | 21 | use_ok('SDL::Overlay'); 22 | 23 | my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_ANYFORMAT ); 24 | 25 | my $overlay = SDL::Overlay->new( 100, 100, SDL_YV12_OVERLAY, $display ); 26 | 27 | isa_ok( $overlay, 'SDL::Overlay' ); 28 | 29 | if ($videodriver) { 30 | $ENV{SDL_VIDEODRIVER} = $videodriver; 31 | } else { 32 | delete $ENV{SDL_VIDEODRIVER}; 33 | } 34 | 35 | sleep(2); 36 | -------------------------------------------------------------------------------- /t/core_palette.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | 6 | use SDL; 7 | use SDL::Surface; 8 | use SDL::PixelFormat; 9 | use SDL::Video; 10 | 11 | use lib 't/lib'; 12 | use SDL::TestTool; 13 | 14 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 15 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 16 | 17 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 18 | plan( skip_all => 'Failed to init video' ); 19 | } else { 20 | plan( tests => 10 ); 21 | } 22 | 23 | use_ok('SDL::Palette'); 24 | 25 | can_ok( 'SDL::Palette', qw/ ncolors colors color_index / ); 26 | 27 | my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE ); 28 | 29 | isa_ok( $display->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?' ); 30 | 31 | ok( !defined $display->format->palette, 32 | 'Palette is not defined as BitPerPixels is greater then 8' 33 | ); 34 | 35 | my $disp = SDL::Video::set_video_mode( 640, 480, 8, SDL_SWSURFACE ); 36 | 37 | SKIP: 38 | { 39 | 40 | skip( 'Cannot open display: ' . SDL::get_error(), 4 ) unless ($disp); 41 | isa_ok( $disp->format, 'SDL::PixelFormat', 'Are we a SDL::PixelFormat?' ); 42 | 43 | isa_ok( 44 | $disp->format->palette, 'SDL::Palette', 45 | 'Palette is SDL::Palette when BitPerPixels is 8 ' 46 | ); 47 | 48 | is( $disp->format->palette->ncolors, 256, '256 colors in palette' ); 49 | 50 | my $colors = $disp->format->palette->colors(); 51 | isa_ok( $colors, 'ARRAY', 'Palette->colors is an array' ); 52 | 53 | isa_ok( $colors->[0], 'SDL::Color', 'Palette->colors[x] is an SDL::Color' ); 54 | 55 | isa_ok( 56 | $disp->format->palette->color_index(23), 57 | 'SDL::Color', 'Palette->color_index() is a SDL::Color' 58 | ); 59 | } 60 | 61 | if ($videodriver) { 62 | $ENV{SDL_VIDEODRIVER} = $videodriver; 63 | } else { 64 | delete $ENV{SDL_VIDEODRIVER}; 65 | } 66 | 67 | sleep(2); 68 | -------------------------------------------------------------------------------- /t/core_rect.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Test::More tests => 10; 5 | use_ok('SDL::Rect'); 6 | 7 | my $rect = SDL::Rect->new( 0, 0, 0, 0 ); 8 | isa_ok( $rect, 'SDL::Rect' ); 9 | is( $rect->x(), 0, 'x is 0' ); 10 | is( $rect->y(), 0, 'y is 0' ); 11 | is( $rect->w(), 0, 'w is 0' ); 12 | is( $rect->h(), 0, 'h is 0' ); 13 | 14 | $rect->x(1); 15 | $rect->y(2); 16 | $rect->w(3); 17 | $rect->h(4); 18 | 19 | is( $rect->x(), 1, 'x is now 1' ); 20 | is( $rect->y(), 2, 'y is now 2' ); 21 | is( $rect->w(), 3, 'w is now 3' ); 22 | is( $rect->h(), 4, 'h is now 4' ); 23 | sleep(2); 24 | -------------------------------------------------------------------------------- /t/core_rwops.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use Test::More; 6 | use SDL::RWOps; 7 | my @done = qw/ 8 | new_file 9 | seek 10 | close 11 | /; 12 | can_ok( 'SDL::RWOps', @done ); 13 | 14 | open FH, '>', '.rwops'; 15 | print FH 'rwops'; 16 | close FH; 17 | 18 | my $file = SDL::RWOps->new_file( '.rwops', 'rw' ); 19 | isa_ok( $file, 'SDL::RWOps', '[from_file] returns RWOps' ); 20 | 21 | #0 SEEK_SET 22 | #1 SEEK_CUR 23 | #2 SEEK_END 24 | my $len = $file->seek( 0, 0 ); 25 | is( $len, 0, '[seek] gets seek_end' ); 26 | $len = $file->seek( 0, 1 ); 27 | is( $len, 0, '[seek] gets seek_start' ); 28 | $len = $file->seek( 0, 2 ); 29 | is( $len, 5, '[seek] gets seek_cur' ); 30 | SKIP: 31 | { 32 | skip( 'crashing', 1 ); 33 | my $char; 34 | my $blocks = $file->read( $char, 16, 1 ); 35 | is( $blocks, 5, '[read] got ' . $char ); 36 | } 37 | $file->close(); 38 | unlink '.rwops'; 39 | my @left = qw/ 40 | from_fp 41 | from_mem 42 | from_const_mem 43 | alloc 44 | free 45 | tell 46 | read 47 | write 48 | /; 49 | 50 | my $why = 51 | '[Percentage Completion] ' 52 | . int( 100 * ( $#done + 1 ) / ( $#done + $#left + 2 ) ) 53 | . "\% implementation. " 54 | . ( $#done + 1 ) . " / " 55 | . ( $#done + $#left + 2 ); 56 | 57 | TODO: 58 | { 59 | local $TODO = $why; 60 | fail "Not Implmented $_" foreach (@left) 61 | 62 | } 63 | print "$why\n"; 64 | 65 | done_testing; 66 | sleep(2); 67 | -------------------------------------------------------------------------------- /t/core_timer.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | BEGIN { # http://wiki.cpantesters.org/wiki/CPANAuthorNotes 3 | use Config; 4 | if ( !$Config{'useithreads'} ) { 5 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); 6 | exit(0); 7 | } 8 | } 9 | use threads; 10 | use threads::shared; 11 | use strict; 12 | use warnings; 13 | use SDL; 14 | use Test::More; 15 | use SDL::Time; 16 | use Config; 17 | 18 | use lib 't/lib'; 19 | use SDL::TestTool; 20 | 21 | if ( !SDL::TestTool->init(SDL_INIT_TIMER) ) { 22 | plan( skip_all => 'Failed to init timer' ); 23 | } else { 24 | plan( tests => 6 ); 25 | } 26 | 27 | my @done = qw/get_ticks 28 | delay/; 29 | 30 | my $before = SDL::get_ticks(); 31 | like( $before, qr/^\d+$/, '[get_ticks] returns a number' ); 32 | 33 | SDL::delay(250); 34 | my $after = SDL::get_ticks(); 35 | like( $after, qr/^\d+$/, '[get_ticks] returns a number again' ); 36 | 37 | my $diff = $after - $before; 38 | ok( $diff > 100 && $diff < 400, '[delay](250) delayed for ' . $diff . 'ms' ); 39 | 40 | my $fired : shared = 0; 41 | 42 | sub fire { $fired++; return 100 } 43 | 44 | my $id = SDL::Time::add_timer( 101, 'main::fire' ); 45 | 46 | sleep(2); 47 | is( SDL::Time::remove_timer($id), 1, "[remove_timer] removed $id timer" ); 48 | isnt( $fired, 0, '[add_timer] ran ' . $fired ); 49 | 50 | my @left = qw/set_timer new_timer_callback add_timer remove_timer/; 51 | 52 | my $why = 53 | '[Percentage Completion] ' 54 | . int( 100 * ( $#done + 1 ) / ( $#done + $#left + 2 ) ) 55 | . "\% implementation. " 56 | . ( $#done + 1 ) . " / " 57 | . ( $#done + $#left + 2 ); 58 | 59 | TODO: 60 | { 61 | local $TODO = $why; 62 | pass "\nThe following functions:\n" . join ",", @left; 63 | } 64 | print "$why\n"; 65 | 66 | sleep(2); 67 | -------------------------------------------------------------------------------- /t/core_version.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Version; 6 | use Test::More tests => 8; 7 | 8 | my $version = SDL::version(); 9 | isa_ok( $version, 'SDL::Version' ); 10 | like( $version->major, qr/^\d+$/, 'Compile-time version major is a number' ); 11 | like( $version->minor, qr/^\d+$/, 'Compile-time version minor is a number' ); 12 | like( $version->patch, qr/^\d+$/, 'Compile-time version patch is a number' ); 13 | 14 | my $linked_version = SDL::linked_version(); 15 | isa_ok( $linked_version, 'SDL::Version' ); 16 | like( 17 | $linked_version->major, qr/^\d+$/, 18 | 'Link-time version major is a number' 19 | ); 20 | like( 21 | $linked_version->minor, qr/^\d+$/, 22 | 'Link-time version minor is a number' 23 | ); 24 | like( 25 | $linked_version->patch, qr/^\d+$/, 26 | 'Link-time version patch is a number' 27 | ); 28 | -------------------------------------------------------------------------------- /t/core_video_convert_surface.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use SDL; 4 | use SDL::Rect; 5 | use SDL::Color; 6 | use SDL::Video; 7 | use SDL::Surface; 8 | use SDL::PixelFormat; 9 | use SDL::Palette; 10 | use Test::More; 11 | 12 | use Data::Dumper; 13 | use Devel::Peek; 14 | 15 | use lib 't/lib'; 16 | use SDL::TestTool; 17 | 18 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 19 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 20 | 21 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 22 | plan( skip_all => 'Failed to init video' ); 23 | } 24 | 25 | my $hwdisplay = SDL::Video::set_video_mode( 640, 480, 8, SDL_HWSURFACE ); 26 | 27 | my $surface = SDL::Video::convert_surface( $hwdisplay, $hwdisplay->format, 0 ); 28 | isa_ok( 29 | $surface, 'SDL::Surface', 30 | '[convert_surface] makes copy of surface correctly' 31 | ); 32 | warn 'Copy conversion failed: ' . SDL::get_error if !$surface; 33 | 34 | my $display = SDL::Surface->new( SDL_HWSURFACE, 640, 480, 8, 0, 0, 0, 0 ); 35 | my $surface2 = SDL::Video::convert_surface( $display, $hwdisplay->format, 0 ); 36 | isa_ok( 37 | $surface2, 'SDL::Surface', 38 | '[convert_surface] makes copy of surface converted surface HW->HW' 39 | ); 40 | 41 | warn 'HW->HW conversion failed: ' . SDL::get_error if !$surface2; 42 | 43 | $display = SDL::Surface->new( SDL_SWSURFACE, 640, 480, 8, 0, 0, 0, 0 ); 44 | my $surface3 = SDL::Video::convert_surface( $display, $hwdisplay->format, 0 ); 45 | isa_ok( 46 | $surface3, 'SDL::Surface', 47 | '[convert_surface] makes copy of surface converted surface SW->SW' 48 | ); 49 | 50 | warn 'SW->SW conversion failed: ' . SDL::get_error if !$surface3; 51 | 52 | if ($videodriver) { 53 | $ENV{SDL_VIDEODRIVER} = $videodriver; 54 | } else { 55 | delete $ENV{SDL_VIDEODRIVER}; 56 | } 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/core_video_gamma.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Color; 6 | use SDL::Surface; 7 | use SDL::Config; 8 | use SDL::Overlay; 9 | use Test::More; 10 | use SDL::Rect; 11 | use SDL::Video; 12 | use SDL::VideoInfo; 13 | 14 | use lib 't/lib'; 15 | use SDL::TestTool; 16 | 17 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 18 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 19 | 20 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 21 | plan( skip_all => 'Failed to init video' ); 22 | } 23 | 24 | my $zero = [ 0, 0, 0, 0 ]; 25 | SDL::Video::set_gamma_ramp( $zero, $zero, $zero ); 26 | pass '[set_gamma_ramp] ran'; 27 | 28 | my ( $r, $g, $b ) = ( [], [], [] ); 29 | SDL::Video::get_gamma_ramp( $r, $g, $b ); 30 | pass '[get_gamma_ramp] ran got ' . @{$r}; 31 | is( @{$r}, 256, '[get_gamma_ramp] got 256 gamma ramp red back' ); 32 | is( @{$g}, 256, '[get_gamma_ramp] got 256 gamma ramp green back' ); 33 | is( @{$b}, 256, '[get_gamma_ramp] got 256 gamma ramp blue back' ); 34 | 35 | SDL::Video::set_gamma( 1.0, 1.0, 1.0 ); 36 | pass '[set_gamma] ran '; 37 | 38 | if ($videodriver) { 39 | $ENV{SDL_VIDEODRIVER} = $videodriver; 40 | } else { 41 | delete $ENV{SDL_VIDEODRIVER}; 42 | } 43 | 44 | pass 'Are we still alive? Checking for segfaults'; 45 | 46 | sleep(1); 47 | 48 | done_testing(); 49 | -------------------------------------------------------------------------------- /t/extendingrect.t: -------------------------------------------------------------------------------- 1 | package MyRect; 2 | use strict; 3 | use warnings; 4 | use base 'SDL::Rect'; 5 | 6 | sub new { 7 | my $class = shift; 8 | my $self = $class->SUPER::new(@_); 9 | unless ( ref $self ) { 10 | require Carp; 11 | Carp::confess SDL::GetError(); 12 | } 13 | return bless $self => $class; 14 | 15 | } 16 | 17 | sub foo { 18 | my $self = shift; 19 | return $self->x; 20 | } 21 | 22 | package main; 23 | use Test::More tests => 6; 24 | 25 | my $rect = MyRect->new( 0, 0, 0, 0 ); 26 | 27 | isa_ok( $rect, 'SDL::Rect' ); 28 | isa_ok( $rect, 'MyRect' ); 29 | can_ok( $rect, qw(x y w h) ); 30 | can_ok( $rect, qw(new foo) ); 31 | 32 | $rect->x(10); 33 | is( $rect->x, 10 ); 34 | is( $rect->foo, 10 ); 35 | sleep(2); 36 | -------------------------------------------------------------------------------- /t/gfx.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Config; 6 | use SDL::Version; 7 | use SDL::GFX; 8 | use Test::More; 9 | 10 | use lib 't/lib'; 11 | use SDL::TestTool; 12 | 13 | if ( !SDL::Config->has('SDL_gfx_primitives') ) { 14 | plan( skip_all => 'SDL_gfx support not compiled' ); 15 | } 16 | 17 | my $v = SDL::GFX::linked_version(); 18 | isa_ok( $v, 'SDL::Version', '[linked_version]' ); 19 | printf( "got version: %d.%d.%d\n", $v->major, $v->minor, $v->patch ); 20 | 21 | pass 'Are we still alive? Checking for segfaults'; 22 | 23 | done_testing; 24 | -------------------------------------------------------------------------------- /t/gfx_fpsmanager.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Config; 6 | use SDL::Version; 7 | use SDL::GFX; 8 | use SDL::GFX::Framerate; 9 | use SDL::GFX::FPSManager; 10 | use Test::More; 11 | 12 | use lib 't/lib'; 13 | use SDL::TestTool; 14 | 15 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 16 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 17 | 18 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 19 | plan( skip_all => 'Failed to init video' ); 20 | } elsif ( !SDL::Config->has('SDL_gfx_framerate') ) { 21 | plan( skip_all => 'SDL_gfx_framerate support not compiled' ); 22 | } else { 23 | plan( tests => 11 ); 24 | } 25 | 26 | my $v = SDL::GFX::linked_version(); 27 | isa_ok( $v, 'SDL::Version', '[linked_version]' ); 28 | printf( "got version: %d.%d.%d\n", $v->major, $v->minor, $v->patch ); 29 | 30 | my $fps = SDL::GFX::FPSManager->new( 0, 0, 0, 0 ); 31 | 32 | isa_ok( $fps, 'SDL::GFX::FPSManager' ); 33 | is( $fps->framecount, 0, 'fps has framecount' ); 34 | is( $fps->rateticks, 0, 'fps has rateticks' ); 35 | is( $fps->lastticks, 0, 'fps has lastticks' ); 36 | is( $fps->rate, 0, 'fps has rate' ); 37 | 38 | $fps->framecount(1); 39 | $fps->rateticks(2); 40 | $fps->lastticks(3); 41 | $fps->rate(4); 42 | 43 | is( $fps->framecount, 1, 'fps has framecount' ); 44 | is( $fps->rateticks, 2, 'fps has rateticks' ); 45 | is( $fps->lastticks, 3, 'fps has lastticks' ); 46 | is( $fps->rate, 4, 'fps has rate' ); 47 | 48 | SDL::delay(100); 49 | 50 | if ($videodriver) { 51 | $ENV{SDL_VIDEODRIVER} = $videodriver; 52 | } else { 53 | delete $ENV{SDL_VIDEODRIVER}; 54 | } 55 | 56 | pass 'Are we still alive? Checking for segfaults'; 57 | 58 | done_testing; 59 | -------------------------------------------------------------------------------- /t/gfx_framerate.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Config; 6 | use SDL::Version; 7 | use SDL::GFX; 8 | use SDL::GFX::Framerate; 9 | use SDL::GFX::FPSManager; 10 | use Test::More; 11 | 12 | use lib 't/lib'; 13 | use SDL::TestTool; 14 | 15 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 16 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 17 | 18 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 19 | plan( skip_all => 'Failed to init video' ); 20 | } elsif ( !SDL::Config->has('SDL_gfx_framerate') ) { 21 | plan( skip_all => 'SDL_gfx_framerate support not compiled' ); 22 | } else { 23 | plan( tests => 6 ); 24 | } 25 | 26 | my $v = SDL::GFX::linked_version(); 27 | isa_ok( $v, 'SDL::Version', '[linked_version]' ); 28 | printf( "got version: %d.%d.%d\n", $v->major, $v->minor, $v->patch ); 29 | 30 | # init 31 | my $fps = SDL::GFX::FPSManager->new( 0, 0, 0, 0 ); 32 | is( SDL::GFX::Framerate::init($fps), undef, '[init] returns undef' ); 33 | 34 | # get 35 | my $rate = SDL::GFX::Framerate::get($fps); 36 | is( $rate, 30, "[rate] is 30 by default" ); 37 | 38 | # set 39 | SDL::GFX::Framerate::set( $fps, 60 ); 40 | is( SDL::GFX::Framerate::get($fps), 60, "[rate] successfully set to 60" ); 41 | 42 | # delay 43 | is( SDL::GFX::Framerate::delay($fps), undef, "[delay] return undef" ); 44 | 45 | SDL::delay(100); 46 | 47 | if ($videodriver) { 48 | $ENV{SDL_VIDEODRIVER} = $videodriver; 49 | } else { 50 | delete $ENV{SDL_VIDEODRIVER}; 51 | } 52 | 53 | pass 'Are we still alive? Checking for segfaults'; 54 | 55 | done_testing; 56 | -------------------------------------------------------------------------------- /t/lib/SDL/TestTool.pm: -------------------------------------------------------------------------------- 1 | package SDL::TestTool; 2 | use strict; 3 | use warnings; 4 | use Capture::Tiny qw(capture); 5 | use SDL; 6 | use SDL::AudioSpec; 7 | use SDL::Audio; 8 | my %inits = ( 9 | 0x00000001 => 'SDL_INIT_TIMER', 10 | 0x00000010 => 'SDL_INIT_AUDIO', 11 | 0x00000020 => 'SDL_INIT_VIDEO', 12 | 0x00000100 => 'SDL_INIT_CDROM', 13 | 0x00000200 => 'SDL_INIT_JOYSTICK', 14 | 0x00100000 => 'SDL_INIT_NOPARACHUTE', 15 | 0x01000000 => 'SDL_INIT_EVENTTHREAD', 16 | 0x0000FFFF => 'SDL_INIT_EVERYTHING' 17 | ); 18 | 19 | sub init { 20 | my ( $self, $init ) = @_; 21 | my $stdout = ''; 22 | my $stderr = ''; 23 | my $result = 0; 24 | 25 | if ( $init == SDL_INIT_VIDEO ) { 26 | if ( $^O !~ /win/i && !$ENV{DISPLAY} && !$ENV{SDL_VIDEODRIVER} ) { 27 | warn '$DISPLAY is not set! Cannot Init Video'; 28 | return; 29 | } 30 | } 31 | 32 | if ( $init == SDL_INIT_AUDIO ) { 33 | if ( test_audio_open() != 0 ) { 34 | warn "Couldn't use a valid audio device: " . SDL::get_error(); 35 | return; 36 | } 37 | SDL::quit(); 38 | } 39 | 40 | ($stdout, $stderr, $result ) = capture { SDL::init($init) }; 41 | if ( $result != 0 ) { 42 | warn 'Init ' . $inits{$init} . ' failed with SDL error: ' . SDL::get_error() . "\nand stderr $stderr\n"; 43 | } 44 | 45 | return $result == 0; 46 | } 47 | 48 | sub test_audio_open { 49 | my $desired = SDL::AudioSpec->new; 50 | $desired->freq(44100); 51 | $desired->format(SDL::Audio::AUDIO_S16SYS); 52 | $desired->channels(2); 53 | $desired->samples(4096); 54 | $desired->callback('main::audio_callback'); 55 | 56 | my $obtained = SDL::AudioSpec->new; 57 | return SDL::Audio::open( $desired, $obtained ); 58 | } 59 | 60 | sub audio_callback { 61 | 62 | } 63 | 64 | 1; 65 | -------------------------------------------------------------------------------- /t/mixer_mixchunk.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Config; 6 | use SDL::Mixer; 7 | use SDL::Mixer::Channels; 8 | use SDL::Mixer::Samples; 9 | use SDL::Mixer::MixChunk; 10 | 11 | my $audiodriver; 12 | 13 | BEGIN { 14 | use Config; 15 | if ( !$Config{'useithreads'} ) { 16 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); 17 | exit(0); 18 | } 19 | 20 | use Test::More; 21 | use lib 't/lib'; 22 | use SDL::TestTool; 23 | 24 | $audiodriver = $ENV{SDL_AUDIODRIVER}; 25 | $ENV{SDL_AUDIODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 26 | 27 | if ( !SDL::TestTool->init(SDL_INIT_AUDIO) ) { 28 | plan( skip_all => 'Failed to init sound' ); 29 | } elsif ( !SDL::Config->has('SDL_mixer') ) { 30 | plan( skip_all => 'SDL_mixer support not compiled' ); 31 | } else { 32 | plan( tests => 6 ); 33 | } 34 | } 35 | 36 | is( SDL::Mixer::open_audio( 44100, SDL::Audio::AUDIO_S16SYS, 2, 4096 ), 37 | 0, 'open_audio passed' 38 | ); 39 | 40 | my $mix_chunk = SDL::Mixer::Samples::load_WAV('test/data/sample.wav'); 41 | isa_ok( $mix_chunk, 'SDL::Mixer::MixChunk' ); 42 | 43 | is( $mix_chunk->volume, 128, 'Default volume is 128' ); 44 | $mix_chunk->volume(100); 45 | is( $mix_chunk->volume, 100, 'Can change volume to 100' ); 46 | 47 | is( $mix_chunk->alen, 1926848, 'Alen is 1926848' ); 48 | 49 | SDL::Mixer::Channels::play_channel( -1, $mix_chunk, 0 ); 50 | 51 | # we close straight away so no audio is actually played 52 | 53 | SDL::Mixer::close_audio(); 54 | 55 | ok( 1, 'Got to the end' ); 56 | 57 | if ($audiodriver) { 58 | $ENV{SDL_AUDIODRIVER} = $audiodriver; 59 | } else { 60 | delete $ENV{SDL_AUDIODRIVER}; 61 | } 62 | 63 | sleep(2); 64 | -------------------------------------------------------------------------------- /t/mixer_mixmusic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use SDL; 4 | use SDL::Config; 5 | 6 | my $audiodriver; 7 | 8 | BEGIN { 9 | use Config; 10 | if ( !$Config{'useithreads'} ) { 11 | print("1..0 # Skip: Perl not compiled with 'useithreads'\n"); 12 | exit(0); 13 | } 14 | 15 | use Test::More; 16 | use lib 't/lib'; 17 | use SDL::TestTool; 18 | 19 | $audiodriver = $ENV{SDL_AUDIODRIVER}; 20 | $ENV{SDL_AUDIODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 21 | 22 | if ( !SDL::TestTool->init(SDL_INIT_AUDIO) ) { 23 | plan( skip_all => 'Failed to init sound' ); 24 | } elsif ( !SDL::Config->has('SDL_mixer') ) { 25 | plan( skip_all => 'SDL_mixer support not compiled' ); 26 | } else { 27 | plan( tests => 6 ); 28 | } 29 | } 30 | 31 | use_ok('SDL::Mixer'); 32 | use_ok('SDL::Mixer::Music'); 33 | use_ok('SDL::Mixer::MixMusic'); 34 | 35 | is( SDL::Mixer::open_audio( 44100, SDL::Audio::AUDIO_S16SYS, 2, 4096 ), 36 | 0, 'open_audio passed' 37 | ); 38 | 39 | my $mix_music = SDL::Mixer::Music::load_MUS('test/data/tribe_i.wav') 40 | ; # from Matthew Newman, http://opengameart.org/content/vocal-grunts-tribeiwav 41 | 42 | #warn 'Error:'. SDL::get_error() if (!$mix_music); 43 | 44 | { 45 | 46 | # I'm not sure why this fails 47 | isa_ok( $mix_music, 'SDL::Mixer::MixMusic' ); 48 | }; 49 | 50 | SDL::Mixer::Music::play_music( $mix_music, 0 ); 51 | 52 | # we close straight away so no audio is actually played 53 | 54 | SDL::Mixer::close_audio(); 55 | 56 | ok( 1, 'Got to the end' ); 57 | 58 | if ($audiodriver) { 59 | $ENV{SDL_AUDIODRIVER} = $audiodriver; 60 | } else { 61 | delete $ENV{SDL_AUDIODRIVER}; 62 | } 63 | 64 | sleep(2); 65 | -------------------------------------------------------------------------------- /t/sdlx_app.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | 3 | # basic testing of SDLx::App 4 | use strict; 5 | use warnings; 6 | use SDL; 7 | use SDL::Config; 8 | use SDL::Rect; 9 | use SDLx::Rect; 10 | use SDL::Color; 11 | use SDL::Video; 12 | use Test::More; 13 | use lib 't/lib'; 14 | use SDL::TestTool; 15 | 16 | plan( tests => 2 ); 17 | 18 | use SDLx::App; 19 | 20 | can_ok( 21 | 'SDLx::App', qw/ 22 | new 23 | resize 24 | title 25 | delay 26 | ticks 27 | error 28 | warp 29 | fullscreen 30 | iconify 31 | grab_input 32 | sync 33 | attribute 34 | / 35 | ); 36 | 37 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 38 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 39 | 40 | SKIP: 41 | { 42 | skip 'No Video', 1 unless SDL::TestTool->init(SDL_INIT_VIDEO); 43 | 44 | my $app = SDLx::App->new( 45 | title => "Test", 46 | width => 640, 47 | height => 480, 48 | init => SDL_INIT_VIDEO 49 | ); 50 | 51 | my $rect = SDL::Rect->new( 0, 0, $app->w, $app->h ); 52 | 53 | my $pixel_format = $app->format; 54 | my $blue_pixel = SDL::Video::map_RGB( $pixel_format, 0x00, 0x00, 0xff ); 55 | my $col_pixel = SDL::Video::map_RGB( $pixel_format, 0xf0, 0x00, 0x33 ); 56 | 57 | my $grect = SDLx::Rect->new( 10, 10, 30, 35 ); 58 | foreach ( 0 .. 80 ) { 59 | 60 | $grect->x($_); 61 | $grect->centery( $_ * 3 ); 62 | $grect->size( ( $_ / 40 ) * $_, ( $_ / 38 ) * $_ ); 63 | SDL::Video::fill_rect( $app, $rect, $blue_pixel ); 64 | SDL::Video::fill_rect( $app, $grect, $col_pixel ); 65 | 66 | SDL::Video::update_rect( $app, 0, 0, 640, 480 ); 67 | SDL::delay(10); 68 | } 69 | 70 | SDL::delay(100); 71 | pass 'Ran'; 72 | } 73 | 74 | if ($videodriver) { 75 | $ENV{SDL_VIDEODRIVER} = $videodriver; 76 | } else { 77 | delete $ENV{SDL_VIDEODRIVER}; 78 | } 79 | 80 | -------------------------------------------------------------------------------- /t/sdlx_sfont.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | use SDL; 5 | use SDL::Config; 6 | use SDL::Video; 7 | use SDL::Surface; 8 | use SDLx::SFont; 9 | use lib 't/lib'; 10 | use SDL::TestTool; 11 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 12 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 13 | 14 | my $audiodriver = $ENV{SDL_AUDIODRIVER}; 15 | $ENV{SDL_AUDIODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 16 | 17 | if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) { 18 | plan( skip_all => 'Failed to init video' ); 19 | } elsif ( !SDL::Config->has('SDL_image') ) { 20 | plan( skip_all => 'SDL_image support not compiled' ); 21 | } 22 | 23 | can_ok( 'SDLx::SFont', qw( new ) ); 24 | 25 | 26 | #Make a surface 27 | #Select a font 28 | my $d = SDL::Surface->new( SDL_SWSURFACE, 100, 100, 32 ); 29 | my $font = SDLx::SFont->new( 'test/data/font.' . ( SDL::Config->has('png') ? 'png' : 'bmp' ) ); 30 | 31 | isa_ok( $font, 'SDL::Surface', '[new] makes surface' ); 32 | 33 | #print using $font 34 | 35 | SDLx::SFont::print_text( $d, 10, 10, 'Huh' ); 36 | 37 | pass('[print_test] worked'); 38 | 39 | $font->use(); 40 | 41 | pass('[use] switch font worked'); 42 | 43 | SDLx::SFont::print_text( $d, 10, 10, 'Huh' ); 44 | pass('[use|printe_text] switch to font and print worked'); 45 | 46 | END { 47 | done_testing; 48 | 49 | #reset the old video driver 50 | if ($videodriver) { 51 | $ENV{SDL_VIDEODRIVER} = $videodriver; 52 | } else { 53 | delete $ENV{SDL_VIDEODRIVER}; 54 | } 55 | 56 | if ($audiodriver) { 57 | $ENV{SDL_AUDIODRIVER} = $audiodriver; 58 | } else { 59 | delete $ENV{SDL_AUDIODRIVER}; 60 | } 61 | } 62 | -------------------------------------------------------------------------------- /t/sdlx_text.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use SDL; 4 | use SDL::Config; 5 | use SDL::Color; 6 | use SDL::Surface; 7 | use SDLx::App; 8 | BEGIN { 9 | use FindBin; 10 | use Test::More; 11 | use lib 't/lib'; 12 | use SDL::TestTool; 13 | 14 | if ( !SDL::Config->has('SDL_ttf') ) { 15 | plan( skip_all => 'SDL_ttf support not compiled' ); 16 | } 17 | } 18 | 19 | use_ok( 'SDLx::Text' ); 20 | 21 | my $videodriver = $ENV{SDL_VIDEODRIVER}; 22 | $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING}; 23 | 24 | use File::Spec; 25 | my $score = SDLx::Text->new( 26 | font => File::Spec->catfile($FindBin::Bin, '..', 'share', 'GenBasR.ttf') 27 | ); 28 | 29 | isa_ok( $score, 'SDLx::Text'); 30 | 31 | is($score->x, 0, 'default x position'); 32 | is($score->y, 0, 'default y position'); 33 | is($score->h_align, 'left', 'default horizontal alignment'); 34 | isa_ok( $score->font, 'SDL::TTF::Font' ); 35 | isa_ok($score->color, 'SDL::Color', 'default color'); 36 | is($score->size, 24, 'default size'); 37 | 38 | $score->text('Hello'); 39 | 40 | is( $score->text, 'Hello', 'text() as a getter' ); 41 | ok( $score->w >= 50 && $score->w <= 53, 'Hello! is 50..53 px wide!' ); 42 | is( $score->h, 28, 'Hello! is 28 px high!' ); 43 | isa_ok($score->surface, 'SDL::Surface'); 44 | 45 | my $value = undef; 46 | my $other_self = $score->text($value); 47 | isa_ok($score, 'SDLx::Text'); 48 | 49 | END { 50 | 51 | if ($videodriver) { 52 | $ENV{SDL_VIDEODRIVER} = $videodriver; 53 | } else { 54 | delete $ENV{SDL_VIDEODRIVER}; 55 | } 56 | 57 | done_testing; 58 | } 59 | -------------------------------------------------------------------------------- /t/ttf_font.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use SDL; 5 | use SDL::Config; 6 | 7 | BEGIN { 8 | use FindBin; 9 | use File::Spec; 10 | use Test::More; 11 | use lib 't/lib'; 12 | use SDL::TestTool; 13 | 14 | if ( !SDL::Config->has('SDL_ttf') ) { 15 | plan( skip_all => 'SDL_ttf support not compiled' ); 16 | } 17 | } 18 | 19 | use SDL::TTF; 20 | use SDL::TTF::Font; 21 | use SDL::Version; 22 | my $font_filename = File::Spec->catfile( 23 | $FindBin::Bin, '..', 'share', 'GenBasR.ttf' 24 | ); 25 | 26 | my $lv = SDL::TTF::linked_version(); 27 | my $cv = SDL::TTF::compile_time_version(); 28 | 29 | isa_ok( $lv, 'SDL::Version', '[linked_version] returns a SDL::Version object' ); 30 | isa_ok( 31 | $cv, 'SDL::Version', 32 | '[compile_time_version] returns a SDL::Version object' 33 | ); 34 | printf( 35 | "got version: %d.%d.%d/%d.%d.%d\n", 36 | $lv->major, $lv->minor, $lv->patch, $cv->major, $cv->minor, $cv->patch 37 | ); 38 | 39 | is( SDL::TTF::init(), 0, "[init] succeeded" ); 40 | 41 | isa_ok( 42 | SDL::TTF::Font->new( $font_filename, 24 ), 43 | 'SDL::TTF::Font', 44 | "[new] with font and size" 45 | ); 46 | isa_ok( 47 | SDL::TTF::Font->new( $font_filename, 24, 0 ), 48 | 'SDL::TTF::Font', 49 | "[new] with font, size and index" 50 | ); 51 | 52 | is( SDL::TTF::quit(), undef, "[quit] ran" ); 53 | 54 | done_testing; 55 | 56 | sleep(1); 57 | -------------------------------------------------------------------------------- /t_backcompat/64encode.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use MIME::Base64 qw/ encode_base64 /; 4 | 5 | open FILE, "< $ARGV[0]" or die "$!\n"; 6 | 7 | while ( read FILE, $buf, 60 * 57 ) { 8 | print encode_base64($buf); 9 | } 10 | -------------------------------------------------------------------------------- /t_backcompat/MoP/.gitignore: -------------------------------------------------------------------------------- 1 | Build.bat 2 | Build 3 | blib 4 | _build 5 | MANIFEST 6 | 7 | -------------------------------------------------------------------------------- /t_backcompat/MoP/Build.PL: -------------------------------------------------------------------------------- 1 | use Module::Build; 2 | 3 | # See perldoc Module::Build for details of how this works 4 | 5 | my $build = Module::Build->new( 6 | module_name => 'SDL::Tutorial::MoP', 7 | bmp_files => { 8 | 'data/tiles.bmp' => 'lib/auto/SDL/Tutorial/MoP/data/tiles.bmp', 9 | 'data/main.bmp' => 'lib/auto/SDL/Tutorial/MoP/data/main.bmp', 10 | }, 11 | map_files => { 'data/main.map' => 'lib/auto/SDL/Tutorial/MoP/data/main.map', }, 12 | install_path => { 13 | bmp => 'installsitelib', 14 | map => 'installsitelib', 15 | }, 16 | ); 17 | $build->add_build_element('bmp'); 18 | $build->add_build_element('map'); 19 | $build->create_build_script; 20 | -------------------------------------------------------------------------------- /t_backcompat/MoP/Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl module SDL::Tutorial::MoP 2 | 3 | 0.01 Sun Nov 15 16:53:29 2009 4 | - original version; created by ExtUtils::ModuleMaker 0.51 5 | 6 | 7 | -------------------------------------------------------------------------------- /t_backcompat/MoP/README: -------------------------------------------------------------------------------- 1 | pod2text SDL::Tutorial::MoP.pm > README 2 | 3 | If this is still here it means the programmer was too lazy to create the readme file. 4 | 5 | You can create it now by using the command shown above from this directory. 6 | 7 | At the very least you should be able to use this set of instructions 8 | to install the module... 9 | 10 | perl Build.PL 11 | ./Build 12 | ./Build test 13 | ./Build install 14 | 15 | If you are on a windows box you should use 'nmake' rather than 'make'. 16 | -------------------------------------------------------------------------------- /t_backcompat/MoP/Todo: -------------------------------------------------------------------------------- 1 | TODO list for Perl module SDL::Tutorial::MoP 2 | 3 | - Nothing yet 4 | 5 | 6 | -------------------------------------------------------------------------------- /t_backcompat/MoP/data/18.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/MoP/data/18.gif -------------------------------------------------------------------------------- /t_backcompat/MoP/data/18.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/MoP/data/18.png -------------------------------------------------------------------------------- /t_backcompat/MoP/data/main.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/MoP/data/main.bmp -------------------------------------------------------------------------------- /t_backcompat/MoP/data/tiles.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/MoP/data/tiles.bmp -------------------------------------------------------------------------------- /t_backcompat/MoP/data/tiles.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/MoP/data/tiles.png -------------------------------------------------------------------------------- /t_backcompat/MoP/lib/SDL/Tutorial/MoP/Base.pm: -------------------------------------------------------------------------------- 1 | package SDL::Tutorial::MoP::Base; 2 | 3 | use strict; 4 | use warnings; 5 | use Carp; 6 | 7 | use SDL::Tutorial::MoP::EventManager; 8 | 9 | our $VERSION = '0.01'; 10 | 11 | # all the classes will also inherit the evt_manager, 12 | # so we won't have to pass it around everywhere 13 | my $evt_manager = SDL::Tutorial::MoP::EventManager->new(); 14 | sub evt_manager {$evt_manager} 15 | 16 | sub new { 17 | my ( $class, %params ) = (@_); 18 | 19 | my $self = bless {%params}, $class; 20 | 21 | # all controllers must register a listener 22 | $self->evt_manager->reg_listener($self); 23 | 24 | $self->init(%params) if $self->can('init'); 25 | 26 | return $self; 27 | } 28 | 29 | 1; 30 | 31 | __END__ 32 | 33 | =head1 NAME 34 | 35 | SDL::Tutorial::MoP::Base - base class 36 | 37 | =head1 DESCRIPTION 38 | 39 | This is the base class for most of the game objects. We put in this class 40 | all the information that we want to be visible across the game: 41 | 42 | =head2 Event Manager 43 | 44 | =head1 SEE ALSO 45 | 46 | L 47 | 48 | =head1 AUTHOR 49 | 50 | Kartik Thakore 51 | CPAN ID: KTHAKORE 52 | kthakore@CPAN.org 53 | http://yapgh.blogspot.com 54 | 55 | =head1 COPYRIGHT 56 | 57 | This program is free software; you can redistribute 58 | it and/or modify it under the same terms as Perl itself. 59 | 60 | The full text of the license can be found in the 61 | LICENSE file included with this module. 62 | 63 | 64 | =head1 SEE ALSO 65 | 66 | perl(1). 67 | -------------------------------------------------------------------------------- /t_backcompat/MoP/lib/SDL/Tutorial/MoP/Controller/CPUSpinner.pm: -------------------------------------------------------------------------------- 1 | package SDL::Tutorial::MoP::Controller::CPUSpinner; 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use base 'SDL::Tutorial::MoP::Base'; 7 | 8 | sub init { 9 | my $self = shift; 10 | $self->{keep_going} ||= 1; 11 | } 12 | 13 | sub run { 14 | my $self = shift; 15 | while ( $self->{keep_going} == 1 ) { 16 | $self->evt_manager->post( { name => 'Tick' } ); 17 | } 18 | } 19 | 20 | sub notify { 21 | my ( $self, $event ) = (@_); 22 | 23 | print "Notify in CPU Spinner \n" if $self->{EDEBUG}; 24 | 25 | my %event_method = ( 'Quit' => '_quit', ); 26 | 27 | my $method = $event_method{ $event->{name} }; 28 | 29 | if ( defined $method ) { 30 | print "Event: $event->{name}\n" if $self->{EDEBUG}; 31 | 32 | # call the corresponding method 33 | $self->$method(); 34 | } 35 | 36 | #if we did not have a tick event then some other controller needs to do 37 | #something so game state is still beign process we cannot have new input 38 | #now 39 | } 40 | 41 | sub _quit { 42 | my $self = shift; 43 | $self->{keep_going} = 0; 44 | } 45 | 46 | 1; 47 | 48 | __END__ 49 | 50 | =head1 NAME 51 | 52 | SDL::Tutorial::MoP::Controller::CPUSpinner 53 | 54 | =head1 DESCRIPTION 55 | 56 | The C controller is the heartbeat of the game. 57 | 58 | The game proceeds while C is set. When C 59 | receives a C event, C is set to zero. 60 | 61 | =head2 init 62 | 63 | C simply initializes C, so the game will start. 64 | 65 | =head2 run 66 | 67 | Produces a C event while C is set. 68 | 69 | =head2 notify 70 | 71 | If this controller receives a C event, C is 72 | set to zero, stopping the game. 73 | 74 | =head1 SEE ALSO 75 | 76 | L 77 | -------------------------------------------------------------------------------- /t_backcompat/MoP/lib/SDL/Tutorial/MoP/EventManager.pm: -------------------------------------------------------------------------------- 1 | package SDL::Tutorial::MoP::EventManager; 2 | 3 | sub new { 4 | my ( $class, %params ) = @_; 5 | 6 | my $self = bless {%params}, $class; 7 | 8 | $self->{listeners} ||= {}; 9 | $self->{evt_queue} ||= []; 10 | 11 | return $self; 12 | } 13 | 14 | sub listeners : lvalue { 15 | return shift->{listeners}; 16 | } 17 | 18 | sub evt_queue : lvalue { 19 | return shift->{evt_queue}; 20 | } 21 | 22 | sub reg_listener { 23 | my ( $self, $listener ) = (@_); 24 | $self->listeners->{$listener} = $listener 25 | if defined $listener; 26 | 27 | return $self->listeners->{$listener}; 28 | } 29 | 30 | sub un_reg_listener { 31 | my ( $self, $listener ) = (@_); 32 | 33 | if ( defined $listener ) { 34 | return delete $self->listeners->{$listener}; 35 | } else { 36 | return; 37 | } 38 | } 39 | 40 | sub post { 41 | my $self = shift; 42 | my $event = shift; 43 | 44 | die "Post needs a Event as parameter" unless defined $event->{name}; 45 | 46 | foreach my $listener ( values %{ $self->listeners } ) { 47 | $listener->notify($event); 48 | } 49 | } 50 | 51 | 1; 52 | 53 | __END__ 54 | 55 | =head1 DESCRIPTION 56 | 57 | The C is responsible for sending events to 58 | controllers, so they can trigger actions at specific times. 59 | 60 | For instance, when you press a key, or the game ticks, it 61 | is an event. 62 | 63 | The C will contact all the controllers so they 64 | can take the appropriate action. 65 | 66 | =head2 reg_listener 67 | 68 | Registers a listener that will be updated 69 | 70 | =head2 un_reg_listener 71 | 72 | UnRegisters a listerner 73 | 74 | =head2 listeners 75 | 76 | All listeners attached to this EventManager 77 | 78 | =head2 evt_queue 79 | 80 | The current evnets in queue 81 | 82 | =head2 post 83 | 84 | Send update signal to all Controllers 85 | -------------------------------------------------------------------------------- /t_backcompat/MoP/lib/SDL/Tutorial/MoP/Models.pm: -------------------------------------------------------------------------------- 1 | package SDL::Tutorial::MoP::Models; 2 | use strict; 3 | use File::ShareDir qw(module_file); 4 | use Cwd qw(abs_path); 5 | use Data::Dumper; 6 | 7 | BEGIN { 8 | use Exporter (); 9 | use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 10 | $VERSION = '0.01'; 11 | @ISA = qw(Exporter); 12 | 13 | #Give a hoot don't pollute, do not export more than needed by default 14 | @EXPORT = qw(map); 15 | @EXPORT_OK = qw(map); 16 | %EXPORT_TAGS = (); 17 | } 18 | 19 | my @map = (); # bool values where we can go 20 | my @frame = (); # tile gfx definitions 21 | my $avatar = { x => 0, y => 0, face => 0 }; # player pos 22 | 23 | sub new { 24 | my ( $class, %parameters ) = @_; 25 | my $self = bless( {}, ref($class) || $class ); 26 | 27 | load_map() or die("Can't load map."); 28 | 29 | return $self; 30 | } 31 | 32 | sub load_map { 33 | my $path = module_file( 'SDL::Tutorial::MoP', 'data/main.map' ); 34 | open( FH, $path ) || die "Can not open file $path: $!"; 35 | while () { 36 | my @row = split( //, $_ ); 37 | push( @map, \@row ); 38 | } 39 | close(FH); 40 | } 41 | 42 | sub map { 43 | return @map; 44 | } 45 | 46 | 1; 47 | -------------------------------------------------------------------------------- /t_backcompat/MoP/t/001_load.t: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | 3 | # t/001_load.t - check module loading and create testing directory 4 | 5 | use Test::More tests => 2; 6 | 7 | BEGIN { use_ok('SDL::Tutorial::MoP'); } 8 | 9 | my $object = SDL::Tutorial::MoP->new(); 10 | isa_ok( $object, 'SDL::Tutorial::MoP' ); 11 | 12 | -------------------------------------------------------------------------------- /t_backcompat/MoP/t/run.t: -------------------------------------------------------------------------------- 1 | use SDL::Tutorial::MoP; 2 | 3 | SDL::Tutorial::MoP->play(); 4 | -------------------------------------------------------------------------------- /t_backcompat/OpenGL/README: -------------------------------------------------------------------------------- 1 | README 2 | 3 | These scripts are intended to demonstrate how 4 | the SDLperl OpenGL API can be used. 5 | 6 | Due to the high level nature of the perl language, 7 | much of the OpenGL API's complexity has been 8 | reduced to a lowest common denominator, that is 9 | to say, real numbers. 10 | 11 | Given the overhead of perl itself, hardware accleration 12 | is pretty much mandatory for good performance. That 13 | said, perl and good hardware acceleration go hand in 14 | hand like fine wine and delicious cheese. 15 | 16 | Descriptions: 17 | 18 | test1.pl Basic Triangle and Square 19 | test2.pl 3D Cube example 20 | test3.pl Bezier Curve example 21 | test4.pl Bezier Surface (wireframe & solid) 22 | test5.pl Nurbs Surfaces, Curves, and Trims 23 | 24 | The tutorial directory contains SDL_perl specific 25 | adaptations of Jeff Molofee's OpenGL tutorial examples. 26 | The original tutorials and accompanying C programs 27 | can be found at http://nehe.gamedev.net 28 | 29 | tutorial/lesson02.pl Basic Triangle and Square 30 | tutorial/lesson03.pl Color Triangle and Square 31 | tutorial/lesson04.pl Rotating Triangle and Square 32 | tutorial/lesson05.pl Rotating Pyramid and Cube 33 | tutorial/lesson06.pl Rotating Textured Cube 34 | tutorial/lesson07.pl Lighting and Filters Cube 35 | tutorial/lesson08.pl Blending (aka transperancy) Cube 36 | 37 | 38 | -------------------------------------------------------------------------------- /t_backcompat/OpenGL/test3.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # Bezier Curve example 4 | # 5 | 6 | use SDL; 7 | use SDLx::App; 8 | use SDL::Surface; 9 | use SDL::Event; 10 | use SDL::OpenGL; 11 | 12 | my $app = SDLx::App->new( -w => 800, -h => 600, -d => 16, -gl => 1 ); 13 | 14 | my @points = ( 15 | [ -4.0, -4.0, 0.0 ], 16 | [ -2.0, 4.0, 0.0 ], 17 | [ 2.0, -4.0, 0.0 ], 18 | [ 4.0, 4.0, 0.0 ] 19 | ); 20 | 21 | my $ctrlpoints = pack "d12", map {@$_} @points; 22 | 23 | sub init { 24 | 25 | glViewport( 0, 0, 800, 600 ); 26 | glMatrixMode( GL_PROJECTION() ); 27 | glLoadIdentity(); 28 | 29 | glFrustum( -0.1, 0.1, -0.075, 0.075, 0.3, 100.0 ); 30 | 31 | glMatrixMode( GL_MODELVIEW() ); 32 | glLoadIdentity(); 33 | 34 | glTranslate( 0, 0, -30 ); 35 | 36 | glClearColor( 0.0, 0.0, 0.0, 0.0 ); 37 | glShadeModel( GL_FLAT() ); 38 | glMap1( GL_MAP1_VERTEX_3(), 0.0, 1.0, 3, 4, $ctrlpoints ); 39 | glEnable( GL_MAP1_VERTEX_3() ); 40 | } 41 | 42 | sub display { 43 | glClear(GL_COLOR_BUFFER_BIT); 44 | glColor( 1.0, 1.0, 1.0 ); 45 | glBegin(GL_LINE_STRIP); 46 | for my $i ( 0 .. 30 ) { 47 | glEvalCoord1( $i / 30 ); 48 | } 49 | glEnd(); 50 | 51 | glPointSize(5); 52 | glColor( 1.0, 1.0, 0 ); 53 | glBegin(GL_POINTS); 54 | for my $i ( 0 .. 3 ) { 55 | glVertex( @{ $points[$i] } ); 56 | } 57 | glEnd(); 58 | $app->sync(); 59 | } 60 | 61 | init(); 62 | display(); 63 | 64 | $app->loop( 65 | { SDL_QUIT() => sub { exit(); } 66 | } 67 | ); 68 | 69 | -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/NeHe.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/NeHe.png -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/Star.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/Star.bmp -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/crate.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/crate.png -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/cube.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/cube.bmp -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/glass.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/glass.bmp -------------------------------------------------------------------------------- /t_backcompat/OpenGL/tutorial/Data/tim.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/t_backcompat/OpenGL/tutorial/Data/tim.jpg -------------------------------------------------------------------------------- /t_backcompat/core_event_filter.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use warnings; 4 | use lib '.'; 5 | use SDL; 6 | use SDL::Event; 7 | use SDL::Events; 8 | use SDL::Video; 9 | 10 | SDL::init(SDL_INIT_VIDEO); 11 | my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE ); 12 | my $event = SDL::Event->new(); 13 | 14 | #This filters out all ActiveEvents 15 | my $filter = sub { 16 | if ( $_[0]->type == SDL_ACTIVEEVENT ) { return 0 } 17 | else { return 1; } 18 | }; 19 | my $filtered = 1; 20 | 21 | SDL::Events::set_event_filter($filter); 22 | 23 | while (1) { 24 | 25 | SDL::Events::pump_events(); 26 | if ( SDL::Events::poll_event($event) ) { 27 | if ( $event->type == SDL_ACTIVEEVENT ) { 28 | $filtered = 0; #we got a problem! 29 | print "Hello Mouse!!!\n" 30 | if ( $event->active_gain 31 | && ( $event->active_state == SDL_APPMOUSEFOCUS ) ); 32 | print "Bye Mouse!!!\n" 33 | if ( !$event->active_gain 34 | && ( $event->active_state == SDL_APPMOUSEFOCUS ) ); 35 | } 36 | if ( $event->type == SDL_MOUSEBUTTONDOWN ) { 37 | my ( $x, $y, $but, $wh ) = ( 38 | $event->button_x, $event->button_y, 39 | $event->button_button, $event->button_which 40 | ); 41 | warn "$but $wh CLICK!!! at $x and $y \n"; 42 | } 43 | exit if ( $event->type == SDL_QUIT ); 44 | } 45 | } 46 | SDL::quit(); 47 | 48 | -------------------------------------------------------------------------------- /t_backcompat/fontpm.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | # Copyright (C) 2003 Tels 4 | # Copyright (C) 2004 David J. Goehrig 5 | # 6 | # Copyright (C) 2005 David J. Goehrig 7 | # 8 | # ------------------------------------------------------------------------------ 9 | # 10 | # This library is free software; you can redistribute it and/or 11 | # modify it under the terms of the GNU Lesser General Public 12 | # License as published by the Free Software Foundation; either 13 | # version 2.1 of the License, or (at your option) any later version. 14 | # 15 | # This library is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 | # Lesser General Public License for more details. 19 | # 20 | # You should have received a copy of the GNU Lesser General Public 21 | # License along with this library; if not, write to the Free Software 22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 23 | # 24 | # ------------------------------------------------------------------------------ 25 | # 26 | # Please feel free to send questions, suggestions or improvements to: 27 | # 28 | # David J. Goehrig 29 | # dgoehrig\@cpan.org 30 | # 31 | # 32 | # basic testing of SDL::Font 33 | 34 | BEGIN { 35 | unshift @INC, 'blib/lib', 'blib/arch'; 36 | } 37 | 38 | use strict; 39 | use SDL::Config; 40 | 41 | use Test::More; 42 | 43 | if ( SDL::Config->has('SDL_image') ) { 44 | plan( tests => 2 ); 45 | } else { 46 | plan( skip_all => 'SDL_image support not compiled' ); 47 | } 48 | 49 | use_ok('SDL::Font'); 50 | 51 | can_ok( 'SDL::Font', qw/ new use / ); 52 | 53 | sleep(2); 54 | -------------------------------------------------------------------------------- /t_backcompat/graywin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # graywin.pl 4 | # 5 | # adapted from SDL-1.2.x/test/graywin.c 6 | # 7 | 8 | use SDL; 9 | use SDLx::App; 10 | use SDL::Rect; 11 | use SDL::Event; 12 | use SDL::Color; 13 | 14 | my %options; 15 | 16 | die <new(%options); 35 | 36 | sub DrawBox { 37 | my ( $x, $y ) = @_; 38 | 39 | my ( $w, $h ) = ( int( rand(640) ), int( rand(480) ) ); 40 | 41 | my $rect = SDL::Rect->new( 42 | -width => $w, 43 | -height => $h, 44 | -x => ( $x - int( $w / 2 ) ), 45 | -y => ( $y - int( $h / 2 ) ) 46 | ); 47 | 48 | my $color = SDL::Color->new( -r => rand(256), -g => rand(256), -b => rand(256) ); 49 | 50 | $app->fill( $rect, $color ); 51 | $app->update($rect); 52 | } 53 | 54 | $app->loop( 55 | { SDL_MOUSEBUTTONDOWN() => sub { 56 | my ($event) = @_; 57 | DrawBox( $event->button_x(), $event->button_y() ); 58 | }, 59 | SDL_KEYDOWN() => sub { 60 | my ($event) = @_; 61 | $app->warp( $options{-width} / 2, $options{-height} / 2 ) 62 | if ( $event->key_sym() == SDLK_SPACE ); 63 | $app->fullscreen() 64 | if ( $event->key_sym() == SDLK_f ); 65 | exit(0) if ( $event->key_sym() == SDLK_ESCAPE ); 66 | }, 67 | SDL_QUIT() => sub { 68 | exit(0); 69 | } 70 | } 71 | ); 72 | 73 | -------------------------------------------------------------------------------- /t_backcompat/loopwave.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use SDL; 4 | use SDL::Event; 5 | use Carp; 6 | 7 | Carp::confess "Could not initialize SDL: ", SDL::GetError() 8 | if ( 0 > SDL::Init(SDL_INIT_AUDIO) ); 9 | 10 | $ARGV[0] ||= 'data/sample.wav'; 11 | 12 | Carp::confess "usage: $0 [wavefile]\n" 13 | if ( in $ARGV[0], qw/ -h --help -? / ); 14 | 15 | my ( $wav_spec, $wav_buffer, $wav_len, $wav_pos ) = ( 0, 0, 0, 0 ); 16 | 17 | my $done = 0; 18 | 19 | $fillerup = sub { 20 | my ( $data, $len ) = @_; 21 | 22 | $wav_ptr = $wav_buffer + $wav_pos; 23 | $wav_remainder = $wav_len - $wav_pos; 24 | 25 | while ( $wav_remainder <= $len ) { 26 | SDL::MixAudio( $data, $wav_ptr, $wav_remainder, SDL_MIX_MAXVOLUME ); 27 | $data += $wav_remainder; 28 | $len -= $wav_remainder; 29 | $wav_ptr = $wav_buffer; 30 | $wav_remainder = $wav_len; 31 | $wav_pos = 0; 32 | } 33 | SDL::MixAudio( $data, $wav_ptr, $len, SDL_MIX_MAXVOLUME ); 34 | $wav_pos += $len; 35 | }; 36 | 37 | $poked = sub { 38 | $done = 1; 39 | }; 40 | 41 | $SIG{HUP} = $poked; 42 | $SIG{INT} = $poked; 43 | $SIG{QUIT} = $poked; 44 | $SIG{TERM} = $poked; 45 | 46 | $spec = SDL::NewAudioSpec( 44100, AUDIO_S16, 2, 4096 ); 47 | 48 | $wave = SDL::LoadWAV( $ARGV[0], $spec ); 49 | 50 | ( $wav_spec, $wav_buffer, $wav_len ) = @$wave; 51 | 52 | Carp::confess "Could not load wav file $ARGV[0], ", SDL::GetError(), "\n" 53 | unless ($wav_len); 54 | 55 | Carp::confess "Could not open audio ", SDL::GetError() 56 | if ( 0 > SDL::OpenAudio( $wav_spec, $fillerup ) ); 57 | 58 | SDL::PauseAudio(0); 59 | 60 | print "Using audio driver: ", SDL::AudioDriverName(), "\n"; 61 | 62 | while ( !$done && ( SDL::GetAudioStatus() == SDL_AUDIO_PLAYING ) ) { 63 | SDL::Delay(1000); 64 | } 65 | 66 | -------------------------------------------------------------------------------- /t_backcompat/palettepm.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | # Copyright (C) 2003 Tels 4 | # Copyright (C) 2004 David J. Goehrig 5 | # 6 | # Copyright (C) 2005 David J. Goehrig 7 | # 8 | # ------------------------------------------------------------------------------ 9 | # 10 | # This library is free software; you can redistribute it and/or 11 | # modify it under the terms of the GNU Lesser General Public 12 | # License as published by the Free Software Foundation; either 13 | # version 2.1 of the License, or (at your option) any later version. 14 | # 15 | # This library is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 | # Lesser General Public License for more details. 19 | # 20 | # You should have received a copy of the GNU Lesser General Public 21 | # License along with this library; if not, write to the Free Software 22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 23 | # 24 | # ------------------------------------------------------------------------------ 25 | # 26 | # Please feel free to send questions, suggestions or improvements to: 27 | # 28 | # David J. Goehrig 29 | # dgoehrig\@cpan.org 30 | # 31 | # 32 | # basic testing of SDL::Palette 33 | 34 | BEGIN { 35 | unshift @INC, 'blib/lib', 'blib/arch'; 36 | } 37 | 38 | use strict; 39 | 40 | use Test::More; 41 | 42 | plan( tests => 2 ); 43 | 44 | use_ok('SDL::Game::Palette'); 45 | 46 | can_ok( 47 | 'SDL::Game::Palette', qw/ 48 | new 49 | size 50 | red 51 | green 52 | blue 53 | color / 54 | ); 55 | 56 | sleep(2); 57 | -------------------------------------------------------------------------------- /t_backcompat/soundpm.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | # Copyright (C) 2003 Tels 4 | # Copyright (C) 2004 David J. Goehrig 5 | # 6 | # Copyright (C) 2005 David J. Goehrig 7 | # 8 | # ------------------------------------------------------------------------------ 9 | # 10 | # This library is free software; you can redistribute it and/or 11 | # modify it under the terms of the GNU Lesser General Public 12 | # License as published by the Free Software Foundation; either 13 | # version 2.1 of the License, or (at your option) any later version. 14 | # 15 | # This library is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 | # Lesser General Public License for more details. 19 | # 20 | # You should have received a copy of the GNU Lesser General Public 21 | # License along with this library; if not, write to the Free Software 22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 23 | # 24 | # ------------------------------------------------------------------------------ 25 | # 26 | # Please feel free to send questions, suggestions or improvements to: 27 | # 28 | # David J. Goehrig 29 | # dgoehrig\@cpan.org 30 | # 31 | # 32 | # basic testing of SDL::Sound 33 | 34 | BEGIN { 35 | unshift @INC, 'blib/lib', 'blib/arch'; 36 | } 37 | 38 | use strict; 39 | use SDL::Config; 40 | 41 | use Test::More; 42 | 43 | plan( tests => 2 ); 44 | 45 | use_ok('SDL::Sound'); 46 | 47 | can_ok( 48 | 'SDL::Sound', qw/ 49 | new 50 | volume 51 | / 52 | ); 53 | 54 | sleep(2); 55 | -------------------------------------------------------------------------------- /t_backcompat/testgraphictool.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use SDL; 7 | use SDL::Surface; 8 | use SDLx::App; 9 | use SDL::Tool::Graphic; 10 | 11 | my $app = SDLx::App->new( 12 | -title => "Graphic Tool Test", 13 | -width => 640, 14 | -height => 480, 15 | -depth => 16, 16 | -fullscreen => 0 17 | ); 18 | my $app_rect = SDL::Rect->new( 19 | -x => 0, 20 | -y => 0, 21 | -width => $app->width, 22 | -height => $app->height 23 | ); 24 | 25 | my $sprite = SDL::Surface->new( -name => "data/logo.png" ); 26 | $sprite->display_format(); 27 | 28 | #Test Zoom 29 | my $graphicTool = SDL::Tool::Graphic->new(); 30 | $graphicTool->zoom( $sprite, .5, .5, 1 ); 31 | 32 | my $sprite_rect = SDL::Rect->new( 33 | -x => 0, 34 | -y => 0, 35 | -width => $sprite->width, 36 | -height => $sprite->height 37 | ); 38 | $sprite->blit( $sprite_rect, $app, $sprite_rect ); 39 | $app->flip(); 40 | sleep 4; 41 | $app->fill( $app_rect, $SDL::Color::black ); 42 | 43 | #Test Rotate 44 | $graphicTool->rotoZoom( $sprite, 90, 1, 1 ); 45 | 46 | $sprite_rect = SDL::Rect->new( 47 | -x => 0, 48 | -y => 0, 49 | -width => $sprite->width, 50 | -height => $sprite->height 51 | ); 52 | $sprite->blit( $sprite_rect, $app, $sprite_rect ); 53 | $app->flip(); 54 | sleep 4; 55 | 56 | +print "GrayScaling\n"; 57 | +$app->fill( $app_rect, $SDL::Color::black ); 58 | 59 | #Test GrayScale 60 | $graphicTool->grayScale($sprite); 61 | 62 | $sprite->blit( $sprite_rect, $app, $sprite_rect ); 63 | $app->flip(); 64 | sleep 4; 65 | 66 | -------------------------------------------------------------------------------- /t_backcompat/testtimer.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | 3 | use SDL; 4 | use SDL::Timer; 5 | use SDL::Event; 6 | 7 | die "usage: $0\n" if in( $ARGV[0], qw/ -? -h --help/ ); 8 | 9 | SDL::Init(SDL_INIT_TIMER); 10 | 11 | print STDERR "Waiting 4 seconds\n"; 12 | SDL::Delay(4000); 13 | 14 | $a = SDL::Timer->new( 15 | sub { 16 | my $timer = shift; 17 | print STDERR "Timer A: $$timer{-times} runs\n"; 18 | }, 19 | -delay => 1000, 20 | -times => 10 21 | ); 22 | 23 | $b = SDL::Timer->new( 24 | sub { print STDERR "Timer B: ", ++$i, "\n" }, 25 | -delay => 3000 26 | ); 27 | 28 | $c = SDL::Timer->new( 29 | sub { print STDERR "Timer C: restarting Timer A\n"; $a->run( 1000, 10 ) }, 30 | -delay => 19000, 31 | -times => 1 32 | ); 33 | 34 | SDL::Delay(30000); 35 | 36 | print STDERR "Cleaning up...\n"; 37 | SDL::Delay(300); 38 | 39 | SDL::Quit(); 40 | 41 | -------------------------------------------------------------------------------- /t_backcompat/toolgraphicpm.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | # 3 | # Copyright (C) 2003 Tels 4 | # Copyright (C) 2004 David J. Goehrig 5 | # 6 | # Copyright (C) 2005 David J. Goehrig 7 | # 8 | # ------------------------------------------------------------------------------ 9 | # 10 | # This library is free software; you can redistribute it and/or 11 | # modify it under the terms of the GNU Lesser General Public 12 | # License as published by the Free Software Foundation; either 13 | # version 2.1 of the License, or (at your option) any later version. 14 | # 15 | # This library is distributed in the hope that it will be useful, 16 | # but WITHOUT ANY WARRANTY; without even the implied warranty of 17 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 18 | # Lesser General Public License for more details. 19 | # 20 | # You should have received a copy of the GNU Lesser General Public 21 | # License along with this library; if not, write to the Free Software 22 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 23 | # 24 | # ------------------------------------------------------------------------------ 25 | # 26 | # Please feel free to send questions, suggestions or improvements to: 27 | # 28 | # David J. Goehrig 29 | # dgoehrig\@cpan.org 30 | # 31 | # 32 | # basic testing of SDL::Tool::Graphic 33 | 34 | use strict; 35 | use Test::More; 36 | 37 | plan( skip_all => 'Old test TBD' ); 38 | 39 | use_ok('SDL::Tool::Graphic'); 40 | 41 | can_ok( 42 | 'SDL::Tool::Graphic', qw/ 43 | new zoom rotoZoom 44 | / 45 | ); 46 | 47 | my $gtool = SDL::Tool::Graphic->new(); 48 | isa_ok( $gtool, 'SDL::Tool::Graphic' ); 49 | 50 | -------------------------------------------------------------------------------- /t_backcompat/wave.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # This example plays a .WAV sound sample 4 | # 5 | use strict; 6 | use warnings; 7 | use SDL; 8 | use SDL::Mixer; 9 | use SDL::Sound; 10 | 11 | my $filename = shift || 'data/sample.wav'; 12 | 13 | # we want a frequency that is higher than the default 14 | my $mixer = SDL::Mixer->new( -frequency => 44100, ); 15 | print "Using audio driver: ", SDL::AudioDriverName(), "\n"; 16 | 17 | my $wave = SDL::Sound->new($filename); 18 | 19 | # we don't care what channel, and we only want to play it once 20 | my $channel = $mixer->play_channel( -1, $wave, 0 ); 21 | 22 | # wait until it has finished playing 23 | while ( $mixer->playing($channel) ) { 24 | SDL::Delay(10); 25 | } 26 | 27 | -------------------------------------------------------------------------------- /test/README: -------------------------------------------------------------------------------- 1 | README 2 | 3 | The files in this directory are the test scripts used 4 | to both verify that nothing major is broken each release 5 | and to demonstrate how the SDLperl API can be used. 6 | 7 | Many of these scripts have been submitted by people who 8 | use SDLperl, and further submissions are more than welcome. 9 | Still, while these examples demonstrate how to use the 10 | API, they should not be taken as the best way to use it. 11 | There is more than one way to do it. Given the variety 12 | of styles presented in these scripts, there is probably 13 | something for everyone. 14 | 15 | Descriptions 16 | 17 | checkkeys.pl prints keys pressed to stdout and change color surface 18 | graywin.pl creates colored rectangles where you click 19 | loopwave.pl plays a wav file using audio callback in perl! 20 | testconsole.pl creates a simple console interface 21 | testfonttool.pl displays a series of bitmapped and true type fonts 22 | testgfxprim.pl demonstrates some basic drawing primitives 23 | testgfxroto.pl rotates and caches an image (wait a few seconds) 24 | testjoystick.pl tests joystick movements 25 | testshell.pl experimental perl shell support 26 | testsprite.pl displays a wave of smilie faces 27 | testtimer.pl displays multiple, contemporary, timer callbacks in perl 28 | 29 | -------------------------------------------------------------------------------- /test/checkkeys.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use SDL ':init'; 7 | use SDL::Video ':all'; 8 | use SDL::Events ':all'; 9 | use SDL::Rect; 10 | use SDL::Event; 11 | use SDL::Surface; 12 | 13 | SDL::init(SDL_INIT_VIDEO); 14 | 15 | my $screen_surface = SDL::Video::set_video_mode( 800, 600, 32, SDL_SWSURFACE ); 16 | 17 | my $event = SDL::Event->new(); 18 | my ( $r, $g, $b ) = ( 0, 0, 0 ); 19 | while (1) { 20 | while ( SDL::Events::poll_event($event) ) { 21 | 22 | exit(0) if $event->type == SDL_QUIT; 23 | 24 | if ( $event->type == SDL_KEYDOWN ) { 25 | 26 | print STDERR SDL::Events::get_key_name( $event->key_sym ), "\n"; 27 | ( $r, $g, $b ) = ( rand_num(), rand_num(), rand_num() ); 28 | } 29 | } 30 | 31 | my $color = SDL::Video::map_RGB( $screen_surface->format(), $r, $g, $b ); 32 | 33 | SDL::Video::fill_rect( 34 | $screen_surface, SDL::Rect->new( 0, 0, 800, 600, ), 35 | $color 36 | ); 37 | 38 | SDL::Video::update_rect( $screen_surface, 0, 0, 800, 600 ); 39 | 40 | SDL::delay(20); 41 | } 42 | 43 | sub rand_num { 44 | return int( rand(256) ); 45 | } 46 | 47 | -------------------------------------------------------------------------------- /test/data/24P_Arial_NeonYellow.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/24P_Arial_NeonYellow.png -------------------------------------------------------------------------------- /test/data/24P_Copperplate_Blue.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/24P_Copperplate_Blue.png -------------------------------------------------------------------------------- /test/data/5x7.fnt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/5x7.fnt -------------------------------------------------------------------------------- /test/data/LargeFont.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/LargeFont.bmp -------------------------------------------------------------------------------- /test/data/README: -------------------------------------------------------------------------------- 1 | README 2 | 3 | files in this directory: 4 | 5 | Filename Author License Link 6 | 24P_Arial_NeonYellow.png 7 | 24P_Copperplate_Blue.png 8 | 5x7.fnt Andreas Schiffler LGPL 2.1 http://www.ferzkopp.net/joomla/software-mainmenu-14/4-ferzkopps-linux-software/19-sdlgfx 9 | aircut3.ttf 10 | electrohar.ttf 11 | highlight.png 12 | icon.bmp 13 | LargeFont.bmp 14 | logo.png 15 | menu.png 16 | README Tobias Leich none/free this file 17 | picture.bmp Tobias Leich none/free 18 | sample.wav 19 | tribute_i.wav Matthew Newman GPL 3.0, LGPL 2.0, CC-BY-SA 3.0 http://opengameart.org/content/vocal-grunts-tribeiwav -------------------------------------------------------------------------------- /test/data/button_dark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/button_dark.png -------------------------------------------------------------------------------- /test/data/button_light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/button_light.png -------------------------------------------------------------------------------- /test/data/chest.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/chest.png -------------------------------------------------------------------------------- /test/data/electrohar.ttf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/electrohar.ttf -------------------------------------------------------------------------------- /test/data/font.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/font.bmp -------------------------------------------------------------------------------- /test/data/font.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/font.png -------------------------------------------------------------------------------- /test/data/hero.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/hero.bmp -------------------------------------------------------------------------------- /test/data/hero.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/hero.png -------------------------------------------------------------------------------- /test/data/highlight.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/highlight.png -------------------------------------------------------------------------------- /test/data/icon.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/icon.bmp -------------------------------------------------------------------------------- /test/data/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/logo.png -------------------------------------------------------------------------------- /test/data/menu.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/menu.png -------------------------------------------------------------------------------- /test/data/pattern_red_white_2x2.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/pattern_red_white_2x2.bmp -------------------------------------------------------------------------------- /test/data/picture.bmp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/picture.bmp -------------------------------------------------------------------------------- /test/data/picture.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/picture.jpg -------------------------------------------------------------------------------- /test/data/picture.tif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/picture.tif -------------------------------------------------------------------------------- /test/data/sample.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/sample.wav -------------------------------------------------------------------------------- /test/data/silence.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/silence.wav -------------------------------------------------------------------------------- /test/data/test-mpeg.mpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/test-mpeg.mpg -------------------------------------------------------------------------------- /test/data/tribe_i.wav: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/tribe_i.wav -------------------------------------------------------------------------------- /test/data/wood_dark.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/wood_dark.png -------------------------------------------------------------------------------- /test/data/wood_light.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PerlGameDev/SDL/b532a7440b1d20b7c57db2caa7f53e47060127ec/test/data/wood_light.png -------------------------------------------------------------------------------- /test/graywin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | use strict; 4 | use warnings; 5 | 6 | use SDL ':init'; 7 | use SDL::Video ':all'; 8 | use SDL::Events ':all'; 9 | use SDL::Rect; 10 | use SDL::Event; 11 | use SDL::Surface; 12 | 13 | SDL::init(SDL_INIT_VIDEO); 14 | 15 | my $width = 800; 16 | my $height = 600; 17 | 18 | my $screen_surface = SDL::Video::set_video_mode( $width, $height, 32, SDL_SWSURFACE ); 19 | 20 | my $event = SDL::Event->new; 21 | 22 | while (1) { 23 | 24 | while ( SDL::Events::poll_event($event) ) { 25 | exit(0) if $event->type == SDL_QUIT; 26 | 27 | if ( $event->type == SDL_MOUSEBUTTONDOWN ) { 28 | 29 | my $mapped_color = SDL::Video::map_RGB( 30 | $screen_surface->format(), rand_color(), 31 | rand_color(), rand_color() 32 | ); 33 | 34 | SDL::Video::fill_rect( 35 | $screen_surface, 36 | SDL::Rect->new( $event->button_x, $event->button_y, 20, 10 ), 37 | $mapped_color 38 | ); 39 | 40 | } 41 | 42 | } 43 | 44 | SDL::Video::update_rect( $screen_surface, 0, 0, $width, $height ); 45 | SDL::delay(20); 46 | } 47 | 48 | sub rand_color { 49 | return int( rand(256) ); 50 | } 51 | -------------------------------------------------------------------------------- /tools/GFX_headers_digest.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Data::Dumper; 4 | use File::Spec; 5 | 6 | my $head_loc = `sdl-config --cflags`; 7 | $head_loc = ( split ' ', $head_loc )[0]; 8 | $head_loc =~ s/-I//; 9 | 10 | # This should be a config file that is updated regularly 11 | my %mod_headers = ( 12 | SDL_gfxPrimitives => 'SDL::GFX::Primitives', 13 | SDL_rotozoom => 'SDL::GFX::Rotozoom', 14 | SDL_framerate => 'SDL::GFX::Framerate', 15 | SDL_imageFilter => 'SDL::GFX::ImageFilter', 16 | SDL_gfxBlitFunc => 'SDL::GFX::BlitFunc', 17 | ); 18 | 19 | #check to see we have a different path set for SDL_gfx 20 | # 21 | 22 | if ( $ENV{SDL_GFX_LOC} && -d $ENV{SDL_GFX_LOC} ) { 23 | warn 'Using user defined location for SDL_GFX and not ' . $head_loc; 24 | $head_loc = $ENV{SDL_GFX_LOC}; 25 | } 26 | 27 | while ( my ( $header, $module ) = each(%mod_headers) ) { 28 | 29 | my $file = File::Spec->catfile( $head_loc, $header . '.h' ); 30 | 31 | warn " Creating Config for: $file at $module ::Config \n"; 32 | 33 | my $config = { header => $header . '.h', file => $file, module => $module }; 34 | 35 | my $FH; 36 | open $FH, '<' . $file 37 | or warn "Cannot find $file please set \$ENV{SDL_GFX_LOC} to point to a different location : $!"; 38 | 39 | if ( !$FH ) { $config->{exist} = -1; next } 40 | 41 | my @methods = (); 42 | 43 | grep { 44 | $_ =~ /^(\s+|)(\S+) (\S+) (\*|)(\S+)(\()/; 45 | push( @methods, $5 ) if $5 46 | } <$FH>; 47 | 48 | $config->{methods} = \@methods; 49 | 50 | close $FH; 51 | 52 | warn Dumper $config; 53 | 54 | } 55 | -------------------------------------------------------------------------------- /tools/evalSDL.run: -------------------------------------------------------------------------------- 1 | ulimit -c 3 -e 10 -f 2048 -i 20 -l 1024 -n 3 -v 24 -H 2 | ulimit -u 5 -H 3 | #perl -MData::Dumper -e "`ulimit -a` "; 4 | #perl -e "while(1) { fork } " 5 | perl SDLBot.pl 6 | 7 | -------------------------------------------------------------------------------- /tools/make_XS_stub.pl: -------------------------------------------------------------------------------- 1 | 2 | @files = @ARGV; 3 | 4 | foreach (@files) { 5 | my $filename = $_; 6 | my $file = $_; 7 | $filename =~ s/\:\:/\//g; 8 | $filename = 'lib/' . $filename . '.pm'; 9 | print "Writing to $filename \n"; 10 | open FH, ">$filename" or die 'Error ' . $!; 11 | print FH "package $file; 12 | use strict; 13 | use warnings; 14 | require Exporter; 15 | require DynaLoader; 16 | our \@ISA = qw(Exporter DynaLoader); 17 | bootstrap $file; 18 | 1;"; 19 | close FH; 20 | } 21 | 22 | -------------------------------------------------------------------------------- /tools/perltidy.pl: -------------------------------------------------------------------------------- 1 | #Because not all people have bash. 2 | use strict; 3 | use warnings; 4 | use App::Ack; 5 | use Perl::Tidy; 6 | my @ack = `ack -f --perl`; 7 | 8 | foreach (@ack) { 9 | chomp; 10 | print "Tidy $_ \n"; 11 | `perltidy -b -pro=perltidyrc $_`; 12 | 13 | unlink "$_.bak" if $ARGV[0]; 14 | } 15 | 16 | -------------------------------------------------------------------------------- /tools/smokeNsend.pl: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | die 4 | "Usage: username password [git-branch] [toggle for main repo] [extra options for smolder_smoke_signal]. \n Found @ARGV args" 5 | if $#ARGV < 1; 6 | my $revision = `git log --pretty='%h' -n 1`; 7 | 8 | if ( !$revision ) #Don't have pretty format supported in git so using regex 9 | { 10 | $revision = `git log -n 1`; 11 | 12 | $revision =~ /commit (\w{8})/; 13 | 14 | $revision = $1; 15 | } 16 | 17 | if ( !$ARGV[4] ) { 18 | system split ' ', "git pull origin $ARGV[2]" 19 | if ( $ARGV[2] && !( $ARGV[3] ) ); 20 | system split ' ', "git pull git://github.com/kthakore/SDL_perl.git $ARGV[2]" 21 | if $ARGV[3]; 22 | system( 'perl', 'Build.PL' ); 23 | system( 'perl', 'Build' ); 24 | unlink('sdl.tar.gz'); 25 | system split ' ', 'prove -vlbm --archive sdl.tar.gz'; 26 | } 27 | 28 | my $cmd = 29 | "perl tools/smolder_smoke_signal --server sdlperl.ath.cx --port 8080 --username $ARGV[0] --password $ARGV[1] --file sdl.tar.gz --project SDL --architecture $] --platform $^O $ARGV[3] --revision $revision"; 30 | warn $cmd; 31 | system split ' ', $cmd; 32 | -------------------------------------------------------------------------------- /tools/stubPod.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | 4 | die "Usage file.pod NAME DESC \@CATEGORY" if $#ARGV < 3; 5 | 6 | my ( $file, $name, $desc, @category ) = @ARGV; 7 | 8 | open FH, '>', $file; 9 | 10 | print FH "\=pod 11 | 12 | \=head1 NAME 13 | 14 | $name -- $desc 15 | 16 | \=head1 CATEGORY 17 | 18 | TODO, " . join( ', ', @category ) . " 19 | 20 | \=cut 21 | "; 22 | 23 | close FH; 24 | -------------------------------------------------------------------------------- /xt/01_podspell.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval q{ use Test::Spelling }; 3 | plan skip_all => "Test::Spelling is not installed." if $@; 4 | add_stopwords( map { split /[\s\:\-]/ } ); 5 | $ENV{LANG} = 'C'; 6 | all_pod_files_spelling_ok('lib'); 7 | __DATA__ 8 | Thomas Klausner 9 | domm {at} cpan.org 10 | App::Fotagger 11 | -------------------------------------------------------------------------------- /xt/02_perlcritic.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use Test::More; 3 | eval { 4 | require Test::Perl::Critic; 5 | Test::Perl::Critic->import( -profile => 'xt/perlcriticrc' ); 6 | }; 7 | plan skip_all => "Test::Perl::Critic is not installed." if $@; 8 | all_critic_ok('lib'); 9 | -------------------------------------------------------------------------------- /xt/03_pod.t: -------------------------------------------------------------------------------- 1 | use Test::More; 2 | eval "use Test::Pod 1.00"; 3 | plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; 4 | all_pod_files_ok(); 5 | -------------------------------------------------------------------------------- /xt/04_podcoverage.t: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use Test::More; 4 | 5 | eval "use Test::Pod::Coverage 1.04"; 6 | plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@; 7 | 8 | all_pod_coverage_ok(); 9 | -------------------------------------------------------------------------------- /xt/05_manifest.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl 2 | 3 | # Test that our MANIFEST describes the distribution 4 | 5 | use strict; 6 | 7 | BEGIN { 8 | use English qw(-no_match_vars); 9 | $OUTPUT_AUTOFLUSH = 1; 10 | $WARNING = 1; 11 | } 12 | 13 | my @MODULES = ( 'Test::DistManifest 1.001003', ); 14 | 15 | # Don't run tests for installs 16 | use Test::More; 17 | unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { 18 | plan( skip_all => "Author tests not required for installation" ); 19 | } 20 | 21 | # Load the testing modules 22 | foreach my $MODULE (@MODULES) { 23 | eval "use $MODULE"; 24 | if ($EVAL_ERROR) { 25 | $ENV{RELEASE_TESTING} 26 | ? BAIL_OUT("Failed to load required release-testing module $MODULE") 27 | : plan( skip_all => "$MODULE not available for testing" ); 28 | } 29 | } 30 | 31 | manifest_ok(); 32 | sleep(2); 33 | -------------------------------------------------------------------------------- /xt/07_core_memleak.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | use strict; 3 | use warnings; 4 | use Test::More; 5 | use SDL; 6 | use SDL::Rect; 7 | 8 | # Don't run tests for installs 9 | use Test::More; 10 | 11 | sub leaky() { 12 | 13 | SDL::Rect->new( 0, 0, 10, 10 ); 14 | 15 | } 16 | 17 | eval 'use Test::Valgrind'; 18 | plan skip_all => 'Test::Valgrind is required to test your distribution with valgrind' 19 | if $@; 20 | 21 | leaky(); 22 | 23 | sleep(2); 24 | -------------------------------------------------------------------------------- /xt/net.t: -------------------------------------------------------------------------------- 1 | #!/usr/bin/perl -w 2 | use strict; 3 | use SDL; 4 | use SDL::Config; 5 | use SDL::Version; 6 | use SDL::Net; 7 | use Test::More; 8 | 9 | =pod 10 | use lib 't/lib'; 11 | use SDL::TestTool; 12 | 13 | 14 | =cut 15 | 16 | if ( !SDL::Config->has('SDL_net') ) { 17 | plan( skip_all => 'SDL_net support not compiled' ); 18 | } 19 | 20 | my @done = qw/ 21 | init 22 | quit 23 | /; 24 | 25 | can_ok( 'SDL::Net', @done ); 26 | 27 | my $v = SDL::Net::linked_version(); 28 | isa_ok( $v, 'SDL::Version', '[linked_version]' ); 29 | diag sprintf( "got version: %d.%d.%d", $v->major, $v->minor, $v->patch ); 30 | 31 | is( 0, SDL::Net::init(), '[init] SDL net is inited' ); 32 | SDL::Net::quit(); 33 | pass('[quit] SDL net quit'); 34 | my @left = qw/ 35 | read16 36 | write16 37 | read32 38 | write32 39 | /; 40 | 41 | my $why = 42 | '[Percentage Completion] ' 43 | . int( 100 * $#done / ( $#done + $#left ) ) 44 | . "\% implementation. $#done / " 45 | . ( $#done + $#left ); 46 | 47 | TODO: 48 | { 49 | local $TODO = $why; 50 | pass "\nThe following functions:\n" . join ",", @left; 51 | } 52 | if ( $done[0] eq 'none' ) { diag '0% done 0/' . $#left } 53 | else { diag $why} 54 | 55 | pass 'Are we still alive? Checking for segfaults'; 56 | 57 | done_testing(); 58 | 59 | SDL::delay(100); 60 | -------------------------------------------------------------------------------- /xt/perlcriticrc: -------------------------------------------------------------------------------- 1 | [TestingAndDebugging::ProhibitNoStrict] 2 | allow=refs 3 | --------------------------------------------------------------------------------