#!/usr/bin/perl -w
# 智慧盤. 用 hjkl 四個鍵移動棋子, r 鍵打亂盤面, ^l 重畫盤面, ESC 離開.
# 畫面左上角顯示目前的盤面有多亂 (0 表示完全排整齊了)
# http://www.cyut.edu.tw/~ckhung/b/pl/

use strict;
require "sitio";

my (%board);
my ($row, $col, $c, $ent, $empty);

$board{"height"} = $#ARGV >= 0 ? $ARGV[0] : 4;
$board{"width"} = $#ARGV >= 1 ? $ARGV[1] : 4;

# Perl 內沒有真正的二維陣列, 我們用 hash 來模擬二維陣列.
# $board{"r0c3"} 記載的是: 棋盤上第 0 列第 3 行這一格目前擺的是那個數字.
for ($row=0; $row<$board{"height"}; ++$row) {
    for ($col=0; $col<$board{"width"}; ++$col) {
	$board{"r${row}c${col}"} = $row * $board{"width"} + $col + 1;
    }
}

# 請仔細研究下句: 把棋盤上的右下角那一格清成空白.
$empty = "";
$board{ sprintf("r%dc%d", $board{"height"}-1, $board{"width"}-1) } = $empty;

redraw();

while (1) {
    $ent = entropy();
    gotorc(23, 1);
    print $ent ? '      ' : '成功!', "\n";
    gotorc(1,1);
    aprintf($ent ? "31" : "36", "%3d", $ent);
    $c = getkey();
    if (index("hjkl", $c) >= 0) {
	moveblank($c);
    } elsif ($c eq "r") {
	stir(80);
    } elsif ($c eq "\x0c" || $c eq "\x12") {
	redraw();
    } elsif ($c eq "\x1b") {
	last;
    }
}
if ($ent) {
    gotorc(23, 1);
    print("放棄!\n")
} else {
    gotorc(24, 1);
}

sub redraw {
    my ($row, $col);

    clearscr();
    for ($row=0; $row<$board{"height"}; ++$row) {
	for ($col=0; $col<$board{"width"}; ++$col) {
	    drawcell($row, $col);
	}
    }
}

sub drawcell {
    my ($row, $col) = @_;
    my ($r0, $c0) = (
	(24 - $board{"height"}*2) / 2,
	(80 - $board{"width"}*4) / 2
    );

    gotorc($row*2+$r0, $col*4+$c0);
    aprintf("31;46", "%2s", $board{"r${row}c${col}"});
}

sub moveblank {
    my ($dir) = @_;
    my ($row, $col) = blankpos();
    my ($row_new, $col_new) = ($row, $col);

    if ($dir eq "h") {		# chess moves to the left; blank to the right
	return if ++$col_new >= $board{"width"};
    } elsif ($dir eq "j") {	# chess moves downward; blank upward
	return if --$row_new < 0;
    } elsif ($dir eq "k") {	# chess moves upward; blank downward
	return if ++$row_new >= $board{"height"};
    } elsif ($dir eq "l") {	# chess moves to the right; blank to the left
	return if --$col_new < 0;
    } else {
	return;
    }
    $board{"r${row}c${col}"} = $board{"r${row_new}c${col_new}"};
    $board{"r${row_new}c${col_new}"} = $empty;
    drawcell($row, $col);
    drawcell($row_new, $col_new);
}

sub blankpos {
    my ($row, $col);

    # 作業: 試把下面的迴圈改成 foreach 迴圈, 並用 regexp 從
    # %board 的 keys 當中取出行與列數. 這樣就不必用 label 了.
    locate:
    for ($row=0; $row<$board{"height"}; ++$row) {
	for ($col=0; $col<$board{"width"}; ++$col) {
	    last locate if ($board{"r${row}c${col}"} eq $empty);
	}
    }
    return ($row, $col);
}

sub stir {
    my ($count) = @_;

    for ( ; $count>0; --$count) {
	moveblank(substr("hjkl", int(rand 4), 1));
    }
}

sub entropy {
    my ($ent, $row, $col, $r_dst, $c_dst);

    $ent = 0;
    for ($row=0; $row<$board{"height"}; ++$row) {
	for ($col=0; $col<$board{"width"}; ++$col) {
	    next unless $board{"r${row}c${col}"};
	    # 按照它的數值, 它本來應該放到那裡去?
	    $r_dst = int( ($board{"r${row}c${col}"}-1) / $board{"width"} );
	    $c_dst = ($board{"r${row}c${col}"}-1) % $board{"width"};
	    # 把誤差累加入 $ent.
	    $ent += abs($row - $r_dst) + abs($col - $c_dst);
	}
    }
    return $ent;
}