#!/usr/bin/perl -w

#  copyright alex@slab.org, January 2004

#  This program is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License
#  as published by the Free Software Foundation; either version 2
#  of the License, or (at your option) any later version.

#  This program is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
 
#  You should have received a copy of the GNU General Public License
#  along with this program; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

#  the complete license may be found here:
#  http://www.gnu.org/copyleft/gpl.html


# ** please note **
# This perl script requires the Curses and Time::Hires modules, both of
# which are available from http://search.cpan.org/ .

# alternatively, debian gnu/linux users can try running:
# apt-get install libtime-hires-perl libcurses-perl

# i'm sure that you could get it working under windows too fairly
# easily, but i'm not sure how.

use strict;

use Curses;
use Time::HiRes qw{ sleep };

use vars qw/ $bodyparts $current $speed @speeds /;

@speeds = qw/ 0.4 0.01 0.025 0.05 0.075 0.1 0.15 0.2 0.25 0.3 /;
$speed = $speeds[4];

$bodyparts =
  {
   head => {default => [['','   O   ']],
	    bob     => [['','   O   '],
			['','   o   '],
		       ]
	   },
   body => {
	    default => [['','','   Z   ']],
	    spin => [
		     ['','','   Z   '],
		     ['','','   z   '],
		     ['','','   Z   '],
		     ['','','   z   '],
		     ['','','   Z   '],
		     ['','','   Z   '],
		     ['','','   Z   '],
		     ['','','   Z   '],
		    ]
	   },
   arms => {
	    default => [['',
			 '       ',
			 ' ./ \. '
			]
		       ],
	    flap => [
		     ['',
		      '       ',
		      ' ./ \. '
		     ],
		     ['','.__ __. ',
		     ],
		    ],
	    feelie => [
		       ['',
			'       ',
			' ./ \. '
		       ],
		       ['',
			'       ',
			' ,/ \, '
		       ],
		      ],
	    curl => [
		     ['       ',
		      '       ',
		      ' ./ \. '
		     ],
		     ['       ',
		      '.__    ',
		      '    \. '
		     ],
		     ['   .   ',
		      '  (    ',
		      '    \. '
		     ],
		     ['       ',
		      '.__    ',
		      '    \. '
		     ],
		     ['       ',
		      '       ',
		      ' ./ \. '
		     ],
		     ['',
		      '    __.',
		      ' ./    '
		     ],
		     ['   .   ',
		      '    )  ',
		      ' ./    '
		     ],
		     ['',
		      '    __.',
		      ' ./    '
		     ],
		    ],
	    wave => [
		     ['   .   ',
		      '.__ )  ',
		     ],
		     ['     . ',
		      '.__ /  ',
		     ],
		     [' .     ',
		      '  \ __.',
		     ],
		     ['   .   ',
		      '  ( __.',
		     ],
		     [' .     ',
		      '  \ __.',
		     ],
		     ['     . ',
		      '.__ /  ',
		     ],
		    ]
	   },
   legs  => {
	     default => [['','','','  / \  ']],
	     wobble => [['','','','  / \ '],
			['','','','  ( )  '],
			['','','','  / \  '],
			['','','','  ) (  ']
		       ],
	     strut => [
		       ['','','','  ( \  '],
		       ['','','','  / )  ']
		      ]
	    }
  };

##

init();
dance();

##

sub place {
  my ($frame) = @_;
  my $y = 0;
  foreach my $line (@$frame) {
    my $x = 0;
    foreach my $char (split(//, $line)) {
      unless ($char eq ' ') {
	addstr($y,
	       $x,
	       $char
	      );
      }
      ++$x;
    }
    ++$y;
  }
}

##

sub init_curses {
  initscr;
  cbreak;
  noecho;
  keypad 1;
  nonl;
  nodelay 1;
}

##

sub init_parts {
  foreach my $part (keys %$bodyparts) {
    $current->{$part} = 'default';
  }
}

##

sub init {
  init_curses();
  init_parts();
  addstr(0, 8, "| ");
  addstr(1, 8, "| hello");
  addstr(2, 8, "| press SPACEBAR to change my dance");
  addstr(3, 8, "| press a number key to change my dancing speed");
  addstr(4, 8, "| for more options, add things to my sourcecode");
  addstr(5, 8, "| please let alex\@slab.org know of your changes ");
  addstr(6, 8, "| ");
}

##

sub dance {
  my $step = 0;
  while (1) {
    while (my ($part, $position) = each %$current) {
      my $frames = $bodyparts->{$part}->{$position};
      my $frame = $frames->[$step % @$frames];
      place($frame);
    }
    ++$step;
    refresh();
    sleep($speed);
    foreach my $y (0 .. 5) {
	addstr($y, 0, ' ' x 7);
    }
    while((my $ch = getch()) ne ERR) {
	$ch = 'space' if $ch eq ' ';
	$ch = 'left' if $ch eq KEY_LEFT;
	$ch = 'right' if $ch eq KEY_RIGHT;
	$ch = 'up' if $ch eq KEY_UP;
	$ch = 'down' if $ch eq KEY_DOWN;
	my $func = "key__$ch";
	if (__PACKAGE__->can($func)) {
	    __PACKAGE__->$func();
	}
    }
  }
}

##

sub key__space {
    my $self = shift;
    while (my ($part, $positions) = each %$bodyparts) {
	my @names = keys %$positions;
	$current->{$part} = $names[rand @names];
    }
}

sub key__1 { $speed = $speeds[1] }
sub key__2 { $speed = $speeds[2] }
sub key__3 { $speed = $speeds[3] }
sub key__4 { $speed = $speeds[4] }
sub key__5 { $speed = $speeds[5] }
sub key__6 { $speed = $speeds[6] }
sub key__7 { $speed = $speeds[7] }
sub key__8 { $speed = $speeds[8] }
sub key__9 { $speed = $speeds[9] }
sub key__0 { $speed = $speeds[0] }