#!/usr/opt/tcl/bin/tclsh8.6
# global Music
# Music = directory containing index.sqlite created with mkmusicdb.tcl
set Music Music ;# default
if {$argc} {set Music [lindex $argv 0]}
set DB [file join $Music index.sqlite]
if {![file isdirectory $Music]} {puts "$Music is not directory"; exit}
if {![file exists $DB]} {puts "$DB does exist"; exit}
# global STO
# appending a digit (0-9) to STO gives name of a file for storing playlist
set STO "./plistmusicsh"
package require sqlite3
sqlite3 db $DB -readonly 1 -create 0 ;# if file locking buggy: -vfs unix-none
db function regexp -argcount 2 -deterministic {regexp --}
db function match -argcount 2 -deterministic {match}
package require sound
snack::sound fsnd
snack::sound snd -channels Stereo
###################### Player #################################
# global key n N do start startsec mvflag
set usagePl {
Press to
--------------
ret see elapsed time : track length
up play previous in list
down play next in list
right play at 10 seconds forward
left play at 10 seconds backward
space pause or continue playing
q quit playing
--------------}
# Horrible hack to move forwards or backwards
proc sndmv {relsec} {
global do start startsec mvflag
snd pause; set elapsed [snack::audio elapsedTime]; snd stop
set lensec [snd length -u SECONDS]
set lensam [snd length]
set relsam [format %.0f [expr $lensam*$relsec/$lensec]]
set played [format %.0f [expr $lensam*$elapsed/$lensec]]
set start [expr $start+$played+$relsam]
if {$start < 0} {set start 0}
if {$start >= $lensam} {set start [expr $lensam-2]}
set startsec [expr $lensec*$start/$lensam]
set mvflag 1
set do $do}
# define callback for proc play
chan event stdin readable {
set key [binary encode hex [read stdin 1]]
set n [chan pending input stdin]
while {$n} {append key -[binary encode hex [read stdin 1]]; incr n -1}
switch -exact $key {
0a {puts $usagePl; puts "$do<$N:\
[expr $startsec+[snack::audio elapsedTime]] : [snd length -u SECONDS]"}
20 {snd pause
# above: ret, sp
# now: up, down, right, left, alt-right, alt-left, ctr-right, ctr-left
# then: q
}
1b-5b-41 {snd stop; if {$do} {incr do -1} else {set do 0}}
1b-5b-42 {snd stop; if {$do < $N-1} {incr do} else {set do $do}}
1b-5b-43 {sndmv 10}
1b-5b-44 {sndmv -10}
1b-5b-31-3b-33-43 {sndmv 60}
1b-5b-31-3b-33-44 {sndmv -60}
1b-5b-31-3b-35-43 {sndmv 300}
1b-5b-31-3b-35-44 {sndmv -300}
71 {snd stop; set do $N}
}}
proc play {files} {
global N do start startsec mvflag usagePl
puts $usagePl
set N [llength $files]; set do 0; set start 0; set startsec 0; set mvflag 0
# prepare stdin
set enc [fconfigure stdin -encoding]
fconfigure stdin -encoding binary -blocking 0
set ttyst [exec stty -g]
exec /bin/stty raw -echo <@stdin
# For every file wait for key press
while {$do < $N} {
snd stop ;# sets elapsedTime to 0
set file [lindex $files $do]
snd configure -file $file
set len [snd length -u SECONDS]
if {$mvflag} {set mvflag 0} else {set start 0; set startsec 0}
snd play -command "incr do" -start $start
puts "$do<$N:$file [format %.2f $startsec] : [format %.2f $len]"
vwait do}
snd stop
# reset stdin
exec /bin/stty -raw echo <@stdin
exec /bin/stty $ttyst <@stdin
fconfigure stdin -encoding $enc -blocking 1
return}
###################### Main Menu #############################
# global k file STO Music S cdid nid tr0 tr1 cdtxt cdp trtxt trp plist
## flute {tfl} to get feedback from monitorless computer
## tfl = list with alternating time in seconds and frequence
proc flute {tfl} {
set rate [fsnd cget -rate]
foreach {time freq} $tfl {
set len [format %0.f [expr $time*$rate]]
set fl [snack::filter generator $freq 30000 0.0 sine $len]
fsnd play -filter $fl -block 1
$fl destroy}
return}
# freq 264 275 297 317 330 352 367 396 422 440 475 495 528
# cdur do # re # mi fa # sol # la # si do
set S(rea) [list .5 264]
set S(ok) [list .1 264]
set S(done) [list .3 396] ;# when something changed
set S(err) [list .5 264 .5 528] ;# for caught tcl errors
set S(ko) [list .1 264 .1 528] ;# not ok, for bad input
set S(bye) [list .5 528]
# Gives hex bytes generated by a key press
proc readk {} {
set enc [fconfigure stdin -encoding]
fconfigure stdin -encoding binary
set ttyst [exec stty -g]
exec /bin/stty raw -echo <@stdin
set key [binary encode hex [read stdin 1]]
set n [chan pending input stdin]
while {$n} {append key -[binary encode hex [read stdin 1]]; incr n -1}
exec /bin/stty -raw echo <@stdin
exec /bin/stty $ttyst <@stdin
fconfigure stdin -encoding $enc
return $key}
proc reset {} {
global S cdid nid tr0 tr1 cdtxt cdp trtxt trp plist
foreach var [list cdid nid tr0 tr1 cdtxt cdp trtxt trp plist] {set $var ""}}
proc usage {} {
global S cdid nid tr0 tr1 cdtxt cdp trtxt trp
#set F [list F1 F2 F3 F4 F5 F6 F7 F8]
set L [list cdid nid tr0 tr1 cdtxt cdp trtxt trp]
puts "Press to enter\n--------------"
for {set i 0} {$i < 8} {incr i} {
set j [expr $i+1]
set var [lindex $L $i]
puts "F$j $var \[[set $var]\]"}
puts {
Press to
--------------
ret see search params
esc reset search params
v view playlist
s write playlist to file
r read playlist from file
o generate playlist
p play
^D quit}
return}
# reads stdin and sets $var to it if it is allowed type
proc enter {var} {
global S cdid nid tr0 tr1 cdtxt cdp trtxt trp
puts "$var = (enter value and press return)"
gets stdin val
if {[string range [binary encode hex [string index $val 0]] 0 1] eq "1b"} {
puts "Nothing changed"; flute $S(ok); return 1}
switch -exact $var {
cdid -
tr0 -
tr1 {if {![string is integer $val]} {
usage; flute $S(ko); return 0}}
nid {
set val [split [string trim $val] /]
foreach n $val {
if {![string is integer -strict $n] || $n < 1} {
usage; flute $S(ko); return 0}
lappend res [format %02d $n]}
set val [join $res /]}
default {}}
set $var $val
usage; flute $S(done); return 1}
# search db and puts result in plist if it finds something
# returns length of plist, perhaps an old plist.
proc genplist {} {
global S cdid nid tr0 tr1 cdtxt cdp trtxt trp plist
foreach var [list Cdid Nid Tr0 Tr1 Cdtxt Cdp Trtxt Trp] {set $var ""}
if {$cdid ne ""} {set Cdid "cdid=:cdid"}
if {$nid ne ""} {set nid2 "^$nid"; set Nid "nid regexp :nid2"}
if {$tr0 ne ""} {set Tr0 "trid >= :tr0"}
if {$tr1 ne ""} {set Tr1 "trid <= :tr1"}
if {$cdtxt ne ""} {set cdtxt2 "%$cdtxt%"; set Cdtxt "cdtxt like :cdtxt2"}
if {$cdp ne ""} {set Cdp "cdp regexp :cdp"}
if {$trtxt ne ""} {set trtxt2 "%$trtxt%"; set Trtxt "trtxt like :trtxt2"}
if {$trp ne ""} {set Trp "trp regexp :trp"}
set SQ [list]
foreach var [list Cdid Nid Tr0 Tr1 Cdtxt Cdp Trtxt Trp] {
if {[set $var] ne ""} {lappend SQ [set $var]}}
if {![llength $SQ]} {
puts "No parameter set"
flute $S(ko); return 0}
set SQ [join $SQ " AND "]
set SQ "SELECT trp FROM conc WHERE $SQ ORDER BY trid"
if {[catch {db eval $SQ} plistT]} {flute $S(err); return 0}
set fnd [llength $plistT]
if {!$fnd} {
puts "Nothing found"
flute $S(ko); return 0}
set plist $plistT
flute $S(done)
return $plist}
proc save {} {
global STO S plist
puts "Enter playlist number (0-9):"
set k [readk]
if {![string is integer -strict $k] || $k < 30 || $k > 39 } {
puts "Not number between 0 and 9, playlist not saved"
flute $S(ko); return 0}
incr k -30
if {[catch {open $STO$k w} fd]} {
puts "Could not open $STO$k, playlist not saved"
flute $S(err); return 0}
foreach track $plist {puts $fd $track}
close $fd
flute $S(done); return 1}
proc restore {} {
global STO S plist
puts "Enter playlist number (0-9):"
set k [readk]
if {![string is integer -strict $k] || $k < 30 || $k > 39 } {
puts "Not number between 0 and 9, playlist not set"
flute $S(ko); return 0}
incr k -30
if {[catch {open $STO$k r} fd]} {
puts "Could not open $STO$k, playlist not set"
flute $S(err); return 0}
set plist [split [read -nonewline $fd] \n]
close $fd
flute $S(done); return 1}
proc mfiles {plist} {
global Music
set res [list]
foreach file $plist {lappend res [file join $Music $file]}
return $res}
reset; usage; flute $S(rea)
while {[set k [readk]] ne 04} {
switch -exact $k {
1b-4f-50 {enter cdid}
1b-4f-51 {enter nid}
1b-4f-52 {enter tr0}
1b-4f-53 {enter tr1}
1b-5b-31-35-7e {enter cdtxt}
1b-5b-31-37-7e {enter cdp}
1b-5b-31-38-7e {enter trtxt}
1b-5b-31-39-7e {enter trp}
0a {usage; flute $S(ok)}
1b {reset; usage; flute $S(rea)}
76 {foreach file $plist {puts $file}}
73 {save}
72 {restore}
6f {genplist}
70 {play [mfiles $plist]; usage; fsnd play; fsnd stop}
}}
# Without "fsnd play; fsnd stop" flute does not sound after playing corrupted
# file. For unknown reason.
db close
snd destroy
flute $S(bye)
fsnd destroy