source: libcaca/trunk/perl/lib/Term/Caca.pm @ 379 Tweet

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 $