File Coverage

lib/Termbox.pm

Criterion	Covered	Total	%
statement	62	63	98.4
branch	0	2	0.0
condition			n/a
subroutine	21	22	95.4
pod	1	1	100.0
total	84	88	95.4

package Termbox 0.12 {
    use 5.020;
    use strictures 2;
    use warnings;
    #
    use File::ShareDir        qw[dist_dir];
    use File::Spec::Functions qw[catdir canonpath];
    #
    use FFI::CheckLib;
    use FFI::Platypus 2.00;
    use FFI::Platypus::Memory qw( malloc free );
    $ENV{FFI_PLATYPUS_DLERROR} = 1;
    my $ffi = FFI::Platypus->new(
        api  => 2,
        lang => 'CPP',
        lib  => find_lib_or_exit(
            lib       => 'termbox',
            recursive => 1,
            libpath   => [ qw[ . ./share/lib], canonpath( catdir( dist_dir(__PACKAGE__), 'lib' ) ) ]
        )
    );
    #
    use base qw[Exporter];
    use vars qw[@EXPORT_OK @EXPORT %EXPORT_TAGS];
    #
    $EXPORT_TAGS{api} = [
        qw[
            tb_init tb_init_file tb_init_fd tb_shutdown
            tb_width tb_height
            tb_clear tb_set_clear_attributes
            tb_present
            tb_set_cursor
            tb_put_cell tb_change_cell
            tb_cell_buffer
            tb_select_input_mode
            tb_select_output_mode
            tb_peek_event
            tb_poll_event
        ]
    ];
    use constant {
        TB_KEY_F1               => ( 0xFFFF - 0 ),
        TB_KEY_F2               => ( 0xFFFF - 1 ),
        TB_KEY_F3               => ( 0xFFFF - 2 ),
        TB_KEY_F4               => ( 0xFFFF - 3 ),
        TB_KEY_F5               => ( 0xFFFF - 4 ),
        TB_KEY_F6               => ( 0xFFFF - 5 ),
        TB_KEY_F7               => ( 0xFFFF - 6 ),
        TB_KEY_F8               => ( 0xFFFF - 7 ),
        TB_KEY_F9               => ( 0xFFFF - 8 ),
        TB_KEY_F10              => ( 0xFFFF - 9 ),
        TB_KEY_F11              => ( 0xFFFF - 10 ),
        TB_KEY_F12              => ( 0xFFFF - 11 ),
        TB_KEY_INSERT           => ( 0xFFFF - 12 ),
        TB_KEY_DELETE           => ( 0xFFFF - 13 ),
        TB_KEY_HOME             => ( 0xFFFF - 14 ),
        TB_KEY_END              => ( 0xFFFF - 15 ),
        TB_KEY_PGUP             => ( 0xFFFF - 16 ),
        TB_KEY_PGDN             => ( 0xFFFF - 17 ),
        TB_KEY_ARROW_UP         => ( 0xFFFF - 18 ),
        TB_KEY_ARROW_DOWN       => ( 0xFFFF - 19 ),
        TB_KEY_ARROW_LEFT       => ( 0xFFFF - 20 ),
        TB_KEY_ARROW_RIGHT      => ( 0xFFFF - 21 ),
        TB_KEY_MOUSE_LEFT       => ( 0xFFFF - 22 ),
        TB_KEY_MOUSE_RIGHT      => ( 0xFFFF - 23 ),
        TB_KEY_MOUSE_MIDDLE     => ( 0xFFFF - 24 ),
        TB_KEY_MOUSE_RELEASE    => ( 0xFFFF - 25 ),
        TB_KEY_MOUSE_WHEEL_UP   => ( 0xFFFF - 26 ),
        TB_KEY_MOUSE_WHEEL_DOWN => ( 0xFFFF - 27 ),

        # These are all ASCII code points below SPACE character and a BACKSPACE key.
        TB_KEY_CTRL_TILDE       => 0x00,
        TB_KEY_CTRL_2           => 0x00,    # clash with 'CTRL_TILDE'
        TB_KEY_CTRL_A           => 0x01,
        TB_KEY_CTRL_B           => 0x02,
        TB_KEY_CTRL_C           => 0x03,
        TB_KEY_CTRL_D           => 0x04,
        TB_KEY_CTRL_E           => 0x05,
        TB_KEY_CTRL_F           => 0x06,
        TB_KEY_CTRL_G           => 0x07,
        TB_KEY_BACKSPACE        => 0x08,
        TB_KEY_CTRL_H           => 0x08,    # clash with 'CTRL_BACKSPACE'
        TB_KEY_TAB              => 0x09,
        TB_KEY_CTRL_I           => 0x09,    # clash with 'TAB'
        TB_KEY_CTRL_J           => 0x0A,
        TB_KEY_CTRL_K           => 0x0B,
        TB_KEY_CTRL_L           => 0x0C,
        TB_KEY_ENTER            => 0x0D,
        TB_KEY_CTRL_M           => 0x0D,    # clash with 'ENTER'
        TB_KEY_CTRL_N           => 0x0E,
        TB_KEY_CTRL_O           => 0x0F,
        TB_KEY_CTRL_P           => 0x10,
        TB_KEY_CTRL_Q           => 0x11,
        TB_KEY_CTRL_R           => 0x12,
        TB_KEY_CTRL_S           => 0x13,
        TB_KEY_CTRL_T           => 0x14,
        TB_KEY_CTRL_U           => 0x15,
        TB_KEY_CTRL_V           => 0x16,
        TB_KEY_CTRL_W           => 0x17,
        TB_KEY_CTRL_X           => 0x18,
        TB_KEY_CTRL_Y           => 0x19,
        TB_KEY_CTRL_Z           => 0x1A,
        TB_KEY_ESC              => 0x1B,
        TB_KEY_CTRL_LSQ_BRACKET => 0x1B,    # clash with 'ESC'
        TB_KEY_CTRL_3           => 0x1B,    # clash with 'ESC'
        TB_KEY_CTRL_4           => 0x1C,
        TB_KEY_CTRL_BACKSLASH   => 0x1C,    # clash with 'CTRL_4'
        TB_KEY_CTRL_5           => 0x1D,
        TB_KEY_CTRL_RSQ_BRACKET => 0x1D,    # clash with 'CTRL_5'
        TB_KEY_CTRL_6           => 0x1E,
        TB_KEY_CTRL_7           => 0x1F,
        TB_KEY_CTRL_SLASH       => 0x1F,    # clash with 'CTRL_7'
        TB_KEY_CTRL_UNDERSCORE  => 0x1F,    # clash with 'CTRL_7'
        TB_KEY_SPACE            => 0x20,
        TB_KEY_BACKSPACE2       => 0x7F,
        TB_KEY_CTRL_8           => 0x7F     # clash with 'BACKSPACE2'
    };
    $EXPORT_TAGS{keys} = [
        qw[
            TB_KEY_F1
            TB_KEY_F2
            TB_KEY_F3
            TB_KEY_F4
            TB_KEY_F5
            TB_KEY_F6
            TB_KEY_F7
            TB_KEY_F8
            TB_KEY_F9
            TB_KEY_F10
            TB_KEY_F11
            TB_KEY_F12
            TB_KEY_INSERT
            TB_KEY_DELETE
            TB_KEY_HOME
            TB_KEY_END
            TB_KEY_PGUP
            TB_KEY_PGDN
            TB_KEY_ARROW_UP
            TB_KEY_ARROW_DOWN
            TB_KEY_ARROW_LEFT
            TB_KEY_ARROW_RIGHT
            TB_KEY_MOUSE_LEFT
            TB_KEY_MOUSE_RIGHT
            TB_KEY_MOUSE_MIDDLE
            TB_KEY_MOUSE_RELEASE
            TB_KEY_MOUSE_WHEEL_UP
            TB_KEY_MOUSE_WHEEL_DOWN
            TB_KEY_CTRL_TILDE
            TB_KEY_CTRL_2
            TB_KEY_CTRL_A
            TB_KEY_CTRL_B
            TB_KEY_CTRL_C
            TB_KEY_CTRL_D
            TB_KEY_CTRL_E
            TB_KEY_CTRL_F
            TB_KEY_CTRL_G
            TB_KEY_BACKSPACE
            TB_KEY_CTRL_H
            TB_KEY_TAB
            TB_KEY_CTRL_I
            TB_KEY_CTRL_J
            TB_KEY_CTRL_K
            TB_KEY_CTRL_L
            TB_KEY_ENTER
            TB_KEY_CTRL_M
            TB_KEY_CTRL_N
            TB_KEY_CTRL_O
            TB_KEY_CTRL_P
            TB_KEY_CTRL_Q
            TB_KEY_CTRL_R
            TB_KEY_CTRL_S
            TB_KEY_CTRL_T
            TB_KEY_CTRL_U
            TB_KEY_CTRL_V
            TB_KEY_CTRL_W
            TB_KEY_CTRL_X
            TB_KEY_CTRL_Y
            TB_KEY_CTRL_Z
            TB_KEY_ESC
            TB_KEY_CTRL_LSQ_BRACKET
            TB_KEY_CTRL_3
            TB_KEY_CTRL_4
            TB_KEY_CTRL_BACKSLASH
            TB_KEY_CTRL_5
            TB_KEY_CTRL_RSQ_BRACKET
            TB_KEY_CTRL_6
            TB_KEY_CTRL_7
            TB_KEY_CTRL_SLASH
            TB_KEY_CTRL_UNDERSCORE
            TB_KEY_SPACE
            TB_KEY_BACKSPACE2
            TB_KEY_CTRL_8
        ]
    ];
    #
    use constant { TB_MOD_ALT => 0x01, TB_MOD_MOTION => 0x02 };
    $EXPORT_TAGS{modifier} = [
        qw[
            TB_MOD_ALT
            TB_MOD_MOTION
        ]
    ];
    #
    use constant {
        TB_DEFAULT => 0x00,
        TB_BLACK   => 0x01,
        TB_RED     => 0x02,
        TB_GREEN   => 0x03,
        TB_YELLOW  => 0x04,
        TB_BLUE    => 0x05,
        TB_MAGENTA => 0x06,
        TB_CYAN    => 0x07,
        TB_WHITE   => 0x08,
    };
    $EXPORT_TAGS{color} = [
        qw[
            TB_DEFAULT
            TB_BLACK
            TB_RED
            TB_GREEN
            TB_YELLOW
            TB_BLUE
            TB_MAGENTA
            TB_CYAN
            TB_WHITE
        ]
    ];
    #
    use constant { TB_BOLD => 0x0100, TB_UNDERLINE => 0x0200, TB_REVERSE => 0x0400 };
    $EXPORT_TAGS{font} = [
        qw[
            TB_BOLD
            TB_UNDERLINE
            TB_REVERSE
        ]
    ];
    #
    use constant { TB_EVENT_KEY => 1, TB_EVENT_RESIZE => 2, TB_EVENT_MOUSE => 3 };
    $EXPORT_TAGS{event} = [
        qw[
            TB_EVENT_KEY
            TB_EVENT_RESIZE
            TB_EVENT_MOUSE
        ]
    ];
    #
    use constant {
        TB_EUNSUPPORTED_TERMINAL => -1,
        TB_EFAILED_TO_OPEN_TTY   => -2,
        TB_EPIPE_TRAP_ERROR      => -3
    };
    $EXPORT_TAGS{error} = [
        qw[
            TB_EUNSUPPORTED_TERMINAL
            TB_EFAILED_TO_OPEN_TTY
            TB_EPIPE_TRAP_ERROR
        ]
    ];
    #
    use constant { TB_HIDE_CURSOR => -1 };
    $EXPORT_TAGS{cursor} = [
        qw[
            TB_HIDE_CURSOR
        ]
    ];
    #
    use constant {
        TB_INPUT_CURRENT => 0,
        TB_INPUT_ESC     => 1,
        TB_INPUT_ALT     => 2,
        TB_INPUT_MOUSE   => => 4
    };
    $EXPORT_TAGS{input} = [
        qw[
            TB_INPUT_CURRENT
            TB_INPUT_ESC
            TB_INPUT_ALT
            TB_INPUT_MOUSE
        ]
    ];
    use constant {
        TB_OUTPUT_CURRENT   => 0,
        TB_OUTPUT_NORMAL    => 1,
        TB_OUTPUT_256       => 2,
        TB_OUTPUT_216       => 3,
        TB_OUTPUT_GRAYSCALE => 4
    };
    $EXPORT_TAGS{output} = [
        qw[
            TB_OUTPUT_NORMAL
            TB_OUTPUT_256
            TB_OUTPUT_216
            TB_OUTPUT_GRAYSCALE
        ]
    ];
    @EXPORT_OK          = sort map { @$_ = sort @$_; @$_ } values %EXPORT_TAGS;
    $EXPORT_TAGS{'all'} = \@EXPORT_OK;    # When you want to import everything

    #
    use Termbox::Cell;
    $ffi->type('record(Termbox::Cell)');
    #
    use Termbox::Event;
    $ffi->type('record(Termbox::Event)');
    #
    $ffi->attach( tb_init      => ['void']   => 'int' );
    $ffi->attach( tb_init_file => ['string'] => 'int' );
    $ffi->attach( tb_init_fd   => ['int']    => 'int' );
    $ffi->attach( tb_shutdown  => ['void']   => 'void' );
    #
    $ffi->attach( tb_width  => ['void'] => 'int' );
    $ffi->attach( tb_height => ['void'] => 'int' );
    #
    $ffi->attach( tb_clear                => ['void']                   => 'void' );
    $ffi->attach( tb_set_clear_attributes => [ 'uint16_t', 'uint16_t' ] => 'void' );
    #
    $ffi->attach( tb_present => ['void'] => 'void' );
    #
    $ffi->attach( tb_set_cursor => [ 'int', 'int' ] => 'void' );
    #
    $ffi->attach( tb_put_cell => [ 'int', 'int', 'record(Termbox::Cell)*' ] => 'void' );
    $ffi->attach( [ 'tb_change_cell' => '_tb_change_cell' ],
        [ 'int', 'int', 'uint32_t', 'uint16_t', 'uint16_t' ] => 'void' );

    # The C API expects a char which doesn't so much work with Perl's representation of a character.
    sub tb_change_cell {
        _tb_change_cell( $_[0], $_[1], ( length $_[2] == 1 ? ord( $_[2] ) : $_[2] ), $_[3], $_[4] );
    }
    #
    $ffi->attach( tb_cell_buffer => ['void'] => 'record(Termbox::Cell)*' );
    #
    $ffi->attach( tb_select_input_mode => ['int'] => 'int' );
    #
    $ffi->attach( tb_select_output_mode => ['int'] => 'int' );
    #
    $ffi->attach( tb_peek_event => [ 'record(Termbox::Event)*', 'int' ] => 'int' );
    #
    $ffi->attach( tb_poll_event => ['record(Termbox::Event)*'] => 'int' );

    # Utils: Not documented yet... might keep them private
    $ffi->attach( tb_utf8_char_length     => ['char']                   => 'int' );
    $ffi->attach( tb_utf8_char_to_unicode => [ 'uint32_t *', 'string' ] => 'int' );
    $ffi->attach( tb_utf8_unicode_to_char => [qw[string uint32_t]]      => 'int' );
    #
}
1;
__END__