1 #!/usr/bin/env tclsh8.6
2 #
3 # Copyright (c) 2023 Omar Polo <op@omarpolo.com>
4 #
5 # Permission to use, copy, modify, and distribute this software for any
6 # purpose with or without fee is hereby granted, provided that the above
7 # copyright notice and this permission notice appear in all copies.
8 #
9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16 
17 package require Tk
18 
19 set usongs {}	;# unfiltered sogs
20 set fsongs {}	;# filtered songs
21 set query ""
22 set cur 0
23 set max 0
24 set cur_song ""
25 set cur_time 0
26 set max_time 0
27 set status "stopped"
28 set mode {"off" "off" "off"}
29 
30 set toggle_btn "pause"
31 
32 # workaround for spurious first event from ttk::scale
33 set first_seek yes
34 
35 proc amused_jump {song} {
36 	puts "jumping to $song"
37 	exec amused jump $song
38 }
39 
40 proc amused_seek {pos} {
41 	global cur_time first_seek
42 
43 	if {$first_seek == yes} {
44 		puts "skipping spurious seek"
45 		set first_seek no
46 		return
47 	}
48 
49 	set pos [expr {round($pos)}]
50 	set tmp [showtime $pos]
51 
52 	if {$cur_time != $tmp} {
53 		set cur_time $tmp
54 		puts "seeking to $cur_time"
55 		exec amused seek $pos
56 	}
57 }
58 
59 proc amused {cmd} {
60 	puts "exec amused $cmd"
61 	exec "amused" $cmd
62 }
63 
64 proc getsongs {} {
65 	global usongs
66 	global cur
67 	global cur_song
68 	global max
69 	global query
70 
71 	set usongs {}
72 
73 	set fd [open "|amused show -p"]
74 
75 	set i 0
76 	while {[gets $fd line] != -1} {
77 		set marker [string range $line 0 1]
78 		if {$marker == "> "} {
79 			set cur $i
80 			# XXX: is wrong to do that here.
81 			set cur_song [string range $line 2 end]
82 		}
83 
84 		set song [string range $line 2 end]
85 		set usongs [lappend usongs $song]
86 
87 		incr i
88 	}
89 
90 	set max $i
91 	dofilter $query
92 	.c.main.list see $cur
93 
94 	close $fd
95 }
96 
97 proc dofilter {query} {
98 	global usongs fsongs cur cur_song
99 
100 	set q [string tolower [string trim $query]]
101 	set fsongs {}
102 	set i -1
103 	foreach e $usongs {
104 		set l [string tolower $e]
105 		if {$q == "" || [string first $q $l] != -1} {
106 			incr i
107 			set fsongs [lappend fentries $e]
108 			if {$e == $cur_song} {
109 				set cur $i
110 			}
111 		}
112 	}
113 
114 	.c.main.list selection set $cur
115 }
116 
117 proc updatefilter {varname args} {
118 	upvar #0 $varname var
119 	dofilter $var
120 }
121 
122 proc settime {var text} {
123 	upvar $var time
124 
125 	set parsed [split $text]
126 	set t [lindex $parsed 1]
127 	set time [showtime $t]
128 }
129 
130 proc setmode {n m text} {
131 	global mode
132 
133 	set parsed [split $text]
134 	set t [lindex $parsed $m]
135 	lset mode $n $t
136 }
137 
138 proc getstatus {} {
139 	global status
140 	global cur_time
141 	global max_time
142 	global toggle_btn
143 
144 	set fd [open "|amused status -f status,time:raw,mode"]
145 
146 	while {[gets $fd line] != -1} {
147 		switch -glob $line {
148 		"playing *"	{
149 			set status "playing"
150 			set toggle_btn "pause"
151 		}
152 		"paused *"	{
153 			set status "paused"
154 			set toggle_btn "play"
155 		}
156 		"stopped *"	{
157 			set status "stopped"
158 			set toggle_btn "play"
159 		}
160 		"position *"	{settime cur_time $line}
161 		"duration *"	{settime max_time $line}
162 		"repeat all *"	{setmode 0 2 $line}
163 		"repeat one *"	{setmode 1 2 $line}
164 		"consume *"	{setmode 2 1 $line}
165 		}
166 	}
167 
168 	close $fd
169 }
170 
171 proc setpos {ev} {
172 	global cur_time max_time
173 
174 	set t [split $ev]
175 
176 	set cur_time [showtime [lindex $t 1]]
177 	set max_time [showtime [lindex $t 2]]
178 
179 	.c.bottom.bar set [lindex $t 1]
180 	.c.bottom.bar configure -to [lindex $t 2]
181 }
182 
183 proc handle_event {fd} {
184 	global status
185 	global toggle_btn
186 
187 	if {[eof $fd]} {
188 		set loop 0
189 	}
190 
191 	set ev [gets $fd]
192 
193 	#puts "got event $ev"
194 
195 	switch -glob $ev {
196 	"add *"		{getsongs}
197 	"jump"		{getsongs}
198 	"load"		{getsongs}
199 	"mode *"	{puts "TODO: refresh mode"}
200 	"next"		{getsongs}	# may be optimized
201 	"pause"		{
202 		set status "paused"
203 		set toggle_btn "play"
204 	}
205 	"play"		{
206 		set status "playing"
207 		set toggle_btn "pause"
208 	}
209 	"prev"		{getsongs}	# may be optimized
210 	"seek *"	{setpos $ev}
211 	"stop"		{
212 		set status "stopped"
213 		set toggle_btn "play"
214 	}
215 	default		{puts "un-catched event $ev"}
216 	}
217 }
218 
219 proc showtime {seconds} {
220 	set tmp ""
221 	if {$seconds > 3600} {
222 		set hours [expr {$seconds / 3600}]
223 		set seconds [expr {$seconds - $hours * 3600}]
224 		set tmp [format "%02d:" $hours]
225 	}
226 
227 	set minutes [expr {$seconds / 60}]
228 	set seconds [expr {$seconds - $minutes * 60}]
229 	return [format "%s%02d:%02d" $tmp $minutes $seconds]
230 }
231 
232 # start the gui
233 
234 option add *tearOff 0
235 wm title . gamused
236 wm geometry . 600x300
237 
238 # create and grid the outer content frame
239 grid [ttk::frame .c -padding "5 5 5 5"] -column 0 -row 0 -sticky nsew
240 
241 grid [ttk::frame .c.top -padding "5 0 5 5"]
242 ttk::entry .c.top.query -textvariable query -width 50
243 trace add variable query write "updatefilter query"
244 grid .c.top.query -column 0 -row 0
245 
246 grid [ttk::frame .c.main] -column 0 -row 1 -sticky nsew
247 tk::listbox .c.main.list -listvariable fsongs \
248 	-yscrollcommand ".c.main.scroll set" -exportselection no \
249 	-selectbackground "#8888cc" -selectforeground "#ffffff"
250 ttk::scrollbar .c.main.scroll -command ".c.main.list yview" -orient vertical
251 
252 grid .c.main.list -column 0 -row 0 -sticky nwes
253 grid .c.main.scroll -column 1 -row 0 -sticky ns
254 
255 bind .c.main.list <<ListboxSelect>> {
256 	set curselection [.c.main.list curselection]
257 	if {$curselection != ""} {
258 		amused_jump [lindex $fsongs $curselection]
259 	} else {
260 		# something strange happened.  maybe lost focus.
261 		# set the current again.
262 		.c.main.list selection set $cur
263 	}
264 }
265 
266 grid [ttk::frame .c.cntl -padding "0 5 0 0"] -column 0 -row 2
267 ttk::button .c.cntl.prev -text "prev" -command "amused prev"
268 ttk::button .c.cntl.togg -textvariable toggle_btn -command "amused toggle"
269 ttk::button .c.cntl.stop -text stop -command "amused stop"
270 ttk::button .c.cntl.next -text "next" -command "amused next"
271 
272 grid .c.cntl.prev -column 0 -row 0
273 grid .c.cntl.togg -column 1 -row 0
274 grid .c.cntl.stop -column 2 -row 0
275 grid .c.cntl.next -column 3 -row 0
276 
277 grid [ttk::frame .c.status -padding "5 5 5 5"] -column 0 -row 3
278 ttk::label .c.status.text -textvariable status
279 grid .c.status.text
280 
281 grid [ttk::frame .c.bottom -borderwidth 2] -column 0 -row 4
282 ttk::label .c.bottom.cur_time -textvariable cur_time -padding "0 0 5 0"
283 ttk::scale .c.bottom.bar -orient horizontal -length 400 -command amused_seek
284 ttk::label .c.bottom.max_time -textvariable max_time -padding "5 0 0 0"
285 
286 grid .c.bottom.cur_time -column 0 -row 0
287 grid .c.bottom.bar -column 1 -row 0
288 grid .c.bottom.max_time -column 2 -row 0
289 
290 # make resizing works
291 grid columnconfigure . 0 -weight 1
292 grid rowconfigure . 0 -weight 1
293 
294 grid columnconfigure .c 0 -weight 1
295 grid rowconfigure .c 1 -weight 1
296 
297 grid columnconfigure .c.main 0 -weight 1
298 grid rowconfigure .c.main 0 -weight 1
299 
300 grid columnconfigure .c.bottom 1 -weight 1
301 grid rowconfigure .c.bottom 0 -weight 1
302 
303 # init the state
304 
305 set fd [open "|amused monitor" r]
306 fileevent $fd readable "handle_event $fd"
307 
308 getsongs
309 getstatus
310 
311 #set loop 1
312 #vwait loop