implement Engine; include "sys.m"; sys: Sys; include "draw.m"; include "../spree.m"; spree: Spree; Attributes, Range, Object, Clique, Member, rand: import spree; MAXPLAYERS: con 32; clique: ref Clique; # each member is described by a state machine. # a member progresses through the following states: # # Notplaying # istart -> Havedice # otherstarts -> Waiting # Havedice # declare -> Waiting # look -> Looking # Looking # expose -> Looking # unexpose -> Looking # declare -> Waiting # roll -> Rolled # Rolled # expose -> Rolled # unexpose -> Rolled # declare -> Waiting # Waiting # queried -> Queried # lost -> Havedice # Queried # reject,win -> Waiting # reject,lose -> Havedice # accept -> Havedice plate, cup, space, members: ref Object; dice := array[5] of ref Object; declared: int; # member states Notplaying, Havedice, Looking, Rolled, Waiting, Queried: con iota; # info on a particular member Info: adt { state: int; id: int; member: ref Object; action: ref Object; }; info := array[MAXPLAYERS] of ref Info; plorder := array[MAXPLAYERS] of int; # map member id to their place around the table nplaying := 0; nmembers := 0; turn := 0; clienttype(): string { return "none"; } init(g: ref Clique, srvmod: Spree): string { sys = load Sys Sys->PATH; clique = g; spree = srvmod; plate = clique.newobject(nil, ~0, "plate"); cup = clique.newobject(plate, 0, "cup"); space = clique.newobject(plate, ~0, "space"); members = clique.newobject(nil, ~0, "members"); for (i := 0; i < len dice; i++) { dice[i] = clique.newobject(cup, ~0, "die"); dice[i].setattr("number", string rand(6), ~0); } return nil; } join(member: ref Member): string { check(); pmask := 1 << member.id; ord := nmembers++; inf := info[ord] = ref Info; inf.state = -1; inf.id = member.id; inf.action = clique.newobject(nil, pmask, "actions" + string member.id); plorder[member.id] = ord; setstate(ord, Notplaying); check(); return nil; } leave(member: ref Member) { check(); ord := plorder[member.id]; state := info[ord].state; info[ord] = nil; for (i := 0; i < nmembers; i++) if (i != ord) setstate(i, Notplaying); nmembers--; nplaying = 0; clique.action("say member " + string ord + " has left. the clique stops.", nil, nil, ~0); check(); } currmember: ref Member; currcmd: string; command(member: ref Member, cmd: string): string { check(); e := ref Sys->Exception; if (sys->rescue("parse:*", e) == Sys->EXCEPTION) { sys->rescued(Sys->ONCE, nil); check(); currmember = nil; currcmd = nil; return e.name[6:]; } currmember = member; currcmd = cmd; (nlines, lines) := sys->tokenize(cmd, "\n"); assert(nlines > 0, "unknown command"); (n, toks) := sys->tokenize(hd lines, " "); assert(n > 0, "unknown command"); pmask := 1 << member.id; ord := plorder[member.id]; state := info[ord].state; case hd toks { "say" or "show" or "showme" => case hd toks { "say" => clique.action("say member " + string member.id + ": '" + (hd lines)[4:] + "'", nil, nil, ~0); "show" => # show [memberid] p: ref Member = nil; if (n == 2) { memberid := int hd tl toks; p = clique.member(memberid); assert(p != nil, "bad memberid"); } clique.show(p); "showme" => clique.show(member); } currmember = nil; currcmd = nil; return nil; } case state { Notplaying => case hd toks { "start" => assert(nplaying == 0, "clique is in progress"); assert(nmembers > 1, "need at least two members"); newinfo := array[len info] of ref Info; members.deletechildren((0, len members.children)); j := 0; for (i := 0; i < len info; i++) if (info[i] != nil) newinfo[j++] = info[i]; info = newinfo; nplaying = nmembers; for (i = 0; i < nplaying; i++) { info[i].member = clique.newobject(members, ~0, nil); info[i].member.setattr("id", string info[i].id, ~0); } turn = rand(nplaying); start(); * => assert(0, "you are not playing"); } Havedice => case hd toks { "declare" => # declare hand declare(ord, tl toks); "look" => cup.setattr("raised", "1", ~0); cup.setvisibility(pmask); setstate(ord, Looking); * => assert(0, "bad command"); } Looking => case hd toks { "expose" or "unexpose" => expose(n, toks); "declare" => declare(ord, tl toks); "roll" => # roll index... # XXX should be able to roll in the open too for (toks = tl toks; toks != nil; toks = tl toks) { index := int hd toks; checkrange((index, index), cup); cup.children[index].setattr("number", string rand(6), ~0); } setstate(ord, Rolled); * => assert(0, "bad command"); } Rolled => case hd toks { "expose" or "unexpose" => expose(n, toks); "declare" => declare(ord, tl toks); * => assert(0, "bad command"); } Waiting => assert(0, "not your turn"); Queried => case hd toks { "reject" => # lift the cup! cup.transfer((0, len cup.children), space, len space.children); assert(len space.children == 5, "lost a die somewhere!"); dvals := array[5] of int; for (i := 0; i < 5; i++) dvals[i] = int space.children[i].getattr("number"); actval := value(dvals); if (actval >= declared) { # declaration was correct; rejector loses clique.action("say member " + string ord + " loses.", nil, nil, ~0); turn = ord; start(); } else { # liar caught out. rejector wins. clique.action("say member " + string turn + " was lying...", nil, nil, ~0); start(); } "accept" => # dice accepted, turn moves on # XXX should allow for anticlockwise play newturn := (turn + 1) % nplaying; plate.setattr("owner", string newturn, ~0); setstate(ord, Havedice); setstate(turn, Waiting); } } check(); currmember = nil; currcmd = nil; return nil; } expose(n: int, toks: list of string) { # (un)expose index assert(n == 2, Eusage); (src, dest) := (cup, space); if (hd toks == "unexpose") (src, dest) = (space, cup); index := int hd tl toks; checkrange((index, index+1), cup); src.transfer((index, index+1), dest, len dest.children); } start() { clique.action("start", nil, nil, ~0); space.transfer((0, len space.children), cup, len cup.children); cup.setvisibility(0); for (i := 0; i < len dice; i++) dice[i].setattr("number", string rand(6), ~0); plate.setattr("owner", string turn, ~0); for (i = 0; i < nplaying; i++) { if (i == turn) setstate(i, Havedice); else setstate(i, Waiting); } declared = 0; } declare(ord: int, toks: list of string) { cup.setvisibility(0); assert(len toks == 1 && len hd toks == 5, "bad declaration"); d := hd toks; v := array[5] of {* => 0}; for (i := 0; i < 5; i++) { v[i] = (hd toks)[i] - '0'; assert(v[i] >= 0 && v[i] <= 5, "bad declaration"); } newval := value(v); assert(newval > declared, "declaration not high enough"); declared = newval; setstate(turn, Waiting); setstate((turn + 1) % nplaying, Queried); } # check that range is valid for object's children checkrange(r: Range, o: ref Object) { assert(r.start >= 0 && r.start < len o.children && r.end >= r.start && r.end >= 0 && r.end <= len o.children, "index out of range"); } setstate(ord: int, state: int) { poss: string; case state { Notplaying => poss = "start"; Havedice => poss = "declare look"; Looking => poss = "expose unexpose declare roll"; Rolled => poss = "expose unexpose declare"; Waiting => poss = ""; Queried => poss = "accept reject"; * => sys->print("liarclique: unknown state %d, member %d\n", state, ord); sys->raise("panic"); } info[ord].action.setattr("actions", poss, 1<print("cardclique: error '%s' on %s", err, currcmd); sys->raise("parse:" + err); } } checkobj(o: ref Object, what: string) { if (o != nil && o.id == -1) { clique.show(currmember); sys->print("object %d has been deleted unexpectedly (%s)\n", o.id, what); sys->raise("panic"); } } check() { } NOTHING, PAIR, TWOPAIRS, THREES, LOWSTRAIGHT, FULLHOUSE, HIGHSTRAIGHT, FOURS, FIVES: con iota; what := array[] of { NOTHING => "nothing", PAIR => "pair", TWOPAIRS => "twopairs", THREES => "threes", LOWSTRAIGHT => "lowstraight", FULLHOUSE => "fullhouse", HIGHSTRAIGHT => "highstraight", FOURS => "fours", FIVES => "fives" }; same(dice: array of int): int { x := dice[0]; for (i := 0; i < len dice; i++) if (dice[i] != x) return 0; return 1; } val(hi, lo: int): int { return hi * 100000 + lo; } D: con 10; value(dice: array of int): int { mergesort(dice, array[5] of int); for (i := 0; i < 5; i++) sys->print("%d ", dice[i]); sys->print("\n"); # five of a kind x := dice[0]; if (same(dice)) return val(FIVES, dice[0]); # four of a kind if (same(dice[1:])) return val(FOURS, dice[0] + dice[1]*D); if (same(dice[0:4])) return val(FOURS, dice[4] + dice[0]*D); # high straight if (dice[0] == 1 && dice[1] == 2 && dice[2] == 3 && dice[3] == 4 && dice[4] == 5) return val(HIGHSTRAIGHT, 0); # full house if (same(dice[0:3]) && same(dice[3:5])) return val(FULLHOUSE, dice[0]*D + dice[4]); if (same(dice[0:2]) && same(dice[2:5])) return val(FULLHOUSE, dice[4]*D + dice[0]); # low straight if (dice[0] == 0 && dice[1] == 1 && dice[2] == 2 && dice[3] == 3 && dice[4] == 4) return val(LOWSTRAIGHT, 0); # three of a kind if (same(dice[0:3])) return val(THREES, dice[3] + dice[4]*D + dice[0]*D*D); if (same(dice[1:4])) return val(THREES, dice[0] + dice[4]*D + dice[1]*D*D); if (same(dice[2:5])) return val(THREES, dice[0] + dice[1]*D + dice[2]*D*D); for (i = 0; i < 4; i++) if (same(dice[i:i+2])) break; case i { 4 => return val(NOTHING, dice[0] + dice[1]*D + dice[2]*D*D + dice[3]*D*D*D + dice[4]*D*D*D*D); 3 => return val(PAIR, dice[0] + dice[1]*D + dice[2]*D*D + dice[3]*D*D*D); 2 => return val(PAIR, dice[0] + dice[1]*D + dice[4]*D*D + dice[2]*D*D*D); } h := array[5] of int; h[0:] = dice; if (i == 1) (h[0], h[2]) = (h[2], h[0]); # pair is in first two dice if (same(h[2:4])) return val(TWOPAIRS, h[4] + h[2]*D + h[0]*D*D); if (same(h[3:5])) return val(TWOPAIRS, h[2] + h[0]*D + h[4]*D*D); return val(PAIR, dice[2] + dice[3]*D + dice[4]*D*D + dice[0]*D*D*D); } mergesort(a, b: array of int) { r := len a; if (r > 1) { m := (r-1)/2 + 1; mergesort(a[0:m], b[0:m]); mergesort(a[m:], b[m:]); b[0:] = a; for ((i, j, k) := (0, m, 0); i < m && j < r; k++) { if (b[i] > b[j]) a[k] = b[j++]; else a[k] = b[i++]; } if (i < m) a[k:] = b[i:m]; else if (j < r) a[k:] = b[j:r]; } }