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 status "stopped"
28 66fe8023 2023-01-18 op set mode {"off" "off" "off"}
30 66fe8023 2023-01-18 op set toggle_btn "pause"
32 66fe8023 2023-01-18 op # workaround for spurious first event from ttk::scale
33 66fe8023 2023-01-18 op set first_seek yes
35 66fe8023 2023-01-18 op proc amused_jump {song} {
36 66fe8023 2023-01-18 op puts "jumping to $song"
37 66fe8023 2023-01-18 op exec amused jump $song
40 66fe8023 2023-01-18 op proc amused_seek {pos} {
41 66fe8023 2023-01-18 op global cur_time first_seek
43 66fe8023 2023-01-18 op if {$first_seek == yes} {
44 66fe8023 2023-01-18 op puts "skipping spurious seek"
45 66fe8023 2023-01-18 op set first_seek no
49 66fe8023 2023-01-18 op set pos [expr {round($pos)}]
50 66fe8023 2023-01-18 op set tmp [showtime $pos]
52 66fe8023 2023-01-18 op if {$cur_time != $tmp} {
53 66fe8023 2023-01-18 op set cur_time $tmp
54 66fe8023 2023-01-18 op puts "seeking to $cur_time"
55 66fe8023 2023-01-18 op exec amused seek $pos
59 66fe8023 2023-01-18 op proc amused {cmd} {
60 66fe8023 2023-01-18 op puts "exec amused $cmd"
61 66fe8023 2023-01-18 op exec "amused" $cmd
64 66fe8023 2023-01-18 op proc getsongs {} {
67 66fe8023 2023-01-18 op global cur_song
73 66fe8023 2023-01-18 op set fd [open "|amused show -p"]
76 66fe8023 2023-01-18 op while {[gets $fd line] != -1} {
77 66fe8023 2023-01-18 op set marker [string range $line 0 1]
78 66fe8023 2023-01-18 op if {$marker == "> "} {
80 66fe8023 2023-01-18 op # XXX: is wrong to do that here.
81 66fe8023 2023-01-18 op set cur_song [string range $line 2 end]
84 66fe8023 2023-01-18 op set song [string range $line 2 end]
85 66fe8023 2023-01-18 op set usongs [lappend usongs $song]
91 66fe8023 2023-01-18 op dofilter $query
92 66fe8023 2023-01-18 op .c.main.list see $cur
97 66fe8023 2023-01-18 op proc dofilter {query} {
98 66fe8023 2023-01-18 op global usongs fsongs cur cur_song
100 66fe8023 2023-01-18 op set q [string tolower [string trim $query]]
101 66fe8023 2023-01-18 op set fsongs {}
103 66fe8023 2023-01-18 op foreach e $usongs {
104 66fe8023 2023-01-18 op set l [string tolower $e]
105 66fe8023 2023-01-18 op if {$q == "" || [string first $q $l] != -1} {
107 66fe8023 2023-01-18 op set fsongs [lappend fentries $e]
108 66fe8023 2023-01-18 op if {$e == $cur_song} {
114 66fe8023 2023-01-18 op .c.main.list selection set $cur
117 66fe8023 2023-01-18 op proc updatefilter {varname args} {
118 66fe8023 2023-01-18 op upvar #0 $varname var
119 66fe8023 2023-01-18 op dofilter $var
122 66fe8023 2023-01-18 op proc settime {var text} {
123 66fe8023 2023-01-18 op upvar $var time
125 66fe8023 2023-01-18 op set parsed [split $text]
126 66fe8023 2023-01-18 op set t [lindex $parsed 1]
127 66fe8023 2023-01-18 op set time [showtime $t]
130 66fe8023 2023-01-18 op proc setmode {n m text} {
133 66fe8023 2023-01-18 op set parsed [split $text]
134 66fe8023 2023-01-18 op set t [lindex $parsed $m]
135 66fe8023 2023-01-18 op lset mode $n $t
138 66fe8023 2023-01-18 op proc getstatus {} {
139 66fe8023 2023-01-18 op global status
140 66fe8023 2023-01-18 op global cur_time
141 66fe8023 2023-01-18 op global max_time
142 66fe8023 2023-01-18 op global toggle_btn
144 66fe8023 2023-01-18 op set fd [open "|amused status -f status,time:raw,mode"]
146 66fe8023 2023-01-18 op while {[gets $fd line] != -1} {
147 66fe8023 2023-01-18 op switch -glob $line {
148 66fe8023 2023-01-18 op "playing *" {
149 66fe8023 2023-01-18 op set status "playing"
150 66fe8023 2023-01-18 op set toggle_btn "pause"
153 66fe8023 2023-01-18 op set status "paused"
154 66fe8023 2023-01-18 op set toggle_btn "play"
156 66fe8023 2023-01-18 op "stopped *" {
157 66fe8023 2023-01-18 op set status "stopped"
158 66fe8023 2023-01-18 op set toggle_btn "play"
160 66fe8023 2023-01-18 op "position *" {settime cur_time $line}
161 66fe8023 2023-01-18 op "duration *" {settime max_time $line}
162 66fe8023 2023-01-18 op "repeat all *" {setmode 0 2 $line}
163 66fe8023 2023-01-18 op "repeat one *" {setmode 1 2 $line}
164 66fe8023 2023-01-18 op "consume *" {setmode 2 1 $line}
171 66fe8023 2023-01-18 op proc setpos {ev} {
172 66fe8023 2023-01-18 op global cur_time max_time
174 66fe8023 2023-01-18 op set t [split $ev]
176 66fe8023 2023-01-18 op set cur_time [showtime [lindex $t 1]]
177 66fe8023 2023-01-18 op set max_time [showtime [lindex $t 2]]
179 66fe8023 2023-01-18 op .c.bottom.bar set [lindex $t 1]
180 66fe8023 2023-01-18 op .c.bottom.bar configure -to [lindex $t 2]
183 66fe8023 2023-01-18 op proc handle_event {fd} {
184 66fe8023 2023-01-18 op global status
185 66fe8023 2023-01-18 op global toggle_btn
187 66fe8023 2023-01-18 op if {[eof $fd]} {
191 66fe8023 2023-01-18 op set ev [gets $fd]
193 66fe8023 2023-01-18 op #puts "got event $ev"
195 66fe8023 2023-01-18 op switch -glob $ev {
196 66fe8023 2023-01-18 op "add *" {getsongs}
197 66fe8023 2023-01-18 op "jump" {getsongs}
198 66fe8023 2023-01-18 op "load" {getsongs}
199 66fe8023 2023-01-18 op "mode *" {puts "TODO: refresh mode"}
200 66fe8023 2023-01-18 op "next" {getsongs} # may be optimized
202 66fe8023 2023-01-18 op set status "paused"
203 66fe8023 2023-01-18 op set toggle_btn "play"
206 66fe8023 2023-01-18 op set status "playing"
207 66fe8023 2023-01-18 op set toggle_btn "pause"
209 66fe8023 2023-01-18 op "prev" {getsongs} # may be optimized
210 66fe8023 2023-01-18 op "seek *" {setpos $ev}
212 66fe8023 2023-01-18 op set status "stopped"
213 66fe8023 2023-01-18 op set toggle_btn "play"
215 66fe8023 2023-01-18 op default {puts "un-catched event $ev"}
219 66fe8023 2023-01-18 op proc showtime {seconds} {
221 66fe8023 2023-01-18 op if {$seconds > 3600} {
222 66fe8023 2023-01-18 op set hours [expr {$seconds / 3600}]
223 66fe8023 2023-01-18 op set seconds [expr {$seconds - $hours * 3600}]
224 66fe8023 2023-01-18 op set tmp [format "%02d:" $hours]
227 66fe8023 2023-01-18 op set minutes [expr {$seconds / 60}]
228 66fe8023 2023-01-18 op set seconds [expr {$seconds - $minutes * 60}]
229 66fe8023 2023-01-18 op return [format "%s%02d:%02d" $tmp $minutes $seconds]
232 66fe8023 2023-01-18 op # start the gui
234 66fe8023 2023-01-18 op option add *tearOff 0
235 66fe8023 2023-01-18 op wm title . gamused
236 66fe8023 2023-01-18 op wm geometry . 600x300
238 66fe8023 2023-01-18 op # create and grid the outer content frame
239 66fe8023 2023-01-18 op grid [ttk::frame .c -padding "5 5 5 5"] -column 0 -row 0 -sticky nsew
241 66fe8023 2023-01-18 op grid [ttk::frame .c.top -padding "5 0 5 5"]
242 66fe8023 2023-01-18 op ttk::entry .c.top.query -textvariable query -width 50
243 66fe8023 2023-01-18 op trace add variable query write "updatefilter query"
244 66fe8023 2023-01-18 op grid .c.top.query -column 0 -row 0
246 66fe8023 2023-01-18 op grid [ttk::frame .c.main] -column 0 -row 1 -sticky nsew
247 66fe8023 2023-01-18 op tk::listbox .c.main.list -listvariable fsongs \
248 66fe8023 2023-01-18 op -yscrollcommand ".c.main.scroll set" -exportselection no \
249 66fe8023 2023-01-18 op -selectbackground "#8888cc" -selectforeground "#ffffff"
250 66fe8023 2023-01-18 op ttk::scrollbar .c.main.scroll -command ".c.main.list yview" -orient vertical
252 66fe8023 2023-01-18 op grid .c.main.list -column 0 -row 0 -sticky nwes
253 66fe8023 2023-01-18 op grid .c.main.scroll -column 1 -row 0 -sticky ns
255 66fe8023 2023-01-18 op bind .c.main.list <<ListboxSelect>> {
256 66fe8023 2023-01-18 op set curselection [.c.main.list curselection]
257 66fe8023 2023-01-18 op if {$curselection != ""} {
258 66fe8023 2023-01-18 op amused_jump [lindex $fsongs $curselection]
260 66fe8023 2023-01-18 op # something strange happened. maybe lost focus.
261 66fe8023 2023-01-18 op # set the current again.
262 66fe8023 2023-01-18 op .c.main.list selection set $cur
266 66fe8023 2023-01-18 op grid [ttk::frame .c.cntl -padding "0 5 0 0"] -column 0 -row 2
267 66fe8023 2023-01-18 op ttk::button .c.cntl.prev -text "prev" -command "amused prev"
268 66fe8023 2023-01-18 op ttk::button .c.cntl.togg -textvariable toggle_btn -command "amused toggle"
269 66fe8023 2023-01-18 op ttk::button .c.cntl.stop -text stop -command "amused stop"
270 66fe8023 2023-01-18 op ttk::button .c.cntl.next -text "next" -command "amused next"
272 66fe8023 2023-01-18 op grid .c.cntl.prev -column 0 -row 0
273 66fe8023 2023-01-18 op grid .c.cntl.togg -column 1 -row 0
274 66fe8023 2023-01-18 op grid .c.cntl.stop -column 2 -row 0
275 66fe8023 2023-01-18 op grid .c.cntl.next -column 3 -row 0
277 66fe8023 2023-01-18 op grid [ttk::frame .c.status -padding "5 5 5 5"] -column 0 -row 3
278 66fe8023 2023-01-18 op ttk::label .c.status.text -textvariable status
279 66fe8023 2023-01-18 op grid .c.status.text
281 66fe8023 2023-01-18 op grid [ttk::frame .c.bottom -borderwidth 2] -column 0 -row 4
282 66fe8023 2023-01-18 op ttk::label .c.bottom.cur_time -textvariable cur_time -padding "0 0 5 0"
283 66fe8023 2023-01-18 op ttk::scale .c.bottom.bar -orient horizontal -length 400 -command amused_seek
284 66fe8023 2023-01-18 op ttk::label .c.bottom.max_time -textvariable max_time -padding "5 0 0 0"
286 19cab05c 2023-01-18 op grid [ttk::frame .c.current -padding "0 5 0 0"] -column 0 -row 5
287 19cab05c 2023-01-18 op grid [ttk::label .c.current.title -textvariable cur_song]
289 66fe8023 2023-01-18 op grid .c.bottom.cur_time -column 0 -row 0
290 66fe8023 2023-01-18 op grid .c.bottom.bar -column 1 -row 0
291 66fe8023 2023-01-18 op grid .c.bottom.max_time -column 2 -row 0
293 66fe8023 2023-01-18 op # make resizing works
294 66fe8023 2023-01-18 op grid columnconfigure . 0 -weight 1
295 66fe8023 2023-01-18 op grid rowconfigure . 0 -weight 1
297 66fe8023 2023-01-18 op grid columnconfigure .c 0 -weight 1
298 66fe8023 2023-01-18 op grid rowconfigure .c 1 -weight 1
300 66fe8023 2023-01-18 op grid columnconfigure .c.main 0 -weight 1
301 66fe8023 2023-01-18 op grid rowconfigure .c.main 0 -weight 1
303 66fe8023 2023-01-18 op grid columnconfigure .c.bottom 1 -weight 1
304 66fe8023 2023-01-18 op grid rowconfigure .c.bottom 0 -weight 1
306 66fe8023 2023-01-18 op # init the state
308 66fe8023 2023-01-18 op set fd [open "|amused monitor" r]
309 66fe8023 2023-01-18 op fileevent $fd readable "handle_event $fd"
