view mservtk.tcl @ 8:81b36e5b725b default tip

Add mouse wheel support
author darius
date Tue, 17 Sep 2002 06:04:33 +0000
parents abe05fb9c2a6
children
line wrap: on
line source

#!/usr/bin/env wish8.2

#
# This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name Daniel O'Connor nor the names of its contributors
#    may be used to endorse or promote products derived from this software
#    without specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY DANIEL O'CONNOR AND CONTRIBUTORS ``AS IS'' AND
# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

proc main {} {
    global argv0 argv state albums songs tcl_platform;

    if {[string first "Windows" $tcl_platform(os)] == -1} {
	set state(conffile) "~/.mservtk";
	set state(windows) 0;
    } else {
	package require registry 1.0;
	set state(windows) 1;
    }

    set state(loglevel) 0;
    set state(port) "4444";
    set state(exit) 0;
    set state(tmpphrase) "";
    set state(sortmode) "Title";

    set state(rtlist) "";

    wm withdraw .;

    f_readconf;
    gui_conf;
    
    if {$state(host) == "NONE"} {
	log 0 "Login cancelled";
	exit;
    } else {
	log 0 "Login OK'd";
    }

    f_writeconf;

    wm deiconify .;
    con_mserv;

    con_getalbums albums;
    con_getsongs songs albums;

    gui_build;
    focus -force .;

    gui_updatesongs;
    gui_updatequeue;

    gui_updateinfo;
    update_timer;

    while {1} {
	vwait state;

	if {$state(rtlist) != ""} {
	    # Copy it so we don't stomp any new additions
	    set tmp $state(rtlist);
	    set state(rtlist) "";

	    foreach t $tmp {
#		log 0 "Handle $t";
		n_rthandler [lindex $t 0] [lindex $t 1];
	    }
	}

	if {$state(exit) == 1} {
	    exit;
	}
    }
}

proc f_readconf {} {
    global state;
    
    set state(host) "NONE";
    set state(user) "NONE";
    set state(pass) "";

    if {$state(windows) == 1} {
	if {[catch {
	    set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host];
	    set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user];
	    set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass];
	} msg]} {
	    log 0 "Failed to read registry keys - $msg";
	}
    } else {
	if {![catch {
	    set fh [open $state(conffile)];
	} msg]} {
	    if {[gets $fh] != "mservtk-0.1"} {
		log 0 "Conf file has the wrong version";
	    } else {
		set state(host) [gets $fh];
		set state(user) [gets $fh];
		set state(pass) [gets $fh];
		close $fh;
	    }
	} else {
	    log 0 "Failed to open $state(conffile) - $msg";
	}
    }
}

proc f_writeconf {} {
    global state;
    
    if {$state(windows) == 1} {
	if {[catch {
	    registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host);
	    registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user);
	    registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass);
	} msg]} {
	    log 0 "Failed to set registry keys - $msg";
	}
    } else {
	if {![catch {
	    set fh [open $state(conffile) w];
	} msg]} {
	    puts $fh "mservtk-0.1";
	    puts $fh $state(host);
	    puts $fh $state(user);
	    puts $fh $state(pass);

	    close $fh;
	} else {
	    log 0 "Failed to open $state(conffile) - $msg";
	}
    }
}

