Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP

Comparing changes

Choose two branches to see what’s changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
base fork: PerlGameDev/SDL2
base: c232a1e563
...
head fork: PerlGameDev/SDL2
compare: 2f60245f23
  • 8 commits
  • 11 files changed
  • 0 commit comments
  • 1 contributor
View
2  .gitignore
@@ -2,7 +2,9 @@ _build
blib
*.o
lib/*.c
+lib/*.xs
*.swp
Build
MYMETA.json
MYMETA.yml
+Build.bat
View
14 Build.PL
@@ -15,10 +15,18 @@ use Module::Build;
my %subsystems = (
SDL2 => {
file => {
- from => 'src/SDL2.xs',
- to => 'lib/SDL2.xs',
+ from => 'src/SDL2pp.xs',
+ to => 'lib/SDL2pp.xs',
},
libraries => [qw( SDL2 )],
+ },
+ Window => {
+ file => {
+ from => 'src/Core/objects/Window.xs',
+ to => 'lib/SDL2/Window.xs',
+ },
+ libraries => [qw( SDL2 )],
+
}
);
@@ -41,6 +49,8 @@ my %xs =
map { $subsystems{$_}{file}{from} => $subsystems{$_}{file}{to} }
keys %subsystems;
+my $cflags = '-I. -Isrc '. `sdl2-config --cflags`;
+my $libs = `sdl2-config --libs`;
my $build = Module::Build->new(
module_name => 'SDL2',
View
13 lib/SDL2.pm
@@ -1,6 +1,7 @@
package SDL2;
use strict;
use warnings;
+use SDL2pp;
use vars qw($VERSION $XS_VERSION @ISA @EXPORT @EXPORT_OK);
require Exporter;
require DynaLoader;
@@ -10,11 +11,11 @@ our $VERSION = '0.01';
our $XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
-use SDL2::Internal::Loader;
-internal_load_dlls(__PACKAGE__);
-
-bootstrap SDL2;
-
-use base 'Exporter';
+sub init {
+ return SDL2pp::init(@_);
+}
+sub quit {
+ return SDL2pp::quit(@_);
+}
1;
View
16 lib/SDL2/Window.pm
@@ -0,0 +1,16 @@
+package SDL2::Window;
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+require Exporter;
+require DynaLoader;
+our @ISA = qw(Exporter DynaLoader);
+
+use SDL2::Internal::Loader;
+internal_load_dlls(__PACKAGE__);
+
+bootstrap SDL2::Window;
+
+use base 'Exporter';
+
+1;
View
16 lib/SDL2pp.pm
@@ -0,0 +1,16 @@
+package SDL2pp;
+use strict;
+use warnings;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+require Exporter;
+require DynaLoader;
+our @ISA = qw(Exporter DynaLoader);
+
+use SDL2::Internal::Loader;
+internal_load_dlls(__PACKAGE__);
+
+bootstrap SDL2pp;
+
+use base 'Exporter';
+
+1;
View
45 src/Core/objects/Window.xs
@@ -0,0 +1,45 @@
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "ppport.h"
+#include "helper.h"
+#include <stdio.h>
+
+#ifndef aTHX_
+#define aTHX_
+#endif
+
+#include <SDL2/SDL.h>
+
+MODULE = SDL2::Window PACKAGE = SDL2::Window PREFIX = window_
+
+=for documentation
+
+SDL_Window -- Defines an SDL window
+=cut
+
+SDL_Window *
+window_new (CLASS, title, x, y, w, h, flags)
+ char* CLASS
+ char* title
+ int x
+ int y
+ int w
+ int h
+ Uint32 flags
+ CODE:
+ SDL_Window* window = SDL_CreateWindow(title, x, y, w, h, flags);
+ //warn( "Made window %p", window);
+ RETVAL = window;
+ OUTPUT:
+ RETVAL
+
+void
+window_DESTROY(bag)
+ SV *bag
+ CODE:
+ void* obj = bag2obj( bag );
+ SDL_Window* window = (SDL_Window*)obj;
+ //warn( "Destroying bag: %p obj: %p window %p", bag, obj, window );
+ SDL_DestroyWindow( window );
+ //warn( "Destroyed");
View
67 src/SDL2.xs
@@ -1,67 +0,0 @@
-
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-#include "ppport.h"
-
-#ifndef aTHX_
-#define aTHX_
-#endif
-
-#include <SDL2/SDL.h>
-
-
-
-MODULE = SDL2 PACKAGE = SDL2
-PROTOTYPES : DISABLE
-
-int
-init ( flags )
- Uint32 flags
- CODE:
-#if defined WINDOWS || defined WIN32
- windows_force_driver();
-#endif
- RETVAL = SDL_Init(flags);
- OUTPUT:
- RETVAL
-
-int
-init_sub_system ( flags )
- Uint32 flags
- CODE:
- RETVAL = SDL_InitSubSystem(flags);
- OUTPUT:
- RETVAL
-
-void
-quit_sub_system ( flags )
- Uint32 flags
- CODE:
- SDL_QuitSubSystem(flags);
-
-void
-quit ()
- CODE:
- SDL_Quit();
-
-int
-was_init ( flags )
- Uint32 flags
- CODE:
- RETVAL = SDL_WasInit(flags);
- OUTPUT:
- RETVAL
-
-IV
-get_handle ()
- CODE:
-#if defined WINDOWS || defined WIN32
- RETVAL = (IV)get_handle_win32();
-#else
- RETVAL = 0;
-#endif
- OUTPUT:
- RETVAL
-
-
View
19 lib/SDL2.xs → src/SDL2pp.xs 100755 → 100644
@@ -1,9 +1,10 @@
-
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
+#include <stdio.h>
+
#ifndef aTHX_
#define aTHX_
#endif
@@ -12,16 +13,13 @@
-MODULE = SDL2 PACKAGE = SDL2
+MODULE = SDL2pp PACKAGE = SDL2pp
PROTOTYPES : DISABLE
int
init ( flags )
Uint32 flags
CODE:
-#if defined WINDOWS || defined WIN32
- windows_force_driver();
-#endif
RETVAL = SDL_Init(flags);
OUTPUT:
RETVAL
@@ -35,6 +33,13 @@ init_sub_system ( flags )
RETVAL
void
+delay ( time )
+ Uint32 time
+ CODE:
+ SDL_Delay( time );
+
+
+void
quit_sub_system ( flags )
Uint32 flags
CODE:
@@ -56,11 +61,7 @@ was_init ( flags )
IV
get_handle ()
CODE:
-#if defined WINDOWS || defined WIN32
- RETVAL = (IV)get_handle_win32();
-#else
RETVAL = 0;
-#endif
OUTPUT:
RETVAL
View
125 src/helper.h
@@ -0,0 +1,125 @@
+
+#ifndef SDL_PERL_HELPER_H
+#define SDL_PERL_HELPER_H
+
+#include <SDL.h>
+#include "SDL_thread.h"
+
+PerlInterpreter * perl = NULL;
+
+void *bag2obj( SV *bag )
+{
+ void *obj = NULL;
+
+ if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) )
+ {
+ void **pointers = (void **)INT2PTR(void *, SvIV((SV *)SvRV( bag )));
+ obj = (void *)(pointers[0]);
+ }
+
+ return obj;
+}
+
+SV *obj2bag( int size_ptr, void *obj, char *CLASS )
+{
+ SV * objref = newSV( size_ptr );
+ void** pointers = safemalloc(3 * sizeof(void*));
+ pointers[0] = (void*)obj;
+ pointers[1] = (void*)PERL_GET_CONTEXT;
+ Uint32 *threadid = (Uint32 *)safemalloc(sizeof(Uint32));
+ *threadid = SDL_ThreadID();
+ pointers[2] = (void*)threadid;
+ sv_setref_pv( objref, CLASS, (void *)pointers);
+ return objref;
+}
+
+SV *cpy2bag( void *object, int p_size, int s_size, char *package )
+{
+ SV *ref = newSV( p_size );
+ void *copy = safemalloc( s_size );
+ memcpy( copy, object, s_size );
+
+ void** pointers = safemalloc(3 * sizeof(void*));
+ pointers[0] = (void*)copy;
+ pointers[1] = (void*)PERL_GET_CONTEXT;
+ Uint32 *threadid = (Uint32 *)safemalloc(sizeof(Uint32));
+ *threadid = SDL_ThreadID();
+ pointers[2] = (void*)threadid;
+ SV* a = sv_setref_pv(ref, package, (void *)pointers);
+ return a;
+}
+
+void objDESTROY(SV *bag, void (* callback)(void *object))
+{
+ if( sv_isobject(bag) && (SvTYPE(SvRV(bag)) == SVt_PVMG) )
+ {
+ void** pointers = (void**)INT2PTR(void *, SvIV((SV *)SvRV( bag )));
+ void* object = pointers[0];
+ Uint32 *threadid = (Uint32*)(pointers[2]);
+
+ if(PERL_GET_CONTEXT == pointers[1]
+ && *threadid == SDL_ThreadID())
+ {
+ pointers[0] = NULL;
+ if(object)
+ callback(object);
+ safefree(threadid);
+ safefree(pointers);
+ }
+ }
+}
+
+SV *_sv_ref( void *object, int p_size, int s_size, char *package )
+{
+ SV *ref = newSV( p_size );
+ void *copy = safemalloc( s_size );
+ memcpy( copy, object, s_size );
+
+ void** pointers = safemalloc(3 * sizeof(void*));
+ pointers[0] = (void*)copy;
+ pointers[1] = (void*)perl;
+ Uint32 *threadid = (Uint32 *)safemalloc(sizeof(Uint32));
+ *threadid = SDL_ThreadID();
+ pointers[2] = (void*)threadid;
+
+ return sv_setref_pv(ref, package, (void *)pointers);
+}
+
+void _svinta_free(Sint16* av, int len_from_av_len)
+{
+ if( av == NULL )
+ return;
+ safefree( av ); /* we only need to free the malloc'd array. It is one block. */
+ av = NULL;
+}
+
+Sint16* av_to_sint16 (AV* av)
+{
+ int len = av_len(av);
+ if( len != -1)
+ {
+ int i;
+ Sint16* table = (Sint16 *)safemalloc(sizeof(Sint16)*(len+1));
+ for ( i = 0; i < len+1 ; i++ )
+ {
+ SV ** temp = av_fetch(av,i,0);
+ if( temp != NULL )
+ table[i] = (Sint16) SvIV ( *temp );
+ else
+ table[i] = 0;
+ }
+ return table;
+
+ }
+ return NULL;
+}
+
+void _int_range( int *val, int min, int max )
+{
+ if( *val < min )
+ *val = min;
+ else if ( *val > max )
+ *val = max;
+}
+
+#endif
View
30 t/001_load.t
@@ -2,12 +2,34 @@
# t/001_load.t - check module loading and create testing directory
-use Test::More tests => 2;
+use Test::More tests => 3;
-BEGIN { use_ok( 'SDL2' ); }
+BEGIN {
+ use_ok( 'SDL2pp' );
+ use_ok( 'SDL2::Window' );
+ }
-SDL2::init(0);
+SDL2pp::init(0);
-SDL2::quit();
+my $window_flags => { SDL_WINDOW_FULLSCREEN => 0x00000001,
+ SDL_WINDOW_OPENGL => 0x00000002,
+ SDL_WINDOW_SHOWN => 0x00000004,
+ SDL_WINDOW_HIDDEN => 0x00000008,
+ SDL_WINDOW_BORDERLESS => 0x00000010,
+ SDL_WINDOW_RESIZABLE => 0x00000020,
+ SDL_WINDOW_MINIMIZED => 0x00000040,
+ SDL_WINDOW_MAXIMIZED => 0x00000080,
+ SDL_WINDOW_INPUT_GRABBED => 0x00000100,
+ SDL_WINDOW_INPUT_FOCUS => 0x00000200,
+ SDL_WINDOW_MOUSE_FOCUS => 0x00000400,
+ SDL_WINDOW_FULLSCREEN_DESKTOP => ( 0x00000001 | 0x00001000 ),
+ SDL_WINDOW_FOREIGN => 0x00000800
+};
+
+my $win = SDL2::Window->new("FIRST WINDOW", 50, 50, 200, 200, $window_flags->{SDL_WINDOW_SHOWN} | $window_flags->{SDL_WINDOW_OPENGL});
+
+SDL2pp::delay(3000);
+
+SDL2pp::quit();
pass();
View
2  typemap
@@ -17,6 +17,8 @@ Sint16 T_IV
Sint16 * T_PTR
Sint32 T_IV
Sint32 * T_PTR
+SDL_Window * O_OBJECT
+SDL_Renderer * O_OBJECT
SDL_Event * O_OBJECT
SDL_ActiveEvent * O_OBJECT
SDL_KeyboardEvent * O_OBJECT

No commit comments for this range

Something went wrong with that request. Please try again.