#!/usr/bin/perl
#
# This is a very simple example using Term::Animation. 
# To see it in color, you will need your TERM environment
# variable set to something that supports color, and your
# terminal or terminal emulator configured to support color.
#
# Kirk Baucom <kbaucom@schizoid.com>
#
#

use strict;
use warnings;

# you don't have to include Curses, but it is handy so we
# can use halfdelay and getch below.
use Curses;

use Term::Animation 2.0;

# this creates a full screen animation object. you can also
# pass a curses window as an argument to new()
my $s = Term::Animation->new();

# if you are going to use color, you must enable it immediately
# after creating the animation object. you can turn color off
# again afterwards by calling disable_color()
$s->color(1);

my $phrase = "Press q to exit";


# a few simple ASCII art objects to move around
my $cloud1 = q#
   .--.
 .(    )
(_   )__)
  '-'
#;

my $cloud2 = q#
   .-.
 .(  _).
(_. (___)
#;

my $cloud3 = q#
    .-.
 .-(   ).
(        )
 (_(__.___)
#;

my @sun = (q{
  \  |  /
   .---.
- |     | -
   '---'
  /  |  \
},
q{

   .---.
  |     |
   '---'

});


my $tree = q#
     ,-
    (  }
  ,^    '),
 (         }
{           )
 '-.       /,
  {         }
   -.    ,-'
     |  }
     | |
     | |
  .-'   '-.
#;


# here we have a color mask for the tree above. each
# character in the mask represents the color for the
# corresponding character in the object. capital letters
# indicate bold. here, G and K represent bold green and
# bold black (dark gray). supplying a color where there
# is no character draw in the object has no effect.
# leaving out a color where there is a character will
# cause that character to be drawn with the default color.
# the default color (unless you override it) is non-bold white.
my $tree_fg_mask = q#
     GG
    G  G
  GG    GGG
 G         G
G           G
 GGG       GG
  G         G
   GG    GGG
     K  G
     K K
     K K
  KKK   KKK
#;

# now we take our ascii art from above and create animation
# objects out of them.
$s->new_entity(
	# the ASCII image for this entity
	shape		=> $cloud1,

	# this is the start position of the object,
	# row, column, depth. lower depth numbers
	# make objects closer to the 'camera'
	position	=> [ 2, 1, 10],

	# the vector we want the object to follow
	# x, y, z, frame. see the 'sun' object for frame
	# info. vectors can be floating point values
	callback_args	=> [1,0,0,0],

	# whether the object should wrap around when
	# it gets to the edge of the screen
	wrap		=> 1,

	# instead of supplying a color mask, we just
	# give a default_color, since the whole thing
	# is the same color
	default_color	=> 'WHITE',

	# this flag indicates that any whitespace before
	# the first non-whitespace in a line should be
	# transparent
	auto_trans	=> 1,
);

$s->new_entity(
	shape		=> $cloud2,
	position	=> [ 10, 5, 10],
	callback_args	=> [1,0,0,0],
	wrap		=> 1,
	default_color	=> 'WHITE',
	auto_trans	=> 1,
);

$s->new_entity(
	shape		=> $cloud3,
	position	=> [ 15, 1, 10],
	callback_args	=> [1,0,0,0],
	wrap		=> 1,
	default_color	=> 'WHITE',
	auto_trans	=> 1,
);

$s->new_entity(
	# here we pass in an array of animation frames
	shape		=> \@sun,
	position	=> [ 60, 2, 20],

	# the last element of the vector represents the
	# animation frame. for every update, the sun will
	# move ahead one animation frame (and loop back
	# to the first frame when it reaches the last frame)
	callback_args	=> [-1,0,0,1],

	wrap		=> 1,
	default_color	=> 'YELLOW',
);

$s->new_entity(
	shape		=> $tree,
	position	=> [ 25, 7, 5],

	# here we specify our color mask. you can still
	# supply a default_color even if you give a mask,
	# which will be used for any characters that you
	# left out of the mask
	color		=> $tree_fg_mask,

	auto_trans	=> 1,
);

$s->new_entity(
	shape		=> $tree,
	position	=> [ 5, 5, 5],
	color		=> $tree_fg_mask,
	auto_trans	=> 1,
);

$s->new_entity(
	shape		=> $tree,
	position	=> [ 35, 5, 5],
	color		=> $tree_fg_mask,
	auto_trans	=> 1,
);

# halfdelay is a Curses call to tell getch  how long it should
# wait for input before it times out (in tenths of a second).
# you can use halfdelay and getch to control the frame rate
# of your animation, if you don't expect to be getting much
# input from the user. 
halfdelay( 2 );

# here is the main animation loop.
for(1..500) {

  # run the callback routines for all the objects, and update
  # the screen
  $s->animate();

  # ask for user input, and wait a bit. exit our loop
  # if the user gives us a 'q'
  my $in = lc( getch() );
  if($in eq 'q') { last; }

}