#!/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 => [ ["╔", "═", "λ
+9;"], ["║", " ", "║"], ["╚", "═", "╝"],
+ ],
},
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 => "█",
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 => "█",
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 => "█",
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 => "▒",
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 => "▒",
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 => "░",
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 => "░",
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
],
};
}
|