proc gui_conf {} {
    global state;

    catch {destroy .conf};

    toplevel .conf -class Dialog;
    wm title .conf "Authentication";
    wm iconname .conf "Authentication";

    frame .conf.host;
    pack .conf.host -side top -pady 2m -fill x;
    label .conf.host.label -text "Host:" -width 10 -anchor e;

    entry .conf.host.entry -relief sunken -width 30 -textvariable state(host)
    pack .conf.host.label .conf.host.entry -side left -padx 1m

    frame .conf.user
    pack .conf.user -side top -pady 2m -fill x
    label .conf.user.label -text "User:" -width 10 -anchor e
    entry .conf.user.entry -relief sunken -width 8 -textvariable state(user)
    pack .conf.user.label .conf.user.entry -side left -padx 1m

    frame .conf.password
    pack .conf.password -side top -pady 2m -fill x
    label .conf.password.label -text "Password:" -width 10 -anchor e
    entry .conf.password.entry -relief sunken -width 8 -textvariable state(pass) -show *;
    bind .conf.password.entry <Return> ".conf.buttons.ok invoke";
    pack .conf.password.label .conf.password.entry -side left -padx 1m

    frame .conf.buttons
    pack .conf.buttons -side top -pady 1m -fill x
    button .conf.buttons.ok -text OK -width 6 -command {
        destroy .conf;
    }
    button .conf.buttons.cancel -text Cancel -width 6 -command {
        set state(host) "NONE";
        set state(user) "NONE";
        set state(pass) "NONE";
        destroy .conf;
    }
    pack .conf.buttons.ok -side left -padx 1m;
    pack .conf.buttons.cancel -side right -padx 1m;

    
    # Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw .conf
    update idletasks
    set x [expr [winfo screenwidth .conf]/2 - [winfo reqwidth .conf]/2 \
            - [winfo vrootx [winfo parent .conf]]]
    set y [expr [winfo screenheight .conf]/2 - [winfo reqheight .conf]/2 \
            - [winfo vrooty [winfo parent .conf]]]
    wm geom .conf +$x+$y
    wm deiconify .conf

    # Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current .conf]
    if {$oldGrab != ""} {
        set grabStatus [grab status $oldGrab]
    }
    grab .conf
    tkwait visibility .conf
    if {$state(host) == "NONE"} {
        focus .conf.host.entry;
    } else {
        focus .conf.password.entry;
    }
    tkwait window .conf;
    if {$oldGrab != ""} {
        if {$grabStatus == "global"} {
            grab -global $oldGrab
        } else {
            grab $oldGrab
        }
    }

    log 0 "Host $state(host)";
}

proc quit_now {} {
    global state;

    set state(exit) 1;
}

