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 mode {"off" "off" "off"}
28 
29 set toggle_btn "pause"
30 
31 # workaround for spurious first event from ttk::scale
32 set first_seek yes
33 
34 proc amused_jump {song} {
35 	puts "jumping to $song"
36 	exec amused jump $song
37 }
38 
39 proc amused_seek {pos} {
40 	global cur_time first_seek
41 
42 	if {$first_seek == yes} {
43 		puts "skipping spurious seek"
44 		set first_seek no
45 		return
46 	}
47 
48 	set pos [expr {round($pos)}]
49 	set tmp [showtime $pos]
50 
51 	if {$cur_time != $tmp} {
52 		set cur_time $tmp
53 		puts "seeking to $cur_time"
54 		exec amused seek $pos
55 	}
56 }
57 
58 proc amused {cmd} {
59 	puts "exec amused $cmd"
60 	exec "amused" $cmd
61 }
62 
63 proc getsongs {} {
64 	global usongs
65 	global cur
66 	global cur_song
67 	global max
68 	global query
69 
70 	set usongs {}
71 
72 	set fd [open "|amused show -p"]
73 
74 	set i 0
75 	while {[gets $fd line] != -1} {
76 		set marker [string range $line 0 1]
77 		if {$marker == "> "} {
78 			set cur $i
79 			# XXX: is wrong to do that here.
80 			set cur_song [string range $line 2 end]
81 		}
82 
83 		set song [string range $line 2 end]
84 		set usongs [lappend usongs $song]
85 
86 		incr i
87 	}
88 
89 	set max $i
90 	dofilter $query
91 	.c.main.list see $cur
92 
93 	close $fd
94 }
95 
96 proc dofilter {query} {
97 	global usongs fsongs cur cur_song
98 
99 	set q [string tolower [string trim $query]]
100 	set fsongs {}
101 	set i -1
102 	foreach e $usongs {
103 		set l [string tolower $e]
104 		if {$q == "" || [string first $q $l] != -1} {
105 			incr i
106 			set fsongs [lappend fentries $e]
107 			if {$e == $cur_song} {
108 				set cur $i
109 			}
110 		}
111 	}
112 
113 	.c.main.list selection set $cur
114 }
115 
116 proc updatefilter {varname args} {
117 	upvar #0 $varname var
118 	dofilter $var
119 }
120 
121 proc settime {var text} {
122 	upvar $var time
123 
124 	set parsed [split $text]
125 	set t [lindex $parsed 1]
126 	set time [showtime $t]
127 }
128 
129 proc setmode {n m text} {
130 	global mode
131 
132 	set parsed [split $text]
133 	set t [lindex $parsed $m]
134 	lset mode $n $t
135 }
136 
137 proc getstatus {} {
138 	global cur_time
139 	global max_time
140 	global toggle_btn
141 
142 	set fd [open "|amused status -f status,time:raw,mode"]
143 
144 	while {[gets $fd line] != -1} {
145 		switch -glob $line {
146 		"playing *"	{
147 			set toggle_btn "pause"
148 		}
149 		"paused *"	{
150 			set toggle_btn "play"
151 		}
152 		"stopped *"	{
153 			set toggle_btn "play"
154 		}
155 		"position *"	{settime cur_time $line}
156 		"duration *"	{settime max_time $line}
157 		"repeat all *"	{setmode 0 2 $line}
158 		"repeat one *"	{setmode 1 2 $line}
159 		"consume *"	{setmode 2 1 $line}
160 		}
161 	}
162 
163 	close $fd
164 }
165 
166 proc setpos {ev} {
167 	global cur_time max_time
168 
169 	set t [split $ev]
170 
171 	set cur_time [showtime [lindex $t 1]]
172 	set max_time [showtime [lindex $t 2]]
173 
174 	.c.bottom.bar set [lindex $t 1]
175 	.c.bottom.bar configure -to [lindex $t 2]
176 }
177 
178 proc handle_event {fd} {
179 	global toggle_btn
180 
181 	if {[eof $fd]} {
182 		set loop 0
183 	}
184 
185 	set ev [gets $fd]
186 
187 	#puts "got event $ev"
188 
189 	switch -glob $ev {
190 	"add *"		{getsongs}
191 	"jump"		{getsongs}
192 	"load"		{getsongs}
193 	"mode *"	{puts "TODO: refresh mode"}
194 	"next"		{getsongs}	# may be optimized
195 	"pause"		{
196 		set toggle_btn "play"
197 	}
198 	"play"		{
199 		set toggle_btn "pause"
200 	}
201 	"prev"		{getsongs}	# may be optimized
202 	"seek *"	{setpos $ev}
203 	"stop"		{
204 		set toggle_btn "play"
205 	}
206 	default		{puts "un-catched event $ev"}
207 	}
208 }
209 
210 proc showtime {seconds} {
211 	set tmp ""
212 	if {$seconds > 3600} {
213 		set hours [expr {$seconds / 3600}]
214 		set seconds [expr {$seconds - $hours * 3600}]
215 		set tmp [format "%02d:" $hours]
216 	}
217 
218 	set minutes [expr {$seconds / 60}]
219 	set seconds [expr {$seconds - $minutes * 60}]
220 	return [format "%s%02d:%02d" $tmp $minutes $seconds]
221 }
222 
223 # start the gui
224 
225 option add *tearOff 0
226 wm title . gamused
227 wm geometry . 600x300
228 
229 # create and grid the outer content frame
230 grid [ttk::frame .c -padding "5 5 5 5"] -column 0 -row 0 -sticky nsew
231 
232 grid [ttk::frame .c.top -padding "5 0 5 5"]
233 ttk::entry .c.top.query -textvariable query -width 50
234 trace add variable query write "updatefilter query"
235 grid .c.top.query -column 0 -row 0
236 
237 grid [ttk::frame .c.main] -column 0 -row 1 -sticky nsew
238 tk::listbox .c.main.list -listvariable fsongs \
239 	-yscrollcommand ".c.main.scroll set" -exportselection no \
240 	-selectbackground "#8888cc" -selectforeground "#ffffff"
241 ttk::scrollbar .c.main.scroll -command ".c.main.list yview" -orient vertical
242 
243 grid .c.main.list -column 0 -row 0 -sticky nwes
244 grid .c.main.scroll -column 1 -row 0 -sticky ns
245 
246 bind .c.main.list <<ListboxSelect>> {
247 	set curselection [.c.main.list curselection]
248 	if {$curselection != ""} {
249 		amused_jump [lindex $fsongs $curselection]
250 	} else {
251 		# something strange happened.  maybe lost focus.
252 		# set the current again.
253 		.c.main.list selection set $cur
254 	}
255 }
256 
257 grid [ttk::frame .c.cntl -padding "0 5 0 5"] -column 0 -row 2
258 ttk::button .c.cntl.prev -text "prev" -command "amused prev"
259 ttk::button .c.cntl.togg -textvariable toggle_btn -command "amused toggle"
260 ttk::button .c.cntl.stop -text stop -command "amused stop"
261 ttk::button .c.cntl.next -text "next" -command "amused next"
262 
263 grid .c.cntl.prev -column 0 -row 0
264 grid .c.cntl.togg -column 1 -row 0
265 grid .c.cntl.stop -column 2 -row 0
266 grid .c.cntl.next -column 3 -row 0
267 
268 grid [ttk::frame .c.bottom -borderwidth 2] -column 0 -row 3
269 ttk::label .c.bottom.cur_time -textvariable cur_time -padding "0 0 5 0"
270 ttk::scale .c.bottom.bar -orient horizontal -length 400 -command amused_seek
271 ttk::label .c.bottom.max_time -textvariable max_time -padding "5 0 0 0"
272 
273 grid [ttk::frame .c.current -padding "0 5 0 0"] -column 0 -row 4
274 grid [ttk::label .c.current.title -textvariable cur_song]
275 
276 grid .c.bottom.cur_time -column 0 -row 0
277 grid .c.bottom.bar -column 1 -row 0
278 grid .c.bottom.max_time -column 2 -row 0
279 
280 # make resizing works
281 grid columnconfigure . 0 -weight 1
282 grid rowconfigure . 0 -weight 1
283 
284 grid columnconfigure .c 0 -weight 1
285 grid rowconfigure .c 1 -weight 1
286 
287 grid columnconfigure .c.main 0 -weight 1
288 grid rowconfigure .c.main 0 -weight 1
289 
290 grid columnconfigure .c.bottom 1 -weight 1
291 grid rowconfigure .c.bottom 0 -weight 1
292 
293 # define keybindings
294 
295 bind . <space> {amused toggle}
296 bind . <n> {amused next}
297 bind . <p> {amused prev}
298 bind . <s> {amused stop}
299 bind . <comma> {exec amused seek -1}
300 bind . <less> {exec amused seek -5}
301 bind . <period> {exec amused seek +1}
302 bind . <greater> {exec amused seek +5}
303 bind . <slash> {focus .c.top.query}
304 
305 bind .c.top.query <Escape> {focus .}
306 
307 bind . <Control-q> {exit}
308 
309 # init the state
310 
311 set fd [open "|amused monitor" r]
312 fileevent $fd readable "handle_event $fd"
313 
314 getsongs
315 getstatus
316 
317 #set loop 1
318 #vwait loop