Last modified on Tue Jan 31 10:27:31 PST 1995 by kalsow modified on Wed Jul 14 16:41:03 PDT 1993 by msm

MODULE Card;

IMPORT Point, VBT, ZSplit, Rect, Random,
         CardRank, CardSuit, FaceCards, Gray, HighlightVBT,
         Pixmap, Axis, PaintOp, Region, VBTRep, Filter,
         MouseSplit, Split, Thread, TwoTone;

CONST
  MidH   = Width DIV 2;
  MidV   = Height DIV 2;
  Mid    = Point.T{MidH, MidV};
  TenV1  = (3 * Height) DIV 10;
  TenV2  = Height - TenV1;
  SevenV = (7 * Height) DIV 20;
  EightV = Height - SevenV;
  Col1   = (3 * Width) DIV 10;
  Col3   = Width - Col1;
  Row1   = Height DIV 5;
  Row2   = (2 * Height) DIV 5;
  Row3   = MidV;
  Row4   = Height - Row2;
  Row5   = Height - Row1;
  RankH  = 4;
  RankV  = 7;
  SuitH  = RankH;
  SuitV  = 24;
  RankNW = Point.T{RankH, RankV};
  KnarNW = Point.T{Width - RankH, Height - RankV};
  SuitNW = Point.T{SuitH, SuitV};
  TiusNW = Point.T{Width - SuitH, Height - SuitV};
VAR
  realRed     := PaintOp.FromRGB(0.75, 0.0, 0.0, bw := PaintOp.BW.UseFg);
  red         := PaintOp.Pair(PaintOp.Bg, realRed);
  transpRed   := PaintOp.Pair(PaintOp.Transparent, realRed);
  redSwap     := PaintOp.SwapPair(PaintOp.Bg, realRed);
  black       := PaintOp.BgFg;
  transpBlack := PaintOp.TransparentFg;
  blackSwap   := PaintOp.Swap;
  realFelt    := PaintOp.FromRGB(0.2, 0.8, 0.6);
  feltSwap    := PaintOp.SwapPair(PaintOp.Fg, realFelt);
  back    := PaintOp.Pair(PaintOp.Bg, PaintOp.FromRGB(0.16, 0.30, 0.60));
  backPix := Pixmap.Gray;

REVEAL
  Private = HighlightVBT.T BRANDED OBJECT END;
  T = Public BRANDED OBJECT
        nexthigh: T := NIL;
      OVERRIDES
        mouse    := Mouse;
        position := Position
      END;

<*UNUSED*>
CONST
  Names = ARRAY Value OF
            TEXT{"Min", "A", "2", "3", "4", "5", "6", "7", "8", "9", "10",
                 "J", "Q", "K", "Max", "Talon"};
  Suits = ARRAY Family OF TEXT{"", "S", "H", "D", "C"};

VAR
  dragSource, dest: T   := NIL;
  high            : T   := NIL;
  killGen               := 0;
  tracking              := FALSE;
  highlight             := TRUE;
  chainTime             := 1000;
  log             : Log;

TYPE
  UndoRec = RECORD
              card, prevBelow, newBelow: T;
              userMade                 : BOOLEAN
            END;
  UndoLog = REF ARRAY OF UndoRec;
  Log = REF RECORD
              undo              : UndoLog;
              nextUndo, lastUndo: INTEGER
            END;

PROCEDURE StartUndoLog () =
  BEGIN
    IF log = NIL THEN log := NEW(Log) END;
    IF log.undo = NIL THEN log.undo := NEW(UndoLog, 10) END;
    log.nextUndo := 0;
    log.lastUndo := 0;
  END StartUndoLog;

PROCEDURE MoreUndo () =
  VAR u := NEW(UndoLog, 2 * NUMBER(log.undo^));
  BEGIN
    SUBARRAY(u^, 0, NUMBER(log.undo^)) := log.undo^;
    log.undo := u
  END MoreUndo;

