#!/usr/bin/perl -w
# 作者: 洪朝貴 http://www.cyut.edu.tw/~ckhung/, 2001.
#       趙惟倫 <bluebat@member.fsf.org>, 2012.
# 功能: 讓使用者下象棋的程式. 純粹只是版面安排及棋子移動;
#       沒有電腦下棋的功能.
# 需求: 系統內應有 ncurses 程式庫, 及 perl 的 curses 模組.
# 操作說明: 用方向鍵移動遊標, 用空間棒撿起/放下棋子,
#	按 s 將目前盤面存檔. 所存檔案, 下次可作為命令列參數
# 其他: 在彩色終端機上可顯示彩色 (例如 cxterm-color 或 linux
#	console); 在黑白終端機上 (例如 MS Windows 的 telnet)
#	則以反白區別將帥兩國. (由 TERM 這個環境變數決定.)
# 版權聲明: XFree86 style. 若要將本程式修改成有用的大程式,
#	建議將您的版本施以 GPL.

use Curses;
use Data::Dumper;
use strict;
use vars qw($pos);		# 用 my 宣告的變數無法跨越檔案
my (%viseff, $pos0, $chess, $ch, $cursor, $picked);

$pos0 = {			# 標準位置
    '將'=>[0,0],
    '士1'=>[0,-1], '士2'=>[0,1], '象1'=>[0,-2], '象2'=>[0,2],
    '車1'=>[0,-4], '車2'=>[0,4], '馬1'=>[0,-3], '馬2'=>[0,3],
    '包1'=>[2,-3], '包2'=>[2,3], '卒1'=>[3,-4], '卒2'=>[3,4],
    '卒3'=>[3,-2], '卒4'=>[3,2], '卒5'=>[3,0],

    '帥'=>[9,0],
    '仕1'=>[9,-1], '仕2'=>[9,1], '相1'=>[9,-2], '相2'=>[9,2],
    '俥1'=>[9,-4], '俥2'=>[9,4], '傌1'=>[9,-3], '傌2'=>[9,3],
    '炮1'=>[7,-3], '炮2'=>[7,3], '兵1'=>[6,-4], '兵2'=>[6,4],
    '兵3'=>[6,-2], '兵4'=>[6,2], '兵5'=>[6,0],
};

$cursor = [9,0];

initscr();
cbreak();
noecho();
keypad(1);
# getmaxyx($height, $width);

%viseff = set_visual_effect();

foreach $chess (keys %$pos0) {
    @{$pos->{$chess}} = @{$pos0->{$chess}};
}

if (-r $ARGV[0]) {
    do $ARGV[0];
    # "do" is better because "require" tries to avoid repeated loading.
    redraw();
    show_status("saved game restored!");
} else {
    redraw();
}

$picked = 0;			# 目前撿起了那個棋子
while (1) {
    move(xy2rc(@$cursor));
    $ch = getch();
    show_status(" " x 60);
    if ($ch eq KEY_LEFT) {
	--$cursor->[0];
	$cursor->[0] += 10 if $cursor->[0] < 0;
    } elsif ($ch eq KEY_RIGHT) {
	++$cursor->[0];
	$cursor->[0] -= 10 if $cursor->[0] > 9;
    } elsif ($ch eq KEY_UP) {
	--$cursor->[1];
	$cursor->[1] += 9 if $cursor->[1] < -4;
    } elsif ($ch eq KEY_DOWN) {
	++$cursor->[1];
	$cursor->[1] -= 9 if $cursor->[1] > 4;
    } elsif ($ch eq ' ') {
	$chess = who_is_at(@$cursor);
	if ($picked) {		# 即將放下棋子
	    if ($chess and $chess ne $picked) {	# 底下原本有一個棋子
		if (side($chess) == side($picked)) {
		    flash();	# 同一國的, 不可以吃啦!
		    next;
		} else {	# 另一國的, 吃掉!
		    delete $pos->{$chess};
		}
	    }
	    move_chess($picked, @$cursor);
	    $picked = 0;
	} else {		# 即將撿起棋子
	    if (not $chess) {	# 可是這裡沒有棋子可撿啊!
		flash();
		next;
	    }
	    $picked = $chess;
	    show_chess($chess, $viseff{picked});
	}
    } elsif ($ch eq 's') {
	$Data::Dumper::Terse = 1;		# 印變數時只要內容不要首尾
	open F, "> save.cch" or die "can't open save.cch";
	print F '$pos = ', Dumper($pos), ";\n";
	close F;
	show_status("Saved!");
    } elsif ($ch eq "\x0c" || $ch eq "\x12") {
	redraw();
    } else {
	last;
    }
}

endwin();

sub xy2rc {			# 把棋盤座標轉換成螢幕字元座標
    return (($_[1]+4)*2+2, $_[0]*6+8);
}

sub show_status {
    addstr(0, 0, @_);
}

sub redraw {			# 重畫整個棋盤及所有棋子
    my ($x, $y, @t);

    clear();
    for ($y=-4; $y<=4; ++$y) {
	addstr(xy2rc(0, $y), ("+-----" x 9) . "+");
    }
    for ($x=0; $x<=9; ++$x) {
	for ($y=-4; $y<=3; ++$y) {
	    @t = xy2rc($x, $y);
	    addstr($t[0]+1, $t[1], "|");
	}
    }
    foreach (keys %$pos) {
	show_chess($_);
    }
}

sub side {			# 這個棋子是那一國的?
    return ($pos0->{$_[0]}[0] > 5) ? 1 : 0;
}

sub show_chess {
    my ($chess, $attr) = @_;
    $attr |= side($chess) ? $viseff{side_B} : $viseff{side_A};
    attrset($attr);
    addstr(xy2rc(@{$pos->{$chess}}), substr($chess,0,3));
    attrset(A_NORMAL);
}

sub who_is_at {			# 那個棋子落在這個座標上?
    my ($x, $y) = @_;
    my ($c);
    foreach $c (keys %$pos) {
	return $c if ($x == $pos->{$c}[0] && $y == $pos->{$c}[1]);
    }
    return 0;
}

sub set_visual_effect {		# 決定要用黑白還是彩色
    return (
	side_A=>A_NORMAL, side_B=>A_REVERSE, picked=>A_UNDERLINE,
    ) unless has_colors();
    start_color();
    init_pair(1, COLOR_CYAN, COLOR_BLACK);
    init_pair(2, COLOR_RED, COLOR_BLACK);
    return (
	side_A=>COLOR_PAIR(1), side_B=>COLOR_PAIR(2), picked=>A_REVERSE,
    );
}

sub move_chess {
    my ($chess, @new_pos) = @_;
    addstr(xy2rc(@{$pos->{$chess}}), $pos->{$chess}[0] == 9 ? '+' : '+-');
    @{$pos->{$chess}} = @new_pos;
    show_chess($chess);
}