Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
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 all is quiet...

How do I use this? | Other CB clients
Other Users?
Others surveying the Monastery: (4)
As of 2017-01-21 11:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you watch meteor showers?




    Results (184 votes). Check out past polls.