[Tkabber-dev] r2167 - in trunk/tkabber-plugins: . battleship

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sat Dec 13 11:20:06 MSK 2014


Author: sergei
Date: 2014-12-13 11:20:06 +0300 (Sat, 13 Dec 2014)
New Revision: 2167

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/battleship/battleship.tcl
Log:
	* battleship/battleship.tcl: Fixed error with creating windows with
	  the same names. Fixed errors when flipping and/or dragging ships
	  with mouse pointer exactly between the edges of two adjacent cells.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2014-12-09 11:53:17 UTC (rev 2166)
+++ trunk/tkabber-plugins/ChangeLog	2014-12-13 08:20:06 UTC (rev 2167)
@@ -1,3 +1,9 @@
+2014-12-13  Sergei Golovan <sgolovan at nes.ru>
+
+	* battleship/battleship.tcl: Fixed error with creating windows with
+	  the same names. Fixed errors when flipping and/or dragging ships
+	  with mouse pointer exactly between the edges of two adjacent cells.
+
 2014-11-12  Sergei Golovan <sgolovan at nes.ru>
 
 	* otr/tclotr/otr.tcl: Evaluate external callback procedures at the top

Modified: trunk/tkabber-plugins/battleship/battleship.tcl
===================================================================
--- trunk/tkabber-plugins/battleship/battleship.tcl	2014-12-09 11:53:17 UTC (rev 2166)
+++ trunk/tkabber-plugins/battleship/battleship.tcl	2014-12-13 08:20:06 UTC (rev 2167)
@@ -15,6 +15,8 @@
 	return
     }
 
+    variable winid 0
+
     package require sha1
 
     variable square_size 27
@@ -121,6 +123,16 @@
         }
     }
 
+    foreach w [winfo children .] {
+	if {[regexp {^\.battleship_invite} $w]} {
+	    catch {
+		set wf [$w getframe]
+		bind $wf <Destroy> {}
+	    }
+	    destroy $w
+	}
+    }
+
     foreach var [info vars [namespace current]::*] {
         if {$var ne "[namespace current]::options"} {
             unset $var
@@ -142,11 +154,9 @@
 }
 
 proc battleship::invite_dialog {xlib jid} {
-    set w .battleship_invite
+    variable winid
 
-    if {[winfo exists $w]} {
-	destroy $w
-    }
+    set w .battleship_invite[incr winid]
 
     Dialog $w -title [::msgcat::mc "Battleship Invitation"] \
 	-separator 1 -anchor e -default 0
@@ -159,9 +169,9 @@
     pack $wf.message -pady 2m
 
     $w add -text [::msgcat::mc "I want to move first"] \
-	-command [namespace code [list invite $xlib $jid true]]
+	-command [namespace code [list invite $w $xlib $jid true]]
     $w add -text [::msgcat::mc "I want to move second"] \
-	-command [namespace code [list invite $xlib $jid false]]
+	-command [namespace code [list invite $w $xlib $jid false]]
     $w add -text [::msgcat::mc "Cancel invitation"] \
 	-command [list destroy $w]
 
@@ -168,8 +178,8 @@
     $w draw
 }
 
-proc battleship::invite {xlib jid first} {
-    destroy .battleship_invite
+proc battleship::invite {w xlib jid first} {
+    destroy $w
 
     set id battleship[random 1000000000]
 
@@ -187,8 +197,12 @@
 }
 
 proc battleship::invite_res {xlib jid id first status xml} {
+    variable winid
+
     if {![string equal $status ok]} {
-	after idle [list NonmodalMessageDlg .battleship_invite_error -aspect 50000 -icon error \
+	set w .battleship_invite_error[incr winid]
+
+	after idle [list NonmodalMessageDlg $w -aspect 50000 -icon error \
 	    -message [::msgcat::mc "%s (%s) has refused Battleship invitation: %s" \
 				   [chat::get_nick $xlib $jid chat] \
 				   $jid [error_to_string $xml]]]
@@ -199,11 +213,9 @@
 }
 
 proc battleship::invited_dialog {xlib jid iqid id first} {
-    set w .battleship_invited
+    variable winid
 
-    if {[winfo exists $w]} {
-	destroy $w
-    }
+    set w .battleship_invited[incr winid]
 
     Dialog $w -title [::msgcat::mc "Battleship Invitation from %s" $jid] \
 	      -modal none -separator 1 -anchor e -default 0
@@ -889,7 +901,7 @@
     set x [$board canvasx $x]
     set y [$board canvasy $y]
     $board dtag dst
-    $board addtag dst overlapping $x $y $x $y
+    $board addtag dst overlapping [expr {$x-1}] [expr {$y-1}] $x $y
     lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
 	    c1 r1
     $board dtag dst
@@ -929,7 +941,7 @@
     set state(lastx) [$board canvasx $x]
     set state(lasty) [$board canvasy $y]
     $board dtag dst
-    $board addtag dst overlapping $x $y $x $y
+    $board addtag dst overlapping [expr {$x-1}] [expr {$y-1}] $x $y
     lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
 	    state(startc) state(startr)
     $board dtag dst
@@ -1009,7 +1021,7 @@
     set x [expr {$x1 + $square_size/2}]
     set y [expr {$y1 + $square_size/2}]
     $board dtag dst
-    $board addtag dst overlapping $x $y $x $y
+    $board addtag dst overlapping [expr {$x-1}] [expr {$y-1}] $x $y
     lassign [lindex [lmatch -regexp [$board gettags dst&&mbackground] ^cr] 0] cr \
 	    c1 r1
     $board dtag dst
@@ -1365,7 +1377,7 @@
     $board itemconfigure dst_sq&&square -outline ""
     $board dtag dst_sq
     
-    $board addtag dst_sq overlapping $x $y $x $y
+    $board addtag dst_sq overlapping [expr {$x-1}] [expr {$y-1}] $x $y
     set tags [$board gettags dst_sq&&obackground]
     lassign [lindex $tags [lsearch $tags cr*]] cr c r
     $board addtag dst_sq withtag [list cr $c $r]&&square
@@ -1398,7 +1410,7 @@
     set x [$board canvasx $x]
     set y [$board canvasy $y]
     $board dtag dst_sq
-    $board addtag dst_sq overlapping $x $y $x $y
+    $board addtag dst_sq overlapping [expr {$x-1}] [expr {$y-1}] $x $y
 
     set tags [$board gettags dst_sq&&obackground]
     lassign [lindex $tags [lsearch $tags cr*]] cr c r



More information about the Tkabber-dev mailing list