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