ref: f1eaa84bca784511be2b98c4f82a858c42110b4d
dir: /appl/spree/lib/cardlib.b/
implement Cardlib; 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 "objstore.m"; objstore: Objstore; include "cardlib.m"; MAXPLAYERS: con 4; Layobject: adt { lay: ref Object; name: string; packopts: int; pick { Obj => obj: ref Object; # nil if it's a frame Frame => facing: int; # only valid if for frames } }; clique: ref Clique; cmembers: array of ref Cmember; cpids := array[8] of list of ref Cmember; # XXX first string is unnecessary as it's held in the Layobject anyway? layouts := array[17] of list of (string, ref Layout, ref Layobject); maxlayid := 1; cmemberid := 1; archiveobjs: array of list of (string, ref Object); defaultrank := array[13] of {12, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11}; defaultsuitrank := array[] of {CLUBS => 0, DIAMONDS => 1, HEARTS => 2, SPADES => 3}; table := array[] of { 0 => array[] of { (-1, dTOP|EXPAND, dBOTTOM, dTOP), }, 1 => array [] of { (0, dBOTTOM|FILLX, dBOTTOM, dTOP), (-1, dTOP|EXPAND, dBOTTOM, dTOP), }, 2 => array[] of { (0, dBOTTOM|FILLX, dBOTTOM, dTOP), (1, dTOP|FILLX, dTOP, dBOTTOM), (-1, dTOP|EXPAND, dBOTTOM, dTOP) }, 3 => array[] of { (2, dRIGHT|FILLY, dRIGHT, dLEFT), (0, dBOTTOM|FILLX, dBOTTOM, dTOP), (1, dTOP|FILLX, dTOP, dBOTTOM), (-1, dRIGHT|EXPAND, dBOTTOM, dTOP) }, 4 => array[] of { (1, dLEFT|FILLY, dLEFT, dRIGHT), (3, dRIGHT|FILLY, dRIGHT, dLEFT), (0, dBOTTOM|FILLX, dBOTTOM, dTOP), (2, dTOP|FILLX, dTOP, dBOTTOM), (-1, dRIGHT|EXPAND, dBOTTOM, dTOP) }, }; init(mod: Spree, g: ref Clique) { sys = load Sys Sys->PATH; sets = load Sets Sets->PATH; if (sets == nil) panic(sys->sprint("cannot load %s: %r", Sets->PATH)); objstore = load Objstore Objstore->PATH; if (objstore == nil) panic(sys->sprint("cannot load %s: %r", Objstore->PATH)); objstore->init(mod, g); clique = g; spree = mod; } archive(): ref Object { for (i := 0; i < len cmembers; i++) { cp := cmembers[i]; setarchivename(cp.obj, "member" + string i); setarchivename(cp.layout.lay, "layout" + string i); sel := cp.sel; if (sel.stack != nil) setarchivename(sel.stack, "sel" + string i); } for (i = 0; i < len layouts; i++) { for (ll := layouts[i]; ll != nil; ll = tl ll) { (name, lay, layobj) := hd ll; if (name != nil) layobj.lay.setattr("layname", name, None); pick l := layobj { Frame => l.lay.setattr("facing", sides[l.facing], None); Obj => setarchivename(l.obj, "layid" + l.obj.getattr("layid")); } } } # XXX should archive layouts that aren't particular to a member. archiveobj := clique.newobject(nil, None, "archive"); setarchivename(archiveobj, "archive"); archiveobj.setattr("maxlayid", string maxlayid, None); archiveobj.setattr("cmemberid", string cmemberid, None); return archiveobj; } setarchivename(o: ref Object, name: string) { objstore->setname(o, name); } getarchiveobj(name: string): ref Object { return objstore->get(name); } archivearray(a: array of ref Object, name: string) { for (i := 0; i < len a; i++) objstore->setname(a[i], name + string i); } getarchivearray(name: string): array of ref Object { l: list of ref Object; for (i := 0; ; i++) { o := objstore->get(name + string i); if (o == nil) break; l = o :: l; } a := array[i] of ref Object; for (; l != nil; l = tl l) a[--i] = hd l; return a; } unarchive(): ref Object { objstore->unarchive(); archiveobj := getarchiveobj("archive"); cpl: list of ref Cmember; for (i := 0; (o := getarchiveobj("member" + string i)) != nil; i++) { cp := ref Cmember( i, int o.getattr("id"), clique.membernamed(o.getattr("name")), o, ref Layout(getarchiveobj("layout" + string i)), ref Selection(getarchiveobj("sel" + string i), -1, 1, (0, 0), nil) ); cp.sel.ownerid = cp.id; sel := cp.sel; if (sel.stack != nil && (selstr := sel.stack.getattr("sel")) != nil) { (n, val) := sys->tokenize(selstr, " "); if (tl val != nil && hd tl val == "-") (sel.r.start, sel.r.end) = (int hd val, int hd tl tl val); else { idxl: list of int; sel.isrange = 0; for (; val != nil; val = tl val) idxl = int hd val :: idxl; sel.idxl = idxl; } } lay := cp.layout.lay; # there should be exactly one child, of type "layframe" if (len lay.children != 1 || lay.children[0].objtype != "layframe") panic("invalid layout"); x := strhash(nil, len layouts); layouts[x] = (nil, cp.layout, obj2layobj(lay.children[0])) :: layouts[x]; unarchivelayoutobj(cp.layout, lay.children[0]); cpl = cp :: cpl; } cmembers = array[len cpl] of ref Cmember; for (; cpl != nil; cpl = tl cpl) { cp := hd cpl; cmembers[cp.ord] = cp; idx := cp.id % len cpids; cpids[idx] = cp :: cpids[idx]; } maxlayid = int archiveobj.getattr("maxlayid"); cmemberid = int archiveobj.getattr("cmemberid"); return archiveobj; } unarchivelayoutobj(layout: ref Layout, o: ref Object) { for (i := 0; i < len o.children; i++) { child := o.children[i]; layobj := obj2layobj(child); if (layobj.name != nil) { x := strhash(layobj.name, len layouts); layouts[x] = (layobj.name, layout, layobj) :: layouts[x]; } if (tagof(layobj) == tagof(Layobject.Frame)) unarchivelayoutobj(layout, child); } } obj2layobj(o: ref Object): ref Layobject { case o.objtype { "layframe" => return ref Layobject.Frame( o, o.getattr("layname"), s2packopts(o.getattr("opts")), searchopt(sides, o.getattr("facing")) ); "layobj" => return ref Layobject.Obj( o, o.getattr("layname"), s2packopts(o.getattr("opts")), getarchiveobj("layid" + o.getattr("layid")) ); * => panic("invalid layobject found, of type '" + o.objtype + "'"); return nil; } } Cmember.join(member: ref Member, ord: int): ref Cmember { cmembers = (array[len cmembers + 1] of ref Cmember)[0:] = cmembers; if (ord == -1) ord = len cmembers - 1; else { cmembers[ord + 1:] = cmembers[ord:len cmembers - 1]; for (i := ord + 1; i < len cmembers; i++) cmembers[i].ord = i; } cp := cmembers[ord] = ref Cmember(ord, cmemberid++, member, nil, nil, nil); cp.obj = clique.newobject(nil, All, "member"); cp.obj.setattr("id", string cp.id, All); cp.obj.setattr("name", member.name, All); cp.obj.setattr("you", string cp.id, None.add(member.id)); cp.obj.setattr("cliquetitle", clique.fname, All); cp.layout = newlayout(cp.obj, None.add(member.id)); cp.sel = ref Selection(nil, cp.id, 1, (0, 0), nil); idx := cp.id % len cpids; cpids[idx] = cp :: cpids[idx]; return cp; } Cmember.find(p: ref Member): ref Cmember { id := p.id; for (i := 0; i < len cmembers; i++) if (cmembers[i].p.id == id) return cmembers[i]; return nil; } Cmember.index(ord: int): ref Cmember { if (ord < 0 || ord >= len cmembers) return nil; return cmembers[ord]; } Cmember.next(cp: self ref Cmember, fwd: int): ref Cmember { if (!fwd) return cp.prev(1); x := cp.ord + 1; if (x >= len cmembers) x = 0; return cmembers[x]; } Cmember.prev(cp: self ref Cmember, fwd: int): ref Cmember { if (!fwd) return cp.next(1); x := cp.ord - 1; if (x < 0) x = len cmembers - 1; return cmembers[x]; } Cmember.leave(cp: self ref Cmember) { ord := cp.ord; cmembers[ord] = nil; cmembers[ord:] = cmembers[ord + 1:]; cmembers[len cmembers - 1] = nil; cmembers = cmembers[0:len cmembers - 1]; for (i := ord; i < len cmembers; i++) cmembers[i].ord = i; cp.obj.delete(); dellayout(cp.layout); cp.layout = nil; idx := cp.id % len cpids; l: list of ref Cmember; ll := cpids[idx]; for (; ll != nil; ll = tl ll) if (hd ll != cp) l = hd ll :: l; cpids[idx] = l; cp.ord = -1; } Cmember.findid(id: int): ref Cmember { for (l := cpids[id % len cpids]; l != nil; l = tl l) if ((hd l).id == id) return hd l; return nil; } newstack(parent: ref Object, owner: ref Member, spec: Stackspec): ref Object { vis := All; if (spec.conceal) { vis = None; if (owner != nil) vis = vis.add(owner.id); } o := clique.newobject(parent, vis, "stack"); o.setattr("maxcards", string spec.maxcards, All); o.setattr("style", spec.style, All); # XXX provide some means for this to contain the member's name? o.setattr("title", spec.title, All); return o; } makecard(deck: ref Object, c: Card, rear: string): ref Object { card := clique.newobject(deck, None, "card"); card.setattr("face", string c.face, All); vis := None; if(c.face) vis = All; card.setattr("number", string (c.number * 4 + c.suit), vis); if (rear != nil) card.setattr("rear", rear, All); return card; } makecards(deck: ref Object, r: Range, rear: string) { for (i := r.start; i < r.end; i++) for(suit := 0; suit < 4; suit++) makecard(deck, (suit, i, 0), rear); } # deal n cards to each member, if possible. # deal in chunks for efficiency. # if accuracy is required (e.g. dealing from an unshuffled # deck containing known cards) then this'll have to change. deal(deck: ref Object, n: int, stacks: array of ref Object, first: int) { ncards := len deck.children; ord := 0; permember := n; leftover := 0; if (n * len stacks > ncards) { # if trying to deal more cards than we've got, # deal all that we've got, distributing the remainder fairly. permember = ncards / len stacks; leftover = ncards % len stacks; } for (i := 0; i < len stacks; i++) { n = permember; if (leftover > 0) { n++; leftover--; } priv := stacks[(first + i) % len stacks]; deck.transfer((ncards - n, ncards), priv, len priv.children); priv.setattr("n", string (int priv.getattr("n") + n), All); # make cards visible to member for (j := len priv.children - n; j < len priv.children; j++) setface(priv.children[j], 1); ncards -= n; } } setface(card: ref Object, face: int) { # XXX check parent stack style and if it's a pile, # only expose a face up card at the top. card.setattr("face", string face, All); if (face) card.setattrvisibility("number", All); else card.setattrvisibility("number", None); } nmembers(): int { return len cmembers; } getcard(card: ref Object): Card { n := int card.getattr("number"); (suit, num) := (n % 4, n / 4); return Card(suit, num, int card.getattr("face")); } getcards(stack: ref Object): array of Card { a := array[len stack.children] of Card; for (i := 0; i < len a; i++) a[i] = getcard(stack.children[i]); return a; } discard(stk, pile: ref Object, facedown: int) { n := len stk.children; if (facedown) for (i := 0; i < n; i++) setface(stk.children[i], 0); stk.transfer((0, n), pile, len pile.children); } # shuffle children into a random order. first we make all the children # invisible (which will cause them to be deleted in the clients) then # shuffle to our heart's content, and make visible again... shuffle(o: ref Object) { ovis := o.visibility; o.setvisibility(None); a := o.children; n := len a; for (i := 0; i < n; i++) { j := i + rand(n - i); (a[i], a[j]) = (a[j], a[i]); } o.setvisibility(ovis); } sort(o: ref Object, rank, suitrank: array of int) { if (rank == nil) rank = defaultrank; if (suitrank == nil) suitrank = defaultsuitrank; ovis := o.visibility; o.setvisibility(None); cardmergesort(o.children, array[len o.children] of ref Object, rank, suitrank); o.setvisibility(ovis); } cardcmp(a, b: ref Object, rank, suitrank: array of int): int { c1 := getcard(a); c2 := getcard(b); if (suitrank[c1.suit] != suitrank[c2.suit]) return suitrank[c1.suit] - suitrank[c2.suit]; return rank[c1.number] - rank[c2.number]; } cardmergesort(a, b: array of ref Object, rank, suitrank: array of int) { r := len a; if (r > 1) { m := (r-1)/2 + 1; cardmergesort(a[0:m], b[0:m], rank, suitrank); cardmergesort(a[m:], b[m:], rank, suitrank); b[0:] = a; for ((i, j, k) := (0, m, 0); i < m && j < r; k++) { if (cardcmp(b[i], b[j], rank, suitrank) > 0) 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]; } } # reverse and flip all cards in stack. flip(stack: ref Object) { ovis := stack.visibility; stack.setvisibility(None); a := stack.children; (n, m) := (len a, len a / 2); for (i := 0; i < m; i++) { j := n - i - 1; (a[i], a[j]) = (a[j], a[i]); } for (i = 0; i < n; i++) setface(a[i], !int a[i].getattr("face")); stack.setvisibility(ovis); } selection(stack: ref Object): ref Selection { if ((owner := stack.getattr("owner")) != nil && (cp := Cmember.findid(int owner)) != nil) return cp.sel; return nil; } Selection.set(sel: self ref Selection, stack: ref Object) { if (stack == sel.stack) return; if (stack != nil) { oldowner := stack.getattr("owner"); if (oldowner != nil) { oldcp := Cmember.findid(int oldowner); if (oldcp != nil) oldcp.sel.set(nil); } } if (sel.stack != nil) sel.stack.setattr("owner", nil, All); sel.stack = stack; sel.isrange = 1; sel.r = (0, 0); sel.idxl = nil; setsel(sel); } Selection.setexcl(sel: self ref Selection, stack: ref Object): int { if (stack != nil && (oldowner := stack.getattr("owner")) != nil) if ((cp := Cmember.findid(int oldowner)) != nil && !cp.sel.isempty()) return 0; sel.set(stack); return 1; } Selection.owner(sel: self ref Selection): ref Cmember { return Cmember.findid(sel.ownerid); } Selection.setrange(sel: self ref Selection, r: Range) { if (!sel.isrange) { sel.idxl = nil; sel.isrange = 1; } sel.r = r; setsel(sel); } Selection.addindex(sel: self ref Selection, i: int) { if (sel.isrange) { sel.r = (0, 0); sel.isrange = 0; } ll: list of int; for (l := sel.idxl; l != nil; l = tl l) { if (hd l >= i) break; ll = hd l :: ll; } if (l != nil && hd l == i) return; l = i :: l; for (; ll != nil; ll = tl ll) l = hd ll :: l; sel.idxl = l; setsel(sel); } Selection.delindex(sel: self ref Selection, i: int) { if (sel.isrange) { sys->print("cardlib: delindex from range-type selection\n"); return; } ll: list of int; for (l := sel.idxl; l != nil; l = tl l) { if (hd l == i) { l = tl l; break; } ll = hd l :: ll; } for (; ll != nil; ll = tl ll) l = hd ll :: l; sel.idxl = l; setsel(sel); } Selection.isempty(sel: self ref Selection): int { if (sel.stack == nil) return 1; if (sel.isrange) return sel.r.start == sel.r.end; return sel.idxl == nil; } Selection.isset(sel: self ref Selection, index: int): int { if (sel.isrange) return index >= sel.r.start && index < sel.r.end; for (l := sel.idxl; l != nil; l = tl l) if (hd l == index) return 1; return 0; } Selection.transfer(sel: self ref Selection, dst: ref Object, index: int) { if (sel.isempty()) return; src := sel.stack; if (sel.isrange) { r := sel.r; sel.set(nil); src.transfer(r, dst, index); } else { if (sel.stack == dst) { sys->print("cardlib: cannot move multisel to same stack\n"); return; } xl := l := sel.idxl; sel.set(nil); rl: list of Range; for (; l != nil; l = tl l) { r := Range(hd l, hd l); last := l; # concatenate adjacent items, for efficiency. for (l = tl l; l != nil; (last, l) = (l, tl l)) { if (hd l != r.end + 1) break; r.end = hd l; } rl = (r.start, r.end + 1) :: rl; l = last; } # do ranges in reverse, so that later ranges # aren't affected by earlier ones. if (index == -1) index = len dst.children; for (; rl != nil; rl = tl rl) src.transfer(hd rl, dst, index); } } setsel(sel: ref Selection) { if (sel.stack == nil) return; s := ""; if (sel.isrange) { if (sel.r.end > sel.r.start) s = string sel.r.start + " - " + string sel.r.end; } else { if (sel.idxl != nil) { s = string hd sel.idxl; for (l := tl sel.idxl; l != nil; l = tl l) s += " " + string hd l; } } if (s != nil) sel.stack.setattr("owner", string sel.owner().id, All); else sel.stack.setattr("owner", nil, All); vis := None.add(sel.owner().p.id); sel.stack.setattr("sel", s, vis); sel.stack.setattrvisibility("sel", vis); } newlayout(parent: ref Object, vis: Set): ref Layout { l := ref Layout(clique.newobject(parent, vis, "layout")); x := strhash(nil, len layouts); layobj := ref Layobject.Frame(nil, "", dTOP|EXPAND|FILLX|FILLY, dTOP); layobj.lay = clique.newobject(l.lay, All, "layframe"); layobj.lay.setattr("opts", packopts2s(layobj.packopts), All); layouts[x] = (nil, l, layobj) :: layouts[x]; # sys->print("[%d] => ('%s', %ux, %ux) (new layout)\n", x, "", l, layobj); return l; } addlayframe(name, parent: string, layout: ref Layout, packopts: int, facing: int) { # sys->print("addlayframe('%s', %ux, name: %s\n", parent, layout, name); addlay(parent, layout, ref Layobject.Frame(nil, name, packopts, facing)); } addlayobj(name, parent: string, layout: ref Layout, packopts: int, obj: ref Object) { # sys->print("addlayobj('%s', %ux, name: %s, obj %d\n", parent, layout, name, obj.id); addlay(parent, layout, ref Layobject.Obj(nil, name, packopts, obj)); } addlay(parent: string, layout: ref Layout, layobj: ref Layobject) { a := layouts; name := layobj.name; x := strhash(name, len a); added := 0; for (nl := a[strhash(parent, len a)]; nl != nil; nl = tl nl) { (s, lay, parentlay) := hd nl; if (s == parent && (layout == nil || layout == lay)) { pick p := parentlay { Obj => sys->fprint(sys->fildes(2), "cardlib: cannot add layout to non-frame: %d\n", p.obj.id); Frame => nlayobj := copylayobj(layobj); nlayobj.packopts = packoptsfacing(nlayobj.packopts, p.facing); o: ref Object; pick lo := nlayobj { Obj => o = clique.newobject(p.lay, All, "layobj"); id := lo.obj.getattr("layid"); if (id == nil) { id = string maxlayid++; lo.obj.setattr("layid", id, All); } o.setattr("layid", id, All); Frame => o = clique.newobject(p.lay, All, "layframe"); lo.facing = (lo.facing + p.facing) % 4; } o.setattr("opts", packopts2s(nlayobj.packopts), All); nlayobj.lay = o; if (name != nil) a[x] = (name, lay, nlayobj) :: a[x]; added++; } } } if (added == 0) sys->print("no parent found, adding '%s', parent '%s', layout %ux\n", layobj.name, parent, layout); # sys->print("%d new entries\n", added); } maketable(parent: string) { # make a table for all current members. plcount := len cmembers; packopts := table[plcount]; for (i := 0; i < plcount; i++) { layout := cmembers[i].layout; for (j := 0; j < len packopts; j++) { (ord, outer, inner, facing) := packopts[j]; name := "public"; if (ord != -1) name = "p" + string ((ord + i) % plcount); addlayframe("@" + name, parent, layout, outer, dTOP); addlayframe(name, "@" + name, layout, inner, facing); } } } dellay(name: string, layout: ref Layout) { a := layouts; x := strhash(name, len a); rl: list of (string, ref Layout, ref Layobject); for (nl := a[x]; nl != nil; nl = tl nl) { (s, lay, layobj) := hd nl; if (s != name || (layout != nil && layout != lay)) rl = hd nl :: rl; } a[x] = rl; } dellayout(layout: ref Layout) { for (i := 0; i < len layouts; i++) { ll: list of (string, ref Layout, ref Layobject); for (nl := layouts[i]; nl != nil; nl = tl nl) { (s, lay, layobj) := hd nl; if (lay != layout) ll = hd nl :: ll; } layouts[i] = ll; } } copylayobj(obj: ref Layobject): ref Layobject { pick o := obj { Frame => return ref *o; Obj => return ref *o; } return nil; } packoptsfacing(opts, facing: int): int { if (facing == dTOP) return opts; nopts := 0; # 4 directions nopts |= (facing + (opts & dMASK)) % 4; # 2 orientations nopts |= ((facing + ((opts & oMASK) >> oSHIFT)) % 4) << oSHIFT; # 8 anchorpoints (+ centre) a := (opts & aMASK); if (a != aCENTRE) a = ((((a >> aSHIFT) - 1 + facing * 2) % 8) + 1) << aSHIFT; nopts |= a; # two fill options if (facing % 2) { if (opts & FILLX) nopts |= FILLY; if (opts & FILLY) nopts |= FILLX; } else nopts |= (opts & (FILLX | FILLY)); nopts |= (opts & EXPAND); return nopts; } # these arrays are dependent on the ordering of # the relevant constants defined in cardlib.m sides := array[] of {"top", "left", "bottom", "right"}; anchors := array[] of {"centre", "n", "nw", "w", "sw", "s", "se", "e", "ne"}; orientations := array[] of {"right", "up", "left", "down"}; fills := array[] of {"none", "x", "y", "both"}; packopts2s(opts: int): string { s := orientations[(opts & oMASK) >> oSHIFT] + " -side " + sides[opts & dMASK]; if ((opts & aMASK) != aCENTRE) s += " -anchor " + anchors[(opts & aMASK) >> aSHIFT]; if (opts & EXPAND) s += " -expand 1"; if (opts & (FILLX | FILLY)) s += " -fill " + fills[(opts & FILLMASK) >> FILLSHIFT]; return s; } searchopt(a: array of string, s: string): int { for (i := 0; i < len a; i++) if (a[i] == s) return i; panic("unknown pack option '" + s + "'"); return 0; } s2packopts(s: string): int { (nil, toks) := sys->tokenize(s, " "); if (toks == nil) panic("invalid packopts: " + s); p := searchopt(orientations, hd toks) << oSHIFT; for (toks = tl toks; toks != nil; toks = tl tl toks) { if (tl toks == nil) panic("invalid packopts: " + s); arg := hd tl toks; case hd toks { "-anchor" => p |= searchopt(anchors, arg) << aSHIFT; "-fill" => p |= searchopt(fills, arg) << FILLSHIFT; "-side" => p |= searchopt(sides, arg) << dSHIFT; "-expand" => if (int hd tl toks) p |= EXPAND; * => panic("unknown pack option: " + hd toks); } } return p; } panic(e: string) { sys->fprint(sys->fildes(2), "cardlib panic: %s\n", e); raise "panic"; } assert(b: int, err: string) { if (b == 0) raise "parse:" + err; } # from Aho Hopcroft Ullman strhash(s: string, n: int): int { h := 0; m := len s; for(i := 0; i<m; i++){ h = 65599 * h + s[i]; } return (h & 16r7fffffff) % n; }