A curses-based japh
I originally posted this on Perlmonks, and now I’ve added a video of it in action
Curses-based Perl JAPH (Just another Perl hacker) from brian d foy on Vimeo.
Here’s the code, with is nothing fancy and a bit verbose, which is just the opposite of the spirit of the “Just another Perl hacker,” ethos.
#!/usr/bin/perl -w
use strict;
use warnings;
use Curses;
my @LETTERS = ( 'A' .. 'Z', 'a' .. 'z', ',', ' ' );
$SIG{TERM} = sub { exit };
my $STRING = 'Just Another Perl Hacker,';
my $LENGTH = length $STRING;
initscr;
my $ROW = ( LINES() % 2 ? LINES() - 1 : LINES() ) / 2;
my $COLUMN = ( COLS() % 2 ? COLS() - 1 : COLS() ) / 2 -
( $LENGTH % 2 ? $LENGTH - 1 : $LENGTH ) / 2;
my $END_COL = $COLUMN + $LENGTH - 1;
my @array;
my $count = 0;
my $x = random( LINES );
my $y = random( COLS );
my $letter = sub { $LETTERS[ int( rand( @LETTERS ) ) ] };
while( 1 ) {
my $x = &$x;
my $y = &$y;
my $letter = &$letter;
next if( $x == $ROW and $array[$y] );
if( $x == $ROW and $y >= $COLUMN and $y <= $END_COL
and substr( $STRING, $y - $COLUMN, 1 ) eq $letter ) {
$array[$y]++;
$count++;
}
put_letter( $letter, $x, $y );
if( $count == $LENGTH ) { @LETTERS = ' '; }
}
sub random {
my $range = shift;
sub { int( rand($range) ) }
}
sub put_letter {
my ($letter, $x, $y) = @_;
addch( $x, $y, $letter );
refresh;
}