Reversi on TCL in 64 lines

On Habré already have topics about writing the game Reversi (Othello) in Python , Silverlight .
Let's invent a bike on Tcl / Tk. Cross platform (works even on Windows Mobile with a small modification), just 64 lines.



The code, a small description and screen with WinMobile under habrakatom.

')
Source (reversi.tcl):

 package require Tk 8.5
 for {set i 0} {$ i <64} {incr i} {lappend icells [expr {$ i / 8}] [expr {$ i% 8}]}
 array set vs [list 1 2 2 1 cl, 1 black cl, 2 white pn, 1 black pn, 2 white]
 ttk :: button .b1 -text "New game" -command {newgame 1 2}
 ttk :: button .b2 -text "Exit" -command {exit}
 ttk :: label .l1 -text "Welcome to Reversi game"
 canvas .cv -width 479 -height 479
 grid rowconfigure.  1-weight 1
 grid columnconfigure.  2-weight 1
 grid .b1 .b2 .l1 -padx 4 -pady 4 -sticky e
 grid .cv -padx 4 -pady 4 -columnspan 3
 foreach {xy} $ icells {
   set cr1 [list [expr {$ x * 60 + 2}] [expr {$ y * 60 + 2}] [expr {$ x * 60 + 60}] [expr {$ y * 60 + 60}]]
   set cr2 [list [expr {$ x * 60 + 4}] [expr {$ y * 60 + 4}] [expr {$ x * 60 + 58}] [expr {$ y * 60 + 58}]]
   .cv create rectangle $ cr1 -fill gray -tag "cell, $ x, $ y"
   .cv create oval $ cr2 -state hidden -tag "piece $ x, $ y"
   .cv bind cell, $ x, $ y <1> [list evuser $ x $ y]}
 proc pieceset {xyp} {
   .cv itemconfigure $ x, $ y -state normal -fill $ :: vs (cl, $ p)
   incr :: score ($ p) [expr {+ ($ :: board ($ x, $ y)! = $ p)}]]
   incr :: score ($ :: vs (p)) [expr {- ($ :: board ($ x, $ y) == $ $ vs ($ p))}]
   set :: board ($ x, $ y) [list $ p]}
 proc newgame {p1 p2} {
   .cv itemconfigure piece -state hidden
   array set :: score [list 0 0 1 0 2 0]
   array set :: player [list 1 $ p1 2 $ p2]
   foreach {xy} $ :: icells {set :: board ($ x, $ y) 0}
   foreach {xys} {3 3 2 4 4 2 3 4 1 4 3 1} {pieceset $ x $ y $ s}
   set :: cur 1;  waitturn}
 proc getflips {xyp} {
   if {$ :: board ($ x, $ y)! = 0} return;
   set result {}
   foreach {ix iy} {0 -1 0 1 -1 0 1 0 -1 -1 1 1 1 1 -1 -1 1} {
     set temp {}
     for {set i [expr {$ x + $ ix}];  set j [expr {$ y + $ iy}]} \
         {[info exists :: board ($ i, $ j)]} {incr i $ ix;  incr j $ iy} {
         switch - $ :: board ($ i, $ j) \
           $ :: vs ($ p) {lappend temp $ i $ j} \
           $ p {foreach {mn} $ temp {lappend result $ m $ n};  break} \
           0 {break}
   }}
   return $ result}
 proc waitturn {} {
   .l1 configure -text "Go $ :: vs (pn, $ :: cur) ($ :: score (1): $ :: score (2))"
   array set v [list $ :: cur {} $ :: vs ($ :: cur) {}]  
   foreach {xy} $ :: icells {
     set l [getflips $ x $ y $ :: cur];  if {[llength $ l]} {lappend v ($ :: cur) [list $ x $ y]}
     set l [getflips $ x $ y $ :: vs ($ :: cur)];  if {[llength $ l]} {lappend v ($ :: vs ($ :: cur)) [list $ x $ y]}}
   if {[llength $ v ($ :: cur)] == 0 && [llength $ v ($ :: vs ($ :: cur))] == 0} {
     tk_messageBox -title "Reversi" -message "Game over";  return}
   if {$ :: player ($ :: cur) == 1 && [llength $ v ($ :: cur)]} {
     set :: waituser 1;  return}
   if {$ :: player ($ :: cur) == 2 && [llength $ v ($ :: cur)]} {
     set :: waituser 0
     set :: flip [lindex $ v ($ :: cur) [expr {int ([llength $ v ($ :: cur)] * rand ())}]]]
     turn [lindex $ :: flip 0] [lindex $ :: flip 1] $ :: cur}
   set :: cur $ :: vs ($ :: cur);  after idle waitturn}
 proc evuser {xy} {
   if {[info exists :: waituser] && $ :: waituser && [turn $ x $ y $ :: cur]} {
     set :: cur $ :: vs ($ :: cur);  after idle waitturn}}
 proc turn {xyp} {
   set flips [getflips $ x $ y $ p]
   foreach {ij} $ flips {pieceset $ i $ j $ p}
   if {[llength $ flips]} {pieceset $ x $ y $ p;  return 1} else {return 0}}

To make it easier to work with coordinates, create a list of icells (0 0 0 1 ... 1 1 1 2 ..).
In the future, instead of a nested loop, we can use foreach {xy} $ icells .

Next is the creation of the interface, work with the canvas and event binding (evuser) when you click on the cell.

Global Variables:
vs - hash array, identifies opponents ID, color of chips. vs (1) = 2; vs (2) = 1 .
score - score (number of black and white chips)
player - player configuration (1 - person, 2 - computer)
board - playing field
cur - current player id
waituser - flag waiting user progress

Consider the declared functions.
newgame {p1 p2}
Start a new game. Arguments determine the type of player:
1 person
2 - Computer

In other matters, AI is absolutely not here, but you can see how they will play Random vs Random by passing {2 2}

pieceset {xyp}
Sets the player's chip p, in the cell x, y
Recalculates current account. Here is a little magic

 incr :: score ($ p) [expr {+ ($ :: board ($ x, $ y)! = $ p)}]]
 incr :: score ($ :: vs (p)) [expr {- ($ :: board ($ x, $ y) == $ :: vs ($ p))}].

We are increasing the current player's account p, and his opponent $ vs ($ p)
For the current player, if his chip is not yet in the cell, then +1 otherwise +0
If the opponent's chip cost, then we reduce the score to -1.

getflips {xyp}
Returns a list of all possible chips that a player ( p ) can capture by going to xy

waitturn {}
Waiting for a move.
Determines the number of all possible moves for each player. Decides when the game is over and who should make the move now.

evuser {xy}
The procedure is called every time a person clicks on one of the cells.
If the global variable :: waituser is set and there is an opportunity to go to the current user, then we transfer control to the opponent:
set :: cur $ :: vs ($ :: cur); after idle waitturn}}

turn {xyp}
Make a move in x y. Turn over the captured opponent's chips, if it works, returns 1, otherwise 0.

References:
Reversi on Wikipedia
ActiveTcl (Tcl distribution for Windows / OSX / Linux)
eTcl (Windows Mobile)


And finally, the screen with Windows Mobile


UPD:
Screenshot from Ubuntu . True, to bring to normal appearance, I connected the tile-gtk module.

Google code
Starkit and build under windows (1.2 mb)