proc gui_build {} {
    # create the toplevel
    eval destroy [winfo child .];
    wm title . "MServ-Tk";
    wm minsize . 600 500;
    wm geometry . 600x500;

    # Let's have a menubar
    frame .menubar -relief raised -bd 2;
    pack .menubar -side top -fill x;

    # Add the File menu
    menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
    menu .menubar.file.m -tearoff 0;
    .menubar.file.m add command -label " Top" -command "gui_top"
    .menubar.file.m add command -label " Update Queue" -command "gui_updatequeue"
    .menubar.file.m add separator;
    .menubar.file.m add command -label " Quit" -command "quit_now" \
	-underline 2 -accelerator "Alt-q";
    pack .menubar.file -side left;

    # Add the Rate menu
    menubutton .menubar.rate -text "Rate" -menu .menubar.rate.m -underline 0;
    menu .menubar.rate.m -tearoff 0;
    .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB";
    .menubar.rate.m add command -label " Good" -command "rate_song GOOD";
    .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL";
    .menubar.rate.m add command -label " Bad" -command "rate_song BAD";
    .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL";
    .menubar.rate.m add command -label " Awful and Skip" -command "rate_song AWFUL ; control_player NEXT";
    
    pack .menubar.rate -side left;

    # Add the Control menu
    menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0;
    menu .menubar.control.m -tearoff 0;
    .menubar.control.m add command -label " Next" -command "control_player NEXT";
    .menubar.control.m add command -label " Pause" -command "control_player PAUSE";
    .menubar.control.m add command -label " Stop" -command "control_player STOP"
    .menubar.control.m add command -label " Play" -command "control_player PLAY";
    
    pack .menubar.control -side left;

    # Add the Volume menu
    menubutton .menubar.vol -text "Volume" -menu .menubar.vol.m -underline 0;
    menu .menubar.vol.m -tearoff 0;
    .menubar.vol.m add command -label " Increase" -command "set_vol +3" \
	-accelerator "+";
    .menubar.vol.m add command -label " Decrease" -command "set_vol -3" \
	-accelerator "-";
    .menubar.vol.m add separator;
    .menubar.vol.m add command -label " 100%" -command "set_vol 100";
    .menubar.vol.m add command -label " 90%" -command "set_vol 90";
    .menubar.vol.m add command -label " 80%" -command "set_vol 80";
    .menubar.vol.m add command -label " 70%" -command "set_vol 70";
    .menubar.vol.m add command -label " 60%" -command "set_vol 60";
    .menubar.vol.m add command -label " 50%" -command "set_vol 50";
    .menubar.vol.m add command -label " 40%" -command "set_vol 40";
    .menubar.vol.m add command -label " 30%" -command "set_vol 30";
    .menubar.vol.m add command -label " 20%" -command "set_vol 20"; 
    .menubar.vol.m add command -label " 10%" -command "set_vol 10";
    .menubar.vol.m add command -label " 0%" -command "set_vol 0";
   
    pack .menubar.vol -side left;

    # Add the Sort menu
    menubutton .menubar.sort -text "Sort" -menu .menubar.sort.m -underline 0;
    menu .menubar.sort.m -tearoff 0;
    .menubar.sort.m add command -label " Artist" \
	-command "global state; set state(sortmode) Artist; gui_updatesongs";
    .menubar.sort.m add command -label " Title" \
	-command "global state; set state(sortmode) Title; gui_updatesongs";
    .menubar.sort.m add command -label " Album" \
	-command "global state; set state(sortmode) Album; gui_updatesongs";
    
    pack .menubar.sort -side left;
 
    # Add the debug menu
    menubutton .menubar.debug -text "Debug" -menu .menubar.debug.m -underline 0;
    menu .menubar.debug.m -tearoff 0;
    .menubar.debug.m add command -label " Debug 0" -command "global state; set state(loglevel) 0";
    .menubar.debug.m add command -label " Debug 1" -command "global state; set state(loglevel) 1";
    pack .menubar.debug -side left;

    # Add the Help menu
    menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0;
    menu .menubar.help.m -tearoff 0;
    .menubar.help.m add command -label " About" -command "about_box" \
	-underline 2;
    pack .menubar.help -side right;

    # Top frame holding tracklist and trackinfo frames
    frame .top -relief raised -bd 1;
    pack .top -fill both -expand 1;

    # Tracklist
    frame .top.tlist -relief raised -bd 1;
    pack .top.tlist -side left -fill both -expand 1;
    label .top.tlist.label -text "Track List";
    pack .top.tlist.label -side top -expand 0;
    listbox .top.tlist.list -relief raised -borderwidth 2 \
	-yscrollcommand ".top.tlist.scr set";
    pack .top.tlist.list -side left -fill both -expand 1;
    scrollbar .top.tlist.scr -command ".top.tlist.list yview";
    pack .top.tlist.scr -side right -fill y;
    
    bind .top.tlist.list <Button-4> ".top.tlist.list yview scroll -3 units";
    bind .top.tlist.list <Button-5> ".top.tlist.list yview scroll +3 units";
    bind .top.tlist.list <Shift-Button-4> ".top.tlist.list yview scroll -1 pages";
    bind .top.tlist.list <Shift-Button-5> ".top.tlist.list yview scroll +1 pages";

    bind .top.tlist.list <Double-Button-1> {
	queue_song [.top.tlist.list curselection];
	gui_updatequeue;
    }
    
    # Trackinfo
    frame .top.tinfo -relief raised -bd 1;
    pack .top.tinfo -side right -fill both -expand 0;
    label .top.tinfo.label -text "Track Info";
    pack .top.tinfo.label -side top -expand 0;
    frame .top.tinfo.sub -relief raised -bd 1;
    pack .top.tinfo.sub -side right -fill both -expand 0;
    label .top.tinfo.sub.author -text "Author:";
    pack .top.tinfo.sub.author -side top -expand 0;
    label .top.tinfo.sub.title -text "Title:";
    pack .top.tinfo.sub.title -side top -expand 0;
    label .top.tinfo.sub.length -text "Length:";
    pack .top.tinfo.sub.length -side top -expand 0;
#    label .top.tinfo.sub.time -text "Time:";
#    pack .top.tinfo.sub.time -side top -expand 0;
    label .top.tinfo.sub.album -text "Album:";
    pack .top.tinfo.sub.album -side top -expand 0;
    label .top.tinfo.sub.misc -text "Misc:";
    pack .top.tinfo.sub.misc -side top -expand 0;
    label .top.tinfo.sub.rate1 -text "Rating:";
    pack .top.tinfo.sub.rate1 -side top -expand 0;
    label .top.tinfo.sub.rate2 -text "Temporally Adjusted:";
    pack .top.tinfo.sub.rate2 -side top -expand 0;
    label .top.tinfo.sub.vol -text "Volume:";
    pack .top.tinfo.sub.vol -side top -expand 0;

    # Queue (and the frame holding it)
    frame .bot -relief raised -bd 1;
    pack .bot -fill both -expand 1;
    label .bot.qlabel -text "Queue";
    pack .bot.qlabel -side top -expand 0;
    frame .bot.queue;
    pack .bot.queue -fill both -expand 1;
    listbox .bot.queue.list -relief raised -borderwidth 2 \
	-yscrollcommand ".bot.queue.scr set";
    pack .bot.queue.list -side left -fill both -expand 1;
    scrollbar .bot.queue.scr -command ".bot.queue.list yview";
    pack .bot.queue.scr -side right -fill y;
    bind .bot.queue.list <Double-Button-1> {
	gui_delqueue [.bot.queue.list curselection];
    }

    bind . <Destroy> {quit_now};
    bind all <Alt-q> {quit_now};

    bind all <KP_Add> {set_vol +3};
    bind all <KP_Subtract> {set_vol -3};
    bind all <plus> {set_vol +3};
    bind all <equal> {set_vol +3};
    bind all <minus> {set_vol -3};
    bind all <F1> {set_vol 10};
    bind all <F2> {set_vol 20};
    bind all <F3> {set_vol 30};
    bind all <F4> {set_vol 40};
    bind all <F5> {set_vol 50};
    bind all <F6> {set_vol 60};
    bind all <F7> {set_vol 70};
    bind all <F8> {set_vol 80};
    bind all <F9> {set_vol 90};
    bind all <F10> {set_vol 100};
    
    bind all <Pause> {control_player PAUSE};
    bind all <End> {control_player NEXT};
    bind all <Delete> {control_player STOP};
    bind all <Home> {control_player PLAY};

    update;
}

