|
1
|
1 #!/usr/bin/env wish8.0
|
|
|
2
|
|
|
3 #
|
|
|
4 # This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
|
|
|
5 #
|
|
|
6 # Redistribution and use in source and binary forms, with or without
|
|
|
7 # modification, are permitted provided that the following conditions
|
|
|
8 # are met:
|
|
|
9 # 1. Redistributions of source code must retain the above copyright
|
|
|
10 # notice, this list of conditions and the following disclaimer.
|
|
|
11 # 2. Redistributions in binary form must reproduce the above copyright
|
|
|
12 # notice, this list of conditions and the following disclaimer in the
|
|
|
13 # documentation and/or other materials provided with the distribution.
|
|
|
14 # 3. Neither the name Daniel O'Connor nor the names of its contributors
|
|
|
15 # may be used to endorse or promote products derived from this software
|
|
|
16 # without specific prior written permission.
|
|
|
17 #
|
|
|
18 # THIS SOFTWARE IS PROVIDED BY DANIEL O'CONNOR AND CONTRIBUTORS ``AS IS'' AND
|
|
|
19 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
|
|
20 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
|
|
21 # ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
|
|
|
22 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
|
|
23 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
|
|
24 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
|
|
25 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
|
|
|
26 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
|
|
|
27 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
|
|
|
28 # SUCH DAMAGE.
|
|
|
29 #
|
|
|
30
|
|
|
31 proc main {} {
|
|
3
|
32 global argv0 argv state albums songs tcl_platform;
|
|
1
|
33
|
|
3
|
34 if {[string first "Windows" $tcl_platform(os)] == -1} {
|
|
|
35 set state(conffile) "~/.mservtk";
|
|
|
36 set state(windows) 0;
|
|
|
37 } else {
|
|
|
38 package require registry 1.0;
|
|
|
39 set state(windows) 1;
|
|
|
40 }
|
|
|
41
|
|
1
|
42 set state(port) "4444";
|
|
3
|
43 set state(exit) 0;
|
|
1
|
44 set state(tmpphrase) "";
|
|
3
|
45 set state(sortmode) "Title";
|
|
1
|
46
|
|
3
|
47 wm withdraw .;
|
|
|
48
|
|
|
49 f_readconf;
|
|
|
50 gui_conf;
|
|
1
|
51
|
|
3
|
52 if {$state(host) == "NONE"} {
|
|
|
53 log "%s" "Login cancelled";
|
|
|
54 exit;
|
|
|
55 } else {
|
|
|
56 log "%s" "Login OK'd";
|
|
|
57 }
|
|
|
58
|
|
|
59 f_writeconf;
|
|
|
60
|
|
|
61 wm deiconify .;
|
|
1
|
62 con_mserv;
|
|
|
63
|
|
|
64 con_getalbums albums;
|
|
|
65 con_getsongs songs albums;
|
|
|
66
|
|
3
|
67 gui_build;
|
|
|
68 focus -force .;
|
|
|
69
|
|
1
|
70 gui_updatesongs;
|
|
|
71 gui_updatequeue;
|
|
|
72
|
|
|
73 update_timer;
|
|
|
74
|
|
|
75 while {1} {
|
|
|
76 vwait state(exit);
|
|
|
77
|
|
|
78 if {$state(exit) == 1} {
|
|
|
79 exit;
|
|
|
80 }
|
|
|
81 }
|
|
|
82 }
|
|
|
83
|
|
3
|
84 proc f_readconf {} {
|
|
|
85 global state;
|
|
|
86
|
|
|
87 set state(host) "NONE";
|
|
|
88 set state(user) "NONE";
|
|
|
89 set state(pass) "";
|
|
|
90
|
|
|
91 if {$state(windows) == 1} {
|
|
|
92 if {[catch {
|
|
|
93 set state(host) [registry get {HKEY_CURRENT_USER\Software\MServTk} host];
|
|
|
94 set state(user) [registry get {HKEY_CURRENT_USER\Software\MServTk} user];
|
|
|
95 set state(pass) [registry get {HKEY_CURRENT_USER\Software\MServTk} pass];
|
|
|
96 } msg]} {
|
|
|
97 log "%s" "Failed to read registry keys - $msg";
|
|
|
98 }
|
|
|
99 } else {
|
|
|
100 if {![catch {
|
|
|
101 set fh [open $state(conffile)];
|
|
|
102 } msg]} {
|
|
|
103 if {[gets $fh] != "mservtk-0.1"} {
|
|
|
104 log "%s" "Conf file has the wrong version";
|
|
|
105 } else {
|
|
|
106 set state(host) [gets $fh];
|
|
|
107 set state(user) [gets $fh];
|
|
|
108 set state(pass) [gets $fh];
|
|
|
109 close $fh;
|
|
|
110 }
|
|
|
111 } else {
|
|
|
112 log "%s" "Failed to open $state(conffile) - $msg";
|
|
|
113 }
|
|
|
114 }
|
|
|
115 }
|
|
|
116
|
|
|
117 proc f_writeconf {} {
|
|
|
118 global state;
|
|
|
119
|
|
|
120 if {$state(windows) == 1} {
|
|
|
121 if {[catch {
|
|
|
122 registry set {HKEY_CURRENT_USER\Software\MServTk} host $state(host);
|
|
|
123 registry set {HKEY_CURRENT_USER\Software\MServTk} user $state(user);
|
|
|
124 registry set {HKEY_CURRENT_USER\Software\MServTk} pass $state(pass);
|
|
|
125 } msg]} {
|
|
|
126 log "%s" "Failed to set registry keys - $msg";
|
|
|
127 }
|
|
|
128 } else {
|
|
|
129 if {![catch {
|
|
|
130 set fh [open $state(conffile) w];
|
|
|
131 } msg]} {
|
|
|
132 puts $fh "mservtk-0.1";
|
|
|
133 puts $fh $state(host);
|
|
|
134 puts $fh $state(user);
|
|
|
135 puts $fh $state(pass);
|
|
|
136
|
|
|
137 close $fh;
|
|
|
138 } else {
|
|
|
139 log "%s" "Failed to open $state(conffile) - $msg";
|
|
|
140 }
|
|
|
141 }
|
|
|
142 }
|
|
|
143
|
|
|
144 proc gui_conf {} {
|
|
|
145 global state;
|
|
|
146
|
|
|
147 catch {destroy .conf};
|
|
|
148
|
|
|
149 toplevel .conf -class Dialog;
|
|
|
150 wm title .conf "Authentication";
|
|
|
151 wm iconname .conf "Authentication";
|
|
|
152
|
|
|
153 frame .conf.host;
|
|
|
154 pack .conf.host -side top -pady 2m -fill x;
|
|
|
155 label .conf.host.label -text "Host:" -width 10 -anchor e;
|
|
|
156
|
|
|
157 entry .conf.host.entry -relief sunken -width 30 -textvariable state(host)
|
|
|
158 pack .conf.host.label .conf.host.entry -side left -padx 1m
|
|
|
159
|
|
|
160 frame .conf.user
|
|
|
161 pack .conf.user -side top -pady 2m -fill x
|
|
|
162 label .conf.user.label -text "User:" -width 10 -anchor e
|
|
|
163 entry .conf.user.entry -relief sunken -width 8 -textvariable state(user)
|
|
|
164 pack .conf.user.label .conf.user.entry -side left -padx 1m
|
|
|
165
|
|
|
166 frame .conf.password
|
|
|
167 pack .conf.password -side top -pady 2m -fill x
|
|
|
168 label .conf.password.label -text "Password:" -width 10 -anchor e
|
|
|
169 entry .conf.password.entry -relief sunken -width 8 -textvariable state(pass) -show *;
|
|
|
170 bind .conf.password.entry <Return> ".conf.buttons.ok invoke";
|
|
|
171 pack .conf.password.label .conf.password.entry -side left -padx 1m
|
|
|
172
|
|
|
173 frame .conf.buttons
|
|
|
174 pack .conf.buttons -side top -pady 1m -fill x
|
|
|
175 button .conf.buttons.ok -text OK -width 6 -command {
|
|
|
176 destroy .conf;
|
|
|
177 }
|
|
|
178 button .conf.buttons.cancel -text Cancel -width 6 -command {
|
|
|
179 set state(host) "NONE";
|
|
|
180 set state(user) "NONE";
|
|
|
181 set state(pass) "NONE";
|
|
|
182 destroy .conf;
|
|
|
183 }
|
|
|
184 pack .conf.buttons.ok -side left -padx 1m;
|
|
|
185 pack .conf.buttons.cancel -side right -padx 1m;
|
|
|
186
|
|
|
187
|
|
|
188 # Withdraw the window, then update all the geometry information
|
|
|
189 # so we know how big it wants to be, then center the window in the
|
|
|
190 # display and de-iconify it.
|
|
|
191
|
|
|
192 wm withdraw .conf
|
|
|
193 update idletasks
|
|
|
194 set x [expr [winfo screenwidth .conf]/2 - [winfo reqwidth .conf]/2 \
|
|
|
195 - [winfo vrootx [winfo parent .conf]]]
|
|
|
196 set y [expr [winfo screenheight .conf]/2 - [winfo reqheight .conf]/2 \
|
|
|
197 - [winfo vrooty [winfo parent .conf]]]
|
|
|
198 wm geom .conf +$x+$y
|
|
|
199 wm deiconify .conf
|
|
|
200
|
|
|
201 # Set a grab and claim the focus too.
|
|
|
202
|
|
|
203 set oldFocus [focus]
|
|
|
204 set oldGrab [grab current .conf]
|
|
|
205 if {$oldGrab != ""} {
|
|
|
206 set grabStatus [grab status $oldGrab]
|
|
|
207 }
|
|
|
208 grab .conf
|
|
|
209 tkwait visibility .conf
|
|
|
210 if {$state(host) == "NONE"} {
|
|
|
211 focus .conf.host.entry;
|
|
|
212 } else {
|
|
|
213 focus .conf.password.entry;
|
|
|
214 }
|
|
|
215 tkwait window .conf;
|
|
|
216 if {$oldGrab != ""} {
|
|
|
217 if {$grabStatus == "global"} {
|
|
|
218 grab -global $oldGrab
|
|
|
219 } else {
|
|
|
220 grab $oldGrab
|
|
|
221 }
|
|
|
222 }
|
|
|
223
|
|
|
224 log "%s" "Host $state(host)";
|
|
|
225 }
|
|
|
226
|
|
1
|
227 proc quit_now {} {
|
|
|
228 global state;
|
|
|
229
|
|
|
230 set state(exit) 1;
|
|
|
231 }
|
|
|
232
|
|
|
233 proc gui_build {} {
|
|
|
234 # create the toplevel
|
|
|
235 eval destroy [winfo child .];
|
|
|
236 wm title . "MServ-Tk";
|
|
|
237 wm minsize . 600 500;
|
|
|
238 wm geometry . 600x500;
|
|
|
239
|
|
|
240 # Let's have a menubar
|
|
|
241 frame .menubar -relief raised -bd 2;
|
|
|
242 pack .menubar -side top -fill x;
|
|
|
243
|
|
|
244 # Add the File menu
|
|
|
245 menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
|
|
|
246 menu .menubar.file.m -tearoff 0;
|
|
3
|
247 .menubar.file.m add command -label " Top" -command "gui_top"
|
|
|
248 .menubar.file.m add separator;
|
|
1
|
249 .menubar.file.m add command -label " Quit" -command "quit_now" \
|
|
|
250 -underline 2 -accelerator "Alt-q";
|
|
|
251 pack .menubar.file -side left;
|
|
|
252
|
|
|
253 # Add the Rate menu
|
|
|
254 menubutton .menubar.rate -text "Rate" -menu .menubar.rate.m -underline 0;
|
|
|
255 menu .menubar.rate.m -tearoff 0;
|
|
|
256 .menubar.rate.m add command -label " Superb" -command "rate_song SUPERB";
|
|
|
257 .menubar.rate.m add command -label " Good" -command "rate_song GOOD";
|
|
|
258 .menubar.rate.m add command -label " Neutral" -command "rate_song NEUTRAL";
|
|
|
259 .menubar.rate.m add command -label " Bad" -command "rate_song BAD";
|
|
|
260 .menubar.rate.m add command -label " Awful" -command "rate_song AWFUL";
|
|
|
261
|
|
|
262 pack .menubar.rate -side left;
|
|
|
263
|
|
|
264 # Add the Control menu
|
|
|
265 menubutton .menubar.control -text "Control" -menu .menubar.control.m -underline 0;
|
|
|
266 menu .menubar.control.m -tearoff 0;
|
|
|
267 .menubar.control.m add command -label " Next" -command "control_player NEXT";
|
|
|
268 .menubar.control.m add command -label " Pause" -command "control_player PAUSE";
|
|
|
269 .menubar.control.m add command -label " Stop" -command "control_player STOP"
|
|
|
270 .menubar.control.m add command -label " Play" -command "control_player PLAY";
|
|
|
271
|
|
|
272 pack .menubar.control -side left;
|
|
|
273
|
|
|
274 # Add the Volume menu
|
|
|
275 menubutton .menubar.vol -text "Volume" -menu .menubar.vol.m -underline 0;
|
|
|
276 menu .menubar.vol.m -tearoff 0;
|
|
|
277 .menubar.vol.m add command -label " Increase" -command "set_vol +3" \
|
|
|
278 -accelerator "+";
|
|
|
279 .menubar.vol.m add command -label " Decrease" -command "set_vol -3" \
|
|
|
280 -accelerator "-";
|
|
|
281 .menubar.vol.m add separator;
|
|
|
282 .menubar.vol.m add command -label " 100%" -command "set_vol 100";
|
|
|
283 .menubar.vol.m add command -label " 90%" -command "set_vol 90";
|
|
|
284 .menubar.vol.m add command -label " 80%" -command "set_vol 80";
|
|
|
285 .menubar.vol.m add command -label " 70%" -command "set_vol 70";
|
|
|
286 .menubar.vol.m add command -label " 60%" -command "set_vol 60";
|
|
|
287 .menubar.vol.m add command -label " 50%" -command "set_vol 50";
|
|
|
288 .menubar.vol.m add command -label " 40%" -command "set_vol 40";
|
|
|
289 .menubar.vol.m add command -label " 30%" -command "set_vol 30";
|
|
|
290 .menubar.vol.m add command -label " 20%" -command "set_vol 20";
|
|
|
291 .menubar.vol.m add command -label " 10%" -command "set_vol 10";
|
|
|
292 .menubar.vol.m add command -label " 0%" -command "set_vol 0";
|
|
|
293
|
|
|
294 pack .menubar.vol -side left;
|
|
|
295
|
|
|
296 # Add the Sort menu
|
|
|
297 menubutton .menubar.sort -text "Sort" -menu .menubar.sort.m -underline 0;
|
|
|
298 menu .menubar.sort.m -tearoff 0;
|
|
|
299 .menubar.sort.m add command -label " Artist" \
|
|
|
300 -command "global state; set state(sortmode) Artist; gui_updatesongs";
|
|
|
301 .menubar.sort.m add command -label " Title" \
|
|
|
302 -command "global state; set state(sortmode) Title; gui_updatesongs";
|
|
|
303 .menubar.sort.m add command -label " Album" \
|
|
|
304 -command "global state; set state(sortmode) Album; gui_updatesongs";
|
|
|
305
|
|
|
306 pack .menubar.sort -side left;
|
|
|
307
|
|
|
308 # Add the Help menu
|
|
|
309 menubutton .menubar.help -text "Help" -menu .menubar.help.m -underline 0;
|
|
|
310 menu .menubar.help.m -tearoff 0;
|
|
|
311 .menubar.help.m add command -label " About" -command "about_box" \
|
|
|
312 -underline 2;
|
|
|
313 pack .menubar.help -side right;
|
|
|
314
|
|
|
315 # Top frame holding tracklist and trackinfo frames
|
|
|
316 frame .top -relief raised -bd 1;
|
|
|
317 pack .top -fill both -expand 1;
|
|
|
318
|
|
|
319 # Tracklist
|
|
|
320 frame .top.tlist -relief raised -bd 1;
|
|
|
321 pack .top.tlist -side left -fill both -expand 1;
|
|
|
322 label .top.tlist.label -text "Track List";
|
|
|
323 pack .top.tlist.label -side top -expand 0;
|
|
|
324 listbox .top.tlist.list -relief raised -borderwidth 2 \
|
|
|
325 -yscrollcommand ".top.tlist.scr set";
|
|
|
326 pack .top.tlist.list -side left -fill both -expand 1;
|
|
|
327 scrollbar .top.tlist.scr -command ".top.tlist.list yview";
|
|
|
328 pack .top.tlist.scr -side right -fill y;
|
|
|
329 bind .top.tlist.list <Double-Button-1> {
|
|
|
330 queue_song [.top.tlist.list curselection];
|
|
|
331 }
|
|
|
332
|
|
|
333 # Trackinfo
|
|
|
334 frame .top.tinfo -relief raised -bd 1;
|
|
|
335 pack .top.tinfo -side right -fill both -expand 0;
|
|
|
336 label .top.tinfo.label -text "Track Info";
|
|
|
337 pack .top.tinfo.label -side top -expand 0;
|
|
|
338 frame .top.tinfo.sub -relief raised -bd 1;
|
|
|
339 pack .top.tinfo.sub -side right -fill both -expand 0;
|
|
|
340 label .top.tinfo.sub.author -text "Author:";
|
|
|
341 pack .top.tinfo.sub.author -side top -expand 0;
|
|
|
342 label .top.tinfo.sub.title -text "Title:";
|
|
|
343 pack .top.tinfo.sub.title -side top -expand 0;
|
|
|
344 label .top.tinfo.sub.length -text "Length:";
|
|
|
345 pack .top.tinfo.sub.length -side top -expand 0;
|
|
|
346 label .top.tinfo.sub.time -text "Time:";
|
|
|
347 pack .top.tinfo.sub.time -side top -expand 0;
|
|
|
348 label .top.tinfo.sub.album -text "Album:";
|
|
|
349 pack .top.tinfo.sub.album -side top -expand 0;
|
|
3
|
350 label .top.tinfo.sub.misc -text "Misc:";
|
|
|
351 pack .top.tinfo.sub.misc -side top -expand 0;
|
|
|
352 label .top.tinfo.sub.rate1 -text "Rating:";
|
|
|
353 pack .top.tinfo.sub.rate1 -side top -expand 0;
|
|
|
354 label .top.tinfo.sub.rate2 -text "Temporally Adjusted:";
|
|
|
355 pack .top.tinfo.sub.rate2 -side top -expand 0;
|
|
1
|
356 label .top.tinfo.sub.vol -text "Volume:";
|
|
|
357 pack .top.tinfo.sub.vol -side top -expand 0;
|
|
|
358
|
|
|
359 # Queue (and the frame holding it)
|
|
|
360 frame .bot -relief raised -bd 1;
|
|
|
361 pack .bot -fill both -expand 1;
|
|
|
362 label .bot.qlabel -text "Queue";
|
|
|
363 pack .bot.qlabel -side top -expand 0;
|
|
|
364 frame .bot.queue;
|
|
|
365 pack .bot.queue -fill both -expand 1;
|
|
|
366 listbox .bot.queue.list -relief raised -borderwidth 2 \
|
|
|
367 -yscrollcommand ".bot.queue.scr set";
|
|
|
368 pack .bot.queue.list -side left -fill both -expand 1;
|
|
|
369 scrollbar .bot.queue.scr -command ".bot.queue.list yview";
|
|
|
370 pack .bot.queue.scr -side right -fill y;
|
|
|
371 bind .bot.queue.list <Double-Button-1> {
|
|
|
372 gui_delqueue [.bot.queue.list curselection];
|
|
|
373 }
|
|
|
374
|
|
|
375 bind . <Destroy> {quit_now};
|
|
|
376 bind all <Alt-q> {quit_now};
|
|
|
377
|
|
|
378 bind all <KP_Add> {set_vol +3};
|
|
|
379 bind all <KP_Subtract> {set_vol -3};
|
|
|
380 bind all <plus> {set_vol +3};
|
|
|
381 bind all <equal> {set_vol +3};
|
|
|
382 bind all <minus> {set_vol -3};
|
|
|
383 bind all <F1> {set_vol 10};
|
|
|
384 bind all <F2> {set_vol 20};
|
|
|
385 bind all <F3> {set_vol 30};
|
|
|
386 bind all <F4> {set_vol 40};
|
|
|
387 bind all <F5> {set_vol 50};
|
|
|
388 bind all <F6> {set_vol 60};
|
|
|
389 bind all <F7> {set_vol 70};
|
|
|
390 bind all <F8> {set_vol 80};
|
|
|
391 bind all <F9> {set_vol 90};
|
|
|
392 bind all <F10> {set_vol 100};
|
|
|
393
|
|
|
394 bind all <Pause> {control_player PAUSE};
|
|
|
395 bind all <End> {control_player NEXT};
|
|
|
396 bind all <Delete> {control_player STOP};
|
|
|
397 bind all <Home> {control_player PLAY};
|
|
|
398
|
|
|
399 update;
|
|
|
400 }
|
|
|
401
|
|
|
402 proc queue_song {id} {
|
|
|
403 global songs state;
|
|
|
404
|
|
|
405 set tmp [lindex [lindex [array get songs *:listid:$id] 1] 0];
|
|
|
406 log "%s" "Queue - '$songs($tmp:name)' by '$songs($tmp:author)' ($tmp)";
|
|
|
407
|
|
|
408 n_write "QUEUE [split $tmp {:}]";
|
|
|
409 n_getrtn rtn;
|
|
|
410
|
|
|
411 if {$rtn(code) != 247} {
|
|
|
412 if {$rtn(code) == 510} {
|
|
|
413 msg_box "Queue" "You can't have the same\nsong in the queue twice!";
|
|
|
414 } else {
|
|
|
415 log "Failed to queue track ($rtn(code) $rtn(data))";
|
|
|
416 }
|
|
|
417 }
|
|
|
418 }
|
|
|
419
|
|
|
420 proc msg_box {title msg} {
|
|
|
421 global state;
|
|
|
422
|
|
|
423 catch {destroy .msg};
|
|
|
424
|
|
|
425 toplevel .msg -class Dialog;
|
|
|
426 wm title .msg $title;
|
|
|
427 wm iconname .msg $title;
|
|
|
428
|
|
|
429 # text region
|
|
|
430 frame .msg.frame;
|
|
|
431 pack .msg.frame -side top -fill both -expand yes;
|
|
3
|
432 text .msg.frame.text -font fixed -yscroll ".msg.frame.scroll set" -wrap none;
|
|
1
|
433 scrollbar .msg.frame.scroll -command ".msg.frame.text yview";
|
|
|
434 pack .msg.frame.text -side left -expand y -fill both;
|
|
|
435 pack .msg.frame.scroll -side right -fill y;
|
|
|
436
|
|
|
437 # close button
|
|
|
438 button .msg.close -text "Close" -command "destroy .msg";
|
|
|
439 pack .msg.close -side bottom -fill x;
|
|
|
440
|
|
|
441 # read text into the text widget
|
|
|
442 .msg.frame.text insert end $msg;
|
|
|
443 }
|
|
|
444
|
|
|
445 proc about_box {} {
|
|
|
446 global state;
|
|
|
447
|
|
|
448 catch {destroy .about};
|
|
|
449
|
|
|
450 toplevel .about -class Dialog;
|
|
|
451 wm title .about "About...";
|
|
|
452 wm iconname .about "About";
|
|
|
453
|
|
|
454 # text region
|
|
|
455 frame .about.frame;
|
|
|
456 pack .about.frame -side top -fill both -expand yes;
|
|
|
457 text .about.frame.text -font fixed -height 10 -width 40 -yscroll ".about.frame.scroll set" \
|
|
|
458 -wrap none;
|
|
|
459 scrollbar .about.frame.scroll -command ".about.frame.text yview";
|
|
|
460 pack .about.frame.text -side left -expand y;
|
|
|
461 pack .about.frame.scroll -side right -fill y;
|
|
|
462
|
|
|
463 # close button
|
|
|
464 button .about.close -text "Close" -command "destroy .about";
|
|
|
465 pack .about.close -side bottom -fill x;
|
|
|
466
|
|
|
467 # read text into the text widget
|
|
|
468 .about.frame.text insert end "Mserv Client\n";
|
|
|
469 .about.frame.text insert end "Copyright Daniel O'Connor 2000\n";
|
|
|
470 .about.frame.text insert end "\n";
|
|
|
471 .about.frame.text insert end "http://www.dons.net.au/~darius/\n";
|
|
|
472 }
|
|
|
473
|
|
|
474 proc set_vol {vol} {
|
|
|
475 global state;
|
|
|
476
|
|
|
477 n_write "VOLUME $vol"
|
|
|
478 n_getrtn rtn;
|
|
|
479
|
|
|
480 if {$rtn(code) != 255} {
|
|
|
481 log "%s" "Couldn't set volume ($rtn(code) $rtn(data))";
|
|
|
482 }
|
|
|
483 }
|
|
|
484
|
|
|
485 proc rate_song {rate} {
|
|
|
486 global state;
|
|
|
487
|
|
|
488 n_write "RATE $rate";
|
|
|
489 n_getrtn rtn;
|
|
|
490
|
|
|
491 if {$rtn(code) != 270} {
|
|
|
492 log "%s" "Failed to get rate song ($rtn(code) $rtn(data))";
|
|
|
493 }
|
|
|
494
|
|
|
495 }
|
|
|
496
|
|
|
497 proc control_player {cmd} {
|
|
|
498 global state;
|
|
|
499
|
|
|
500 n_write "$cmd";
|
|
|
501 n_getrtn rtn;
|
|
|
502
|
|
|
503 log "%s" "Control Got $rtn(code) $rtn(data)";
|
|
|
504 }
|
|
|
505
|
|
3
|
506 proc gui_top {} {
|
|
|
507 global state;
|
|
|
508
|
|
|
509 n_write "TOP"
|
|
|
510 n_getrtn rtn;
|
|
|
511
|
|
|
512 set msg "List of songs most likely to be played next\n\n";
|
|
|
513
|
|
|
514 foreach t $rtn(lines) {
|
|
|
515 set tmp [split $t \011];
|
|
|
516 append msg "[lindex $tmp 0]%\t[lindex $tmp 4] by [lindex $tmp 3]\n";
|
|
|
517 }
|
|
|
518
|
|
|
519 msg_box "Top Listing" $msg;
|
|
|
520 }
|
|
|
521
|
|
1
|
522 proc gui_updatesongs {} {
|
|
|
523 global state songs;
|
|
|
524
|
|
|
525 .top.tlist.list delete 0 end;
|
|
|
526
|
|
|
527 set tmp "";
|
|
|
528
|
|
|
529 foreach tag [array names songs "*:id"] {
|
|
|
530 set a $songs($tag);
|
|
|
531 lappend tmp [list $a $songs($a:name) $songs($a:author) $songs($a:albumname)];
|
|
|
532 }
|
|
|
533
|
|
|
534 switch -- $state(sortmode) {
|
|
|
535 "Title" {
|
|
|
536 set idx 1;
|
|
|
537 }
|
|
|
538
|
|
|
539 "Artist" {
|
|
|
540 set idx 2;
|
|
|
541 }
|
|
|
542
|
|
|
543 "Album" {
|
|
|
544 set idx 3;
|
|
|
545 }
|
|
|
546
|
|
|
547 default {
|
|
|
548 set idx 1;
|
|
|
549 }
|
|
|
550 }
|
|
|
551 set tmp [lsort -dictionary -index $idx $tmp];
|
|
|
552
|
|
|
553 foreach a [array names songs *:listid:*] {
|
|
|
554 unset songs($a);
|
|
|
555 }
|
|
|
556
|
|
|
557 set i 0;
|
|
|
558 foreach a $tmp {
|
|
|
559 .top.tlist.list insert end "'[lindex $a 1]' by '[lindex $a 2]' on '[lindex $a 3]'"
|
|
|
560 set songs([lindex $a 0]:listid:$i) $a;
|
|
|
561 incr i;
|
|
|
562 }
|
|
|
563 }
|
|
|
564
|
|
|
565 proc gui_updatequeue {} {
|
|
|
566 global state songs queue;
|
|
|
567
|
|
|
568 if {[info exists state(queuelock)]} {
|
|
|
569 return;
|
|
|
570 }
|
|
|
571
|
|
|
572 set state(queuelock) "";
|
|
|
573
|
|
|
574 log "%s" "Updating queue";
|
|
|
575
|
|
|
576 .bot.queue.list delete 0 end;
|
|
|
577
|
|
|
578 con_getqueue queue;
|
|
|
579
|
|
|
580 foreach tag [lsort [array names queue]] {
|
|
|
581 .bot.queue.list insert end "'$songs($queue($tag):name)' by '$songs($queue($tag):author)' on '$songs($queue($tag):albumname)'";
|
|
|
582 }
|
|
|
583
|
|
|
584 unset state(queuelock);
|
|
|
585 }
|
|
|
586
|
|
|
587 proc gui_delqueue {id} {
|
|
|
588 global queue;
|
|
|
589
|
|
|
590 if {$id == ""} {
|
|
|
591 return;
|
|
|
592 }
|
|
|
593
|
|
|
594 n_write "UNQUEUE [split $queue($id) {:}]";
|
|
|
595 n_getrtn rtn;
|
|
|
596
|
|
|
597 if {$rtn(code) != 254} {
|
|
|
598 log "%s" "Failed to remove $id ($queue($id))";
|
|
|
599 msg_box "Queue" "Failed to dequeue the song";
|
|
|
600 }
|
|
|
601 }
|
|
|
602
|
|
|
603 proc gui_updateinfo {} {
|
|
|
604 global state;
|
|
|
605
|
|
|
606 n_write "VOLUME";
|
|
|
607 n_getrtn rtn;
|
|
|
608
|
|
|
609 if {$rtn(code) != 235} {
|
|
|
610 set vol "??";
|
|
|
611 } else {
|
|
|
612 set vol "[lindex [lindex $rtn(lines) 0] 0]";
|
|
|
613 }
|
|
|
614
|
|
|
615 n_write "INFO";
|
|
|
616 n_getrtn rtn;
|
|
|
617
|
|
|
618 if {$rtn(code) == 246} {
|
|
|
619 set data [split [lindex $rtn(lines) 0] "\t"];
|
|
|
620 set author [lindex $data 4];
|
|
|
621 set title [lindex $data 5];
|
|
|
622 set length [lindex $data 14];
|
|
|
623 set album [lindex $data 3];
|
|
3
|
624 set rate1 [lindex $data 9];
|
|
|
625 set rate2 [lindex $data 10];
|
|
|
626 set misc [lindex $data 15];
|
|
1
|
627 } else {
|
|
|
628 set author "N/A";
|
|
|
629 set title "N/A";
|
|
|
630 set length "N/A";
|
|
|
631 set album "N/A";
|
|
3
|
632 set rate1 "N/A";
|
|
|
633 set rate2 "N/A";
|
|
|
634 set misc "N/A";
|
|
1
|
635 if {$rtn(code) != 401} {
|
|
|
636 log "%s" "Failed to get track info ($rtn(code) $rtn(data))";
|
|
|
637 }
|
|
|
638 }
|
|
|
639
|
|
|
640 n_write "STATUS";
|
|
|
641 n_getrtn rtn;
|
|
|
642
|
|
|
643 if {$rtn(code) != 222} {
|
|
|
644 set left "x:xx";
|
|
|
645 set played "x:xx";
|
|
|
646 } else {
|
|
|
647 set played [lindex [split [lindex $rtn(lines) 0] "\t"] 8];
|
|
|
648
|
|
|
649 # scan $played "%d:%d" played_m played_s;
|
|
|
650 # set played [expr ($played_m * 60) + $played_s];
|
|
|
651 # scan $length "%d:%f" len_m len_s;
|
|
|
652 # set len [expr ($len_m * 60) + $len_s];
|
|
|
653
|
|
|
654 # set left [expr $len - $played];
|
|
|
655 # set left_m [expr int($left / 60)];
|
|
|
656 # set left [format "%02d:%02d" $left_m [expr int($left - ($left_m * 60))]];
|
|
|
657 }
|
|
|
658
|
|
|
659 .top.tinfo.sub.author configure -text "Author: $author";
|
|
|
660 .top.tinfo.sub.title configure -text "Title: $title";
|
|
|
661 .top.tinfo.sub.length configure -text "Length: $length";
|
|
|
662 .top.tinfo.sub.time configure -text "Time: $played";
|
|
|
663 .top.tinfo.sub.album configure -text "Album: $album";
|
|
3
|
664 .top.tinfo.sub.misc configure -text "Misc: $misc";
|
|
|
665 .top.tinfo.sub.rate1 configure -text "Rating: $rate1";
|
|
|
666 .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2";
|
|
1
|
667 .top.tinfo.sub.vol configure -text "Volume: $vol";
|
|
|
668 }
|
|
|
669
|
|
|
670 proc con_getqueue {queuevar} {
|
|
|
671 upvar $queuevar queue;
|
|
|
672
|
|
|
673 global state;
|
|
|
674
|
|
|
675 catch {unset queue};
|
|
|
676
|
|
|
677 n_write "QUEUE"
|
|
|
678 n_getrtn rtn;
|
|
|
679
|
|
|
680 if {$rtn(code) == 225} {
|
|
|
681 set i 0;
|
|
|
682 foreach line $rtn(lines) {
|
|
|
683 set foo [split $line \011];
|
|
|
684 set id "[lindex $foo 1]:[lindex $foo 2]";
|
|
|
685
|
|
|
686 set queue($i) $id;
|
|
|
687 incr i;
|
|
|
688 }
|
|
|
689 } elseif {$rtn(code) == 404} {
|
|
|
690 log "%s" "Queue empty";
|
|
|
691 } else {
|
|
|
692 log "%s" "Failed to get queue ($rtn(code) $rtn(data))";
|
|
|
693 }
|
|
|
694 }
|
|
|
695
|
|
|
696 proc con_getsongs {songsvar albumsvar} {
|
|
|
697 upvar $songsvar songs;
|
|
|
698 upvar $albumsvar albums;
|
|
|
699
|
|
|
700 global state;
|
|
|
701
|
|
|
702 catch { unset songs };
|
|
|
703
|
|
|
704 foreach i [array names albums "*:"] {
|
|
|
705 n_write "TRACKS $albums($i)";
|
|
|
706 n_getrtn rtn;
|
|
|
707 if {$rtn(code) != "228"} {
|
|
|
708 error "Got bogus response to track request ($rtn(code) $rtn(data))";
|
|
|
709 }
|
|
|
710
|
|
|
711 foreach trk $rtn(lines) {
|
|
|
712 set foo [split $trk \011];
|
|
|
713 if {[llength $foo] != 6} {
|
|
|
714 continue;
|
|
|
715 }
|
|
|
716
|
|
|
717 set albid [lindex $foo 0];
|
|
|
718 set num [lindex $foo 1]
|
|
|
719 set songs($albid:$num:id) "$albid:$num";
|
|
|
720 set songs($albid:$num:author) [lindex $foo 2];
|
|
|
721 set songs($albid:$num:name) [lindex $foo 3];
|
|
|
722 set songs($albid:$num:rating) [lindex $foo 4];
|
|
|
723 set songs($albid:$num:length) [lindex $foo 5];
|
|
|
724 set songs($albid:$num:albumname) $albums($albid:name);
|
|
|
725 }
|
|
|
726 }
|
|
|
727
|
|
|
728 }
|
|
|
729
|
|
|
730 proc con_getalbums {albumsvar} {
|
|
|
731 upvar $albumsvar albums;
|
|
|
732
|
|
|
733 global state;
|
|
|
734
|
|
|
735 catch {unset albums};
|
|
|
736
|
|
|
737 n_write "ALBUMS";
|
|
|
738 n_getrtn rtn;
|
|
|
739 if {$rtn(code) != 227} {
|
|
|
740 error "Server gave bogus response to album request ($rtn(code) $rtn(data))";
|
|
|
741 }
|
|
|
742
|
|
|
743 foreach alb $rtn(lines) {
|
|
|
744 set foo [split $alb \011];
|
|
|
745 set id [lindex $foo 0];
|
|
|
746 set albums($id:) [lindex $foo 0];
|
|
|
747 set albums($id:author) [lindex $foo 1];
|
|
|
748 set albums($id:name) [lindex $foo 2];
|
|
|
749
|
|
|
750 # log "%s" "Album $i, ID $albums($i:id) called $albums($i:name) by $albums($i:author)";
|
|
|
751 }
|
|
|
752 }
|
|
|
753
|
|
|
754 proc update_timer {} {
|
|
|
755
|
|
|
756 gui_updateinfo;
|
|
|
757
|
|
|
758 after 900 update_timer;
|
|
|
759 }
|
|
|
760
|
|
|
761 proc con_mserv {} {
|
|
|
762 global state;
|
|
|
763
|
|
|
764 # Close old FD
|
|
|
765 catch {close state(serv_fd)};
|
|
|
766 catch {unset state(serv_fd)};
|
|
|
767
|
|
|
768 catch {fileevent $state(serv_fd) readable ""};
|
|
|
769 set state(serv_fd) [ socket $state(host) $state(port) ];
|
|
|
770 set state(pushbuf) "";
|
|
|
771 fileevent $state(serv_fd) readable n_rtinput;
|
|
|
772 fconfigure $state(serv_fd) -blocking 0;
|
|
|
773
|
|
|
774 # Greeting from server
|
|
|
775 n_getrtn rtn;
|
|
|
776 puts $rtn(data);
|
|
|
777 if {$rtn(code) != "200"} {
|
|
|
778 error "Server failed to send greeting";
|
|
|
779 }
|
|
|
780
|
|
|
781 # Login
|
|
|
782 n_write "USER $state(user)"
|
|
|
783 n_getrtn rtn;
|
|
|
784 if {$rtn(code) != "201"} {
|
|
|
785 error "Server failed to send password request";
|
|
|
786 }
|
|
|
787
|
|
|
788 n_write "PASS $state(pass) RTCOMPUTER";
|
|
|
789 n_getrtn rtn;
|
|
|
790 if {$rtn(code) == "507"} {
|
|
|
791 error "Server rejected our credentials";
|
|
|
792 }
|
|
|
793
|
|
|
794 if {$rtn(code) != "202"} {
|
|
|
795 error "Unknown response to PASS command - $rtn(code) $rtn(data)"
|
|
|
796 }
|
|
|
797
|
|
|
798 log "%s" "Logged in";
|
|
|
799 }
|
|
|
800
|
|
|
801 proc n_write {text} {
|
|
|
802 global state;
|
|
|
803
|
|
|
804 puts $state(serv_fd) $text;
|
|
|
805 # log "%s" "Wrote - $text";
|
|
|
806
|
|
|
807 flush $state(serv_fd);
|
|
|
808 }
|
|
|
809
|
|
|
810 proc n_rthandler {code data} {
|
|
|
811 global songs;
|
|
|
812
|
|
|
813 log "%s" "Got RT - $code $data";
|
|
|
814
|
|
|
815 switch -- $code {
|
|
|
816 600 {
|
|
|
817 log "%s" "User '$data' connected";
|
|
|
818 }
|
|
|
819
|
|
|
820 601 {
|
|
|
821 log "%s" "User '$data' disconnected";
|
|
|
822 }
|
|
|
823
|
|
|
824 618 -
|
|
|
825 619 -
|
|
|
826 622 -
|
|
|
827 627 -
|
|
|
828 623 {
|
|
|
829 after idle gui_updatequeue;
|
|
|
830 }
|
|
|
831 }
|
|
|
832 }
|
|
|
833
|
|
|
834 proc n_rtinput {} {
|
|
|
835 global state;
|
|
|
836
|
|
|
837 set rth "";
|
|
|
838
|
|
|
839 set line [gets $state(serv_fd)];
|
|
|
840 # log "%s" "Read - $line";
|
|
|
841
|
|
|
842 # Check for RT text
|
|
|
843 set foo [split $line "\t"];
|
|
|
844 if {[string index $line 0] == "="} {
|
|
|
845 set rth [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
|
|
|
846 } else {
|
|
|
847 lappend state(tmpphrase) $line
|
|
|
848 if {$line == "."} {
|
|
|
849 set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
|
|
|
850 set state(tmpphrase) "";
|
|
|
851 }
|
|
|
852 }
|
|
|
853
|
|
|
854 if {$rth != ""} {
|
|
|
855 n_rthandler [lindex $rth 0] [lindex $rth 1];
|
|
|
856 }
|
|
|
857 }
|
|
|
858
|
|
|
859 proc n_getrtn {var} {
|
|
|
860 upvar $var rtn;
|
|
|
861 global state;
|
|
|
862
|
|
|
863 set gotcode 0;
|
|
|
864 catch {unset rtn(code)};
|
|
|
865 catch {unset rtn(data)};
|
|
|
866 catch {unset rtn(lines)}
|
|
|
867
|
|
|
868 while {[llength $state(pushbuf)] == 0} {
|
|
|
869 vwait state(pushbuf);
|
|
|
870 }
|
|
|
871
|
|
|
872 set buf [lindex $state(pushbuf) 0];
|
|
|
873 set state(pushbuf) [lrange $state(pushbuf) 1 end];
|
|
|
874
|
|
|
875 while {1} {
|
|
|
876 if {[llength $buf] == 0} {
|
|
|
877 break;
|
|
|
878 }
|
|
|
879
|
|
|
880 set line [lindex $buf 0];
|
|
|
881 set buf [lrange $buf 1 end];
|
|
|
882
|
|
|
883 if {[string index $line 0] == "."} {
|
|
|
884 break;
|
|
|
885 }
|
|
|
886
|
|
|
887 if {$gotcode == 0} {
|
|
|
888 set rtn(code) [string range $line 0 2];
|
|
|
889 set rtn(data) [string range $line 4 end];
|
|
|
890 set gotcode 1;
|
|
|
891 continue;
|
|
|
892 }
|
|
|
893
|
|
|
894 lappend rtn(lines) $line;
|
|
|
895 }
|
|
|
896
|
|
|
897 if {$gotcode == 0} {
|
|
|
898 log "%s" "Failed to parse phrase (got . before server responce)";
|
|
|
899 }
|
|
|
900 }
|
|
|
901
|
|
|
902 ##################################################################
|
|
|
903 # Log a message to stderr
|
|
|
904 #
|
|
|
905 proc log {format args} {
|
|
|
906 # Extract the calling function's name
|
|
3
|
907 if {[catch {set fname [lindex [info level -1] 0]}]} {
|
|
|
908 set fname "unknown";
|
|
|
909 }
|
|
1
|
910
|
|
|
911 # Evaluate the supplied format string and arguments
|
|
|
912 if {[catch {set csm [eval format {$format} $args]} msg]} {
|
|
|
913 set csm "bad log message. format='$format' args='$args'";
|
|
|
914 }
|
|
|
915
|
|
|
916 # Emit the message
|
|
|
917 puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
|
|
|
918 flush stderr;
|
|
|
919 }
|
|
|
920
|
|
|
921 main;
|
