view release on metacpan or  search on metacpan

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

	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});

	# Run until an automatic cutoff time has elapsed.
	$kernel->delay("shut_down", $self->{run_for}) if $self->{run_for};

	# Cause the tree to be painted.
	$kernel->yield("paint_tree");
}

# Some window managers send a lot of window-change signals during a
# window resize.  This waits for the user to let go before finally
# painting the new tree.

sub _handle_sigwinch {
	$_[KERNEL]->delay(paint_tree => 0.5);
}

# Handle keystrokes.  Quit if the user presses "q".

sub _handle_keystroke {
	my $keystroke = $_[ARG0];

	# Make control and extended keystrokes printable.
	if ($keystroke lt ' ') {
		$keystroke = '<' . uc(unctrl($keystroke)) . '>';
	}
	elsif ($keystroke =~ /^\d{2,}$/) {
		$keystroke = '<' . uc(keyname($keystroke)) . '>';
	}

	if ( $keystroke eq '<^C>' or $keystroke eq 'q') {
		$_[KERNEL]->yield("shut_down");
	}
}

# Repaint the tree.  This happens after every terminal resize.

sub _paint_tree {
	my $heap = $_[HEAP];
	$heap->{lights} = grow_tree($heap);
}

# Periodically change which lights are lit.

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

	if (CYCLE_TYPE eq "random") {
		foreach my $light (@{$heap->{lights}}) {
			next unless rand() < 0.25;

			$light->{lit} = !$light->{lit};
			$light->{c_paint} = $light->{c_main} | ($light->{lit} ? A_BOLD : A_DIM);

			if ($light->{lit} or DIM_BULBS) {
				attrset($light->{c_paint});
				addstr($light->{y}, $light->{x}, "o");
			}
			else {
				addstr($light->{y}, $light->{x}, " ");
			}
		}
	}
	elsif (CYCLE_TYPE eq "cycle") {
		foreach my $light (@{$heap->{lights}}) {
			$light->{lit} = (
				$light->{c_main} == $heap->{light_colors}[$heap->{light_cycle} || 0]
			) || 0;
			$light->{c_paint} = $light->{c_main} | ($light->{lit} ? A_BOLD : A_DIM);

			if ($light->{lit} or DIM_BULBS) {
				attrset($light->{c_paint});
				addstr($light->{y}, $light->{x}, "o");
			}
			else {
				addstr($light->{y}, $light->{x}, " ");
			}
		}

		$heap->{light_cycle}++;
		$heap->{light_cycle} = 0 if (
			$heap->{light_cycle} >= @{$heap->{light_colors}}
		);
	}

	do_refresh($heap);

	$kernel->delay("light_cycle", $self->{light_delay});
}

# The star periodically shimmers.

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

	$heap->{star_cycle}++;
	draw_star($heap);

	do_refresh($heap);

	$kernel->delay("star_cycle", $self->{star_delay});
}

# Grow a new tree.  Returns a list of lights to be cycled by timers
# later.

sub grow_tree {
	my $heap = shift;

	# Make sure Curses knows the current terminal size.

	my ($lines, $cols) = ($LINES, $COLS);
	eval {
		my $winsize = " " x 64;
		ioctl(STDOUT, &IO::Tty::Constant::TIOCGWINSZ, $winsize) or die $!;
		($lines, $cols) = unpack("S2", $winsize);
	};

	# TODO - How to do this portably?
	eval { resizeterm($lines, $cols) };

	# Clear the screen in the default color.  Add vertical bars to
	# either side of the screen, as this sometimes ensures erasure.

	attrset($heap->{color_bg});
	clear();
	addstr($_-1, 0, "|" . (" " x ($cols-2)) . "|") for 1..$lines;

	# Draw the tree.

	my $tier_width = 2;
	my $tier_height = 4;
	my $tier_width_increment = 8;
	my $light_density = 0.05;

	my $center = int($cols / 2);

	my $tier_pos = 4;

	my @tiers;

	TIER: while ($tier_pos < $lines - $tier_height) {
		for my $subtier (0..$tier_height-1) {
			last TIER if $tier_width >= $cols - 5;

			my $y = $tier_pos + $subtier;
			my $x = $center - int($tier_width / 2);
			my $w = $tier_width - 1;

			push @tiers, { y => $y, x => $x + 1, w => $w } if $w > 0;

			attrset($heap->{color_tree});
			addstr($y, $center - int($tier_width / 2), "/");
			addstr($y, $center + int($tier_width / 2), "\\");

			$tier_width += 2 * ($tier_width_increment / $tier_height);
		}

		$tier_pos += $tier_height;
		$tier_width -= $tier_width_increment;
	}

	# Distribute lights throughout the tree's area.