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

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Jul 6 22:19:11 MSD 2008


Author: sergei
Date: 2008-07-06 22:19:10 +0400 (Sun, 06 Jul 2008)
New Revision: 1466

Modified:
   trunk/tkabber-plugins/ChangeLog
   trunk/tkabber-plugins/whiteboard/svgrender.tcl
   trunk/tkabber-plugins/whiteboard/whiteboard.tcl
Log:
	* whiteboard/svgrender.tcl: Reworked SVG rendering, made all existing
	  shapes transformable (except text), implemented all transformations,
	  added several new attributes (stroke-linecap, stroke-linejoin etc.).
	  Broken compatibility (the default outline color is empty now and not
	  black).

	* whiteboard/whiteboard.tcl: Use svgrender for all elements rendering.
	  Added a new rectangular shape. Moved all actions to a popup menu
	  instead of radiobuttons. Added very preliminary (without user
	  interface yet) tranformation support.


Modified: trunk/tkabber-plugins/ChangeLog
===================================================================
--- trunk/tkabber-plugins/ChangeLog	2008-07-05 15:46:58 UTC (rev 1465)
+++ trunk/tkabber-plugins/ChangeLog	2008-07-06 18:19:10 UTC (rev 1466)
@@ -1,3 +1,16 @@
+2008-07-06  Sergei Golovan <sgolovan at nes.ru>
+
+	* whiteboard/svgrender.tcl: Reworked SVG rendering, made all existing
+	  shapes transformable (except text), implemented all transformations,
+	  added several new attributes (stroke-linecap, stroke-linejoin etc.).
+	  Broken compatibility (the default outline color is empty now and not
+	  black).
+
+	* whiteboard/whiteboard.tcl: Use svgrender for all elements rendering.
+	  Added a new rectangular shape. Moved all actions to a popup menu
+	  instead of radiobuttons. Added very preliminary (without user
+	  interface yet) tranformation support.
+
 2008-06-18  Sergei Golovan <sgolovan at nes.ru>
 
 	* cyrillize/cyrillize.tcl: Added cyrillize bindings to all text and

Modified: trunk/tkabber-plugins/whiteboard/svgrender.tcl
===================================================================
--- trunk/tkabber-plugins/whiteboard/svgrender.tcl	2008-07-05 15:46:58 UTC (rev 1465)
+++ trunk/tkabber-plugins/whiteboard/svgrender.tcl	2008-07-06 18:19:10 UTC (rev 1466)
@@ -1,320 +1,468 @@
-#!/usr/bin/wishx
+# $Id$
 
-namespace eval svg {}
+namespace eval svg {
+    # Smoothed lines and polygons are available in Tk starting from 8.5
+    if {[package vsatisfies [package provide Tk] 8.5]} {
+	variable Smooth 1
+    } else {
+	variable Smooth 0
+    }
 
+    variable Debug 0
+}
 
-proc svg::load_file {c filename} {
+proc svg::loadFile {c filename} {
     set f [open $filename]
     set file [read $f]
     close $f
 
     set parser [jlib::wrapper:new "#" "#" \
-		    [list svg::parse_file $c]]
+				  [list [namespace current]::parseSVG $c]]
     jlib::wrapper:elementstart $parser stream:stream {} {}
     jlib::wrapper:parser $parser parse $file
     jlib::wrapper:parser $parser configure -final 0
 }
 
