view release on metacpan or  search on metacpan

lib/TCOD.pm  view on Meta::CPAN

# ABSTRACT: FFI bindings for libtcod
package TCOD;

use strict;
use warnings;

use Encode ();
use FFI::C;
use FFI::CheckLib ();
use FFI::Platypus 1.00;
use FFI::Platypus::Buffer ();
use Ref::Util;
use TCOD::SDL2;
use TCOD::Event;

sub import {
    use Import::Into;
    TCOD::Event->import::into( scalar caller );
}

our $VERSION = '0.009';

my $bundle = FFI::Platypus->new( api => 1 );
$bundle->bundle('TCOD');

my $ffi;
BEGIN {
    $ffi = FFI::Platypus->new( api => 1 );
    $ffi->lib( FFI::CheckLib::find_lib_or_exit lib => 'tcod' );
    FFI::C->ffi($ffi);
}

$ffi->load_custom_type( '::WideString' => 'wstring', access => 'read' );

$ffi->attach( [ TCOD_set_error => 'set_error' ] => ['string'] => 'int'    );
$ffi->attach( [ TCOD_get_error => 'get_error' ] => [        ] => 'string' );

sub enum {
    my %enums = @_;
    while ( my ( $name, $values ) = each %enums ) {
        require constant;
        constant->import($values);

        my $variable = __PACKAGE__ . '::' . $name;
        no strict 'refs';
        %{$variable} = ( %{$variable}, reverse %$values );
    }
}

use constant {
    NOISE_MAX_OCTAVES        => 128,
    NOISE_MAX_DIMENSIONS     => 4,
    NOISE_DEFAULT_HURST      => 0.5,
    NOISE_DEFAULT_LACUNARITY => 2,

};

BEGIN {
    enum Distribution => {
        DISTRIBUTION_LINEAR                 => 0,
        DISTRIBUTION_GAUSSIAN               => 1,
        DISTRIBUTION_GAUSSIAN_RANGE         => 2,
        DISTRIBUTION_GAUSSIAN_INVERSE       => 3,
        DISTRIBUTION_GAUSSIAN_RANGE_INVERSE => 4,
    },
    Charmap => {
        CHARMAP_CP437 => [
            0x0000, 0x263A, 0x263B, 0x2665, 0x2666, 0x2663, 0x2660, 0x2022,
            0x25D8, 0x25CB, 0x25D9, 0x2642, 0x2640, 0x266A, 0x266B, 0x263C,
            0x25BA, 0x25C4, 0x2195, 0x203C, 0x00B6, 0x00A7, 0x25AC, 0x21A8,
            0x2191, 0x2193, 0x2192, 0x2190, 0x221F, 0x2194, 0x25B2, 0x25BC,
            0x0020, 0x0021, 0x0022, 0x0023, 0x0024, 0x0025, 0x0026, 0x0027,

lib/TCOD.pm  view on Meta::CPAN

        # Accommodate $con->print( $x, $y, $string, %rest );
        %args = ( x => shift, y => shift, string => shift ) if @_ % 2;
        %args = ( %args, @_ );

        my $string = Encode::encode( 'UTF-8', $args{string}, Encode::FB_CROAK );

        $xsub->(
            $console,  @args{qw( x y )},
            length($string), $string,
            @args{qw( fg bg )},
            $args{bg_blend}  // TCOD::BKGND_SET,
            $args{alignment} // TCOD::LEFT,
        );
    });

    $ffi->attach( [ printn_rect => 'print_box' ] => [qw(
        TCOD_console
        int
        int
        int
        int
        size_t
        string
        TCOD_color*
        TCOD_color*
        int
        int
    )] => TCOD_error => sub {
        my ( $xsub, $console, %args ) = @_;
        my $string = Encode::encode( 'UTF-8', $args{string}, Encode::FB_CROAK );

        $xsub->(
            $console, @args{qw( x y width height )},
            length($string), $string,
            @args{qw( fg bg )},
            $args{bg_blend}  // TCOD::BKGND_SET,
            $args{alignment} // TCOD::LEFT,
        );
    });

    $ffi->attach( [ draw_frame_rgb => 'draw_frame' ] => [qw(
        TCOD_console
        int
        int
        int
        int
        int[]
        TCOD_color*
        TCOD_color*
        int
        bool
    )] => TCOD_error => sub {
        my ( $xsub, $console, %args ) = @_;

        Carp::croak 'The title parameter is not supported' if exists $args{title};

        my $decoration = $args{decoration} // [ '┌', '─', '┐', '│', ' ', '│', '└', '─', '┘' ];

        $decoration = [ map ord, split //, $decoration ]
            unless Ref::Util::is_arrayref $decoration;

        Carp::croak 'Frame decoration must have a length of 9. It has a length of ' . @$decoration
            if @$decoration != 9;

        $xsub->(
            $console, @args{qw( x y width height )},
            $decoration,
            @args{qw( fg bg )},
            $args{bg_blend}  // TCOD::BKGND_SET,
            $args{clear}     // 1,
        );
    });

    $ffi->attach( [ draw_rect_rgb => 'draw_rect' ] => [qw(
        TCOD_console
        int
        int
        int
        int
        int
        TCOD_color*
        TCOD_color*
        int
        bool
    )] => TCOD_error => sub {
        my ( $xsub, $console, %args ) = @_;

        $xsub->(
            $console,
            @args{qw( x y width height ch fg bg )},
            $args{bg_blend}  // TCOD::BKGND_SET,
        );
    });

    # Methods

    my $clear = $bundle->function( clear => [qw( TCOD_console TCOD_color* TCOD_color* int )] );
    $ffi->attach( clear => [qw( TCOD_console )] => 'void' => sub {
        my ( $xsub, $console, %args ) = @_;

        return $xsub->($console) unless %args;

        $clear->( $console, $args{fg}, $args{bg}, $args{ch} // TCOD::Event::K_SPACE );
    });

    $ffi->attach( save_asc                => [qw( TCOD_console string                            )] => 'bool'       );
    $ffi->attach( save_apf                => [qw( TCOD_console string                            )] => 'bool'       );

    $ffi->attach( set_char                => [qw( TCOD_console int int int                       )] => 'void'       );
    $ffi->attach( get_char                => [qw( TCOD_console int int                           )] => 'int'        );
    $ffi->attach( put_char                => [qw( TCOD_console int int int int                   )] => 'void'       );
    $ffi->attach( put_char_ex             => [qw( TCOD_console int int int TCOD_color TCOD_color )] => 'void'       );

    $ffi->attach( get_width               => [qw( TCOD_console                                   )] => 'int'        );
    $ffi->attach( get_height              => [qw( TCOD_console                                   )] => 'int'        );

    $ffi->attach( set_background_flag     => [qw( TCOD_console int                               )] => 'void'       );
    $ffi->attach( get_background_flag     => [qw( TCOD_console                                   )] => 'int'        );

    $ffi->attach( set_alignment           => [qw( TCOD_console int                               )] => 'void'       );