62 lines
1.5 KiB
Tcl
62 lines
1.5 KiB
Tcl
package require Tcl 8.6
|
|
|
|
# Write a message to everyone except the sender of the message
|
|
proc writeEveryoneElse {sender message} {
|
|
dict for {who ch} $::cmap {
|
|
if {$who ne $sender} {
|
|
puts $ch $message
|
|
}
|
|
}
|
|
}
|
|
|
|
# How to read a line (up to 256 chars long) in a coroutine
|
|
proc cgets {ch var} {
|
|
upvar 1 $var v
|
|
while {[gets $ch v] < 0} {
|
|
if {[eof $ch] || [chan pending input $ch] > 256} {
|
|
return false
|
|
}
|
|
yield
|
|
}
|
|
return true
|
|
}
|
|
|
|
# The chatting, as seen by one user
|
|
proc chat {ch addr port} {
|
|
### CONNECTION CODE ###
|
|
#Log "connection from ${addr}:${port} on channel $ch"
|
|
fconfigure $ch -buffering none -blocking 0 -encoding utf-8
|
|
fileevent $ch readable [info coroutine]
|
|
global cmap
|
|
try {
|
|
|
|
### GET THE NICKNAME OF THE USER ###
|
|
puts -nonewline $ch "Please enter your name: "
|
|
if {![cgets $ch name]} {
|
|
return
|
|
}
|
|
#Log "Mapping ${addr}:${port} to ${name} on channel $ch"
|
|
dict set cmap $name $ch
|
|
writeEveryoneElse $name "+++ $name arrived +++"
|
|
|
|
### MAIN CHAT LOOP ###
|
|
while {[cgets $ch line]} {
|
|
writeEveryoneElse $name "$name> $line"
|
|
}
|
|
|
|
} finally {
|
|
### DISCONNECTION CODE ###
|
|
if {[info exists name]} {
|
|
writeEveryoneElse $name "--- $name left ---"
|
|
dict unset cmap $name
|
|
}
|
|
close $ch
|
|
#Log "disconnection from ${addr}:${port} on channel $ch"
|
|
}
|
|
}
|
|
|
|
# Service the socket by making corouines running [chat]
|
|
socket -server {coroutine c[incr count] chat} 4004
|
|
set ::cmap {}; # Dictionary mapping nicks to channels
|
|
vwait forever; # Run event loop
|