ref: 60ecd07e6d3f5786c8723dc9172c35d580fdadc8
dir: /appl/wm/c4.b/
implement Connect;
#
# Copyright © 2000 Vita Nuova Limited. All rights reserved.
#
include "sys.m";
sys: Sys;
include "draw.m";
draw: Draw;
Point, Rect, Image, Font, Context, Screen, Display: import draw;
include "tk.m";
tk: Tk;
Toplevel: import tk;
include "tkclient.m";
tkclient: Tkclient;
include "daytime.m";
daytime: Daytime;
include "rand.m";
rand: Rand;
# adtize and modularize
stderr: ref Sys->FD;
Connect: module
{
init: fn(ctxt: ref Draw->Context, argv: list of string);
};
nosleep, printout, auto: int;
display: ref Draw->Display;
init(ctxt: ref Draw->Context, argv: list of string)
{
sys = load Sys Sys->PATH;
draw = load Draw Draw->PATH;
tk = load Tk Tk->PATH;
tkclient = load Tkclient Tkclient->PATH;
daytime = load Daytime Daytime->PATH;
rand = load Rand Rand->PATH;
argv = tl argv;
while(argv != nil){
s := hd argv;
if(s != nil && s[0] == '-'){
for(i := 1; i < len s; i++){
case s[i]{
'a' => auto = 1;
'p' => printout = 1;
's' => nosleep = 1;
}
}
}
argv = tl argv;
}
stderr = sys->fildes(2);
rand->init(daytime->now());
daytime = nil;
if(ctxt == nil)
fatal("wm not running");
display = ctxt.display;
tkclient->init();
(win, wmcmd) := tkclient->toplevel(ctxt, "", "Connect", Tkclient->Resize | Tkclient->Hide);
mainwin = win;
sys->pctl(Sys->NEWPGRP, nil);
cmdch := chan of string;
tk->namechan(win, cmdch, "cmd");
for(i := 0; i < len win_config; i++)
cmd(win, win_config[i]);
pid := -1;
sync := chan of int;
mvch := chan of (int, int);
initboard();
setimage();
spawn game(sync, mvch);
pid = <- sync;
tkclient->onscreen(win, nil);
tkclient->startinput(win, "kbd"::"ptr"::nil);
for(;;){
alt{
s := <-win.ctxt.kbd =>
tk->keyboard(win, s);
s := <-win.ctxt.ptr =>
tk->pointer(win, *s);
c := <-win.ctxt.ctl or
c = <-win.wreq or
c = <-wmcmd =>
case c{
"exit" =>
if(pid != -1)
kill(pid);
exit;
* =>
e := tkclient->wmctl(win, c);
if(e == nil && c[0] == '!'){
setimage();
drawboard();
}
}
c := <- cmdch =>
(nil, toks) := sys->tokenize(c, " ");
case hd toks{
"b1" or "b2" or "b3" =>
alt{
mvch <-= (int hd tl toks, int hd tl tl toks) => ;
* => ;
}
"bh" or "bm" or "wh" or "wm" =>
colour := BLACK;
knd := HUMAN;
if((hd toks)[0] == 'w')
colour = WHITE;
if((hd toks)[1] == 'm')
knd = MACHINE;
kind[colour] = knd;
"blev" or "wlev" =>
colour := BLACK;
e := "be";
if((hd toks)[0] == 'w'){
colour = WHITE;
e = "we";
}
sk := int cmd(win, ".f0." + e + " get");
if(sk > MAXPLIES)
sk = MAXPLIES;
if(sk >= 0)
skill[colour] = sk;
* =>
;
}
<- sync =>
pid = -1;
# exit;
spawn game(sync, mvch);
pid = <- sync;
}
}
}
WIDTH: con 400;
HEIGHT: con 400;
SZW: con 7;
SZH: con 6;
SZC: con 4;
SZS: con 1024;
PIECES: con SZW*SZH;
BLACK, WHITE, EMPTY: con iota;
MACHINE, HUMAN: con iota;
SKILLB : con 8;
SKILLW : con 0;
MAXPLIES: con 10;
board: array of array of int; # for display
brd: array of array of int; # for calculations
col: array of int;
pieces: array of int;
val: array of int;
kind: array of int;
skill: array of int;
name: array of string;
lines: array of array of int;
line: array of array of list of int;
mainwin: ref Toplevel;
brdimg: ref Image;
brdr: Rect;
brdx, brdy: int;
black, white, bg: ref Image;
movech: chan of (int, int);
setimage()
{
brdw := int tk->cmd(mainwin, ".p cget -actwidth");
brdh := int tk->cmd(mainwin, ".p cget -actheight");
brdr = Rect((0,0), (brdw, brdh));
brdimg = display.newimage(brdr, display.image.chans, 0, Draw->White);
if(brdimg == nil)
fatal("not enough image memory");
tk->putimage(mainwin, ".p", brdimg, nil);
}
game(sync: chan of int, mvch: chan of (int, int))
{
sync <-= sys->pctl(0, nil);
movech = mvch;
initbrd();
play();
sync <-= 0;
}
initboard()
{
i, j, k: int;
board = array[SZW] of array of int;
brd = array[SZW] of array of int;
line = array[SZW] of array of list of int;
col = array[SZW] of int;
for(i = 0; i < SZW; i++){
board[i] = array[SZH] of int;
brd[i] = array[SZH] of int;
line[i] = array[SZH] of list of int;
}
pieces = array[2] of int;
val = array[2] of int;
kind = array[2] of int;
kind[BLACK] = MACHINE;
if(auto)
kind[WHITE] = MACHINE;
else
kind[WHITE] = HUMAN;
skill = array[2] of int;
skill[BLACK] = SKILLB;
skill[WHITE] = SKILLW;
name = array[2] of string;
name[BLACK] = "black";
name[WHITE] = "white";
black = display.color(Draw->Black);
white = display.color(Draw->White);
bg = display.color(Draw->Yellow);
n := SZW*(SZH-SZC+1)+SZH*(SZW-SZC+1)+2*(SZH-SZC+1)*(SZW-SZC+1);
lines = array[n] of array of int;
for(i = 0; i < n; i++)
lines[i] = array[2] of int;
m := 0;
for(i = 0; i < SZW; i++){
for(j = 0; j <= SZH-SZC; j++){
for(k = 0; k < SZC; k++){
line[i][j+k] = m :: line[i][j+k];
}
m++;
}
}
for(i = 0; i < SZH; i++){
for(j = 0; j <= SZW-SZC; j++){
for(k = 0; k < SZC; k++){
line[j+k][i] = m :: line[j+k][i];
}
m++;
}
}
for(i = 0; i <= SZW-SZC; i++){
for(j = 0; j <= SZH-SZC; j++){
for(k = 0; k < SZC; k++){
line[i+k][j+k] = m :: line[i+k][j+k];
}
m++;
}
}
for(i = 0; i <= SZW-SZC; i++){
for(j = 0; j <= SZH-SZC; j++){
for(k = 0; k < SZC; k++){
line[SZW-1-i-k][j+k] = m :: line[SZW-1-i-k][j+k];
}
m++;
}
}
if(m != n)
fatal(sys->sprint("%d != %d\n", m, n));
}
initbrd()
{
i, j: int;
for(i = 0; i < SZW; i++){
col[i] = 0;
for(j = 0; j < SZH; j++)
board[i][j] = brd[i][j] = EMPTY;
}
pieces[BLACK] = pieces[WHITE] = 0;
val[BLACK] = val[WHITE] = 0;
drawboard();
n := len lines;
for(i = 0; i < n; i++)
lines[i][0] = lines[i][1] = 0;
}
plays := 0;
bwins := 0;
wwins := 0;
play()
{
if(plays&1)
(first, second) := (WHITE, BLACK);
else
(first, second) = (BLACK, WHITE);
for(;;){
if(pieces[BLACK]+pieces[WHITE] == PIECES)
break;
m1 := move(first, second);
if(printout)
sys->print("%s: %d %d %d\n", name[first], m1, val[BLACK], val[WHITE]);
if(win(first))
break;
if(pieces[BLACK]+pieces[WHITE] == PIECES)
break;
m2 := move(second, first);
if(printout)
sys->print("%s: %d %d %d\n", name[second], m2, val[BLACK], val[WHITE]);
if(win(second))
break;
}
if(win(BLACK)){
bwins++;
puts("black wins");
highlight(BLACK);
}
else if(win(WHITE)){
wwins++;
puts("white wins");
highlight(WHITE);
}
else
puts("draw");
sleep(2500);
plays++;
puts(sys->sprint("black %d:%d white", bwins, wwins));
sleep(2500);
if(printout)
sys->print("\n");
}
move(me: int, you: int): int
{
if(kind[me] == MACHINE){
puts("machine " + name[me] + " move");
return genmove(me, you);
}
else{
m, n: int;
# mvs := findmoves();
for(;;){
puts("human " + name[me] + " move");
m = getmove();
if(m < 0 || m >= SZW)
continue;
n = col[m];
valid := n >= 0 && n < SZH;
if(valid && brd[m][n] != EMPTY)
fatal("! EMPTY");
if(valid)
break;
puts("illegal move");
sleep(2500);
}
makemove(m, n, me, you, 0);
return m*SZS+n;
}
}
genmove(me: int, you: int): int
{
m, n, v: int;
mvs := findmoves();
if(skill[me] == 0){
l := len mvs;
r := rand->rand(l);
# r = 0;
while(--r >= 0)
mvs = tl mvs;
(m, n) = hd mvs;
}
else{
plies := skill[me];
left := PIECES-(pieces[BLACK]+pieces[WHITE]);
if(left < plies) # limit search
plies = left;
else if(left < 2*plies) # expand search to end
plies = left;
else{ # expand search nearer end of game
k := left/plies;
if(k < 3)
plies = ((k+2)*plies)/(k+1);
}
visits = leaves = 0;
(v, (m, n)) = minimax(me, you, plies, ∞);
if(0){
while(mvs != nil){
v0: int;
(a, b) := hd mvs;
makemove(a, b, me, you, 1);
(v0, (m, n)) = minimax(you, me, plies-1, ∞);
sys->print(" (%d, %d): %d\n", a, b, -v0);
undomove(a, b, me, you);
mvs = tl mvs;
}
sys->print("best move is %d, %d\n", m, n);
kind[WHITE] = HUMAN;
}
if(auto)
sys->print("eval = %d plies=%d goes=%d visits=%d\n", v, plies, len mvs, leaves);
}
makemove(m, n, me, you, 0);
return m*SZS+n;
}
findmoves(): list of (int, int)
{
mvs: list of (int, int);
for(i := 0; i < SZW; i++){
if((j := col[i]) < SZH)
mvs = (i, j) :: mvs;
}
return mvs;
}
makemove(m: int, n: int, me: int, you: int, gen: int)
{
pieces[me]++;
brd[m][n] = me;
col[m]++;
for(l := line[m][n]; l != nil; l = tl l){
i := hd l;
a := lines[i][me];
b := lines[i][you];
lines[i][me]++;
if(a+b >= SZC)
fatal("makemove a+b");
if(b == 0){
val[me] += 2*a+1;
if(a == SZC-1)
val[me] += WIN;
}
else if(a == 0)
val[you] -= b*b;
}
if(!gen){
board[m][n] = me;
drawpiece(m, n, me);
panelupdate();
# sleep(1000);
}
}
undomove(m: int, n: int, me: int, you: int)
{
brd[m][n] = EMPTY;
pieces[me]--;
col[m]--;
for(l := line[m][n]; l != nil; l = tl l){
i := hd l;
a := lines[i][me];
b := lines[i][you];
lines[i][me]--;
if(a == 0 || a+b > SZC)
fatal("undomove a+b");
if(b == 0){
val[me] -= 2*a-1;
if(a == SZC)
val[me] -= WIN;
}
else if(a == 1)
val[you] += b*b;
}
}
win(me: int): int
{
return val[me] > WIN/2;
}
highlight(me: int)
{
n := len lines;
for(i := 0; i < n; i++){
if(lines[i][me] == SZC){
for(j := 0; j < SZW; j++){
for(k := 0; k < SZH; k++){
for(l := line[j][k]; l != nil; l = tl l){
if(i == hd l)
highpiece(j, k, board[j][k]);
}
}
}
}
}
}
getmove(): int
{
(x, nil) := <- movech;
return x/brdx;
}
drawboard()
{
brdx = brdr.dx()/SZW;
brdy = brdr.dy()/SZH;
brdimg.draw(brdr, bg, nil, (0, 0));
for(i := 1; i < SZW; i++)
drawline(lmap(i, 0), lmap(i, SZH), nil);
for(j := 1; j < SZH; j++)
drawline(lmap(0, j), lmap(SZW, j), nil);
for(i = 0; i < SZW; i++){
for(j = 0; j < SZH; j++){
if (board[i][j] == BLACK || board[i][j] == WHITE)
drawpiece(i, j, board[i][j]);
}
}
panelupdate();
}
drawpiece(m, n, p: int)
{
if(p == BLACK)
src := black;
else if(p == WHITE)
src = white;
else
src = bg;
brdimg.fillellipse(cmap(m, n), 3*brdx/8, 3*brdy/8, src, (0, 0));
}
highpiece(m, n, p: int)
{
if(p == BLACK)
src := white;
else if(p == WHITE)
src = black;
else
src = bg;
pt := cmap(m, n);
rx := (3*brdx/8, 0);
ry := (0, 3*brdy/8);
drawline(pt.add(rx), pt.sub(rx), src);
drawline(pt.add(ry), pt.sub(ry), src);
}
panelupdate()
{
tk->cmd(mainwin, sys->sprint(".p dirty %d %d %d %d", brdr.min.x, brdr.min.y, brdr.max.x, brdr.max.y));
tk->cmd(mainwin, "update");
}
drawline(p0, p1: Point, c: ref Image)
{
if(c == nil)
c = black;
brdimg.line(p0, p1, Draw->Endsquare, Draw->Endsquare, 0, c, (0, 0));
}
cmap(m, n: int): Point
{
return brdr.min.add((m*brdx+brdx/2, (SZH-1-n)*brdy+brdy/2));
}
lmap(m, n: int): Point
{
return brdr.min.add((m*brdx, n*brdy));
}
∞: con (1<<30);
WIN: con (1<<20);
MAXVISITS: con 1024;
visits, leaves : int;
minimax(me: int, you: int, plies: int, αβ: int): (int, (int, int))
{
v: int;
if(plies == 0){
visits++;
leaves++;
if(visits == MAXVISITS){
visits = 0;
sys->sleep(0);
}
return (eval(me, you), (0, 0));
}
mvs := findmoves();
if(mvs == nil){
fatal("mvs==nil");
# if(mv)
# (v, nil) := minimax(you, me, plies, ∞);
# else
# (v, nil) = minimax(you, me, plies-1, ∞);
# return (-v, (0, 0));
}
bestv := -∞;
bestm := (0, 0);
e := 0;
for(; mvs != nil; mvs = tl mvs){
(m, n) := hd mvs;
makemove(m, n, me, you, 1);
if(win(me))
v = eval(me, you);
else{
(v, nil) = minimax(you, me, plies-1, -bestv);
v = -v;
}
undomove(m, n, me, you);
if(v > bestv || (v == bestv && rand->rand(++e) == 0)){
if(v > bestv)
e = 1;
bestv = v;
bestm = (m, n);
if(bestv >= αβ)
return (∞, (0, 0));
}
}
return (bestv, bestm);
}
eval(me: int, you: int): int
{
return val[me]-val[you];
}
fatal(s: string)
{
sys->fprint(stderr, "%s\n", s);
exit;
}
sleep(t: int)
{
if(nosleep)
sys->sleep(0);
else
sys->sleep(t);
}
kill(pid: int): int
{
fd := sys->open("#p/"+string pid+"/ctl", Sys->OWRITE);
if(fd == nil)
return -1;
if(sys->write(fd, array of byte "kill", 4) != 4)
return -1;
return 0;
}
cmd(top: ref Toplevel, s: string): string
{
e := tk->cmd(top, s);
if (e != nil && e[0] == '!')
sys->fprint(stderr, "connect: tk error on '%s': %s\n", s, e);
return e;
}
# swidth: int;
# sfont: ref Font;
# gettxtattrs()
# {
# swidth = int cmd(mainwin, ".f1.txt cget -width"); # always initial value ?
# f := cmd(mainwin, ".f1.txt cget -font");
# sfont = Font.open(brdimg.display, f);
# }
puts(s: string)
{
# while(sfont.width(s) > swidth)
# s = s[0: len s -1];
cmd(mainwin, ".f1.txt configure -text {" + s + "}");
cmd(mainwin, "update");
}
win_config := array[] of {
"frame .f",
"menubutton .f.bk -text Black -menu .f.bk.bm",
"menubutton .f.wk -text White -menu .f.wk.wm",
"menu .f.bk.bm",
".f.bk.bm add command -label Human -command { send cmd bh }",
".f.bk.bm add command -label Machine -command { send cmd bm }",
"menu .f.wk.wm",
".f.wk.wm add command -label Human -command { send cmd wh }",
".f.wk.wm add command -label Machine -command { send cmd wm }",
"pack .f.bk -side left",
"pack .f.wk -side right",
"frame .f0",
"label .f0.bl -text {Black level}",
"label .f0.wl -text {White level}",
"entry .f0.be -width 32",
"entry .f0.we -width 32",
".f0.be insert 0 {" + string SKILLB+"}",
".f0.we insert 0 {" + string SKILLW+"}",
"pack .f0.bl -side left",
"pack .f0.be -side left",
"pack .f0.wl -side right",
"pack .f0.we -side right",
"frame .f1",
"label .f1.txt -text { } -width " + string WIDTH,
"pack .f1.txt -side top -fill x",
"panel .p -width " + string WIDTH + " -height " + string HEIGHT,
"pack .f -side top -fill x",
"pack .f0 -side top -fill x",
"pack .f1 -side top -fill x",
"pack .p -side bottom -fill both -expand 1",
"pack propagate . 0",
"bind .p <Button-1> {send cmd b1 %x %y}",
"bind .p <Button-2> {send cmd b2 %x %y}",
"bind .p <Button-3> {send cmd b3 %x %y}",
# "bind .c <ButtonRelease-1> {send cmd b1r %x %y}",
# "bind .c <ButtonRelease-2> {send cmd b2r %x %y}",
# "bind .c <ButtonRelease-3> {send cmd b3r %x %y}",
"bind .f0.be <Key-\n> {send cmd blev}",
"bind .f0.we <Key-\n> {send cmd wlev}",
"update",
};