64-line TCL reverse

    On a habr already there are topics about writing the game Reversi (Othello) in Python , Silverlight .
    Invent the bike on Tcl / Tk. Cross-platform (even works on Windows Mobile with a little modification), only 64 lines.

    image

    Code, a small description and a screen with WinMobile under habrakat.


    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 the 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 "There is $ :: 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 more convenient to work with coordinates, create an icells list (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, working with the canvas and event binding (evuser) when you click on the cell.

    Global variables:
    vs - a hash array, defines the ID of opponents, chip colors. vs (1) = 2; vs (2) = 1 .
    score - score (the number of black and white chips)
    player - configuration of players (1 - person, 2 - computer)
    board - playing field
    cur - identifier of the current player
    waituser - flag for waiting for user progress

    Consider the declared functions.
    newgame {p1 p2}
    The beginning of a new game. The arguments determine the type of player:
    1 - Man
    2 - Computer

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

    pieceset {xyp}
    Sets the player’s chip p, in the cell x, y
    Recalculates the current score . Here is a little magic
    incr :: score ($ p) [expr {+ ($ :: board ($ x, $ y)! = $ p)}]
    incr :: score ($ :: vs ($ p)) [expr {- ($ :: board ($ x, $ y) == $ :: vs ($ p))}].
    


    We increase the score of the current player p, and his opponent $ vs ($ p)
    For the current player, if his chip was not already in the cage, then +1 otherwise +0
    If the opponent’s chip was worth, then he will be reduced by -1.

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

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

    evuser {xy}
    A procedure 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 transfer control to the opponent:
    set :: cur $ :: vs ($ :: cur); after idle waitturn}}

    turn {xyp}
    Make a move at x y. Flip the captured enemy chips, if successful - returns 1, otherwise 0.

    Links:
    Reversing Wikipedia
    ActiveTcl (Tcl distribution for Windows / OSX / Linux)
    eTcl (Windows Mobile)


    And finally, a screen from Windows Mobile
    image

    UPD:
    Screenshot from Ubuntu . True, in order to bring it to normal view, I connected the Star Code tile-gtk

    Google Code
    module and Windows build (1.2 mb)

    Also popular now: