難読化テトリス perltris リーディング

本日は降雪なり。横浜では朝から大きなみぞれが地面めざして落下し続けてきました。窓のすぐ向こうを落下していくみぞれは大きくて形もいろいろです。朝方、ぼんやりと眺めていたら、テトリスが頭に思い浮かんでいました。ロシアでテトリスが生まれたのは、降雪がヒントだったりしたらおもしろかろうと妄想したり。そして、7年ぐらい前に perl で書かれた難読化テトリスを見たことがあったなと思い出したのでした。

http://colinfahey.com/tetris/tetris.html

4.3.7 Obfuscated code Tetris : Perl code

The following is Tetris for the Perl interpreter: Perltris (version 20050717) by Sean Adams.

というわけで、perltris リーディングを流れ落ちる自然のテトレスを窓の外に眺めながらやってみることにしました。

まず、このスクリプトでは末尾にあるように、英大文字の前のドル記号のシジルがコード上で省略してあります。

$_='A=15; B=30; 以下略';
s/([A-Z])/\$$1/g; s/\%\$/\%/g; eval;

なので、先頭の A=15; は、$A=15; を意味します。シジルを復元し、perltidy にかけたものを「ダウンロードたけし(寅年)」さんが公開していらっしゃいますので、以下では、それに注釈をつけることにします。my 変数名は適宜付け替えます。

perlでテトリス! - ダウンロードたけし(寅年)の日記

#!/usr/bin/env perl
no strict;
no warnings;

our $A = 15;      # 盤面の幅
our $B = 30;      # 盤面の高さ

# 盤面 @G。盤面はタイルの2次元配列 $G[$x][$y] である。左上が原点[0][0]の左手系。
# 各タイル値はゼロから 7 の整数値で表現され、タイルの色が $G[$x][$y] に格納される。
# タイル値ゼロは空のタイルであることを意味する。
our @G = map { [map { 0 } 1 .. $B] } 1 .. $A;
# 盤面 @R。端末に出力済みの盤面 @G のキャッシュ。@R から @G へ値が変化したタイルだけを出力する。
our @R = map { [map { 0 } 1 .. $B] } 1 .. $A;

# STDIN/STDOUT のバッファリングをオフにする。
select(STDIN); $| = 1;
select(STDOUT); $| = 1;
# 端末をノーエコーモードにして、クックモードをオフにする。
system "stty -echo -icanon eol \001";

# n 手続きで使う7種類のピースの初期タイルを保持する。
our @C; # $C[$c]->[$dx][$dy]。$c 番目のピースのタイル。
our @I; # $J[$c]。$c 番目のピースの幅。
our @J; # $I[$c]。$c 番目のピースの高さ。

# ピース @C、@I、@J を初期化する。初期化タイルパターンは [$dy][$dx] で記述してあるため、
# @C に格納するとき、縦横を転置する。
# 例えば "022.020.020" は
#
#   [[0, 2, 2],
#    [0, 2, 0],
#    [0, 2, 0]],
#
# を意味する。
# これから、
#
#   $C[2]->[0][0] = 0; $C[2]->[1][0] = 2; $C[2]->[2][0] = 2;
#   $C[2]->[0][1] = 0; $C[2]->[1][1] = 2; $C[2]->[2][1] = 0;
#   $C[2]->[0][2] = 0; $C[2]->[1][2] = 2; $C[2]->[2][2] = 0;
#   $I[2] = 3;
#   $J[2] = 3;
#
# と格納をおこなう。
our $P = 0;     # ピースの個数。最終的に scalar @C と同じ値になる。
for my $tilemap (split /\s/, "010.010.010.010 77.77 022.020.020 330.030.030 440.044.000 055.550.000 666.060.000") {
    my $dy=0;
    my $dx=0;   # バグ修正
    for my $tilerow (split /\./, $tilemap) {
        $dx=0;  # バグ修正
        for my $tile (split //, $tilerow) {
            $C[$P]->[$dx++][$dy] = $tile;
        }
        $dy++
    }
    $J[$P] = $dx;
    $I[$P++] = $dy;
}

# 端末制御に termcap/terminfo を使わず、直接 ANSI エスケープ・シーケンスを
# STDOUT へ送出している。

