#!/usr/bin/tclsh

# gothchat.tcl
# Copyright (C) 2004 Andy Goth <unununium@openverse.com>
# This code be under the GNU General Public License, y'hear?
# It's the messiest program EVAR! :^)

# Set this to the name of the server
set server       chainsaw
set port         3012

# Some other settings.
set start_hidden 0
set start_client 1
set timestamp    0
set sound        1

if {[catch {set hostname [exec hostname]}]} {set hostname 0.0.0.0}
if {[catch {set nick [string totitle [exec whoami]]}]} {set nick Guest}

set version      "gothchat 0.1.1"

# Takes each variable name listed in $out and assigns it a value popped from the
# variable named $in.  Returns 1 on success and 0 on failure.
proc arg_pop {out in} {
    upvar $in inList
    if {[llength $inList] < [llength $out]} {return 0}
    set idx 0
    foreach outVar $out {
        upvar $outVar var
        set var [lindex $inList $idx]
        incr idx
    }
    set inList [lrange $inList $idx end]
    return 1
}

while {[arg_pop arg argv]} {
    switch -- $arg {
    -hide     {set start_hidden 1 }
    -show     {set start_hidden 0 }
    -nick     {arg_pop nick   argv}
    -server   {arg_pop server argv}
    -port     {arg_pop port   argv}
    -noclient {set start_client 0 }
    }
}

proc ssplit {var} {
    upvar 1 $var data
    set div [string first " " $data]
    if {$div == -1} {
        set retval $data
        set data   ""
    } else {
        set retval [string range $data 0 [expr {$div - 1}]]
        set data   [string range $data [expr {$div + 1}] end]
    }
    return $retval
}

if {$hostname eq $server} {
    # Start server.
    set next_id 0

    proc broadcast {msg} {
        foreach chan $::chanlist {
            set id $::chanmap($chan)
            if {[set ::clients::${id}::auth]} {
                puts $chan $msg
            }
        }
    }

    proc do_ping {id} {
        if {![namespace exists ::clients::$id]} {return}
        if {[set ::clients::${id}::ping] - [clock seconds] > 450000} {
            # Ping timeout.
            set idx [lsearch $::idlist $id]
            set ::idlist [lreplace $::idlist $idx $idx]
            set idx [lsearch $::chanlist $chan]
            set ::chanlist [lreplace $::chanlist $idx $idx]
            unset ::idmap($id)
            unset ::chanmap($chan)
            if {[set ::clients::${id}::auth]} {
                broadcast "NOMORE $id"
            }
            namespace delete ::clients::$id
            close $chan
        } else {
            puts [set ::clients::${id}::chan] PING
            after 180000 do_ping $id
        }
    }

    proc accept_connection {chan addr port} {
        set id [incr ::next_id]

        fconfigure $chan -blocking 0 -buffering line\
                -encoding binary -translation binary
        fileevent $chan readable [list accept_from_client $chan]

        lappend ::idlist $id
        set ::idmap($id) $chan

        lappend ::chanlist $chan
        set ::chanmap($chan) $id

        namespace eval ::clients::$id {}
        set ::clients::${id}::chan    $chan
        set ::clients::${id}::id      $id
        set ::clients::${id}::nick    ""
        set ::clients::${id}::auth    0
        set ::clients::${id}::version unknown
        set ::clients::${id}::ping    [clock seconds]
        after 180000 do_ping $id

        catch {puts $chan "HELLO 'sup dawg!"}
        catch {puts $chan "VERSION $::version"}
    }

    proc accept_from_client {chan} {
        set id $::chanmap($chan)

        if {[gets $chan data] == -1} {
            if {[fblocked $chan]} {
                # Shouldn't happen?
            } elseif {[eof $chan]} {
                # Disconnect.
                set idx [lsearch $::idlist $id]
                set ::idlist [lreplace $::idlist $idx $idx]
                set idx [lsearch $::chanlist $chan]
                set ::chanlist [lreplace $::chanlist $idx $idx]
                unset ::idmap($id)
                unset ::chanmap($chan)
                if {[set ::clients::${id}::auth]} {
                    broadcast "NOMORE $id"
                }
                namespace delete ::clients::$id
                close $chan
            } else {
                # Huh?
            }
            return
        }

        set parms $data
        set cmd   [ssplit parms]

        if {![set ::clients::${id}::auth]} {
            # Authenticating...
            switch -- $cmd {
            WAKE {
                # Wake up a client.
                catch {puts [set ::clients::${parms}::chan] "WAKE"}
            } NICK {
                # Set nickname.
                set success 1
                foreach oid $::idlist {
                    if {$id != $oid && [set ::clients::${oid}::auth]} {
                        if {[set ::clients::${oid}::nick] eq $parms} {
                            # Nick collision!
                            puts $chan "ERROR 200 Nickname already taken"
                            set success 0
                            break
                        }
                    }
                }
                if {$success} {
                    # No nick collision.
                    set ::clients::${id}::nick $parms
                }
            } VERSION {
                # Set version.
                set ::clients::${id}::version $parms
            } LOGIN {
                # End authentication phase.
                set nick [set ::clients::${id}::nick]
                if {$nick eq ""} {
                    # Ack, no nickname.
                    puts $chan "ERROR 300 Nickname not provided"
                } else {
                    # Success.
                    puts $chan "NEW $id $nick"
                    foreach oid $::idlist {
                        if {$id != $oid && [set ::clients::${oid}::auth]} {
                            puts $chan "NEW $oid [set ::clients::${oid}::nick]"
                        }
                    }
                    broadcast "NEW $id $nick"
                    puts $chan "LOGIN"
                    set ::clients::${id}::auth 1
                }
            } PONG {
                # Ping response.
                set ::clients::${id}::ping [clock seconds]
            } default {
                # ?
                puts $chan "WARNING 100 Unrecognized command $cmd"
            }}
        } else {
            # Chatting...
            switch -- $cmd {
            CHAT {
                # Chatter.
                broadcast "CHAT $id $parms"
            } NICK {
                # Change nickname.
                set success 1
                foreach oid $::idlist {
                    if {$id != $oid} {
                        if {[set ::clients::${oid}::nick] eq $parms} {
                            # Nick collision!
                            puts $chan "ERROR 200 Nickname already taken"
                            set success 0
                            break
                        }
                    }
                }
                if {$success} {
                    # No nick collision.
                    set ::clients::${id}::nick $parms
                    broadcast "NICK $id $parms"
                }
            } PONG {
                # Ping response.
                set ::clients::${id}::ping [clock seconds]
            } default {
                # ?
                puts $chan "WARNING 100 Unrecognized command $cmd"
            }}
        }
    }

    catch {socket -server accept_connection $port}
}

