1 66fe8023 2023-01-18 op #!/usr/bin/env tclsh8.6
3 66fe8023 2023-01-18 op # Copyright (c) 2023 Omar Polo <op@omarpolo.com>
5 66fe8023 2023-01-18 op # Permission to use, copy, modify, and distribute this software for any
6 66fe8023 2023-01-18 op # purpose with or without fee is hereby granted, provided that the above
7 66fe8023 2023-01-18 op # copyright notice and this permission notice appear in all copies.
9 66fe8023 2023-01-18 op # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10 66fe8023 2023-01-18 op # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11 66fe8023 2023-01-18 op # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12 66fe8023 2023-01-18 op # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13 66fe8023 2023-01-18 op # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14 66fe8023 2023-01-18 op # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15 66fe8023 2023-01-18 op # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17 66fe8023 2023-01-18 op package require Tk
19 66fe8023 2023-01-18 op set usongs {} ;# unfiltered sogs
20 66fe8023 2023-01-18 op set fsongs {} ;# filtered songs
24 66fe8023 2023-01-18 op set cur_song ""
25 66fe8023 2023-01-18 op set cur_time 0
26 66fe8023 2023-01-18 op set max_time 0
27 66fe8023 2023-01-18 op set mode {"off" "off" "off"}
29 66fe8023 2023-01-18 op set toggle_btn "pause"
31 66fe8023 2023-01-18 op # workaround for spurious first event from ttk::scale
32 66fe8023 2023-01-18 op set first_seek yes
34 66fe8023 2023-01-18 op proc amused_jump {song} {
35 66fe8023 2023-01-18 op puts "jumping to $song"
36 66fe8023 2023-01-18 op exec amused jump $song
39 66fe8023 2023-01-18 op proc amused_seek {pos} {
40 66fe8023 2023-01-18 op global cur_time first_seek
42 66fe8023 2023-01-18 op if {$first_seek == yes} {
43 66fe8023 2023-01-18 op puts "skipping spurious seek"
44 66fe8023 2023-01-18 op set first_seek no
48 66fe8023 2023-01-18 op set pos [expr {round($pos)}]
49 66fe8023 2023-01-18 op set tmp [showtime $pos]
51 66fe8023 2023-01-18 op if {$cur_time != $tmp} {
52 66fe8023 2023-01-18 op set cur_time $tmp
53 66fe8023 2023-01-18 op puts "seeking to $cur_time"
54 66fe8023 2023-01-18 op exec amused seek $pos
58 66fe8023 2023-01-18 op proc amused {cmd} {
59 66fe8023 2023-01-18 op puts "exec amused $cmd"
60 66fe8023 2023-01-18 op exec "amused" $cmd
63 66fe8023 2023-01-18 op proc getsongs {} {
66 66fe8023 2023-01-18 op global cur_song
72 66fe8023 2023-01-18 op set fd [open "|amused show -p"]
75 66fe8023 2023-01-18 op while {[gets $fd line] != -1} {
76 66fe8023 2023-01-18 op set marker [string range $line 0 1]
77 66fe8023 2023-01-18 op if {$marker == "> "} {
79 66fe8023 2023-01-18 op # XXX: is wrong to do that here.
80 66fe8023 2023-01-18 op set cur_song [string range $line 2 end]
83 66fe8023 2023-01-18 op set song [string range $line 2 end]
84 66fe8023 2023-01-18 op set usongs [lappend usongs $song]
90 66fe8023 2023-01-18 op dofilter $query
91 66fe8023 2023-01-18 op .c.main.list see $cur
96 66fe8023 2023-01-18 op proc dofilter {query} {
97 66fe8023 2023-01-18 op global usongs fsongs cur cur_song
99 66fe8023 2023-01-18 op set q [string tolower [string trim $query]]
100 66fe8023 2023-01-18 op set fsongs {}
102 66fe8023 2023-01-18 op foreach e $usongs {
103 66fe8023 2023-01-18 op set l [string tolower $e]
104 66fe8023 2023-01-18 op if {$q == "" || [string first $q $l] != -1} {
106 66fe8023 2023-01-18 op set fsongs [lappend fentries $e]
107 66fe8023 2023-01-18 op if {$e == $cur_song} {
113 66fe8023 2023-01-18 op .c.main.list selection set $cur
116 66fe8023 2023-01-18 op proc updatefilter {varname args} {
117 66fe8023 2023-01-18 op upvar #0 $varname var
118 66fe8023 2023-01-18 op dofilter $var
121 66fe8023 2023-01-18 op proc settime {var text} {
122 66fe8023 2023-01-18 op upvar $var time
124 66fe8023 2023-01-18 op set parsed [split $text]
125 66fe8023 2023-01-18 op set t [lindex $parsed 1]
126 66fe8023 2023-01-18 op set time [showtime $t]
129 66fe8023 2023-01-18 op proc setmode {n m text} {
132 66fe8023 2023-01-18 op set parsed [split $text]
133 66fe8023 2023-01-18 op set t [lindex $parsed $m]
134 66fe8023 2023-01-18 op lset mode $n $t
137 66fe8023 2023-01-18 op proc getstatus {} {
138 66fe8023 2023-01-18 op global cur_time
139 66fe8023 2023-01-18 op global max_time
140 66fe8023 2023-01-18 op global toggle_btn
142 66fe8023 2023-01-18 op set fd [open "|amused status -f status,time:raw,mode"]
144 66fe8023 2023-01-18 op while {[gets $fd line] != -1} {
145 66fe8023 2023-01-18 op switch -glob $line {
146 66fe8023 2023-01-18 op "playing *" {
147 66fe8023 2023-01-18 op set toggle_btn "pause"
150 66fe8023 2023-01-18 op set toggle_btn "play"
152 66fe8023 2023-01-18 op "stopped *" {
153 66fe8023 2023-01-18 op set toggle_btn "play"
155 66fe8023 2023-01-18 op "position *" {settime cur_time $line}
156 66fe8023 2023-01-18 op "duration *" {settime max_time $line}
157 66fe8023 2023-01-18 op "repeat all *" {setmode 0 2 $line}
158 66fe8023 2023-01-18 op "repeat one *" {setmode 1 2 $line}
159 66fe8023 2023-01-18 op "consume *" {setmode 2 1 $line}
166 66fe8023 2023-01-18 op proc setpos {ev} {
167 66fe8023 2023-01-18 op global cur_time max_time
169 66fe8023 2023-01-18 op set t [split $ev]
171 66fe8023 2023-01-18 op set cur_time [showtime [lindex $t 1]]
172 66fe8023 2023-01-18 op set max_time [showtime [lindex $t 2]]
174 66fe8023 2023-01-18 op .c.bottom.bar set [lindex $t 1]
175 66fe8023 2023-01-18 op .c.bottom.bar configure -to [lindex $t 2]
178 66fe8023 2023-01-18 op proc handle_event {fd} {
179 66fe8023 2023-01-18 op global toggle_btn
181 66fe8023 2023-01-18 op if {[eof $fd]} {
185 66fe8023 2023-01-18 op set ev [gets $fd]
187 66fe8023 2023-01-18 op #puts "got event $ev"
189 66fe8023 2023-01-18 op switch -glob $ev {
190 66fe8023 2023-01-18 op "add *" {getsongs}
191 66fe8023 2023-01-18 op "jump" {getsongs}
192 66fe8023 2023-01-18 op "load" {getsongs}
193 66fe8023 2023-01-18 op "mode *" {puts "TODO: refresh mode"}
194 66fe8023 2023-01-18 op "next" {getsongs} # may be optimized
196 66fe8023 2023-01-18 op set toggle_btn "play"
199 66fe8023 2023-01-18 op set toggle_btn "pause"
201 66fe8023 2023-01-18 op "prev" {getsongs} # may be optimized
202 66fe8023 2023-01-18 op "seek *" {setpos $ev}
204 66fe8023 2023-01-18 op set toggle_btn "play"
206 66fe8023 2023-01-18 op default {puts "un-catched event $ev"}
210 66fe8023 2023-01-18 op proc showtime {seconds} {
212 66fe8023 2023-01-18 op if {$seconds > 3600} {
213 66fe8023 2023-01-18 op set hours [expr {$seconds / 3600}]
214 66fe8023 2023-01-18 op set seconds [expr {$seconds - $hours * 3600}]
215 66fe8023 2023-01-18 op set tmp [format "%02d:" $hours]
218 66fe8023 2023-01-18 op set minutes [expr {$seconds / 60}]
219 66fe8023 2023-01-18 op set seconds [expr {$seconds - $minutes * 60}]
220 66fe8023 2023-01-18 op return [format "%s%02d:%02d" $tmp $minutes $seconds]
223 66fe8023 2023-01-18 op # start the gui
225 66fe8023 2023-01-18 op option add *tearOff 0
226 66fe8023 2023-01-18 op wm title . gamused
227 66fe8023 2023-01-18 op wm geometry . 600x300
229 66fe8023 2023-01-18 op # create and grid the outer content frame
230 66fe8023 2023-01-18 op grid [ttk::frame .c -padding "5 5 5 5"] -column 0 -row 0 -sticky nsew
232 66fe8023 2023-01-18 op grid [ttk::frame .c.top -padding "5 0 5 5"]
233 66fe8023 2023-01-18 op ttk::entry .c.top.query -textvariable query -width 50
234 66fe8023 2023-01-18 op trace add variable query write "updatefilter query"
235 66fe8023 2023-01-18 op grid .c.top.query -column 0 -row 0
237 66fe8023 2023-01-18 op grid [ttk::frame .c.main] -column 0 -row 1 -sticky nsew
238 66fe8023 2023-01-18 op tk::listbox .c.main.list -listvariable fsongs \
239 66fe8023 2023-01-18 op -yscrollcommand ".c.main.scroll set" -exportselection no \
240 66fe8023 2023-01-18 op -selectbackground "#8888cc" -selectforeground "#ffffff"
241 66fe8023 2023-01-18 op ttk::scrollbar .c.main.scroll -command ".c.main.list yview" -orient vertical
243 66fe8023 2023-01-18 op grid .c.main.list -column 0 -row 0 -sticky nwes
244 66fe8023 2023-01-18 op grid .c.main.scroll -column 1 -row 0 -sticky ns
246 66fe8023 2023-01-18 op bind .c.main.list <<ListboxSelect>> {
247 66fe8023 2023-01-18 op set curselection [.c.main.list curselection]
248 66fe8023 2023-01-18 op if {$curselection != ""} {
249 66fe8023 2023-01-18 op amused_jump [lindex $fsongs $curselection]
251 66fe8023 2023-01-18 op # something strange happened. maybe lost focus.
252 66fe8023 2023-01-18 op # set the current again.
253 66fe8023 2023-01-18 op .c.main.list selection set $cur
257 9b739c87 2023-01-18 op grid [ttk::frame .c.cntl -padding "0 5 0 5"] -column 0 -row 2
258 66fe8023 2023-01-18 op ttk::button .c.cntl.prev -text "prev" -command "amused prev"
259 66fe8023 2023-01-18 op ttk::button .c.cntl.togg -textvariable toggle_btn -command "amused toggle"
260 66fe8023 2023-01-18 op ttk::button .c.cntl.stop -text stop -command "amused stop"
261 66fe8023 2023-01-18 op ttk::button .c.cntl.next -text "next" -command "amused next"
263 66fe8023 2023-01-18 op grid .c.cntl.prev -column 0 -row 0
264 66fe8023 2023-01-18 op grid .c.cntl.togg -column 1 -row 0
265 66fe8023 2023-01-18 op grid .c.cntl.stop -column 2 -row 0
266 66fe8023 2023-01-18 op grid .c.cntl.next -column 3 -row 0
268 9b739c87 2023-01-18 op grid [ttk::frame .c.bottom -borderwidth 2] -column 0 -row 3
269 66fe8023 2023-01-18 op ttk::label .c.bottom.cur_time -textvariable cur_time -padding "0 0 5 0"
270 66fe8023 2023-01-18 op ttk::scale .c.bottom.bar -orient horizontal -length 400 -command amused_seek
271 66fe8023 2023-01-18 op ttk::label .c.bottom.max_time -textvariable max_time -padding "5 0 0 0"
273 9b739c87 2023-01-18 op grid [ttk::frame .c.current -padding "0 5 0 0"] -column 0 -row 4
274 19cab05c 2023-01-18 op grid [ttk::label .c.current.title -textvariable cur_song]
276 66fe8023 2023-01-18 op grid .c.bottom.cur_time -column 0 -row 0
277 66fe8023 2023-01-18 op grid .c.bottom.bar -column 1 -row 0
278 66fe8023 2023-01-18 op grid .c.bottom.max_time -column 2 -row 0
280 66fe8023 2023-01-18 op # make resizing works
281 66fe8023 2023-01-18 op grid columnconfigure . 0 -weight 1
282 66fe8023 2023-01-18 op grid rowconfigure . 0 -weight 1
284 66fe8023 2023-01-18 op grid columnconfigure .c 0 -weight 1
285 66fe8023 2023-01-18 op grid rowconfigure .c 1 -weight 1
287 66fe8023 2023-01-18 op grid columnconfigure .c.main 0 -weight 1
288 66fe8023 2023-01-18 op grid rowconfigure .c.main 0 -weight 1
290 66fe8023 2023-01-18 op grid columnconfigure .c.bottom 1 -weight 1
291 66fe8023 2023-01-18 op grid rowconfigure .c.bottom 0 -weight 1
293 04aefc81 2023-01-18 op # define keybindings
295 04aefc81 2023-01-18 op bind . <space> {amused toggle}
296 04aefc81 2023-01-18 op bind . <n> {amused next}
297 04aefc81 2023-01-18 op bind . <p> {amused prev}
298 04aefc81 2023-01-18 op bind . <s> {amused stop}
299 04aefc81 2023-01-18 op bind . <comma> {exec amused seek -1}
300 04aefc81 2023-01-18 op bind . <less> {exec amused seek -5}
301 04aefc81 2023-01-18 op bind . <period> {exec amused seek +1}
302 04aefc81 2023-01-18 op bind . <greater> {exec amused seek +5}
303 4361fd50 2023-01-18 op bind . <slash> {focus .c.top.query}
305 4361fd50 2023-01-18 op bind .c.top.query <Escape> {focus .}
307 0b76f897 2023-01-19 op bind . <Control-q> {exit}
309 66fe8023 2023-01-18 op # init the state
311 66fe8023 2023-01-18 op set fd [open "|amused monitor" r]
312 66fe8023 2023-01-18 op fileevent $fd readable "handle_event $fd"