PROCEDURE Undo (): BOOLEAN =
  <*FATAL BadDeal*>
  BEGIN
    IF log = NIL OR log.nextUndo = 0 THEN RETURN FALSE END;
    LOOP
      IF log.nextUndo = 0 THEN EXIT END;
      DEC(log.nextUndo);
      WITH u = log.undo[log.nextUndo] DO
        IF u.prevBelow = NIL THEN
          Flip(u.card, NOT u.card.faceUp);
        ELSE
          Attach(u.card, u.prevBelow);
        END;
        IF u.userMade THEN EXIT END
      END
    END;
    RETURN TRUE
  END Undo;

PROCEDURE Redo (slowly: BOOLEAN): BOOLEAN =
  <*FATAL BadDeal*>
  VAR c: T;
  BEGIN
    IF log = NIL OR log.nextUndo = log.lastUndo THEN RETURN FALSE END;
    LOOP
      WITH u = log.undo[log.nextUndo] DO
        c := u.card;
        IF u.newBelow = NIL THEN
          Flip(u.card, NOT u.card.faceUp);
        ELSE
          Attach(u.card, u.newBelow);
        END;
      END;
      INC(log.nextUndo);
      IF log.nextUndo = log.lastUndo THEN EXIT END;
      IF log.undo^[log.nextUndo].userMade THEN EXIT END;
      IF slowly THEN
        VBTRep.Redisplay();
        VBT.Sync(c);
        Thread.Pause(0.1D0)
      END
    END;
    RETURN TRUE
  END Redo;

PROCEDURE AddLog (cd, pBelow, nBelow: T; uMade: BOOLEAN) =
  BEGIN
    IF (log = NIL) OR (log.undo = NIL) THEN StartUndoLog() END;
    IF log.nextUndo = NUMBER(log.undo^) THEN MoreUndo() END;
    WITH u = log.undo[log.nextUndo] DO
      u.card := cd;
      u.prevBelow := pBelow;
      u.newBelow := nBelow;
      u.userMade := uMade
    END;
    INC(log.nextUndo);
    log.lastUndo := log.nextUndo
  END AddLog;

PROCEDURE Real (c: T): BOOLEAN =
  BEGIN
    RETURN (c.value # Value.Min) AND (c.value # Value.Max)
             AND (c.value # Value.Talon)
  END Real;

PROCEDURE RealCard (c: Card): BOOLEAN =
  BEGIN
    RETURN (c.value # Value.Min) AND (c.value # Value.Max)
             AND (c.value # Value.Talon)
  END RealCard;

PROCEDURE Shape (<*UNUSED*> ch: VBT.T;
                            ax: Axis.T;
                 <*UNUSED*> n : CARDINAL     ): VBT.SizeRange =
  BEGIN
    IF ax = Axis.T.Hor THEN
      RETURN VBT.SizeRange{lo := Width, pref := Width, hi := Width + 1}
    ELSE
      RETURN VBT.SizeRange{lo := Height, pref := Height, hi := Height + 1}
    END
  END Shape;

PROCEDURE KillHigh (VAR high: T) =
  VAR next: T;
  BEGIN
    WHILE high # NIL DO
      next := high.nexthigh;
      high.nexthigh := NIL;
      HighlightVBT.SetRect(high, Rect.Empty, 0);
      high := next
    END;
    INC(killGen)
  END KillHigh;

PROCEDURE AddHigh (VAR high: T; ch: T) =
  BEGIN
    IF ch = NIL OR ch.nexthigh # NIL OR ch = high THEN RETURN END;
    HighlightVBT.SetRect(ch, VBT.Domain(ch), MAX(Width, Height));
    ch.nexthigh := high;
    high := ch
  END AddHigh;

PROCEDURE Position (ch: T; READONLY cd: VBT.PositionRec) =
  BEGIN
    IF cd.cp.gone THEN
      IF (dragSource # NIL) AND (ch = dragSource) AND (dest # NIL) THEN
        dest := NIL;
        KillHigh(high)
      END;
      VBT.SetCage(ch, VBT.GoneCage)
    ELSE
      IF tracking AND cd.modifiers * VBT.Buttons = VBT.Modifiers{} THEN
        dragSource := ch;
        dest := obvious(dragSource);
        AddHigh(high, dest);
	IF chainTime >= 0 AND dest # NIL THEN
          EVAL Thread.Fork(NEW(Lumen, dest := dest, up := TRUE,
	    killGen := killGen, quick := FALSE))
        END
      END;
      VBT.SetCage(ch, VBT.CageFromRect(VBT.Domain(ch), cd.cp))
    END;
    MouseSplit.Position(ch, cd)
  END Position;

TYPE
  Lumen = Thread.Closure OBJECT
            dest   : T;
            up, quick: BOOLEAN;
            killGen: INTEGER
          OVERRIDES
            apply := LumenApply
          END;

PROCEDURE LumenApply (self: Lumen): REFANY =
  VAR timer: LONGREAL; BEGIN
    IF NOT self.quick THEN
      LOCK VBT.mu DO timer := FLOAT(chainTime, LONGREAL) * 0.01D0 END;
      IF timer < 0.0D0 THEN RETURN NIL END;
      Thread.Pause(timer)
    END;
    LOOP
      LOCK VBT.mu DO
        timer := FLOAT(chainTime, LONGREAL) * 0.001D0
      END;
      IF timer < 0.0D0 THEN EXIT END;
      Thread.Pause(timer);
      LOCK VBT.mu DO
        IF killGen # self.killGen THEN EXIT END;
        IF self.up THEN
          self.dest := obvious(self.dest)
        ELSE
          self.dest := stupid(self.dest)
        END;
        IF self.dest = NIL THEN EXIT END;
        AddHigh(high, self.dest)
      END
    END;
    RETURN NIL
  END LumenApply;

PROCEDURE Mouse (ch: T; READONLY cd: VBT.MouseRec) =
  VAR prev, next, log: T;
  BEGIN
    IF cd.clickType = VBT.ClickType.FirstDown THEN
      dragSource := ch;
      CASE cd.whatChanged OF
        VBT.Modifier.MouseL => dest := obvious(dragSource)
      | VBT.Modifier.MouseM => dest := trivial(dragSource)
      | VBT.Modifier.MouseR => dest := stupid(dragSource)
      ELSE
        dest := NIL
      END;
      KillHigh(high);
      IF highlight THEN
        AddHigh(high, dest);
        IF dest # NIL AND (cd.whatChanged = VBT.Modifier.MouseL
                           OR cd.whatChanged = VBT.Modifier.MouseR)
		      AND chainTime >= 0 THEN
          EVAL Thread.Fork(NEW(Lumen, dest := dest,
                             up := cd.whatChanged = VBT.Modifier.MouseL,
                             killGen := killGen, quick := TRUE))
        END
      END
    ELSE
      KillHigh(high);
      prev := ch;
      IF (cd.clickType = VBT.ClickType.LastUp) AND (dragSource # NIL) THEN
        IF (prev = dragSource) AND NOT cd.cp.gone THEN prev := dest END;
        IF (prev = NIL) OR (prev = dragSource) THEN
          dragSource := NIL;
          RETURN
        END;
        TRY
          IF attachable(dragSource, prev) THEN
            IF Real(dragSource) THEN
              log := dragSource.below;
              Attach(dragSource, prev);
              AddLog(dragSource, log, prev, TRUE);
              VBTRep.Redisplay();
            END;
            WHILE play(prev, next) DO
              VBT.Sync(ch);
              IF prev = next THEN
                Flip(prev, NOT prev.faceUp);
                AddLog(prev, NIL, NIL, FALSE);
              ELSE
                log := prev.below;
                Attach(prev, next);
                AddLog(prev, log, next, FALSE);
                VBTRep.Redisplay()
              END;
              Thread.Pause(0.25D0);
            END;
          END
        EXCEPT
          BadDeal =>
        END
      END;
      dragSource := NIL
    END;
    MouseSplit.Mouse(ch, cd)
  END Mouse;

PROCEDURE NotAttachable ( <*UNUSED*>a, b: T): BOOLEAN =
  BEGIN
    RETURN FALSE
  END NotAttachable;

PROCEDURE NoPlay ( <*UNUSED*>VAR a, b: T): BOOLEAN =
  BEGIN
    RETURN FALSE
  END NoPlay;

PROCEDURE NoMove ( <*UNUSED*>a: T): T =
  BEGIN
    RETURN NIL
  END NoMove;

PROCEDURE Detach (c: T) =
  BEGIN
    IF c.below = c THEN RETURN END;
    c.below.above := c.above;
    c.above.below := c.below;
    c.above := c;
    c.below := c
  END Detach;

PROCEDURE AttachOne (c, p: T) =
  (* Put c on top of p *)
  VAR
    dom  : Rect.T;
    below: T;
  BEGIN
    Detach(c);
    dom := ZSplit.GetDomain(p);
    below := Bottom(p);
    IF (below.value # Value.Min) AND Real(p) THEN
      IF p.faceUp THEN
        dom := Rect.MoveV(dom, Overlap)
      ELSE
        dom := Rect.MoveV(dom, OverlapDown)
      END
    END;
    ZSplit.Move(c, dom);
    ZSplit.Lift(c);
    c.above := p.above;
    p.above := c;
    c.below := p;
    c.above.below := c
  END AttachOne;

PROCEDURE Attach (c, p: T) RAISES {BadDeal} =
  VAR above: T;
  BEGIN
    IF p.above = c OR p = c THEN RETURN END;
    IF Real(p.above) AND (p.above # p) OR Top(p) = Top(c) THEN
      RAISE BadDeal
    END;
    WHILE (p # c) AND Real(c) DO
      above := c.above;
      AttachOne(c, p);
      p := c;
      c := above
    END
  END Attach;

PROCEDURE InitializeStandardDeck (VAR deck: StandardDeck; zSplit: ZSplit.T) =
  VAR i: INTEGER;
  BEGIN
    i := 0;
    FOR val := Value.Ace TO Value.King DO
      FOR st := Family.Spades TO Family.Clubs DO
        deck[i] := New(val, st, Point.Origin, zSplit);
        INC(i)
      END
    END
  END InitializeStandardDeck;

PROCEDURE Flip (c: T; up: BOOLEAN) =
  VAR old: BOOLEAN;
  BEGIN
    old := c.faceUp;
    c.faceUp := up;
    IF old # up THEN FlipCard(Filter.Child(c), up) END
  END Flip;

PROCEDURE FlipCard (c: Card; up: BOOLEAN) =
  VAR old: BOOLEAN;
  BEGIN
    old := c.faceUp;
    c.faceUp := up;
    IF old # up THEN VBT.Mark(c) END
  END FlipCard;

PROCEDURE NewCard (value: Value; suit: Family; faceUp := TRUE): Card =
  BEGIN
    RETURN NEW(Card, value := value, family := suit, faceUp := faceUp)
  END NewCard;

PROCEDURE New (         val   : Value;
                        st    : Family;
               READONLY loc   : Point.T;
                        zSplit: ZSplit.T;
                        faced : BOOLEAN    := TRUE): T =
  VAR res := NEW(T, value := val, family := st, faceUp := faced);
  BEGIN
    IF NOT Real(res) THEN
      EVAL HighlightVBT.T.init(res, NIL, feltSwap, Pixmap.Solid)
    ELSIF st = Family.Hearts OR st = Family.Diamonds THEN
      EVAL HighlightVBT.T.init(res, NIL, redSwap, Pixmap.Solid)
    ELSE
      EVAL HighlightVBT.T.init(res, NIL, blackSwap, Pixmap.Solid)
    END;
    res.above := res;
    res.below := res;
    Realize(res, loc, zSplit);
    RETURN res
  END New;

PROCEDURE Realize (c: T; READONLY loc: Point.T; zSplit: ZSplit.T) =
  <*FATAL Split.NotAChild *>
  BEGIN
    Split.Insert(c, NIL, NEW(Card, round := TRUE, family := c.family,
                             value := c.value, faceUp := c.faceUp));
    ZSplit.InsertAt(zSplit, c, loc)
  END Realize;

REVEAL
  Card = CardPublic BRANDED OBJECT
           round := FALSE;
         OVERRIDES
           repaint := Repaint;
           shape   := Shape
         END;

PROCEDURE Repaint (v: Card; READONLY bad: Region.T) =
  BEGIN
    IF v.round THEN
      PaintBg(v, bad.r);
      PaintBorder(v, bad.r);
      PaintTopCorners(v, bad.r);
      PaintBottomCorners(v, bad.r)
    ELSE
      PaintSquareBg(v, bad.r);
      PaintSquareBorder(v, bad.r)
    END;
    IF RealCard(v) AND v.faceUp THEN
      PaintRankAndSuit(v, bad.r);
      PaintCenter(v, bad.r)
    END
  END Repaint;

PROCEDURE PaintCenter (v: Card; READONLY clip: Rect.T) =
  VAR
    op, top: PaintOp.T;
    delta              := Rect.NorthWest(VBT.Domain(v));
    pix                := CardSuit.PipPix(v.family);
    xip                := CardSuit.PipXip(v.family);
  BEGIN
    IF v.family = Family.Hearts OR v.family = Family.Diamonds THEN
      op := red;
      top := transpRed
    ELSE
      op := black;
      top := transpBlack
    END;
    IF v.value >= Value.Jack THEN
      BorderCenter(v, op, top, clip, FaceCards.Pix(v.family, v.value), Mid,
                   delta, pix, xip, v.family, v.value)
    ELSIF v.value >= Value.Four THEN
      Center(v, op, clip, pix, Point.T{Col1, Row1}, delta);
      Center(v, op, clip, pix, Point.T{Col3, Row1}, delta);
      Center(v, op, clip, xip, Point.T{Col1, Row5}, delta);
      Center(v, op, clip, xip, Point.T{Col3, Row5}, delta);
      IF v.value >= Value.Nine THEN
        Center(v, op, clip, pix, Point.T{Col1, Row2}, delta);
        Center(v, op, clip, pix, Point.T{Col3, Row2}, delta);
        Center(v, op, clip, xip, Point.T{Col1, Row4}, delta);
        Center(v, op, clip, xip, Point.T{Col3, Row4}, delta);
        IF v.value >= Value.Ten THEN
          Center(v, op, clip, pix, Point.T{MidH, TenV1}, delta);
          Center(v, op, clip, xip, Point.T{MidH, TenV2}, delta);
        ELSIF v.value >= Value.Nine THEN
          Center(v, op, clip, pix, Mid, delta);
        END
      ELSIF v.value >= Value.Six THEN
        Center(v, op, clip, pix, Point.T{Col1, Row3}, delta);
        Center(v, op, clip, pix, Point.T{Col3, Row3}, delta);
        IF v.value >= Value.Seven THEN
          Center(v, op, clip, pix, Point.T{MidH, SevenV}, delta);
          IF v.value >= Value.Eight THEN
            Center(v, op, clip, xip, Point.T{MidH, EightV}, delta);
          END
        END;
      ELSIF v.value >= Value.Five THEN
        Center(v, op, clip, pix, Mid, delta)
      END
    ELSIF v.value >= Value.Deuce THEN
      Center(v, op, clip, pix, Point.T{MidH, Row1}, delta);
      Center(v, op, clip, xip, Point.T{MidH, Row5}, delta);
      IF v.value >= Value.Three THEN
        Center(v, op, clip, pix, Mid, delta)
      END
    ELSE
      Center(v, op, clip, CardSuit.AcePix(v.family), Mid, delta)
    END
  END PaintCenter;

PROCEDURE Center (         v           : Card;
                           op          : PaintOp.T;
                  READONLY clip        : Rect.T;
                           pm          : Pixmap.T;
                  READONLY midpt, delta: Point.T    ) =
  VAR
    dom := VBT.PixmapDomain(v, pm);
    nw  := Point.Sub(Point.Add(delta, midpt), Rect.Middle(dom));
  BEGIN
    VBT.PaintPixmap(v, clip, op, pm, nw)
  END Center;

PROCEDURE BorderCenter (         v           : Card;
                                 op, top     : PaintOp.T;
                        READONLY clip        : Rect.T;
                                 pm          : Pixmap.T;
                        READONLY midpt, delta: Point.T;
                                 pix, xip    : Pixmap.T;
                                 s           : Suit;
                                 r           : FaceCards.FaceRank) =
  VAR
    dom            := VBT.PixmapDomain(v, pm);
    nw             := Point.Sub(Point.Add(delta, midpt), Rect.Middle(dom));
    border: Rect.T;
    a: Rect.Partition;
  BEGIN
    VBT.PaintPixmap(v, clip, op, pm, nw);
    Center(v, top, clip, pix, FaceCards.PixCenter(s, r), nw);
    Center(v, top, clip, xip, FaceCards.XipCenter(s, r), nw);
    dom := Rect.Move(dom, nw);
    border := Rect.Inset(dom, -1);
    Rect.Factor(Rect.Meet(clip, border), dom, a, 0, 0);
    a[2] := a[4];
    VBT.PolyTint(v, SUBARRAY(a, 0, 4), op)
  END BorderCenter;

PROCEDURE PaintRankAndSuit (v: Card; READONLY clip: Rect.T) =
  VAR
    op   : PaintOp.T;
    delta            := Rect.NorthWest(VBT.Domain(v));
    pix  : Pixmap.T;
  BEGIN
    IF v.family = Family.Hearts OR v.family = Family.Diamonds THEN
      op := red
    ELSE
      op := black
    END;
    VBT.PaintPixmap(
      v, clip, op, CardRank.Pix(v.value), Point.Add(delta, RankNW));
    pix := CardRank.Xip(v.value);
    VBT.PaintPixmap(v, clip, op, pix,
                    Point.Sub(Point.Add(delta, KnarNW),
                              Rect.SouthEast(VBT.PixmapDomain(v, pix))));
    IF v.family = Family.Diamonds THEN INC(delta.h) END;
    VBT.PaintPixmap(
      v, clip, op, CardSuit.RankPix(v.family), Point.Add(delta, SuitNW));
    pix := CardSuit.RankXip(v.family);
    VBT.PaintPixmap(v, clip, op, pix,
                    Point.Sub(Point.Add(delta, TiusNW),
                              Rect.SouthEast(VBT.PixmapDomain(v, pix))));
  END PaintRankAndSuit;

PROCEDURE TranslateAndClip (READONLY a    : ARRAY OF Rect.T;
                            VAR      b    : ARRAY OF Rect.T;
                            READONLY delta: Point.T;
                            READONLY clip : Rect.T           ): INTEGER =
  VAR
    j         := 0;
    r: Rect.T;
  BEGIN
    FOR i := FIRST(a) TO LAST(a) DO
      r := Rect.Meet(clip, Rect.Move(a[i], delta));
      IF NOT Rect.IsEmpty(r) THEN b[j] := r; INC(j) END
    END;
    RETURN j
  END TranslateAndClip;

PROCEDURE PaintTopCorners (v: Card; READONLY clip: Rect.T) =
  VAR
    t       : T         := VBT.Parent(v);
    op1, op2: PaintOp.T;
    txt     : Pixmap.T;
    bottom              := Bottom(t);
    a1: ARRAY [0 .. LAST(TopCornerRectsA)] OF Rect.T;
    a2: ARRAY [0 .. LAST(TopCornerRectsB)] OF Rect.T;
    n1 := TranslateAndClip(
            TopCornerRectsA, a1, Rect.NorthWest(VBT.Domain(v)), clip);
    n2 := TranslateAndClip(
            TopCornerRectsB, a2, Rect.NorthWest(VBT.Domain(v)), clip);
  BEGIN
    IF bottom = t OR NOT Real(t.below) OR bottom.value = Value.Min THEN
      op1 := felt.op;
      op2 := felt.op;
      txt := felt.txt;
    ELSIF t.below.faceUp THEN
      op1 := PaintOp.Bg;
      op2 := PaintOp.Fg;
      txt := Pixmap.Solid
    ELSE
      op1 := back;
      op2 := PaintOp.Fg;
      txt := backPix;
    END;
    IF n1 > 0 THEN
      IF txt = Pixmap.Solid THEN
        VBT.PolyTint(v, SUBARRAY(a1, 0, n1), op1)
      ELSE
        VBT.PolyTexture(v, SUBARRAY(a1, 0, n1), op1, txt,
                        Rect.NorthWest(VBT.Domain(t.below)))
      END
    END;
    IF n2 > 0 THEN VBT.PolyTint(v, SUBARRAY(a2, 0, n2), op2) END
  END PaintTopCorners;

PROCEDURE PaintBottomCorners (v: Card; READONLY clip: Rect.T) =
  VAR
    a: ARRAY [0 .. LAST(BottomCornerRects)] OF Rect.T;
    n := TranslateAndClip(
           BottomCornerRects, a, Rect.NorthWest(VBT.Domain(v)), clip);
  BEGIN
    IF n > 0 THEN
      VBT.PolyTexture(v, SUBARRAY(a, 0, n), felt.op, felt.txt)
    END
  END PaintBottomCorners;

PROCEDURE PaintBorder (v: Card; READONLY clip: Rect.T) =
  VAR
    a: ARRAY [0 .. LAST(BorderRects)] OF Rect.T;
    n := TranslateAndClip(
           BorderRects, a, Rect.NorthWest(VBT.Domain(v)), clip);
  BEGIN
    IF n > 0 THEN VBT.PolyTint(v, SUBARRAY(a, 0, n), PaintOp.Fg) END
  END PaintBorder;

PROCEDURE PaintSquareBorder (v: Card; READONLY clip: Rect.T) =
  VAR
    a: ARRAY [0 .. LAST(SquareBorderRects)] OF Rect.T;
    n := TranslateAndClip(
           SquareBorderRects, a, Rect.NorthWest(VBT.Domain(v)), clip);
  BEGIN
    IF n > 0 THEN VBT.PolyTint(v, SUBARRAY(a, 0, n), PaintOp.Fg) END
  END PaintSquareBorder;

PROCEDURE ComputeBg(v: Card; VAR txt: Pixmap.T; VAR op: PaintOp.T) =
  BEGIN
    IF NOT RealCard(v) THEN
      txt := felt.txt;
      op := felt.op
    ELSIF v.faceUp THEN
      txt := Pixmap.Solid;
      op := PaintOp.Bg
    ELSE
      txt := backPix;
      op := back
    END
  END ComputeBg;

PROCEDURE PaintBg (v: Card; READONLY clip: Rect.T) =
  VAR
    op : PaintOp.T;
    txt: Pixmap.T;
    a  : ARRAY [0 .. LAST(BgRects)] OF Rect.T;
    n  : INTEGER;
  BEGIN
    ComputeBg(v, txt, op);
    n := TranslateAndClip(BgRects, a, Rect.NorthWest(VBT.Domain(v)), clip);
    IF n > 0 THEN VBT.PolyTexture(v, SUBARRAY(a, 0, n), op, txt) END
  END PaintBg;

PROCEDURE PaintSquareBg (v: Card; READONLY clip: Rect.T) =
  VAR
    op : PaintOp.T;
    txt: Pixmap.T;
    a  : ARRAY [0 .. LAST(SquareBgRects)] OF Rect.T;
    n  : INTEGER;
  BEGIN
    ComputeBg(v, txt, op);
    n := TranslateAndClip(
           SquareBgRects, a, Rect.NorthWest(VBT.Domain(v)), clip);
    IF n > 0 THEN VBT.PolyTexture(v, SUBARRAY(a, 0, n), op, txt) END
  END PaintSquareBg;

PROCEDURE EnableTracking (enable: BOOLEAN) =
  BEGIN
    tracking := enable
  END EnableTracking;

PROCEDURE EnableHighlight (enable: BOOLEAN; chain: INTEGER) =
  BEGIN
    highlight := enable;
    chainTime := chain
  END EnableHighlight;

PROCEDURE Shuffle (VAR deck: ARRAY OF T) =
  VAR
    j: INTEGER;
    c: T;
  BEGIN
    FOR i := 0 TO LAST(deck) DO
      j := default.integer(i, LAST(deck));
      c := deck[i];
      deck[i] := deck[j];
      deck[j] := c
    END
  END Shuffle;

PROCEDURE Top (c: T): T =
  BEGIN
    RETURN Bottom(c).below
  END Top;

PROCEDURE Bottom (c: T): T =
  VAR d := c.below;
  BEGIN
    IF NOT Real(c) THEN RETURN c END;
    WHILE Real(d) AND d # c DO d := d.below END;
    RETURN d
  END Bottom;

CONST
  SquareBorderRects = ARRAY OF
                        Rect.T{Rect.T{0, 1, 0, Height},
                               Rect.T{Width - 1, Width, 0, Height},
                               Rect.T{1, Width - 1, 0, 1},
                               Rect.T{1, Width - 1, Height - 1, Height}};
  BorderRects = ARRAY OF
                  Rect.T{
                  Rect.T{4, Width - 4, 0, 1},
                  Rect.T{4, Width - 4, Height - 1, Height},
                  Rect.T{0, 1, 4, Height - 4},
                  Rect.T{Width - 1, Width, 4, Height - 4},
                  Rect.T{2, 4, 1, 2}, Rect.T{Width - 4, Width - 2, 1, 2},
                  Rect.T{2, 4, Height - 2, Height - 1},
                  Rect.T{Width - 4, Width - 2, Height - 2, Height - 1},
                  Rect.T{1, 2, 2, 4}, Rect.T{1, 2, Height - 4, Height - 2},
                  Rect.T{Width - 2, Width - 1, 2, 4},
                  Rect.T{Width - 2, Width - 1, Height - 4, Height - 2}};

  SquareBgRects = ARRAY OF Rect.T{Rect.T{1, Width - 1, 1, Height - 1}};

  BgRects = ARRAY OF
              Rect.T{
              Rect.T{4, Width - 4, 1, 2}, Rect.T{2, Width - 2, 2, 4},
              Rect.T{1, Width - 1, 4, Height - 4},
              Rect.T{2, Width - 2, Height - 4, Height - 2},
              Rect.T{4, Width - 4, Height - 2, Height - 1}};

  TopCornerRectsA = ARRAY OF
                      Rect.T{Rect.T{1, 4, 0, 1},
                             Rect.T{Width - 4, Width - 1, 0, 1},
                             Rect.T{1, 2, 1, 2},
                             Rect.T{Width - 2, Width - 1, 1, 2}};
  TopCornerRectsB = ARRAY OF
                      Rect.T{
                      Rect.T{0, 1, 0, 4}, Rect.T{Width - 1, Width, 0, 4}};

  BottomCornerRects = ARRAY OF
                        Rect.T{
                        Rect.T{0, 4, Height - 1, Height},
                        Rect.T{Width - 4, Width, Height - 1, Height},
                        Rect.T{0, 2, Height - 2, Height - 1},
                        Rect.T{Width - 2, Width, Height - 2, Height - 1},
                        Rect.T{0, 1, Height - 4, Height - 2},
                        Rect.T{Width - 1, Width, Height - 4, Height - 2}};

VAR
  default := NEW(Random.Default).init();

BEGIN
  attachable := NotAttachable;
  play := NoPlay;
  obvious := NoMove;
  trivial := NoMove;
  stupid := NoMove;
  felt := TwoTone.New(PaintOp.Pair(PaintOp.Bg, realFelt), Gray.New4x4(6));
END Card.