From: patthoyts <patthoyts>
Date: Tue, 23 Nov 2004 13:39:29 +0000 (+0000)
Subject: * demos/chat.tcl: Sample Tk chat app using multicast udp.
X-Git-Tag: tcludp-1_0_7~9
X-Git-Url: https://privyetmir.co.uk/gitweb.cgi?a=commitdiff_plain;h=9d255343a48e186181f37f4506d00e72c56d5383;p=tcludp

* demos/chat.tcl: Sample Tk chat app using multicast udp.
---

diff --git a/ChangeLog b/ChangeLog
index c1ec4b8..e46f693 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,11 @@
+2004-11-23  Pat Thoyts  <patthoyts@users.sourceforge.net>
+
+	* demos/chat.tcl: Sample Tk chat app using multicast udp.
+
 2004-11-22  Pat Thoyts  <patthoyts@users.sourceforge.net>
 
+	* TAG:          ====  tcludp-1_0_6 ====
+	
 	* win/makefile.vc: Improved the win build system.
 	* demos/*: Added a few sample applications, demos of broadcast, 
 	multicast and normal operation.
diff --git a/demos/chat.tcl b/demos/chat.tcl
new file mode 100644
index 0000000..acef698
--- /dev/null
+++ b/demos/chat.tcl
@@ -0,0 +1,68 @@
+# chat.tcl - Copyright (C) 2004 Pat Thoyts <patthoyts@users.sourceforge.net>
+#
+# This is a sample application from TclUDP.
+#
+# This illustrates the use of multicast UDP messages to implement a primitive chat
+# application.
+#
+# $Id$
+
+package require Tk  8.4
+package require udp 1.0.6
+
+variable Address  224.5.1.21
+variable Port     7771
+
+proc Receive {sock} {
+    set pkt [read $sock]
+    set peer [fconfigure $sock -peer]
+    AddMessage $peer $pkt
+    return
+}
+
+proc Start {addr port} {
+    set s [udp_open $port]
+    fconfigure $s -blocking 0 -buffering none -translation binary \
+        -mcastadd $addr -remote [list $addr $port]
+    fileevent $s readable [list ::Receive $s]
+    return $s
+}
+
+proc CreateGui {socket} {
+    text .t -yscrollcommand {.s set}
+    scrollbar .s -command {.t yview}
+    frame .f -border 0
+    entry .f.e -textvariable ::_msg
+    button .f.ok -text Send -underline 0 -command "SendMessage $socket \$::_msg"
+    button .f.ex -text Exit -underline 1 -command {destroy .}
+    pack .f.ex .f.ok -side right
+    pack .f.e -side left -expand 1 -fill x
+    grid .t .s -sticky news
+    grid .f -  -sticky ew
+    grid columnconfigure . 0 -weight 1
+    grid rowconfigure . 0 -weight 1
+    bind .f.e <Return> {.f.ok invoke}
+    .t tag configure CLNT -foreground red
+}
+
+proc SendMessage {sock msg} {
+    puts -nonewline $sock $msg
+}
+
+proc AddMessage {client msg} {
+    set msg [string map [list "\r\n" "" "\r" "" "\n" ""] $msg]
+    set client [lindex $client 0]
+    if {[string length $msg] > 0} {
+        .t insert end "$client " CLNT "$msg\n" MSG
+    }
+}
+
+if {!$tcl_interactive} {
+    set sock [Start $Address $Port]    
+    CreateGui $sock
+    after idle [list SendMessage $sock "$::tcl_platform(user)@[info hostname] connected"]
+    tkwait window .
+    close $sock
+    exit 0
+}
+