diff options
Diffstat (limited to 'appl/spree/engines')
| -rw-r--r-- | appl/spree/engines/afghan.b | 302 | ||||
| -rw-r--r-- | appl/spree/engines/bounce.b | 258 | ||||
| -rw-r--r-- | appl/spree/engines/canfield.b | 340 | ||||
| -rw-r--r-- | appl/spree/engines/chat.b | 60 | ||||
| -rw-r--r-- | appl/spree/engines/debug.b | 163 | ||||
| -rw-r--r-- | appl/spree/engines/freecell.b | 428 | ||||
| -rw-r--r-- | appl/spree/engines/gather.b | 267 | ||||
| -rw-r--r-- | appl/spree/engines/hearts.b | 300 | ||||
| -rw-r--r-- | appl/spree/engines/liars.b | 490 | ||||
| -rw-r--r-- | appl/spree/engines/liars.y | 132 | ||||
| -rw-r--r-- | appl/spree/engines/lobby.b | 389 | ||||
| -rw-r--r-- | appl/spree/engines/othello.b | 242 | ||||
| -rw-r--r-- | appl/spree/engines/racingdemon.b | 464 | ||||
| -rw-r--r-- | appl/spree/engines/snap.b | 241 | ||||
| -rw-r--r-- | appl/spree/engines/spider.b | 259 | ||||
| -rw-r--r-- | appl/spree/engines/spit.b | 483 | ||||
| -rw-r--r-- | appl/spree/engines/whist.b | 305 |
17 files changed, 5123 insertions, 0 deletions
diff --git a/appl/spree/engines/afghan.b b/appl/spree/engines/afghan.b new file mode 100644 index 00000000..0ca2ca49 --- /dev/null +++ b/appl/spree/engines/afghan.b @@ -0,0 +1,302 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + All, None: import Sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember: import cardlib; + dTOP, dLEFT, oLEFT, oRIGHT, EXPAND, FILLX, FILLY, aUPPERCENTRE, + Stackspec: import Cardlib; +include "../gather.m"; + +CLICK, REDEAL: con iota; + +clique: ref Clique; +rows: array of ref Object; # [10] +central: array of ref Object; # [4] +chokey, deck: ref Object; +direction := 0; +nredeals := 0; + +Rowpilespec := Stackspec( + "display", # style + 10, # maxcards + 0, # conceal + nil # title +); + +Centralpilespec := Stackspec( + "pile", + 13, + 0, + nil +); + +clienttype(): string +{ + return "cards"; +} + +maxmembers(): int +{ + return 1; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + return nil; +} + +propose(members: array of string): string +{ + if (len members != 1) + return "one member only"; + return nil; +} + +archive() +{ + archiveobj := cardlib->archive(); + allow->archive(archiveobj); + cardlib->archivearray(rows, "rows"); + cardlib->archivearray(central, "central"); + cardlib->setarchivename(chokey, "chokey"); + cardlib->setarchivename(deck, "deck"); + archiveobj.setattr("direction", string direction, None); + archiveobj.setattr("nredeals", string nredeals, None); +} + +start(members: array of ref Member, archived: int) +{ + if (archived) { + archiveobj := cardlib->unarchive(); + allow->unarchive(archiveobj); + rows = cardlib->getarchivearray("rows"); + central = cardlib->getarchivearray("central"); + chokey = cardlib->getarchiveobj("chokey"); + deck = cardlib->getarchiveobj("deck"); + direction = int archiveobj.getattr("direction"); + nredeals = int archiveobj.getattr("nredeals"); + } else { + p := members[0]; + Cmember.join(p, -1).layout.lay.setvisibility(All); + startclique(); + allow->add(CLICK, p, "click %o %d"); + } +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "you are not playing"; + + case tag { + REDEAL => + if (nredeals >= 3) + return "no more redeals"; + redeal(); + nredeals++; + CLICK => + # click stack index + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + + if (sel.isempty() || sel.stack == stack) { + # selecting a card to move + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + case stype { + "row" or + "chokey" => + select(cp, stack, (nc - 1, nc)); + * => + return "you can't move cards from there"; + } + } else { + # selecting a stack to move to. + card := cardlib->getcard(sel.stack.children[sel.r.start]); + case stype { + "central" => + top := cardlib->getcard(stack.children[nc - 1]); + if (direction == 0) { + if (card.number != (top.number + 1) % 13 && + card.number != (top.number + 12) % 13) + return "out of sequence"; + if (card.suit != top.suit) + return "wrong suit"; + direction = card.number - top.number; + } else { + if (card.number != (top.number + direction + 13) % 13) + return "out of sequence"; + if (card.suit != top.suit) + return "wrong suit"; + } + "row" => + if (nc == 0 || sel.stack.getattr("type") == "chokey") + return "you wish!"; + top := cardlib->getcard(stack.children[nc - 1]); + if (card.suit != top.suit) + return "wrong suit"; + if (card.number != (top.number + 1) % 13 && + card.number != (top.number + 12) % 13) + return "out of sequence"; + "chokey" => + if (nc != 0) + return "only one card allowed there"; + * => + return "can't move there"; + } + sel.transfer(stack, -1); + } + } + return nil; +} + +startclique() +{ + addlayobj, addlayframe: import cardlib; + + entry := clique.newobject(nil, All, "widget entry"); + entry.setattr("command", "say", All); + + but := clique.newobject(nil, All, "widget button"); + but.setattr("text", "Redeal", All); + but.setattr("command", "redeal", All); + allow->add(REDEAL, Cmember.index(0).p, "redeal"); + + addlayframe("topf", nil, nil, dTOP|EXPAND|FILLX|aUPPERCENTRE, dTOP); + addlayobj(nil, "topf", nil, dLEFT, but); + addlayobj(nil, "topf", nil, dLEFT|EXPAND|FILLX, entry); + + addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + + addlayframe("left", "arena", nil, dLEFT|EXPAND, dTOP); + addlayframe("central", "arena", nil, dLEFT|EXPAND, dTOP); + addlayframe("right", "arena", nil, dLEFT|EXPAND, dTOP); + + rows = array[10] of {* => newstack(nil, Rowpilespec, "row")}; + central = array[4] of {* => newstack(nil, Centralpilespec, "central")}; + chokey = newstack(nil, Centralpilespec, "chokey"); + + deck = clique.newobject(nil, All, "stack"); + cardlib->makecards(deck, (0, 13), nil); + cardlib->shuffle(deck); + + for (i := 0; i < 5; i++) + addlayobj(nil, "left", nil, dTOP|oRIGHT, rows[i]); + for (i = 5; i < 10; i++) + addlayobj(nil, "right", nil, dTOP|oRIGHT, rows[i]); + for (i = 0; i < 4; i++) + addlayobj(nil, "central", nil, dTOP, central[i]); + addlayobj(nil, "central", nil, dTOP, chokey); + + for (i = 0; i < 52; i++) + cardlib->setface(deck.children[i], 1); + # get top card from deck for central piles. + c := deck.children[len deck.children - 1]; + v := cardlib->getcard(c); + j := 0; + for (i = len deck.children - 1; i >= 0; i--) { + w := cardlib->getcard(deck.children[i]); + if (w.number == v.number) + deck.transfer((i, i + 1), central[j++], -1); + } + for (i = 0; i < 10; i += 5) { + for (j = i; j < i + 4; j++) + deck.transfer((0, 5), rows[j], -1); + deck.transfer((0, 4), rows[j], -1); + } +} + +redeal() +{ + for (i := 0; i < len rows; i++) + cardlib->discard(rows[i], deck, 0); + cardlib->shuffle(deck); + + i = 0; + while ((n := len deck.children) > 0) { + l, r: int; + if (n >= 10) + l = r = 5; + else { + l = n / 2; + r = n - l; + } + deck.transfer((0, l), rows[i], 0); + deck.transfer((0, r), rows[i + 5], 0); + i++; + } + + n = cardlib->nmembers(); + for (i = 0; i < n; i++) + Cmember.index(i).sel.set(nil); +} + +newstack(parent: ref Object, spec: Stackspec, stype: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + return stack; +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} + +archivearray(a: array of ref Object, name: string) +{ + for (i := 0; i < len a; i++) + cardlib->setarchivename(a[i], name + string i); +} + +unarchivearray(a: array of ref Object, name: string) +{ + for (i := 0; i < len a; i++) + a[i] = cardlib->getarchiveobj(name + string i); +} diff --git a/appl/spree/engines/bounce.b b/appl/spree/engines/bounce.b new file mode 100644 index 00000000..05e476d4 --- /dev/null +++ b/appl/spree/engines/bounce.b @@ -0,0 +1,258 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; + draw: Draw; + Point, Rect: import draw; +include "sets.m"; + sets: Sets; + Set, All, None, A, B: import sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member: import spree; +include "../gather.m"; + +clique: ref Clique; + +W, H: con 500; +INSET: con 20; +D: con 30; +BATLEN: con 100.0; +GOALSIZE: con 0.1; + +MAXPLAYERS: con 32; +nmembers := 0; + +Line: adt { + p1, p2: Point; + seg: fn(l: self Line, s1, s2: real): Line; +}; + +Dmember: adt { + p: ref Member; + score: int; + bat: ref Object; +}; + +Eusage: con "bad command usage"; +colours := array[4] of {"blue", "orange", "yellow", "white"}; +batpos: array of Line; +borderpos: array of Line; + +members: array of Dmember; +arena: ref Object; +clienttype(): string +{ + return "bounce"; +} + +maxmembers(): int +{ + return 4; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + draw = load Draw Draw->PATH; + clique = g; + spree = srvmod; + + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("spit: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + sets->init(); + + r := Rect((0, 0), (W, H)); + walls := sides(r.inset(INSET)); + addlines(segs(walls, 0.0, 0.5 - GOALSIZE), nil); + addlines(segs(walls, 0.5 + GOALSIZE, 1.0), nil); + + batpos = l2a(segs(sides(r.inset(INSET + 50)), 0.1, 0.9)); + borderpos = l2a(sides(r.inset(-1))); + + arena = clique.newobject(nil, All, "arena"); + arena.setattr("arenasize", string W + " " + string H, All); + + return nil; +} + +propose(members: array of string): string +{ + if (len members < 2) + return "need at least two members"; + if (len members > 4) + return "too many members"; + return nil; +} + +archive() +{ +} + +start(pl: array of ref Member, archived: int) +{ + if (archived) { + } else { + members = array[len pl] of Dmember; + for (i := 0; i < len pl; i++) { + p := pl[i]; + bat := addline(batpos[i], nil); + bat.setattr("pos", "10 " + string (10.0 + BATLEN), All); + bat.setattr("owner", p.name, All); + addline(borderpos[i], ("owner", p.name) :: nil); + arena.setattr("member" + string i, p.name + " " + colours[i], All); + members[i] = (p, 0, bat); + } + r := Rect((0, 0), (W, H)).inset(INSET + 1); + goals := l2a(sides(r)); + for (i = len members; i < len batpos; i++) { + addline(goals[i], nil); + addline(borderpos[i], ("owner", pl[0].name) :: nil); + } + } +} + +addline(lp: (Point, Point), attrs: list of (string, string)): ref Object +{ + (p1, p2) := lp; + l := clique.newobject(nil, All, "line"); + l.setattr("coords", p2s(p1) + " " + p2s(p2), All); + l.setattr("id", string l.id, All); + for (; attrs != nil; attrs = tl attrs) { + (attr, val) := hd attrs; + l.setattr(attr, val, All); + } + return l; +} + + +p2s(p: Point): string +{ + return string p.x + " " + string p.y; +} + +command(member: ref Member, cmd: string): string +{ + ord := order(member); + sys->print("cmd: %s", cmd); + { + (n, toks) := sys->tokenize(cmd, " \n"); + assert(n > 0, "unknown command"); + case hd toks { + "newball" => + # newball batid p.x p.y v.x v.y speed + assert(n == 7, Eusage); + bat := member.obj(int hd tl toks); + assert(bat != nil, "no such bat"); + ball := clique.newobject(nil, All, "ball"); + ball.setattr("state", string bat.id + " " + string ord + + " " + concat(tl tl toks) + " " + string sys->millisec(), All); + "lost" => + # lost ballid + assert(n == 2, Eusage); + o := member.obj(int hd tl toks); + assert(o != nil, "bad object"); + assert(o.getattr("state") != nil, "can only lose balls"); + o.delete(); + "state" => + # state ballid lasthit owner p.x p.y v.x v.y s time + assert(n == 10, Eusage); + assert(ord >= 0, "you are not playing"); + o := member.obj(int hd tl toks); + assert(o != nil, "object does not exist"); + o.setattr("state", concat(tl tl toks), All); + members[ord].score++; + arena.setattr("score" + string ord, string members[ord].score, All); + "bat" => + # bat pos + assert(n == 2, Eusage); + s1 := real hd tl toks; + members[ord].bat.setattr("pos", hd tl toks + " " + string (s1 + BATLEN), All); + "time" => + # time millisec + assert(n == 2, Eusage); + tm := int hd tl toks; + offset := sys->millisec() - tm; + clique.action("time " + string offset + " " + string tm, nil, nil, None.add(member.id)); + * => + assert(0, "bad command"); + } + } exception e { + "parse:*" => + return e[6:]; + } + return nil; +} + +order(p: ref Member): int +{ + for (i := 0; i < len members; i++) + if (members[i].p == p) + return i; + return -1; +} + +assert(b: int, err: string) +{ + if (b == 0) + raise "parse:" + err; +} + +concat(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +Line.seg(l: self Line, s1, s2: real): Line +{ + (dx, dy) := (l.p2.x - l.p1.x, l.p2.y - l.p1.y); + return (((l.p1.x + int (s1 * real dx)), l.p1.y + int (s1 * real dy)), + ((l.p1.x + int (s2 * real dx)), l.p1.y + int (s2 * real dy))); +} + +sides(r: Rect): list of Line +{ + return ((r.min.x, r.min.y), (r.min.x, r.max.y)) :: + ((r.max.x, r.min.y), (r.max.x, r.max.y)) :: + ((r.min.x, r.min.y), (r.max.x, r.min.y)) :: + ((r.min.x, r.max.y), (r.max.x, r.max.y)) :: nil; +} + +addlines(ll: list of Line, attrs: list of (string, string)) +{ + for (; ll != nil; ll = tl ll) + addline(hd ll, attrs); +} + +segs(ll: list of Line, s1, s2: real): list of Line +{ + nll: list of Line; + for (; ll != nil; ll = tl ll) + nll = (hd ll).seg(s1, s2) :: nll; + ll = nil; + for (; nll != nil; nll = tl nll) + ll = hd nll :: ll; + return ll; +} + +l2a(ll: list of Line): array of Line +{ + a := array[len ll] of Line; + for (i := 0; ll != nil; ll = tl ll) + a[i++] = hd ll; + return a; +} diff --git a/appl/spree/engines/canfield.b b/appl/spree/engines/canfield.b new file mode 100644 index 00000000..dbf3734f --- /dev/null +++ b/appl/spree/engines/canfield.b @@ -0,0 +1,340 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + All, None: import Sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember, Card: import cardlib; + dTOP, dRIGHT, dLEFT, oDOWN, + aCENTRELEFT, aUPPERRIGHT, + EXPAND, FILLX, FILLY, Stackspec: import Cardlib; +include "../gather.m"; + +clique: ref Clique; + +sevens: array of ref Object; # [7] +spare1, spare2: ref Object; +acepiles: array of ref Object; # [4] +top2botcount := 3; +top2bot: ref Object; + +CLICK, TOP2BOT, REDEAL, SHOW: con iota; + +Openspec := Stackspec( + "display", # style + 19, # maxcards + 0, # conceal + "" # title +); + +Pilespec := Stackspec( + "pile", # style + 19, # maxcards + 0, # conceal + "pile" # title +); + +Untitledpilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "" # title +); + +clienttype(): string +{ + return "cards"; +} + +rank := array[] of {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12}; + +maxmembers(): int +{ + return 1; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + return nil; +} + +propose(members: array of string): string +{ + if (len members != 1) + return "one member only"; + return nil; +} + +start(members: array of ref Member, archived: int) +{ + allow->add(SHOW, nil, "show"); + if (archived) { + archiveobj := cardlib->unarchive(); + sevens = cardlib->getarchivearray("sevens"); + acepiles = cardlib->getarchivearray("acepiles"); + spare1 = cardlib->getarchiveobj("spare1"); + spare2 = cardlib->getarchiveobj("spare2"); + top2bot = cardlib->getarchiveobj("top2bot"); + top2botcount = int archiveobj.getattr("top2botcount"); + + allow->unarchive(archiveobj); + archiveobj.delete(); + } else { + p := members[0]; + Cmember.join(p, -1).layout.lay.setvisibility(All); + startclique(); + allow->add(CLICK, p, "click %o %d"); + allow->add(TOP2BOT, p, "top2bot"); + allow->add(REDEAL, p, "redeal"); + } +} + +archive() +{ + archiveobj := cardlib->archive(); + cardlib->archivearray(sevens, "sevens"); + cardlib->archivearray(acepiles, "acepiles"); + cardlib->setarchivename(spare1, "spare1"); + cardlib->setarchivename(spare2, "spare2"); + cardlib->setarchivename(top2bot, "top2bot"); + archiveobj.setattr("top2botcount", string top2botcount, None); + allow->archive(archiveobj); +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "you are not playing"; + + case tag { + CLICK => + # click stack index + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + if (sel.isempty() || sel.stack == stack) { + if (nc == 0 && stype == "spare1") { + cardlib->flip(spare2); + spare2.transfer((0, len spare2.children), spare1, 0); + return nil; + } + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + case stype { + "spare2" or + "open" => + select(cp, stack, (idx, nc)); + "spare1" => + if ((n := nc) > 3) + n = 3; + for (i := 0; i < n; i++) { + cardlib->setface(stack.children[nc - 1], 1); + stack.transfer((nc - 1, nc), spare2, -1); + nc--; + } + * => + return "you can't move cards from there"; + } + } else { + from := sel.stack; + case stype { + "acepile" => + if (sel.r.end != sel.r.start + 1) + return "only one card at a time!"; + card := getcard(sel.stack.children[sel.r.start]); + if (nc == 0) { + if (card.number != 0) + return "aces only"; + } else { + top := getcard(stack.children[nc - 1]); + if (card.number != top.number + 1) + return "out of sequence"; + if (card.suit != top.suit) + return "wrong suit"; + } + sel.transfer(stack, -1); + "open" => + c := getcard(sel.stack.children[sel.r.start]); + col := !isred(c); + n := c.number + 1; + for (i := sel.r.start; i < sel.r.end; i++) { + c2 := getcard(sel.stack.children[i]); + if (c2.face == 0) + return "cannot move face-down cards"; + if (isred(c2) == col) + return "bad colour sequence"; + if (c2.number != n - 1) + return "bad number sequence"; + n = c2.number; + col = isred(c2); + } + if (nc != 0) { + c2 := getcard(stack.children[nc - 1]); + if (isred(c2) == isred(c) || c2.number != c.number + 1) + return "invalid move"; + } else if (c.number != 12) + return "only kings allowed there"; + sel.transfer(stack, -1); + * => + return "can't move there"; + } + if (from.getattr("type") == "open" && len from.children > 0) + cardlib->setface(from.children[len from.children - 1], 1); + } + TOP2BOT => + if (len spare2.children != 0) + return "can only top-to-bottom on the whole pile"; + if (top2botcount <= 0) + return "too late"; + nc := len spare1.children; + if (nc > 0) { + spare1.transfer((nc - 1, nc), spare1, 0); + top2botcount--; + settop2bottext(); + } + REDEAL => + clearup(); + cardlib->shuffle(spare1); + deal(); + top2botcount = 3; + settop2bottext(); + SHOW => + clique.show(nil); + } + return nil; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +settop2bottext() +{ + top2bot.setattr("text", + sys->sprint("top to bottom (%d left)", top2botcount), All); +} + +startclique() +{ + addlayobj, addlayframe: import cardlib; + + entry := clique.newobject(nil, All, "widget entry"); + entry.setattr("command", "say", All); + addlayobj("entry", nil, nil, dTOP|FILLX, entry); + addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + + addlayframe("top", "arena", nil, dTOP|EXPAND, dTOP); + addlayframe("mid", "arena", nil, dTOP|EXPAND, dTOP); + addlayframe("bot", "arena", nil, dTOP|EXPAND, dTOP); + + sevens = array[7] of {* => newstack(nil, Openspec, "open")}; + acepiles = array[4] of {* => newstack(nil, Untitledpilespec, "acepile")}; + spare1 = newstack(nil, Untitledpilespec, "spare1"); + spare2 = newstack(nil, Untitledpilespec, "spare2"); + + cardlib->makecards(spare1, (0, 13), nil); + + for (i := 0; i < 4; i++) + addlayobj(nil, "top", nil, dRIGHT, acepiles[i]); + for (i = 0; i < len sevens; i++) + addlayobj(nil, "mid", nil, dLEFT|oDOWN|EXPAND, sevens[i]); + addlayframe("buts", "bot", nil, dLEFT|EXPAND|aUPPERRIGHT, dTOP); + top2bot = newbutton("top2bot", "top to bottom"); + addlayobj(nil, "buts", nil, dTOP, top2bot); + addlayobj(nil, "buts", nil, dTOP, newbutton("redeal", "redeal")); + addlayobj(nil, "bot", nil, dLEFT, spare1); + addlayobj(nil, "bot", nil, dLEFT|EXPAND|aCENTRELEFT, spare2); + deal(); + settop2bottext(); +} + +clearup() +{ + for (i := 0; i < len sevens; i++) + cardlib->discard(sevens[i], spare1, 1); + for (i = 0; i < len acepiles; i++) + cardlib->discard(acepiles[i], spare1, 1); + cardlib->discard(spare2, spare1, 1); +} + +deal() +{ + cardlib->shuffle(spare1); + + for (i := 0; i < 7; i++) { + spare1.transfer((0, i + 1), sevens[i], 0); + cardlib->setface(sevens[i].children[i], 1); + } + +} + +newbutton(cmd, text: string): ref Object +{ + but := clique.newobject(nil, All, "widget button"); + but.setattr("command", cmd, All); + but.setattr("text", text, All); + return but; +} + +newstack(parent: ref Object, spec: Stackspec, stype: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + return stack; +} + +getcard(card: ref Object): Card +{ + c := cardlib->getcard(card); + c.number = rank[c.number]; + return c; +} + +isred(c: Card): int +{ + return c.suit == Cardlib->DIAMONDS || c.suit == Cardlib->HEARTS; +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} diff --git a/appl/spree/engines/chat.b b/appl/spree/engines/chat.b new file mode 100644 index 00000000..c409b272 --- /dev/null +++ b/appl/spree/engines/chat.b @@ -0,0 +1,60 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member: import spree; + +clique: ref Clique; + +clienttype(): string +{ + return "chat"; +} + +init(g: ref Clique, srvmod: Spree): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + return nil; +} + +join(nil: ref Member): string +{ + return nil; +} + +leave(nil: ref Member) +{ +} + +Eusage: con "bad command usage"; + +command(member: ref Member, cmd: string): string +{ + e := ref Sys->Exception; + if (sys->rescue("parse:*", e) == Sys->EXCEPTION) { + sys->rescued(Sys->ONCE, nil); + return e.name[6:]; + } + (n, toks) := sys->tokenize(cmd, " \n"); + assert(n > 0, "unknown command"); + case hd toks { + "say" => + # say something + assert(n == 2, Eusage); + clique.action("say " + string member.id + " " + hd tl toks, nil, nil, ~0); + * => + assert(0, "bad command"); + } + return nil; +} + +assert(b: int, err: string) +{ + if (b == 0) + sys->raise("parse:" + err); +} diff --git a/appl/spree/engines/debug.b b/appl/spree/engines/debug.b new file mode 100644 index 00000000..96acede0 --- /dev/null +++ b/appl/spree/engines/debug.b @@ -0,0 +1,163 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member: import spree; + +clique: ref Clique; + +init(g: ref Clique, srvmod: Spree): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + return nil; +} + +join(nil: ref Member): string +{ + return nil; +} + +leave(nil: ref Member) +{ +} + +number := 0; +currmember: ref Member; + +obj(ext: int): ref Object +{ + o := currmember.obj(ext); + if (o == nil) + sys->raise("parse:bad object"); + return o; +} + +Eusage: con "bad command usage"; + +assert(b: int, err: string) +{ + if (b == 0) + sys->raise("parse:" + err); +} + +command(member: ref Member, cmd: string): string +{ + e := ref Sys->Exception; + if (sys->rescue("parse:*", e) == Sys->EXCEPTION) { + sys->rescued(Sys->ONCE, nil); + currmember = nil; + return e.name[6:]; + } + currmember = member; + (nlines, lines) := sys->tokenize(cmd, "\n"); + assert(nlines > 0, "unknown command"); + (n, toks) := sys->tokenize(hd lines, " "); + assert(n > 0, "unknown command"); + case hd toks { + "new" => # new parent visibility\nvisibility attr val\nvisibility attr val... + assert(n == 3, Eusage); + setattrs(clique.newobject(obj(int hd tl toks), int hd tl tl toks), tl lines); + "deck" => + stack := clique.newobject(nil, ~0); + stack.setattr("type", "stack", ~0); + for (i := 0; i < 6; i++) { + o := clique.newobject(stack, ~0); + o.setattr("face", "down", ~0); + o.setattr("number", string number++, 0); + } + "flip" => + # flip objid start [end] + assert(n == 2 || n == 3 || n == 4, Eusage); + o := obj(int hd tl toks); + if (n > 2) { + start := int hd tl tl toks; + end := start + 1; + if (n == 4) + end = int hd tl tl tl toks; + assert(start >= 0 && start < len o.children && + end >= start && end >= 0 && end <= len o.children, "index out of range"); + for (; start < end; start++) + flip(o.children[start]); + } else + flip(o); + + "set" => # set objid attr val + assert(n == 4, Eusage); + obj(int hd tl toks).setattr(hd tl tl toks, hd tl tl tl toks, ~0); + "vis" => # vis objid flags + assert(n == 3, Eusage); + obj(int hd tl toks).setvisibility(int hd tl tl toks); + "attrvis" => # attrvis objid attr flags + assert(n == 4, Eusage); + o := obj(int hd tl toks); + name := hd tl tl toks; + attr := o.attrs.get(name); + assert(attr != nil, "attribute not found"); + o.setattrvisibility(name, int hd tl tl tl toks); + "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); + "del" or "delete" => # del obj + assert(n == 2, Eusage); + obj(int hd tl toks).delete(); + "tx" => # tx src from to dest [index] + assert(n == 5 || n == 6, Eusage); + src, dest: ref Object; + r: Range; + (src, toks) = (obj(int hd tl toks), tl tl toks); + (r.start, toks) = (int hd toks, tl toks); + (r.end, toks) = (int hd toks, tl toks); + (dest, toks) = (obj(int hd toks), tl toks); + index := len dest.children; + if (n == 6) + index = int hd toks; + assert(r.start >= 0 && r.start < len src.children && + r.end >= 0 && r.end <= len src.children && r.end >= r.start, + "bad range"); + src.transfer(r, dest, index); + * => + assert(0, "bad command"); + } + currmember = nil; + return nil; +} + + +flip(o: ref Object) +{ + face := o.getattr("face"); + if (face == "down") { + face = "up"; + o.setattrvisibility("number", ~0); + } else { + face = "down"; + o.setattrvisibility("number", 0); + } + o.setattr("face", face, ~0); +} + +setattrs(o: ref Object, lines: list of string): string +{ + for (; lines != nil; lines = tl lines) { + # attr val [visibility] + (n, toks) := sys->tokenize(hd lines, " "); + if (n != 2 && n != 3) + return "bad attribute line"; + vis := 0; + if (n == 3) + vis = int hd tl tl toks; + o.setattr(hd toks, hd tl toks, vis); + } + return nil; +} + diff --git a/appl/spree/engines/freecell.b b/appl/spree/engines/freecell.b new file mode 100644 index 00000000..8005926c --- /dev/null +++ b/appl/spree/engines/freecell.b @@ -0,0 +1,428 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, set, A, B, All, None: import sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember, Card: import cardlib; + getcard: import cardlib; + dTOP, dRIGHT, dLEFT, oRIGHT, oDOWN, + aCENTRERIGHT, aCENTRELEFT, aUPPERRIGHT, + EXPAND, FILLX, FILLY, Stackspec: import Cardlib; +include "../gather.m"; + +clique: ref Clique; + +open: array of ref Object; # [8] +cells: array of ref Object; # [4] +acepiles: array of ref Object; # [4] +txpiles: array of ref Object; # [len open + len cells] +deck: ref Object; + +fnames := array[] of { +"qua", +"quack", +"quackery", +"quad", +"quadrangle", +"quadrangular", +"quadrant", +"quadratic", +"quadrature", +"quadrennial", +}; +dir(name: string, perm: int, owner: string): Sys->Dir +{ + d := Sys->zerodir; + d.name = name; + d.uid = owner; + d.gid = owner; + d.qid.qtype = (perm >> 24) & 16rff; + d.mode = perm; + # d.atime = now; + # d.mtime = now; + return d; +} + + +suitsout := array[4] of {* => -1}; + +mainmember: ref Cmember; + +CLICK: con iota; + +Openspec := Stackspec( + "display", # style + 19, # maxcards + 0, # conceal + "" # title +); + +Pilespec := Stackspec( + "pile", # style + 19, # maxcards + 0, # conceal + "pile" # title +); + +Untitledpilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "" # title +); + +clienttype(): string +{ + return "cards"; +} + +maxmembers(): int +{ + return 1; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("whist: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + g.fcreate(0, -1, dir("data", 8r555|Sys->DMDIR, "spree")); + for(i := 0; i < len fnames; i++) + g.fcreate(i + 1, 0, dir(fnames[i], 8r444, "arble")); + return nil; +} + +propose(members: array of string): string +{ + if (len members != 1) + return "one member only"; + return nil; +} + +start(members: array of ref Member, archived: int) +{ +sys->print("freecell: starting\n"); + if (archived) { + archiveobj := cardlib->unarchive(); + open = cardlib->getarchivearray("open"); + cells = cardlib->getarchivearray("cells"); + acepiles = cardlib->getarchivearray("acepiles"); + txpiles = cardlib->getarchivearray("txpiles"); + deck = cardlib->getarchiveobj("deck"); + for (i := 0; i < len suitsout; i++) + suitsout[i] = int archiveobj.getattr("suitsout" + string i); + mainmember = Cmember.findid(int archiveobj.getattr("mainmember")); + allow->unarchive(archiveobj); + archiveobj.delete(); + } else { + sys->print("freecell: starting afresh\n"); + mainmember = Cmember.join(members[0], -1); + mainmember.layout.lay.setvisibility(All); + startclique(); + movefree(); + allow->add(CLICK, members[0], "click %o %d"); + } +} + +readfile(f: int, boffset: big, n: int): array of byte +{ + offset := int boffset; + f--; + if (f < 0 || f >= len fnames) + return nil; + data := array of byte fnames[f]; + if (offset >= len data) + return nil; + if (offset + n > len data) + n = len data - offset; + return data[offset:offset + n]; +} + +archive() +{ + sys->print("freecell: archiving\n"); + archiveobj := cardlib->archive(); + cardlib->archivearray(open, "open"); + cardlib->archivearray(cells, "cells"); + cardlib->archivearray(acepiles, "acepiles"); + cardlib->archivearray(txpiles, "txpiles"); + cardlib->setarchivename(deck, "deck"); + for (i := 0; i < len suitsout; i++) + archiveobj.setattr("suitsout" + string i, string suitsout[i], None); + archiveobj.setattr("mainmember", string mainmember.id, None); + allow->archive(archiveobj); +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "you are not playing"; + case tag { + CLICK => + # click stack index + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + if (sel.isempty() || sel.stack == stack) { + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + case stype { + "cell" or + "open" => + select(cp, stack, (idx, nc)); + * => + return "you can't move cards from there"; + } + } else { + from := sel.stack; + case stype { + "acepile" => + if (sel.r.end != sel.r.start + 1) + return "only one card at a time!"; + addtoacepile(sel.stack); + sel.set(nil); + movefree(); + "open" => + c := getcard(sel.stack.children[sel.r.start]); + col := !isred(c.suit); + n := c.number + 1; + for (i := sel.r.start; i < sel.r.end; i++) { + c2 := getcard(sel.stack.children[i]); + if (isred(c2.suit) == col) + return "bad colour sequence"; + if (c2.number != n - 1) + return "bad number sequence"; + n = c2.number; + col = isred(c2.suit); + } + if (nc != 0) { + c2 := getcard(stack.children[nc - 1]); + if (isred(c2.suit) == isred(c.suit) || c2.number != c.number + 1) + return "opposite colours, descending, only"; + } + r := sel.r; + selstack := sel.stack; + sel.set(nil); + fc := freecells(stack); + if (r.end - r.start - 1 > len fc) + return "not enough free cells"; + n = 0; + for (i = r.end - 1; i >= r.start + 1; i--) + selstack.transfer((i, i + 1), fc[n++], -1); + selstack.transfer((i, i + 1), stack, -1); + while (--n >= 0) + fc[n].transfer((0, 1), stack, -1); + movefree(); + "cell" => + if (sel.r.end - sel.r.start > 1 || nc > 0) + return "only one card allowed there"; + sel.transfer(stack, -1); + movefree(); + * => + return "can't move there"; + } + } + } + return nil; +} + +freecells(dest: ref Object): array of ref Object +{ + fc := array[len txpiles] of ref Object; + n := 0; + for (i := 0; i < len txpiles; i++) + if (len txpiles[i].children == 0 && txpiles[i] != dest) + fc[n++] = txpiles[i]; + return fc[0:n]; +} + +# move any cards that can be moved. +movefree() +{ + nmoved := 1; + while (nmoved > 0) { + nmoved = 0; + for (i := 0; i < len txpiles; i++) { + pile := txpiles[i]; + nc := len pile.children; + if (nc == 0) + continue; + card := getcard(pile.children[nc - 1]); + if (suitsout[card.suit] != card.number - 1) + continue; + # card can be moved; now make sure there's no card out + # that might be moved onto this card + for (j := 0; j < len suitsout; j++) + if (isred(j) != isred(card.suit) && card.number > 1 && suitsout[j] < card.number - 1) + break; + if (j == len suitsout) { + addtoacepile(pile); + nmoved++; + } + } + } +} + +addtoacepile(pile: ref Object) +{ + nc := len pile.children; + if (nc == 0) + return; + card := getcard(pile.children[nc - 1]); + for (i := 0; i < len acepiles; i++) { + anc := len acepiles[i].children; + if (anc == 0) { + if (card.number == 0) + break; + continue; + } + acard := getcard(acepiles[i].children[anc - 1]); + if (acard.suit == card.suit && acard.number == card.number - 1) + break; + } + if (i < len acepiles) { + pile.transfer((nc - 1, nc), acepiles[i], -1); + suitsout[card.suit] = card.number; + } +} + +startclique() +{ + addlayobj, addlayframe: import cardlib; + + open = array[8] of {* => newstack(nil, Openspec, "open", nil)}; + acepiles = array[4] of {* => newstack(nil, Untitledpilespec, "acepile", nil)}; + cells = array[4] of {* => newstack(nil, Untitledpilespec, "cell", "cell")}; + for (i := 0; i < len cells; i++) + cells[i].setattr("showsize", "0", All); + + txpiles = array[12] of ref Object; + txpiles[0:] = open; + txpiles[len open:] = cells; + deck = clique.newobject(nil, All, "stack"); + + cardlib->makecards(deck, (0, 13), nil); + + addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + addlayframe("top", "arena", nil, dTOP|EXPAND, dTOP); + addlayframe("bot", "arena", nil, dTOP|EXPAND, dTOP); + for (i = 0; i < 4; i++) + addlayobj(nil, "top", nil, dRIGHT, acepiles[i]); + for (i = 0; i < 4; i++) + addlayobj(nil, "top", nil, dLEFT, cells[i]); + for (i = 0; i < len open; i++) + addlayobj(nil, "bot", nil, dLEFT|oDOWN|EXPAND, open[i]); + deal(); +} + +deal() +{ + cardlib->shuffle(deck); + cardlib->deal(deck, 7, open, 0); +} + +newstack(parent: ref Object, spec: Stackspec, stype, title: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + stack.setattr("title", title, All); + return stack; +} + +isred(suit: int): int +{ + return suit == Cardlib->DIAMONDS || suit == Cardlib->HEARTS; +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} + +#randstate := 1; +#srand(seed: int) +#{ +# randstate = seed; +#} +# +#rand(): int +#{ +# randstate = randstate * 214013 + 2531011; +# return (randstate >> 16) & 0x7fff; +#} +##From: jimh@MICROSOFT.com (Jim Horne) +## +##I'm happy to share the card shuffle algorithm, but I warn you, +##it does depend on the rand() and srand() function built into MS +##compilers. The good news is that I believe these work the same +##for all our compilers. +## +##I use cards.dll which has it's own mapping of numbers (0-51) to +##cards. The following will give you the idea. Play around with +##this and you'll be able to generate all the cliques. +## +##Go ahead and post the code. People might as well have fun with it. +##Please keep me posted on anything interesting that comes of it. +##Thanks. +# +#msdeal(cliquenumber: int): array of array of Card +#{ +# deck := array[52] of Card; +# for (i := 0; i < len deck; i++) # put unique card in each deck loc. +# deck[i] = Card(i % 4, i / 4, 0); +# wleft := 52; # cards left to be chosen in shuffle +# cards := array[8] of {* => array[7] of Card}; +# max := array[8] of {* => 0}; +# srand(cliquenumber); +# for (i = 0; i < 52; i++) { +# j := rand() % wleft; +# card[i % 8][i / 8] = deck[j]; +# max[i % 8] = i / 8; +# deck[j] = deck[--wleft]; +# } +# for (i = 0; i < len cards; i++) +# cards[i] = cards[i][0:max[i]]; +# return cards; +#} diff --git a/appl/spree/engines/gather.b b/appl/spree/engines/gather.b new file mode 100644 index 00000000..59b7bfb2 --- /dev/null +++ b/appl/spree/engines/gather.b @@ -0,0 +1,267 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, set, A, B, All, None: import sets; +include "../spree.m"; + spree: Spree; + archives: Archives; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "daytime.m"; + daytime: Daytime; +include "../gather.m"; + +clique: ref Clique; + +started := 0; +halted := 0; +suspended: Set; # set of members currently suspended from the clique. +count := 0; +nmembers := 0; +title := "unknown"; +cliquemod: Gatherengine; + +members: Set; +watchers: Set; + +invited: list of string; + +# options: +# <n> cliquemodule opts +init(srvmod: Spree, g: ref Clique, argv: list of string): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("gather: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + sets->init(); + daytime = load Daytime Daytime->PATH; + if (daytime == nil) { + sys->print("gather: cannot load %s: %r\n", Daytime->PATH); + return "bad module"; + } + archives = load Archives Archives->PATH; + if (archives == nil) { + sys->print("gather: cannot load %s: %r\n", Archives->PATH); + return "bad module"; + } + archives->init(srvmod); + argv = tl argv; + n := len argv; + if (n < 2) + return "bad init options"; + count = int hd argv; + if (count != -1 && count <= 0) + return "bad gather count"; + argv = tl argv; + if (count < len clique.archive.members) + count = len clique.archive.members; + cliquemod = load Gatherengine "/dis/spree/engines/" + hd argv + ".dis"; + if (cliquemod == nil) + return sys->sprint("bad module: %r"); + title = concat(argv); + e := cliquemod->init(srvmod, clique, tl argv, len clique.archive.members > 0); + if (e != nil) + return e; + if (len clique.archive.members > 0) { + for (i := 0; i < len clique.archive.members; i++) + invited = clique.archive.members[i] :: invited; + } else + invited = clique.owner() :: nil; + for (inv := invited; inv != nil; inv = tl inv) + clique.notify(clique.parentid, "invite " + hd inv); + clique.notify(clique.parentid, "title (" + title + ")"); + return nil; +} + +join(p: ref Member, cmd: string, susp: int): string +{ +sys->print("gather: %s[%d] joining '%s' (suspended: %d)\n", p.name, p.id, cmd, susp); + case cmd { + "join" => + if (started) { + if (!susp || !halted) + return "clique has already started"; + suspended = suspended.del(p.id); + if (suspended.eq(None)) { + halted = 0; + # XXX inform participants that clique is starting again + } + pset := None.add(p.id); + clique.action("clienttype " + cliquemod->clienttype(), nil, nil, pset); + clique.breakmsg(pset); + return nil; + } + for (inv := invited; inv != nil; inv = tl inv) + if (hd inv == p.name || hd inv == "all") + break; + if (inv == nil) + return "you have not been invited"; + if (nmembers >= cliquemod->maxmembers() || (count != -1 && nmembers >= count)) + return "too many members already"; + if (len clique.archive.members > 0) { + for (i := 0; i < len clique.archive.members; i++) + if (p.name == clique.archive.members[i]) + break; + if (i == len clique.archive.members) + return "you are not part of that clique"; + } + nmembers++; + members = members.add(p.id); + clique.notify(clique.parentid, "join " + p.name); + s := None.add(p.id); + # special case for single member cliques: don't need a gather client as we can start right now. + if (cliquemod->maxmembers() == 1) + return startclique(); + clique.action("clienttype gather", nil, nil, s); + clique.breakmsg(s); + clique.action("title " + title, nil, nil, s); + clique.action("join " + p.name, nil, nil, All); + "watch" => + if (susp) + return "you cannot watch if you are playing"; + watchers = watchers.add(p.id); + s := None.add(p.id); + if (started) + clique.action("clienttype " + cliquemod->clienttype(), nil, nil, s); + else + clique.action("clienttype gather", nil, nil, s); + clique.breakmsg(s); + if (!started) + clique.action("watch " + p.name, nil, nil, All); + * => + return "unknown join request"; + } + return nil; +} + +leave(p: ref Member): int +{ + if (members.holds(p.id)) { + if (started) { + suspended = suspended.add(p.id); + if (suspended.eq(members)) { + cliquemod->archive(); + name := spree->newarchivename(); + e := archives->write(clique, + ("title", concat(tl tl clique.archive.argv)) :: + ("date", string daytime->now()) :: nil, + name, members); + if (e != nil) + sys->print("warning: cannot archive clique: %s\n", e); + else + clique.notify(clique.parentid, "archived " + name); + clique.hangup(); + return 1; + } else { + halted = 1; + return 0; + } + } + + members = members.del(p.id); + nmembers--; + clique.notify(clique.parentid, "leave " + p.name); + if (nmembers == 0) + clique.hangup(); + } else { + watchers = watchers.del(p.id); + clique.action("unwatch " + p.name, nil, nil, All); + } + return 1; +} + +notify(nil: int, note: string) +{ + (n, toks) := sys->tokenize(note, " "); + case hd toks { + "invite" => + invited = hd tl toks :: invited; + "uninvite" => + inv := invited; + for (invited = nil; inv != nil; inv = tl inv) + if (hd inv != hd tl toks) + invited = hd inv :: invited; + * => + sys->print("gather: unknown notification '%s'\n", note); + } +} + +command(p: ref Member, cmd: string): string +{ + if (halted) + return "clique is halted for the time being"; + if (started) { + if (!members.holds(p.id)) { +sys->print("members (%s) doesn't hold %s[%d]\n", members.str(), p.name, p.id); + return "you are only watching"; + } + return cliquemod->command(p, cmd); + } + + (n, toks) := sys->tokenize(cmd, " \n"); + if (n == 0) + return "bad command"; + case hd toks { + "start" => + if (len clique.archive.members == 0 && p.name != clique.owner()) + return "only the owner can start a clique"; + if (count != -1 && nmembers != count) + return "need " + string count + " members"; + return startclique(); + "chat" => + clique.action("chat " + p.name + " " + concat(tl toks), nil, nil, All); + * => + return "unknown command"; + } + return nil; +} + +startclique(): string +{ + # XXX could randomly shuffle members here + + pa := array[nmembers] of ref Member; + names := array[nmembers] of string; + j := nmembers; + for (i := members.limit(); i >= 0; i--) + if (members.holds(i)) { + pa[--j] = clique.member(i); + names[j] = pa[j].name; + } + e := cliquemod->propose(names); + if (e != nil) + return e; + clique.action("clienttype " + cliquemod->clienttype(), nil, nil, All); + clique.breakmsg(All); + cliquemod->start(pa, len clique.archive.members > 0); + clique.start(); + started = 1; + clique.notify(clique.parentid, "started"); + clique.notify(clique.parentid, "title " + concat(tl tl clique.archive.argv)); + return nil; +} + +readfile(f: int, offset: big, n: int): array of byte +{ + if (!started) + return nil; + return cliquemod->readfile(f, offset, n); +} + +concat(l: list of string): string +{ + if (l == nil) + return nil; + s := hd l; + for (l = tl l; l != nil; l = tl l) + s += " " + hd l; + return s; +} diff --git a/appl/spree/engines/hearts.b b/appl/spree/engines/hearts.b new file mode 100644 index 00000000..759f07e2 --- /dev/null +++ b/appl/spree/engines/hearts.b @@ -0,0 +1,300 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + dTOP, dLEFT, oLEFT, oRIGHT, EXPAND, FILLX, FILLY, Stackspec: import Cardlib; +include "tricks.m"; + tricks: Tricks; + Trick: import tricks; +clique: ref Clique; +CLICK, START, SAY: con iota; + +started := 0; + +buttons: ref Object; +scores: ref Object; +deck, pile: ref Object; +hands, taken, passon: array of ref Object; + +MINPLAYERS: con 2; +MAXPLAYERS: con 4; + +leader, turn: int; +trick: ref Trick; + +Trickpilespec := Stackspec( + "display", # style + 4, # maxcards + 0, # conceal + "trick pile" # title +); + +Handspec := Stackspec( + "display", + 13, + 1, + "" +); + +Passonspec := Stackspec( + "display", + 3, + 0, + "pass on" +); + +Takenspec := Stackspec( + "pile", + 52, + 0, + "tricks" +); + +clienttype(): string +{ + return "cards"; +} + +init(g: ref Clique, srvmod: Spree): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("hearts: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + allow->add(SAY, nil, "say &"); + + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("hearts: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + + tricks = load Tricks Tricks->PATH; + if (tricks == nil) { + sys->print("hearts: cannot load %s: %r\n", Tricks->PATH); + return "bad module"; + } + tricks->init(spree, clique, cardlib); + + deck = clique.newobject(nil, ~0, "stack"); + cardlib->makecards(deck, (0, 13), 1); + cardlib->shuffle(deck); + buttons = clique.newobject(nil, ~0, "buttons"); + scores = clique.newobject(nil, ~0, "scoretable"); + + return nil; +} + +join(p: ref Member): string +{ + sys->print("%s(%d) joining\n", p.name(), p.id); + if (!started && cardlib->nmembers() < MAXPLAYERS) { + (nil, err) := cardlib->join(p, -1); + if (err == nil) { + if (cardlib->nmembers() == MINPLAYERS) { + mkbutton("Start", "start"); + allow->add(START, nil, "start"); + } + } else + sys->print("error on join: %s\n", err); + } + return nil; +} + +leave(p: ref Member) +{ + cardlib->leave(p); + started == 0; + if (cardlib->nmembers() < MINPLAYERS) { + buttons.deletechildren((0, len buttons.children)); + allow->del(START, nil); + } +} + +command(p: ref Member, cmd: string): string +{ + e := ref Sys->Exception; + if (sys->rescue("parse:*", e) == Sys->EXCEPTION) { + sys->rescued(Sys->ONCE, nil); + return e.name[6:]; + } + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + ord := cardlib->order(p); + case tag { + START => + buttons.deletechildren((0, len buttons.children)); + allow->del(START, nil); + startclique(); + n := cardlib->nmembers(); + leader = rand(n); + starthand(); + titles := ""; + for (i := 0; i < n; i++) + titles += cardlib->info(i).p.name() + " "; + clique.newobject(scores, ~0, "score").setattr("score", titles, ~0); + + CLICK => + # click stackid index + hand := hands[ord]; + if (int hd tl toks != hand.id) + return "can't click there"; + index := int hd tl tl toks; + if (index < 0 || index >= len hand.children) + return "index out of range"; + cardlib->setsel(hands[ord], (index, len hands[ord].children), p); + break; + err := trick.play(cardlib->order(p), int hd tl toks); + if (err != nil) + return err; + + turn = next(turn); # clockwise + if (turn == leader) { # come full circle + winner := trick.winner; + inf := cardlib->info(winner); + remark(sys->sprint("%s won the trick", inf.p.name())); + cardlib->discard(pile, taken[winner], 0); + taken[winner].setattr("title", + string (len taken[winner].children / cardlib->nmembers()) + + " " + "tricks", ~0); + o := cardlib->info(winner).obj; + trick = nil; + s := ""; + for (i := 0; i < cardlib->nmembers(); i++) { + if (i == winner) + s += "1 "; + else + s += "0 "; + } + clique.newobject(scores, ~0, "score").setattr("score", s, ~0); + if (len hands[winner].children > 0) { + leader = turn = winner; + trick = Trick.new(pile, -1, hands); + } else { + remark("one round down, some to go"); + leader = turn = -1; # XXX this round over + } + } + canplay(turn); + SAY => + clique.action("say member " + string p.id + ": '" + joinwords(tl toks) + "'", nil, nil, ~0); + } + return nil; +} + +startclique() +{ + cardlib->startclique(); + entry := clique.newobject(nil, ~0, "widget entry"); + entry.setattr("command", "say", ~0); + cardlib->addlayobj("entry", nil, nil, dTOP|FILLX, entry); + cardlib->addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + cardlib->maketable("arena"); + + pile = cardlib->newstack(nil, nil, Trickpilespec); + cardlib->addlayobj(nil, "public", nil, dTOP|oLEFT, pile); + n := cardlib->nmembers(); + hands = array[n] of ref Object; + taken = array[n] of ref Object; + passon = array[n] of ref Object; + tt := clique.newobject(nil, ~0, "widget menu"); + tt.setattr("text", "hello", ~0); + for (ml := "one" :: "two" :: "three" :: nil; ml != nil; ml = tl ml) { + o := clique.newobject(tt, ~0, "menuentry"); + o.setattr("text", hd ml, ~0); + o.setattr("command", hd ml, ~0); + } + for (i := 0; i < n; i++) { + inf := cardlib->info(i); + hands[i] = cardlib->newstack(inf.obj, inf.p, Handspec); + taken[i] = cardlib->newstack(inf.obj, inf.p, Takenspec); + passon[i] = cardlib->newstack(inf.obj, inf.p, Passonspec); + p := "p" + string i; + cardlib->addlayframe(p + ".f", p, nil, dLEFT|oLEFT, dTOP); + cardlib->addlayobj(nil, p + ".f", inf.layout, dTOP, tt); + cardlib->addlayobj(nil, p + ".f", nil, dTOP|oLEFT, hands[i]); + cardlib->addlayobj(nil, p, nil, dLEFT|oLEFT, taken[i]); + cardlib->addlayobj(nil, p, nil, dLEFT|oLEFT, passon[i]); + } +} + +joinwords(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +starthand() +{ + cardlib->deal(deck, 13, hands, 0); + trick = Trick.new(pile, -1, hands); + turn = leader; + canplay(turn); +} + +canplay(ord: int) +{ + allow->del(CLICK, nil); + for (i := 0; i < cardlib->nmembers(); i++) { + inf := cardlib->info(i); + inf.obj.setattr("status", nil, 1<<inf.p.id); + hands[i].setattr("actions", nil, 1<<inf.p.id); + } + if (ord != -1) { + allow->add(CLICK, member(ord), "click %o %d"); + inf := cardlib->info(ord); + inf.obj.setattr("status", "It's your turn to play", 1<<inf.p.id); + hands[ord].setattr("actions", "click", 1<<inf.p.id); + } +} + +memberobj(p: ref Member): ref Object +{ + return cardlib->info(cardlib->order(p)).obj; +} + +member(ord: int): ref Member +{ + return cardlib->info(ord).p; +} + +next(i: int): int +{ + i++; + if (i >= cardlib->nmembers()) + i = 0; + return i; +} + +remark(s: string) +{ + clique.action("remark " + s, nil, nil, ~0); +} + +mkbutton(text, cmd: string): ref Object +{ + but := clique.newobject(buttons, ~0, "button"); + but.setattr("text", text, ~0); + but.setattr("command", cmd, ~0); + return but; +} diff --git a/appl/spree/engines/liars.b b/appl/spree/engines/liars.b new file mode 100644 index 00000000..488e993b --- /dev/null +++ b/appl/spree/engines/liars.b @@ -0,0 +1,490 @@ +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<<info[ord].id); + info[ord].state = state; +} + +obj(ext: int): ref Object +{ + assert((o := currmember.obj(ext)) != nil, "bad object"); + return o; +} + +Eusage: con "bad command usage"; + +assert(b: int, err: string) +{ + if (b == 0) { + sys->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]; + } +} diff --git a/appl/spree/engines/liars.y b/appl/spree/engines/liars.y new file mode 100644 index 00000000..1e191076 --- /dev/null +++ b/appl/spree/engines/liars.y @@ -0,0 +1,132 @@ +%{ + + +YYSTYPE: adt { +}; + +YYLEX: adt { + lval: YYSTYPE; + lex: fn(l: self ref YYLEX): int; + error: fn(l: self ref YYLEX, err: string); + toks: list of string; +}; +%} + +%module Sh { + # module definition is in shell.m +} +%token A ALL AND BROKEN FIVE FOUR FUCK FULL HIGH +%token HOUSE KIND LOW NOTHING OF ON PAIR PAIRS STRAIGHT THREE TWO VALUE + +%start phrase +%% +phrase: nothing + | pair + | twopairs + | threes + | lowstraight + | fullhouse + | highstraight + | fours + | fives + +pair: PAIR + | PAIR ofsomething ',' extras + +nothing: NOTHING + | BROKEN STRAIGHT + | FUCK ALL + +twopairs: TWO PAIRS moretuppers + | TWO VALUE optcomma TWO VALUE and_a VALUE + | PAIR OF VALUE ',' PAIR OF VALUE and_a VALUE + +moretuppers: + | ',' VALUE ',' VALUE and_a VALUE + +threes: THREE OF A KIND extras + | THREE VALUE extras + +lowstraight: LOW STRAIGHT + +fullhouse: FULL HOUSE + | FULL HOUSE optcomma VALUE + | FULL HOUSE optcomma VALUE ON VALUE + | FULL HOUSE optcomma VALUE HIGH + +highstraight: HIGH STRAIGHT + +fours: FOUR OF A KIND extras + | FOUR VALUE extras + +fives: FIVE OF A KIND + | FIVE VALUE +and_a: # null + | AND A +optcomma: + | ',' +extras: VALUE + | extras VALUE +%% + +Tok: adt { + s: string; + tok: int; + val: int; +}; + +known := array of { +Tok("an", A, -1), +Tok("a", A, -1), +Tok("all", ALL, -1), +Tok("and", AND, -1), +Tok("broken", BROKEN, -1), +Tok(",", ',', -1), +Tok("five", FIVE, -1), +Tok("5", FIVE, -1), +Tok("four", FOUR, -1), +Tok("4", FOUR, -1), +Tok("fuck", FUCK, -1), +Tok("full", FULL, -1), +Tok("high", HIGH, -1), +Tok("house", HOUSE, -1), +Tok("kind", KIND, -1), +Tok("low", LOW, -1), +Tok("nothing", NOTHING, -1), +Tok("of", OF, -1), +Tok("on", ON, -1), +Tok("pair", PAIR, -1), +Tok("pairs", PAIRS, -1), +Tok("straight", STRAIGHT, -1), +Tok("three", THREE, -1), +Tok("3", THREE, -1), +Tok("two", TWO, -1), +Tok("2", TWO, -1), + +Tok("A", VALUE, 5), +Tok("K", VALUE, 4), +Tok("Q", VALUE, 3), +Tok("J", VALUE, 2), +Tok("10", VALUE, 1), +Tok("9", VALUE, 0), + +Tok("ace" +}; + +YYLEX.lex(l: self ref YYLEX): int +{ + if (l.toks == nil) + return -1; + t := hd l.toks; + for (i := 0; i < len known; i++) { + if (known[i].t0 == t) + return known[i].t1; + + case hd l.toks { + + +%token A ALL AND BROKEN FIVE FOUR FUCK FULL HIGH +%token HOUSE KIND LOW NOTHING OF ON PAIR PAIRS STRAIGHT THREE TWO VALUE +%token END + +}
\ No newline at end of file diff --git a/appl/spree/engines/lobby.b b/appl/spree/engines/lobby.b new file mode 100644 index 00000000..119922e2 --- /dev/null +++ b/appl/spree/engines/lobby.b @@ -0,0 +1,389 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, set, A, B, All, None: import sets; +include "../spree.m"; + spree: Spree; + archives: Archives; + Archive: import Archives; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "readdir.m"; + readdir: Readdir; + +# what the lobby provides: +# a list of cliques it's started +# name of clique +# current members +# list of members inside the lobby. +# name +# invites +# how does a gather engine know who's been invited? +# as the lobby's the only place with the knowledge of who's around to invite. +# could allow lobby to communicate with the cliques it's started... +# but clique also needs to communicate with the lobby +# (e.g. to say clique has started, no more invites necessary or allowed) +# +# list of available engines +# title +# clienttype(s?) +# +# understands commands: +# chat message +# invite +# new name params +# +# question: how do we know about archives? +# answer: maybe we don't... could have another module +# that does, or maybe an option to gather ("gather unarchive"?) +# +# the one that's started the clique is always invited. +# start clique. +# clique says to parent "invite x, y and z" (perhaps they were in the archive) +# how should we deal with recursive invocation? +# could queue up requests to other clique engines, +# and deliver them after the current request has been processed. +# no return available (one way channel) but maybe that's good, +# as if sometime in the future engines do run in parallel, we will +# need to avoid deadlock. +# Clique.notify(clique: self ref Clique, cliqueid: int, note: string); +# when a request has been completed, we run notify requests +# for all the cliques that have been notified, and repeat +# until no more. (could keep a count to check for infinite loop). +# don't allow communication between unrelated cliques. + +clique: ref Clique; + +members: ref Object; +sessions: ref Object; +available: ref Object; +archiveobj: ref Object; + +ARCHIVEDIR: con "./archive"; + +init(srvmod: Spree, g: ref Clique, nil: list of string): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("lobby: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + readdir = load Readdir Readdir->PATH; + if (readdir == nil) { + sys->print("lobby: cannot load %s: %r\n", Readdir->PATH); + return "bad module"; + } + archives = load Archives Archives->PATH; + if (archives == nil) { + sys->print("lobby: cannot load %s: %r\n", Archives->PATH); + return "bad module"; + } + archives->init(srvmod); + members = clique.newobject(nil, All, "members"); + sessions = clique.newobject(nil, All, "sessions"); + available = clique.newobject(nil, All, "available"); + o := clique.newobject(available, All, "sessiontype"); + o.setattr("name", "freecell", All); + o.setattr("title", "Freecell", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 1 freecell", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Lobby", All); + o.setattr("name", "lobby", All); + o.setattr("clienttype", "lobby", All); + o.setattr("start", "lobby", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Spit", All); + o.setattr("name", "spit", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 2 spit", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Canfield", All); + o.setattr("name", "canfield", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 1 canfield", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Afghan", All); + o.setattr("name", "afghan", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 1 afghan", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Spider", All); + o.setattr("name", "spider", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 1 spider", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Racing Demon", All); + o.setattr("name", "racingdemon", All); + o.setattr("clienttype", "cards", All); + o.setattr("start", "gather 3 racingdemon", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Othello", All); + o.setattr("name", "othello", All); + o.setattr("clienttype", "othello", All); + o.setattr("start", "gather 2 othello", All); + + o = clique.newobject(available, All, "sessiontype"); + o.setattr("title", "Whist", All); + o.setattr("name", "whist", All); + o.setattr("clienttype", "whist", All); + o.setattr("start", "gather 4 whist", All); + + getarchives(); + + clique.start(); + + return nil; +} + +join(p: ref Member, cmd: string, nil: int): string +{ + sys->print("%s joins '%s'\n", p.name, cmd); + clique.notify(clique.parentid, "join " + p.name); + s := None.add(p.id); + clique.action("clienttype lobby", nil, nil, s); + clique.breakmsg(s); + clique.action("name " + p.name, nil, nil, s); + o := clique.newobject(members, All, "member"); + o.setattr("name", p.name, All); + return nil; +} + +leave(p: ref Member): int +{ + clique.notify(clique.parentid, "leave " + p.name); + deletename(members, p.name, "member"); + sys->print("%s leaves\n", p.name); + return 1; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +command(p: ref Member, cmd: string): string +{ + sys->print("%s: '%s'\n", p.name, cmd); + (n, toks) := sys->tokenize(cmd, " \n"); + if (n == 0) + return "bad command"; + case hd toks { + "kick" => + getarchives(); + return nil; + "chat" => + clique.action("chat " + p.name + " " + concat(tl toks), nil, nil, All); + return nil; + "start" => + # start engine [params] + if (n >= 2) { + (gid, fname, err) := clique.new( + ref Archive(tl toks, nil, nil, nil), + p.name); + if (gid == -1) + return err; + s := addname(sessions, string gid, "session"); + s.setattr("title", concat(tl toks), All); + s.setattr("filename", fname, All); + s.setattr("cliqueid", string gid, None); + s.setattr("owner", p.name, All); + return nil; + } + return "bad start params"; + "invite" or + "uninvite"=> + # invite sessionid name + if (n == 3) { + (what, sessionid, name) := (hd toks, int hd tl toks, hd tl tl toks); + if ((s := p.obj(sessionid)) == nil) + return "bad object id"; + if (s.objtype != "session") + return "bad session type " + s.objtype; + if (s.getattr("owner") != p.name) + return "permission denied"; + clique.notify(int s.getattr("cliqueid"), what + " " + name); + if (hd toks == "invite") + addname(s, name, "invite"); + else + deletename(s, name, "invite"); + return nil; + } + return "bad invite params"; + "unarchive" => + # unarchive object + if (n == 2) { + o := p.obj(int hd tl toks); + if (o == nil || o.objtype != "archive") + return "bad archive object"; + # archive object contains: + # name name of clique + # members members of the clique + # file filename of archive + + aname := o.getattr("file"); + (archive, err) := archives->read(aname); + if (archive == nil) + return sys->sprint("cannot load archive: %s", err); + for (i := 0; i < len archive.members; i++) + if (p.name == archive.members[i]) + break; + if (i == len archive.members) + return "you did not participate in that session"; + (gid, fname, err2) := clique.new(archive, p.name); + if (gid == -1) + return err2; + s := addname(sessions, string gid, "session"); + s.setattr("title", concat(archive.argv), All); + s.setattr("filename", fname, All); + s.setattr("cliqueid", string gid, None); + s.setattr("owner", p.name, All); + + o.delete(); + (ok, d) := sys->stat(aname); + if (ok != -1) { + d.name += ".old"; + sys->wstat(aname, d); + } + # XXX delete old archive file? + return nil; + } + return "bad unarchive params"; + * => + return "bad command"; + } +} + +notify(srcid: int, note: string) +{ + sys->print("lobby: note from %d: %s\n", srcid, note); + s := findname(sessions, string srcid); + if (s == nil) { + sys->print("cannot find srcid %d\n", srcid); + return; + } + if (note == nil) { + s.delete(); + return; + } + if (srcid == clique.parentid) + return; + (n, toks) := sys->tokenize(note, " "); + case hd toks { + "join" => + p := addname(s, hd tl toks, "member"); + "leave" => + deletename(s, hd tl toks, "member"); + "invite" => + addname(s, hd tl toks, "invite"); + "uninvite" => + deletename(s, hd tl toks, "invite"); + "title" => + s.setattr("title", concat(tl toks), All); + "archived" => + # archived filename + arch := clique.newobject(archiveobj, All, "archive"); + arch.setattr("name", s.getattr("title"), All); + pnames := ""; + for (i := 0; i < len s.children; i++) + if (s.children[i].objtype == "member") + pnames += " " + s.children[i].getattr("name"); + if (pnames != nil) + pnames = pnames[1:]; + arch.setattr("members", pnames, All); + arch.setattr("file", hd tl toks, None); + * => + sys->print("unknown note from %d: %s\n", srcid, note); + } +} + +addname(o: ref Object, name: string, otype: string): ref Object +{ + x := clique.newobject(o, All, otype); + x.setattr("name", name, All); + return x; +} + +findname(o: ref Object, name: string): ref Object +{ + c := o.children; + for (i := 0; i < len c; i++) + if (c[i].getattr("name") == name) + return c[i]; + return nil; +} + +deletename(o: ref Object, name: string, objtype: string) +{ + c := o.children; + for (i := 0; i < len c; i++) + if (c[i].objtype == objtype && c[i].getattr("name") == name) { + o.deletechildren((i, i+1)); + break; + } +} + +getarchives() +{ + if (archiveobj == nil) + archiveobj = clique.newobject(nil, All, "archives"); + else + archiveobj.deletechildren((0, len archiveobj.children)); + for (names := spree->archivenames(); names != nil; names = tl names) { + fname := hd names; + (a, err) := archives->readheader(fname); + if (a == nil) { + sys->print("lobby: cannot read archive header on %s: %s\n", fname, err); + continue; + } + title := ""; + for (inf := a.info; inf != nil; inf = tl inf) { + if ((hd inf).t0 == "title") { + title = (hd inf).t1; + break; + } + } + if (title == nil) + title = concat(a.argv); + arch := clique.newobject(archiveobj, All, "archive"); + arch.setattr("name", title, All); + arch.setattr("members", concatarray(a.members), All); + arch.setattr("file", fname, None); + j := 0; + for (info := a.info; info != nil; info = tl info) + arch.setattr("info" + string j++, (hd info).t0 + " " + (hd info).t1, All); + } +} + +concat(l: list of string): string +{ + if (l == nil) + return nil; + s := hd l; + for (l = tl l; l != nil; l = tl l) + s += " " + hd l; + return s; +} + +concatarray(a: array of string): string +{ + if (len a == 0) + return nil; + s := a[0]; + for (i := 1; i < len a; i++) + s += " " + a[i]; + return s; +} diff --git a/appl/spree/engines/othello.b b/appl/spree/engines/othello.b new file mode 100644 index 00000000..2f36c47b --- /dev/null +++ b/appl/spree/engines/othello.b @@ -0,0 +1,242 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + All, None: import Sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member: import spree; +include "objstore.m"; + objstore: Objstore; +include "../gather.m"; + +clique: ref Clique; + +Black, White, Nocolour: con iota; # first two must be 0 and 1. +N: con 8; + +boardobj: ref Object; +board: array of array of int; +pieces: array of int; +turn := Nocolour; +members := array[2] of ref Member; # member ids of those playing + +Point: adt { + x, y: int; + add: fn(p: self Point, p1: Point): Point; + inboard: fn(p: self Point): int; +}; + +clienttype(): string +{ + return "othello"; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + objstore = load Objstore Objstore->PATH; + if (objstore == nil) { + sys->print("othello: cannot load %s: %r", Objstore->PATH); + return "bad module"; + } + objstore->init(srvmod, g); + + return nil; +} + +maxmembers(): int +{ + return 2; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +propose(members: array of string): string +{ + if (len members != 2) + return "need exactly two members"; + return nil; +} + +archive() +{ + objstore->setname(boardobj, "board"); +} + +start(pl: array of ref Member, archived: int) +{ + members = pl; + board = array[N] of {* => array[N] of {* => Nocolour}}; + pieces = array[2] of {* => 0}; + if (archived) { + objstore->unarchive(); + boardobj = objstore->get("board"); + for (i := 0; i < N; i++) { + for (j := 0; j < N; j++) { + a := boardobj.getattr(pt2attr((j, i))); + if (a != nil) { + piece := int a; + board[j][i] = piece; + if (piece != Nocolour) + pieces[piece]++; + } + } + } + turn = int boardobj.getattr("turn"); + } else { + boardobj = clique.newobject(nil, All, nil); + boardobj.setattr("members", string members[Black].name + " " + string members[White].name, All); + for (ps := (Black, (3, 3)) :: (Black, (4, 4)) :: (White, (3, 4)) :: (White, Point(4, 3)) :: nil; + ps != nil; + ps = tl ps) { + (colour, p) := hd ps; + setpiece(colour, p); + } + turn = Black; + boardobj.setattr("turn", string Black, All); + } +} + +cliqueover() +{ + turn = Nocolour; + boardobj.setattr("winner", string winner(), All); + boardobj.setattr("turn", string turn, All); +} + +command(member: ref Member, cmd: string): string +{ + { + (n, toks) := sys->tokenize(cmd, " \n"); + assert(n > 0, "unknown command"); + + case hd toks { + "move" => + assert(n == 3, "bad command usage"); + assert(turn != Nocolour, "clique has finished"); + assert(member == members[White] || member == members[Black], "you are not playing"); + assert(member == members[turn], "it is not your turn"); + p := Point(int hd tl toks, int hd tl tl toks); + assert(p.x >= 0 && p.x < N && p.y >= 0 && p.y < N, "invalid move position"); + assert(board[p.x][p.y] == Nocolour, "position is already occupied"); + assert(newmove(turn, p, 1), "cannot move there"); + + turn = reverse(turn); + if (!canplay()) { + turn = reverse(turn); + if (!canplay()) + cliqueover(); + } + boardobj.setattr("turn", string turn, All); + return nil; + } + sys->print("othello: unknown client command '%s'\n", hd toks); + return "who knows"; + } exception e { + "parse:*" => + return e[6:]; + } +} + +Directions := array[] of {Point(0, 1), (1, 1), (1, 0), (1, -1), (0, -1), (-1, -1), (-1, 0), (-1, 1)}; + +setpiece(colour: int, p: Point) +{ + v := board[p.x][p.y]; + if (v != Nocolour) + pieces[v]--; + board[p.x][p.y] = colour; + pieces[colour]++; + boardobj.setattr(pt2attr(p), string colour, All); +} + +pt2attr(pt: Point): string +{ + s := " "; + s[0] = pt.x + 'a'; + s[1] = pt.y + 'a'; + return s; +} + +# member colour has tried to place a piece at mp. +# return -1 if it's an illegal move, 0 otherwise. +# (in which case appropriate updates are sent out all round). +# if update is 0, just check for the move's validity +# (no change to the board, no updates sent) +newmove(colour: int, mp: Point, update: int): int +{ + totchanged := 0; + for (i := 0; i < len Directions; i++) { + d := Directions[i]; + n := 0; + for (p := mp.add(d); p.inboard(); p = p.add(d)) { + n++; + if (board[p.x][p.y] == colour || board[p.x][p.y] == Nocolour) + break; + } + if (p.inboard() && board[p.x][p.y] == colour && n > 1) { + if (!update) + return 1; + totchanged += n - 1; + for (p = mp.add(d); --n > 0; p = p.add(d)) + setpiece(reverse(board[p.x][p.y]), p); + } + } + if (totchanged > 0) { + setpiece(colour, mp); + return 1; + } + return 0; +} + +# who has most pieces? +winner(): int +{ + if (pieces[White] > pieces[Black]) + return White; + else if (pieces[Black] > pieces[White]) + return Black; + return Nocolour; +} + +# is there any possible legal move? +canplay(): int +{ + for (y := 0; y < N; y++) + for (x := 0; x < N; x++) + if (board[x][y] == Nocolour && newmove(turn, (x, y), 0)) + return 1; + return 0; +} + +reverse(colour: int): int +{ + if (colour == Nocolour) + return Nocolour; + return !colour; +} + +Point.add(p: self Point, p1: Point): Point +{ + return (p.x + p1.x, p.y + p1.y); +} + +Point.inboard(p: self Point): int +{ + return p.x >= 0 && p.x < N && p.y >= 0 && p.y < N; +} + +assert(b: int, err: string) +{ + if (b == 0) + raise "parse:" + err; +} diff --git a/appl/spree/engines/racingdemon.b b/appl/spree/engines/racingdemon.b new file mode 100644 index 00000000..f839e29a --- /dev/null +++ b/appl/spree/engines/racingdemon.b @@ -0,0 +1,464 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, set, A, B, All, None: import sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember, Card: import cardlib; + dTOP, dLEFT, oDOWN, EXPAND, FILLX, FILLY, aCENTRELEFT, Stackspec: import Cardlib; +include "../gather.m"; + +clique: ref Clique; + +CLICK, SAY, SHOW: con iota; +KING: con 12; +NACES: con 7; # number of ace piles to fit across the board. + +Dmember: adt { + pile, + spare1, + spare2: ref Object; + open: array of ref Object; # [4] + acepiles: array of ref Object; +}; +scores: array of int; +scorelabel: ref Object; + +dmembers: array of ref Dmember; + +Openspec := Stackspec( + "display", # style + 4, # maxcards + 0, # conceal + "" # title +); + +Pilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "pile" # title +); + +Untitledpilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "" # title +); + +clienttype(): string +{ + return "cards"; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("whist: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + sets->init(); + + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + + return nil; +} + +maxmembers(): int +{ + return 100; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +propose(members: array of string): string +{ + if (len members < 3) + return "need at least 3 members"; + return nil; +} + +archive() +{ + archiveobj := cardlib->archive(); + allow->archive(archiveobj); + for (i := 0; i < len dmembers; i++) { + dp := dmembers[i]; + s := "d" + string i + "_"; + cardlib->setarchivename(dp.spare1, s + "spare1"); + cardlib->setarchivename(dp.spare2, s + "spare2"); + cardlib->setarchivename(dp.pile, s + "pile"); + cardlib->archivearray(dp.open, s + "open"); + cardlib->archivearray(dp.acepiles, s + "acepiles"); + } + cardlib->setarchivename(scorelabel, "scorelabel"); + s := ""; + for (i = 0; i < len scores; i++) + s += " " + string scores[i]; + archiveobj.setattr("scores", s, None); + +} + +start(members: array of ref Member, archived: int) +{ + if (archived) { + archiveobj := cardlib->unarchive(); + allow->unarchive(archiveobj); + dmembers = array[len members] of ref Dmember; + for (i := 0; i < len dmembers; i++) { + dp := dmembers[i] = ref Dmember; + s := "d" + string i + "_"; + dp.spare1 = cardlib->getarchiveobj(s + "spare1"); + dp.spare2 = cardlib->getarchiveobj(s + "spare2"); + dp.pile = cardlib->getarchiveobj(s + "pile"); + dp.open = cardlib->getarchivearray(s + "open"); + dp.acepiles = cardlib->getarchivearray(s + "acepiles"); + } + scorelabel = cardlib->getarchiveobj("scorelabel"); + s := archiveobj.getattr("scores"); + (n, toks) := sys->tokenize(s, " "); + scores = array[len members] of int; + for (i = 0; toks != nil; toks = tl toks) + scores[i++] = int hd toks; + } else { + pset := None; + for (i := 0; i < len members; i++) { + p := members[i]; + Cmember.join(p, i); + pset = pset.add(p.id); + allow->add(CLICK, p, "click %o %d"); + } + Cmember.index(0).layout.lay.setvisibility(All.X(A&~B, pset).add(members[0].id)); + + layout(); + deal(); + allow->add(SAY, nil, "say &"); + } +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "bad member"; + case tag { + CLICK => + # click stack index + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + d := dmembers[cp.ord]; + if (sel.isempty() || sel.stack == stack) { + # selecting a card to move + if (nc == 0 && stype == "spare1") { + cardlib->flip(d.spare2); + d.spare2.transfer((0, len d.spare2.children), d.spare1, 0); + return nil; + } + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + if (owner(stack) != cp) + return "not yours, don't touch!"; + case stype { + "spare2" or + "pile" => + select(cp, stack, (nc - 1, nc)); + "open" => + select(cp, stack, (idx, nc)); + "spare1" => + if ((n := nc) > 3) + n = 3; + for (i := 0; i < n; i++) { + cardlib->setface(stack.children[nc - 1], 1); + stack.transfer((nc - 1, nc), d.spare2, -1); + nc--; + } + * => + return "you can't move cards from there"; + } + } else { + # selecting a stack to move to. + frompile := sel.stack.getattr("type") == "pile"; + case stype { + "acepile" => + if (sel.r.end != sel.r.start + 1) + return "only one card at a time!"; + card := getcard(sel.stack.children[sel.r.start]); + if (nc == 0) { + if (card.number != 0) + return "aces only"; + } else { + top := getcard(stack.children[nc - 1]); + if (card.number != top.number + 1) + return "out of sequence"; + if (card.suit != top.suit) + return "wrong suit"; + } + sel.transfer(stack, -1); + if (card.number == KING) # kings get flipped + cardlib->setface(stack.children[len stack.children - 1], 0); + "open" => + if (owner(stack) != cp) + return "not yours, don't touch!"; + c := getcard(sel.stack.children[sel.r.start]); + col := !isred(c); + n := c.number + 1; + for (i := sel.r.start; i < sel.r.end; i++) { + c2 := getcard(sel.stack.children[i]); + if (isred(c2) == col) + return "bad colour sequence"; + if (c2.number != n - 1) + return "bad number sequence"; + n = c2.number; + col = isred(c2); + } + if (nc != 0) { + c2 := getcard(stack.children[nc - 1]); + if (isred(c2) == isred(c) || c2.number != c.number + 1) + return "invalid move"; + } + sel.transfer(stack, -1); + * => + return "can't move there"; + } + if (frompile) { + nc = len d.pile.children; + if (nc == 0) { + endround(); + deal(); + } else { + cardlib->setface(d.pile.children[nc - 1], 1); + d.pile.setattr("title", "pile [" + string nc + "]", All); + } + } + } + SAY => + clique.action("say member " + string p.id + ": '" + joinwords(tl toks) + "'", nil, nil, All); + + SHOW => + clique.show(nil); + } + return nil; +} + +getcard(card: ref Object): Card +{ + return cardlib->getcard(card); +} + +isred(c: Card): int +{ + return c.suit == Cardlib->DIAMONDS || c.suit == Cardlib->HEARTS; +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} + +owner(stack: ref Object): ref Cmember +{ + parent := clique.objects[stack.parentid]; + n := cardlib->nmembers(); + for (i := 0; i < n; i++) { + cp := Cmember.index(i); + if (cp.obj == parent) + return cp; + } + return nil; +} + +layout() +{ + n := cardlib->nmembers(); + dmembers = array[n] of ref Dmember; + for (i := 0; i < n; i++) { + cp := Cmember.index(i); + d := dmembers[i] = ref Dmember; + d.spare1 = newstack(cp.obj, Untitledpilespec, "spare1"); + d.spare2 = newstack(cp.obj, Untitledpilespec, "spare2"); + d.pile = newstack(cp.obj, Pilespec, "pile"); + d.open = array[4] of {* => newstack(cp.obj, Openspec, "open")}; + d.acepiles = array[4] of {* => newstack(cp.obj, Untitledpilespec, "acepile")}; + cardlib->makecards(d.spare1, (0, 13), string i); + } + + entry := clique.newobject(nil, All, "widget entry"); + entry.setattr("command", "say", All); + cardlib->addlayobj(nil, nil, nil, dTOP|FILLX, entry); + + scores = array[n] of {* => 0}; + scorelabel = clique.newobject(nil, All, "widget label"); + setscores(); + cardlib->addlayobj(nil, nil, nil, dTOP|FILLX, scorelabel); + + cardlib->addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + row := 0; + col := 0; + maketable("arena"); + for (i = 0; i < n; i++) { + d := dmembers[i]; + f := "p" + string i; + cardlib->addlayobj(nil, f, nil, dLEFT, d.spare1); + cardlib->addlayobj(nil, f, nil, dLEFT, d.spare2); + cardlib->addlayobj(nil, f, nil, dLEFT, d.pile); + for (j := 0; j < len d.open; j++) + cardlib->addlayobj(nil, f, nil, dLEFT|EXPAND|oDOWN, d.open[j]); + for (j = 0; j < len d.acepiles; j++) { + cardlib->addlayobj(nil, "a" + string row, nil, dLEFT|EXPAND, d.acepiles[j]); + if (++col >= NACES) { + col = 0; + row++; + } + } + } +} + +setscores() +{ + s := "Scores: "; + n := cardlib->nmembers(); + for (i := 0; i < n; i++) { + s += Cmember.index(i).p.name + ": " + string scores[i]; + if (i < n - 1) + s[len s] = ' '; + } + scorelabel.setattr("text", s, All); +} + +deal() +{ + n := cardlib->nmembers(); + for (i := 0; i < n; i++) { + cp := Cmember.index(i); + d := dmembers[i]; + deck := d.spare1; + cardlib->shuffle(deck); + deck.transfer((0, 13), d.pile, 0); + cardlib->setface(d.pile.children[12], 1); + d.pile.setattr("title", "pile [13]", All); + for (j := 0; j < len d.open; j++) { + deck.transfer((0, 1), d.open[j], 0); + cardlib->setface(d.open[j].children[0], 1); + } + } +} + +endround() +{ + # go through all the ace piles, moving cards back to the appropriate deck + # and counting appropriately. + # move all other cards back too. + n := cardlib->nmembers(); + for (i := 0; i < n; i++) { + d := dmembers[i]; + Cmember.index(i).sel.set(nil); + for (j := 0; j < len d.acepiles; j++) { + acepile := d.acepiles[j]; + nc := len acepile.children; + for (k := nc - 1; k >= 0; k--) { + card := acepile.children[k]; + back := int card.getattr("rear"); + scores[back]++; + if (getcard(card).number == KING) + scores[back] += 5; + cardlib->setface(card, 0); + acepile.transfer((k, k + 1), dmembers[back].spare1, -1); + } + } + if (len d.pile.children == 0) + scores[i] += 10; # bonus for going out + else + scores[i] -= len d.pile.children; + cardlib->discard(d.pile, d.spare1, 1); + cardlib->discard(d.spare2, d.spare1, 1); + for (j = 0; j < len d.open; j++) + cardlib->discard(d.open[j], d.spare1, 1); + } + setscores(); +} + +maketable(parent: string) +{ + addlayframe: import cardlib; + + n := cardlib->nmembers(); + na := ((n * 4) + (NACES - 1)) / NACES; + for (i := 0; i < n; i++) { + layout := Cmember.index(i).layout; + # one frame for each member other than self; + # then all the ace piles; then self. + for (j := 0; j < n; j++) + if (j != i) + addlayframe("p" + string j, parent, layout, dTOP|EXPAND, dTOP); + for (j = 0; j < na; j++) + addlayframe("a" + string j, parent, layout, dTOP|EXPAND|aCENTRELEFT, dTOP); + addlayframe("p" + string i, parent, layout, dTOP|EXPAND, dTOP); + } +} + +newstack(parent: ref Object, spec: Stackspec, stype: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + return stack; +} + +joinwords(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +remark(s: string) +{ + clique.action("remark " + s, nil, nil, All); +} diff --git a/appl/spree/engines/snap.b b/appl/spree/engines/snap.b new file mode 100644 index 00000000..ff7166cb --- /dev/null +++ b/appl/spree/engines/snap.b @@ -0,0 +1,241 @@ +implement Engine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + publicstack: import cardlib; + VERT, HORIZ, TOP, BOTTOM, LEFT, RIGHT, Stackspec: import Cardlib; + +clique: ref Clique; +PLAY, START, SAY, SNAP: con iota; + +started := 0; + +buttons: ref Object; +scores: ref Object; +deck: ref Object; + +HAND, PILE: con iota; + +hands := array[2] of ref Object; +piles := array[2] of ref Object; + +publicspec: array of Stackspec; + +privatespec := array[] of { + HAND => Stackspec(Cardlib->sPILE, + 52, + 0, + "hand", + HORIZ, + BOTTOM), + PILE => Stackspec(Cardlib->sPILE, + 52, + 0, + "pile", + HORIZ, + TOP), +}; + +oneplayed := 0; # true if only one member's put down a card so far + +MINPLAYERS: con 2; +MAXPLAYERS: con 2; + +clienttype(): string +{ + return "cards"; +} + +init(g: ref Clique, srvmod: Spree): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + allow->add(SAY, nil, "say &"); + + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + + cardlib->init(clique, spree); + deck = clique.newobject(nil, ~0, "stack"); + cardlib->makepack(deck, (0, 52), 1); + cardlib->shuffle(deck); + buttons = clique.newobject(nil, ~0, "buttons"); + scores = clique.newobject(nil, ~0, "scoretable"); + + return nil; +} + +join(p: ref Member): string +{ + sys->print("%s(%d) joining\n", p.name(), p.id); + if (!started && cardlib->nmembers() < MAXPLAYERS) { + (nil, err) := cardlib->join(p, -1); + if (err == nil) { + if (cardlib->nmembers() == MINPLAYERS) { + mkbutton("Start", "start"); + allow->add(START, nil, "start"); + } + } else + sys->print("error on join: %s\n", err); + } + return nil; +} + +leave(p: ref Member) +{ + cardlib->leave(p); + started == 0; + if (cardlib->nmembers() < MINPLAYERS) { + buttons.deletechildren((0, len buttons.children)); + allow->del(START, nil); + } +} + +command(p: ref Member, cmd: string): string +{ + e := ref Sys->Exception; + if (sys->rescue("parse:*", e) == Sys->EXCEPTION) { + sys->rescued(Sys->ONCE, nil); + return e.name[6:]; + } + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + case tag { + START => + buttons.deletechildren((0, len buttons.children)); + allow->del(START, nil); + allow->add(SNAP, nil, "snap"); + mkbutton("Snap!", "snap"); + cardlib->startclique(publicspec, privatespec); + for (i := 0; i < 2; i++) { + hands[i] = cardlib->info(i).stacks[HAND]; + piles[i] = cardlib->info(i).stacks[PILE]; + } + deck.transfer((0, 26), hands[0], 0); + deck.transfer((0, 26), hands[1], 0); + canplay(0); + canplay(1); + + PLAY => + # click index + ord := cardlib->order(p); + inf := cardlib->info(ord); + + hand := hands[ord]; + pile := piles[ord]; + hand.transfer((len hand.children - 1, len hand.children), pile, len pile.children); + cardlib->setface(pile.children[len pile.children - 1], 1); + cantplay(ord); + oneplayed = !oneplayed; + if (!oneplayed || len hands[!ord].children == 0) { + for (i := 0; i < 2; i++) + if (len hands[i].children > 0) + canplay(i); + } + SNAP => + # snap + ord := cardlib->order(p); + inf := cardlib->info(ord); + if (oneplayed) # XXX allow for case where one person has no cards. + return "must wait for two cards to be put down"; + if (len piles[0].children == 0 || len piles[1].children == 0) + return "no cards"; + c0 := cardlib->getcard(piles[0].children[len piles[0].children - 1]); + c1 := cardlib->getcard(piles[1].children[len piles[0].children - 1]); + if (c0.number != c1.number) { + remark(p.name() + " said snap wrongly!"); + return "cards must be the same"; + } else { + transferall(piles[!ord], piles[ord], len piles[ord].children); + flipstack(piles[ord]); + transferall(piles[ord], hands[ord], 0); + if (len hands[!ord].children == 0) + remark(p.name() + " has won!"); + oneplayed = 0; + for (i := 0; i < 2; i++) + if (len hands[i].children > 0) + canplay(i); + else + cantplay(i); + } + SAY => + clique.action("say member " + string p.id + ": '" + joinwords(tl toks) + "'", nil, nil, ~0); + } + return nil; +} + +transferall(stack, into: ref Object, idx: int) +{ + stack.transfer((0, len stack.children), into, idx); +} + +flipstack(stack: ref Object) +{ + for (i := 0; i < len stack.children; i++) { + card := stack.children[i]; + cardlib->setface(card, ! int card.getattr("face")); + } +} + +joinwords(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +canplay(ord: int) +{ + inf := cardlib->info(ord); + allow->del(PLAY, inf.p); + allow->add(PLAY, inf.p, "click %d"); + inf.stacks[HAND].setattr("actions", "click", 1<<inf.p.id); +} + +cantplay(ord: int) +{ + inf := cardlib->info(ord); + allow->del(PLAY, inf.p); + inf.stacks[HAND].setattr("actions", nil, 1<<inf.p.id); +} + +member(ord: int): ref Member +{ + return cardlib->info(ord).p; +} + +remark(s: string) +{ + clique.action("remark " + s, nil, nil, ~0); +} + +mkbutton(text, cmd: string): ref Object +{ + but := clique.newobject(buttons, ~0, "button"); + but.setattr("text", text, ~0); + but.setattr("command", cmd, ~0); + return but; +} diff --git a/appl/spree/engines/spider.b b/appl/spree/engines/spider.b new file mode 100644 index 00000000..08576ff0 --- /dev/null +++ b/appl/spree/engines/spider.b @@ -0,0 +1,259 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + All, None: import Sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember, Card: import cardlib; + getcard: import cardlib; + dTOP, dRIGHT, dLEFT, oRIGHT, oDOWN, + aCENTRERIGHT, aCENTRELEFT, aUPPERRIGHT, aUPPERCENTRE, + EXPAND, FILLX, FILLY, Stackspec: import Cardlib; +include "../gather.m"; + +clique: ref Clique; + +open: array of ref Object; # [10] +deck: ref Object; +discard: ref Object; +dealbutton: ref Object; + +CLICK, MORECARDS: con iota; + +Openspec := Stackspec( + "display", # style + 19, # maxcards + 0, # conceal + "" # title +); + +clienttype(): string +{ + return "cards"; +} + +maxmembers(): int +{ + return 1; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + return nil; +} + +propose(members: array of string): string +{ + if (len members != 1) + return "one member only"; + return nil; +} + +archive() +{ + archiveobj := cardlib->archive(); + allow->archive(archiveobj); + cardlib->archivearray(open, "open"); + cardlib->setarchivename(deck, "deck"); + cardlib->setarchivename(discard, "discard"); + cardlib->setarchivename(dealbutton, "dealbutton"); +} + +start(members: array of ref Member, archived: int) +{ + cardlib->init(spree, clique); + if (archived) { + archiveobj := cardlib->unarchive(); + allow->unarchive(archiveobj); + open = cardlib->getarchivearray("open"); + discard = cardlib->getarchiveobj("discard"); + deck = cardlib->getarchiveobj("deck"); + dealbutton = cardlib->getarchiveobj("dealbutton"); + } else { + p := members[0]; + Cmember.join(p, -1).layout.lay.setvisibility(All); + startclique(); + allow->add(CLICK, p, "click %o %d"); + allow->add(MORECARDS, p, "morecards"); + } +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "you are not playing"; + case tag { + CLICK => + # click stack index + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + if (sel.isempty() || sel.stack == stack) { + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + case stype { + "open" => + select(cp, stack, (idx, nc)); + * => + return "you can't move cards from there"; + } + } else { + from := sel.stack; + case stype { + "open" => + c := getcard(sel.stack.children[sel.r.start]); + n := c.number + 1; + for (i := sel.r.start; i < sel.r.end; i++) { + c2 := getcard(sel.stack.children[i]); + if (c2.face == 0) + return "cannot move face down cards"; + if (c2.number != n - 1) + return "bad number sequence"; + n = c2.number; + } + if (nc != 0) { + c2 := getcard(stack.children[nc - 1]); + if (c2.number != c.number + 1) + return "descending, only"; + } + srcstack := sel.stack; + sel.transfer(stack, -1); + turntop(srcstack); + + nc = len stack.children; + if (nc >= 13) { + c = getcard(stack.children[nc - 1]); + suit := c.suit; + for (i = 0; i < 13; i++) { + c = getcard(stack.children[nc - i - 1]); + if (c.suit != suit || c.number != i) + break; + } + if (i == 13) { + stack.transfer((nc - 13, nc), discard, -1); + turntop(stack); + } + } + * => + return "can't move there"; + } + } + MORECARDS => + for (i := 0; i < 10; i++) + if (len open[i].children == 0) + return "spaces must be filled before redeal"; + for (i = 0; i < 10; i++) { + if (len deck.children == 0) + break; + cp.sel.set(nil); + cardlib->setface(deck.children[0], 1); + deck.transfer((0, 1), open[i], -1); + } + setdealbuttontext(); + } + return nil; +} + +setdealbuttontext() +{ + dealbutton.setattr("text", sys->sprint("deal more (%d left)", len deck.children), All); +} + +turntop(stack: ref Object) +{ + if (len stack.children > 0) + cardlib->setface(stack.children[len stack.children - 1], 1); +} + +startclique() +{ + addlayobj, addlayframe: import cardlib; + open = array[10] of {* => newstack(nil, Openspec, "open", nil)}; + deck = clique.newobject(nil, All, "stack"); + discard = clique.newobject(nil, All, "stack"); + cardlib->makecards(deck, (0, 13), "0"); + cardlib->makecards(deck, (0, 13), "1"); + addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + addlayframe("top", "arena", nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + + for (i := 0; i < 10; i++) + addlayobj(nil, "top", nil, dLEFT|oDOWN|EXPAND|aUPPERCENTRE, open[i]); + addlayframe("bot", "arena", nil, dTOP, dTOP); + dealbutton = newbutton("morecards", "deal more"); + addlayobj(nil, "bot", nil, dLEFT, dealbutton); + deal(); + setdealbuttontext(); +} + +deal() +{ + cardlib->shuffle(deck); + for (i := 0; i < 10; i++) { + deck.transfer((0, 4), open[i], 0); + turntop(open[i]); + } +} + +newstack(parent: ref Object, spec: Stackspec, stype, title: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + stack.setattr("title", title, All); + return stack; +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} + +newbutton(cmd, text: string): ref Object +{ + but := clique.newobject(nil, All, "widget button"); + but.setattr("command", cmd, All); + but.setattr("text", text, All); + return but; +} + diff --git a/appl/spree/engines/spit.b b/appl/spree/engines/spit.b new file mode 100644 index 00000000..2c42cb95 --- /dev/null +++ b/appl/spree/engines/spit.b @@ -0,0 +1,483 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, All, None, A, B: import sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember, Card: import cardlib; + dTOP, dLEFT, dBOTTOM, oDOWN, EXPAND, FILLX, FILLY, aCENTRELEFT, Stackspec: import Cardlib; +include "../gather.m"; + +clique: ref Clique; +CLICK, SPIT, SAY, SHOW: con iota; +playing := 0; +dealt := 0; +deck: ref Object; +buttons: ref Object; +winner: ref Member; + +Dmember: adt { + spare: ref Object; + row: array of ref Object; + centre: ref Object; +}; + +dmembers := array[2] of ref Dmember; + +Openspec := Stackspec( + "display", # style + 4, # maxcards + 0, # conceal + "" # title +); + +Pilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "pile" # title +); + +Untitledpilespec := Stackspec( + "pile", # style + 13, # maxcards + 0, # conceal + "" # title +); + +clienttype(): string +{ + return "cards"; +} + + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("spit: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("spit: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + sets->init(); + + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("spit: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + cardlib->init(spree, clique); + + return nil; +} + +maxmembers(): int +{ + return 2; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +propose(members: array of string): string +{ + if (len members != 2) + return "need exactly two members"; + return nil; +} + +archive() +{ + archiveobj := cardlib->archive(); + allow->archive(archiveobj); + for (i := 0; i < len dmembers; i++) { + dp := dmembers[i]; + s := "d" + string i + "_"; + cardlib->setarchivename(dp.spare, s + "spare"); + cardlib->setarchivename(dp.centre, s + "centre"); + for (j := 0; j < len dp.row; j++) + cardlib->setarchivename(dp.row[j], s + "row" + string j); + } + archiveobj.setattr("playing", string playing, None); + archiveobj.setattr("dealt", string dealt, None); + cardlib->setarchivename(deck, "deck"); +} + +start(members: array of ref Member, archived: int) +{ + cardlib->init(spree, clique); + if (archived) { + archiveobj := cardlib->unarchive(); + allow->unarchive(archiveobj); + playing = int archiveobj.getattr("playing"); + dealt = int archiveobj.getattr("dealt"); + deck = cardlib->getarchiveobj("deck"); + for (i := 0; i < len dmembers; i++) { + dp := dmembers[i] = ref Dmember; + s := "d" + string i + "_"; + dp.spare = cardlib->getarchiveobj(s + "spare"); + dp.centre = cardlib->getarchiveobj(s + "centre"); + dp.row = array[4] of ref Object; + for (j := 0; j < len dp.row; j++) + dp.row[j] = cardlib->getarchiveobj(s + "row" + string j); + } + } else { + buttons = clique.newobject(nil, All, "buttons"); + pset := None; + for (i := 0; i < len members; i++) { + Cmember.join(members[i], i); + pset = pset.add(members[i].id); + } + # member 0 layout visible to member 0 and everyone else but other member. + # could be All.del(members[1].id) but doing it this way extends to many-member cliques. + Cmember.index(0).layout.lay.setvisibility(All.X(A&~B, pset).add(members[0].id)); + layout(); + deal(); + dealt = 1; + playing = 0; + allow->add(SPIT, nil, "spit"); + allow->add(SAY, nil, "say &"); + allow->add(SHOW, nil, "show"); + } +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil){ + if(winner != nil){ + if(winner == p) + return "game has finished: you have won"; + return "game has finished: you have lost"; + } + return err; + } + cp := Cmember.find(p); + if (cp == nil) + return "you're only watching"; + case tag { + SPIT => + if (!dealt) { + deal(); + dealt = 1; + } else if (!playing) { + go(); + allow->add(CLICK, nil, "click %o %d"); + playing = 1; + } else if (!canplay(!cp.ord)) { + go(); + } else + return "it is possible to play"; + + CLICK => + stack := clique.objects[int hd tl toks]; + nc := len stack.children; + idx := int hd tl tl toks; + sel := cp.sel; + stype := stack.getattr("type"); + d := dmembers[cp.ord]; + if (sel.isempty() || sel.stack == stack) { + # selecting a card to move + if (idx < 0 || idx >= len stack.children) + return "invalid index"; + if (owner(stack) != cp) + return "not yours, don't touch!"; + case stype { + "row" => + card := getcard(stack.children[nc - 1]); + if (card.face == 0) + cardlib->setface(stack.children[nc - 1], 1); + else + select(cp, stack, (nc - 1, nc)); + * => + return "you can't move cards from there"; + } + } else { + # selecting a stack to move to. + case stype { + "centre" => + card := getcard(sel.stack.children[sel.r.start]); + onto := getcard(stack.children[nc - 1]); + if ((card.number + 1) % 13 != onto.number && + (card.number + 12) % 13 != onto.number) { + sel.set(nil); + return "out of sequence"; + } + sel.transfer(stack, -1); + for (i := 0; i < len d.row; i++) + if (len d.row[i].children > 0) + break; + if (i == len d.row) { + if (len d.spare.children == 0) { + remark(p.name + " has won"); + winner = p; + allow->del(CLICK, nil); + allow->del(SPIT, nil); + clearsel(); + } else + finish(cp); + } + "row" => + if (owner(stack) != cp) { + sel.set(nil); + return "not yours, don't touch!"; + } + if (nc != 0) { + sel.set(nil); + return "cannot stack cards"; + } + sel.transfer(stack, -1); + * => + sel.set(nil); + return "can't move there"; + } + } + + SAY => + clique.action("say member " + string p.id + ": '" + concat(tl toks) + "'", nil, nil, All); + + SHOW => + clique.show(nil); + } + return nil; +} + +canplay(ord: int): int +{ + d := dmembers[ord]; + nmulti := nfree := 0; + for (j := 0; j < len d.row; j++) { + s1 := d.row[j]; + if (len s1.children > 0) { + nmulti += len s1.children > 1; + card1 := getcard(s1.children[len s1.children - 1]); + for (k := 0; k < 2; k++) { + s2 := dmembers[k].centre; + if (len s2.children > 0) { + card2 := getcard(s2.children[len s2.children - 1]); + if ((card1.number + 1) % 13 == card2.number || + (card1.number + 12) % 13 == card2.number) + return 1; + } + } + } else + nfree++; + } + return nmulti > 0 && nfree > 0; +} + +bottomdiscard(src, dst: ref Object) +{ + cardlib->flip(src); + for (i := 0; i < len src.children; i++) + cardlib->setface(src.children[i], 0); + src.transfer((0, len src.children), dst, 0); +} + +finish(winner: ref Cmember) +{ + loser := dmembers[!winner.ord]; + for (i := 0; i < 2; i++) { + d := dmembers[i]; + bottomdiscard(d.centre, loser.spare); + for (j := 0; j < len d.row; j++) + bottomdiscard(d.row[j], loser.spare); + } + playing = 0; + dealt = 0; + allow->del(CLICK, nil); + allow->add(SPIT, nil, "spit"); + clearsel(); +} + +go() +{ + for (i := 0; i < 2; i++) { + d := dmembers[i]; + n := len d.spare.children; + if (n > 0) + d.spare.transfer((n - 1, n), d.centre, -1); + else if ((m := len dmembers[!i].spare.children) > 0) + dmembers[!i].spare.transfer((m - 1, m), d.centre, -1); + else { + # both members' spare piles are used up; use central piles instead + for (j := 0; j < 2; j++) { + cardlib->discard(dmembers[j].centre, dmembers[j].spare, 0); + cardlib->flip(dmembers[j].spare); + } + go(); + return; + } + cardlib->setface(d.centre.children[len d.centre.children - 1], 1); + } +} + +getcard(card: ref Object): Card +{ + return cardlib->getcard(card); +} + +select(cp: ref Cmember, stack: ref Object, r: Range) +{ + if (cp.sel.isempty()) { + cp.sel.set(stack); + cp.sel.setrange(r); + } else { + if (cp.sel.r.start == r.start && cp.sel.r.end == r.end) + cp.sel.set(nil); + else + cp.sel.setrange(r); + } +} + +owner(stack: ref Object): ref Cmember +{ + parent := clique.objects[stack.parentid]; + n := cardlib->nmembers(); + for (i := 0; i < n; i++) { + cp := Cmember.index(i); + if (cp.obj == parent) + return cp; + } + return nil; +} + +layout() +{ + for (i := 0; i < 2; i++) { + cp := Cmember.index(i); + d := dmembers[i] = ref Dmember; + d.spare = newstack(cp.obj, Untitledpilespec, "spare"); + d.row = array[4] of {* => newstack(cp.obj, Openspec, "row")}; + d.centre = newstack(cp.obj, Untitledpilespec, "centre"); + } + deck = clique.newobject(nil, All, "stack"); + cardlib->makecards(deck, (0, 13), "0"); + cardlib->shuffle(deck); + + entry := clique.newobject(nil, All, "widget entry"); + entry.setattr("command", "say", All); + cardlib->addlayobj(nil, nil, nil, dTOP|FILLX, entry); + + cardlib->addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + maketable("arena"); + spitbutton := newbutton("spit", "Spit!"); + for (i = 0; i < 2; i++) { + d := dmembers[i]; + f := "p" + string i; + + subf := "f" + string i; + cardlib->addlayframe(subf, f, nil, dLEFT, dTOP); + cardlib->addlayobj(nil, subf, Cmember.index(i).layout, dTOP, spitbutton); + cardlib->addlayobj(nil, subf, nil, dTOP, d.spare); + for (j := 0; j < len d.row; j++) + cardlib->addlayobj(nil, f, nil, dLEFT|EXPAND|oDOWN, d.row[j]); + cardlib->addlayobj(nil, "centre", nil, dLEFT|EXPAND, d.centre); + } +} + +newbutton(cmd, text: string): ref Object +{ + but := clique.newobject(nil, All, "widget button"); + but.setattr("command", cmd, All); + but.setattr("text", text, All); + return but; +} + +settopface(stack: ref Object, face: int) +{ + n := len stack.children; + if (n > 0) + cardlib->setface(stack.children[n - 1], face); +} + +transfertop(src, dst: ref Object, index: int) +{ + n := len src.children; + src.transfer((n - 1, n), dst, index); +} + +deal() +{ + clearsel(); + n := len deck.children; + if (n > 0) { + deck.transfer((0, n / 2), dmembers[0].spare, 0); + deck.transfer((0, len deck.children), dmembers[1].spare, 0); + } + + for (i := 0; i < 2; i++) { + d := dmembers[i]; +loop: for (j := 0; j < len d.row; j++) { + for (k := j; k < len d.row; k++) { + if (len d.spare.children == 0) + break loop; + transfertop(d.spare, d.row[k], -1); + } + } + for (j = 0; j < len d.row; j++) + settopface(d.row[j], 1); + } +} + +maketable(parent: string) +{ + addlayframe: import cardlib; + + for (i := 0; i < 2; i++) { + layout := Cmember.index(i).layout; + addlayframe("p" + string !i, parent, layout, dTOP|EXPAND, dBOTTOM); + addlayframe("p" + string i, parent, layout, dBOTTOM|EXPAND, dTOP); + addlayframe("centre", parent, layout, dTOP|EXPAND, dTOP); + } +} + +newstack(parent: ref Object, spec: Stackspec, stype: string): ref Object +{ + stack := cardlib->newstack(parent, nil, spec); + stack.setattr("type", stype, None); + stack.setattr("actions", "click", All); + return stack; +} + +concat(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +remark(s: string) +{ + clique.action("remark " + s, nil, nil, All); +} + +clearsel() +{ + n := cardlib->nmembers(); + for (i := 0; i < n; i++) + Cmember.index(i).sel.set(nil); +} diff --git a/appl/spree/engines/whist.b b/appl/spree/engines/whist.b new file mode 100644 index 00000000..ca0c26f9 --- /dev/null +++ b/appl/spree/engines/whist.b @@ -0,0 +1,305 @@ +implement Gatherengine; + +include "sys.m"; + sys: Sys; +include "draw.m"; +include "sets.m"; + sets: Sets; + Set, All, None, A, B: import sets; +include "../spree.m"; + spree: Spree; + Attributes, Range, Object, Clique, Member, rand: import spree; +include "allow.m"; + allow: Allow; +include "cardlib.m"; + cardlib: Cardlib; + Selection, Cmember: import cardlib; + dTOP, dLEFT, oRIGHT, EXPAND, FILLX, FILLY, Stackspec: import Cardlib; +include "tricks.m"; + tricks: Tricks; + Trick: import tricks; +include "../gather.m"; + +clique: ref Clique; +CLICK, SAY: con iota; + +scores: ref Object; +deck, pile: ref Object; +hands, taken: array of ref Object; +leader, turn: ref Cmember; +trick: ref Trick; + +Trickpilespec := Stackspec( + "display", # style + 4, # maxcards + 0, # conceal + "trick pile" # title +); + +Handspec := Stackspec( + "display", + 13, + 1, + "" +); + +Takenspec := Stackspec( + "pile", + 52, + 0, + "tricks" +); + +clienttype(): string +{ + return "cards"; +} + +init(srvmod: Spree, g: ref Clique, nil: list of string, nil: int): string +{ + sys = load Sys Sys->PATH; + clique = g; + spree = srvmod; + + allow = load Allow Allow->PATH; + if (allow == nil) { + sys->print("whist: cannot load %s: %r\n", Allow->PATH); + return "bad module"; + } + allow->init(spree, clique); + + sets = load Sets Sets->PATH; + if (sets == nil) { + sys->print("spit: cannot load %s: %r\n", Sets->PATH); + return "bad module"; + } + sets->init(); + + cardlib = load Cardlib Cardlib->PATH; + if (cardlib == nil) { + sys->print("whist: cannot load %s: %r\n", Cardlib->PATH); + return "bad module"; + } + + tricks = load Tricks Tricks->PATH; + if (tricks == nil) { + sys->print("hearts: cannot load %s: %r\n", Tricks->PATH); + return "bad module"; + } + + return nil; +} + +maxmembers(): int +{ + return 4; +} + +readfile(nil: int, nil: big, nil: int): array of byte +{ + return nil; +} + +propose(members: array of string): string +{ + if (len members < 2) + return "need at least two members"; + if (len members > 4) + return "too many members"; + return nil; +} + +archive() +{ + archiveobj := cardlib->archive(); + allow->archive(archiveobj); + + cardlib->setarchivename(scores, "scores"); + cardlib->setarchivename(deck, "deck"); + cardlib->setarchivename(pile, "pile"); + cardlib->archivearray(hands, "hands"); + cardlib->archivearray(taken, "taken"); + if (leader != nil) + archiveobj.setattr("leader", string leader.ord, None); + if (turn != nil) + archiveobj.setattr("turn", string turn.ord, None); + trick.archive(archiveobj, "trick"); +} + +start(members: array of ref Member, archived: int) +{ + cardlib->init(spree, clique); + tricks->init(spree, clique, cardlib); + if (archived) { + archiveobj := cardlib->unarchive(); + allow->unarchive(archiveobj); + + scores = cardlib->getarchiveobj("scores"); + deck = cardlib->getarchiveobj("deck"); + pile = cardlib->getarchiveobj("pile"); + hands = cardlib->getarchivearray("hands"); + taken = cardlib->getarchivearray("taken"); + + o := archiveobj.getattr("leader"); + if (o != nil) + leader = Cmember.index(int o); + o = archiveobj.getattr("turn"); + if (o != nil) + turn = Cmember.index(int o); + trick = Trick.unarchive(archiveobj, "trick"); + } else { + pset := None; + for (i := 0; i < len members; i++) { + Cmember.join(members[i], i); + pset = pset.add(members[i].id); + } + # member 0 layout visible to member 0 and everyone else but other member. + # could be All.del(members[1].id) but doing it this way extends to many-member cliques. + Cmember.index(0).layout.lay.setvisibility(All.X(A&~B, pset).add(members[0].id)); + deck = clique.newobject(nil, All, "stack"); + cardlib->makecards(deck, (0, 13), nil); + cardlib->shuffle(deck); + scores = clique.newobject(nil, All, "scoretable"); + startclique(); + n := cardlib->nmembers(); + leader = Cmember.index(rand(n)); + starthand(); + titles := ""; + for (i = 0; i < n; i++) + titles += members[i].name + " "; + clique.newobject(scores, All, "score").setattr("score", titles, All); + } +} + +command(p: ref Member, cmd: string): string +{ + (err, tag, toks) := allow->action(p, cmd); + if (err != nil) + return err; + cp := Cmember.find(p); + if (cp == nil) + return "you're only watching"; + case tag { + CLICK => + # click stackid index + stack := p.obj(int hd tl toks); + if (stack != trick.hands[cp.ord]) + return "not yours"; + err = trick.play(cp.ord, int hd tl tl toks); + if (err != nil) + return err; + + turn = turn.next(1); + if (turn == leader) { # come full circle + winner := Cmember.index(trick.winner); + remark(sys->sprint("%s won the trick", winner.p.name)); + cardlib->discard(pile, taken[winner.ord], 0); + nmembers := cardlib->nmembers(); + taken[winner.ord].setattr("title", + string (len taken[winner.ord].children / nmembers) + + " tricks", All); + o := winner.obj; + trick = nil; + s := ""; + for (i := 0; i < nmembers; i++) { + if (i == winner.ord) + s += "1 "; + else + s += "0 "; + } + clique.newobject(scores, All, "score").setattr("score", s, All); + if (len hands[winner.ord].children > 0) { + leader = turn = winner; + trick = Trick.new(pile, -1, hands, nil); + } else { + remark("one round down, some to go"); + leader = turn = nil; # XXX this round over + } + } + canplay(turn); + SAY => + clique.action("say member " + string p.id + ": '" + joinwords(tl toks) + "'", nil, nil, All); + } + return nil; +} + +startclique() +{ + entry := clique.newobject(nil, All, "widget entry"); + entry.setattr("command", "say", All); + cardlib->addlayobj("entry", nil, nil, dTOP|FILLX, entry); + cardlib->addlayframe("arena", nil, nil, dTOP|EXPAND|FILLX|FILLY, dTOP); + cardlib->maketable("arena"); + + pile = cardlib->newstack(nil, nil, Trickpilespec); + cardlib->addlayobj(nil, "public", nil, dTOP|oRIGHT, pile); + n := cardlib->nmembers(); + hands = array[n] of ref Object; + taken = array[n] of ref Object; + tt := clique.newobject(nil, All, "widget menu"); + tt.setattr("text", "hello", All); + for (ml := "one" :: "two" :: "three" :: nil; ml != nil; ml = tl ml) { + o := clique.newobject(tt, All, "menuentry"); + o.setattr("text", hd ml, All); + o.setattr("command", hd ml, All); + } + for (i := 0; i < n; i++) { + cp := Cmember.index(i); + hands[i] = cardlib->newstack(cp.obj, cp.p, Handspec); + taken[i] = cardlib->newstack(cp.obj, cp.p, Takenspec); + p := "p" + string i; + cardlib->addlayframe(p + ".f", p, nil, dLEFT|oRIGHT, dTOP); + cardlib->addlayobj(nil, p + ".f", cp.layout, dTOP, tt); + cardlib->addlayobj(nil, p + ".f", nil, dTOP, hands[i]); + cardlib->addlayobj(nil, "p" + string i, nil, dLEFT|oRIGHT, taken[i]); + } +} + +joinwords(v: list of string): string +{ + if (v == nil) + return nil; + s := hd v; + for (v = tl v; v != nil; v = tl v) + s += " " + hd v; + return s; +} + +suitrank := array[] of { + Cardlib->CLUBS => 0, + Cardlib->DIAMONDS => 1, + Cardlib->SPADES => 2, + Cardlib->HEARTS => 3 +}; + +starthand() +{ + cardlib->deal(deck, 13, hands, 0); + for (i := 0; i < len hands; i++) + cardlib->sort(hands[i], nil, suitrank); + trick = Trick.new(pile, -1, hands, nil); + turn = leader; + canplay(turn); +} + +canplay(cp: ref Cmember) +{ + allow->del(CLICK, nil); + for (i := 0; i < cardlib->nmembers(); i++) { + ccp := Cmember.index(i); + v := None.add(ccp.p.id); + ccp.obj.setattr("status", nil, v); + hands[i].setattr("actions", nil, v); + } + if (cp != nil && cp.ord != -1) { + allow->add(CLICK, cp.p, "click %d %d"); + v := None.add(cp.p.id); + cp.obj.setattr("status", "Your turn", v); + hands[cp.ord].setattr("actions", "click", v); + } +} + +remark(s: string) +{ + clique.action("remark " + s, nil, nil, All); +} |