[Tkabber-dev] r819 - in trunk/tkabber-plugins: . whiteboard whiteboard/msgs

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Dec 3 23:02:00 MSK 2006


Author: sergei
Date: 2006-12-03 23:01:56 +0300 (Sun, 03 Dec 2006)
New Revision: 819

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/whiteboard/msgs/ru.msg
   trunk/tkabber-plugins/whiteboard/svgrender.tcl
   trunk/tkabber-plugins/whiteboard/whiteboard.tcl
Log:
	* whiteboard/svgrender.tcl, whiteboard/whiteboard.tcl,
	  whiteboard/msgs/ru.msg: Added circle and polygon whiteboard
	  figures (thanks to Pavel Arajums).


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2006-12-03 19:43:03 UTC (rev 818)
+++ trunk/tkabber-plugins/ChangeLog	2006-12-03 20:01:56 UTC (rev 819)
@@ -1,3 +1,9 @@
+2006-12-03  Sergei Golovan  <sgolovan at nes.ru>
+
+	* whiteboard/svgrender.tcl, whiteboard/whiteboard.tcl,
+	  whiteboard/msgs/ru.msg: Added circle and polygon whiteboard
+	  figures (thanks to Pavel Arajums).
+
 2006-11-27  Sergei Golovan  <sgolovan at nes.ru>
 
 	* debug/debug.tcl: Added loading translation messages.

Modified: trunk/tkabber-plugins/whiteboard/msgs/ru.msg
===================================================================
--- trunk/tkabber-plugins/whiteboard/msgs/ru.msg	2006-12-03 19:43:03 UTC (rev 818)
+++ trunk/tkabber-plugins/whiteboard/msgs/ru.msg	2006-12-03 20:01:56 UTC (rev 819)
@@ -1,4 +1,3 @@
-
 ::msgcat::mcset ru "Whiteboard" "Грифельная доска"
 ::msgcat::mcset ru "%s whiteboard" "%s доска"
 ::msgcat::mcset ru "PolyLine" "Ломаная"
@@ -13,3 +12,7 @@
 ::msgcat::mcset ru "Line width: " "Ширина линии: "
 ::msgcat::mcset ru "OK" "Продолжить"
 ::msgcat::mcset ru "Cancel" "Отменить"
+::msgcat::mcset ru "Fill color" "Цвет заливки"
+::msgcat::mcset ru "Fill" "Заливать"
+::msgcat::mcset ru "Circle" "Окружность"
+::msgcat::mcset ru "Polygon" "Многоугольник"

Modified: trunk/tkabber-plugins/whiteboard/svgrender.tcl
===================================================================
--- trunk/tkabber-plugins/whiteboard/svgrender.tcl	2006-12-03 19:43:03 UTC (rev 818)
+++ trunk/tkabber-plugins/whiteboard/svgrender.tcl	2006-12-03 20:01:56 UTC (rev 819)
@@ -20,7 +20,7 @@
     #puts $xmldata
 
     if {$tag != "svg"} {
-	puts "Not SVG file"
+	#puts "Not SVG file"
 	return
     }
 
@@ -48,6 +48,9 @@
 	polygon {
 	    parse_polygon $c $transform $item
 	}
+	circle {
+	    parse_circle $c $transform $item
+	}
 	text {
 	    parse_text $c $transform $item
 	}
@@ -55,7 +58,7 @@
 	    parse_g $c $transform $vars $children
 	}
 	default {
-	    puts "Unknown svg tag '$tag'"
+	    #puts "Unknown svg tag '$tag'"
 	}
     }
 }
@@ -80,11 +83,14 @@
 	    polygon {
 		parse_polygon $c $transform $item
 	    }
+	    circle {
+		parse_circle $c $transform $item
+	    }
 	    text {
 		parse_text $c $transform $item
 	    }
 	    default {
-		puts "Unknown g tag '$tag'"
+		#puts "Unknown g tag '$tag'"
 	    }
 	}
 	#update
@@ -126,7 +132,7 @@
 	    stroke {set attrs(stroke) $val}
 	    stroke-width {set attrs(stroke-width) $val}
 	    default {
-		puts "Unknown style attr '$attr'"
+		#puts "Unknown style attr '$attr'"
 	    }
 	}
     }
@@ -140,11 +146,43 @@
 	lappend p [lindex $p 0] [lindex $p 1]
     }
 
-    puts "$c create $drawitem $p $opts"
+    #puts "$c create $drawitem $p $opts"
     eval $c create $drawitem $p $opts
 }
 
