/[perlscripts]/racer
ViewVC logotype

Contents of /racer

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (show annotations)
Mon Feb 14 06:31:16 2005 UTC (12 years, 7 months ago) by jaldhar
File size: 7648 byte(s)
Initial import.
1 #!/usr/bin/env perl
2 use strict;
3 use warnings;
4 use Getopt::Long;
5 use Pod::Usage;
6 use Switch;
7
8 my $gear = 1;
9 my $help = 0;
10 my $quiet = 0;
11 my $trees = 1;
12 my $twist = 1;
13 my $width = 8;
14
15 Getopt::Long::Configure('gnu_getopt');
16 GetOptions (
17 'gear=i' => \$gear,
18 'help|h|?' => \$help,
19 'quiet' => \$quiet,
20 'trees=i' => \$trees,
21 'twist=i' => \$twist,
22 'width=i' => \$width,
23
24 ) or pod2usage(-exitstatus => 2, -verbose => 1);
25 pod2usage(-exitstatus => 0, -verbose => 2) if $help;
26
27 my $driver = Driver->new(gear => $gear, quiet => $quiet, trees => $trees,
28 twist => $twist, width => $width,);
29
30 $driver->line;
31
32 my $keypress;
33 do {
34 switch($keypress)
35 {
36 case qr/[qz\[b,]/ { $driver->{delta} = -1 }
37 case qr/[ xn\.]/ { $driver->{delta} = 0 }
38 case qr/[wc\]m\/]/ { $driver->{delta} = 1 }
39 case '1' { $driver->{gear} = 1 }
40 case '2' { $driver->{gear} = 2 }
41 case '3' { $driver->{gear} = 3 }
42 case '4' { $driver->{gear} = 4 }
43 }
44 } while (($keypress = $driver->getchar) ne 'q');
45
46 exit(0);
47
48 package Driver;
49 use Curses;
50 use Params::Validate qw/validate SCALAR UNDEF/;
51 use Time::HiRes qw/setitimer ITIMER_REAL/;
52
53 sub new
54 {
55 my $proto = shift;
56 my $class = ref($proto) || $proto;
57
58 my %args = validate( @_, {
59 gear => { type => SCALAR,
60 default => 1,
61 callbacks => { 'valid gear' =>
62 sub { 0 < $_[0] && $_[0] < 5 },
63 },
64 },
65 quiet => { type => SCALAR | UNDEF,
66 default => 0,
67 },
68 trees => { type => SCALAR,
69 default => 1,
70 callbacks => { 'valid trees' =>
71 sub { 0 < $_[0] && $_[0] < 5 },
72 },
73 },
74 twist => { type => SCALAR,
75 default => 1,
76 callbacks => { 'valid twist' =>
77 sub { 0 < $_[0] && $_[0] < 6 },
78 },
79 },
80 width => { type => SCALAR,
81 default => 8,
82 callbacks => { 'valid width' =>
83 sub { 0 < $_[0] && $_[0] < 33 },
84 },
85 },
86 });
87
88 my $self =
89 {
90 score => 0,
91 gear => $args{gear} || 1,
92 # previous gear
93 prevgear => 0,
94 # delta or change in driver position ($dpos)
95 delta => 0,
96 # drivers position on the line
97 dpos => 0,
98 # drivers previous position
99 prevdpos => 0,
100 # shall we draw a tree or not?
101 drawtree => 0,
102 # ring the bell or not?
103 quiet => $args{quiet} || 0,
104 # position in the line to draw a tree
105 tpos => 0,
106 tparts => [ ' |', ' |', '%\\|/%', ' %%%', '', ],
107 # the current line of the tree to draw
108 tcurpart => 0,
109 # chance of displaying a tree
110 trees => $args{tree} || 1,
111 road => 1,
112 # array of the locations of the middle of the road on each line
113 rp => [],
114 # how 'twisty' the road is going to be
115 twist => $args{twist} || 1,
116 # Half the width of the road
117 width => $args{width} || 8,
118 };
119
120 initscr;
121 cbreak;
122 noecho;
123 nonl;
124 nodelay($stdscr, 1);
125 intrflush($stdscr, 0);
126 keypad($stdscr, 1);
127 scrollok($stdscr, 1);
128 curs_set(0);
129 $self->{dpos} = COLS() / 2;
130 $self->{rp}->[0] = COLS() / 2;
131
132 bless ($self, $class);
133
134 $SIG{ALRM} = sub { $self->line; };
135
136 return $self;
137 }
138
139 sub DESTROY
140 {
141 my ($self) = @_;
142
143 endwin;
144 $SIG{ALRM} = 'IGNORE';
145 print '*** Score: ', $self->{score}, " ***\n";
146 }
147
148 sub getchar
149 {
150 my ($self) = @_;
151
152 return getch;
153 }
154
155 sub line
156 {
157 my ($self) = @_;
158
159 my $n;
160 my @roadparts = ( '\\', '|', '/', );
161
162 if ($self->{gear} != $self->{prevgear})
163 {
164 $self->{prevgear} = $self->{gear};
165 setitimer(ITIMER_REAL, 0.108 / $self->{gear}, 0.108 / $self->{gear});
166 }
167
168 move(0,0);
169 clrtoeol;
170
171 if ($self->{drawtree} == 0 && (int(rand(4)) < $self->{trees}))
172 {
173 $self->{drawtree} = 1;
174 do
175 {
176 $self->{tpos} = int(rand(COLS() - $self->{width} - 1));
177 } while (($self->{tpos} > ($self->{rp}->[0] - $self->{width} - 6))
178 && $self->{tpos} < ($self->{rp}->[0] + $self->{width} + 7));
179 }
180
181 if ($self->{drawtree} == 1)
182 {
183 if ($self->{tparts}->[$self->{tcurpart}] eq '')
184 {
185 $self->{drawtree} = 0;
186 $self->{tcurpart} = 0;
187 }
188 else
189 {
190 addstr(0, $self->{tpos}, $self->{tparts}->[$self->{tcurpart}++]);
191 }
192 }
193
194 $n = int(rand(15));
195 if ($n < (3 * $self->{twist}))
196 {
197 $self->{road} = $n % 3;
198 }
199
200 for ($n = LINES() - 2; $n > - 1; $n --)
201 {
202 $self->{rp}->[$n + 1] = $self->{rp}->[$n];
203 }
204
205 $self->{rp}->[0] = $self->{rp}->[1] + ($self->{road} - 1);
206
207 if (($self->{rp}->[0] - $self->{width}) < 1)
208 {
209 $self->{rp}->[0]++;
210 $self->{road} = 1;
211 }
212 elsif (($self->{rp}->[0] + $self->{width}) > (COLS() - 1))
213 {
214 $self->{rp}->[0]--;
215 $self->{road} = 1;
216 }
217
218 addch(0, $self->{rp}->[0] - $self->{width}, $roadparts[$self->{road}]);
219 addch(0, $self->{rp}->[0] + $self->{width}, $roadparts[$self->{road}]);
220 $self->{prevdpos} = $self->{dpos};
221 $self->{dpos} += $self->{delta};
222
223 if(defined($self->{rp}->[LINES() - 2]) && $self->{rp}->[LINES() - 2] > 0)
224 {
225 if($self->{dpos} < $self->{rp}->[LINES() - 2] - $self->{width}
226 || $self->{dpos} >= $self->{rp}->[LINES() - 2] + $self->{width})
227 {
228 exit(1);
229 }
230 else
231 {
232 $self->{score} += $self->{gear};
233 }
234 }
235
236 addch(LINES() - 2, $self->{dpos}, '@');
237 addch(LINES() - 1, $self->{prevdpos}, ' ');
238 beep() unless ($self->{quiet});
239 scrl(-1);
240 addstr(0, 0, "RACER Gear = " . $self->{gear} . " Score = " . $self->{score});
241 refresh;
242 }
243
244 1;
245
246 __END__
247
248 =pod
249
250 =head1 NAME
251
252 racer -- a driving game
253
254 =head1 SYNOPSIS
255
256 B<racer> [options]
257
258 =head1 DESCRIPTION
259
260 Drive a racing car represented by a I<@> around a track, score points, and
261 admire the scenery. If you go outside the lines, you die.
262
263 =head2 KEYS
264
265 =over 4
266
267 =item B<q>, B<z>, B<b>, B<[>, B<,>
268
269 Move left.
270
271 =item B<w>, B<x>, B<n>, B<space>
272
273 Move ahead.
274
275 =item B<e>, B<c>, B<m>, B<]>, B</>
276
277 Move right.
278
279 =item B<1>, B<2>, B<3>, B<4>
280
281 Change gears. See L<B<--gear>> under B<OPTIONS>.
282
283 =item B<q>
284
285 Quit the game.
286
287 =back
288
289 =head1 OPTIONS
290
291 =over 4
292
293 =item B<--gear>
294
295 A number from 1-4. The higher the gear, the faster you go and the more points
296 you score. The default is 1.
297
298 =item B<--help>, B<-h>, B<-?>
299
300 Display this help text.
301
302 =item B<--quiet>
303
304 If this option is set, sound effects are disabled. The default is sound
305 is enabled.
306
307 =item B<--trees>
308
309 A number from 1-4. The higher the number, the greater the likelyhood a tree
310 will be drawn. The default is 1.
311
312 =item B<--twist>
313
314 A number from 1-5. The higher the number the twistier the road will be. The
315 default is 1.
316
317 =item B<--width>
318
319 A number from 1-32. Equal to half the width of the road. The default is 8.
320 (So the default width of the road is 16.)
321
322 =back
323
324 =head1 INSTALLATION
325
326 Make the script executable. You will also need the B<Curses> and
327 B<Params::Validate> packages from CPAN.
328
329 =head1 BUGS/TODO
330
331 Doesn't handle SIGWINCH yet or do color.
332
333 =head1 AUTHOR
334
335 Jaldhar H. Vyas E<lt>jaldhar@braincells.comE<gt>
336
337 =head1 LICENSE
338
339 This code is free software under the Crowley Public License ("Do what
340 thou wilt shall be the whole of the license")
341
342 =head1 CREDITS
343
344 Based on Chris Kings' entry in the 2001 Obfuscated C Contest.
345
346 =head1 VERSION
347
348 1.0 -- May 30, 2004
349
350 =cut

Properties

Name Value
svn:executable

webmaster@braincells.com
ViewVC Help
Powered by ViewVC 1.1.26