# ANSI エスケープ・シーケンスのテンプレートをセットする。
# H と J を chr で表現してある理由は、英大文字に $ がついてしまうためであろう。
# our %L = split( / /, "m _" . chr(72) . " c 2" . chr(74) . " a _m" );
# ハッシュのキーは a() 手続きへ渡すコマンドパラメータ名。
# 素直に書き直すと、次のようになる。アンダースコアがパラメータの埋め込み位置。
our %L = (
    'm' => '_H',    # "\e[${row};${col}H"
    'c' => '2J',    # "\e[2J"
    'a' => '_m',    # "\e[${color}m"
);

# ansi ANSI エスケープ・シーケンス送信手続き。スペースで区切って複数同時送信できる。
#   a("m=${row};${col}") でカーソル移動。(move)
#   a("c") で画面クリア。(clear)
#   a("a=${color}") で文字属性設定。(attribute)
# スペースで区切って同時送信できる a("m=${row};${col} c a=${color}");
sub a {
    my($param) = @_;
    for my $pair (split / /, $param) {
        my($command, $args) = split /=/, $pair;
        my $K = $L{$command};
        $K =~ s/_/$args/;
        printf "%c[$K", 27; # print "\e[$K"; と同じ
    }
}

# update 画面アップデート手続き。@G の内容へ、盤面を書き換える。
# 説明不要で素直なコードになっている。
sub u {
    a("a=40"); # 背景色に
    for my $y (0 .. $B - 1) {
        for my $x (0 .. $A - 1) {
            my $mode = $G[$x][$y];
            if ($R[$x][$y] != $mode) {
                $R[$x][$y] = $mode;
                a("m=" . (5 + $y) . ";" . ($x * 2 + 5));
                a("a=" . (40 + $mode) . ";" . (30 + $mode));
                print " " x 2;
            }
        }
    }
    a("m=0;0 a=37;40"); # 画面左上へカーソルを移動して背景色へ
}

# テトリスで必要なスプライトは落下中のピース用のものだけ。
# 回転情報がないのは、ピースを回転するとスプライトのタイルを回転済みのパターンへ書き直すため。
our @K; # $K[$dx][$dy] 落下中のピースのタイル。
our $W; # 落下中のピースの幅。
our $H; # 落下中のピースの高さ。
our $X; # 落下中のピースの盤面での X 座標。
our $Y; # 落下中のピースの盤面での Y 座標。

# rotate ピースのスプライトの回転手続き。引数 $N は回転回数。
# 90 度回転なので幅と高さが入れ替わる。タイルの並びも回転する。
sub r {
    my($N) = @_;
    while ($N--) {
        # 幅と高さを入れ換え、入れ換え前の値をコピーしておく。
        # $Q = $W;
        # $W = $O = $H;
        # $H = $Q;
        my($old_w, $old_h) = ($W, $H);
        ($W, $H) = ($old_h, $old_w);
        # 回転前のタイルをコピーする。
        my @old_tiles;
        for my $dx (0 .. $old_w - 1) {
            for my $dy (0 .. $old_h - 1) {
                $old_tiles[$dx][$dy] = $K[$dx][$dy];
            }
        }
        # タイルを 90 度回転する。
        for my $dx (0 .. $old_h - 1) {
            for my $dy (0 .. $old_w - 1) {
                $K[$dx][$dy] = $old_tiles[$old_w - $dy - 1][$dx];
            }
        }
    }
}

# ピースの衝突チェック手続き。壁と落下済みのタイルと衝突するかどうを調べる。
# 落下済みタイルへの衝突チェックは、床に衝突チェックの後におこなう方が行儀が良い。
sub l {
    for my $dx (0 .. $W - 1) {
        for my $dy (0 .. $H - 1) {
            $K[$dx][$dy]                # ピースのタイルがゼロでない
            && ($G[$X + $dx][$Y + $dy]  # 落下済みタイルに衝突
                || $X + $dx < 0         # 左壁に衝突
                || $X + $dx >= $A       # 右壁に衝突
                || $Y + $dy >= $B)      # 床に衝突
            && return 0;
        }
    }
    1;
}

# put @G にピースのタイルを置く手続き。update 時と落下完了時にピースを @G へ置く。
# 常に真を返す。
sub p {
    for my $dx (0 .. $W - 1) {
        for my $dy (0 .. $H - 1) {
            if ($K[$dx][$dy]) {
                $G[$X + $dx][$Y + $dy] = $K[$dx][$dy];
            }
        }
    }
    1;
}

# off @G からピースのタイルを剥がす手続き。ピースの移動・落下前に剥がす。
sub o {
    for my $dx (0 .. $W - 1) {
        for my $dy (0 .. $H - 1) {
            if ($K[$dx][$dy]) {
                $G[$X + $dx][$Y + $dy] = 0;
            }
        }
    }
}

