view release on metacpan or  search on metacpan

lib/Acme/Monkey.pm  view on Meta::CPAN

=cut

sub fling {
    my $fling_buffer = Acme::Monkey::FrameBuffer->new(W => 40, H => 10);

    system($CLEAR_COMMAND);
    for my $seq(@{$Acme::Monkey::FlingFrames::sequence}) {
        system($CLEAR_COMMAND);
        $fling_buffer->clear();
        $fling_buffer->put(@{$Acme::Monkey::FlingFrames::frames}[$seq], 2, 2);
        $fling_buffer->put([__PACKAGE__], 1, 1);
        $fling_buffer->draw();
        usleep(120000);
    }
}


use Exporter qw( import );
our @EXPORT = qw(grrrr bannana grubs wine beer vodka swing fling);

=head1 SUBROUTINES

Exporter is used to these on you.

  grrrr($stuff); # Like warn().
  bannana();     # For feeding.

=head2 CONSUMEABLES

  wine()      # For happy monkeys.
  grubs()     # Yummy.
  beer()     # Have anything stronger?
  vodka()        # Ya baby!
  bannana()   # The usual fare.

=cut

sub grrrr   { print STDERR join(' grrr ',@_)." GRRRR\n"; }
sub banana  { return 'food',  1; }
sub grubs   { return 'food',  2; }
sub wine    { return 'drunk', 2; }
sub beer    { return 'drunk', 1; }
sub vodka   { return 'drunk', 5; }

# Hmmm, Appears to be a Java inner class :)
{
    package Acme::Monkey::FrameBuffer;

    use Carp qw(croak);

    # TODO: put all OO boilerplate...

    sub new {
	    my $class  = shift;
	    my %params = @_;
	    my $self   = {};
	
	    $self->{WIDTH}  = $params{'width'}  || $params{'W'} || undef;
	    $self->{HEIGHT} = $params{'height'} || $params{'H'} || undef;

        # TODO: Should we just default X,Y instead?
	    croak "Width required\n"  if !defined($self->{WIDTH});
	    croak "Height required\n" if !defined($self->{HEIGHT});

	    $self->{BUF_SIZE} = $self->{WIDTH} * $self->{HEIGHT};
	    $self->{BUFFER}   = '';

	    bless($self, $class);
    }

    sub width {
	    my ($self) = shift;
	    return $self->{WIDTH};
    }

    sub height {
	    my ($self) = shift;
	    return $self->{HEIGHT};
    }

    sub get_buffer {
	    my $self = shift;
	    return $self->{BUFFER};
    }

    sub clear {
	    my $self = shift;
	    $self->{BUFFER} = ' ' x $self->{BUF_SIZE};
    }

    sub put {
	    my $self = shift;
	    my ($what, $xcoord, $ycoord) = @_;

	    $xcoord -= 1; 
	    $ycoord -= 1;
	
	    my $location = ($ycoord * $self->{WIDTH}) + $xcoord;
	
	    for my $line(@$what) {
		    substr($self->{BUFFER}, $location, length($line), $line);
		    $location += $self->{WIDTH};
	    }
    }

    sub draw {
	    my $self = shift;

	    for my $row(0..($self->{HEIGHT}-1)) {
		    my $line = substr($self->{BUFFER}, $row * $self->{WIDTH}, $self->{WIDTH});
		    print "$line\n";
	    }
    }

    !(!(!0));
}

{
    package Acme::Monkey::FlingFrames;

    use strict;