Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

jonadab's scratchpad

by jonadab (Parson)
on Jun 03, 2004 at 19:32 UTC ( #360400=scratchpad: print w/ replies, xml ) Need Help??

#!/usr/bin/perl use strict; use utf8; use open ':encoding(UTF-8)'; use open ":std"; use Term::ANSIColor; use File::Spec::Functions; use Time::HiRes; use Term::ReadKey; #use DateTime; my %cmdline = @ARGV; my %config = ( configfiles => defaultconfigfiles(), globalcfg => defaultglobalcfg(), pieceset => defaultpieceset(), highscores => defaulthighscores(), ); readconfig(); $|++; END { print color("reset"); waitpos(); ReadMode 0; } ReadMode 3; setupscreen(); my %stillgoing = map { $$_{name} => "true" } @{$config{globalcfg}{play +ers}}; my %currentpiece = map { my $player = $_; my $piece = getnewpiece(); $$player{name} => +{ %$piece, %{randomstartpos($player +, $piece)}, }; } @{$config{globalcfg}{players}}; my %nextpiece = map { $$_{name} => getnewpiece() } @{$config{global +cfg}{players}}; my %board = map { my $player = $_; my $col = -1; $$player{name} => [ (map { my $row = -1; $col++; [map { $row++; +{ filled => 0, %{$config{pi +eceset}{boardbg}}, coord => "$$player{name} ($col,$row)" } } $$player{board}{top} .. $$player{boa +rd}{bottom} ] } ($$player{board}{left} .. $$player{board}{r +ight})), "$$player{name} column " . $col ]; } @{$config{globalcfg}{players}}; my %score = map { $$_{name} => 0 } @{$config{globalcfg}{players +}}; my %paused = map { $$_{name} => 0 } @{$config{globalcfg}{players +}}; my $plcount = 0; my %plnum = map { $$_{name} => $plcount++ } @{$config{globalcfg +}{players}}; my $pieceid = 1; my $fallingdelay = $config{globalcfg}{initialdelay}; my @piecequeue = (); for my $player (@{$config{globalcfg}{players}}) { shownext($$player{name}); showpiece($currentpiece{$$player{name}}); } while (grep { $_ } values %stillgoing) { print color("reset"); waitpos(); my $starttime = Time::HiRes::time(); my $timeleft = ($fallingdelay / 1000); while ($timeleft) { processkey(ReadKey $timeleft); $timeleft = $timeleft - (Time::HiRes::time() - $starttime); $timeleft = 0 if $timeleft < 0; } piecesfall(); } print "Press Enter to view the high score list..."; <STDIN>; cls(); my @highscore = @{$config{highscores}{toptwenty}}; for my $plname (keys %score) { push @highscore, +{ name => $plname, score => $score{$plname}, fake +=> 0, #date => DateTime->now()->ymd(), date => nowymd(), }; } @highscore = sort { ($$b{score} <=> $$a{score}) or ($$b{fake} <=> $$a{ +fake}) or ($$b{date} cmp $$a{date}) } @highscore; my %len = (name => 5, score => 1, date => 5); for my $n (0 .. 19) { for my $field (qw(name score date)) { my $value = ($field eq "score") ? int($highscore[$n]{$field}) : $h +ighscore[$n]{$field}; $len{$field} = length($value) if $len{$field} < length($value); }} for my $n (0 .. 19) { print color($highscore[$n]{fake} ? "reset" : "bold white on_black"); for my $field (qw(name score date)) { my $value = ($field eq "score") ? sprintf("%0$len{score}d", int($h +ighscore[$n]{$field})) : $highscore[$n]{$field}; print $value; print ((" ") x ($len{$field} - length($value))); print " "; } print "\n"; } $config{highscores}{toptwenty} = [ map { $highscore[$_] } 0 .. 19 ]; if ($cmdline{writeconfig}) { writeconfig(); } else { writeconfigfile("highscores", $config{configfiles}{highscores}); } exit 0; # Subroutines follow. sub nowymd { my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = l +ocaltime(); return sprintf("%04d-%02d-%02d", 1900 + $year, $mon, $mday); } sub shuffle { return map { $$_[0] } sort { $$a[1] <=> $$b[1] } map { [ $_ => rand +1000 ] } @_; } sub checkforlines { my ($plname) = @_; my $player = $config{globalcfg}{players}[$plnum{$plname}]; my $xmax = $$player{board}{right} - $$player{board}{left}; my $ymax = $$player{board}{bottom} - $$player{board}{top}; my $lines = 0; my $mult = 1; for my $y (reverse(0 .. $ymax)) { my $full = 1; while ($full) { my $points = 0; for my $x (0 .. $xmax) { if ($board{$plname}[$x][$y]{filled}) { $points += $board{$plname}[$x][$y]{val}; } else { $full = 0; } } if ($full) { $lines++; $score{$plname} += $points * $config{globalcfg}{scoremult}{lin +e} * $mult; $mult *= $config{globalcfg}{scoremult}{multiline}; for my $ty (reverse(1 .. $y)) { for my $tx (0 .. $xmax) { $board{$plname}[$tx][$ty] = +{ %{ $board{$plname}[$tx][$ty + - 1] }, row => $ty }; gotoxy($$player{board}{left} + $tx, $$player{board}{top} + + $ty); print color($board{$plname}[$tx][$ty]{bg}) . color($board{ +$plname}[$tx][$ty]{fg}) . $board{$plname}[$tx][$ty]{char}; } } for my $tx (0 .. $xmax) { $board{plname}[$tx][0] = +{ filled = +> 0, %{$config{pieceset}{boardbg}} }; } $fallingdelay *= $config{globalcfg}{delaymult}; }}} showscore($player) if $lines; waitpos(); } sub processkey { my ($key) = @_; return if not $key; for my $p (@{$config{globalcfg}{players}}) { for my $k (grep { $_ eq $key } keys %{$$p{keys}}) { dispatch($$p{name}, $$p{keys}{$k}); }}} sub dispatch { my ($plname, $action) = @_; return if not $stillgoing{$plname}; if ($action eq "pause") { $paused{$plname} = $paused{$plname} ? undef : "true"; my $player = $config{globalcfg}{players}[$plnum{$plname}]; gotoxy($$player{pause}{x}, $$player{pause}{y}); print color($config{globalcfg}{titles}{bg}) . color($config{global +cfg}{titles}{fg}) . (($paused{$plname}) ? "PAUSED" : " "); } elsif (not $paused{$plname}) { if ($action eq "down") { movedown($currentpiece{$plname}); } elsif ($action eq "left") { move($currentpiece{$plname}, -1, 0); } elsif ($action eq "right") { move($currentpiece{$plname}, 1, 0); } elsif ($action eq "rotleft") { rotate($currentpiece{$plname}, -1); } elsif ($action eq "rotright") { rotate($currentpiece{$plname}, 1); } elsif ($action eq "transform") { transform($currentpiece{$plname}); } elsif ($action eq "drop") { drop($currentpiece{$plname}); } elsif ($action eq "steal") { stealnext($plname); } } } sub stealnext { my ($thief) = @_; if ($score{$thief} >= $config{globalcfg}{cost}{steal}) { my $victim = $config{globalcfg}{players}[($plnum{$thief} + 1) % ( +scalar @{$config{globalcfg}{players}})]; ($nextpiece{$thief}, $nextpiece{$victim}) = ($nextpiece{$victim}, +$nextpiece{$thief}); $score{$thief} -= $config{globalcfg}{cost}{steal}; shownext($thief); shownext($victim); } } sub transform { my ($piece) = @_; if ($score{$$piece{plname}} >= $config{globalcfg}{cost}{transform}) +{ my $newpiece = +{ %{getnewpiece()}, plname => $$piece{name}, x => $$piece{x}, y => $$piece{y}, transformed => + $$piece{transformed} + 1, moved => $$piece{moved}, turned => $$piece{turne +d}, fallen => $$piece{fallen}, }; if (piecewouldfit($newpiece, $$newpiece{cview}, $$newpiece{x}, $$n +ewpiece{y})) { hidepiece($piece); $currentpiece{$$piece{plname}} = $newpiece; showpiece($newpiece); $score{$$piece{plname}} -= $config{globalcfg}{cost}{transform}; } } } sub drop { my ($piece) = @_; my $score = 0; while (movedown($piece)) { $score++; } $score *= $$piece{val} * $config{globalcfg}{scoremult}{drop}; $score{$$piece{plname}} += $score; } sub rotate { my ($piece, $dir) = @_; my $vmax = scalar @{$$piece{view}}; my $vnum = ($$piece{cview} + $dir + $vmax) % $vmax; if (piecewouldfit($piece, $vnum, $$piece{x}, $$piece{y})) { hidepiece($piece); $$piece{cview} = $vnum; $$piece{turned}++; showpiece($piece); $score{$$piece{plname}} -= ($config{globalcfg}{cost}{rotate} || 0) +; } } sub move { my ($piece, $dx, $dy) = @_; if (($dx == 0) and ($dy = 1)) { movedown($piece); } elsif (piecewouldfit($piece, $$piece{cview}, $$piece{x} + ($dx * ($config{pieceset}{xmove} + || 1)), $$piece{y} + ($dy * ($config{pieceset}{ymove} + || 1)))) { hidepiece($piece); $$piece{x} += $dx * ($config{pieceset}{xmove} || 1); $$piece{y} += $dy * ($config{pieceset}{ymove} || 1); $$piece{moved} += abs($dx) + abs($dy); showpiece($piece); $score{$$piece{plname}} -= ($config{globalcfg}{cost}{move} || 0); } } sub movedown { my ($piece) = @_; if (piecewouldfit($piece, $$piece{cview}, $$piece{x}, $$piece{y} + ( +$config{pieceset}{ymove} || 1))) { hidepiece($piece); $$piece{y} += ($config{pieceset}{ymove} || 1); $$piece{fallen}++; showpiece($piece); return 1; } else { stickpiece($piece); return 0; } } sub gameover { my ($plname) = @_; $stillgoing{$plname} = undef; my $player = $config{globalcfg}{players}[$plnum{$plname}]; my $cx = $$player{board}{left} + int(($$player{board}{right} - $$p +layer{board}{left}) / 2); my $cy = $$player{board}{top} + int(($$player{board}{bottom} - $$p +layer{board}{top}) / 2); my $len = length($config{globalcfg}{gameover}{message}); fillrect($cx - int((1 + $len) / 2), $cy - 2, $cx + int((1 + $len) / +2), $cy + 2, %{$config{globalcfg}{boardbg}}); framearound($cx - int((1 + $len) / 2), $cy - 2, $cx + int((1 + $len) + / 2), $cy + 2); gotoxy($cx - int($len / 2),$cy - 1); print color($config{globalcfg}{gameover}{bg}) . color($config{global +cfg}{gameover}{fg}) . $config{globalcfg}{gameover}{message}; $len = length(int $score{$plname}); gotoxy($cx - int($len / 2), $cy + 1); print int $score{$plname}; waitpos(); } sub stickpiece { my ($piece) = @_; #my @filled; for my $x (0 .. ($config{pieceset}{xsize} - 1)) { for my $y (0 .. ($config{pieceset}{ysize} - 1)) { if ($$piece{view}[$$piece{cview}][$y][$x]) { #push @filled, "(" . ($x + $$piece{x}) . ",". ($y + $$piece{y} +) . ")"; $score{$$piece{plname}} += $$piece{val} * $config{globalcfg}{s +coremult}{stick}; $board{$$piece{plname}}[$x + $$piece{x}][$y + $$piece{y}] = +{ filled => "true", char => $$piece{char}, plname = +> $$piece{plname}, fg => $$piece{fg}, bg => $$piece{bg}, pieceid = +> $$piece{id}, src => $$piece{name}, val => $$piece{val}, }; }}} checkforlines($$piece{plname}); $currentpiece{$$piece{plname}} = +{ %{$nextpiece{$$piece{plname}}}, %{randomstartpos($config{globa +lcfg}{players}[$plnum{$$piece{plname}}], $nextpiece{$$ +piece{plname}})}, }; $nextpiece{$$piece{plname}} = getnewpiece(); shownext($$piece{plname}); if (piecewouldfit($currentpiece{$$piece{plname}}, $currentpiece{$$pi +ece{plname}}{cview}, $currentpiece{$$piece{plname}}{x}, $currentpiece{$ +$piece{plname}}{y})) { return $currentpiece{$$piece{plname}}; } else { return gameover($$piece{plname}); } } sub shownext { my ($plname) = @_; my $player = $config{globalcfg}{players}[$plnum{$plname}]; my $right = $$player{next}{left} + $config{pieceset}{xsize} - 1; my $bottom = $$player{next}{top} + $config{pieceset}{ysize} - 1; fillrect($$player{next}{left}, $$player{next}{top}, $right, $bottom, + %{$config{globalcfg}{boardbg}}); showpiece($nextpiece{$plname}, $$player{next}{left}, $$player{next}{ +top}); waitpos(); } sub showpiece { my ($piece, $basex, $basey) = @_; my $player = $config{globalcfg}{players}[$plnum{$$piece{plname}}]; $basex = $$player{board}{left} + $$piece{x} if not defined $basex; $basey = $$player{board}{top} + $$piece{y} if not defined $basey; for my $x (0 .. ($config{pieceset}{xsize} - 1)) { for my $y (0 .. ($config{pieceset}{ysize} - 1)) { if ($$piece{view}[$$piece{cview}][$y][$x]) { gotoxy($basex + $x, $basey + $y); print color($$piece{bg}) . color($$piece{fg}) . $$piece{char}; }}}} sub hidepiece { my ($piece) = @_; my $player = $config{globalcfg}{players}[$plnum{$$piece{plname}}]; for my $x (0 .. ($config{pieceset}{xsize} - 1)) { for my $y (0 .. ($config{pieceset}{ysize} - 1)) { if ($$piece{view}[$$piece{cview}][$y][$x]) { my $tx = $$player{board}{left} + $x + $$piece{x}; my $ty = $$player{board}{top} + $y + $$piece{y}; gotoxy($tx, $ty); print color($config{pieceset}{boardbg}{bg}) . color($config{pi +eceset}{boardbg}{fg}) . $config{pieceset}{boardbg}{char}; }}}} sub piecewouldfit { my ($piece, $viewnum, $tx, $ty) = @_; my $player = $config{globalcfg}{players}[$plnum{$$piece{plname}}]; for my $x (0 .. ($config{pieceset}{xsize} - 1)) { for my $y (0 .. ($config{pieceset}{ysize} - 1)) { if ($$piece{view}[$viewnum][$y][$x] and (($tx + $x < 0) or ($tx + $x > ($$player{board}{right} - $$ +player{board}{left})) or ($ty + $y < 0) or ($ty + $y > ($$player{board}{bottom} - $$ +player{board}{top})))) { return; # piece would extend outside the game board } if ($$piece{view}[$viewnum][$y][$x] and $board{$$piece{plname}}[ +$x + $tx][$y + $ty]{filled}) { return; # piece would overlap a filled spot }}} return [$tx, $ty]; } sub showscore { my ($player) = @_; gotoxy($$player{score}{x}, $$player{score}{y}); print color($config{globalcfg}{titles}{bg} || "on_black") . color($c +onfig{globalcfg}{titles}{fg} || "white") . sprintf("%0$$player{score}{padto}d", $score{$$player{name}}); } sub piecesfall { for my $player (grep { not $paused{$$_{name}} } @{$config{globalcfg} +{players}}) { movedown($currentpiece{$$player{name}}) if $stillgoing{$$player{na +me}}; showscore($player); } waitpos(); } sub randomstartpos { my ($player, $piece) = @_; my $min = 0; my $max = ($$player{board}{right} - $$player{board}{left}) - ($confi +g{pieceset}{xsize}); my $x = int((($max - $min) / 2) + ((50 > int rand 100) ? 1 : -1) * rand rand(($max - $ +min) / 2)); my $xadj = ($x < (($max - $min) / 2)) ? +1 : -1; while ($x % ($config{pieceset}{xmove} || 1)) { $x += $xadj; } return +{ plname => $$player{name}, x => $x, y => 0, moved => 0, turned => 0, fallen => 0, transformed => 0, }; } sub getnewpiece { if (not scalar @piecequeue) { @piecequeue = shuffle(map { (+{%$_}) x ($$_{freq}) } @{$config{pie +ceset}{pieces}}); } my $piece = shift @piecequeue; $$piece{id} = $pieceid++; $$piece{cview} = int rand(@{$$piece{view}}); return $piece; } sub setupscreen { cls(); #print join "\n", map { join "", map { $_ % 10 } 0 .. 100 } 1 .. 30; for my $player (@{$config{globalcfg}{players}}) { # Draw frame around the board: framearound($$player{board}{left}, $$player{board}{top}, $$player{ +board}{right}, $$player{board}{bottom}); fillrect($$player{board}{left}, $$player{board}{top}, $$player{boa +rd}{right}, $$player{board}{bottom}, %{$config{globalcfg}{boardbg}}) +; my $nextright = $$player{next}{left} + $config{pieceset}{xsize} - + 1; my $nextbottom = $$player{next}{top} + $config{pieceset}{ysize} - + 1; framearound($$player{next}{left}, $$player{next}{top}, $nextright, + $nextbottom); print color($config{globalcfg}{titles}{bg} || "on_black") . color( +$config{globalcfg}{titles}{fg} || "white"); if ($$player{board}{top} >= 2) { gotoxy($$player{board}{left}, ($$player{board}{top} - 2)); print $$player{name}; } if ($$player{next}{top} >= 2) { gotoxy($$player{next}{left}, ($$player{next}{top} - 2)); print $$player{next}{title} || "Next"; } } } sub fillrect { my ($minx, $miny, $maxx, $maxy, %arg) = @_; print color($arg{bg} || "on_black") . color($arg{fg} || "white"); my $line = (($arg{char} || " ") x ($maxx + 1 - $minx)); for my $y ($miny .. $maxy) { gotoxy($minx, $y); print $line; } } sub framearound { my ($minx, $miny, $maxx, $maxy) = @_; # These are the coordinates of + the area contained within the frame. print color($config{globalcfg}{frames}{bg} || "on_black") . color($c +onfig{globalcfg}{frames}{fg} || "white"); my $doleft = ($minx > 1) ? 1 : 0; if ($miny > 1) { # Top of frame gotoxy($minx - $doleft, $miny - 1); if ($doleft) { print $config{globalcfg}{frames}{char}[0][0]; } print(($config{globalcfg}{frames}{char}[0][1]) x ($maxx + 1 - $min +x)); print $config{globalcfg}{frames}{char}[0][2]; } for my $y ($miny .. $maxy) { # sides of frame if ($doleft) { gotoxy($minx - 1, $y); print $config{globalcfg}{frames}{char}[1][0]; } gotoxy($maxx + 1, $y); print $config{globalcfg}{frames}{char}[1][2]; } gotoxy($minx - $doleft, $maxy + 1); # bottom of frame if ($doleft) { print $config{globalcfg}{frames}{char}[2][0]; } print(($config{globalcfg}{frames}{char}[2][1]) x ($maxx + 1 - $minx) +); print $config{globalcfg}{frames}{char}[2][2]; #use Data::Dumper; print Dumper(+{ minx => $minx, miny => $miny, dol +eft => $doleft }); } sub gotoxy { my ($x, $y) = @_; print "\033[${y};${x}H"; } sub cls { print color("reset"); print "\033[2J"; # clear the screen gotoxy(0,0); } sub waitpos { gotoxy(@{$config{globalcfg}{waitpos}}); } sub nonfatalerror { my ($msg) = @_; waitpos(); print color("bold yellow on_red"); print "Error: $msg. Press Enter."; print color("reset"); <STDIN>; } sub writeconfig { for my $cfgkey (sort { $config{$a}{sort} <=> $config{$b}{sort} } ke +ys %config) { if ($config{configfiles}{$cfgkey}) { writeconfigfile($cfgkey, $config{configfiles}{$cfgkey}); } } } sub readconfig { for my $cfgkey (sort { $config{$a}{sort} <=> $config{$b}{sort} } ke +ys %config) { if ($config{configfiles}{$cfgkey}) { print "Reading config file for $cfgkey: $config{configfiles}{$cf +gkey}\n"; readconfigfile($cfgkey, $config{configfiles}{$cfgkey}); } } } sub readconfigfile { my ($cfgkey, $file) = @_; my $path = catfile($config{configfiles}{directory}, $file); if (-e $path) { open CFG, "<", $path or return nonfatalerror("Unable to read confi +g $path: $!"); #print " Opened config file $file\n"; my $slurp = join "", <CFG>; close CFG; $config{cfgkey}{fromfile} = $path; readconfigtext($config{$cfgkey}, $slurp); } } sub readconfigscalar { my ($text) = @_; return if not $text; my %closer = ("[" => "]", "{" => "}", '"' => '"', "'" => "'"); if ($text =~ m/^\s*([[{"'])/) { my ($type) = ($1); $text =~ s/^\s*([[{"'])//; if ($type eq "[") { return readconfiglist($text, $closer{$type}); } elsif ($type eq "{") { my ($value, $remainingtext) = readconfiglist($text, $closer{$typ +e}); return (+{ @$value }, $remainingtext); } else { return readconfigstring($text, $closer{$type}); } } else { my ($line) = $text =~ m/^(.*?)$/; nonfatalerror("Failed to parse config scalar: $line"); } } sub readconfiglist { my ($text, $closer) = @_; my @list; while ($text and not $text =~ m/^\s*[$closer]/) { if ($text =~ m/^\s*(?:[,]|[=][>])\s*/) { push @list, undef; } else { my ($value, $rest) = readconfigscalar($text); push @list, $value; $text = $rest; } $text =~ s/^\s*(?:[,]|[=][>])\s*//; } $text =~ s/^\s*[$closer]\s*//; return (\@list, $text); } sub readconfigstring { my ($text, $closer) = @_; my $string = ""; while ($text and not $text =~ m/^[$closer]/) { my ($substring) = $text =~ m/^([^"'\\])/; $string .= $substring; $text =~ s/^([^"'\\])//; if ($text =~ m/^[\\]([\\"'])/) { my ($escaped) = $1; $string .= $escaped; $text =~ s/^[\\]([\\"'])//; } } $text =~ s/^[$closer]//; return ($string, $text); } sub readconfigtext { my ($cfghash, $text) = @_; $text =~ s/^\s*(?:[#].*|)(?:$)\s*//; return if not $text; print " <" . length($text) . ">\n"; my %closer = ("[" => "]", "{" => "}", '"' => '"', "'" => "'"); if ($text =~ m/^\s*(\w+)\s*[=][>]?\s*([[{"'])/) { my ($key, $type) = ($1, $2); $text =~ s/^\s*(\w+)\s*[=][>]?\s*([[{"'])//; if ($type eq "[") { my ($value, $remainingtext) = readconfiglist($text, $closer{$typ +e}); if ($value) { $$cfghash{$key} = $value; readconfigtext($cfghash, $remainingtext); } } elsif ($type eq "{") { my ($value, $remainingtext) = readconfiglist($text, $closer{$typ +e}); if ($value) { $$cfghash{$key} = +{ %{$$cfghash{$key}}, @$value }; readconfigtext($cfghash, $remainingtext); } } else { my ($value, $remainingtext) = readconfigstring($text, $closer{$t +ype}); if ($value) { $$cfghash{$key} = $value; readconfigtext($cfghash, $remainingtext); } } } else { my ($line) = $text =~ m/^(.*?)$/; nonfatalerror("Failed to parse config text: $line"); } } sub cfgscalartostring { my ($scalar, $indentlevel) = @_; $indentlevel ||= ""; if ((ref $scalar) eq "ARRAY") { return "[" . (join ", ", map { cfgscalartostring($_, $indentlevel +. " ") } @$scalar) . "]\n$indentlevel"; } elsif ((ref $scalar) eq "HASH") { return "{" . (join ", ", map { my $k = $_; cfgscalartostring($k) . + " => " . cfgscalartostring($$scalar{$k}, $indentlevel . " ") } key +s %$scalar) . "}\n$indentlevel"; } elsif (not defined $scalar) { return ""; } elsif (not ref $scalar) { my $string = "" . $scalar; $string =~ s/[\\]/\\\\/; $string =~ s/(['"])/\\$1/; return '"' . $string . '"'; } } sub writeconfigfile { my ($cfgkey, $file) = @_; my $path = catfile($config{configfiles}{directory}, $file); open CFG, ">", $path or return nonfatalerror("Unable to write config + file $path: $!"); my $cfghash = $config{$cfgkey}; for my $key (keys %$cfghash) { print CFG "$key = " . cfgscalartostring($$cfghash{$key}) . "\n"; } close CFG; } sub defaultconfigfiles { return +{ sort => 1, directory => $cmdline{configdir} || defaultconfigdir( +), configfiles => undef, globalcfg => $cmdline{globalconfig} || "tetris.cfg", pieceset => $cmdline{pieceset} || "tetris-pieces.da +t", highscores => $cmdline{scorefile} || "tetris-highscore +s.dat", }; } sub defaultconfigdir { my $base = $ENV{HOME} || "./"; for my $part (".config", "perlgames", "jtetris") { my $dir = catfile($base, $part); mkdir $dir if not -e $dir; $base = $dir if -e $dir; } return $base; } sub defaultglobalcfg { return +{ sort => 2, waitpos => [2, 30], initialdelay => 3000, delaymult => (95 / 100), scoremult => +{ stick => (1 / 20), line => 1, multiline + => 2, drop => 1, }, cost => +{ move => 0, rotate => 0, steal => 10, tr +ansform => 100, }, gameover => +{ bg => "on_black", fg => "bold yellow", +message => " G A M E O V E R ", }, players => [ +{ name => "Player One", board => +{ top => 1, left => 3, righ +t => 26, bottom => 24, }, next => +{ top => 5, left => 30, tit +le => "Next (1)", }, pause => +{ x => 31, y => 11, }, score => +{ x => 30, y => 13, padto = +> 8, }, keys => +{ a => "left", d => "right" +, w => "rotleft", e => "rotright", q => "transform", s => "down", x = +> "drop", "~" => "pause", t => "steal", }, }, # +{ name => "Player Two", # next => +{ top => 5, left => 42, ti +tle => "Next (2)", }, # board => +{ top => 1, left => 53, ri +ght => 76, bottom => 24, }, # pause => +{ x => 43, y => 11, }, # score => +{ x => 42, y => 13, padto +=> 8, }, # keys => +{ j => "left", l => "right +", i => "rotleft", o => "rotright", p => "transform", k => "down", ", +" => "drop", 7 => "steal", "\\" => "pause", }, # }, ], frames => +{ fg => "white", bg => "on_blue", char => [ ["&#9556;", "&#9552;", "&#955 +9;"], ["&#9553;", " ", "&#9553;"], ["&#9562;", "&#9552;", "&#9565;"], + ], }, titles => +{ fg => "bold white", bg => "on_blue", }, }; } sub defaultpieceset { return +{ sort => 3, xsize => 8, ysize => 4, xmove => 2, ymove => 1, boardbg => +{ bg => "on_black", fg => "white", char => " +", }, pieces => [ +{ name => "George", char => "&#9608;", fg => "green", bg => "on_black", freq => 5, val => 1, view => [ [ [(0) x 8], [(0) x 8], [(1) x 8] +, [(0) x 8], ], [ [1, 1, ((0) x 6)], [0, 0, 1, 1, + ((0) x 4)], [(0) x 4, 1, 1, 0, 0], [(0) x 6 +, 1, 1], ], [ ([(0) x 4, 1, 1, 0, 0]) x 4 ], [ [(0) x 6, 1, 1], [(0) x 4, 1, 1 +, 0, 0], [0, 0, 1, 1, ((0) x 4)], [1, 1, + ((0) x 6)], ], [ [(0) x 8], [(1) x 8], [(0) x 8] +, [(0) x 8], ], [ [1, 1, ((0) x 6)], [0, 0, 1, 1, + ((0) x 4)], [(0) x 4, 1, 1, 0, 0], [(0) x 6 +, 1, 1], ], [ ([0, 0, 1, 1, ((0) x 4)]) x 4 ] +, [ [(0) x 6, 1, 1], [(0) x 4, 1, 1 +, 0, 0], [0, 0, 1, 1, ((0) x 4)], [1, 1, + ((0) x 6)], ], ], }, +{ name => "Barracuda", char => "&#9608;", freq => 3, fg => "red", bg => "on_red", val => 3, view => [ [ [(1) x 6, 0, 0], ([0, 0, 1, 1 +, ((0) x 4)]) x 2, [(0) x 8], ], [ [0, 0, 1, 1, ((0) x 4)], [(0) + x 4, 1, 1, 0, 0], [(0, 0, 1, 1) x 2], [1, 1, ((0) x 6)], ], [ [(0) x 4, 1, 1, 0, 0], [(1) x + 6, 0, 0], [(0) x 4, 1, 1, 0, 0], [(0) x 8], ], [ [1, 1, ((0) x 6)], [(0, 0, 1, + 1) x 2], [(0) x 4, 1, 1, 0, 0], [0, 0, 1, 1, ((0) x4)], ], [ ([0, 0, 1, 1, ((0) x 4)]) x 2 +, [(1) x 6, 0, 0], [(0) x 8], ], [ [(0) x 6, 1, 1], [(1, 1, 0, 0 +) x 2], [0, 0, 1, 1, ((0) x 4)], [(0) x 4, 1, 1, 0, 0], ], [ [1, 1, ((0) x 6)], [(1) x 6, +0, 0], [1, 1, ((0) x 6)], [(0) x 8], ], [ [(0) x 4, 1, 1, 0, 0], [0, 0, + 1, 1, ((0) x 4)], [(1, 1, 0, 0) x 2], [(0) x 6, 1, 1], ], ], }, +{ name => "Wavelength", char => "&#9608;", freq => 2, fg => "magenta", bg => "on_blue", val => 2, view => [ [ [(1) x 6, 0, 0], [0, 0, 1, 1, + ((0) x 4)], ([(0) x 8]) x 2, ], [ [1, 1, ((0) x 6)], [0, 0, 1, +1, ((0) x 4)], [(1, 1, 0, 0) x 2], [(0) x 8], ], [ [0, 0, 1, 1, ((0) x 4)], [(1) + x 4, ((0) x 4)], [0, 0, 1, 1, ((0) x 4)], [(0) x 8], ], [ [(1, 1, 0, 0) x 2], [0, 0, 1, + 1, ((0) x 4)], [1, 1, ((0) x 6)], [(0) x 8], ], [ [0, 0, 1, 1, ((0) x 4)], [(1) + x 6, 0, 0], ([(0) x 8]) x 2, ], [ [(1, 1, 0, 0) x 2], [0, 0, 1, + 1, ((0) x 4)], [(0) x 4, 1, 1, 0, 0], [(0) x 8], ], [ [1, 1, ((0) x 6)], [(1) x 4, +((0) x 4)], [1, 1, ((0) x 4)], [(0) x 8], ], [ [(0) x 4, 1, 1, 0, 0], [0, 0, + 1, 1, ((0) x 4)], [(1, 1, 0, 0) x 2], [(0) x 8], ], ], }, +{ name => "Clara", char => "&#9618;", freq => 3, fg => "red", bg => "on_white", val => 4, view => [ ([ [0, 0, 1, 1, ((0) x 4)], [(1) x 6, 0, 0], [0, 0, 1, 1, ((0) x 4)], [(0) x 8], ], [ [(1, 1, 0, 0) x 2], [0, 0, 1, 1, ((0) x 4)], [(1, 1, 0, 0) x 2], [(0) x 8], ]) x 4, ], }, +{ name => "Corrugated", char => "&#9618;", freq => 1, fg => "white", bg => "on_yellow", val => 5, view => [ ([ ([(1) x 6, 0, 0]) x 3, [(0) +x 8], ], [ [0, 0, ((1) x 4), 0, 0], ([( +1) x 8]) x 2, [0, 0, ((1) x 4), 0, 0], ]) x 4, ], }, +{ name => "Leon", char => "&#9617;", freq => 6, fg => "cyan", bg => "on_blue", val => 2, view => [ [ ([0, 0, 1, 1, (0) x 4]) x 2, +[0, 0, ((1) x 4), 0, 0], [(0) x 8], ], [ [(0) x 4, 1, 1, 0, 0], [0, 0, + 1, 1, ((0) x 4)], [1, 1, ((0) x 6)], [0, 0, 1, 1, ((0) x 4)], ], [ [(0) x 8], [(1) x 6, 0, 0], [ +1, 1, ((0) x 6)], [(0) x 8], ], [ [0, 0, 1, 1, ((0) x 4)], [(1, + 1, 0, 0) x 2], [(0) x 6, 1, 1], [(0) x 8], ], [ [0, 0, ((1) x 4), 0, 0], (([( +0) x 4, 1, 1, 0, 0]) x 2), [(0) x 8], ], [ [(0) x 4, 1, 1, 0, 0], [(0) x + 6, 1, 1], [(0) x 4, 1, 1, 0, 0], [0, 0, 1, 1, ((0) x 4)], ], [ [(0) x 8], [(0) x 6, 1, 1], [ +0, 0, ((1) x 6)], [(0) x 8], ], [ [1, 1, ((0) x 6)], [(0, 0, 1, + 1) x 2], [(0) x 4, 1, 1, 0, 0], [(0) x 8], ], ], }, +{ name => "Allstar", char => "&#9617;", freq => 6, fg => "green", bg => "on_cyan", val => 2, view => [ [ ([(0) x 4, 1, 1, 0, 0]) x 2, +[0, 0, ((1) x 4), 0, 0], [(0) x 8], ], [ [(0) x 6, 1, 1], [(1, 1, 0, 0 +) x 2], [0, 0, 1, 1, ((0) x 4)], [(0) x 8], ], [ [(0) x 8], [1, 1, ((0) x 6)], + [(1) x 6, 0, 0], [(0) x 8], ], [ [0, 0, 1, 1, ((0) x 4)], [1, +1, ((0) x 6)], [0, 0, 1, 1, ((0) x 4)], [(0) x 4, 1, 1, 0, 0], ], [ [(1) x 4, ((0) x 4)], ([1, 1, + ((0) x 6)]) x 2, [(0) x 8], ], [ [(0) x 4, 1, 1, 0, 0], [(0, 0 +, 1, 1) x 2], [1, 1, ((0) x 6)], [(0) x 8], ], [ [(1) x 6, 0, 0], [(0) x 4, 1, + 1, 0, 0], ([(0) x 8]) x 2, ], [ [1, 1, ((0) x 6)], [0, 0, 1, +1, ((0) x 4)], [(0) x 4, 1, 1, 0, 0], [0, 0, 1, 1, ((0) x 4)], ], ], }, ], }; } sub defaulthighscores { return +{ toptwenty => [ +{ name => "Jonadab the Unsightly One", sc +ore => 77777, date => "2016-05-08", fake => 1, }, # 1 +{ name => "Artaxerxes the Useless", sc +ore => 55555, date => "2016-05-08", fake => 1, }, # 2 +{ name => "Bildad the Unnecessary", sc +ore => 33333, date => "2016-05-08", fake => 1, }, # 3 +{ name => "Horatio the Lackwit", sc +ore => 11111, date => "2016-05-08", fake => 1, }, # 4 +{ name => "Goldenivy the Incontinent", sc +ore => 9999, date => "2016-05-08", fake => 1, }, # 5 +{ name => "Sanballat the Toad", sc +ore => 7777, date => "2016-05-08", fake => 1, }, # 6 +{ name => "Athalia the Unrighteous", sc +ore => 5555, date => "2016-05-08", fake => 1, }, # 7 +{ name => "Cruella the Incorrigible", sc +ore => 3333, date => "2016-05-08", fake => 1, }, # 8 +{ name => "Mehitabel the Shunned", sc +ore => 1111, date => "2016-05-08", fake => 1, }, # 9 +{ name => "Bartleby the Illiterate", sc +ore => 999, date => "2016-05-08", fake => 1, }, # 10 +{ name => "Jezebel the Jaded", sc +ore => 777, date => "2016-05-08", fake => 1, }, # 11 +{ name => "Norwood the Nondescript", sc +ore => 555, date => "2016-05-08", fake => 1, }, # 12 +{ name => "Nebuchadnezzar the Dolt", sc +ore => 333, date => "2016-05-08", fake => 1, }, # 13 +{ name => "Ivan the Unreasonable", sc +ore => 111, date => "2016-05-08", fake => 1, }, # 14 +{ name => "Archibald the Incorrigible", sc +ore => 99, date => "2016-05-08", fake => 1, }, # 15 +{ name => "Minnie the Morbid Miser" , sc +ore => 77, date => "2016-05-08", fake => 1, }, # 16 +{ name => "Gerusamy the Geezer", sc +ore => 55, date => "2016-05-08", fake => 1, }, # 17 +{ name => "Bonnie the Bored", sc +ore => 33, date => "2016-05-08", fake => 1, }, # 18 +{ name => "Eustace the Ecumenist", sc +ore => 11, date => "2016-05-08", fake => 1, }, # 19 +{ name => "Petruchio the Pointless", sc +ore => 0, date => "2016-05-08", fake => 1, }, # 20 ], }; }
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (6)
As of 2016-05-25 03:54 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?