-proc svg::parse_file {c xmldata} {
+proc svg::parseSVG {c xmldata} {
+    Debug 2 $xmldata
     jlib::wrapper:splitxml $xmldata tag vars isempty chdata children
-    #puts $xmldata
 
     if {$tag != "svg"} {
-	#puts "Not SVG file"
-	return
+	return -code error "Not a SVG file"
     }
 
-    foreach child $children {
-	parse_svg_item $c $child
-    }
+    parseSVGItem $c {} {} $xmldata
 }
 
-proc svg::parse_svg_item {c item} {
+proc svg::parseSVGItem {c transform curAttrs item} {
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    #set transform [parse_transform [jlib::wrapper:getattr $vars transform]]
-    #set transform {{scale 500}}
-    set transform {}
     switch -- $tag {
+	svg {
+	    ParseSVG $c $transform $curAttrs $item
+	}
 	rect {
-	    return [parse_rect $c $transform $vars $item]
+	    ParseRect $c $transform $curAttrs $item
 	}
 	line {
-	    return [parse_line $c $transform {} $item]
+	    ParseLine $c $transform $curAttrs $item
 	}
 	polyline {
-	    return [parse_polyline $c $transform $item]
+	    ParsePolyline $c $transform $curAttrs $item
 	}
 	polygon {
-	    return [parse_polygon $c $transform $item]
+	    ParsePolygon $c $transform $curAttrs $item
 	}
 	circle {
-	    return [parse_circle $c $transform $item]
+	    ParseCircle $c $transform $curAttrs $item
 	}
+	ellipse {
+	    ParseEllipse $c $transform $curAttrs $item
+	}
 	text {
-	    return [parse_text $c $transform $item]
+	    ParseText $c $transform $curAttrs $item
 	}
 	g {
-	    parse_g $c $transform $vars $children
-	    # TODO
-	    return ""
+	    ParseG $c $transform $curAttrs $vars $children
 	}
 	default {
-	    #puts "Unknown svg tag '$tag'"
+	    Debug 1 Unknown SVG tag '$tag'
 	    return ""
 	}
     }
 }
 
-proc svg::parse_g {c transform vars items} {
-    set transform [eval lreplace [list $transform] -1 -1 \
-		       [parse_transform [jlib::wrapper:getattr \
-					     $vars transform]]]
+proc svg::ParseSVG {c transform curAttrs item} {
+    jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    foreach item $items {
-	jlib::wrapper:splitxml $item tag vars1 isempty chdata children
-	switch -- $tag {
-	    rect {
-		parse_rect $c $transform $vars $item
-	    }
-	    line {
-		parse_line $c $transform $vars $item
-	    }
-	    polyline {
-		parse_polyline $c $transform $item
-	    }
-	    polygon {
-		parse_polygon $c $transform $item
-	    }
-	    circle {
-		parse_circle $c $transform $item
-	    }
-	    text {
-		parse_text $c $transform $item
-	    }
-	    default {
-		#puts "Unknown g tag '$tag'"
-	    }
-	}
-	#update
+    # TODO
+
+    foreach child $children {
+	parseSVGItem $c $transform $curAttrs $child
     }
+    return ""
 }
 
-proc svg::transform_points {transform raw_points} {
-    # SVG spec says coordinate points can be separated by comma or
-    # white space or comma-with-white-space
-    # string map...    convert , to space
-    # regsub...        condense multiple whitespaces to single space
-    regsub -all {\s\s*} [string map {, { }} [string trim $raw_points]] { } points_str
+proc svg::ParseG {c transform curAttrs vars items} {
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
 
-    set p {}
-    foreach {x y} [split $points_str] {
-	eval lappend p [transform_coord $transform $x $y]
+    array set attrs $curAttrs
+    array set attrs $vars
+    set curAttrs [array get attrs]
+
+    foreach item $items {
+	parseSVGItem $c $transform $curAttrs $item
     }
-    return $p
+    return ""
 }
 
-proc svg::parse_polygon {c transform item} {
+proc svg::ParsePolygon {c transform curAttrs item} {
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    set transform [eval lreplace [list $transform] -1 -1 \
-		       [parse_transform [jlib::wrapper:getattr \
-					     $vars transform]]]
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
 
-    set p [transform_points $transform [jlib::wrapper:getattr $vars points]]
+    set p [TransformPoints $transform [jlib::wrapper:getattr $vars points]]
 
+    array set attrs $curAttrs
     array set attrs $vars
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
     foreach s $styles {
-	lassign [split $s :] attr val
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
 	switch -- $attr {
 	    "" {}
-	    fill {set attrs(fill) $val}
-	    stroke {set attrs(stroke) $val}
-	    stroke-width {set attrs(stroke-width) $val}
+	    fill -
+	    stroke -
+	    stroke-width -
+	    stroke-linejoin {
+		set attrs($attr) $val
+	    }
 	    default {
-		#puts "Unknown style attr '$attr'"
+		Debug 1 Unknown style attr '$attr'
 	    }
 	}
     }
 
     if {[info exists attrs(fill)]} {
-	set opts [polygon_opts]
+	set opts [PolygonOpts]
 	set drawitem polygon
     } else {
-	set opts [line_opts]
+	set opts [LineOpts]
 	set drawitem line
 	lappend p [lindex $p 0] [lindex $p 1]
     }
 
-    #puts "$c create $drawitem $p $opts"
-    eval $c create $drawitem $p $opts
+    Debug 2 $drawitem $p $opts
+    eval [list $c create $drawitem] $p $opts
 }
 
-proc svg::parse_circle {c transform item} {
+proc svg::ParseCircle {c transform curAttrs item} {
+    variable Smooth
+    variable Unitcircle
+
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
+
+    array set attrs $curAttrs
+    array set attrs {cx 0 cy 0 r 0}
     array set attrs $vars
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem circle
 
     foreach s $styles {
-	lassign [split $s :] attr val
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $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}
+	    cx -
+	    cy -
+	    r -
+	    fill -
+	    stroke -
+	    stroke-width {
+		set attrs($attr) $val
+	    }
 	    default {
-		#puts "Unknown style attr '$attr'"
+		Debug 1 Unknown style attr '$attr'
 	    }
 	}
     }
 
-    set opts [circle_opts]
+    set opts [CircleOpts]
 
-    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
+    if {$Smooth} {
+	set points {}
+	for {set i 0} {$i < 30} {incr i} {
+	    set a [expr {3.1415926 * $i / 15}]
+	    lappend points [expr {$attrs(cx) + $attrs(r)*cos($a)}] \
+		           [expr {$attrs(cy) + $attrs(r)*sin($a)}]
+	}
+    } else {
+	set points {}
+	for {set i 0} {$i < 180} {incr i} {
+	    set a [expr {3.1415926 * $i / 90}]
+	    lappend points [expr {$attrs(cx) + $attrs(r)*cos($a)}] \
+		           [expr {$attrs(cy) + $attrs(r)*sin($a)}]
+	}
+    }
+
+    set points [TransformPoints $transform $points]
+
+    Debug 2 polygon $points $opts
+    eval [list $c create polygon $points] $opts
 }
 
-proc svg::parse_line {c transform style item} {
+proc svg::ParseEllipse {c transform curAttrs item} {
+    variable Smooth
+    variable Unitcircle
+
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    set transform [eval lreplace [list $transform] -1 -1 \
-		       [parse_transform [jlib::wrapper:getattr \
-					     $vars transform]]]
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
 
+    array set attrs $curAttrs
+    array set attrs {cx 0 cy 0 rx 0 ry 0}
+    array set attrs $vars
+    set styles [split [jlib::wrapper:getattr $vars style] \;]
+    set drawitem circle
+
+    foreach s $styles {
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
+	switch -- $attr {
+	    "" {}
+	    cx -
+	    cy -
+	    rx -
+	    ry -
+	    fill -
+	    stroke -
+	    stroke-width {
+		set attrs($attr) $val
+	    }
+	    default {
+		Debug 1 Unknown style attr '$attr'
+	    }
+	}
+    }
+
+    set opts [CircleOpts]
+
+    if {$Smooth} {
+	set points {}
+	for {set i 0} {$i < 30} {incr i} {
+	    set a [expr {3.1415926 * $i / 15}]
+	    lappend points [expr {$attrs(cx) + $attrs(rx)*cos($a)}] \
+		           [expr {$attrs(cy) + $attrs(ry)*sin($a)}]
+	}
+    } else {
+	set points {}
+	for {set i 0} {$i < 180} {incr i} {
+	    set a [expr {3.1415926 * $i / 90}]
+	    lappend points [expr {$attrs(cx) + $attrs(rx)*cos($a)}] \
+		           [expr {$attrs(cy) + $attrs(ry)*sin($a)}]
+	}
+    }
+
+    set points [TransformPoints $transform $points]
+
+    Debug 2 polygon $points $opts
+    eval [list $c create polygon $points] $opts
+}
+
+proc svg::ParseLine {c transform curAttrs item} {
+    jlib::wrapper:splitxml $item tag vars isempty chdata children
+
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
+
     set x1 [jlib::wrapper:getattr $vars x1]
     set y1 [jlib::wrapper:getattr $vars y1]
     set x2 [jlib::wrapper:getattr $vars x2]
     set y2 [jlib::wrapper:getattr $vars y2]
 
-    lassign [transform_coord $transform $x1 $y1] x1 y1
-    lassign [transform_coord $transform $x2 $y2] x2 y2
+    foreach {x1 y1} [TransformCoord $transform $x1 $y1] break
+    foreach {x2 y2} [TransformCoord $transform $x2 $y2] break
 
-    #puts $style
-    array set attrs $style
+    array set attrs $curAttrs
     array set attrs $vars
-    #puts [array get attrs]
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
     foreach s $styles {
-	lassign [split $s :] attr val
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
 	switch -- $attr {
 	    "" {}
-	    stroke {set attrs(stroke) $val}
-	    stroke-width {set attrs(stroke-width) $val}
+	    stroke -
+	    stroke-width -
+	    stroke-linecap -
+	    stroke-linejoin {
+		set attrs($attr) $val
+	    }
 	    default {
-		#puts "Unknown style attr '$attr'"
+		Debug 1 Unknown style attr '$attr'
 	    }
 	}
     }
 
-    set opts [line_opts]
+    set opts [LineOpts]
 
-    #puts "$c create line $x1 $y1 $x2 $y2 $opts"
-    eval $c create line $x1 $y1 $x2 $y2 $opts
+    Debug 2 line $x1 $y1 $x2 $y2 $opts
+    eval [list $c create line $x1 $y1 $x2 $y2] $opts
 }
 
-proc svg::parse_rect {c transform style item} {
+proc svg::ParseRect {c transform curAttrs item} {
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    set transform [eval lreplace [list $transform] -1 -1 \
-		       [parse_transform [jlib::wrapper:getattr \
-					     $vars transform]]]
-    
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
+
     set x      [jlib::wrapper:getattr $vars x]
     set y      [jlib::wrapper:getattr $vars y]
     set width  [jlib::wrapper:getattr $vars width]
     set height [jlib::wrapper:getattr $vars height]
+    set rx     [jlib::wrapper:getattr $vars rx]
+    set ry     [jlib::wrapper:getattr $vars ry]
+    if {$rx != ""} {
+	Debug 1 Round corners are ignored
+    }
+    set x2 [expr {$x + $width}]
+    set y2 [expr {$y + $height}]
 
-    lassign [transform_coord $transform $x $y] x y
-    #lassign [transform_coord $transform $x2 $y2] x2 y2
+    foreach {xx yy} [TransformCoord $transform $x $y] break
+    foreach {xx1 yy1} [TransformCoord $transform $x2 $y] break
+    foreach {xx2 yy2} [TransformCoord $transform $x2 $y2] break
+    foreach {xx3 yy3} [TransformCoord $transform $x $y2] break
 
-    #puts $style
-    array set attrs $style
+    array set attrs $curAttrs
     array set attrs $vars
-    #puts [array get attrs]
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
     foreach s $styles {
-	lassign [split $s :] attr val
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
 	switch -- $attr {
 	    "" {}
-	    stroke {set attrs(stroke) $val}
-	    stroke-width {set attrs(stroke-width) $val}
+	    stroke -
+	    stroke-width -
+	    stroke-linejoin {
+		set attrs($attr) $val
+	    }
 	    default {
-		#puts "Unknown style attr '$attr'"
+		Debug 1 Unknown style attr '$attr'
 	    }
 	}
     }
 
-    set opts [rect_opts]
+    set opts [PolygonOpts]
 
-    #puts "$c create rect $x $y [expr {$x + $width}] [expr {$y + $height}] $opts"
-    eval $c create rect $x $y [expr {$x + $width}] [expr {$y + $height}] $opts
+    Debug 2 polygon $xx $yy $xx1 $yy1 $xx2 $yy2 $xx3 $yy3] $opts
+    eval [list $c create polygon $xx $yy $xx1 $yy1 $xx2 $yy2 $xx3 $yy3] $opts
 }
 
-proc svg::parse_polyline {c transform item} {
+proc svg::ParsePolyline {c transform curAttrs item} {
     jlib::wrapper:splitxml $item tag vars isempty chdata children
 
-    set p [transform_points $transform [jlib::wrapper:getattr $vars points]]
+    set p [TransformPoints $transform [jlib::wrapper:getattr $vars points]]
 
+    array set attrs $curAttrs
     array set attrs $vars
     set styles [split [jlib::wrapper:getattr $vars style] \;]
     set drawitem line
 
     foreach s $styles {
-	lassign [split $s :] attr val
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
 	switch -- $attr {
 	    "" {}
-	    fill {set attrs(fill) $val}
-	    stroke {set attrs(stroke) $val}
-	    stroke-width {set attrs(stroke-width) $val}
+	    fill -
+	    stroke -
+	    stroke-width -
+	    stroke-linecap -
+	    stroke-linejoin {
+		set attrs($attr) $val
+	    }
 	    default {
-		#puts "Unknown style attr '$attr'"
+		Debug 1 Unknown style attr '$attr'
 	    }
 	}
     }
 
-    set opts [line_opts]
+    set opts [LineOpts]
 
-    #puts "$c create line $p $opts"
-    eval $c create line $p $opts
+    Debug 2 line $p $opts
+    eval [list $c create line] $p $opts
 }
 
+proc svg::ParseText {c transform curAttrs item} {
+    jlib::wrapper:splitxml $item tag vars isempty chdata children
 
+    eval lappend transform \
+	 [ParseTransform [jlib::wrapper:getattr $vars transform]]
 
-proc svg::line_opts {} {
+    set x  [jlib::wrapper:getattr $vars x]
+    set y  [jlib::wrapper:getattr $vars y]
+
+    if {$x == ""} {set x 0}
+    if {$y == ""} {set y 0}
+
+    foreach {x y} [TransformCoord $transform $x $y] break
+
+    array set attrs $curAttrs
+    array set attrs $vars
+    set styles [split [jlib::wrapper:getattr $vars style] \;]
+
+    foreach s $styles {
+	foreach {attr val} [split $s :] break
+	set attr [string trim $attr]
+	set val [string trim $val]
+	set attrs($attr) $val
+    }
+
+    set allopts [TextOpts]
+
+    set opts [lindex $allopts 0]
+    set fontopts [lindex $allopts 1]
+    if {$fontopts != ""} {
+	variable app_font
+	set fontname [list font $fontopts]
+	if {![info exists app_font($fontname)]} {
+	    # create a font to match the settings
+	    set app_font($fontname) [eval [list font create $fontname] $fontopts]
+	}
+	lappend opts -font $app_font($fontname)
+    }
+
+    Debug 2 text $x $y -text $chdata $opts
+    eval [list $c create text $x $y -text $chdata] $opts
+}
+
+proc svg::LineOpts {} {
     upvar attrs attrs
     upvar c c
-    set opts {-joinstyle miter}
+    set opts {-joinstyle miter -capstyle butt}
     foreach {attr val} [array get attrs] {
 	switch -- $attr {
 	    "" {}
 	    stroke {lappend opts -fill [color $c $val]}
 	    stroke-width {lappend opts -width $val}
+	    stroke-linecap {
+		switch -- $val {
+		    round {lappend opts -capstyle round}
+		    square {lappend opts -capstyle projecting}
+		}
+	    }
+	    stroke-linejoin {
+		switch -- $val {
+		    round {lappend opts -joinstyle round}
+		    bevel {lappend opts -joinstyle bevel}
+		}
+	    }
 	    id {lappend opts -tags [list id$val]}
 	}
     }
     return $opts
 }
 
-proc svg::rect_opts {} {
+proc svg::PolygonOpts {} {
     upvar attrs attrs
     upvar c c
-    set opts {}
+    set opts {-joinstyle miter -fill "" -outline ""}
     foreach {attr val} [array get attrs] {
 	switch -- $attr {
 	    "" {}
@@ -329,37 +477,39 @@
 		}
 	    }
 	    stroke-width {lappend opts -width $val}
+	    stroke-linejoin {
+		switch -- $val {
+		    round {lappend opts -joinstyle round}
+		    bevel {lappend opts -joinstyle bevel}
+		}
+	    }
 	    id {lappend opts -tags [list id$val]}
 	}
     }
     return $opts
 }
 
-proc svg::circle_opts {} {
+proc svg::CircleOpts {} {
+    variable Smooth
     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]}
-	}
+    set opts {-joinstyle round -fill "" -outline ""}
+    if {$Smooth} {
+	lappend opts -smooth bezier
     }
-    return $opts
-}
-
-proc svg::polygon_opts {} {
-    upvar attrs attrs
-    upvar c c
-    set opts {-joinstyle miter}
     foreach {attr val} [array get attrs] {
 	switch -- $attr {
 	    "" {}
-	    fill {lappend opts -fill [color $c $val]}
-	    stroke {lappend opts -outline [color $c $val]}
+	    fill {
+		if {$val != "" && $val != "none"} {
+		    lappend opts -fill [color $c $val]
+		}
+	    }
+	    stroke {
+		if {$val != "" && $val != "none"} {
+		    lappend opts -outline [color $c $val]
+		}
+	    }
 	    stroke-width {lappend opts -width $val}
 	    id {lappend opts -tags [list id$val]}
 	}
@@ -367,7 +517,7 @@
     return $opts
 }
 
-proc svg::text_opts {} {
+proc svg::TextOpts {} {
     upvar attrs attrs
     upvar c c
     set opts {-anchor w}
@@ -410,73 +560,122 @@
 }
 
 
-proc svg::parse_text {c transform item} {
-    jlib::wrapper:splitxml $item tag vars isempty chdata children
+proc svg::TransformPoints {transform raw_points} {
+    # SVG spec says coordinate points can be separated by comma or
+    # white space or comma-with-white-space
+    # string map...    convert , to space
+    # regsub...        condense multiple whitespaces to single space
+    regsub -all {\s\s*} [string map {, { }} [string trim $raw_points]] { } points_str
 
-    set transform [eval lreplace [list $transform] -1 -1 \
-		       [parse_transform [jlib::wrapper:getattr \
-					     $vars transform]]]
-
-    set x  [jlib::wrapper:getattr $vars x]
-    set y  [jlib::wrapper:getattr $vars y]
-
-    if {$x == ""} {set x 0}
-    if {$y == ""} {set y 0}
-
-    lassign [transform_coord $transform $x $y] x y
-
-    array set attrs $vars
-    set allopts [text_opts]
-    set opts [lindex $allopts 0]
-    set fontopts [lindex $allopts 1]
-    if {$fontopts != ""} {
-	variable app_font
-	set fontname [list font $fontopts]
-	if {![info exists app_font($fontname)]} {
-	    # create a font to match the settings
-	    set app_font($fontname) [eval font create [list $fontname] $fontopts]
-	}
-	lappend opts -font $app_font($fontname)
+    set p {}
+    foreach {x y} [split $points_str] {
+	eval lappend p [TransformCoord $transform $x $y]
     }
-
-    #puts "eval $c create text $x $y -text [list $chdata] $opts"
-    eval $c create text $x $y -text [list $chdata] $opts
+    return $p
 }
 
-proc svg::parse_transform {s} {
+proc svg::ParseTransform {s} {
+    Debug 2 $s
+
     set t {}
     while {[regexp {(\w+)\s*\(([^\)]*)\)(.*)} $s temp transform param s]} {
 	lappend t [list $transform [split $param ", "]]
     }
-    #puts $t
+
+    Debug 1 $s $t
     return $t
 }
 
-proc svg::transform_coord {transform x y} {
-    #puts $transform
-    #puts "$x $y"
+proc svg::TransformCoord {transform x y} {
+    Debug 2 $transform $x $y
+
+    set matrix [list 1 0 0 1 0 0]
+
     foreach t $transform {
-	lassign $t op param
-	#puts $t
-	switch -- $op {
-	    translate {
-		lassign $param dx dy
-		set x [expr {$x + $dx}]
-		set y [expr {$y + $dy}]
+	foreach {op param} $t break
+	switch -- $op/[llength $param] {
+	    matrix/6 {
+		set matrix [Tcompose $matrix $param]
 	    }
-	    scale {
-		lassign $param sx sy
-		if {$sy == ""} {set sy $sx}
-		set x [expr {$x * $sx}]
-		set y [expr {$y * $sy}]
+	    translate/1 {
+		foreach tx $param break
+		set matrix [Tcompose $matrix [list 1 0 0 1 $tx 0]]
 	    }
+	    translate/2 {
+		foreach {tx ty} $param break
+		set matrix [Tcompose $matrix [list 1 0 0 1 $tx $ty]]
+	    }
+	    scale/1 {
+		foreach sx $param break
+		set matrix [Tcompose $matrix [list $sx 0 0 $sx 0 0]]
+	    }
+	    scale/2 {
+		foreach {sx sy} $param break
+		set matrix [Tcompose $matrix [list $sx 0 0 $sy 0 0]]
+	    }
+	    rotate/1 {
+		foreach a $param break
+		set a [expr {3.1415926 * $a / 180}]
+		set matrix [Tcompose $matrix \
+				    [list [expr {cos($a)}]  [expr {sin($a)}] \
+					  [expr {-sin($a)}] [expr {cos($a)}] 0 0]]
+	    }
+	    rotate/3 {
+		foreach {a cx cy} $param break
+		set a [expr {3.1415926 * $a / 180}]
+		set matrix [Tcompose $matrix [list 1 0 0 1 [expr {-$cx}] [expr {-$cy}]]]
+		set matrix [Tcompose $matrix \
+				    [list [expr {cos($a)}]  [expr {sin($a)}] \
+					  [expr {-sin($a)}] [expr {cos($a)}] 0 0]]
+		set matrix [Tcompose $matrix [list 1 0 0 1 $cx $cy]]
+	    }
+	    skewX/1 {
+		foreach a $param break
+		set a [expr {3.1415926 * $a / 180}]
+		set matrix [Tcompose $matrix [list 1 0 [expr {tan($a)}] 1 0 0]]
+	    }
+	    skewY/1 {
+		foreach a $param break
+		set a [expr {3.1415926 * $a / 180}]
+		set matrix [Tcompose $matrix [list 1 [expr {tan($a)}] 0 1 0 0]]
+	    }
 	}
     }
-    #puts "$x $y"
-    return [list $x $y]
+
+    return [Tapply $matrix $x $y]
 }
 
+proc svg::Tcompose {matrix1 matrix2} {
+    Debug 2 [list $matrix1] [list $matrix2]
+
+    
+    foreach {a1 b1 c1 d1 e1 f1} $matrix1 break
+    foreach {a2 b2 c2 d2 e2 f2} $matrix2 break
+
+    set a [expr {$a1*$a2 + $c1*$b2}]
+    set b [expr {$b1*$a2 + $d1*$b2}]
+    set c [expr {$a1*$c2 + $c1*$d2}]
+    set d [expr {$b1*$c2 + $d1*$d2}]
+    set e [expr {$a1*$e2 + $c1*$f2 + $e1}]
+    set f [expr {$b1*$e2 + $d1*$f2 + $f1}]
+
+    return [list $a $b $c $d $e $f]
+}
+
+proc svg::Tapply {matrix x y} {
+    Debug 2 [list $matrix] $x $y
+
+    foreach {a b c d e f} $matrix break
+    set x1 [expr {$a*$x + $c*$y + $e}]
+    set y1 [expr {$b*$x + $d*$y + $f}]
+
+    Debug 1 $x1 $y1
+    return [list $x1 $y1]
+}
+
 proc svg::color {c color} {
+    Debug 2 $color
+
     if {[catch {$c create line 0 0 0 0 -fill $color -width 0} id]} {
 	return black
     } else {
@@ -485,3 +684,11 @@
     }
 }
 
+proc svg::Debug {level args} {
+    variable Debug
+
+    if {$Debug >= $level} {
+	puts "[lindex [info level -1] 0]: [join $args]"
+    }
+}
+


Property changes on: trunk/tkabber-plugins/whiteboard/svgrender.tcl
___________________________________________________________________
Name: svn:executable
   - *

Modified: trunk/tkabber-plugins/whiteboard/whiteboard.tcl
===================================================================
--- trunk/tkabber-plugins/whiteboard/whiteboard.tcl	2008-07-05 15:46:58 UTC (rev 1465)
+++ trunk/tkabber-plugins/whiteboard/whiteboard.tcl	2008-07-06 18:19:10 UTC (rev 1466)
@@ -62,50 +62,6 @@
     set tb [frame $w.tb]
     pack $tb -side left -fill y
 
-    set tbpolyline [radiobutton $w.tb.line -text [::msgcat::mc "PolyLine"] \
-			-variable [namespace current]::tool($chatid) \
-			-value polyline \
-			-command [list [namespace current]::line_bind $c $chatid]]
-    
-    set tbfreehand [radiobutton $w.tb.freehand -text [::msgcat::mc "FreeHand"] \
-			-variable [namespace current]::tool($chatid) \
-			-value freehand \
-			-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 \
-		      -command [list [namespace current]::text_bind \
-				    $c $chatid]]
-
-    set tbmove [radiobutton $w.tb.move -text [::msgcat::mc "Move"] \
-		    -variable [namespace current]::tool($chatid) \
-		    -value move \
-		    -command [list [namespace current]::move_bind \
-				  $c $chatid]]
-
-    set tbremove [radiobutton $w.tb.remove -text [::msgcat::mc "Remove"] \
-		      -variable [namespace current]::tool($chatid) \
-		      -value remove \
-		      -command [list [namespace current]::remove_bind \
-				    $c $chatid]]
-
-    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]
     pack $w.tb.clear -side bottom -anchor w -fill x
@@ -185,13 +141,11 @@
     $c bind all <Any-Leave>  \
 	[list [namespace current]::balloon $chatid $c leave  %X %Y]
 
+    reset_bind $c $chatid
+
     trace variable [namespace current]::width($chatid) w \
 	[list [namespace current]::change_width \
 	     $w.tb.color [namespace current]::width($chatid)]
-
-    variable tool
-    set tool($chatid) polyline
-    line_bind $c $chatid
 }
 
 proc wb::balloon {chatid c action X Y} {
@@ -331,8 +285,9 @@
 
     foreach xelem $x {
 	jlib::wrapper:splitxml $xelem tag vars isempty chdata children
-	
-	if {[cequal [jlib::wrapper:getattr $vars xmlns] tkabber:whiteboard]} {
+
+	if {[string equal [jlib::wrapper:getattr $vars xmlns] \
+			  tkabber:whiteboard]} {
 	    open_wb [chat::get_connid $chatid] [chat::get_jid $chatid]
 	    set w [win_id whiteboard $chatid]
 	    foreach child $children {
@@ -353,12 +308,52 @@
     switch -- $tag {
 	svg {
 	    foreach child $children {
-		set id [svg::parse_svg_item $w.c $child]
+		set id [svg::parseSVGItem $w.c {} {} $child]
 		if {$id != ""} {
+		    $w.c addtag tag:$child withtag $id
 		    $w.c addtag [time_tag created $from $seconds] withtag $id
 		}
 	    }
 	}
+	transform {
+	    set id [jlib::wrapper:getattr $vars id]
+	    set transform [jlib::wrapper:getattr $vars transform]
+	    set tags [$w.c gettags id$id]
+	    set child {}
+	    foreach t $tags {
+		if {[string range $t 0 3] == "tag:"} {
+		    set child [string range $t 4 end]
+		    break
+		}
+	    }
+	    if {$child != {}} {
+		$w.c delete id$id
+		jlib::wrapper:splitxml $child tag1 vars1 isempty1 chdata1 children1
+		set vars2 {}
+		set q 0
+		foreach {key val} $vars1 {
+		    if {$key == "transform"} {
+			lappend vars2 $key "$transform $val"
+			set q 1
+		    } else {
+			lappend vars2 $key $val
+		    }
+		}
+		if {!$q} {
+		    lappend vars2 transform $transform
+		}
+		set child [jlib::wrapper:createtag $tag1 \
+			       -vars $vars2 \
+			       -chdata $chdata1 \
+			       -subtags $children1]
+
+		set id [svg::parseSVGItem $w.c {} {} $child]
+		if {$id != ""} {
+		    $w.c addtag tag:$child withtag $id
+		    $w.c addtag [time_tag created $from $seconds] withtag $id
+		}
+	    }
+	}
 	move {
 	    set id [jlib::wrapper:getattr $vars id]
 	    set dx [jlib::wrapper:getattr $vars dx]
@@ -369,7 +364,7 @@
 	    $w.c move id$id $dx $dy
 	}
 	remove {
-	    $w.c delete "id[jlib::wrapper:getattr $vars id]"
+	    $w.c delete id[jlib::wrapper:getattr $vars id]
 	}
 	clear {
 	    $w.c delete all
@@ -405,36 +400,100 @@
 }
 
 ###############################################################################
+
+proc wb::reset_bind {c chatid} {
+    bind $c <ButtonPress-1> \
+	 [list [namespace current]::move_b1p [double% $c] [double% $chatid] %x %y]
+    bind $c <B1-Motion> \
+	 [list [namespace current]::move_b1m [double% $c] %x %y]
+    bind $c <ButtonRelease-1> \
+	 [list [namespace current]::move_b1r [double% $c] [double% $chatid]]
+    bind $c <Button-3> \
+	 [list [namespace current]::popup_menu [double% $c] [double% $chatid] %X %Y]
+    bind $c <Motion> {}
+    $c configure -cursor ""
+}
+
+proc wb::popup_menu {c chatid x y} {
+    set m .whiteboard_popup_menu
+
+    if {[winfo exists $m]} {
+	destroy $m
+    }
+
+    set tags [$c gettags current]
+    set id ""
+    foreach t $tags {
+	if {[string range $t 0 1] == "id"} {
+	    set id [string range $t 2 end]
+	    break
+	}
+    }
+
+    menu $m -tearoff 0
+
+    $m add command -label [::msgcat::mc "FreeHand"] \
+		   -command [list [namespace current]::freehand_bind $c $chatid]
+    $m add command -label [::msgcat::mc "PolyLine"] \
+		   -command [list [namespace current]::line_bind $c $chatid]
+    $m add command -label [::msgcat::mc "Rectangle"] \
+		   -command [list [namespace current]::rectangle_bind $c $chatid]
+    $m add command -label [::msgcat::mc "Circle"] \
+		   -command [list [namespace current]::circle_bind $c $chatid]
+    $m add command -label [::msgcat::mc "Polygon"] \
+		   -command [list [namespace current]::polygon_bind $c $chatid]
+    $m add command -label [::msgcat::mc "Text"] \
+		   -command [list [namespace current]::text_bind $c $chatid]
+
+    if {![string equal $id ""]} {
+	set state normal
+    } else {
+	set state disabled
+    }
+
+    $m add separator
+    $m add command -label [::msgcat::mc "Remove"] \
+		   -command [list [namespace current]::remove_b1p $c $chatid $id] \
+		   -state $state
+
+    tk_popup $m $x $y
+}
+
+###############################################################################
+
+###############################################################################
 # Line
 
-proc wb::line_bind {c jid} {
+proc wb::line_bind {c chatid} {
     bind $c <ButtonPress-1> \
-	[list [namespace current]::line_b1 [double% $c] [double% $jid] %x %y]
+	[list [namespace current]::line_b1 [double% $c] [double% $chatid] %x %y]
     bind $c <B1-Motion> {}
     bind $c <Motion> [list [namespace current]::line_b1m [double% $c] %x %y]
     bind $c <ButtonRelease-1> {}
     bind $c <Button-3> [list [namespace current]::line_b3 \
-			    [double% $c] [double% $jid]]
+			    [double% $c] [double% $chatid]]
+    $c configure -cursor crosshair
 }
 
-proc wb::line_b1 {c jid x y} {
+proc wb::line_b1 {c chatid x y} {
     variable line
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
-    #puts "$x $y"
 
     if {[info exists line(drawed)]} {
 	lappend line(coords) $x $y
-
 	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords) $line(options)]
+	set tag [line_tag ""]
+        set line(temp) [svg::parseSVGItem $c {} {} $tag]
     } else {
 	set line(drawed) 1
-	set line(coords) "$x $y"
-	set line(options) [list -fill [get_color $jid] \
-			       -width [get_width $jid] \
-			       -joinstyle miter]
+	set line(coords) [list $x $y]
+	set line(options) [list stroke-linejoin miter stroke [get_color $chatid]]
+	if {[set width [get_width $chatid]] != 1} {
+	    lappend line(options) stroke-width $width
+	}
+
     }
 }
 
@@ -445,10 +504,12 @@
     set y [$c canvasy $y]
 
     if {[info exists line(drawed)]} {
-	#lappend line(coords) $x $y
-
+	set coords $line(coords)
+	lappend line(coords) $x $y
 	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords) $x $y $line(options)]
+	set tag [line_tag ""]
+        set line(temp) [svg::parseSVGItem $c {} {} $tag]
+	set line(coords) $coords
     }
 }
 
@@ -461,49 +522,54 @@
 
 	set id [create_id]
 	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords) $line(options) \
-				-tag id$id]
+	set tag [line_tag $id]
+        set line(temp) [svg::parseSVGItem $c {} {} $tag]
 
 	if {[chat::is_groupchat $chatid]} {
 	    $c delete $line(temp)
 	} else {
 	    set jid [jlib::connection_jid [chat::get_connid $chatid]]
+	    $c addtag tag:$tag withtag $line(temp)
 	    $c addtag [time_tag created $jid] withtag $line(temp)
 	}
 
-	lappend vars points $line(coords)
-	if {[set color [get_color $chatid]] != "#000000"} {
-	    lappend vars stroke $color
-	}
-	if {[set width [get_width $chatid]] != 1} {
-	    lappend vars stroke-width $width
-	}
+	send_svg $chatid $tag
 
-	lappend vars id $id
-
-	send_svg $chatid [jlib::wrapper:createtag polyline -vars $vars]
-
 	set line(coords) {}
 	set line(temp) {}
+
+	reset_bind $c $chatid
     }
 }
 
+proc wb::line_tag {id} {
+    variable line
+
+    set vars $line(options)
+    lappend vars points $line(coords)
+    if {$id != ""} {
+	lappend vars id $id
+    }
+    return [jlib::wrapper:createtag polyline -vars $vars]
+}
+
 ###############################################################################
 
 ###############################################################################
 # Polygon
 
-proc wb::polygon_bind {c jid} {
+proc wb::polygon_bind {c chatid} {
     bind $c <ButtonPress-1> \
-	[list [namespace current]::polygon_b1 [double% $c] [double% $jid] %x %y]
+	[list [namespace current]::polygon_b1 [double% $c] [double% $chatid] %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]]
+			    [double% $c] [double% $chatid]]
+    $c configure -cursor crosshair
 }
 
-proc wb::polygon_b1 {c jid x y} {
+proc wb::polygon_b1 {c chatid x y} {
     variable polygon
     variable line1
     variable line2
@@ -518,24 +584,21 @@
 	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)]
-	}
+	set tag [polygon_tag ""]
+        set polygon(temp) [svg::parseSVGItem $c {} {} $tag]
     } else {
 	set polygon(drawed) 1
-	set polygon(coords) "$x $y"
-	set polygon(line_options) [list -fill [get_color $jid] \
-			       -width [get_width $jid] \
+	set polygon(coords) [list $x $y]
+	set polygon(line_options) [list -fill [get_color $chatid] \
+			       -width [get_width $chatid] \
 			       -joinstyle miter]
-	set polygon(options) [list -fill [get_fill_color $jid] \
-			       -outline [get_color $jid] \
-			       -width [get_width $jid] \
-			       -joinstyle miter]
-	
+	set polygon(options) [list stroke-linejoin miter stroke [get_color $chatid]]
+	if {[set width [get_width $chatid]] != 1} {
+	    lappend polygon(options) stroke-width $width
+	}
+	if {$dofill == 1} {
+	    lappend polygon(options) fill [get_fill_color $chatid]
+	}
     }
 }
 
@@ -574,124 +637,216 @@
 	catch {$c delete $line1(temp)}
 	catch {$c delete $line2(temp)}
 	catch {$c delete $polygon(temp)}
+
+	set tag [polygon_tag $id]
+
 	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]
-	    }
+	    set polygon(temp) [svg::parseSVGItem $c {} {} $tag]
 
 	    if {[chat::is_groupchat $chatid]} {
 		$c delete $polygon(temp)
 	    } else {
 		set jid [jlib::connection_jid [chat::get_connid $chatid]]
+		$c addtag tag:$tag withtag $polygon(temp)
 		$c addtag [time_tag created $jid] withtag $polygon(temp)
 	    }
 
-	    lappend vars points $polygon(coords)
-	    if {$dofill == 1} {
-		lappend vars fill [get_fill_color $chatid]
-	    }
-	    lappend vars stroke [get_color $chatid]
-	    if {[set width [get_width $chatid]] != 1} {
-		lappend vars stroke-width $width
-	    }
-
-	    lappend vars id $id
-
-	    send_svg $chatid [jlib::wrapper:createtag polygon -vars $vars]
+	    send_svg $chatid $tag
 	}
 	set polygon(coords) {}
 	set polygon(temp) {}
+
+	reset_bind $c $chatid
     }
 }
 
+proc wb::polygon_tag {id} {
+    variable polygon
+
+    set vars $polygon(options)
+    lappend vars points $polygon(coords)
+    if {$id != ""} {
+	lappend vars id $id
+    }
+    return [jlib::wrapper:createtag polygon -vars $vars]
+}
+
 ###############################################################################
 
 ###############################################################################
+# Rectangle
+
+proc wb::rectangle_bind {c chatid} {
+    bind $c <ButtonPress-1> \
+	[list [namespace current]::rectangle_b1 [double% $c] [double% $chatid] %x %y]
+    bind $c <B1-Motion> \
+ 	[list [namespace current]::rectangle_b1m [double% $c] %x %y]
+    bind $c <Motion> {}
+    bind $c <ButtonRelease-1> \
+	[list [namespace current]::rectangle_b1r [double% $c] [double% $chatid] %x %y]
+    bind $c <Button-3> {}
+    $c configure -cursor crosshair
+}
+
+proc wb::rectangle_b1 {c chatid x y} {
+    variable rectangle
+    global dofill
+
+    set x [$c canvasx $x]
+    set y [$c canvasy $y]
+
+    set rectangle(drawed) 1
+    set rectangle(x1) $x
+    set rectangle(y1) $y
+    set rectangle(options) [list stroke [get_color $chatid]]
+    if {$dofill == 1} {
+	lappend rectangle(options) fill [get_fill_color $chatid]
+    }
+    if {[set width [get_width $chatid]] != 1} {
+	lappend rectangle(options) stroke-width $width
+    }
+}
+
+proc wb::rectangle_b1r {c chatid x y} {
+    variable rectangle
+
+    if {[info exists rectangle(drawed)]} {
+        unset rectangle(drawed)
+	set rectangle(x2) [$c canvasx $x]
+	set rectangle(y2) [$c canvasy $y]
+
+        set id [create_id]
+	set tag [rectangle_tag $id]
+
+        catch {$c delete $rectangle(temp)}
+        set rectangle(temp) [svg::parseSVGItem $c {} {} $tag]
+
+	if {[chat::is_groupchat $chatid]} {
+	    $c delete $rectangle(temp)
+	} else {
+	    set jid [jlib::connection_jid [chat::get_connid $chatid]]
+	    $c addtag tag:$tag withtag $rectangle(temp)
+	    $c addtag [time_tag created $jid] withtag $rectangle(temp)
+	}
+
+	send_svg $chatid $tag
+
+        unset rectangle(x1)
+        unset rectangle(x2)
+        unset rectangle(y1)
+        unset rectangle(y2)
+        set rectangle(temp) {}
+
+	reset_bind $c $chatid
+    }
+}
+
+proc wb::rectangle_b1m {c x y} {
+    variable rectangle
+
+    if {[info exists rectangle(drawed)]} {
+	set rectangle(x2) [$c canvasx $x]
+	set rectangle(y2) [$c canvasy $y]
+
+	set tag [rectangle_tag ""]
+
+	catch {$c delete $rectangle(temp)}
+        set rectangle(temp) [svg::parseSVGItem $c {} {} $tag]
+    }
+}
+
+proc wb::rectangle_tag {id} {
+    variable rectangle
+
+    set vars $rectangle(options)
+    if {$rectangle(x2) > $rectangle(x1)} {
+	lappend vars x $rectangle(x1) \
+		     width [expr {$rectangle(x2) - $rectangle(x1)}]
+    } else {
+	lappend vars x $rectangle(x2) \
+		     width [expr {$rectangle(x1) - $rectangle(x2)}]
+    }
+    if {$rectangle(y2) > $rectangle(y1)} {
+	lappend vars y $rectangle(y1) \
+		     height [expr {$rectangle(y2) - $rectangle(y1)}]
+    } else {
+	lappend vars y $rectangle(y2) \
+		     height [expr {$rectangle(y1) - $rectangle(y2)}]
+    }
+    if {$id != ""} {
+	lappend vars id $id
+    }
+    return [jlib::wrapper:createtag rect -vars $vars]
+}
+
+###############################################################################
+
+###############################################################################
 # Circle
 
-proc wb::circle_bind {c jid} {
+proc wb::circle_bind {c chatid} {
     bind $c <ButtonPress-1> \
-	[list [namespace current]::circle_b1 [double% $c] [double% $jid] %x %y]
+	[list [namespace current]::circle_b1 [double% $c] [double% $chatid] %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]
+	[list [namespace current]::circle_b1r [double% $c] [double% $chatid] %x %y]
     bind $c <Button-3> {}
+    $c configure -cursor crosshair
 }
 
-proc wb::circle_b1 {c jid x y} {
+proc wb::circle_b1 {c chatid x y} {
     variable circle
     global dofill
 
-    set x [$c canvasx $x]
-    set y [$c canvasy $y]
+    set cx [$c canvasx $x]
+    set cy [$c canvasy $y]
 
     set circle(drawed) 1
-    set circle(center) "$x $y"
-    set circle(options) [list -outline [get_color $jid] \
-			       -width [get_width $jid] ]
+    set circle(cx) $cx
+    set circle(cy) $cy
+    set circle(options) [list cx $cx cy $cy stroke [get_color $chatid]]
     if {$dofill == 1} {
-	lappend circle(options) -fill [get_fill_color $jid]
+	lappend circle(options) fill [get_fill_color $chatid]
     }
+    if {[set width [get_width $chatid]] != 1} {
+	lappend circle(options) stroke-width $width
+    }
 }
 
 proc wb::circle_b1r {c chatid 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 cx $circle(cx)
+	set cy $circle(cy)
 	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 r [expr {hypot($cx - $x, $cy - $y)}]
 
         set id [create_id]
-        lappend vars cx $cx
-	lappend vars cy $cy
-	lappend vars r $r
-        if {[set color [get_color $chatid]] != "#000000"} {
-	   lappend vars stroke $color
-	}
-	if {$dofill == 1} {
-	   lappend vars fill [get_fill_color $chatid]
-	}
-	if {[set width [get_width $chatid]] != 1} {
-	   lappend vars stroke-width $width
-	}
+	set tag [circle_tag $id $r]
 
-        lappend vars id $id
+        catch {$c delete $circle(temp)}
+        set circle(temp) [svg::parseSVGItem $c {} {} $tag]
 
-        catch {$c delete $circle(temp)}
-        set circle(temp) [eval $c create oval $x1 $y1 $x2 $y2 $circle(options) \
-				  -tag id$id]
-	    
 	if {[chat::is_groupchat $chatid]} {
 	    $c delete $circle(temp)
 	} else {
 	    set jid [jlib::connection_jid [chat::get_connid $chatid]]
+	    $c addtag tag:$tag withtag $circle(temp)
 	    $c addtag [time_tag created $jid] withtag $circle(temp)
 	}
 
-	send_svg $chatid [jlib::wrapper:createtag circle -vars $vars]
+	send_svg $chatid $tag
 
-        set circle(center) {}
+        unset circle(cx)
+        unset circle(cy)
         set circle(temp) {}
+
+	reset_bind $c $chatid
     }
 }
 
@@ -699,58 +854,58 @@
     variable circle
 
     if {[info exists circle(drawed)]} {
-	set cx [lindex $circle(center) 0]
-	set cy [lindex $circle(center) 1]
+	set cx $circle(cx)
+	set cy $circle(cy)
 	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 r [expr hypot($cx - $x, $cy - $y)]
 
+	set tag [circle_tag "" $r]
+
 	catch {$c delete $circle(temp)}
-	set circle(temp) [eval $c create oval $x1 $y1 $x2 $y2 $circle(options)]
+        set circle(temp) [svg::parseSVGItem $c {} {} $tag]
     }
 }
 
+proc wb::circle_tag {id r} {
+    variable circle
 
+    set vars $circle(options)
+    lappend vars r $r
+    if {$id != ""} {
+	lappend vars id $id
+    }
+    return [jlib::wrapper:createtag circle -vars $vars]
+}
 
 ###############################################################################
 
 ###############################################################################
 # Freehand
 
-proc wb::freehand_bind {c jid} {
+proc wb::freehand_bind {c chatid} {
     bind $c <ButtonPress-1> \
 	[list [namespace current]::freehand_b1p \
-	     [double% $c] [double% $jid] %x %y]
+	     [double% $c] [double% $chatid] %x %y]
     bind $c <B1-Motion> [list [namespace current]::freehand_b1m \
 			     [double% $c] %x %y]
     bind $c <ButtonRelease-1> \
-	[list [namespace current]::freehand_b1r [double% $c] [double% $jid]]
+	[list [namespace current]::freehand_b1r [double% $c] [double% $chatid]]
     bind $c <Button-3> {}
+    $c configure -cursor crosshair
 }
 
-proc wb::freehand_b1p {c jid x y} {
+proc wb::freehand_b1p {c chatid x y} {
     variable line
 
     set x [$c canvasx $x]
     set y [$c canvasy $y]
-    #puts "$x $y"
 
-    if {0 && [info exists line(drawed)]} {
-	lappend line(coords) $x $y
-
-	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords)]
-    } else {
-	set line(drawed) 1
-	set line(coords) "$x $y"
-	set line(options) [list -fill [get_color $jid] \
-			       -width [get_width $jid] \
-			       -joinstyle round]
+    set line(drawed) 1
+    set line(coords) [list $x $y]
+    set line(options) [list stroke-linejoin round stroke [get_color $chatid]]
+    if {[set width [get_width $chatid]] != 1} {
+	lappend line(options) stroke-width $width
     }
 }
 
@@ -764,7 +919,8 @@
 	lappend line(coords) $x $y
 
 	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords) $x $y $line(options)]
