diff --git a/AUTHORS b/AUTHORS index 7e6a5da..b53c6b3 100644 --- a/AUTHORS +++ b/AUTHORS @@ -2,4 +2,5 @@ $Id$ Sam Hocevar - main programmer Jean-Yves Lamoureux - cacaball +John Beppu - Term::Caca Perl wrapper diff --git a/perl/Build.PL b/perl/Build.PL new file mode 100644 index 0000000..8b9fb53 --- /dev/null +++ b/perl/Build.PL @@ -0,0 +1,22 @@ +use Module::Build; + +my $builder = Module::Build->new ( + module_name => 'Term::Caca', + license => 'lgpl', + + requires => { + }, + + build_requires => { + 'Test::More' => 0, + }, + + script_files => [ + ], + + extra_compiler_flags => scalar `caca-config --cflags`, + extra_linker_flags => scalar `caca-config --libs`, + create_makefile_pl => 'passthrough', +); + +$builder->create_build_script(); diff --git a/perl/MANIFEST b/perl/MANIFEST new file mode 100644 index 0000000..33d7f85 --- /dev/null +++ b/perl/MANIFEST @@ -0,0 +1,17 @@ +.cvsignore +Build.PL +lib/Term/Caca.pm +lib/Term/Caca.xs +lib/Term/Caca/Bitmap.pm +lib/Term/Caca/Constants.pm +lib/Term/Caca/Sprite.pm +lib/Term/Kaka.pm +lib/Term/Kaka/Bitmap.pm +lib/Term/Kaka/Constants.pm +lib/Term/Kaka/Sprite.pm +Makefile.PL +MANIFEST This list of files +MANIFEST.SKIP +META.yml +README +t/data/caca.txt diff --git a/perl/MANIFEST.SKIP b/perl/MANIFEST.SKIP new file mode 100644 index 0000000..785f09c --- /dev/null +++ b/perl/MANIFEST.SKIP @@ -0,0 +1,11 @@ +\bCVS\b +^MANIFEST\.bak$ +^Makefile$ +\..*\.swp$ +~$ +\bblib\b +\b\.xvpics\b +\b_build\b +^Build$ +^Linux-Input.*gz$ +^x.pl$ diff --git a/perl/META.yml b/perl/META.yml new file mode 100644 index 0000000..fa8b8fe --- /dev/null +++ b/perl/META.yml @@ -0,0 +1,29 @@ +--- #YAML:1.0 +name: Term-Caca +version: 0.9_1 +author: ~ +abstract: |- + perl interface for libcaca (Colour AsCii Art library) +license: lgpl +build_requires: + Test::More: 0 +provides: + Term::Caca: + file: lib/Term/Caca.pm + version: 0.9_1 + Term::Caca::Bitmap: + file: lib/Term/Caca/Bitmap.pm + Term::Caca::Constants: + file: lib/Term/Caca/Constants.pm + version: 0.9 + Term::Caca::Sprite: + file: lib/Term/Caca/Sprite.pm + Term::Kaka: + file: lib/Term/Kaka.pm + Term::Kaka::Bitmap: + file: lib/Term/Kaka/Bitmap.pm + Term::Kaka::Constants: + file: lib/Term/Kaka/Constants.pm + Term::Kaka::Sprite: + file: lib/Term/Kaka/Sprite.pm +generated_by: Module::Build version 0.26 diff --git a/perl/Makefile.PL b/perl/Makefile.PL new file mode 100644 index 0000000..51d31fd --- /dev/null +++ b/perl/Makefile.PL @@ -0,0 +1,31 @@ +# Note: this file was auto-generated by Module::Build::Compat version 0.03 + + unless (eval "use Module::Build::Compat 0.02; 1" ) { + print "This module requires Module::Build to install itself.\n"; + + require ExtUtils::MakeMaker; + my $yn = ExtUtils::MakeMaker::prompt + (' Install Module::Build now from CPAN?', 'y'); + + unless ($yn =~ /^y/i) { + die " *** Cannot install without Module::Build. Exiting ...\n"; + } + + require Cwd; + require File::Spec; + require CPAN; + + # Save this 'cause CPAN will chdir all over the place. + my $cwd = Cwd::cwd(); + my $makefile = File::Spec->rel2abs($0); + + CPAN::Shell->install('Module::Build::Compat') + or die " *** Cannot install without Module::Build. Exiting ...\n"; + + chdir $cwd or die "Cannot chdir() back to $cwd: $!"; + } + eval "use Module::Build::Compat 0.02; 1" or die $@; + use lib '_build/lib'; + Module::Build::Compat->run_build_pl(args => \@ARGV); + require Module::Build; + Module::Build::Compat->write_makefile(build_class => 'Module::Build'); diff --git a/perl/README b/perl/README new file mode 100644 index 0000000..00041f0 --- /dev/null +++ b/perl/README @@ -0,0 +1,21 @@ +___________ _________ +\__ ___/__________ _____ /\ /\ \_ ___ \_____ ____ _____ + | |_/ __ \_ __ \/ \ \/ \/ / \ \/\__ \ _/ ___\\__ \ + | |\ ___/| | \/ Y Y \ /\ /\ \ \____/ __ \\ \___ / __ \_ + |____| \___ >__| |__|_| / \/ \/ \______ (____ /\___ >____ / + \/ \/ \/ \/ \/ \/ + +--]- a perl wrapper around libcaca (Colour AsCii Art library) + ^ ^ ^ ^ + http://sam.zoy.org/projects/libcaca/ + + +--]- a note about versioning, + + Term-Caca-x.y_z.tar.gz + | | ^--------- sub-version of this perl wrapper + | | + `-`----------- version of libcaca c library + this wrapper is based on. + + diff --git a/perl/lib/Term/Caca.pm b/perl/lib/Term/Caca.pm new file mode 100644 index 0000000..dcfb333 --- /dev/null +++ b/perl/lib/Term/Caca.pm @@ -0,0 +1,389 @@ +package Term::Caca; + +require Exporter; +require DynaLoader; +$VERSION = '0.9_1'; +@ISA = qw(Exporter DynaLoader); +Term::Caca->bootstrap($VERSION); + +use strict; +use Term::Caca::Constants ':all'; + +# Basic functions + +# constructor +sub new { + my ($class) = @_; + _init(); + my $self = { }; + return bless($self => $class); +} +*init = \*new; + +# set delay for establishing constant framerate +sub set_delay { + my ($self, $usec) = @_; + $usec ||= 0; + _set_delay($usec); +} + +# +sub get_feature { + my ($self, $feature) = @_; + $feature ||= 0; + return _get_feature($feature); +} + +# +sub set_feature { + my ($self, $feature) = @_; + $feature ||= 0; + _get_feature($feature); +} + +# +sub get_feature_name { + my ($self, $feature) = @_; + $feature ||= 0; + return _get_feature_name($feature); +} + +# +sub get_rendertime { +# my ($self) = @_; + return _get_rendertime(); +} + +# +sub get_width { +# my ($self) = @_; + return _get_width(); +} + +# +sub get_height { +# my ($self) = @_; + return _get_height(); +} + +# +sub set_window_title { + my ($self, $title) = @_; + $title ||= ""; + return _set_window_title($title); +} + +# +sub get_window_width { +# my ($self) = @_; + return _get_window_width(); +} + +# +sub get_window_height { +# my ($self) = @_; + return _get_window_height(); +} + +# +sub refresh { + _refresh(); +} + +# destructor +sub DESTROY { + my ($self) = @_; + _end(); +} + +# Event handling + +# +sub get_event { + my ($self, $event_mask) = @_; + if (!defined($event_mask)) { + $event_mask = 0xFFFFFFFF; + } + return _get_event($event_mask); +} + +# +sub get_mouse_x { + my ($self) = @_; + return _get_mouse_x(); +} + +# +sub get_mouse_y { + my ($self) = @_; + return _get_mouse_y(); +} + +# +sub wait_event { + my ($self, $event_mask) = @_; + $event_mask ||= CACA_EVENT_ANY; + return _wait_event($event_mask); +} + +1; + +# Character printing + +# +sub set_color { + my ($self, $fgcolor, $bgcolor) = @_; + $fgcolor ||= CACA_COLOR_LIGHTGRAY; + $bgcolor ||= CACA_COLOR_BLACK; + return _set_color($fgcolor, $bgcolor); +} + +# +sub get_fg_color { + my ($self) = @_; + return _get_fg_color(); +} + +# +sub get_bg_color { + my ($self) = @_; + return _get_bg_color(); +} + +# +sub get_color_name { + my ($self, $color) = @_; + return undef unless(defined($color)); + return _get_color_name($color); +} + +# +sub putchar { + my ($self, $x, $y, $c) = @_; + $x ||= 0; + $y ||= 0; + $c ||= ""; + _putchar($x, $y, $c); +} + +# +sub putstr { + my ($self, $x, $y, $s) = @_; + $x ||= 0; + $y ||= 0; + $s ||= ""; + _putstr($x, $y, $s); +} + +# faking it by doing printf on the perl side +sub printf { + my ($self, $x, $y, $s, @args) = @_; + $x ||= 0; + $y ||= 0; + my $string = sprintf($s, @args); + _putstr($x, $y, $string); +} + +# +sub clear { + _clear(); +} + +# Primitives drawing + +# +sub draw_line { + my ($self, $x1, $y1, $x2, $y2, $c) = @_; + _draw_line($x1, $y1, $x2, $y2, $c); +} + +# +sub draw_polyline { + my ($self, $x, $y, $n, $c) = @_; + _draw_polyline($x, $y, $n, $c); +} + +# +sub draw_thin_line { + my ($self, $x1, $y1, $x2, $y2) = @_; + _draw_thin_line($x1, $y1, $x2, $y2); +} + +# +sub draw_thin_polyline { + my ($self, $x, $y, $n) = @_; + _draw_thin_polyline($x, $y, $n); +} + +# +sub draw_circle { + my ($self, $x, $y, $r, $c) = @_; + # TODO : check for sane values + _draw_circle($x, $y, $r, $c); +} + +# +sub draw_ellipse { + my ($self, $x0, $y0, $ra, $rb, $c) = @_; + _draw_ellipse($x0, $y0, $ra, $rb, $c); +} + +# +sub draw_thin_ellipse { + my ($self, $x0, $y0, $ra, $rb) = @_; + _draw_ellipse($x0, $y0, $ra, $rb); +} + +# +sub fill_ellipse { + my ($self, $x0, $y0, $ra, $rb, $c) = @_; + _fill_ellipse($x0, $y0, $ra, $rb, $c); +} + +# +sub draw_box { + my ($self, $x0, $y0, $x1, $y1, $c) = @_; + _draw_box($x0, $y0, $x1, $y1, $c); +} + +# +sub draw_thin_box { + my ($self, $x0, $y0, $x1, $y1) = @_; + _draw_thin_box($x0, $y0, $x1, $y1); +} + +# +sub fill_box { + my ($self, $x0, $y0, $x1, $y1, $c) = @_; + _fill_box($x0, $y0, $x1, $y1, $c); +} + +# +sub draw_triangle { + my ($self, $x0, $y0, $x1, $y1, $x2, $y2, $c) = @_; + _draw_triangle($x0, $y0, $x1, $y1, $x2, $y2, $c); +} + +# +sub draw_thin_triangle { + my ($self, $x0, $y0, $x1, $y1, $x2, $y2) = @_; + _draw_thin_triangle($x0, $y0, $x1, $y1, $x2, $y2); +} + +# +sub fill_triangle { + my ($self, $x0, $y0, $x1, $y1, $x2, $y2, $c) = @_; + _fill_triangle($x0, $y0, $x1, $y1, $x2, $y2, $c); +} + +# Mathematical functions + +# +sub rand { + my ($self, $min, $max) = @_; + return _rand($min, $max); +} + +# +sub sqrt { + my ($self, $n) = @_; + return _sqrt($n); +} + +# Sprite handling + +# +sub load_sprite { + my ($self, $file) = @_; + my $sprite = _load_sprite($file); +} + +# +sub get_sprite_frames { + my ($self, $sprite) = @_; + return _get_sprite_frames($sprite); +} + +# +sub get_sprite_width { + my ($self, $sprite) = @_; + return _get_sprite_width($sprite); +} + +# +sub get_sprite_height { + my ($self, $sprite) = @_; + return _get_sprite_height($sprite); +} + +# +sub get_sprite_dx { + my ($self, $sprite) = @_; + return _get_sprite_dx($sprite); +} + +# +sub get_sprite_dy { + my ($self, $sprite) = @_; + return _get_sprite_dy($sprite); +} + +# +sub draw_sprite { + my ($self, $x, $y, $sprite, $f) = @_; + _draw_sprite($x, $y, $sprite, $f); +} + +# +sub free_sprite { + my ($self, $sprite) = @_; + _free_sprite($sprite); +} + +# Bitmap handling + +# +sub create_bitmap { + my ($self, $bpp, $w, $h, $pitch, $rmask, $gmask, $bmask, $amask) = @_; + _create_bitmap($bpp, $w, $h, $pitch, $rmask, $gmask, $bmask, $amask); +} + +# +sub set_bitmap_palette { + my ($self, $bitmap, $red, $green, $blue, $alpha) = @_; + _set_bitmap_palette($bitmap, $red, $green, $blue, $alpha); +} + +# +sub draw_bitmap { + my ($self, $x1, $y1, $x2, $y2, $bitmap, $pixels) = @_; + _draw_bitmap($x1, $y1, $x2, $y2, $bitmap, $pixels); +} + +sub free_bitmap { + my ($self, $bitmap) = @_; + _free_bitmap($bitmap); +} + +__END__ + +=head1 NAME + +Term::Caca - perl interface for libcaca (Colour AsCii Art library) + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +=head2 Class Methods + +=head2 Object Methods + +=head1 AUTHOR + +=head1 SEE ALSO + +=cut + +# vim:sw=2 sts=2 expandtab +# $Id: Caca.pm,v 1.5 2004/10/25 18:14:57 beppu Exp $ diff --git a/perl/lib/Term/Caca.xs b/perl/lib/Term/Caca.xs new file mode 100644 index 0000000..5965608 --- /dev/null +++ b/perl/lib/Term/Caca.xs @@ -0,0 +1,650 @@ +/* What will I use my programming skill for? */ + +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +#include "caca.h" + +/* ref($sprite) eq 'HASH' && $sprite->{__address__} */ +void * +address_of(SV *sprite) +{ + /* make sure sprite is a hashref */ + if (SvTYPE(SvRV(sprite)) != SVt_PVHV) { + return NULL; + } + return (struct caca_sprite *) + SvIV(*hv_fetch((HV *) SvRV(sprite), "__address__", 11, 0)); +} + +/* turn a perl array of numbers into a c array */ +void * +c_array(SV *p_array) +{ +} + +MODULE = Term::Caca PACKAGE = Term::Caca + +# -==[- Basic functions -]==-------------------------------------------------- + +void +_init() + CODE: + caca_init(); + +void +_set_delay(usec) + unsigned int usec + CODE: + caca_set_delay(usec); + +unsigned int +_get_feature(feature) + unsigned int feature + CODE: + RETVAL = caca_get_feature(feature); + OUTPUT: + RETVAL + +void +_set_feature(feature) + unsigned int feature + CODE: + caca_set_feature(feature); + +const char * +_get_feature_name(feature) + unsigned int feature + CODE: + RETVAL = caca_get_feature_name(feature); + OUTPUT: + RETVAL + +unsigned int +_get_rendertime() + CODE: + RETVAL = caca_get_rendertime(); + OUTPUT: + RETVAL + +unsigned int +_get_width() + CODE: + RETVAL = caca_get_width(); + OUTPUT: + RETVAL + +unsigned int +_get_height() + CODE: + RETVAL = caca_get_height(); + OUTPUT: + RETVAL + +int +_set_window_title(title) + const char *title + CODE: + RETVAL = caca_set_window_title(title); + OUTPUT: + RETVAL + +unsigned int +_get_window_width() + CODE: + RETVAL = caca_get_window_width(); + OUTPUT: + RETVAL + +unsigned int +_get_window_height() + CODE: + RETVAL = caca_get_window_height(); + OUTPUT: + RETVAL + +void +_refresh() + CODE: + caca_refresh(); + +void +_end() + CODE: + caca_end(); + +# -==[- Event handling -]==--------------------------------------------------- + +unsigned int +_get_event(event_mask) + unsigned int event_mask + CODE: + RETVAL = caca_get_event(event_mask); + OUTPUT: + RETVAL + +unsigned int +_get_mouse_x() + CODE: + RETVAL = caca_get_mouse_x(); + OUTPUT: + RETVAL + +unsigned int +_get_mouse_y() + CODE: + RETVAL = caca_get_mouse_y(); + OUTPUT: + RETVAL + +unsigned int +_wait_event(event_mask) + unsigned int event_mask + CODE: + RETVAL = caca_wait_event(event_mask); + OUTPUT: + RETVAL + +# -==[- Character printing -]==----------------------------------------------- + +void +_set_color(fgcolor, bgcolor) + unsigned int fgcolor; + unsigned int bgcolor; + CODE: + caca_set_color(fgcolor, bgcolor); + +unsigned int +_get_fg_color() + CODE: + RETVAL = caca_get_fg_color(); + OUTPUT: + RETVAL + +unsigned int +_get_bg_color() + CODE: + RETVAL = caca_get_bg_color(); + OUTPUT: + RETVAL + +const char * +_get_color_name(color) + unsigned int color + CODE: + RETVAL = caca_get_color_name(color); + OUTPUT: + RETVAL + +void +_putchar(x, y, c) + int x; + int y; + char c; + CODE: + caca_putchar(x, y, c); + +void +_putstr(x, y, s) + int x; + int y; + const char *s; + CODE: + caca_putstr(x, y, s); + +# skip caca_printf for now. +# handle va_args on perl side. + +void +_clear() + CODE: + caca_clear(); + +# -==[- Primitives drawing -]==----------------------------------------------- + +void +_draw_line(x1, y1, x2, y2, c) + int x1; + int y1; + int x2; + int y2; + char c; + CODE: + caca_draw_line(x1, y1, x2, y2, c); + +void +_draw_polyline(x, y, n, c) + SV *x; + SV *y; + int n; + char c; + INIT: + int *xc; + int *yc; + int i; + /* make sure x and y are perl arrayrefs */ + if ( (SvTYPE(SvRV(x)) != SVt_PVAV) + || (SvTYPE(SvRV(y)) != SVt_PVAV) ) + { + XSRETURN_UNDEF; + } + + /* create a C int array out of x and y */ + xc = (int *) malloc((n+1) * sizeof(int *)); + if (!xc) { + XSRETURN_UNDEF; + } + yc = (int *) malloc((n+1) * sizeof(int *)); + if (!yc) { + XSRETURN_UNDEF; + } + for (i = 0; i <= n; i++) { + SV **integer; + + integer = av_fetch((AV *) SvRV(x), i, 0); + if (integer) { + xc[i] = SvIV(*integer); + } else { + xc[i] = 0; + } + + integer = av_fetch((AV *) SvRV(y), i, 0); + if (integer) { + yc[i] = SvIV(*integer); + } else { + yc[i] = 0; + } + } + CODE: + caca_draw_polyline(xc, yc, n, c); + free(yc); + free(xc); + +void +_draw_thin_line(x1, y1, x2, y2) + int x1; + int y1; + int x2; + int y2; + CODE: + caca_draw_thin_line(x1, y1, x2, y2); + +void +_draw_thin_polyline(x, y, n) + SV *x; + SV *y; + int n; + INIT: + int *xc; + int *yc; + int i; + /* make sure x and y are perl arrayrefs */ + if ( (SvTYPE(SvRV(x)) != SVt_PVAV) + || (SvTYPE(SvRV(y)) != SVt_PVAV) ) + { + XSRETURN_UNDEF; + } + + /* create a C int array out of x and y */ + xc = (int *) malloc((n+1) * sizeof(int *)); + if (!xc) { + XSRETURN_UNDEF; + } + yc = (int *) malloc((n+1) * sizeof(int *)); + if (!yc) { + XSRETURN_UNDEF; + } + for (i = 0; i <= n; i++) { + SV **integer; + + integer = av_fetch((AV *) SvRV(x), i, 0); + if (integer) { + xc[i] = SvIV(*integer); + } else { + xc[i] = 0; + } + + integer = av_fetch((AV *) SvRV(y), i, 0); + if (integer) { + yc[i] = SvIV(*integer); + } else { + yc[i] = 0; + } + } + CODE: + caca_draw_thin_polyline(xc, yc, n); + free(yc); + free(xc); + +void +_draw_circle(x, y, r, c) + int x; + int y; + int r; + char c; + CODE: + caca_draw_circle(x, y, r, c); + +void +_draw_ellipse(x0, y0, a, b, c) + int x0; + int y0; + int a; + int b; + char c; + CODE: + caca_draw_ellipse(x0, y0, a, b, c); + +void +_draw_thin_ellipse(x0, y0, a, b) + int x0; + int y0; + int a; + int b; + CODE: + caca_draw_thin_ellipse(x0, y0, a, b); + +void +_fill_ellipse(x0, y0, a, b, c) + int x0; + int y0; + int a; + int b; + char c; + CODE: + caca_fill_ellipse(x0, y0, a, b, c); + +void +_draw_box(x0, y0, x1, y1, c) + int x0; + int y0; + int x1; + int y1; + char c; + CODE: + caca_draw_box(x0, y0, x1, y1, c); + +void +_draw_thin_box(x0, y0, x1, y1) + int x0; + int y0; + int x1; + int y1; + CODE: + caca_thin_box(x0, y0, x1, y1); + +void +_fill_box(x0, y0, x1, y1, c) + int x0; + int y0; + int x1; + int y1; + char c; + CODE: + caca_fill_box(x0, y0, x1, y1, c); + +void +_draw_triangle(x0, y0, x1, y1, x2, y2, c) + int x0; + int y0; + int x1; + int y1; + int x2; + int y2; + char c; + CODE: + caca_draw_triangle(x0, y0, x1, y1, x2, y2, c); + +void +_draw_thin_triangle(x0, y0, x1, y1, x2, y2) + int x0; + int y0; + int x1; + int y1; + int x2; + int y2; + CODE: + caca_draw_thin_triangle(x0, y0, x1, y1, x2, y2); + +void +_fill_triangle(x0, y0, x1, y1, x2, y2, c) + int x0; + int y0; + int x1; + int y1; + int x2; + int y2; + char c; + CODE: + caca_fill_triangle(x0, y0, x1, y1, x2, y2, c); + +# -==[- Mathematical functions -]==------------------------------------------- + +int +_rand(min, max) + int min; + int max; + CODE: + RETVAL = caca_rand(min, max); + OUTPUT: + RETVAL + +unsigned int +_sqrt(n) + unsigned int n; + CODE: + RETVAL = caca_sqrt(n); + OUTPUT: + RETVAL + +# -==[- Sprite handling -]==- + +SV * +_load_sprite(file) + const char *file + INIT: + struct caca_sprite *c_sprite; + HV *sprite; + CODE: + if (!file) { + XSRETURN_UNDEF; + } + c_sprite = caca_load_sprite(file); + if (!c_sprite) { + XSRETURN_UNDEF; + } else { + sprite = (HV *) sv_2mortal((SV *) newHV()); + if (!sprite) { + XSRETURN_UNDEF; + } + hv_store(sprite, "__address__", 11, newSViv((int) c_sprite), 0); + RETVAL = newRV((SV *) sprite); + } + OUTPUT: + RETVAL + +int +_get_sprite_frames(sprite) + SV *sprite + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + RETVAL = caca_get_sprite_frames(c_sprite); + OUTPUT: + RETVAL + +int +_get_sprite_width(sprite, f) + SV *sprite; + int f; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + RETVAL = caca_get_sprite_width(c_sprite, f); + OUTPUT: + RETVAL + +int +_get_sprite_height(sprite, f) + SV *sprite; + int f; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + RETVAL = caca_get_sprite_height(c_sprite, f); + OUTPUT: + RETVAL + +int +_get_sprite_dx(sprite, f) + SV *sprite; + int f; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + RETVAL = caca_get_sprite_dx(c_sprite, f); + OUTPUT: + RETVAL + +int +_get_sprite_dy(sprite, f) + SV *sprite; + int f; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + RETVAL = caca_get_sprite_dy(c_sprite, f); + OUTPUT: + RETVAL + +void +_draw_sprite(x, y, sprite, f) + int x; + int y; + SV *sprite; + int f; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + caca_draw_sprite(x, y, c_sprite, f); + +void +_free_sprite(sprite) + SV *sprite; + INIT: + struct caca_sprite *c_sprite; + c_sprite = address_of(sprite); + if (!c_sprite) { + XSRETURN_UNDEF; + } + CODE: + caca_free_sprite(c_sprite); + +# -==[- Bitmap handling -]==-------------------------------------------------- + +SV * +_create_bitmap(bpp, w, h, pitch, rmask, gmask, bmask, amask) + unsigned int bpp; + unsigned int w; + unsigned int h; + unsigned int pitch; + unsigned int rmask; + unsigned int gmask; + unsigned int bmask; + unsigned int amask; + INIT: + struct caca_bitmap *c_bitmap; + HV *bitmap; + CODE: + c_bitmap = + caca_create_bitmap(bpp, w, h, pitch, rmask, gmask, bmask, amask); + if (!c_bitmap) { + XSRETURN_UNDEF; + } else { + bitmap = (HV *) sv_2mortal((SV *) newHV()); + if (!bitmap) { + XSRETURN_UNDEF; + } + hv_store(bitmap, "__address__", 11, newSViv((int) c_bitmap), 0); + hv_store(bitmap, "__bpp__", 7, newSViv((int) bpp ), 0); + RETVAL = newRV((SV *) bitmap); + } + OUTPUT: + RETVAL + +void +_set_bitmap_palette(bitmap, red, green, blue, alpha) + SV *bitmap; + SV *red; + SV *green; + SV *blue; + SV *alpha; + INIT: + struct caca_bitmap *c_bitmap; + unsigned int *c_red; + unsigned int *c_green; + unsigned int *c_blue; + unsigned int *c_alpha; + + c_bitmap = address_of(bitmap); + if (!c_bitmap) { + XSRETURN_UNDEF; + } + /* TODO: perl array to c array */ + c_red = c_array(red); + c_green = c_array(green); + c_blue = c_array(blue); + c_alpha = c_array(alpha); + CODE: + caca_set_bitmap_palette(c_bitmap, c_red, c_green, c_blue, c_alpha); + +void +_draw_bitmap(x1, y1, x2, y2, bitmap, pixels) + int x1; + int y1; + int x2; + int y2; + SV *bitmap; + SV *pixels; + INIT: + /* TODO: implement Tie::Scalar::Pointer for pixel support */ + CODE: + +void +_free_bitmap(bitmap) + SV *bitmap; + INIT: + struct caca_bitmap *c_bitmap; + c_bitmap = address_of(bitmap); + if (!c_bitmap) { + XSRETURN_UNDEF; + } + CODE: + caca_free_bitmap(c_bitmap); + +# vim:sw=2 sts=2 expandtab diff --git a/perl/lib/Term/Caca/Bitmap.pm b/perl/lib/Term/Caca/Bitmap.pm new file mode 100644 index 0000000..dcd6d02 --- /dev/null +++ b/perl/lib/Term/Caca/Bitmap.pm @@ -0,0 +1,5 @@ +package Term::Caca::Bitmap; + + +1; + diff --git a/perl/lib/Term/Caca/Constants.pm b/perl/lib/Term/Caca/Constants.pm new file mode 100644 index 0000000..8c124b7 --- /dev/null +++ b/perl/lib/Term/Caca/Constants.pm @@ -0,0 +1,332 @@ +package Term::Caca::Constants; + +use strict; +use base 'Exporter'; +use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION); + +$VERSION = '0.9'; + +use constant { + + ## enum caca_color + + CACA_COLOR_BLACK => 0, + CACA_COLOR_BLUE => 1, + CACA_COLOR_GREEN => 2, + CACA_COLOR_CYAN => 3, + CACA_COLOR_RED => 4, + CACA_COLOR_MAGENTA => 5, + CACA_COLOR_BROWN => 6, + CACA_COLOR_LIGHTGRAY => 7, + CACA_COLOR_DARKGRAY => 8, + CACA_COLOR_LIGHTBLUE => 9, + CACA_COLOR_LIGHTGREEN => 10, + CACA_COLOR_LIGHTCYAN => 11, + CACA_COLOR_LIGHTRED => 12, + CACA_COLOR_LIGHTMAGENTA => 13, + CACA_COLOR_YELLOW => 14, + CACA_COLOR_WHITE => 15, + + ## enum caca_feature + + CACA_BACKGROUND => 0x10, + CACA_BACKGROUND_BLACK => 0x11, + CACA_BACKGROUND_SOLID => 0x12, + + CACA_BACKGROUND_MIN => 0x11, + CACA_BACKGROUND_MAX => 0x12, + + CACA_ANTIALIASING => 0x20, + CACA_ANTIALIASING_NONE => 0x21, + CACA_ANTIALIASING_PREFILTER => 0x22, + + CACA_ANTIALIASING_MIN => 0x21, + CACA_ANTIALIASING_MAX => 0x22, + + CACA_DITHERING => 0x30, + CACA_DITHERING_NONE => 0x31, + CACA_DITHERING_ORDERED2 => 0x32, + CACA_DITHERING_ORDERED4 => 0x33, + CACA_DITHERING_ORDERED8 => 0x34, + CACA_DITHERING_RANDOM => 0x35, + + CACA_DITHERING_MIN => 0x31, + CACA_DITHERING_MAX => 0x35, + + CACA_FEATURE_UNKNOWN => 0xffff, + + ## enum caca_event + + CACA_EVENT_NONE => 0x00000000, + CACA_EVENT_KEY_PRESS => 0x01000000, + CACA_EVENT_KEY_RELEASE => 0x02000000, + CACA_EVENT_MOUSE_PRESS => 0x04000000, + CACA_EVENT_MOUSE_RELEASE => 0x08000000, + CACA_EVENT_MOUSE_MOTION => 0x10000000, + CACA_EVENT_RESIZE => 0x20000000, + CACA_EVENT_ANY => 0xff000000, + + ## enum caca_key + CACA_KEY_UNKNOWN => 0, + + # /* The following keys have ASCII equivalents */ + CACA_KEY_BACKSPACE => 8, + CACA_KEY_TAB => 9, + CACA_KEY_RETURN => 13, + CACA_KEY_PAUSE => 19, + CACA_KEY_ESCAPE => 27, + CACA_KEY_DELETE => 127, + + # /* The following keys do not have ASCII equivalents but have been + # * chosen to match the SDL equivalents */ + CACA_KEY_UP => 273, + CACA_KEY_DOWN => 274, + CACA_KEY_LEFT => 275, + CACA_KEY_RIGHT => 276, + CACA_KEY_INSERT => 277, + CACA_KEY_HOME => 278, + CACA_KEY_END => 279, + CACA_KEY_PAGEUP => 280, + CACA_KEY_PAGEDOWN => 281, + CACA_KEY_F1 => 282, + CACA_KEY_F2 => 283, + CACA_KEY_F3 => 284, + CACA_KEY_F4 => 285, + CACA_KEY_F5 => 286, + CACA_KEY_F6 => 287, + CACA_KEY_F7 => 288, + CACA_KEY_F8 => 289, + CACA_KEY_F9 => 290, + CACA_KEY_F10 => 291, + CACA_KEY_F11 => 292, + CACA_KEY_F12 => 293, + CACA_KEY_F13 => 294, + CACA_KEY_F14 => 295, + CACA_KEY_F15 => 296, + +}; + +@EXPORT_OK = qw( + + CACA_COLOR_BLACK + CACA_COLOR_BLUE + CACA_COLOR_GREEN + CACA_COLOR_CYAN + CACA_COLOR_RED + CACA_COLOR_MAGENTA + CACA_COLOR_BROWN + CACA_COLOR_LIGHTGRAY + CACA_COLOR_DARKGRAY + CACA_COLOR_LIGHTBLUE + CACA_COLOR_LIGHTGREEN + CACA_COLOR_LIGHTCYAN + CACA_COLOR_LIGHTRED + CACA_COLOR_LIGHTMAGENTA + CACA_COLOR_YELLOW + CACA_COLOR_WHITE + + + CACA_BACKGROUND + CACA_BACKGROUND_BLACK + CACA_BACKGROUND_SOLID + + CACA_BACKGROUND_MIN + CACA_BACKGROUND_MAX + + CACA_ANTIALIASING + CACA_ANTIALIASING_NONE + CACA_ANTIALIASING_PREFILTER + + CACA_ANTIALIASING_MIN + CACA_ANTIALIASING_MAX + + CACA_DITHERING + CACA_DITHERING_NONE + CACA_DITHERING_ORDERED2 + CACA_DITHERING_ORDERED4 + CACA_DITHERING_ORDERED8 + CACA_DITHERING_RANDOM + + CACA_DITHERING_MIN + CACA_DITHERING_MAX + + CACA_FEATURE_UNKNOWN + + + CACA_EVENT_NONE + CACA_EVENT_KEY_PRESS + CACA_EVENT_KEY_RELEASE + CACA_EVENT_MOUSE_PRESS + CACA_EVENT_MOUSE_RELEASE + CACA_EVENT_MOUSE_MOTION + CACA_EVENT_RESIZE + CACA_EVENT_ANY + + CACA_KEY_UNKNOWN + + CACA_KEY_BACKSPACE + CACA_KEY_TAB + CACA_KEY_RETURN + CACA_KEY_PAUSE + CACA_KEY_ESCAPE + CACA_KEY_DELETE + + CACA_KEY_UP + CACA_KEY_DOWN + CACA_KEY_LEFT + CACA_KEY_RIGHT + CACA_KEY_INSERT + CACA_KEY_HOME + CACA_KEY_END + CACA_KEY_PAGEUP + CACA_KEY_PAGEDOWN + CACA_KEY_F1 + CACA_KEY_F2 + CACA_KEY_F3 + CACA_KEY_F4 + CACA_KEY_F5 + CACA_KEY_F6 + CACA_KEY_F7 + CACA_KEY_F8 + CACA_KEY_F9 + CACA_KEY_F10 + CACA_KEY_F11 + CACA_KEY_F12 + CACA_KEY_F13 + CACA_KEY_F14 + CACA_KEY_F15 +); + +%EXPORT_TAGS = ( + colors => [ qw( + CACA_COLOR_BLACK + CACA_COLOR_BLUE + CACA_COLOR_GREEN + CACA_COLOR_CYAN + CACA_COLOR_RED + CACA_COLOR_MAGENTA + CACA_COLOR_BROWN + CACA_COLOR_LIGHTGRAY + CACA_COLOR_DARKGRAY + CACA_COLOR_LIGHTBLUE + CACA_COLOR_LIGHTGREEN + CACA_COLOR_LIGHTCYAN + CACA_COLOR_LIGHTRED + CACA_COLOR_LIGHTMAGENTA + CACA_COLOR_YELLOW + CACA_COLOR_WHITE + ) ], + + features => [ qw( + CACA_BACKGROUND + CACA_BACKGROUND_BLACK + CACA_BACKGROUND_SOLID + + CACA_BACKGROUND_MIN + CACA_BACKGROUND_MAX + + CACA_ANTIALIASING + CACA_ANTIALIASING_NONE + CACA_ANTIALIASING_PREFILTER + + CACA_ANTIALIASING_MIN + CACA_ANTIALIASING_MAX + + CACA_DITHERING + CACA_DITHERING_NONE + CACA_DITHERING_ORDERED2 + CACA_DITHERING_ORDERED4 + CACA_DITHERING_ORDERED8 + CACA_DITHERING_RANDOM + + CACA_DITHERING_MIN + CACA_DITHERING_MAX + + CACA_FEATURE_UNKNOWN + ) ], + + events => [ qw( + CACA_EVENT_NONE + CACA_EVENT_KEY_PRESS + CACA_EVENT_KEY_RELEASE + CACA_EVENT_MOUSE_PRESS + CACA_EVENT_MOUSE_RELEASE + CACA_EVENT_MOUSE_MOTION + CACA_EVENT_RESIZE + CACA_EVENT_ANY + ) ], + + 'keys' => [ qw( + CACA_KEY_UNKNOWN + + CACA_KEY_BACKSPACE + CACA_KEY_TAB + CACA_KEY_RETURN + CACA_KEY_PAUSE + CACA_KEY_ESCAPE + CACA_KEY_DELETE + + CACA_KEY_UP + CACA_KEY_DOWN + CACA_KEY_LEFT + CACA_KEY_RIGHT + CACA_KEY_INSERT + CACA_KEY_HOME + CACA_KEY_END + CACA_KEY_PAGEUP + CACA_KEY_PAGEDOWN + CACA_KEY_F1 + CACA_KEY_F2 + CACA_KEY_F3 + CACA_KEY_F4 + CACA_KEY_F5 + CACA_KEY_F6 + CACA_KEY_F7 + CACA_KEY_F8 + CACA_KEY_F9 + CACA_KEY_F10 + CACA_KEY_F11 + CACA_KEY_F12 + CACA_KEY_F13 + CACA_KEY_F14 + CACA_KEY_F15 + ) ], + + all => [ ], +); + +# add all the other ":class" tags to the ":all" class, +# deleting duplicates +{ + my %seen; + + push @{$EXPORT_TAGS{all}}, + grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach keys %EXPORT_TAGS; +} + + +1; + +__END__ + +=head1 NAME + +Term::Caca::Constants - libcaca constants from caca.h + +=head1 SYNOPSIS + +Import all constants into current package/namespace: + + use Term::Caca::Constants ':all'; + +Only import the constants pertaining to events and keys: + + use Term::Caca qw(:events :keys); + +=head1 DESCRIPTION + + + +=cut + +# $Id: Constants.pm,v 1.1 2004/10/18 21:00:56 beppu Exp $ diff --git a/perl/lib/Term/Caca/Sprite.pm b/perl/lib/Term/Caca/Sprite.pm new file mode 100644 index 0000000..02aeff3 --- /dev/null +++ b/perl/lib/Term/Caca/Sprite.pm @@ -0,0 +1,5 @@ +package Term::Caca::Sprite; + + +1; + diff --git a/perl/lib/Term/Kaka.pm b/perl/lib/Term/Kaka.pm new file mode 100644 index 0000000..0569031 --- /dev/null +++ b/perl/lib/Term/Kaka.pm @@ -0,0 +1,71 @@ +package Term::Kaka; +use base 'Term::Caca'; +1; + +__END__ + +=head1 NAME + +Term::Kaka - a subclass of Term::Caca with virtually identical behavior + +=head1 SYNOPSIS + +Extra thin wrapper for your pleasure + + package Term::Kaka; + use base 'Term::Caca'; + 1; + +=head1 WHY? + +Somewhere deep in the bowels of gmail.google.com.... + +Subject: B + +B to Pip + + Pip, + + Based on the name alone, I think this should be the basis of the + framebuffer for ASCIIker. Even if the name weren't so apropos, the + library itself looks really good to me in terms of how it's coded and + the API that it provides. I think making a set of perl modules around + this and making a Term::Caca distribution would be the right thing for + me to do. + + http://sam.zoy.org/projects/libcaca/ + +B to me + + My only gripe is ... well the spelling. I believe it should almost + always be spelled 'kaka'. Both spellings have been understood && + acceptable according to linguists for quite some time but... my + highschool friends && I agreed that the K makes it harder && harsher + ... && when you're discussing kaka... it should be harsh... it should + sound harsh... it should smell harsh. The C is like a lame copout && + should only be used by the uninformed or for temperament (which I have + never employed when referring to kaka). Maybe it's like eskimos with + tons of names for snow. I think of all sorts of stuff ... refuse... + somewhat affectionately yet recognizing the crap nature... in order of + use: kaka, dung, poop, crap, plop, slop, spit, stuf, shat, stul... + shit is reserved for extreme occasion. These are all my 4-letter + variable names that have been with me for a long time. This is deeply + rooted in me &&... I can't imagine ever accepting the C spelling. + It's weird... I could accept alternate spellings of any of the others + but I must protest for kaka. I know it's rather difficult to take + this complaint seriously since it... well has no technical basis ... + but kaka is kaka... it's like KAKA!!! I know that's a lame argument. + I'm not prepared to defend it more soundly... maybe the module could + be Term::Kaka that wraps libcaca? I know that's probably weird but... + what else can I say? It should be libkaka. + + -Pip + +=head2 but kaka is kaka... it's like KAKA!!! -Pip + +...as opposed to 'caca', and thus, Term::Kaka was born to make Term::Caca +be, sound, and smell harsh. + +=cut + +# $Id: Kaka.pm,v 1.2 2004/10/22 21:12:01 beppu Exp $ diff --git a/perl/lib/Term/Kaka/Bitmap.pm b/perl/lib/Term/Kaka/Bitmap.pm new file mode 100644 index 0000000..fe9bbfd --- /dev/null +++ b/perl/lib/Term/Kaka/Bitmap.pm @@ -0,0 +1,5 @@ +package Term::Kaka::Bitmap; + +use base 'Term::Caca::Bitmap'; + +1; diff --git a/perl/lib/Term/Kaka/Constants.pm b/perl/lib/Term/Kaka/Constants.pm new file mode 100644 index 0000000..7962b42 --- /dev/null +++ b/perl/lib/Term/Kaka/Constants.pm @@ -0,0 +1,9 @@ +package Term::Kaka::Constants; + +use Term::Caca::Constants qw(:all); +push @ISA, 'Term::Caca::Constants'; + +*Term::Kaka::Constants::EXPORT_OK = *Term::Caca::Constants::EXPORT_OK; +*Term::Kaka::Constants::EXPORT_TAGS = *Term::Caca::Constants::EXPORT_TAGS; + +1; diff --git a/perl/lib/Term/Kaka/Sprite.pm b/perl/lib/Term/Kaka/Sprite.pm new file mode 100644 index 0000000..bee387a --- /dev/null +++ b/perl/lib/Term/Kaka/Sprite.pm @@ -0,0 +1,5 @@ +package Term::Kaka::Sprite; + +use base 'Term::Caca::Sprite'; + +1; diff --git a/perl/t/data/caca.txt b/perl/t/data/caca.txt new file mode 100644 index 0000000..1ea8648 --- /dev/null +++ b/perl/t/data/caca.txt @@ -0,0 +1,26 @@ +12 6 6 3 + , + ` ,_ , +` _( )_ + _( ` )_ +( `-. ' ) + `-.____,-' + h + h gg h +h gggggg + gggggggggg +gggggggggggg + gggggggggg +12 6 6 3 + . , + ` ,_ + _( )_ ' + _( ` )_ +( `-. ' ) + `-.____,-' + h h + h gg + gggggg h + gggggggggg +gggggggggggg + gggggggggg