Mercurial > ~darius > hgwebdir.cgi > mservtk
diff mservtk.tcl @ 1:c36994199c5e MSERVTK_0_1
Initial revision
author | darius |
---|---|
date | Wed, 03 May 2000 12:20:47 +0000 |
parents | |
children | 4343bc7f829a |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/mservtk.tcl Wed May 03 12:20:47 2000 +0000 @@ -0,0 +1,730 @@ +#!/usr/bin/env wish8.0 + +# +# 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; + + set state(exit) 0; + set state(host) "lot"; + set state(port) "4444"; + set state(user) "Darius"; + set state(pass) "Fnordish"; + set state(sortmode) "Title"; + set state(tmpphrase) ""; + + gui_build; + + con_mserv; + + con_getalbums albums; + con_getsongs songs albums; + + gui_updatesongs; + gui_updatequeue; + + update_timer; + + while {1} { + vwait state(exit); + + if {$state(exit) == 1} { + exit; + } + } +} + +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 " 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"; + + 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 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 <Double-Button-1> { + queue_song [.top.tlist.list curselection]; + } + + # 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.trackno -text "Misc:"; + pack .top.tinfo.sub.trackno -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 "%s" "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)"; + + n_write "QUEUE [split $tmp {:}]"; + n_getrtn rtn; + + if {$rtn(code) != 247} { + if {$rtn(code) == 510} { + msg_box "Queue" "You can't have the same\nsong in the queue twice!"; + } else { + log "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 -height 10 -width 40 -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; + + n_write "VOLUME $vol" + n_getrtn rtn; + + if {$rtn(code) != 255} { + log "%s" "Couldn't set volume ($rtn(code) $rtn(data))"; + } +} + +proc rate_song {rate} { + global state; + + n_write "RATE $rate"; + n_getrtn rtn; + + if {$rtn(code) != 270} { + log "%s" "Failed to get rate song ($rtn(code) $rtn(data))"; + } + +} + +proc control_player {cmd} { + global state; + + n_write "$cmd"; + n_getrtn rtn; + + log "%s" "Control Got $rtn(code) $rtn(data)"; +} + +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; + + if {[info exists state(queuelock)]} { + return; + } + + set state(queuelock) ""; + + log "%s" "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)'"; + } + + unset state(queuelock); +} + +proc gui_delqueue {id} { + global queue; + + if {$id == ""} { + return; + } + + n_write "UNQUEUE [split $queue($id) {:}]"; + n_getrtn rtn; + + if {$rtn(code) != 254} { + log "%s" "Failed to remove $id ($queue($id))"; + msg_box "Queue" "Failed to dequeue the song"; + } +} + +proc gui_updateinfo {} { + global state; + + n_write "VOLUME"; + n_getrtn rtn; + + if {$rtn(code) != 235} { + set vol "??"; + } else { + set vol "[lindex [lindex $rtn(lines) 0] 0]"; + } + + n_write "INFO"; + n_getrtn rtn; + + 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 tnum [lindex $data 15]; + } else { + set author "N/A"; + set title "N/A"; + set length "N/A"; + set album "N/A"; + set tnum "N/A"; + if {$rtn(code) != 401} { + log "%s" "Failed to get track info ($rtn(code) $rtn(data))"; + } + } + + + + n_write "STATUS"; + n_getrtn rtn; + + if {$rtn(code) != 222} { + set left "x:xx"; + set played "x:xx"; + } else { + set played [lindex [split [lindex $rtn(lines) 0] "\t"] 8]; + +# scan $played "%d:%d" played_m played_s; +# set played [expr ($played_m * 60) + $played_s]; +# scan $length "%d:%f" len_m len_s; +# set len [expr ($len_m * 60) + $len_s]; + +# set left [expr $len - $played]; +# set left_m [expr int($left / 60)]; +# set left [format "%02d:%02d" $left_m [expr int($left - ($left_m * 60))]]; + } + + .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.trackno configure -text "Misc: $tnum"; + .top.tinfo.sub.vol configure -text "Volume: $vol"; +} + +proc con_getqueue {queuevar} { + upvar $queuevar queue; + + global state; + + catch {unset queue}; + + n_write "QUEUE" + n_getrtn rtn; + + 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 "%s" "Queue empty"; + } else { + log "%s" "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 "*:"] { + n_write "TRACKS $albums($i)"; + n_getrtn rtn; + 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}; + + n_write "ALBUMS"; + n_getrtn rtn; + 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]; + set albums($id:) [lindex $foo 0]; + set albums($id:author) [lindex $foo 1]; + set albums($id:name) [lindex $foo 2]; + +# log "%s" "Album $i, ID $albums($i:id) called $albums($i:name) by $albums($i: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; + puts $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)" + } + + log "%s" "Logged in"; +} + +proc n_write {text} { + global state; + + puts $state(serv_fd) $text; +# log "%s" "Wrote - $text"; + + flush $state(serv_fd); +} + +proc n_rthandler {code data} { + global songs; + + log "%s" "Got RT - $code $data"; + + switch -- $code { + 600 { + log "%s" "User '$data' connected"; + } + + 601 { + log "%s" "User '$data' disconnected"; + } + + 618 - + 619 - + 622 - + 627 - + 623 { + after idle gui_updatequeue; + } + } +} + +proc n_rtinput {} { + global state; + + set rth ""; + + set line [gets $state(serv_fd)]; +# log "%s" "Read - $line"; + + # Check for RT text + set foo [split $line "\t"]; + if {[string index $line 0] == "="} { + set rth [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]]; + } else { + lappend state(tmpphrase) $line + if {$line == "."} { + set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)]; + set state(tmpphrase) ""; + } + } + + if {$rth != ""} { + n_rthandler [lindex $rth 0] [lindex $rth 1]; + } +} + +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} { + vwait 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 "%s" "Failed to parse phrase (got . before server responce)"; + } +} + +################################################################## +# Log a message to stderr +# +proc log {format args} { + # Extract the calling function's name + set fname [lindex [info level -1] 0]; + + # Evaluate the supplied format string and arguments + if {[catch {set csm [eval format {$format} $args]} msg]} { + set csm "bad log message. format='$format' args='$args'"; + } + + # Emit the message + puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm"; + flush stderr; +} + +main;