+	set tag [freehand_tag ""]
+	set line(temp) [svg::parseSVGItem $c {} {} $tag]
     }
 }
 
@@ -776,58 +932,46 @@
 	unset line(drawed)
 
 	set id [create_id]
+
+	set tag [freehand_tag $id]
+
 	catch {$c delete $line(temp)}
-	set line(temp) [eval $c create line $line(coords) $line(options) \
-			    -tag id$id]
+	set line(temp) [svg::parseSVGItem $c {} {} $tag]
 
 	if {[chat::is_groupchat $chatid]} {
 	    $c delete $line(temp)
 	} else {
 	    set jid [jlib::connection_jid [chat::get_connid $chatid]]
+	    $c addtag tag:$tag withtag $line(temp)
 	    $c addtag [time_tag created $jid] withtag $line(temp)
 	}
 
-	lappend vars points $line(coords)
-	if {[set color [get_color $chatid]] != "#000000"} {
-	    lappend vars stroke $color
-	}
-	if {[set width [get_width $chatid]] != 1} {
-	    lappend vars stroke-width $width
-	}
+	send_svg $chatid $tag
 
-	lappend vars id $id
-
-	send_svg $chatid [jlib::wrapper:createtag polyline \
-			   -vars $vars]
-
 	set line(coords) {}
 	set line(temp) {}