# next_piece 新しいピースを盤に登場させる手続き。
sub n {
    my $c = int rand $P;    # ピースを乱数選択。$P は scalar @C と同じ。
    $W = $J[$c];            # そのピースの幅。
    $H = $I[$c];            # そのピースの高さ。
    $X = int($A / 2) - 1;   # ピースを盤の上中央に配置する。
    $Y = 0;
    for my $dx (0 .. $W - 1) {
        for my $dy (0 .. $H - 1) {
            $K[$dx][$dy] = $C[$c]->[$dx][$dy];
        }
    }
    r(int rand 4);          # ランダムに回転して、
    l && p;                 # 衝突してないときは @G へスプライトを置いて真を返す。衝突時は偽を返す。
}

# collapse 盤面から横にタイルで満たされた行を削除する手続き。
# なお、この手続きの書き方では削除可能行が連続しているとき、一行おきにしか削除しないので
# イベントループから
#   $E || c | c | c | c | c | n || goto g;
# と繰り返し5回呼び出す。
sub c {
d: for my $y (reverse 0 .. $B - 1) {
        # 行に一つでもゼロのタイルがあると前の行を調べる。
        for $x (0 .. $A - 1) {
            $G[$x][$y] || next d;
        }
        # 先頭行から $y まで一行下に移動する。先頭行はゼロで埋める。
        for my $y2 (reverse 0 .. $y) {
            for my $x (0 .. $A - 1) {
                $G[$x][$y2] = $y2 > 1 ? $G[$x][$y2 - 1] : 0;
            }
        }
        u;  # 画面を更新。
    }
}

# 画面をクリアして、壁を描く。
a("m=0;0 a=0;37;40 c");
print "\n\n"
    . " " x 4
    . " " x ( $A - 4 )
    . "perltris\n"
    . " " x 4
    . "--" x $A . "\n"
    . ( ( " " x 3 ) . "|" . " " x ( $A * 2 ) . "|\n" ) x $B
    . " " x 4
    . "--" x $A . "\n";
# 最初のピースを生成する。
n;
my $e = 0;  # 入力イベントのカウンタ。
for (;;) {
    # 画面を更新。
    u;

    my($R, $U, $V, $Z, $S, $T);

    # 標準入力 (1) から 0.01 秒内に入力があるかチェックする。
    $R = chr(1);
    ($S, $T) = select $R, $U, $V, 0.01;
    if ($S) {
        $Z = getc;  # 入力ありなら受け取る。
    }
    elsif ($e++ > 20) {
        $Z = " ";   # 入力がないときは、0.2 秒ごとにスペースが入力されたとみなす。
        $e = 0;
    }
    else {
        next;
    }
    # ピース更新。
    # o; で @G からスプライトを剥がし、スプライトを更新する。
    # l || 戻し; で衝突時に更新前へ戻す。
    # p; で @G にスプライトを置く。
    if ($Z eq "k") { o; r(1); l || r(3); p }    # "k" で回転
    if ($Z eq "j") { o; $X--; l || $X++; p }    # "j" で左移動
    if ($Z eq "l") { o; $X++; l || $X--; p }    # "l" で右移動
    if ($Z eq " ") {  # " " で落下
        o;
        $Y++;
        (my $E = l) || $Y--;
        p;
        # 落下して衝突が生じたときは、$E が偽になる。
        # そのときは、消去可能な行を消して、ピースを新しく作る。
        # n が偽を返し、新しく作ったピースが衝突するときは goto g でループを抜けてゲーム終了。
        $E || c | c | c | c | c | n || goto g;
        # 上の行は次のように書いたのと同じ。
        # next if $E;
        # c; c; c; c; c;
        # n || last;
    }
    if ($Z eq "q") {    # "q" でゲーム終了。
        last;
    }
}
# ゲーム終了時、カーソルを盤面の下へ移動して、端末の設定を戻す。
g: a("a=0 m=" . ($B + 8) . ";0");
system "stty sane";

以上です。

perlでテトリス! - ダウンロードたけし(寅年)の日記

全面的にグローバル変数まみれ。変数名も故意にわかりづらくしてあります。

また時折まったく意味のない関数や変数がトラップのようにちりばめれていて、まさに難読コードここにありって感じです。

とありますが、私の感想は反対で、難読化されている割には素直なコードだということです。変数名は長くわかりやすい元の名前を連想しやすく、手続き名もそうです。使っているテクニックも平凡でした。