proc queue_song {id} {
    global songs state;

    set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0];
    log 0 "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)";

    set cookie [acquire_lock];
    n_write "QUEUE [split $tmp {:}]";
    n_getrtn rtn;
    release_lock $cookie;
    
    if {$rtn(code) != 247} {
	if {$rtn(code) == 510} {
	    msg_box "Queue" "You can't have the same\nsong in the queue twice!";
	} else {
	    log 0 "Failed to queue track ($rtn(code) $rtn(data))";
	}
    }
}

proc msg_box {title msg} {
    global state;

    catch {destroy .msg};

    toplevel .msg -class Dialog;
    wm title .msg $title;
    wm iconname .msg $title;

    # text region
    frame .msg.frame;
    pack .msg.frame -side top -fill both -expand yes;
    text .msg.frame.text -font fixed -yscroll ".msg.frame.scroll set" -wrap none;
    scrollbar .msg.frame.scroll -command ".msg.frame.text yview";
    pack .msg.frame.text -side left -expand y -fill both;
    pack .msg.frame.scroll -side right -fill y;

    # close button
    button .msg.close -text "Close" -command "destroy .msg";
    pack .msg.close -side bottom -fill x;

    # read text into the text widget
    .msg.frame.text insert end $msg;
}

proc about_box {} {
    global state;

    catch {destroy .about};

    toplevel .about -class Dialog;
    wm title .about "About...";
    wm iconname .about "About";

    # text region
    frame .about.frame;
    pack .about.frame -side top -fill both -expand yes;
    text .about.frame.text -font fixed -height 10 -width 40 -yscroll ".about.frame.scroll set" \
        -wrap none;
    scrollbar .about.frame.scroll -command ".about.frame.text yview";
    pack .about.frame.text -side left -expand y;
    pack .about.frame.scroll -side right -fill y;

    # close button
    button .about.close -text "Close" -command "destroy .about";
    pack .about.close -side bottom -fill x;

    # read text into the text widget
    .about.frame.text insert end "Mserv Client\n";
    .about.frame.text insert end "Copyright Daniel O'Connor 2000\n";
    .about.frame.text insert end "\n";
    .about.frame.text insert end "http://www.dons.net.au/~darius/\n";
}

proc set_vol {vol} {
    global state;

    set cookie [acquire_lock];
    n_write "VOLUME $vol"
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 255} {
	log 0 "Couldn't set volume ($rtn(code) $rtn(data))";
    }
}

proc rate_song {rate} {
    global state;

    set cookie [acquire_lock];
    n_write "RATE $rate";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 270} {
	log 0 "Failed to get rate song ($rtn(code) $rtn(data))";
    }
    
}

proc control_player {cmd} {
    global state;

    log 0 "acquiring lock";
    set cookie [acquire_lock];
    log 0 "Writing $cmd";
    n_write "$cmd";
    log 0 "Wrote $cmd";
    n_getrtn rtn;
    log 0 "Got rtn";
    release_lock $cookie;
    log 0 "Lock freed";

#    log 0 "Control Got $rtn(code) $rtn(data)";
}

proc gui_top {} {
    global state;

    set cookie [acquire_lock];
    n_write "TOP"
    n_getrtn rtn;
    release_lock $cookie;

    set msg "List of songs most likely to be played next\n\n";
    
    foreach t $rtn(lines) {
	set tmp [split $t \011];
	append msg "[lindex $tmp 0]%\t[lindex $tmp 4] by [lindex $tmp 3]\n";
    }

    msg_box "Top Listing" $msg;
}

proc gui_updatesongs {} {
    global state songs;

    .top.tlist.list delete 0 end;

    set tmp "";

    foreach tag [array names songs "*:id"] {
	set a $songs($tag);
	lappend tmp [list $a $songs($a:name) $songs($a:author) $songs($a:albumname)];
    }

    switch -- $state(sortmode) {
	"Title" {
	    set idx 1;
	}

	"Artist" {
	    set idx 2;
	}

	"Album" {
	    set idx 3;
	}

	default {
	    set idx 1;
	}
    }
    set tmp [lsort -dictionary -index $idx $tmp];

    foreach a [array names songs *:listid:*] {
	unset songs($a);
    }

    set i 0;
    foreach a $tmp {
	.top.tlist.list insert end "'[lindex $a 1]' by '[lindex $a 2]' on '[lindex $a 3]'"
	set songs([lindex $a 0]:listid:$i) $a;
	incr i;
    }
}

proc gui_updatequeue {} {
    global state songs queue;

#    log 0 "Updating queue";

    .bot.queue.list delete 0 end;

    con_getqueue queue;

    foreach tag [lsort [array names queue]] {
	.bot.queue.list insert end "'$songs($queue($tag):name)' by '$songs($queue($tag):author)' on '$songs($queue($tag):albumname)'";
    }
}

proc gui_delqueue {id} {
    global queue;

    if {$id == ""} {
	return;
    }

    set cookie [acquire_lock];
    n_write "UNQUEUE [split $queue($id) {:}]";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 254} {
	log 0 "Failed to remove $id ($queue($id))";
	msg_box "Queue" "Failed to dequeue the song";
   }	
}

proc gui_updateinfo {} {
    global state;

    set cookie [acquire_lock];
    n_write "VOLUME";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 235} {
	set vol "??";
    } else {
	set vol "[lindex [lindex $rtn(lines) 0] 0]";
    }

    set cookie [acquire_lock];
    n_write "INFO";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) == 246} {
	set data [split [lindex $rtn(lines) 0] "\t"];
	set author [lindex $data 4];
	set title [lindex $data 5];
	set length [lindex $data 14];
	set album [lindex $data 3];
	set rate1 [lindex $data 9];
	set rate2 [lindex $data 10];
	set misc [lindex $data 15];
    } else {
	set author "N/A";
	set title "N/A";
	set length "N/A";
	set album "N/A";
	set rate1 "N/A";
	set rate2 "N/A";
	set misc "N/A";
	if {$rtn(code) != 401} {
	    log 0 "Failed to get track info ($rtn(code) $rtn(data))";
	}
    }

    set cookie [acquire_lock];
    n_write "STATUS";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 222} {
	set played "x:xx";
    } else {
	set played [lindex [split [lindex $rtn(lines) 0] "\t"] 8];
    }

    .top.tinfo.sub.author configure -text "Author: $author";
    .top.tinfo.sub.title configure -text "Title: $title";
    .top.tinfo.sub.length configure -text "Length: $length";
#    .top.tinfo.sub.time configure -text "Time: $played";
    .top.tinfo.sub.album configure -text "Album: $album";
    .top.tinfo.sub.misc configure -text "Misc: $misc";
    .top.tinfo.sub.rate1 configure -text "Rating: $rate1";
    .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2";
    .top.tinfo.sub.vol configure -text "Volume: $vol";
    
}