+
+	reset_bind $c $chatid
     }
 }
 
+proc wb::freehand_tag {id} {
+    variable line
+
+    set vars $line(options)
+    lappend vars points $line(coords)
+    if {$id != ""} {
+	lappend vars id $id
+    }
+    return [jlib::wrapper:createtag polyline -vars $vars]
+}
+
 ###############################################################################
 
 ###############################################################################
 # Remove
 
-proc wb::remove_bind {c jid} {
-    bind $c <ButtonPress-1> \
-	[list [namespace current]::remove_b1p \
-	     [double% $c] [double% $jid]]
-    bind $c <B1-Motion> {}
-    bind $c <ButtonRelease-1> {}
-    bind $c <Button-3> {}
-}
-
-proc wb::remove_b1p {c chatid} {
-    set tags [$c gettags current]
-    set id ""
-    foreach t $tags {
-	if {[crange $t 0 1] == "id"} {
-	    set id [crange $t 2 end]
-	    break
-	}
-    }
+proc wb::remove_b1p {c chatid id} {
     set connid [chat::get_connid $chatid]
     set jid [chat::get_jid $chatid]
     if {[chat::is_groupchat $chatid]} {
@@ -844,7 +988,6 @@
 			      -vars {xmlns tkabber:whiteboard} \
 			      -subtags [list [jlib::wrapper:createtag remove \
 						  -vars [list id $id]]]]]
-	
     }
 }
 