+proc svg::parse_circle {c transform item} {
+    jlib::wrapper:splitxml $item tag vars isempty chdata children
 
+    array set attrs $vars
+    set styles [split [jlib::wrapper:getattr $vars style] \;]
+    set drawitem circle
+
+    foreach s $styles {
+	lassign [split $s :] attr val
+	switch -- $attr {
+	    "" {}
+	    cx {set attrs(cx) $val}
+	    cy {set attrs(cy) $val}
+	    r {set attrs(r) $val}
+	    fill {set attrs(fill) $val}
+	    stroke {set attrs(stroke) $val}
+	    stroke-width {set attrs(stroke-width) $val}
+	    default {
+		#puts "Unknown style attr '$attr'"
+	    }
+	}
+    }
+
+    set opts [circle_opts]
+
+    set x1 [expr $attrs(cx)-$attrs(r)]
+    set x2 [expr $attrs(cx)+$attrs(r)]
+    set y1 [expr $attrs(cy)-$attrs(r)]
+    set y2 [expr $attrs(cy)+$attrs(r)]
+	
+    eval $c create oval $x1 $y1 $x2 $y2 $opts
+}
+
 proc svg::parse_line {c transform style item} {
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
@@ -160,10 +198,10 @@
     lassign [transform_coord $transform $x1 $y1] x1 y1
     lassign [transform_coord $transform $x2 $y2] x2 y2
 
-    puts $style
+    #puts $style
     array set attrs $style
     array set attrs $vars
-    puts [array get attrs]
+    #puts [array get attrs]
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
@@ -174,14 +212,14 @@
 	    stroke {set attrs(stroke) $val}
 	    stroke-width {set attrs(stroke-width) $val}
 	    default {
-		puts "Unknown style attr '$attr'"
+		#puts "Unknown style attr '$attr'"
 	    }
 	}
     }
 
     set opts [line_opts]
 
-    puts "$c create line $x1 $y1 $x2 $y2 $opts"
+    #puts "$c create line $x1 $y1 $x2 $y2 $opts"
     eval $c create line $x1 $y1 $x2 $y2 $opts
 }
 
@@ -200,10 +238,10 @@
     lassign [transform_coord $transform $x $y] x y
     #lassign [transform_coord $transform $x2 $y2] x2 y2
 
-    puts $style
+    #puts $style
     array set attrs $style
     array set attrs $vars
-    puts [array get attrs]
+    #puts [array get attrs]
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
@@ -214,7 +252,7 @@
 	    stroke {set attrs(stroke) $val}
 	    stroke-width {set attrs(stroke-width) $val}
 	    default {
-		puts "Unknown style attr '$attr'"
+		#puts "Unknown style attr '$attr'"
 	    }
 	}
     }
@@ -242,7 +280,7 @@
 	    stroke {set attrs(stroke) $val}
 	    stroke-width {set attrs(stroke-width) $val}
 	    default {
-		puts "Unknown style attr '$attr'"
+		#puts "Unknown style attr '$attr'"
 	    }
 	}
     }
@@ -294,6 +332,22 @@
     return $opts
 }
 
+proc svg::circle_opts {} {
+    upvar attrs attrs
+    upvar c c
+    set opts {}
+    foreach {attr val} [array get attrs] {
+	switch -- $attr {
+	    "" {}
+	    fill {lappend opts -fill [color $c $val]}
+	    stroke {lappend opts -outline [color $c $val]}
+	    stroke-width {lappend opts -width $val}
+	    id {lappend opts -tags [list id$val]}
+	}
+    }
+    return $opts
+}
+
 proc svg::polygon_opts {} {
     upvar attrs attrs
     upvar c c

Modified: trunk/tkabber-plugins/whiteboard/whiteboard.tcl
===================================================================
--- trunk/tkabber-plugins/whiteboard/whiteboard.tcl	2006-12-03 19:43:03 UTC (rev 818)
+++ trunk/tkabber-plugins/whiteboard/whiteboard.tcl	2006-12-03 20:01:56 UTC (rev 819)
@@ -23,6 +23,7 @@
     [namespace current]::wb::add_whiteboard_menu_item 47
 
 proc wb::open_wb {connid jid} {
+    global dofill
 
     set chatid [chat::chatid $connid $jid]
 
@@ -61,6 +62,18 @@
 			-command [list [namespace current]::freehand_bind \
 				      $c $chatid]]
 
+    set tbcircle [radiobutton $w.tb.circle -text [::msgcat::mc "Circle"] \
+			-variable [namespace current]::tool($chatid) \
+			-value circle \
+			-command [list [namespace current]::circle_bind \
+				      $c $chatid]]
+
+    set tbpolygon [radiobutton $w.tb.polygon -text [::msgcat::mc "Polygon"] \
+			-variable [namespace current]::tool($chatid) \
+			-value polygon \
+			-command [list [namespace current]::polygon_bind \
+				      $c $chatid]]
+
     set tbtext [radiobutton $w.tb.text -text [::msgcat::mc "Text"] \
 		      -variable [namespace current]::tool($chatid) \
 		      -value text \
@@ -79,7 +92,7 @@
 		      -command [list [namespace current]::remove_bind \
 				    $c $chatid]]
 
-    pack $tbpolyline $tbfreehand $tbtext $tbmove $tbremove -anchor w
+    pack $tbpolyline $tbfreehand $tbcircle $tbpolygon $tbtext $tbmove $tbremove -anchor w
 
     button $w.tb.clear -text [::msgcat::mc "Clear"] \
 	-command [list [namespace current]::send_clear $chatid]
@@ -105,6 +118,24 @@
     frame $w.tb.spacer2 -relief sunken -bd 1 -height 2 -highlightthickness 0
     pack $w.tb.spacer2 -side bottom -anchor w -fill x -pady 2m
 
+    frame $w.tb.fill
+
+    checkbutton $w.tb.dofill -text [::msgcat::mc "Fill"] -variable dofill
+    pack $w.tb.dofill -side left -in $w.tb.fill
+
+    canvas $w.tb.fillcolor -background \#FFFFFF -height 5m -width 5m
+    pack $w.tb.fillcolor -side left -padx 3m -in $w.tb.fill
+
+    pack $w.tb.fill -side bottom -anchor w -fill x
+
+    button $w.tb.selfillcol -text [::msgcat::mc "Fill color"] \
+	-command [list [namespace current]::select_color \
+		      $w.tb.selfillcol $w.tb.fillcolor]
+    pack $w.tb.selfillcol -side bottom -anchor w -fill x
+
+    frame $w.tb.spacer3 -relief sunken -bd 1 -height 2 -highlightthickness 0
+    pack $w.tb.spacer3 -side bottom -anchor w -fill x -pady 2m
+
     canvas $w.tb.color -background \#000000 -height 0.5c -width 1
     pack $w.tb.color -side bottom
 
@@ -171,6 +202,11 @@
     [set [namespace current]::text_set_fr($chatid)].example_char cget -font
 }
 
