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

Last change on this file since 4333 was 4333, checked in by Sam Hocevar, 10 years ago

Large source code cleanup, getting rid of spaces, tabs, and svn keywords.

  • Property svn:keywords set to Id
File size: 5.8 KB
Line 
1package Term::Caca;
2
3require Exporter;
4require DynaLoader;
5$VERSION = '0.9_1';
6@ISA = qw(Exporter DynaLoader);
7Term::Caca->bootstrap($VERSION);
8
9use strict;
10use Term::Caca::Constants ':all';
11
12# Basic functions
13
14# constructor
15sub new {
16  my ($class) = @_;
17  _init();
18  my $self = { };
19  return bless($self => $class);
20}
21*init = \*new;
22
23# set delay for establishing constant framerate
24sub set_delay {
25  my ($self, $usec) = @_;
26  $usec ||= 0;
27  _set_delay($usec);
28}
29
30#
31sub get_feature {
32  my ($self, $feature) = @_;
33  $feature ||= 0;
34  return _get_feature($feature);
35}
36
37#
38sub set_feature {
39  my ($self, $feature) = @_;
40  $feature ||= 0;
41  _get_feature($feature);
42}
43
44#
45sub get_feature_name {
46  my ($self, $feature) = @_;
47  $feature ||= 0;
48  return _get_feature_name($feature);
49}
50
51#
52sub get_rendertime {
53# my ($self) = @_;
54  return _get_rendertime();
55}
56
57#
58sub get_width {
59# my ($self) = @_;
60  return _get_width();
61}
62
63#
64sub get_height {
65# my ($self) = @_;
66  return _get_height();
67}
68
69#
70sub set_window_title {
71  my ($self, $title) = @_;
72  $title ||= "";
73  return _set_window_title($title);
74}
75
76#
77sub get_window_width {
78# my ($self) = @_;
79  return _get_window_width();
80}
81
82#
83sub get_window_height {
84# my ($self) = @_;
85  return _get_window_height();
86}
87
88#
89sub refresh {
90  _refresh();
91}
92
93# destructor
94sub DESTROY {
95  my ($self) = @_;
96  _end();
97}
98
99# Event handling
100
101#
102sub get_event {
103  my ($self, $event_mask) = @_;
104  if (!defined($event_mask)) {
105    $event_mask = 0xFFFFFFFF;
106  }
107  return _get_event($event_mask);
108}
109
110#
111sub get_mouse_x {
112  my ($self) = @_;
113  return _get_mouse_x();
114}
115
116#
117sub get_mouse_y {
118  my ($self) = @_;
119  return _get_mouse_y();
120}
121
122#
123sub wait_event {
124  my ($self, $event_mask) = @_;
125  $event_mask ||= CACA_EVENT_ANY;
126  return _wait_event($event_mask);
127}
128
1291;
130
131# Character printing
132
133#
134sub set_color {
135  my ($self, $fgcolor, $bgcolor) = @_;
136  $fgcolor ||= CACA_COLOR_LIGHTGRAY;
137  $bgcolor ||= CACA_COLOR_BLACK;
138  return _set_color($fgcolor, $bgcolor);
139}
140
141#
142sub get_fg_color {
143  my ($self) = @_;
144  return _get_fg_color();
145}
146
147#
148sub get_bg_color {
149  my ($self) = @_;
150  return _get_bg_color();
151}
152
153#
154sub get_color_name {
155  my ($self, $color) = @_;
156  return undef unless(defined($color));
157  return _get_color_name($color);
158}
159
160#
161sub putchar {
162  my ($self, $x, $y, $c) = @_;
163  $x ||= 0;
164  $y ||= 0;
165  $c ||= "";
166  _putchar($x, $y, $c);
167}
168
169#
170sub putstr {
171  my ($self, $x, $y, $s) = @_;
172  $x ||= 0;
173  $y ||= 0;
174  $s ||= "";
175  _putstr($x, $y, $s);
176}
177
178# faking it by doing printf on the perl side
179sub printf {
180  my ($self, $x, $y, $s, @args) = @_;
181  $x ||= 0;
182  $y ||= 0;
183  my $string = sprintf($s, @args);
184  _putstr($x, $y, $string);
185}
186
187#
188sub clear {
189  _clear();
190}
191
192# Primitives drawing
193
194#
195sub draw_line {
196  my ($self, $x1, $y1, $x2, $y2, $c) = @_;
197  _draw_line($x1, $y1, $x2, $y2, $c);
198}
199
200#
201sub draw_polyline {
202  my ($self, $x, $y, $n, $c) = @_;
203  _draw_polyline($x, $y, $n, $c);
204}
205
206#
207sub draw_thin_line {
208  my ($self, $x1, $y1, $x2, $y2) = @_;
209  _draw_thin_line($x1, $y1, $x2, $y2);
210}
211
212#
213sub draw_thin_polyline {
214  my ($self, $x, $y, $n) = @_;
215  _draw_thin_polyline($x, $y, $n);
216}
217
218#
219sub draw_circle {
220  my ($self, $x, $y, $r, $c) = @_;
221  # TODO : check for sane values
222  _draw_circle($x, $y, $r, $c);
223}
224
225#
226sub draw_ellipse {
227  my ($self, $x0, $y0, $ra, $rb, $c) = @_;
228  _draw_ellipse($x0, $y0, $ra, $rb, $c);
229}
230
231#
232sub draw_thin_ellipse {
233  my ($self, $x0, $y0, $ra, $rb) = @_;
234  _draw_ellipse($x0, $y0, $ra, $rb);
235}
236
237#
238sub fill_ellipse {
239  my ($self, $x0, $y0, $ra, $rb, $c) = @_;
240  _fill_ellipse($x0, $y0, $ra, $rb, $c);
241}
242
243#
244sub draw_box {
245  my ($self, $x0, $y0, $x1, $y1, $c) = @_;
246  _draw_box($x0, $y0, $x1, $y1, $c);
247}
248
249#
250sub draw_thin_box {
251  my ($self, $x0, $y0, $x1, $y1) = @_;
252  _draw_thin_box($x0, $y0, $x1, $y1);
253}
254
255#
256sub fill_box {
257  my ($self, $x0, $y0, $x1, $y1, $c) = @_;
258  _fill_box($x0, $y0, $x1, $y1, $c);
259}
260
261#
262sub draw_triangle {
263  my ($self, $x0, $y0, $x1, $y1, $x2, $y2, $c) = @_;
264  _draw_triangle($x0, $y0, $x1, $y1, $x2, $y2, $c);
265}
266
267#
268sub draw_thin_triangle {
269  my ($self, $x0, $y0, $x1, $y1, $x2, $y2) = @_;
270  _draw_thin_triangle($x0, $y0, $x1, $y1, $x2, $y2);
271}
272
273#
274sub fill_triangle {
275  my ($self, $x0, $y0, $x1, $y1, $x2, $y2, $c) = @_;
276  _fill_triangle($x0, $y0, $x1, $y1, $x2, $y2, $c);
277}
278
279# Mathematical functions
280
281#
282sub rand {
283  my ($self, $min, $max) = @_;
284  return _rand($min, $max);
285}
286
287#
288sub sqrt {
289  my ($self, $n) = @_;
290  return _sqrt($n);
291}
292
293# Sprite handling
294
295#
296sub load_sprite {
297  my ($self, $file) = @_;
298  my $sprite = _load_sprite($file);
299}
300
301#
302sub get_sprite_frames {
303  my ($self, $sprite) = @_;
304  return _get_sprite_frames($sprite);
305}
306
307#
308sub get_sprite_width {
309  my ($self, $sprite) = @_;
310  return _get_sprite_width($sprite);
311}
312
313#
314sub get_sprite_height {
315  my ($self, $sprite) = @_;
316  return _get_sprite_height($sprite);
317}
318
319#
320sub get_sprite_dx {
321  my ($self, $sprite) = @_;
322  return _get_sprite_dx($sprite);
323}
324
325#
326sub get_sprite_dy {
327  my ($self, $sprite) = @_;
328  return _get_sprite_dy($sprite);
329}
330
331#
332sub draw_sprite {
333  my ($self, $x, $y, $sprite, $f) = @_;
334  _draw_sprite($x, $y, $sprite, $f);
335}
336
337#
338sub free_sprite {
339  my ($self, $sprite) = @_;
340  _free_sprite($sprite);
341}
342
343# Bitmap handling
344
345#
346sub create_bitmap {
347  my ($self, $bpp, $w, $h, $pitch, $rmask, $gmask, $bmask, $amask) = @_;
348  _create_bitmap($bpp, $w, $h, $pitch, $rmask, $gmask, $bmask, $amask);
349}
350
351#
352sub set_bitmap_palette {
353  my ($self, $bitmap, $red, $green, $blue, $alpha) = @_;
354  _set_bitmap_palette($bitmap, $red, $green, $blue, $alpha);
355}
356
357#
358sub draw_bitmap {
359  my ($self, $x1, $y1, $x2, $y2, $bitmap, $pixels) = @_;
360  _draw_bitmap($x1, $y1, $x2, $y2, $bitmap, $pixels);
361}
362
363sub free_bitmap {
364  my ($self, $bitmap) = @_;
365  _free_bitmap($bitmap);
366}
367
368__END__
369
370=head1 NAME
371
372Term::Caca - perl interface for libcaca (Colour AsCii Art library)
373
374=head1 SYNOPSIS
375
376=head1 DESCRIPTION
377
378=head2 Class Methods
379
380=head2 Object Methods
381
382=head1 AUTHOR
383
384=head1 SEE ALSO
385
386=cut
387
388# vim:sw=2 sts=2 expandtab
Note: See TracBrowser for help on using the repository browser.