if {$start_client} {
    # Connect to server.
    package require Tk 8.4

    proc show_text {msg} {
        if {$::timestamp} {
            set msg "[clock format [clock seconds] -format %T] $msg"
        }

        if {$::first} {
            set ::first 0
        } else {
            set msg "\n$msg"
        }

        .text configure -state normal
        .text insert end $msg
        .text configure -state disabled
        .text see end

        if {[wm state .] eq "iconic"} {
            wm deiconify .
            focus .msg
        }
    }

    proc accept_from_server {chan} {
        if {[gets $chan data] == -1} {
            if {[fblocked $chan]} {
                # Shouldn't happen?
            } elseif {[eof $chan]} {
                # Disconnect.
                close $chan
                exit
            } else {
                # Huh?
            }
            return
        }

        set parms $data
        set cmd   [ssplit parms]

        if {!$::auth} {
            # Authenticating...
            switch -- $cmd {
            NEW {
                # Success.
                if {$::id eq ""} {
                    set ::id [ssplit parms]
                    if {$::nick ne $parms} {
                        show_text "Forced to change name to \"$parms\"."
                    }
                    set ::nick $parms
                    set ::nicks($::id) $::nick
                } else {
                    set id [ssplit parms]
                    set ::nicks($id) $parms
                    if {[string compare -nocase $parms vile] == 0} {
                        show_text "$parms is in the house."
                    } else {
                        show_text "$parms is in the chat."
                    }
                }
            } LOGIN {
                set ::auth 1
                show_text "Connected."
                if {$::start_hidden} {wm iconify .}
            } ERROR {
                set code [ssplit parms]
                switch -- $code {
                200 {
                    set new ${::nick}-
                    append new [format %0.2d [expr {int(rand() * 100)}]]
                    puts $chan "NICK $new"
                } 300 {
                    puts $chan "LOGIN"
                }}
            } PING {
                puts $chan "PONG"
            }}
        } else {
            # Chatting...
            switch -- $cmd {
            CHAT {
                # Chatter.
                set id [ssplit parms]
                show_text "<$::nicks($id)> $parms"
                if {$::sound} {bell}
            } NEW {
                # New user.
                set id [ssplit parms]
                set ::nicks($id) $parms
                show_text "$parms joined the chat."
            } NICK {
                # Change nickname.
                set id [ssplit parms]
                if {$id != $::id} {
                    show_text "$::nicks($id) changed name to \"$parms\"."
                } else {
                    show_text "Changing name to \"$::nick\"."
                }
                set ::nicks($id) $parms
            } NOMORE {
                # User left.
                set id [ssplit parms]
                show_text "$::nicks($id) left the chat."
                unset ::nicks($id)
            } ERROR {
                # Problem.
                set code [ssplit parms]
                switch -- $code {
                200 {
                    show_text "The name \"${::nick}\" is already in use."
                }}
            } PING {
                puts $chan "PONG"
            }}
        }
    }

    proc chat {} {
        if {$::msg ne ""} {
            puts $::chan "CHAT $::msg"
            set ::msg ""
        }
    }

    proc set_nick {} {
        if {$::nick ne $::nicks($::id)} {
            puts $::chan "NICK $::nick"
        }
    }

    option clear

    # Set the default font.
    button .b
    option add *Font [.b cget -font]
    destroy .b

    # Set all other display defaults.
    foreach {path cfg} {
    ""           {Relief solid}
    Button.      {Background white  Foreground black  BorderWidth 1 padY 0}
    Checkbutton. {Background white  Foreground black  BorderWidth 1 padY 1
                  OnRelief solid OffRelief solid selectColor black}
    Text.        {Background gray90 Foreground gray30 BorderWidth 1}
    Scrollbar.   {Background black  Foreground black  BorderWidth 0
                  Width 10 troughColor white}
    Label.       {Background gray90 Foreground gray30 BorderWidth 1}
    Entry.       {Background white  Foreground black  BorderWidth 1}
    } {
        foreach {key val} $cfg {
            option add *$path$key $val startupFile
        }
    }

    # Create a nifty autoupdating clock variable.
    proc update_time {} {
        set ::time [clock format [clock seconds]]
        after 1000 update_time
    }
    update_time

    frame .toplevel

    frame .misc
    label .nickl -text "Your name:"
    frame .nickf
    entry .nicke -textvariable nick
    button .nickb -text Change -command set_nick
    pack .nicke -in .nickf -side left -padx 2 -fill x -expand 1
    pack .nickb -in .nickf -side right -padx 2
    label .timel -text "Current time:"
    label .timee -textvariable time

    grid .nickl -in .misc -row 0 -column 0 -sticky ew -padx 3 -pady 3
    grid .nickf -in .misc -row 0 -column 1 -sticky ew -padx 0 -pady 2
    grid .timel -in .misc -row 1 -column 0 -sticky ew -padx 3 -pady 3
    grid .timee -in .misc -row 1 -column 1 -sticky ew -padx 3 -pady 3
    grid columnconfigure .misc 1 -weight 1

    pack .misc  -in .toplevel -side top -pady 2 -fill x

    frame     .chat
    text      .text -wrap word -width 40 -height 5 -yscrollcommand ".scroll set"
    frame     .scrollb -background white -borderwidth 1 -relief solid
    scrollbar .scroll  -orient vertical -command ".text yview"
    .text configure -state disabled

    pack .text    -in .chat     -side left  -padx 2         -fill both -expand 1
    pack .scroll  -in .scrollb  -side top                   -fill both -expand 1
    pack .scrollb -in .chat     -side right -padx 3 -pady 1 -fill y
    pack .chat    -in .toplevel -side top                   -fill both -expand 1

    frame  .sender
    entry  .msg -textvariable msg
    button .send -text Send -command [list chat]

    pack .msg    -in .sender   -side left  -padx 2 -pady 4 -fill x -expand 1
    pack .send   -in .sender   -side right -padx 2 -pady 4
    pack .sender -in .toplevel -side top                   -fill x

    proc cb_fixup {win} {
        if {[set [$win cget -variable]] eq [$win cget -onvalue]} {
            $win configure -foreground white
        } else {
            $win configure -foreground black
        }
    }

    frame  .bottom
    checkbutton .sound -text Sound -variable ::sound -indicatoron 0\
                       -command {cb_fixup .sound}
    checkbutton .ts    -text Timestamps -variable ::timestamp -indicatoron 0\
                       -command {cb_fixup .ts}
    cb_fixup .sound
    cb_fixup .ts
    button .hide -text Hide -command {wm iconify .}
    button .exit -text Exit -command exit
    pack   .sound   -in .bottom -side left -padx 2 -fill x -expand 1
    pack   .ts      -in .bottom -side left -padx 2 -fill x -expand 1
    pack   .hide    -in .bottom -side left -padx 2 -fill x -expand 1
    pack   .exit    -in .bottom -side left -padx 2 -fill x -expand 1
    pack   .bottom  -in .toplevel -fill x -pady 1

    pack .toplevel -fill both -expand 1 -padx 3 -pady 3

    # Set the window size.
    update
    wm geometry . [wm geometry .]
    wm title . "$version - $server"
    wm iconname . $server

    # Allow the textbox to resize freely.
    .text  configure -width 0 -height 0

    focus .msg

    bind .nicke <Key-Return> {.nickb invoke}
    bind .nicke <FocusOut>   {set ::nick $::nicks($::id)}
    bind .msg   <Key-Return> {.send invoke}
    bind Button <Key-Return> {tk::ButtonInvoke %W}

    set first 1
    set auth 0
    set id ""
    if {[catch {set chan [socket $server $port]} result]} {
        if {$::start_hidden} {after 3000 exit}
        tk_dialog .x $version "Cannot connect to server." "" 0 Crud!
        exit
    }
    fconfigure $chan -blocking 0 -buffering line\
            -encoding binary -translation binary
    fileevent $chan readable [list accept_from_server $chan]
    puts $chan "VERSION $::version"
    puts $chan "NICK $::nick"
    puts $chan "LOGIN"
} else {
    vwait forever
}

# vim: set ts=4 sts=4 sw=4 et: