view release on metacpan or  search on metacpan

lib/Acme/POE/Tree.pm  view on Meta::CPAN

package Acme::POE::Tree;

use warnings;
use strict;

use Curses;
use POE qw(Wheel::Curses);
use IO::Tty;

use constant CYCLE_TYPE => "random"; # "random" or "cycle"
use constant LIGHT_TYPE => "strand"; # "random" or "strand"
use constant DIM_BULBS => 0; # enable dim bulbs

our $VERSION = '1.022';

sub new {
	my ($class, $arg) = @_;

	my $self = bless { %{$arg || {}} }, $class;

	$self->{light_delay} ||= 1;
	$self->{star_delay}  ||= 1.33;

	POE::Session->create(
		object_states => [
			$self => {
				_start        => "_setup_tree",
				got_keystroke => "_handle_keystroke",
				got_sigwinch  => "_handle_sigwinch",
				paint_tree    => "_paint_tree",
				light_cycle   => "_cycle_lights",
				star_cycle    => "_cycle_star",
				shut_down     => "_handle_shut_down",
			},
		],
	);

	return $self;
}

sub run {
	my $self = shift;
	POE::Kernel->run();
}

sub _setup_tree {
	my ($self, $kernel, $heap) = @_[OBJECT, KERNEL, HEAP];

	# Tell this session about terminal size changes.
	$kernel->sig(WINCH => "got_sigwinch");

	# Set up Curses, and notify this session when there's input.
	$heap->{console} = POE::Wheel::Curses->new(
		InputEvent => 'got_keystroke',
	);

	# Initialize the tree's color palette.
	my @light_colors = (
		COLOR_BLUE, COLOR_YELLOW, COLOR_RED, COLOR_GREEN, COLOR_MAGENTA
	);

	init_pair($_, $light_colors[$_-1], COLOR_BLACK) for 1..@light_colors;
	$heap->{light_colors} = [ map { COLOR_PAIR($_) } (1..@light_colors) ];

	init_pair(@light_colors + 2, COLOR_GREEN, COLOR_BLACK);
	$heap->{color_tree} = COLOR_PAIR(@light_colors + 2) | A_DIM;

	init_pair(@light_colors + 3, COLOR_WHITE, COLOR_BLACK);
	$heap->{color_bg} = COLOR_PAIR(@light_colors + 3);

	init_pair(@light_colors + 4, COLOR_YELLOW, COLOR_BLACK);
	$heap->{color_star} = COLOR_PAIR(@light_colors + 4);

	# Start the star cycle.
	$heap->{star_cycle} = 0;

	# Start the star and light timers.
	$kernel->delay("light_cycle", $self->{light_delay});
	$kernel->delay("star_cycle", $self->{star_delay});