proc con_getqueue {queuevar} {
    upvar $queuevar queue;

    global state;

    catch {unset queue};

    set cookie [acquire_lock];
    n_write "QUEUE"
    n_getrtn rtn;
    release_lock $cookie;
    
    if {$rtn(code) == 225} {
	set i 0;
	foreach line $rtn(lines) {
	    set foo [split $line \011];
	    set id "[lindex $foo 1]:[lindex $foo 2]";

	    set queue($i) $id;
	    incr i;
	}
    } elseif {$rtn(code) == 404} {
#	log 0 "Queue empty";
    } else {
	log 0 "Failed to get queue ($rtn(code) $rtn(data))";
    }
}

proc con_getsongs {songsvar albumsvar} {
    upvar $songsvar songs;
    upvar $albumsvar albums;

    global state;

    catch { unset songs };

    foreach i [array names albums "*:"] {
	set cookie [acquire_lock];
	n_write "TRACKS $albums($i)";
	n_getrtn rtn;
	release_lock $cookie;

	if {$rtn(code) != "228"} {
	    error "Got bogus response to track request ($rtn(code) $rtn(data))";
	}

	foreach trk $rtn(lines) {
	    set foo [split $trk \011];
	    if {[llength $foo] != 6} {
		continue;
	    }

	    set albid [lindex $foo 0];
	    set num [lindex $foo 1]
	    set songs($albid:$num:id) "$albid:$num";
	    set songs($albid:$num:author) [lindex $foo 2];
	    set songs($albid:$num:name) [lindex $foo 3];
	    set songs($albid:$num:rating) [lindex $foo 4];
	    set songs($albid:$num:length) [lindex $foo 5];
	    set songs($albid:$num:albumname) $albums($albid:name);
	}
    }
}

proc con_getalbums {albumsvar} {
    upvar $albumsvar albums;

    global state;

    catch {unset albums};
    
    set cookie [acquire_lock];
    n_write "ALBUMS";
    n_getrtn rtn;
    release_lock $cookie;

    if {$rtn(code) != 227} {
	error "Server gave bogus response to album request ($rtn(code) $rtn(data))";
    }

    foreach alb $rtn(lines) {
	set foo [split $alb \011];
	set id [lindex $foo 0];
	if {$id == ""} {
	    continue;
	}
	set albums($id:) $id;
	set albums($id:author) [lindex $foo 1];
	set albums($id:name) [lindex $foo 2];

#	log 0 "Album $id, ID '$albums($id:)' called '$albums($id:name)' by '$albums($id:author)'";
    }
}

proc update_timer {} {

#    gui_updateinfo;

    after 900 update_timer;
}

proc con_mserv {} {
    global state;

    # Close old FD
    catch {close state(serv_fd)};
    catch {unset state(serv_fd)};

    catch {fileevent $state(serv_fd) readable ""};
    set state(serv_fd) [ socket $state(host) $state(port) ];
    set state(pushbuf) "";
    fileevent $state(serv_fd) readable n_rtinput;
    fconfigure $state(serv_fd) -blocking 0;

    # Greeting from server
    n_getrtn rtn;
    log 0 "$rtn(data)";
    if {$rtn(code) != "200"} {
	error "Server failed to send greeting";
    }
    
    # Login
    n_write "USER $state(user)"
    n_getrtn rtn;
    if {$rtn(code) != "201"} {
	error "Server failed to send password request";
    }

    n_write "PASS $state(pass) RTCOMPUTER";
    n_getrtn rtn;
    if {$rtn(code) == "507"} {
	error "Server rejected our credentials";
    }

    if {$rtn(code) != "202"} {
	error "Unknown response to PASS command - $rtn(code) $rtn(data)"
    }	

    set state(lock) "";
#    trace variable state(lock) rw foobar;

    log 0 "Logged in";
}

proc n_write {text} {
    global state;

    puts $state(serv_fd) $text;
    flush $state(serv_fd);

    if {[eof $state(serv_fd)]} {
	log 0 "Server went away on write";
	exit 1;
    }
#    log 0 "Wrote - $text";
}

