SDL2-FFI
view release on metacpan or search on metacpan
lib/SDL2/stdinc.pm view on Meta::CPAN
use warnings;
use experimental 'signatures';
use SDL2::Utils;
#
use SDL2::iconv_t;
#
enum SDL_bool => [ [ SDL_FALSE => !1 ], [ SDL_TRUE => 1 ] ];
use FFI::Platypus::Buffer qw[grow scalar_to_pointer];
# Tricky memory stuff
ffi->type( '(size_t)->opaque' => 'SDL_malloc_func' );
ffi->type( '(size_t,size_t)->opaque' => 'SDL_calloc_func' );
ffi->type( '(opaque,size_t)->opaque' => 'SDL_realloc_func' );
ffi->type( '(opaque)->void' => 'SDL_free_func' );
ffi->load_custom_type( '::WideString' => 'wstring', );
ffi->load_custom_type( '::WideString' => 'wstring_w', access => 'write' );
ffi->type( 'string' => 'wide_string' );
ffi->load_custom_type( '::StringArray' => 'string_array' );
#
attach stdinc => {
SDL_malloc => [ ['size_t'], 'opaque' ],
SDL_calloc => [ [ 'size_t', 'size_t' ], 'opaque' ],
SDL_realloc => [ [ 'opaque', 'size_t' ], 'opaque' ],
SDL_free => [ ['opaque'] ],
#
SDL_GetMemoryFunctions => [
[ 'opaque*', 'opaque*', 'opaque*', 'opaque*' ] =>
sub ( $inner, $malloc_func, $calloc_func, $realloc_func, $free_func ) {
$inner->( $malloc_func, $calloc_func, $realloc_func, $free_func );
$$malloc_func = ffi->function( $$malloc_func, ['size_t'], 'opaque' );
$$calloc_func = ffi->function( $$calloc_func, [ 'size_t', 'size_t' ], 'opaque' );
$$realloc_func = ffi->function( $$realloc_func, [ 'opaque', 'size_t' ], 'opaque' );
$$free_func = ffi->function( $$free_func, ['opaque'], );
}
],
SDL_SetMemoryFunctions => [
[ 'SDL_malloc_func', 'SDL_calloc_func', 'SDL_realloc_func', 'SDL_free_func' ] =>
sub ( $inner, $malloc_func, $calloc_func, $realloc_func, $free_func ) {
if ( ref $malloc_func eq 'CODE' ) {
$malloc_func = ffi->closure($malloc_func);
$malloc_func->sticky;
}
if ( ref $calloc_func eq 'CODE' ) {
$calloc_func = ffi->closure($calloc_func);
$calloc_func->sticky;
}
if ( ref $realloc_func eq 'CODE' ) {
$realloc_func = ffi->closure($realloc_func);
$realloc_func->sticky;
}
if ( ref $free_func eq 'CODE' ) {
$free_func = ffi->closure($free_func);
$free_func->sticky;
}
$inner->( $malloc_func, $calloc_func, $realloc_func, $free_func );
}
],
SDL_GetNumAllocations => [ [], 'int' ],
#
SDL_getenv => [ ['string'], 'string' ],
SDL_setenv => [ [ 'string', 'string', 'int' ], 'int' ],
#
SDL_qsort => [
[ 'opaque', 'size_t', 'size_t', '(opaque,opaque)->int' ] =>
sub ( $inner, $ptr, $count, $size, $comp ) {
my $wrapped = 0;
if ( ref $comp eq 'CODE' ) {
$wrapped = 1;
$comp = ffi->closure($comp);
$comp->sticky;
}
$inner->( $ptr, $count, $size, $comp );
$comp->unstick if $wrapped;
}
],
#
SDL_abs => [ ['int'], 'int' ],
#
SDL_isalpha => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isalnum => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isblank => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_iscntrl => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isdigit => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isxdigit => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_ispunct => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isspace => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isupper => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_islower => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isprint => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
SDL_isgraph => [ ['int'], 'int' => sub ( $inner, $char ) { $inner->( ord $char ) } ],
#
SDL_toupper => [ ['int'], 'int' => sub ( $inner, $char ) { chr $inner->( ord $char ) } ],
SDL_tolower => [ ['int'], 'int' => sub ( $inner, $char ) { chr $inner->( ord $char ) } ],
#
SDL_crc32 => [
[ 'uint32', 'opaque', 'size_t' ],
'uint32' => sub ( $inner, $crc, $str, $len = length( ref $str ? $$str : $str ) ) {
$inner->( $crc, ref $str ? scalar_to_pointer($$str) : $str, $len );
}
],
#
SDL_memset => [
[ 'opaque', 'int', 'size_t' ],
'opaque' => sub ( $inner, $dst, $c, $len ) {
$inner->( ref $dst ? scalar_to_pointer($$dst) : $dst, ord($c), $len );
}
],
SDL_memcpy => [
[ 'opaque', 'opaque', 'size_t' ],
'opaque' => sub ( $inner, $dst, $src, $len ) {
$inner->(
ref $dst ? scalar_to_pointer($$dst) : $dst,
ref $src ? scalar_to_pointer($$src) : $src, $len
);
}
],
SDL_memmove => [
[ 'opaque', 'opaque', 'size_t' ],
'opaque' => sub ( $inner, $dst, $src, $count ) {
$inner->(
ref $dst ? scalar_to_pointer($$dst) : $dst,
lib/SDL2/stdinc.pm view on Meta::CPAN
=back
=head2 C<SDL_SetMemoryFunctions( ... )>
Replace SDL's memory allocation functions with a custom set.
use Data::Dump;
SDL_SetMemoryFunctions( # poor example but I have no idea
sub { ddx \@_; ... }, # why you're doing this anyway
sub { ddx \@_; ... },
sub { ddx \@_; ... },
sub { ddx \@_; ... },
);
Note: If you are replacing SDL's memory functions, you should call L<<
C<SDL_GetNumAllocations( )>|/C<SDL_GetNumAllocations( )> >> and be very careful
if it returns non-zero. That means that your free function will be called with
memory allocated by the previous memory allocation functions.
Expected parameters include:
=over
=item C<malloc_func> - a C<SDL_malloc_func> closure
=item C<calloc_func> - a C<SDL_calloc_func> closure
=item C<realloc_func> - a C<SDL_realloc_func> closure
=item C<free_func> - a C<SDL_free_func> closure
=back
If you pass a simple code reference to any of the parameters, they'll be
wrapped in a closure and made sticky
=head2 C<SDL_GetNumAllocations( )>
Get the number of outstanding (unfreed) allocations.
my $leaks = SDL_GetNumAllocations( );
Returns an integer.
=head2 C<SDL_getenv( ... )>
Get environment variable's value.
my $path = SDL_getenv( 'PATH' );
Expected parameters include:
=over
=item C<name> - the name of the environment variable to query
=back
Returns the value if defined.
=head2 C<SDL_setenv( ... )>
Set environment variable's value.
SDL_setenv( 'Perl_SDL_pocket', 'store something here', 1 );
Expected parameters include:
=over
=item C<name> - the name of the environment variable to set
=item C<value> - the new value to set the given environment variable to
=item C<overwrite> - a boolean value; if true, the value is updated if already defined
=back
Returns C<1> if the environment variable has been changed; otherwise C<0>.
=head2 C<SDL_qsort( ... )>
A polymorphic sorting algorithm for arrays of arbitrary objects according to a
user-provided comparison function.
Expected parameters include:
=over
=item C<base> - pointer to the array to sort
=item C<count> - number of elements in the array
=item C<size> - size of each element in the array in bytes
=item C<comp> - comparison function which returns ​a negative integer value if the first argument is less than the second, a positive integer value if the first argument is greater than the second and zero if the arguments are equivalent.
The signature of the comparison function should be equivalent to the following:
int cmp(const void *a, const void *b);
# for FFI::Platypus->type: '(opaque,opaque)->int'
If the function is a code reference and not a closure, it will be wrapped
automatically and temporarily made sticky.
The function must not modify the objects passed to it and must return
consistent results when called for the same objects, regardless of their
positions in the array.
=back
See also: L<https://en.cppreference.com/w/c/algorithm/qsort>
=head2 C<SDL_abs( ... )>
Standard C<abs( ... )> function.
my $zero = SDL_abs( -459 ); # Ha
Expected parameters include:
=over
=item C<x> - integer value
( run in 1.900 second using v1.01-cache-2.11-cpan-437f7b0c052 )