+proc wb::get_fill_color {chatid} {
+    set w [win_id whiteboard $chatid]
+    $w.tb.fillcolor cget -background
+}
+
 proc wb::get_color {chatid} {
     set w [win_id whiteboard $chatid]
     $w.tb.color cget -background
@@ -357,6 +393,218 @@
 ###############################################################################
 
 ###############################################################################
+# Polygon
+
+proc wb::polygon_bind {c jid} {
+    bind $c <ButtonPress-1> \
+	[list [namespace current]::polygon_b1 [double% $c] [double% $jid] %x %y]
+    bind $c <B1-Motion> {}
+    bind $c <Motion> [list [namespace current]::polygon_m [double% $c] %x %y]
+    bind $c <ButtonRelease-1> {}
+    bind $c <Button-3> [list [namespace current]::polygon_b3 \
+			    [double% $c] [double% $jid]]
+}
+
+proc wb::polygon_b1 {c jid x y} {
+    variable polygon
+    variable line1
+    variable line2
+    global dofill
+
+    set x [$c canvasx $x]
+    set y [$c canvasy $y]
+
+    if {[info exists polygon(drawed)]} {
+	lappend polygon(coords) $x $y
+
+	catch {$c delete $line1(temp)}
+	catch {$c delete $line2(temp)}
+	catch {$c delete $polygon(temp)}
+	if {$dofill == 1} {
+	    set polygon(temp) [eval $c create polygon $polygon(coords) $polygon(options)]
+	} else {
+	    set polygon(temp) [eval $c create line $polygon(coords) [lindex $polygon(coords) 0] [lindex $polygon(coords) 1] $polygon(line_options)]
+	}
+    } else {
+	set polygon(drawed) 1
+	set polygon(coords) "$x $y"
+	set polygon(line_options) [list -fill [get_color $jid] \
+			       -width [get_width $jid] \
+			       -joinstyle miter]
+	set polygon(options) [list -fill [get_fill_color $jid] \
+			       -outline [get_color $jid] \
+			       -width [get_width $jid] \
+			       -joinstyle miter]
+	
+    }
+}
+
+proc wb::polygon_m {c x y} {
+    variable polygon
+    variable line1
+    variable line2
+
+    set x [$c canvasx $x]
+    set y [$c canvasy $y]
+
+    if {[info exists polygon(drawed)]} {
+	set x1 [lindex $polygon(coords) 0]
+	set y1 [lindex $polygon(coords) 1]
+	set xn [lindex $polygon(coords) end-1]
+	set yn [lindex $polygon(coords) end]
+
+	catch {$c delete $line1(temp)}
+	catch {$c delete $line2(temp)}
+	set line1(temp) [eval $c create line $x1 $y1 $x $y $polygon(line_options)]
+	set line2(temp) [eval $c create line $xn $yn $x $y $polygon(line_options)]
+    }
+}
+
+
+proc wb::polygon_b3 {c jid} {
+    variable polygon
+    variable line1
+    variable line2
+    global dofill
+
+    catch {
+	unset polygon(drawed)
+
+	set id [create_id]
+	catch {$c delete $line1(temp)}
+	catch {$c delete $line2(temp)}
+	catch {$c delete $polygon(temp)}
+	if {[llength $polygon(coords)] > 4} {
+	    if {$dofill == 1} {
+		set polygon(temp) [eval $c create polygon $polygon(coords) $polygon(options) \
+			   -tag id$id]
+	    } else {
+	    	set polygon(temp) [eval $c create line $polygon(coords) [lindex $polygon(coords) 0] [lindex $polygon(coords) 1] $polygon(line_options) \
+		                           -tag id$id]
+	    }
+
+	    if {[chat::is_groupchat $jid]} {
+		$c delete $polygon(temp)
+	    }
+
+	    lappend vars points $polygon(coords)
+	    if {$dofill == 1} {
+		lappend vars fill [get_fill_color $jid]
+	    }
+	    lappend vars stroke [get_color $jid]
+	    if {[set width [get_width $jid]] != 1} {
+		lappend vars stroke-width $width
+	    }
+
+	    lappend vars id $id
+
+	    send_svg $jid [jlib::wrapper:createtag polygon \
+			   -vars $vars]
+	}
+	set polygon(coords) {}
+	set polygon(temp) {}
+    }
+}
+
+###############################################################################
+
+###############################################################################
+# Circle
+
+proc wb::circle_bind {c jid} {
+    bind $c <ButtonPress-1> \
+	[list [namespace current]::circle_b1 [double% $c] [double% $jid] %x %y]
+    bind $c <B1-Motion> \
+ 	[list [namespace current]::circle_b1m [double% $c] %x %y]
+    bind $c <Motion> {}
+    bind $c <ButtonRelease-1> \
+	[list [namespace current]::circle_b1r [double% $c] [double% $jid] %x %y]
+    bind $c <Button-3> {}
+}
+
+proc wb::circle_b1 {c jid x y} {
+    variable circle
+    global dofill
+
+    set x [$c canvasx $x]
+    set y [$c canvasy $y]
+
+    set circle(drawed) 1
+    set circle(center) "$x $y"
+    set circle(options) [list -outline [get_color $jid] \
+			       -width [get_width $jid] ]
+    if {$dofill == 1} {
+	lappend circle(options) -fill [get_fill_color $jid]
+    }
+}
+
+proc wb::circle_b1r {c jid x y} {
+    variable circle
+    global dofill
+
+    if {[info exists circle(drawed)]} {
+        unset circle(drawed)
+	set cx [lindex $circle(center) 0]
+	set cy [lindex $circle(center) 1]
+	set x [$c canvasx $x]
+	set y [$c canvasy $y]
+	set r [expr hypot($cx-$x,$cy-$y)]
+	set x1 [expr $cx-$r]
+	set x2 [expr $cx+$r]
+	set y1 [expr $cy-$r]
+	set y2 [expr $cy+$r]
+
+        set id [create_id]
+        lappend vars cx $cx
+	lappend vars cy $cy
+	lappend vars r $r
+        if {[set color [get_color $jid]] != "#000000"} {
+	   lappend vars stroke $color
+	}
+	if {$dofill == 1} {
+	   lappend vars fill [get_fill_color $jid]
+	}
+	if {[set width [get_width $jid]] != 1} {
+	   lappend vars stroke-width $width
+	}
+
+        lappend vars id $id
+
+        catch {$c delete $circle(temp)}
+        set circle(temp) [eval $c create oval $x1 $y1 $x2 $y2 $circle(options) -tag id$id]
+		send_svg $jid [jlib::wrapper:createtag circle \
+	                           -vars $vars]
+
+        set circle(center) {}
+        set circle(temp) {}
+    }
+}
+
+proc wb::circle_b1m {c x y} {
+    variable circle
+
+    if {[info exists circle(drawed)]} {
+	set cx [lindex $circle(center) 0]
+	set cy [lindex $circle(center) 1]
+	set x [$c canvasx $x]
+	set y [$c canvasy $y]
+	set r [expr hypot($cx-$x,$cy-$y)]
+	set x1 [expr $cx-$r]
+	set x2 [expr $cx+$r]
+	set y1 [expr $cy-$r]
+	set y2 [expr $cy+$r]
+		
+
+	catch {$c delete $circle(temp)}
+	set circle(temp) [eval $c create oval $x1 $y1 $x2 $y2 $circle(options)]
+    }
+}
+
+
+
+###############################################################################
+
+###############################################################################
 # Freehand
 
 proc wb::freehand_bind {c jid} {



More information about the Tkabber-dev mailing list