# quake.ka by conio (sam@conio.net)
# retrieves a list of quake2 servers from frag.com

set quake(line) ""
set quake(p) 0
set quake(m) 0

proc put_quake sock {
    fileevent $sock writable ""
    window clear query .quake.
    puts $sock "GET /quake2/servers/servers.txt"
}

proc get_quake { sock filter what } {
    global quake litehelp darkhelp
    if [eof $sock] {
        close $sock
        echo "[kano] $quake(p) players on $quake(m) matching servers." query .quake.
        set quake(p) 0
        set quake(m) 0
        return
    }
    if ![window exists query .quake.] {
	/query .quake.
	window set_title "Frag.com Server List" query .quake.
    }
    gets $sock x

    switch [lindex $x 0] {
        "<TR" {
            echo $litehelp[format "%-32s %-10s %-10s %-10s %-64s" "Host name" Players Map Ping Game] query .quake.
        } "Last" {
            set update [string trim [lrange $x 2 6] "<p>"]
            window set_title "Frag.com Server List: Last updated $update" query .quake.
            echo "[kano] FRAG.COM QUAKE II SERVER LIST" query .quake.
            echo "[kano] LAST UPDATED: $update" query .quake.
        } "<TD" {
            lappend quake(line) [string range $x [expr [string first > $x] + 1] [expr [string last </td> $x] - 1]]
        } "</tr>" {
            set show 1
            switch $filter {
                p { if { $what < [string range [lindex $quake(line) 1] 0 [expr [string first "/" [lindex $quake(line) 1]] - 1]] } { set show 0 } }
                m { if ![string match [lindex $quake(line) 2] $what] { set show 0 } }
                n { if { $what < [lindex $quake(line) 3] } { set show 0 } }
                g { if ![string match [lindex $quake(line) 4] $what] { set show 0 } }
            }
            if $show { 
                incr quake(m)
                set quake(p) [expr $quake(p) + [string range [lindex $quake(line) 1] 0 [expr [string first "/" [lindex $quake(line) 1]] - 1]]]
                echo $litehelp[format "%-32s ${darkhelp}%-10s %-10s %-10s %s" [lindex $quake(line) 0] [lindex $quake(line) 1] [lindex $quake(line) 2] [lindex $quake(line) 3] [lindex $quake(line) 4]] query .quake.
            }
            set quake(line) ""
        }
    }
}

alias quake {
    if ![catch {socket 204.118.244.35 80} sock] {
        fconfigure $sock -buffering line -blocking 0
        fileevent $sock writable "put_quake $sock"
        if { [string match *[string index [lindex [args] 0] 1]* pmng] && [lindex [args] 1] != "" } { 
            fileevent $sock readable "get_quake $sock [string index [lindex [args] 0] 1] [lindex [args] 1]"
        } else {
            fileevent $sock readable "get_quake $sock 0 0"
        }
        echo "[kano] Getting server list..."
    } else {
 	echo [rep [rep [t socketfailed] %type Quake] %error $sock]
    }
    complete
}

addecho "[kano] quake.ka by conio (sam@conio.net) loaded"
addname quake.ka

kaddhelp quake "Shows a list of Quake II servers updated hourly from frag.com's database. ${litehelp}-p <maxplayers> filters all entries, showing only those with <maxplayers> or less players. ${litehelp}-m <map> filters all entries matching <map> (wildcards acceptible). ${litehelp}-n <maxping> filters all entries with <maxping> or less pings. ${litehelp}-g <game> matches all entries against the wildcard <game>." "/quake \[-p <maxplayers> | -m <map> | -n <maxping> | -g <game>]" "Show Quake II Servers"