summaryrefslogtreecommitdiff
path: root/appl/wm/c4.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/c4.b')
-rw-r--r--appl/wm/c4.b718
1 files changed, 718 insertions, 0 deletions
diff --git a/appl/wm/c4.b b/appl/wm/c4.b
new file mode 100644
index 00000000..185b807b
--- /dev/null
+++ b/appl/wm/c4.b
@@ -0,0 +1,718 @@
+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",
+};
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 17:09:50 +0000