[Tkabber-dev] r1400 - in trunk/tkabber-plugins: . renju

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Wed Apr 16 17:26:15 MSD 2008


Author: sergei
Date: 2008-04-16 17:26:14 +0400 (Wed, 16 Apr 2008)
New Revision: 1400

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/renju/renju.tcl
Log:
	* renju/renju.tcl: Implemented Renju game (without openings).


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2008-04-07 17:36:14 UTC (rev 1399)
+++ trunk/tkabber-plugins/ChangeLog	2008-04-16 13:26:14 UTC (rev 1400)
@@ -1,3 +1,7 @@
+2008-04-16  Sergei Golovan <sgolovan at nes.ru>
+
+	* renju/renju.tcl: Implemented Renju game (without openings).
+
 2008-03-23  Sergei Golovan <sgolovan at nes.ru>
 
 	* attline/msgs/de.msg: Updated German translation (thanks to Roger

Modified: trunk/tkabber-plugins/renju/renju.tcl
===================================================================
--- trunk/tkabber-plugins/renju/renju.tcl	2008-04-07 17:36:14 UTC (rev 1399)
+++ trunk/tkabber-plugins/renju/renju.tcl	2008-04-16 13:26:14 UTC (rev 1400)
@@ -20,14 +20,9 @@
 	lappend values $theme $theme
     }
 
-#    set game_names_list \
-#	[list \
-#	    gomoku:freestyle  [::msgcat::mc "Free-style Gomoku"] \
-#	    gomoku:standard   [::msgcat::mc "Standard Gomoku"] \
-#	    renju             [::msgcat::mc "Renju"] \
-#	]
     set game_names_list \
 	[list \
+	    renju             [::msgcat::mc "Renju"] \
 	    gomoku:freestyle  [::msgcat::mc "Free-style Gomoku"] \
 	    gomoku:standard   [::msgcat::mc "Standard Gomoku"] \
 	    gomoku:tournament [::msgcat::mc "Tournament Gomoku"] \
@@ -42,7 +37,7 @@
 	[::msgcat::mc "Gomoku/Renju figures theme."] -group Gomoku/Renju \
 	-type options -values $values \
 	-command [namespace current]::load_stored_theme
-    custom::defvar options(game) gomoku:freestyle \
+    custom::defvar options(game) renju \
 	[::msgcat::mc "Default game variant."] -group Gomoku/Renju \
 	-type options \
 	-values $game_names_list
@@ -102,6 +97,9 @@
     pack $wf.message -pady 2m
 
     variable game $options(game)
+    radiobutton $wf.renju -text [::msgcat::mc "Renju"] \
+	-value renju -variable [namespace current]::game
+    pack $wf.renju -padx 15m -anchor w
     radiobutton $wf.freestyle -text [::msgcat::mc "Free-style Gomoku"] \
 	-value gomoku:freestyle -variable [namespace current]::game
     pack $wf.freestyle -padx 15m -anchor w
@@ -111,9 +109,6 @@
     radiobutton $wf.tournament -text [::msgcat::mc "Tournament Gomoku"] \
 	-value gomoku:tournament -variable [namespace current]::game
     pack $wf.tournament -padx 15m -anchor w
-    radiobutton $wf.renju -text [::msgcat::mc "Renju"] \
-	-state disabled -value renju -variable [namespace current]::game
-    pack $wf.renju -padx 15m -anchor w
 
     $w add -text [::msgcat::mc "I want to move first"] \
 	-command [list [namespace current]::invite $connid $jid black]
@@ -565,7 +560,9 @@
 		set img "tf"
 	    } elseif {$r == 14} {
 		set img "bf"
-	    } elseif {$c == 7 && $r == 7} {
+	    } elseif {($c == 7 && $r == 7)  || ($c == 3 && $r == 3)  || \
+		      ($c == 3 && $r == 11) || ($c == 11 && $r == 3) || \
+		      ($c == 11 && $r == 11)} {
 		set img "cf"
 	    } else {
 		set img "mf"
@@ -1094,7 +1091,11 @@
 	    return [expr {$s1 == 5 || $s2 == 5 || $s3 == 5 || $s4 == 5}]
 	}
 	renju {
-	    # TODO
+	    if {[is_black $mover]} {
+		return [expr {$s1 == 5 || $s2 == 5 || $s3 == 5 || $s4 == 5}]
+	    } else {
+		return [expr {$s1 >= 5 || $s2 >= 5 || $s3 >= 5 || $s4 >= 5}]
+	    }
 	}
     }
 }
