ref: a8083462e62459b2ae8a243dc4ba88416eba03b1
dir: /appl/spree/engines/racingdemon.b/
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);
}