1 #!/usr/bin/env tclsh8.6
3 # Copyright (c) 2023 Omar Polo <op@omarpolo.com>
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.
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.
19 set usongs {} ;# unfiltered sogs
20 set fsongs {} ;# filtered songs
27 set mode {"off" "off" "off"}
29 set toggle_btn "pause"
31 # workaround for spurious first event from ttk::scale
34 proc amused_jump {song} {
35 puts "jumping to $song"
36 exec amused jump $song
39 proc amused_seek {pos} {
40 global cur_time first_seek
42 if {$first_seek == yes} {
43 puts "skipping spurious seek"
48 set pos [expr {round($pos)}]
49 set tmp [showtime $pos]
51 if {$cur_time != $tmp} {
53 puts "seeking to $cur_time"
59 puts "exec amused $cmd"
72 set fd [open "|amused show -p"]
75 while {[gets $fd line] != -1} {
76 set marker [string range $line 0 1]
77 if {$marker == "> "} {
79 # XXX: is wrong to do that here.
80 set cur_song [string range $line 2 end]
83 set song [string range $line 2 end]
84 set usongs [lappend usongs $song]
96 proc dofilter {query} {
97 global usongs fsongs cur cur_song
99 set q [string tolower [string trim $query]]
103 set l [string tolower $e]
104 if {$q == "" || [string first $q $l] != -1} {
106 set fsongs [lappend fentries $e]
107 if {$e == $cur_song} {
113 .c.main.list selection set $cur
116 proc updatefilter {varname args} {
117 upvar #0 $varname var
121 proc settime {var text} {
124 set parsed [split $text]
125 set t [lindex $parsed 1]
126 set time [showtime $t]
129 proc setmode {n m text} {
132 set parsed [split $text]
133 set t [lindex $parsed $m]
142 set fd [open "|amused status -f status,time:raw,mode"]
144 while {[gets $fd line] != -1} {
147 set toggle_btn "pause"
150 set toggle_btn "play"
153 set toggle_btn "play"
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}
167 global cur_time max_time
171 set cur_time [showtime [lindex $t 1]]
172 set max_time [showtime [lindex $t 2]]
174 .c.bottom.bar set [lindex $t 1]
175 .c.bottom.bar configure -to [lindex $t 2]
178 proc handle_event {fd} {
187 #puts "got event $ev"
193 "mode *" {puts "TODO: refresh mode"}
194 "next" {getsongs} # may be optimized
196 set toggle_btn "play"
199 set toggle_btn "pause"
201 "prev" {getsongs} # may be optimized
202 "seek *" {setpos $ev}
204 set toggle_btn "play"
206 default {puts "un-catched event $ev"}
210 proc showtime {seconds} {
212 if {$seconds > 3600} {
213 set hours [expr {$seconds / 3600}]
214 set seconds [expr {$seconds - $hours * 3600}]
215 set tmp [format "%02d:" $hours]
218 set minutes [expr {$seconds / 60}]
219 set seconds [expr {$seconds - $minutes * 60}]
220 return [format "%s%02d:%02d" $tmp $minutes $seconds]
225 option add *tearOff 0
227 wm geometry . 600x300
229 # create and grid the outer content frame
230 grid [ttk::frame .c -padding "5 5 5 5"] -column 0 -row 0 -sticky nsew
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
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
243 grid .c.main.list -column 0 -row 0 -sticky nwes
244 grid .c.main.scroll -column 1 -row 0 -sticky ns
246 bind .c.main.list <<ListboxSelect>> {
247 set curselection [.c.main.list curselection]
248 if {$curselection != ""} {
249 amused_jump [lindex $fsongs $curselection]
251 # something strange happened. maybe lost focus.
252 # set the current again.
253 .c.main.list selection set $cur
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"
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
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"
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]
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
280 # make resizing works
281 grid columnconfigure . 0 -weight 1
282 grid rowconfigure . 0 -weight 1
284 grid columnconfigure .c 0 -weight 1
285 grid rowconfigure .c 1 -weight 1
287 grid columnconfigure .c.main 0 -weight 1
288 grid rowconfigure .c.main 0 -weight 1
290 grid columnconfigure .c.bottom 1 -weight 1
291 grid rowconfigure .c.bottom 0 -weight 1
295 set fd [open "|amused monitor" r]
296 fileevent $fd readable "handle_event $fd"