proc n_rthandler {code data} {
    global songs;

#    log 0 "Got RT - $code $data";

    switch -- $code {
	600 {
	    log 0 "User '$data' connected";
	}
	
	601 {
	    log 0 "User '$data' disconnected";
	}

	240 -
	602 -
	615 -
	618 -
	619 -
	620 -
	622 -
	623 -
	627 -
	628 -
	629 {
#	    log 0 "Updating queue on idle";
	    gui_updateinfo;
	    gui_updatequeue;
	}

	default {
	    log 0 "Got unhandled RT event $code $data";
	}
    }
}

proc n_rtinput {} {
    global state;

    set rth "";

    while {1} {
	set line [gets $state(serv_fd)];
	if {[eof $state(serv_fd)]} {
	    log 0 "Server went away on read";
	    exit 1;
	}
	log 0 "Read - $line";
	if {$line == ""} {
	    return;
	}
	# Check for RT text
	set foo [split $line "\t"];
	if {[string index $line 0] == "="} {
	    lappend state(rtlist) [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
	    log 0 "RT event";
	} else {
	    lappend state(tmpphrase) $line
	    if {$line == "."} {
		set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
		log 0 "push buffer - '$state(tmpphrase)'";
		set state(tmpphrase) "";
	    }
	}
    } 
}

proc n_getrtn {var} {
    upvar $var rtn;
    global state;

    set gotcode 0;
    catch {unset rtn(code)};
    catch {unset rtn(data)};
    catch {unset rtn(lines)}

    while {[llength $state(pushbuf)] == 0} {
	log 0 "Sleeping for data";
	vwait state(pushbuf);
    }

    log 0 "Waking up, got $state(pushbuf)";

    set buf [lindex $state(pushbuf) 0];
    set state(pushbuf) [lrange $state(pushbuf) 1 end];
    
    while {1} {
	if {[llength $buf] == 0} {
	    break;
	}

	set line [lindex $buf 0];
	set buf [lrange $buf 1 end];
	
	if {[string index $line 0] == "."} {
	    break;
	}

	if {$gotcode == 0} {
	    set rtn(code) [string range $line 0 2];
	    set rtn(data) [string range $line 4 end];
	    set gotcode 1;
	    continue;
	}
	    
	lappend rtn(lines) $line;
    }

    if {$gotcode == 0} {
	log 0 "Failed to parse phrase (got . before server response)";
    }
}

##################################################################
# Log a message to stderr
#
proc log {level message} {
    global state;

    # Extract the calling function's name
    if {[catch {set fname [lindex [info level -1] 0]}]} {
	set fname "unknown";
    }

    if {$state(loglevel) > $level} {
	# Emit the message
	catch {
	    puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $message";
	    flush stderr;
	}
    }
}

proc acquire_lock {} {
    global state;

    # Extract the calling function's name
    if {[catch {set fname [lindex [info level -1] 0]}]} {
	set fname "unknown";
    }

    log 0 "Acquiring lock for $fname";

    set foo 0;

    if {[info exists state(lock)]} {
	while {$state(lock) != ""} {
	    set foo 1;
	    log 0 "$fname waiting for lock (held by [lindex $state(lock) 1])";
	    vwait state(lock);
	}

	if {$foo == 1} {
	    log 0 "Lock released";
	}

    }

    set cookie [clock clicks];
    set state(lock) [list $cookie $fname];
    log 0 "Lock acquired";
    return $cookie;
}

proc release_lock {cookie} {
    global state;

    # Extract the calling function's name
    if {[catch {set fname [lindex [info level -1] 0]}]} {
	set fname "unknown";
    }

    if {$cookie == ""} {
	log 0 "$fname trying to unlock without being locked";
	exit 1;
    }

    if {$cookie != [lindex $state(lock) 0]} {
	log 0 "Lock cookie not matched!";
	exit 1;
    }

    if {$fname != [lindex $state(lock) 1]} {
	log 0 "$fname tried to free [lindex $state(lock) 1]'s lock!";
	exit 1;
    }

    set state(lock) "";
    log 0 "Lock for $fname now free";
}

proc foobar {n1 n2 op} {
    global state;

    log 0 "$op, now $state(lock)";
}

if {[catch {main} msg]} {
    catch {tk_dialog .dummy "Error!" [format "%s\n%s" $msg $errorInfo] error 0 "OK"};
    exit 1;
}