Tk Library Source Code

Artifact 7060e9c4993933b905f1268f7e10d57b2b0db77b:

Attachment "drawing.patch" to ticket [602279ffff] added by dkf 2002-08-30 15:19:15.

---

Index: apps/tkchat/tkchat.tcl
===================================================================
RCS file: /cvsroot/tcllib/tclapps/apps/tkchat/tkchat.tcl,v
retrieving revision 1.65
diff -u -r1.65 tkchat.tcl
--- apps/tkchat/tkchat.tcl	13 Aug 2002 12:56:46 -0000	1.65
+++ apps/tkchat/tkchat.tcl	30 Aug 2002 08:17:26 -0000
@@ -101,14 +101,14 @@
 proc buildProxyHeaders {} {
     global Options
     set auth {}
-    if { $Options(UseProxy) \
-               && [info exists Options(ProxyUsername)] \
-               && $Options(ProxyUsername) != {}
-     } then {
+    if {
+	$Options(UseProxy) \
+		&& [info exists Options(ProxyUsername)] \
+		&& $Options(ProxyUsername) != {}
+    } then {
 	set auth [list "Proxy-Authorization" \
-                        [concat "Basic" \
-                               [base64::encode \
-                                      $Options(ProxyUsername):$Options(ProxyPassword)]]]
+		[concat "Basic" [base64::encode \
+		$Options(ProxyUsername):$Options(ProxyPassword)]]]
     }
     return $auth
 }
@@ -1001,6 +1001,11 @@
 }
 
 proc addMessage {clr nick str} {
+    if {[string match {$white_board *} $str]} {
+	if {[whiteboard::add $clr $nick $str]} {
+	    return
+	}
+    }
     global Options
     variable map
     set w .txt
@@ -2909,3 +2914,90 @@
 ::dict.leo.org::init
 
 bind . <Shift-Button-3> {::dict.leo.org::askLEOforSelection}
+
+######################################################################
+#
+# Drawing module; provides a shared whiteboard
+#
+######################################################################
+
+namespace eval whiteboard {
+    variable wb_tl
+    variable wb
+    variable clr
+    variable RE
+    array set RE {
+	line  {^\S+\s+create line((?:\s+\d+(:?\.\d+)?)+)\s*$}
+	clear {^\S+\s+delete all\s*$}
+    }
+}
+proc whiteboard::init {} {
+    variable wb_tl
+    variable wb
+    variable clr
+
+    set wb_tl [toplevel .wb -bg white]
+    set wb [canvas .wb.wb]
+    set clr [button .wb.clr -text "Clear Whiteboard" \
+	    -command ::whiteboard::sendClear]
+    pack $wb $clr -fill both
+
+    bind $wb <1> {whiteboard::startLine %W %x %y}
+    bind $wb <B1-Motion> {whiteboard::midLine %W %x %y}
+    bind $wb <ButtonRelease-1> {whiteboard::endLine %W}
+}
+proc whiteboard::add {clr nick str} {
+    variable wb_tl
+    variable wb
+    variable RE
+    if {![info exists wb] || ![winfo exists $wb]} {
+	whiteboard::init
+    }
+    if {[regexp $RE(line) $str -> coords]} {
+	if {[catch "$wb create line $coords" line] == 0} {
+	    $wb itemconf $line -fill #[getColor $nick] -tags [list $nick]
+	}
+	return 1
+    } elseif {[regexp $RE(clear) $str]} {
+	$wb delete all
+	return 1
+    }
+    return 0
+}
+proc whiteboard::startLine {w x y} {
+    variable id [$w create line $x $y $x $y]
+}
+proc whiteboard::midLine {w x y} {
+    variable id
+    $w coords $id [concat [$w coords $id] $x $y]
+}
+proc whiteboard::endLine {w} {
+    variable id
+    set coords [straighten [string map {.0 {}} [$w coords $id]]]
+    set msg "\$white_board create line $coords"
+    $w delete $id
+    msgSend $msg
+}
+proc whiteboard::sendClear {} {
+    msgSend {$white_board delete all}
+}
+proc whiteboard::straighten {coords} {
+    foreach {x0 y0 x1 y1} $coords break ;# get first two points
+    set res [list $x0 $y0]              ;# keep first point
+    foreach {x2 y2} [lrange $coords 2 end] {
+	if {abs($x2-$x1)<5 && abs($y2-$y1)<5} continue
+	set d01 [expr {hypot($x0-$x1, $y0-$y1)}]
+	set d02 [expr {hypot($x0-$x2, $y0-$y2)}]
+	set d12 [expr {hypot($x1-$x2, $y1-$y2)}]
+	if {$d02>0 && (($d01+$d12)/$d02)>0.1 || ($d01+$d12-$d02)>0.1} {
+	    lappend res $x1 $y1
+	    set x0 $x1; set y0 $y1
+	}
+	set x1 $x2; set y1 $y2
+    }
+    if {[llength $res]==2 || abs($x0-$x1)>3 || abs($y0-$y1)>3} {
+	lappend res $x1 $y1
+    }
+    return $res
+}
+catch {whiteboard::init}