@@ -1126,6 +1127,191 @@
     highlight_legal_moves $gid
 }
 
+proc renju::is_overline {gid ct rt color} {
+    variable moves
+    variable $gid
+    upvar 0 $gid flags
+
+    # Assume that $ct $rt cell is empty
+
+    set mover [expr {[is_black $color] ? "b" : "w"}]
+
+    foreach dir {d1 d2 d3 d4 h1 h2 v1 v2} {
+	set str($dir) 0
+	foreach {x y} $moves($dir,$ct,$rt) {
+	    if {$flags(position,$x,$y) == $mover} {
+		incr str($dir)
+	    } else {
+		break
+	    }
+	}
+    }
+    set s1 [expr {1 + $str(d1) + $str(d3)}]
+    set s2 [expr {1 + $str(d2) + $str(d4)}]
+    set s3 [expr {1 + $str(h1) + $str(h2)}]
+    set s4 [expr {1 + $str(v1) + $str(v2)}]
+
+    return [expr {$s1 > 5 || $s2 > 5 || $s3 > 5 || $s4 > 5}]
+}
+
+proc renju::five {gid ct rt color dir} {
+    variable moves
+    variable $gid
+    upvar 0 $gid flags
+
+    # Assume that $ct $rt cell is empty
+
+    set mover [expr {[is_black $color] ? "b" : "w"}]
+
+    switch -- $dir {
+	d1 { set dir2 d3 }
+	d2 { set dir2 d4 }
+	d3 { set dir2 d1 }
+	d4 { set dir2 d2 }
+	h1 { set dir2 h2 }
+	h2 { set dir2 h1 }
+	v1 { set dir2 v2 }
+	v2 { set dir2 v1 }
+    }
+
+    set str {}
+    foreach d [list $dir $dir2] {
+	foreach {x y} $moves($d,$ct,$rt) {
+	    if {$flags(position,$x,$y) == $mover} {
+		lappend str [list $x $y]
+	    } else {
+		break
+	    }
+	}
+    }
+
+    # Return a list of row cells (all except $ct $rt)
+    if {[llength $str] == 4} {
+	return [lsort $str]
+    } else {
+	return {}
+    }
+}
+
+proc renju::straight_four {gid ct rt color dir} {
+    variable moves
+    variable $gid
+    upvar 0 $gid flags
+
+    # Assume that $ct $rt cell is empty
+
+    set mover [expr {[is_black $color] ? "b" : "w"}]
+
+    switch -- $dir {
+	d1 { set dir2 d3 }
+	d2 { set dir2 d4 }
+	d3 { set dir2 d1 }
+	d4 { set dir2 d2 }
+	h1 { set dir2 h2 }
+	h2 { set dir2 h1 }
+	v1 { set dir2 v2 }
+	v2 { set dir2 v1 }
+    }
+
+    set str {}
+    foreach d [list $dir $dir2] {
+	set open 0
+	foreach {x y} $moves($d,$ct,$rt) {
+	    if {!$open} {
+		if {$flags(position,$x,$y) == $mover} {
+		    lappend str [list $x $y]
+		} elseif {$flags(position,$x,$y) == ""} {
+		    # The row is open from $d side
+		    set open 1
+		} else {
+		    # The row is blocked
+		    return {}
+		}
+	    } else {
+		if {$flags(position,$x,$y) == $mover} {
+		    # The row is blocked by own stone
+		    return {}
+		} else {
+		    break
+		}
+	    }
+	}
+	if {!$open} {
+	    # The row is blocked by a border
+	    return {}
+	}
+    }
+
+    # Return a list of row cells (all except $ct $rt)
+    if {[llength $str] == 3} {
+	return [lsort $str]
+    } else {
+	return {}
+    }
+}
+
+proc renju::threes_and_fours {gid ct rt color dir} {
+    variable moves
+    variable $gid
+    upvar 0 $gid flags
+
+    # Assume that $ct $rt cell is empty
+
+    set mover [expr {[is_black $color] ? "b" : "w"}]
+
+    switch -- $dir {
+	d1 { set dir2 d3 }
+	d2 { set dir2 d4 }
+	d3 { set dir2 d1 }
+	d4 { set dir2 d2 }
+	h1 { set dir2 h2 }
+	h2 { set dir2 h1 }
+	v1 { set dir2 v2 }
+	v2 { set dir2 v1 }
+    }
+
+    foreach d [list $dir $dir2] {
+	set str4($d) {}
+	set str5($d) {}
+	foreach {x y} $moves($d,$ct,$rt) {
+	    if {$flags(position,$x,$y) == ""} {
+		# The row is open from $d side
+		set flags(position,$ct,$rt) $mover
+		set str4($d) [straight_four $gid $x $y $color $d]
+		if {$str4($d) == {}} {
+		    set str5($d) [five $gid $x $y $color $d]
+		}
+		set flags(position,$ct,$rt) ""
+		break
+	    } elseif {$flags(position,$x,$y) != $mover} {
+		break
+	    }
+	}
+    }
+
+    if {$str4($dir) == {} && $str4($dir2) == {}} {
+	set th 0
+    } elseif {$str4($dir) == $str4($dir2)} {
+	set th 1
+    } elseif {$str4($dir) == {} || $str4($dir2) == {}} {
+	set th 1
+    } else {
+	set th 2
+    }
+
+    if {$str5($dir) == {} && $str5($dir2) == {}} {
+	set fo 0
+    } elseif {$str5($dir) == $str5($dir2)} {
+	set fo 1
+    } elseif {$str5($dir) == {} || $str5($dir2) == {}} {
+	set fo 1
+    } else {
+	set fo 2
+    }
+
+    return [list $th $fo]
+}
+
 proc renju::check_legal {gid ct rt color} {
     variable moves
     variable $gid
@@ -1164,7 +1350,41 @@
 	    }
 	}
 	renju {
-	    # TODO
+	    if {![is_black $color]} {
+		return 1
+	    } else {
+		set hist [llength $flags(position,history)]
+		if {$hist == 0} {
+		    if {$ct == 7 && $rt == 7} {
+			return 1
+		    } else {
+			return 0
+		    }
+		}
+
+		foreach dir {d1 d2 h1 v1} {
+		    if {[llength [five $gid $ct $rt $color $dir]] == 4} {
+			return 1
+		    }
+		}
+
+		if {[is_overline $gid $ct $rt $color]} {
+		    return 0
+		}
+
+		set threes 0
+		set fours 0
+		foreach dir {d1 d2 h1 v1} {
+		    lassign [threes_and_fours $gid $ct $rt $color $dir] th fo
+		    incr threes $th
+		    incr fours $fo
+		}
+		if {$fours > 1 || $threes > 1} {
+		    return 0
+		} else {
+		    return 1
+		}
+	    }
 	}
     }
 }
@@ -1248,11 +1468,8 @@
     switch -- $game {
 	gomoku:freestyle -
 	gomoku:standard -
-	gomoku:tournament {}
-	renju {
-	    # TODO
-	    return
-	}
+	gomoku:tournament -
+	renju {}
 	default {
 	    return
 	}
@@ -1286,11 +1503,8 @@
     switch -- [jlib::wrapper:getattr $vars type] {
 	gomoku:freestyle -
 	gomoku:standard -
-	gomoku:tournament {}
-	renju {
-	    # TODO
-	    return
-	}
+	gomoku:tournament -
+	renju {}
 	default {
 	    return
 	}



More information about the Tkabber-dev mailing list