#!/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

