Updated 2007-06-05 09:27:33 by venks ▲

Keith Vetter 2003-04-25: I realized that over my 20+ years of programming that I've written hundreds of games but never a playing card game (actually I once wrote in Lisp an expert system that plays the game of canasta but that only played one hand and had no UI).

So here's my first card--it plays the game Scat, also known as 31, Ride the Bus and Blitz [1]. The object of the game is to collect cards in one�s hand totaling as close to 31 as possible in the same suit. It uses the GPL card images found in Playing Card Images. (No longer true, see below.)

The code for playing the computer hands is pretty simple and could easily be improved (see routines PickupOrKnock and WhichDiscard), but it plays well enough to be enjoyable.

KBK - There appears to be a small bug in the scoring. A player who draws to 31 after another player has knocked does not score a Blitz.

KPV - That's just how I learned to play. If you want to change it, just edit the two lines that have the comment ;# Blitz? on them to remove the knocking test.

KBK - I'd have just have gone and fixed it, except that it appeared to be intentional. It does contradict what the cited Web page says, though.

KPV - okay, I've changed it so that it complies with what the web sites says the rules should be.

KPV May 2, 2003 - I've updated the code to no longer use the viral GPL card images but rather to use card images extracted from the Patience Starkit [2].

HJG 2005-08-29 Factored out the card-images to card_img
 ##+##########################################################################
 #
 # Scat.tcl -- plays the card game of Scat (aka 31, Ride the Bus and Blitz)
 # by Keith Vetter, April 2003
 #   for detailed rules, see http://www.pagat.com/draw/scat.html
 #   Card images from http://tcl.tk/starkits/patience.kit

 package require Tk

 set S(title) "Scat"
 set S(step)   1                                 ;# Animation distance per step
 set S(delay)  0                                 ;# Time between animation moves
 set S(pause)  1                                 ;# Pause between players
 set S(margin) 5
 set S(cs)     2                                 ;# Card spacing
 set ROUND(state) 0
 set ROUND(turn) w
 array set GAME {next,w n next,n e next,e s next,s w}
 array set GAME {name,w West name,n North name,e East name,s South}

 proc DoDisplay {} {
    global S

    wm title . $S(title)
    pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
        -side right -fill both -ipady 5
    pack [frame .screen -bd 2 -relief raised] -side top -fill both -expand 1

    canvas .c -relief raised -borderwidth 0 -height 500 -width 500 \
        -scrollregion {-250 -250 250 250} -bg green4

    label .msg -textvariable S(msg) -bd 2 -bg white -relief ridge
    pack .msg -in .screen -side bottom -fill both
    pack .c   -in .screen -side top    -fill both -expand 1

    button .b1
    option add *Button.font "[font actual [.b1 cget -font]] -weight bold"
    destroy .b1
    button .knock -text Knock -command [list UserMove knock] -padx 10

    bind all <Alt-c> {console show}

    DoCtrlFrame
    update
    GetCardPositions

    bind .c <Configure> {ReCenter %W %h %w}
    trace variable ::ROUND w Tracer
 }
 proc DoCtrlFrame {} {
    frame .sframe -bd 2 -relief sunken
    label .player -text Player
    .player configure -font "[font actual [.player cget -font]] -weight bold"
    label .lives -text Lives -font [.player cget -font]
    grid .player .lives -in .sframe -row 1 -sticky ew
    foreach who {s w n e} {
        label .l$who -text "$::GAME(name,$who)" -bd 0
        label .s$who -textvariable GAME(lives,$who) -bd 0
        grid .l$who .s$who -in .sframe -sticky ew
    }
    button .new -text "New Game" -command NewGame

    button .help -text Help -command Help
    bind .help <3> [list ShowCards 2]
    button .about -text About -command \
        [list tk_messageBox -message "$::S(title)\nby Keith Vetter, April 2003"]

    grid .sframe  -in .ctrl -row 1 -sticky ew
    grid rowconfigure .ctrl 20 -minsize 20
    grid .new     -in .ctrl -row 21 -sticky ew
    grid rowconfigure .ctrl 50 -weight 1
    grid .help    -in .ctrl -row 100 -sticky ew
    grid .about   -in .ctrl -sticky ew
 }
 ##+##########################################################################
 # GetCardPositions -- Where cards are placed on the canvas
 #
 proc GetCardPositions {} {
    global S GAME

    foreach suit {s d c h} {
        foreach v {a k q j t 9 8 7 6 5 4 3 2} {
            lappend S(cards) "$v$suit"
        }
    }
    set img [Card2Image b 0]
    set S(cw) [image width $img]
    set S(ch) [image height $img]

    .c delete card bknock txt
    foreach {x0 y0 x1 y1} [.c cget -scrollregion] break
    set yn [expr {$y0 + $S(margin) + $S(ch) / 2.0}]
    set ys [expr {$y1 - $S(margin) - $S(ch) / 2.0}]
    set xw [expr {$x0 + $S(margin) + $S(cw) / 2.0}]
    set xe [expr {$x1 - $S(margin) - $S(cw) / 2.0}]

    set x [expr {-$S(cw) - $S(cs)}]             ;# For n and s
    set y [expr {-$S(ch) - $S(cs)}]             ;# For e and w

    foreach i {0 1 2 3} {
        set xx [expr {$x + $i * ($S(cw) + $S(cs))}]
        .c create image $xx $yn -anchor c -tag [list card n$i]
        .c create image $xx $ys -anchor c -tag [list card s$i]

        set yy [expr {$y + $i* ($S(ch) + $S(cs))}]
        .c create image $xw $yy -anchor c -tag [list card w$i]
        .c create image $xe $yy -anchor c -tag [list card e$i]
    }

    # Player names
    set x [expr {-1.5 * $S(cw) - 5 * $S(cs)}]
    .c create text $x [expr {$y1 - $S(margin)}] -anchor se -tag txt \
        -text $GAME(name,s) -fill white -font bold
    .c create text $x [expr {$y0 + $S(margin)}] -anchor ne -tag txt \
        -text $GAME(name,n) -fill white -font bold
    set y [expr {-1.5 * $S(ch) - 5 * $S(cs)}]
    .c create text $xw $y -anchor s -text $GAME(name,w) -fill white -font bold \
        -tag txt
    .c create text $xe $y -anchor s -text $GAME(name,e) -fill white -font bold \
        -tag txt

    # Position discard and stock
    set x [expr {($S(cw) + $S(cs)) / -2.0}]
    .c create image $x 0 -anchor c -tag [list card discard]
    set x [expr {round($x + $S(cw) + $S(cs))}]
    foreach i {3 2 1} {
        set xx [expr {$x + $i * 2}]
        .c create image $xx 0 -anchor c -tag [list card stock$i stocks]
    }
    .c create image $x 0 -anchor c -tag [list card stock stocks]

    # KNOCK message
    set y [expr {-$S(ch)/2.0 - 20}]
    .c create text 0 $y -anchor s -tag knock -font {{Times Roman} 24 bold} \
        -fill red
    # KNOCK button
    set y [expr {$ys - $S(ch) / 2.0 - 10}]
    .c create window 0 $y -anchor s -tag bknock -window {}

    foreach who [list s0 s1 s2 s3 stock discard] {
        .c bind $who <Button-1> [list UserMove $who]
    }
 }
 ##+##########################################################################
 #
 # Card2Image -- returns the image name for a card--the back of the card
 # if the card should not be revealed.
 #
 proc Card2Image {card reveal} {
    if {$card == ""} {return {}}                ;# No card -- show nothing
    if {! $reveal} { set card "back" }          ;# Hidden card -- show back
    set iname "::img::$card"
    return $iname
 }
 ##+##########################################################################
 #
 # Recenter -- keeps 0,0 at the center of the canvas during resizing
 #
 proc ReCenter {W h w} {                         ;# Called by configure event
    set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}]
    $W config -scrollregion [list -$w2 -$h2 $w2 $h2]
    GetCardPositions                            ;# Reposition everything
    ShowCards
 }
 ##+##########################################################################
 #
 # NewGame -- starts a new game
 #
 proc NewGame {} {
    global ROUND GAME S

    destroy .score
    set S(animate) 0                            ;# End any animation
    set ROUND(dealer) n
    set GAME(who) {s w n e}                     ;# Who's still playing
    foreach who $GAME(who) { set GAME(lives,$who) 3 }

    .c itemconfig win -text ""
    PlayOneRound $GAME(who)
 }
 proc PlayOneRound {who} {
    global ROUND PUBLIC

    set ROUND(who) $who                         ;# Who's playing
    set ROUND(dealer) [GetNextPlayer $ROUND(dealer)]
    set ROUND(turn)   [GetNextPlayer $ROUND(dealer)]
    set ROUND(state) 0                          ;# Pickup or discard state
    set ROUND(knock) 0                          ;# No one's knocking yet
    set ROUND(blitz) 0                          ;# No one's blitz yet
    catch {unset PUBLIC}
    set PUBLIC(dealer) $ROUND(dealer)
    .c itemconfig knock -text ""

    ShuffleCards
    Deal $ROUND(who)
    ShowCards
    set n [CheckForBlitz]
    if {! $n} ComputerMove
 }
 proc EndOfGame {} {
    .c itemconfig stocks  -image {}
    .c itemconfig discard -image {}
    .c itemconfig knock -text ""
    set msg "   $::GAME(name,$::ROUND(who)) Wins!  "
    set ::S(msg) ""

    set w .score
    destroy $w
    toplevel $w
    wm transient $w .
    wm title $w ""

    if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
        wm geom $w "+[expr {$wx+150}]+[expr {$wy+150}]"
    }
    label $w.l -text $msg -font {{Times Roman} 24 bold} -fg red
    button $w.ok -text "OK" -command [list destroy $w]

    grid $w.l -row 1
    grid $w.ok -pady 10 -ipadx 25
    tkwait window $w
    NewGame
 }
 proc EndOfRound {} {
    global ROUND GAME S

    ShowCards 1                                 ;# Show all the cards
    set players $ROUND(who)
    set losers [FindLosers]                     ;# Who lost this round

    # Now adjust score
    foreach who $losers {
        incr GAME(lives,$who) -1
        if {$who == $ROUND(knock)} {            ;# Knocker w/ low score
            set n [incr GAME(lives,$who) -1]
        }
        if {$GAME(lives,$who) <= 0} {           ;# Out of the game
            set GAME(lives,$who) "out"
            set n [lsearch $ROUND(who) $who]
            set ROUND(who) [lreplace $ROUND(who) $n $n]
        }
    }

    set w .score
    destroy $w
    toplevel $w
    wm transient .score .
    wm title $w "Score"

    if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
        wm geom $w "+[expr {$wx+150}]+[expr {$wy+150}]"
    }

    set font {Helvetica 10 bold}
    label $w.b -text "BLITZ!" -font {Helvetica 14 bold} -fg red
    label $w.p -text "Points" -font $font
    label $w.l -text "Lives" -font $font
    if {$ROUND(blitz) != 0} {
        grid $w.b - - -row 0
    }
    grid x $w.p $w.l -row 1 -sticky ew
    foreach who $players {
        set fg [$w.p cget -fg]
        if {[lsearch $losers $who] > -1} {set fg red}
        label $w.l$who -text "  $GAME(name,$who)" -font $font -fg $fg -bd 0
        label $w.p$who -text $ROUND(score,$who)   -font $font -fg $fg -bd 0
        label $w.s$who -text $GAME(lives,$who)    -font $font -fg $fg -bd 0
        grid $w.l$who $w.p$who $w.s$who
    }
    label $w.msg -text " Losers are displayed in red." -font $font
    button $w.ok -text "OK" -command [list destroy $w]
    grid columnconfigure $w  0 -minsize 10
    grid rowconfigure    $w 20 -minsize 20

    grid $w.msg - - -row 21
    grid $w.ok - - -pady 10 -ipadx 25

    set S(msg) ""
    tkwait window $w
    if {[llength $ROUND(who)] > 1} {
        PlayOneRound $ROUND(who)
    } else {
        EndOfGame
    }
 }
 proc ShuffleCards {} {
    global S CARD

    set cnt 0
    foreach card $S(cards) {
        set z([expr {round(rand() * 10000)}].[incr cnt]) $card
    }
    set CARD(deck) {}
    foreach card [lsort -real [array names z]] {
        lappend CARD(deck) $z($card)
    }
 }
 ##+##########################################################################
 #
 # DealACard -- pops the next card off the deck
 #
 proc DealACard {} {
    global CARD
    set card [lindex $CARD(deck) 0]
    set CARD(deck) [lrange $CARD(deck) 1 end]
    return $card
 }
 proc Deal {who} {
    global CARD

    set CARD(w) [set CARD(n) [set CARD(e) [set CARD(s) {}]]]
    foreach _ {0 1 2} {
        foreach w $who {
            lappend CARD($w) [DealACard]
        }
    }
    foreach who {w n e s} {
        SortHand $who
    }
    set CARD(discard) [DealACard]
 }
 proc SortHand {who} {
    global CARD
    set CARD($who) [lsort -command SortHandCmd $CARD($who)]
 }
 proc SortHandCmd {c1 c2} {
    global S
    set p1 [lsearch $S(cards) $c1]
    set p2 [lsearch $S(cards) $c2]
    return [expr {$p1 - $p2}]
 }
 proc ShowCards {{reveal 0}} {
    ShowHand s 1                                ;# Always reveal
    foreach who {w n e} {
        ShowHand $who $reveal
    }
    ShowStock
    if {$reveal > 1} {                          ;# Cheat
        .c itemconfig stock -image [Card2Image [lindex $::CARD(deck) 0] 1]
    }
 }
 proc ShowHand {who {show 0}} {
    SortHand $who
    foreach n {0 1 2 3} {
        .c itemconfig $who$n -image [Card2Image [lindex $::CARD($who) $n] $show]
    }
 }
 proc ShowStock {} {
    .c itemconfig discard -image [Card2Image [lindex $::CARD(discard) end] 1]
    set img [Card2Image back 0]
    .c itemconfig stock -image $img
    foreach i {1 2 3} { .c itemconfig stock$i -image $img }
 }
 proc Pickup {who whence} {
    global CARD

    if {$whence == "stock"} {
        set card [DealACard]
        lappend CARD($who) $card
        if {$who != "s"} {set card back}
        lappend ::PUBLIC($::ROUND(turn)) ?
    } else {
        set card [lindex $CARD(discard) end]
        lappend CARD($who) $card
        set CARD(discard) [lrange $CARD(discard) 0 end-1]
        ShowStock
        lappend ::PUBLIC($::ROUND(turn)) $card
    }

    # Figure out where we should put the card
    set from ${who}3
    if {$who == "s"} {
        SortHand $who
        set from $who[lsearch $CARD($who) $card]
    }
    AnimateCard $whence $from $card
    ShowHand $who [string match s $who]
 }
 proc Discard {who which} {
    global CARD

    set card [lindex $CARD($who) $which]        ;# Card to discard
    lappend ::PUBLIC($::ROUND(turn)) $card
    lappend CARD(discard) $card
    set CARD($who) [lreplace $CARD($who) $which $which]

    if {$who != "s"} {set from ${who}3} {set from $who$which}

    ShowHand $who [string match s $who]
    AnimateCard $from discard $card
    ShowStock
 }

 ##+##########################################################################
 #
 # UserMove -- handles the user's (south's) turn
 #
 proc UserMove {who} {
    global ROUND

    if {$ROUND(turn) != "s"} return             ;# Not our turn
    Busy 1
    while {1} {
        if {$ROUND(state) == 0} {               ;# Knock or pickup card step
            .c itemconfig bknock -window {}
            if {$who == "knock"} {              ;# Knocking
                KnockOrBlitz $ROUND(turn) knock
                lappend ::PUBLIC($ROUND(turn)) knock

                set ROUND(state) 0
                set ROUND(turn) [GetNextPlayer $ROUND(turn)]
                after 1 ComputerMove
                break
            }

            if {$who != "discard" && $who != "stock"} break
            set ROUND(state) 1
            Pickup s $who
        } else {                                ;# Discard step
            if {$who == "discard" || $who == "stock"} break
            foreach {_ idx} [split $who ""] break ;# Which card to discard
            Discard s $idx

            if {[ScoreHand $ROUND(turn)] == 31} { ;# BLITZ?
                KnockOrBlitz $ROUND(turn) blitz
                EndOfRound
                break
            }
            set ROUND(state) 0
            set ROUND(turn) [GetNextPlayer $ROUND(turn)]
            after 1 ComputerMove
        }
        break
    }
    Busy 0
 }
 proc Busy {onoff} {
    if {$onoff} {
        .new config -state disabled
    } else {
        .new config -state normal
    }
 }

 proc KnockOrBlitz {who what} {
    global ROUND GAME

    set ROUND($what) $who
    set msg ""
    foreach w $who {
        append msg "$::GAME(name,$w) "
    }
    if {[llength $who] == 1} {
        if {$what == "knock"} {set what knocks} {set what blitzes}
    }
    append msg $what
    .c itemconfig knock -text $msg
 }
 proc Tracer {var1 var2 op} {
    global ROUND GAME S

    if {$ROUND(state) == 0} {                   ;# Start of a new turn
        if {$ROUND(turn) == "s"} {
            set S(msg) "Your turn: pickup a card."
        } else {
            set S(msg) "Waiting for $GAME(name,$ROUND(turn)) to go."
        }
    } elseif {$ROUND(turn) == "s" && $ROUND(state) == 1} {
        set S(msg) "Discard."
    }
 }
 proc AnimateCard {from to card} {
    global S

    set S(animate) 1                            ;# We're animating
    foreach {x0 y0} [.c coords $from] break
    foreach {x1 y1} [.c coords $to] break

    set dx [expr {$x1 - $x0}]
    set dy [expr {$y1 - $y0}]
    set dist [expr {sqrt($dx*$dx + $dy*$dy)}]
    set dx [expr {$S(step) * $dx / $dist}]
    set dy [expr {$S(step) * $dy / $dist}]

    .c create image $x0 $y0 -tag animate -image [Card2Image $card 1]
    for {set i 0} {$i < $dist} {incr i $S(step)} {
        if {! $S(animate)} break
        .c move animate $dx $dy
        update
        if {$S(delay) > 0} {
            after $S(delay)
        }
    }
    set S(animate) 0
    .c delete animate
 }
 proc GetNextPlayer {who} {
    global GAME ROUND
    while {1} {
        set who $GAME(next,$who)
        if {[lsearch $ROUND(who) $who] > -1} { return $who }
    }
 }

 proc SumHand {who {extraCard {}}} {
    global CARD GAME

    set max 0
    array set V {sum,s 0 sum,d 0 sum,c 0 sum,h 0
        cards,s {} cards,d {} cards,c {} cards,h {}}
    foreach card [concat $CARD($who) $extraCard] {
        foreach {v s} [split $card ""] break
        if {$v == "a"} {set v 11}
        if {[string first $v "kqjt"] > -1} {set v 10}
        incr V(sum,$s) $v
        if {$V(sum,$s) > $max} {set max $V(sum,$s); set msuit $s}
        lappend V(cards,$s) $card
    }

    set V(max,sum) $max
    set V(max,suit) $msuit
    return [array get V]
 }
 proc ScoreHand {who} {
    array set V [SumHand $who]
    return $V(max,sum)
 }
 proc CheckForBlitz {} {
    set blitzers {}
    foreach who $::ROUND(who) {
        set v [ScoreHand $who]
        if {$v == 31} {lappend blitzers $who}
    }
    if {$blitzers == {}} {return 0}
    KnockOrBlitz $blitzers blitz
    EndOfRound
    return 1
 }
 proc FindLosers {} {
    global ROUND

    foreach who $ROUND(who) {                   ;# Get all the scores
        set v [ScoreHand $who]
        lappend score($v) $who
        set ROUND(score,$who) $v
    }
    if {$ROUND(blitz) != 0} {                   ;# Blitz victory
        set losers $ROUND(who)
        foreach blitzer $ROUND(blitz) {
            set n [lsearch $losers $blitzer]
            set losers [lreplace $losers $n $n]
        }
        return $losers
    }

    set min [lindex [lsort -integer [array names score]] 0]
    set losers $score($min)
    if {[llength $losers] > 1} {
        set n [lsearch $losers $ROUND(knock)]   ;# Did knocker lose in a tie???
        set losers [lreplace $losers $n $n]     ;# Remove knocker from list
    }
    return $losers
 }

 proc ComputerMove {} {
    global ROUND

    foreach a [after info] {after cancel $a}    ;# Just be safe

    # Is this round over???
    if {$ROUND(state) == 0 && $ROUND(turn) == $ROUND(knock)} {
        EndOfRound
        return
    }

    # Is it the user's turn
    if {$ROUND(turn) == "s"} {
        if {$ROUND(state) == 0 && $ROUND(knock) == 0} {
            .c itemconfig bknock -window .knock
        }
        return
    }

    set delay 1
    if {$ROUND(state) == 0} {                   ;# Knock or pickup
        set move [PickupOrKnock $ROUND(turn)]
        if {$move == "knock"} {
            set ROUND(state) 2
            KnockOrBlitz $ROUND(turn) knock
            lappend ::PUBLIC($ROUND(turn)) knock
        } else {
            set ROUND(state) 1
            Pickup $ROUND(turn) $move
        }
    } elseif {$ROUND(state) == 1} {             ;# Which card to discard
        set idx [WhichDiscard $ROUND(turn)]
        set ROUND(state) 2
        ::Discard $ROUND(turn) $idx

    } elseif {$ROUND(state) == 2} {             ;# End of turn
        if {[ScoreHand $ROUND(turn)] == 31} {   ;# BLITZ?
            KnockOrBlitz $ROUND(turn) blitz
            EndOfRound
            return
        }

        set ROUND(turn) [GetNextPlayer $ROUND(turn)]
        set ROUND(state) 0

        if {$ROUND(turn) != "s"} {
            set delay 500
        }
    }
    after $delay ComputerMove
 }
 ##+##########################################################################
 #
 # PickupOrKnock -- figures out if the computer player should knock, pickup
 # from the discard pile or from the stock pile.
 #
 proc PickupOrKnock {who} {
    global CARD ROUND

    set PUBLIC(hand) $CARD($who)                ;# All info known to $who
    array set V [SumHand $who]

    # 1) KNOCK if hand better than 21
    # ...except if discard is much better???
    if {$V(max,sum) > 21 && $ROUND(knock) == 0} { return knock }

    # What is the discard card
    set card [lindex $CARD(discard) end]
    foreach {v s} [split $card ""] break

    # 2) Don't pickup if < 6
    if {$v < 6} { return stock }

    # 3) if card improves hand then pick it up
    array set VV [SumHand $who $card]
    if {$VV(max,sum) > $V(max,sum)} {return discard}

    return stock
 }
 ##+##########################################################################
 #
 # WhichDiscard -- Figure out which card the computer player should discard
 #
 proc WhichDiscard {who} {
    global CARD PUBLIC

    set PUBLIC(hand) $CARD($who)                ;# All info known to $who
    array set V [SumHand $who]

    set min 100                                 ;# Get min card in min suit
    foreach suit {s d c h} {
        set v $V(sum,$suit)
        if {$v == 0} continue
        if {$v < $min} {
            set min $v
            set card [lindex $V(cards,$suit) end]
        }
    }
    set idx [lsearch $CARD($who) $card]
    return $idx
 }

 proc Help {} {
    catch {destroy .helper}
    toplevel .helper
    wm transient .helper .
    wm title .helper "$::S(title) Help"
    if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
        wm geom .helper "+[expr {$wx+35}]+[expr {$wy+35}]"
    }
    set w .helper.t
    text $w -wrap word -width 70 -height 29 -pady 10
    button .helper.quit -text Dismiss -command {catch {destroy .helper}}
    pack .helper.quit -side bottom
    pack $w -side top -fill both -expand 1

    $w tag config title -justify center -font {{Times Roman} 18 bold}
    $w tag config header -font "[font actual [$w cget -font]] -weight bold" \
        -lmargin1 5 ;# -rmargin 5 -spacing3 1
    $w tag config n -lmargin1 5 -lmargin2 5 ;# -rmargin 5

    $w insert end "$::S(title)\nby Keith Vetter\n" title
    $w insert end "\nIntroduction" header
    $w insert end "This card game goes by several names including 31, " n
    $w insert end "Scat and Blitz. " n
    $w insert end "It uses a standard 52 card deck, with aces worth 11, " n
    $w insert end "face cards worth 10, and all other cards worth their " n
    $w insert end "pip value.\n\n" n

    $w insert end "Object" header
    $w insert end "The object of the game is to collect cards in one�s " n
    $w insert end "hand totaling as close to 31 as possible in the same " n
    $w insert end "suit.\n\n" n

    $w insert end "Play" header
    $w insert end "The player to the dealer's left begins and the turn " n
    $w insert end "passes clockwise around the table. A normal turn consists " n
    $w insert end "drawing a card from the stock or discard pile, then " n
    $w insert end "discarding one card to the discard pile.\n\n" n

    $w insert end "Knocking" header
    $w insert end "If at the start of your turn you think that your hand " n
    $w insert end "is not the lowest you can KNOCK instead of drawing. " n
    $w insert end "Each other player gets one final turn. Then, all the " n
    $w insert end "hands are revealed and scored.\n\n" n

    $w insert end "Scoring" header
    $w insert end "The player with the lowest hand loses a life. If there " n
    $w insert end "is a tie, then all of those players lose a life, except " n
    $w insert end "the knocker. If the knocker has the lowest hand, he loses " n
    $w insert end "2 lives.\n\n"

    $w insert end "Blitz" header
    $w insert end "A blitz is when a player gets a hand totalling 31, and " n
    $w insert end "all other players lose a life.\n\n" n

    $w config -state disabled
 }
 ################################################################
 # Card images from Patience card game, see
 #   http://uebb.cs.tu-berlin.de/~krischan/patience/patience-english.html
 #   http://tcl.tk/starkits/patience.kit
 source card_img.tcl
 ################################################################
 DoDisplay
 NewGame

Category Games | Tcl/Tk games | Category Application