Non puoi selezionare più di 25 argomenti Gli argomenti devono iniziare con una lettera o un numero, possono includere trattini ('-') e possono essere lunghi fino a 35 caratteri.

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