[Keith Vetter] - Here's a two-player version of the popular Pente game. 
The object of the game is to get five pieces in a row, or to capture ten of your opponents pieces. 
This program can also play be the newer Keryo rule set.

[AK]: I believe that I know this game under the name ''Gobang''.

[Dan Knapp]: It's also called "Gomoku".

[http://mini.net/pub/pente.png]
----
======
 ##+##########################################################################
 #
 # tkPente -- Plays pente between two players, both classic and Keryo rules
 #

 package require Tk

 ##+##########################################################################
 #
 # init - One time initializtion stuff
 #
 proc init {} {
    global cl st sz bd

    set st(rules) pente
    set cl(1) green3
    set cl(1,m) #00A000
    set cl(-1) blue
    set cl(-1,m) #000080
    set cl(bg) burlywood3
    set cl(bg) [::tk::Darken burlywood3 110]
    set cl(bg2) [::tk::Darken $cl(bg) 110]      ;# For button active

    set cl(fn) "-Adobe-Helvetica-Bold-R-Normal--*-140-*-*-*-*-*-*"
    set cl(fn2) "-Adobe-Courier-Bold-R-Normal--*-100-*"
    catch {set cl(fn2) [font create -family courier -size 10 -weight bold]}

    set sz(pip) 16                              ;# Size of a pip
    set sz(pip2) [expr {$sz(pip) / 2}]
    set sz(gap) 2                               ;# Gap between pips
    set sz(gap2) [expr {$sz(gap) / 2}]
    set sz(pipg) [expr {$sz(pip) + $sz(gap)}]   ;# Pip size plus gap
    set sz(sq)  18                              ;# Number of lines
    set sz(sq2) [expr {$sz(sq)/2}]
    set sz(bd)  $sz(pip2)                       ;# Border around edge

    set sz(size)  [expr {$sz(pipg) * $sz(sq) + 2*$sz(bd)}]
    set sz(size2) [expr {$sz(size) / 2}]

    set sz(side)  [expr {2 * $sz(pip) + 4*$sz(gap)}]
    set sz(side2) [expr {$sz(side) / 2}]

    new_game                                    ;# Do per game init
 }
 ##+##########################################################################
 #
 # new_game - Per game initialization stuff
 #
 proc new_game {} {
    global sz bd cl st

    set st(t) 1                                 ;# Whose turn it is
    set st(n) 1                                 ;# Turn number
    set st(v) 0                                 ;# Someone has won
    set st(cl) $cl($st(t))                      ;# Active color
    set st(cl,m) $cl($st(t),m)                  ;# Active color for mouse move
    set st(capt,1) 0                            ;# Number of captures
    set st(capt,-1) 0
    set st(capt,sum,1) 0                        ;# Number of captured pieces
    set st(capt,sum,-1) 0
    set st(undo) ""
    set st(redo) ""
    set st(c) ""
    set st(msg) ""

    ;# Initialize the board
    for {set r -$sz(sq2)} {$r <= $sz(sq2)} {incr r} {
        for {set c -$sz(sq2)} {$c <= $sz(sq2)} {incr c} {
            set bd($r,$c) 0
        }
    }

    catch {.c delete pip}                       ;# Erase the board
    catch {.p1 delete pip}
    catch {.p2 delete pip}

    catch {draw_turn_number $st(n)}
    catch {do_move 0 0}
    catch {.bundo config -state disabled}
    catch {.m.game.m entryconfigure 3 -state disabled}
    set st(undo) ""                             ;# Nothing to undo
 }
 ##+##########################################################################
 #
 # draw_board - Draws the playing board and sideboard with all its
 # lines and frills.
 #
 proc draw_board {} {
    global sz cl

    catch {destroy .ftop .c .p1 .p2}

    pack [frame .ftop] -side top
    canvas .c -width $sz(size) -height $sz(size) -bd 4 -relief raised
    .c config -cursor crosshair
    .c xview moveto 0 ; .c yview moveto 0
    .c config -bg $cl(bg)

    canvas .p1 -height $sz(size) -width $sz(side) -bg $cl(bg)
    canvas .p2 -height $sz(size) -width $sz(side) -bg $cl(bg)

    foreach w {.c .p1 .p2} {$w config -highlightthickness 0}
    pack .p1 .c .p2 -in .ftop -side left -fill y

    ;# Draw all the lines
    for {set i -$sz(sq2)} {$i <= $sz(sq2)} {incr i} {
        set width 1
        if {$i == 0} {set width 2}
        set c1 [pos2coord $i -$sz(sq2)]
        set c2 [pos2coord $i  $sz(sq2)]
        eval .c create line $c1 $c2 -width $width

        set c1 [pos2coord -$sz(sq2) $i]
        set c2 [pos2coord  $sz(sq2) $i]
        eval .c create line $c1 $c2 -width $width
    }

    ;# Draw little dots 3 out
    foreach {r c} {-3 -3 -3 3 3 3 3 -3} {
        set c1 [eval expand 3 [pos2coord $r $c]]
        .c create oval $c1 -fill $cl(bg)
    }

    set row [expr {.5 - $sz(sq2)}]
    for {set i 0} {$i < 4} {incr i} {
        foreach {x y} [pos2coord $row [expr {-8.5 + $i}]] {}
        set text [string index "Turn" $i]
        .c create text $x $y -text $text -anchor c
    }

    .c create text [pos2coord $row -3.5] -text "" -anchor c -tag {label label1}
    .c create text [pos2coord $row -2.5] -text "" -anchor c -tag {label label2}
    .c create text [pos2coord $row -1.5] -text "" -anchor c -tag label3

    wm title . "tkPente    by Keith Vetter"

    bind .c <Motion> {mouse_move %x %y}
    bind .c <B1-ButtonRelease> {do_move2 %x %y}
    bind .c <Leave> {.c delete cursor ; set st(c) ""}
    bind .c <Shift-Button-3> {null_turn %x %y}
 }
 ##+##########################################################################
 #
 # draw_side - Draws the frills for the side capture panels
 #
 proc draw_side {} {
    global sz cl

    set text "CAPTURES"
    set tlen [string length $text]

    set top [expr {-$sz(sq2) + .5}]
    set interval [expr {-2*$top / ($tlen - 1)}]

    for {set i 0} {$i < $tlen} {incr i} {
        set letter [string index $text $i]
        set row [expr {$top + $interval * $i}]
        set y [lindex [pos2coord $row 0] 1]
        .p1 create text $sz(side2) $y -anchor c -text $letter -font $cl(fn)
        .p2 create text $sz(side2) $y -anchor c -text $letter -font $cl(fn)
    }
 }
 ##+##########################################################################
 #
 # draw_pip - Draws a pip at given row and column
 #
 proc draw_pip {r c color {tags ""}} {
    global sz

    set cl [eval expand $sz(pip2) [pos2coord $r $c]]
    lappend tags p_${r}_$c pip
    set id [.c create oval $cl -fill $color -tag $tags]
    .c itemconfig $id -outline white
    return $id
 }
 ##+##########################################################################
 #
 # draw_pip_xy - Like draw_pip but for any window and any coordinate
 #
 proc draw_pip_xy {w x y color {tags ""}} {
    global sz

    set cl [expand $sz(pip2) $x $y]
    lappend tags pip
    set id [$w create oval $cl -fill $color -tag $tags]
    $w itemconfig $id -outline white

    return $id
 }
 ##+##########################################################################
 #
 # undraw_pip - Erases a pip at row, column
 #
 proc undraw_pip {r c} {
    .c delete p_${r}_$c
 }
 ##+##########################################################################
 #
 # draw_capture - Draws the captured pip in the side capture panels
 #
 proc draw_capture {who cnt type} {
    global st sz cl

    if {$cnt <= 0 || $cnt > 8} return
    if {$st(rules) == "pente" && $cnt > 5} return ;# Out of range

    set w ".p[expr {(3 - $who) / 2}]"           ;# Which window

    set text "CAPTURES"
    set tlen [string length $text]
    set top [expr {-$sz(sq2) + .5}]
    set interval [expr {-2*$top / ($tlen - 1)}]
    set row [expr {$top - .5 + $interval * ($cnt - .5)}]
    set y [lindex [pos2coord $row 0] 1]

    set x1 [expr {$sz(side2) - $sz(gap2) - $sz(pip2)}]
    set x2 [expr {$sz(side2) + $sz(gap2) + $sz(pip2)}]

    set color $cl([expr {-$who}])
    draw_pip_xy $w $x1 $y $color pip$cnt
    draw_pip_xy $w $x2 $y $color pip$cnt
    if {$type == 1} return

    set x $sz(side2)
    set y [lindex [pos2coord [expr {$row + .9}] 0] 1]
    draw_pip_xy $w $x $y $color pip$cnt

 }
 ##+##########################################################################
 #
 # draw_turn_number - Updates the turn number on the board
 #
 proc draw_turn_number {n} {

    set n [expr {($n+1) / 2}]
    .c itemconfig label3 -text [expr {$n % 10}]
    .c itemconfig label -text ""                ;# Erase upper digits
    if {$n >= 10} {                             ;# Draw upper digits if needed
        .c itemconfig label2 -text [expr {($n / 10) % 10}]
        if {$n >= 100} {
            .c itemconfig label1 -text [expr {($n / 100) % 10}]
        }
    }
 }
 ##+##########################################################################
 #
 # darken_all - Used after a victory to darken all but the winning combination
 #
 proc darken_all {who n pips} {
    global cl
    .c itemconfig  pip1  -fill $cl( 1,m) -outline gray80
    .c itemconfig  pip-1 -fill $cl(-1,m) -outline gray80
    .p1 itemconfig pip   -fill $cl(-1,m) -outline gray80
    .p2 itemconfig pip   -fill $cl( 1,m) -outline gray80

    if {$n == 2} {                              ;# Win by capture
        set w ".p[expr {(3 - $who) / 2}]"
        $w itemconfig pip -fill $cl([expr {-$who}]) -outline white
        return
    }
    foreach p $pips {
        .c itemconfig $p -fill $cl($who) -outline white
    }
 }
 ##+##########################################################################
 #
 # undarken_all - Undoes the affect of darken_all
 #
 proc undarken_all {} {
    global cl

    .c itemconfig  pip1  -fill $cl( 1) -outline white
    .c itemconfig  pip-1 -fill $cl(-1) -outline white
    .p1 itemconfig pip   -fill $cl(-1) -outline white
    .p2 itemconfig pip   -fill $cl( 1) -outline white
 }
 ##+##########################################################################
 #
 # draw_buttons - Draws the buttons below the board
 #
 proc draw_buttons {} {
    global cl
    set hlt highlightthickness

    frame .fmid -background $cl(bg) -bd 2 -relief ridge
    frame .fbot -background $cl(bg) -bd 2 -relief ridge
    pack .fbot .fmid -side bottom -expand y -fill x

    label .pl1 -text "Player 1" -bg $cl(1) -$hlt 0 -font $cl(fn) \
        -bd 2 -relief raised -pady 3 -padx 5
    label .pl2 -text "Player 2" -bg $cl(-1) -$hlt 0 -font $cl(fn) \
        -bd 2 -relief raised -pady 3 -padx 5
    label .msg -bg $cl(bg) -$hlt 0 -font $cl(fn) -textvariable st(msg)
    pack .pl1 -in .fmid -side left
    pack .pl2 -in .fmid -side right
    pack .msg -in .fmid -side left -expand 1 -fill x

    button .bundo -text Undo -command undo -state disabled
    button .bstart -text "New Game" -width 8 -command new_game -padx 5
    button .bquit -text Quit -command exit

     foreach b {.bundo .bstart .bquit} {
        $b config -bg $cl(bg) -activebackground $cl(bg2) -font $cl(fn) -$hlt 0
    }
    pack .bundo .bstart .bquit -in .fbot -side left -expand 1 -pady 2m
 }
 proc draw_menus {} {
    global cl

    frame .m -bg $cl(bg)
    pack .m -side top -fill x -expand yes
    menubutton .m.game -text Game -underline 0 -menu .m.game.m -relief flat \
         -bg $cl(bg) -activebackground $cl(bg) -bd 2
    menubutton .m.help -text Help -underline 0 -menu .m.help.m -relief flat \
         -bg $cl(bg) -activebackground $cl(bg) -bd 2
    foreach w [list .m.help .m.game] {
        bind $w <Enter> [list $w config -relief raised]
        bind $w <Leave> [list $w config -relief flat]
    }
    pack .m.game .m.help -side left

    menu .m.game.m -tearoff 0 -bg $::cl(bg)
    .m.game.m add radio -label "Standard Pente" -under 0 \
        -value pente -variable st(rules) -command new_game
    .m.game.m add radio -label "Keryo Pente" -under 0 \
        -value keryo -variable st(rules) -command new_game
    .m.game.m add separator

    .m.game.m add command -label Undo       -under 0 -command undo -state disabled
    .m.game.m add separator
    .m.game.m add command -label "New Game" -under 0 -command new_game
    .m.game.m add separator
    .m.game.m add command -label Exit       -under 0 -command exit

    menu .m.help.m -tearoff 0 -bg $::cl(bg)
    .m.help.m add command -label Help -underline 0 -command help

    return
    menu .m -tearoff 0
    . configure -menu .m                 ;# Attach menu to main window

    # Top level menu buttons
    .m add cascade -menu .m.game -label "Game" -underline 0
    .m add cascade -menu .m.help -label "Help" -underline 0

    menu .m.game -tearoff 0
    .m.game add command -label Undo       -under 0 -command undo -state disabled
    .m.game add separator
    .m.game add command -label "New Game" -under 0 -command new_game
    .m.game add separator
    .m.game add command -label Exit       -under 0 -command exit

    menu .m.help -tearoff 0
    .m.help add command -label Help  -under 0 -command Help
 }
 ##+##########################################################################
 #
 # draw_cross_hairs - Draws some cross hairs on a given row,col
 #
 proc draw_cross_hairs {row col} {
    global cl

    .c delete cross                             ;# Get rid of old

    foreach {x y} [pos2coord $row $col] {}
    foreach {l t r b} [expand 4 $x $y] {}
    .c create line $l $b $r $t -tag cross -fill white -width 2
    .c create line $l $t $r $b -tag cross -fill white -width 2
    return

 }
 #############################################################################
 #############################################################################

 ##+##########################################################################
 #
 # pos2coord - Converts row,col into x,y
 #
 proc pos2coord {r c} {
    global sz

    set r [expr {$r + $sz(sq2)}]
    set c [expr {$c + $sz(sq2)}]
    set x [expr {$sz(bd) + $c * $sz(pipg)}]
    set y [expr {$sz(bd) + $r * $sz(pipg)}]

    return [list $x $y]
 }
 ##+##########################################################################
 #
 # coord2pos - Converts x,y into row,col
 #
 proc coord2pos {x y} {
    global sz

    set x [expr {round($x + $sz(pip2))}]
    set y [expr {round($y + $sz(pip2))}]
    set r [expr {(($y - $sz(bd)) / $sz(pipg)) - $sz(sq2)}]
    set c [expr {(($x - $sz(bd)) / $sz(pipg)) - $sz(sq2)}]

    return [list $r $c]
 }
 ##+##########################################################################
 #
 # expand - Grows rectangle a,b,c,d by n units
 #
 proc expand {n a b {c -999} {d -999}} {
    if {$c == -999} { set c $a ; set d $b }
    return [list [expr {$a - $n}] [expr {$b - $n}] \
                [expr {$c + $n}] [expr {$d + $n}]]
 }
 ##+##########################################################################
 #
 # mouse_move - Handles drawing a pip under the mouse as it moves.
 #
 proc mouse_move {x y} {
    global st bd

    if $st(v) return                            ;# Game over
    set x [.c canvasx $x]                       ;# Convert to canvas coordinates
    set y [.c canvasy $y]

    foreach {r c} [coord2pos $x $y] {}

    if {$st(n) == 3 && $r < 3 && $r > -3 && $c < 3 && $c > -3} {
        .c delete cursor                        ;# Restricted move
        set st(c) ""
        return
    }
    set m [list $r $c]
    if [string match $m $st(c)] return          ;# In the same location
    set st(c) ""
    .c delete cursor
    if {[info exists bd($r,$c)] && $bd($r,$c) == 0} {
        draw_pip $r $c $st(cl,m) cursor
        set st(c) $m
    }
    update
 }
 ##+##########################################################################
 #
 # do_move2 - Like do_move but with coordinates in x,y instead of row, column
 #
 proc do_move2 {x y} {
    set x [.c canvasx $x]
    set y [.c canvasy $y]
    eval do_move [coord2pos $x $y]
 }
 ##+##########################################################################
 #
 # do_move - Handles a move to row, column by the current player
 #
 proc do_move {r c} {
    global bd st cl

    .c delete cursor ; set st(c) ""             ;# Delete mouse cursor
    if $st(v) return                            ;# Game over
    if {$bd($r,$c) != 0} { return [bell] }
    if {$st(n) == 3 && $r < 3 && $r > -3 && $c < 3 && $c > -3} {
        bell                                    ;# This move is restricted
        return
    }

    set id [draw_pip $r $c $st(cl) pip$st(t)]   ;# Draw the pip here
    draw_cross_hairs $r $c
    set bd($r,$c) $st(t)
    set capture [check_capture $r $c $st(t)]
    foreach {cnt cnt3} $capture break
    set undo [concat $r $c $capture]
    set st(undo) "[list $undo] $st(undo)"
    if {[info exists ::debug] && $::debug == 1} {
        puts "capture $capture"
        puts "undo $undo"
        puts "st(undo) $st(undo)"
    }
    .bundo config -state normal
    .m.game.m entryconfigure 3 -state normal

    if {$cnt > 0} {                             ;# Draw the captures
        set capt $st(capt,$st(t))
        incr st(capt,$st(t)) $cnt               ;# One more capture event
        incr st(capt,sum,$st(t)) [expr {2 * $cnt + $cnt3}]

        for {set i [incr capt]} {$i <= $st(capt,$st(t))} {incr i} {
            draw_capture $st(t) $i [expr {[incr cnt3 -1] >= 0 ? 2 : 1}]
        }
    }

    draw_turn_number [incr st(n)]               ;# New turn
    foreach {w pips} [check_win $r $c $st(t)] break ;# Did someone win?
    if {$w != 0} {                              ;# A VICTORY!!!
        set who [expr {$st(t) == 1 ? 1 : 2}]    ;# Who won
        if {$w == 3} {
            set st(msg) "Player $who won -- 15 captures"
        } elseif {$w == 2} {
            set st(msg) "Player $who won -- 5 captures"
        } else {
            set st(msg) "Player $who won -- 5 in a row"
        }
        darken_all $st(t) $w $pips
        set st(v) 1
    }
    change_turn
    return $id
 }
 ##+##########################################################################
 #
 # null_turn - Lets the user skip a turn. Useful for setting up a board.
 # Works by pretending the user moved to -999,-999.
 #
 proc null_turn {x y} {
    global st

    .c delete cursor cross
    draw_turn_number [incr st(n)]               ;# New turn
    change_turn                                 ;# Other person can go
    set st(c) ""
    mouse_move $x $y

    set st(undo) "{-999 -999 0 0} $st(undo)"
 }
 ##+##########################################################################
 #
 # change_turn - Changes the state to be the other players turn.
 #
 proc change_turn {} {
    global st cl

    set st(t) [expr {-$st(t)}]                  ;# Change whose turn it is
    set st(cl) $cl($st(t))                      ;# Active color
    set st(cl,m) $cl($st(t),m)                  ;# Active color for mouse move
 }
 ##+##########################################################################
 #
 # check_capture - Sees what pieces have been captured
 #
 proc check_capture {r c me} {
    global bd st

    set cnt 0
    set cnt3 0                                  ;# Triple captures
    set you [expr {-$me}]
    set undo ""                                 ;# So we can undo it
    foreach {dr dc} {-1 0   -1 -1   -1 1  0 -1   1 -1   1 0   1 1   0 1} {
        set r1 [expr {$r + $dr}]
        set c1 [expr {$c + $dc}]

        if {[info exists bd($r1,$c1)] == 0 || $bd($r1,$c1) != $you} continue
        set r2 [expr {$r1 + $dr}] ; set c2 [expr {$c1 + $dc}]
        if {[info exists bd($r2,$c2)] == 0 || $bd($r2,$c2) != $you} continue
        set r3 [expr {$r2 + $dr}] ; set c3 [expr {$c2 + $dc}]
        if {[info exists bd($r3,$c3)] == 0 || $bd($r3,$c3) != $me} {
            if {$st(rules) == "pente"} continue
            if {[info exists bd($r3,$c3)] == 0 || $bd($r3,$c3) != $you} continue
            set r4 [expr {$r3 + $dr}] ; set c4 [expr {$c3 + $dc}]
            if {[info exists bd($r4,$c4)] == 0 || $bd($r4,$c4) != $me} continue

            set bd($r3,$c3) 0
            undraw_pip $r3 $c3
            lappend undo [list $r3 $c3]
            incr cnt3
        }

        set bd($r1,$c1) 0
        undraw_pip $r1 $c1
        set bd($r2,$c2) 0
        undraw_pip $r2 $c2
        incr cnt
        lappend undo [list $r1 $c1] [list $r2 $c2]
    }
    return [concat $cnt $cnt3 $undo]
 }
 ##+##########################################################################
 #
 # check_win - Checks to see if anyone has won
 #
 proc check_win {r c me} {
    global bd st

    if {$bd($r,$c) != $me} { return 0 }

    foreach {dr dc} {0 1  1 1  1 0  1 -1} {
        foreach {n pips} [adjacents $r $c $dr $dc] {}
        if {$n < 5} continue

        return [list 1 $pips]
    }

    if {$st(rules) == "pente" && $st(capt,$me) >= 5} { return 2 }
    if {$st(capt,sum,$me) >= 15} { return 3 }
    return 0
 }
 ##+##########################################################################
 #
 # adjacents - Returns a list of all pips of the same color to row,col
 # in the line dr, dc.
 #
 proc adjacents {r c dr dc} {
    global bd

    set which "p_${r}_$c"                       ;# Matches in dr,dc dir
    set who $bd($r,$c)

    for {set rr $r; set cc $c} {1} {} {
        set rr [expr {$rr + $dr}] ; set cc [expr {$cc + $dc}]
        if {[info exists bd($rr,$cc)] == 0 || $bd($rr,$cc) != $who} break
        lappend which p_${rr}_$cc
    }
    for {set rr $r; set cc $c} {1} {} {
        set rr [expr {$rr - $dr}] ; set cc [expr {$cc - $dc}]
        if {[info exists bd($rr,$cc)] == 0 || $bd($rr,$cc) != $who} break
        lappend which p_${rr}_$cc
    }

    return [list [llength $which] $which]
 }
 ##+##########################################################################
 #
 # undo - Undoes the last move
 #   {r c captures 3captures {capture pips 1} {capture pips2}}
 #
 proc undo {} {
    global st bd cl

    undarken_all                                ;# Undo victory signs
    set st(v) 0
    set st(msg) ""

    change_turn                                 ;# Back to prev. turn

    set me $st(t)
    set you [expr {-$me}]
    set cl2 $cl($you)
    set w ".p[expr {(3 - $me) / 2}]"            ;# Which window

    set event [lindex $st(undo) 0]              ;# Event to undo
    set st(undo) [lrange $st(undo) 1 end]

    foreach {r c cnt cnt3} $event break

    if {$r != -999} {
        set bd($r,$c) 0                         ;# Remove pip from board
        undraw_pip $r $c

        foreach c [lrange $event 4 end] {       ;# Undo capture events
            foreach {rr cc} $c {}
            set bd($rr,$cc) $you
            draw_pip $rr $cc $cl2 pip$you       ;# Draw the pip here
        }
    }
    if {$cnt > 0} {                             ;# Undo any captures
        incr st(capt,sum,$me) [expr {-2 * $cnt - $cnt3}]
        while {[incr cnt -1] >= 0} {
            $w delete pip$st(capt,$me)          ;# Undraw capture on sidebar
            incr st(capt,$me) -1
        }
    }
    ;# Update the cross hairs
    set e [lindex "$st(undo) {0 0}" 0]
    draw_cross_hairs [lindex $e 0] [lindex $e 1]

    draw_turn_number [incr st(n) -1]    ;# Go back a turn

    if {$st(undo) == ""} {
        .bundo config -state disabled
        .m.game.m entryconfigure 3 -state disabled
    }
 }
 proc help {} {
    catch {destroy .help}
    toplevel .help
    wm transient .help .
    wm title .help "TkPente Help"
    if {[regexp {(\+[0-9]+)(\+[0-9]+)$} [wm geom .] => wx wy]} {
        wm geom .help "+[expr {$wx+35}]+[expr {$wy+35}]"
    }
    set w .help.t
    text $w -wrap word -width 70 -height 31 -pady 10 -padx 5
    button .help.quit -text Dismiss -command {catch {destroy .help}}
    pack .help.quit -side bottom
    pack $w -side top -fill both -expand 1

    $w tag config header -justify center -font bold -foreground red
    $w tag config header2  -justify center -font bold
    set margin  [font measure [$w cget -font] " o "]
    set margin2 [font measure [$w cget -font] " o - "]
    $w tag config bullet -lmargin2 $margin
    $w tag config bullet -font "[font actual [$w cget -font]] -weight bold"
    $w tag config n -lmargin1 $margin -lmargin2 $margin

    $w insert end "TkPente" header "\nby Keith Vetter\n\n" header2

    set m "Pente, or Five-in-a-row type games are very old. In Japan "
    append m "they have been played on a Go board for over a thousand years. "
    append m "Pente was introduced to US in the late seventies and added a "
    append m "twist to the general five-in-a-row idea: the ability to capture "
    append m "opponent pieces.\n\n"
    $w insert end "Overview\n" bullet $m n

    set m "You win by either getting five (or more) stones in a row, "
    append m "horizontally, vertically, or diagonally, with no empty points "
    append m "between them, or by capturing five (or more) pairs of your "
    append m "opponent's stones.\n\n"
    $w insert end "Object of the Game\n" bullet $m n

    set m "Players alternate turns, with the first player starting in the "
    append m "middle. To balance the first player's slight advantage of "
    append m "going first, his second move is restricted to be at least "
    append m "two places of the center. If a move results in a capture, the "
    append m "captured pieces are removed from the board.\n\n"
    $w insert end "How to Play\n" bullet $m n

    set m "If placing your piece results in two adjacent pieces of your "
    append m "opponents being bracketed by your pieces, your opponent's "
    append m "pieces are captured and removed from the board. Note, a single "
    append m "move can result in multiple captures.\n\n"
    $w insert end "Captures\n" bullet $m n

    set m "Introduced in 1983, Keryo Pente is now perhaps the \"preferred\" "
    append m "way to play pente. In Keryo Pente all normal rules apply except "
    append m "that 1) triple captures are also allowed and 2) you need to "
    append m "15 of your opponents pieces to win."
    $w insert end "Keryo Pente\n" bullet $m n

    $w config -state disabled
 }
 ##+##########################################################################
 #############################################################################

 init                                            ;# One time initialization
 draw_menus
 draw_board                                      ;# Draw the board
 draw_side                                       ;# And the capture side bars
 draw_buttons                                    ;# And the buttons
 new_game                                        ;# Begin the game
======

[uniquename] 2013aug01

The image above, at 'external site' mini.net, has gone dead. Here are a couple of 'locally stored' images, on this wiki site --- of the game board and of the game's help window.

[vetter_tkPente_gameBoard_screenshot_431x489.jpg]

[vetter_tkPente_helpWindow_screenshot_508x601.jpg]

<<categories>> Application | Games