@@ -854,25 +997,14 @@
 ###############################################################################
 # Move
 
-proc wb::move_bind {c jid} {
-    bind $c <ButtonPress-1> \
-	[list [namespace current]::move_b1p \
-	     [double% $c] [double% $jid] %x %y]
-    bind $c <B1-Motion> [list [namespace current]::move_b1m \
-			     [double% $c] %x %y]
-    bind $c <ButtonRelease-1> \
-	[list [namespace current]::move_b1r [double% $c] [double% $jid]]
-    bind $c <Button-3> {}
-}
-
-proc wb::move_b1p {c jid x y} {
+proc wb::move_b1p {c chatid x y} {
     variable move
 
     set tags [$c gettags current]
     set id ""
     foreach t $tags {
-	if {[crange $t 0 1] == "id"} {
-	    set id [crange $t 2 end]
+	if {[string range $t 0 1] == "id"} {
+	    set id [string range $t 2 end]
 	    break
 	}
     }
@@ -886,6 +1018,7 @@
 	set move(lasty) $y
 
 	set move(id) $id
+	$c configure -cursor hand2
     } else {
 	catch {unset move(id)}
     }
@@ -915,19 +1048,21 @@
 	set x $move(lastx)
 	set y $move(lasty)
 
+	set dx [expr {$x - $move(startx)}]
+	set dy [expr {$y - $move(starty)}]
+
+	if {$dx == 0 && $dy == 0} return
+
 	if {[chat::is_groupchat $chatid]} {
 	    set type groupchat
-	    $c move id$id \
-		[expr {$move(startx) - $x}] [expr {$move(starty) - $y}]
+	    $c move id$id [expr {-$dx}] [expr {-$dy}]
 	} else {
 	    set type chat
 	    set jid [jlib::connection_jid [chat::get_connid $chatid]]
 	    $c addtag [time_tag moved $jid] withtag id$id
 	}
 
-	set vars [list id $id \
-		      dx [expr {$x - $move(startx)}] \
-		      dy [expr {$y - $move(starty)}]]
+	set vars [list id $id dx $dx dy $dy]
 
 	set connid [chat::get_connid $chatid]
 	set jid [chat::get_jid $chatid]
@@ -938,6 +1073,7 @@
 			      -vars {xmlns tkabber:whiteboard} \
 			      -subtags [list [jlib::wrapper:createtag move \
 						  -vars $vars]]]]
