cacalabs
/
libcaca
mirror of https://github.com/cacalabs/libcaca.git
1
0
Fork 0
Code Issues 0 Releases 7 Wiki Activity
Browse Source

* Imported John Beppu's Perl wrapper.

tags/v0.99.beta14
Sam Hocevar sam 20 years ago
parent
4fad734207
commit
3f810a64ba
17 changed files with 1629 additions and 0 deletions
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. +1
    -0
      AUTHORS
  2. +22
    -0
      perl/Build.PL
  3. +17
    -0
      perl/MANIFEST
  4. +11
    -0
      perl/MANIFEST.SKIP
  5. +29
    -0
      perl/META.yml
  6. +31
    -0
      perl/Makefile.PL
  7. +21
    -0
      perl/README
  8. +389
    -0
      perl/lib/Term/Caca.pm
  9. +650
    -0
      perl/lib/Term/Caca.xs
  10. +5
    -0
      perl/lib/Term/Caca/Bitmap.pm
  11. +332
    -0
      perl/lib/Term/Caca/Constants.pm
  12. +5
    -0
      perl/lib/Term/Caca/Sprite.pm
  13. +71
    -0
      perl/lib/Term/Kaka.pm
  14. +5
    -0
      perl/lib/Term/Kaka/Bitmap.pm
  15. +9
    -0
      perl/lib/Term/Kaka/Constants.pm
  16. +5
    -0
      perl/lib/Term/Kaka/Sprite.pm
  17. +26
    -0
      perl/t/data/caca.txt

+ 1
- 0
AUTHORS View File

@@ -2,4 +2,5 @@ $Id$


Sam Hocevar <sam@zoy.org> - main programmer Sam Hocevar <sam@zoy.org> - main programmer
Jean-Yves Lamoureux <jylam@lnxscene.org> - cacaball Jean-Yves Lamoureux <jylam@lnxscene.org> - cacaball
John Beppu <beppu@lbox.org> - Term::Caca Perl wrapper



+ 22
- 0
perl/Build.PL View File

@@ -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();

+ 17
- 0
perl/MANIFEST View File

@@ -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

+ 11
- 0
perl/MANIFEST.SKIP View File

@@ -0,0 +1,11 @@
\bCVS\b
^MANIFEST\.bak$
^Makefile$
\..*\.swp$
~$
\bblib\b
\b\.xvpics\b
\b_build\b
^Build$
^Linux-Input.*gz$
^x.pl$

+ 29
- 0
perl/META.yml View File

@@ -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

+ 31
- 0
perl/Makefile.PL View File

@@ -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');

+ 21
- 0
perl/README View File

@@ -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.



+ 389
- 0
perl/lib/Term/Caca.pm View File

@@ -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 $

+ 650
- 0
perl/lib/Term/Caca.xs View File

@@ -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

+ 5
- 0
perl/lib/Term/Caca/Bitmap.pm View File

@@ -0,0 +1,5 @@
package Term::Caca::Bitmap;


1;


+ 332
- 0
perl/lib/Term/Caca/Constants.pm View File

@@ -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 $

+ 5
- 0
perl/lib/Term/Caca/Sprite.pm View File

@@ -0,0 +1,5 @@
package Term::Caca::Sprite;


1;


+ 71
- 0
perl/lib/Term/Kaka.pm View File

@@ -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<libcaca <-- our framebuffer>

B<John Beppu> 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<Pip Stuart> 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 $

+ 5
- 0
perl/lib/Term/Kaka/Bitmap.pm View File

@@ -0,0 +1,5 @@
package Term::Kaka::Bitmap;

use base 'Term::Caca::Bitmap';

1;

+ 9
- 0
perl/lib/Term/Kaka/Constants.pm View File

@@ -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;

+ 5
- 0
perl/lib/Term/Kaka/Sprite.pm View File

@@ -0,0 +1,5 @@
package Term::Kaka::Sprite;

use base 'Term::Caca::Sprite';

1;

+ 26
- 0
perl/t/data/caca.txt View File

@@ -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

Write Preview
Loading…
Cancel
Save