So a couple of days ago I became a Bishop. I wanted to do something cool to celebrate and I thought a game might fit the bill. As it happens I was deobfuscating an entry from the Obfuscated C Contest (something I do for fun. What is this "life" you speak of?) It was a nice little driving game which is translated to perl below. It has been tested on Debian GNU/Linux with perl 5.8.3.
#!/usr/bin/env perl
use strict;
use warnings;
use Getopt::Long;
use Pod::Usage;
use Switch;
my $gear = 1;
my $help = 0;
my $quiet = 0;
my $trees = 1;
my $twist = 1;
my $width = 8;
Getopt::Long::Configure('gnu_getopt');
GetOptions (
'gear=i' => \$gear,
'help|h|?' => \$help,
'quiet' => \$quiet,
'trees=i' => \$trees,
'twist=i' => \$twist,
'width=i' => \$width,
) or pod2usage(-exitstatus => 2, -verbose => 1);
pod2usage(-exitstatus => 0, -verbose => 2) if $help;
my $driver = Driver->new(gear => $gear, quiet => $quiet, trees => $tre
+es,
twist => $twist, width => $width,);
$driver->line;
my $keypress;
do {
switch($keypress)
{
case qr/[qz\[b,]/ { $driver->{delta} = -1 }
case qr/[ xn\.]/ { $driver->{delta} = 0 }
case qr/[wc\]m\/]/ { $driver->{delta} = 1 }
case '1' { $driver->{gear} = 1 }
case '2' { $driver->{gear} = 2 }
case '3' { $driver->{gear} = 3 }
case '4' { $driver->{gear} = 4 }
}
} while (($keypress = $driver->getchar) ne 'q');
exit(0);
package Driver;
use Curses;
use Params::Validate qw/validate SCALAR UNDEF/;
use Time::HiRes qw/setitimer ITIMER_REAL/;
sub new
{
my $proto = shift;
my $class = ref($proto) || $proto;
my %args = validate( @_, {
gear => { type => SCALAR,
default => 1,
callbacks => { 'valid gear' =>
sub { 0 < $_[0] && $_[0] < 5 },
},
},
quiet => { type => SCALAR | UNDEF,
default => 0,
},
trees => { type => SCALAR,
default => 1,
callbacks => { 'valid trees' =>
sub { 0 < $_[0] && $_[0] < 5 },
},
},
twist => { type => SCALAR,
default => 1,
callbacks => { 'valid twist' =>
sub { 0 < $_[0] && $_[0] < 6 },
},
},
width => { type => SCALAR,
default => 8,
callbacks => { 'valid width' =>
sub { 0 < $_[0] && $_[0] < 33 },
},
},
});
my $self =
{
score => 0,
gear => $args{gear} || 1,
# previous gear
prevgear => 0,
# delta or change in driver position ($dpos)
delta => 0,
# drivers position on the line
dpos => 0,
# drivers previous position
prevdpos => 0,
# shall we draw a tree or not?
drawtree => 0,
# ring the bell or not?
quiet => $args{quiet} || 0,
# position in the line to draw a tree
tpos => 0,
tparts => [ ' |', ' |', '%\\|/%', ' %%%', '', ],
# the current line of the tree to draw
tcurpart => 0,
# chance of displaying a tree
trees => $args{tree} || 1,
road => 1,
# array of the locations of the middle of the road on each line
rp => [],
# how 'twisty' the road is going to be
twist => $args{twist} || 1,
# Half the width of the road
width => $args{width} || 8,
};
initscr;
cbreak;
noecho;
nonl;
nodelay($stdscr, 1);
intrflush($stdscr, 0);
keypad($stdscr, 1);
scrollok($stdscr, 1);
curs_set(0);
$self->{dpos} = COLS() / 2;
$self->{rp}->[0] = COLS() / 2;
bless ($self, $class);
$SIG{ALRM} = sub { $self->line; };
return $self;
}
sub DESTROY
{
my ($self) = @_;
endwin;
$SIG{ALRM} = 'IGNORE';
print '*** Score: ', $self->{score}, " ***\n";
}
sub getchar
{
my ($self) = @_;
return getch;
}
sub line
{
my ($self) = @_;
my $n;
my @roadparts = ( '\\', '|', '/', );
if ($self->{gear} != $self->{prevgear})
{
$self->{prevgear} = $self->{gear};
setitimer(ITIMER_REAL, 0.108 / $self->{gear}, 0.108 / $self->{gear
+});
}
move(0,0);
clrtoeol;
if ($self->{drawtree} == 0 && (int(rand(4)) < $self->{trees}))
{
$self->{drawtree} = 1;
do
{
$self->{tpos} = int(rand(COLS() - $self->{width} - 1));
} while (($self->{tpos} > ($self->{rp}->[0] - $self->{width} - 6))
&& $self->{tpos} < ($self->{rp}->[0] + $self->{width} + 7));
}
if ($self->{drawtree} == 1)
{
if ($self->{tparts}->[$self->{tcurpart}] eq '')
{
$self->{drawtree} = 0;
$self->{tcurpart} = 0;
}
else
{
addstr(0, $self->{tpos}, $self->{tparts}->[$self->{tcurpart}++])
+;
}
}
$n = int(rand(15));
if ($n < (3 * $self->{twist}))
{
$self->{road} = $n % 3;
}
for ($n = LINES() - 2; $n > - 1; $n --)
{
$self->{rp}->[$n + 1] = $self->{rp}->[$n];
}
$self->{rp}->[0] = $self->{rp}->[1] + ($self->{road} - 1);
if (($self->{rp}->[0] - $self->{width}) < 1)
{
$self->{rp}->[0]++;
$self->{road} = 1;
}
elsif (($self->{rp}->[0] + $self->{width}) > (COLS() - 1))
{
$self->{rp}->[0]--;
$self->{road} = 1;
}
addch(0, $self->{rp}->[0] - $self->{width}, $roadparts[$self->{road}
+]);
addch(0, $self->{rp}->[0] + $self->{width}, $roadparts[$self->{road}
+]);
$self->{prevdpos} = $self->{dpos};
$self->{dpos} += $self->{delta};
if(defined($self->{rp}->[LINES() - 2]) && $self->{rp}->[LINES() - 2]
+ > 0)
{
if($self->{dpos} < $self->{rp}->[LINES() - 2] - $self->{width}
|| $self->{dpos} >= $self->{rp}->[LINES() - 2] + $self->{width})
{
exit(1);
}
else
{
$self->{score} += $self->{gear};
}
}
addch(LINES() - 2, $self->{dpos}, '@');
addch(LINES() - 1, $self->{prevdpos}, ' ');
beep() unless ($self->{quiet});
scrl(-1);
addstr(0, 0, "RACER Gear = " . $self->{gear} . " Score = " . $self->
+{score});
refresh;
}
1;
__END__
=pod
=head1 NAME
racer -- a driving game
=head1 SYNOPSIS
B<racer> [options]
=head1 DESCRIPTION
Drive a racing car represented by a I<@> around a track, score points,
+ and
admire the scenery. If you go outside the lines, you die.
=head2 KEYS
=over 4
=item B<q>, B<z>, B<b>, B<[>, B<,>
Move left.
=item B<w>, B<x>, B<n>, B<space>
Move ahead.
=item B<e>, B<c>, B<m>, B<]>, B</>
Move right.
=item B<1>, B<2>, B<3>, B<4>
Change gears. See L<B<--gear>> under B<OPTIONS>.
=item B<q>
Quit the game.
=back
=head1 OPTIONS
=over 4
=item B<--gear>
A number from 1-4. The higher the gear, the faster you go and the mor
+e points
you score. The default is 1.
=item B<--help>, B<-h>, B<-?>
Display this help text.
=item B<--quiet>
If this option is set, sound effects are disabled. The default is sou
+nd
is enabled.
=item B<--trees>
A number from 1-4. The higher the number, the greater the likelyhood
+a tree
will be drawn. The default is 1.
=item B<--twist>
A number from 1-5. The higher the number the twistier the road will b
+e. The
default is 1.
=item B<--width>
A number from 1-32. Equal to half the width of the road. The default
+ is 8.
(So the default width of the road is 16.)
=back
=head1 INSTALLATION
Make the script executable. You will also need the B<Curses> and
B<Params::Validate> packages from CPAN.
=head1 BUGS/TODO
Doesn't handle SIGWINCH yet or do color.
=head1 AUTHOR
Jaldhar H. Vyas E<lt>jaldhar@braincells.comE<gt>
=head1 LICENSE
This code is free software under the Crowley Public License ("Do what
thou wilt shall be the whole of the license")
=head1 CREDITS
Based on Chris Kings' entry in the 2001 Obfuscated C Contest.
=head1 VERSION
1.0 -- May 30, 2004
=cut