+	$c configure -cursor ""
     }
 }
 
@@ -950,12 +1086,13 @@
     bind $c <ButtonRelease-1> \
 	    [list [namespace current]::text_b1 [double% $c] [double% $chatid] %x %y]
     bind $c <Button-3> {}
+    $c configure -cursor crosshair
 }
 
 proc wb::text_b1 {c chatid x y} {
     variable text_info
-    set text_info(x) $x
-    set text_info(y) $y
+    set text_info(x) [$c canvasx $x]
+    set text_info(y) [$c canvasy $y]
     set w [win_id whiteboard $chatid]
     set wt $w.text_dialog
     if {[winfo exists $wt]} {
@@ -971,7 +1108,7 @@
 	$wt add -text [::msgcat::mc "OK"] \
 	    -command [list [namespace current]::text_ok $wt $c $chatid]
 	$wt add -text [::msgcat::mc "Cancel"] \
-	    -command [list wm withdraw $wt]
+	    -command [list [namespace current]::text_cancel $wt $c $chatid]
 
 	set en [entry $wt.text -width 80 \
 		    -textvariable [namespace current]::text_entered($chatid)]
@@ -986,20 +1123,7 @@
     set id [create_id]
 
     set text [set [namespace current]::text_entered($chatid)]
-    if {[chat::is_groupchat $chatid]} {
-	set type groupchat
-    } else {
-	set type chat
-	$c create text $text_info(x) $text_info(y) -tag id$id \
-	    -text $text \
-	    -fill [get_text_color $chatid]
-	set font [get_text_font $chatid]
-	if {[info exists app_font($font)]} {
-	    $c itemconfigure id$id -font $font
-	}
-	set jid [jlib::connection_jid [chat::get_connid $chatid]]
-	$c addtag [time_tag created $jid] withtag id$id
-    }
+
     set vars [list id $id x $text_info(x) y $text_info(y) \
 		   fill [get_text_color $chatid]]
     set font [get_text_font $chatid]
@@ -1026,10 +1150,24 @@
 	unset font_opt
     }
 
-    send_svg $chatid [jlib::wrapper:createtag text -vars $vars -chdata $text]
+    set tag [jlib::wrapper:createtag text -vars $vars -chdata $text]
+
+    if {![chat::is_groupchat $chatid]} {
+	set textid [svg::parseSVGItem $c {} {} $tag]
+	set jid [jlib::connection_jid [chat::get_connid $chatid]]
+	$c addtag tag:$tag withtag $textid
+	$c addtag [time_tag created $jid] withtag $textid
+    }
+
+    send_svg $chatid $tag
     wm withdraw $wt
+    reset_bind $c $chatid
 }
 
+proc wb::text_cancel {wt c chatid} {
+    wm withdraw $wt
+    reset_bind $c $chatid
+}
 
 ###############################################################################
 



More information about the Tkabber-dev mailing list