/usr/share/doc/tcl-snack-doc/examples/tcl/tomAmp.tcl is in tcl-snack-doc 2.2.10.20090623-dfsg-4.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 | #!/bin/sh
# the next line restarts using wish \
exec wish8.5 "$0" "$@"
# derived from Snack snamp.tcl demo player by Tom Wilkason
#
global taFiles tomAmp
set tomAmp(settingsFile) "~/.tomAmpDefaults"
set tomAmp(cacheFile) "~/.tomAmpCache"
set tomAmp(defaultFolderFile) "~/default.tafs"
set tomAmp(Console) 0
set tomAmp(p) 0
set tomAmp(pause) 0
set tomAmp(elapsed) 0
set tomAmp(current) {}
set tomAmp(currentMP3) {}
;# Setup sound settings
package require -exact snack 2.2
# Buttons
option add *font {Helvetica 10 bold}
option add *Button.activeBackground yellow
option add *Button.borderwidth 1
option add *Button.relief raised
option add *Entry.background lightyellow
option add *Entry.foreground black
option add *Entry.font {Helvetica 9 bold}
option add *Entry.relief sunken
#option add *Entry.borderwidth 2
option add *Label.font {Helvetica 9 bold}
option add *Listbox.background black
option add *Listbox.foreground green
option add *Listbox.font {Helvetica 9 bold}
if {$::tcl_platform(os) == "Linux"} {
option add *Scale.font {Helvetica 8}
} else {
option add *Scale.font {Helvetica 7}
}
option add *Scale.activebackground blue
option add *troughcolor black
snack::debug 0
snack::sound s -debug 0
snack::audio playLatency 1200
###############################################################################
# Function : buildGui
# Description: Build the player Gui
# Author : Tom Wilkason
# Date : 12/27/2000
###############################################################################
proc buildGui {args} {
global tomAmp taFiles LB SS
set tomAmp(timestr) "Snack MP3 Player"
wm title . "SnackAmp MPEG Player"
wm protocol . WM_DELETE_WINDOW exit
;##
;# Control Panel
;#
pack [frame .panel -borderwidth 2 -relief ridge] -side top -fill x -expand false -anchor w
;# Display name and current status
label .panel.l -background black -foreground green -borderwidth 2 -relief ridge \
-font {Helvetica 12 bold} -height 4 -textvar tomAmp(timestr) -wraplength 550
set tomAmp(Mute) 0
bind .panel.l <ButtonPress-1> {toggleMute .panel.l}
grid .panel.l -row 0 -column 1 -columnspan 2 -sticky ew
snack::createIcons
grid [frame .panel.player -borderwidth 2 -relief ridge] -row 1 -column 1 -sticky news
;# Amp controls
pack [button .panel.player.prev -bitmap snackPlayPrev -command Prev] -side left
balloon .panel.player.prev "Play previous in list"
pack [button .panel.player.bp -bitmap snackPlay -command Play] -side left
balloon .panel.player.bp "Play Selection"
pack [button .panel.player.pause -bitmap snackPause -command {Pause}] -side left
balloon .panel.player.pause "Pause/Resume playback"
proc pauseRelief {down} {
global tomAmp
if {$down} {
.panel.player.pause configure -relief sunken
} else {
.panel.player.pause configure -relief raised
} ;# end if
set tomAmp(pause) $down
}
pack [button .panel.player.bs -bitmap snackStop -command Stop] -side left
balloon .panel.player.bs "Stop playing"
pack [button .panel.player.next -bitmap snackPlayNext -command Next] -side left
balloon .panel.player.next "Play next in list"
pack [button .panel.player.bo -image snackOpen -command OpenFile] -side left
balloon .panel.player.bo "Add a file to play list"
;# Offset within file
set SS [scale .panel.ss -show yes -orient horiz -width 10 -len 250 -from 0. -to 60. \
-var tomAmp(p) -tickinterval 30 -sliderlength 15 -relief ridge -borderwidth 2 \
-activebackground blue -troughcolor black]
balloon $SS "Show/Adjust playback location within file"
grid $SS -column 2 -row 1 -sticky ew
;# Sound level
set tomAmp(gain) [snack::audio play_gain]
scale .panel.sv -show no -orient vert -width 10 -command {snack::audio play_gain}\
-len 85 -var tomAmp(gain) -from 130. -to 0. -sliderlength 15 \
-activebackground blue -troughcolor black
grid .panel.sv -column 0 -row 0 -rowspan 3 -sticky ns
balloon .panel.sv "Adjust the playback level"
# Adjust grid resize behavior
grid columnconfigure .panel 0 -weight 0
grid columnconfigure .panel 1 -weight 0
grid columnconfigure .panel 2 -weight 1
;# Allow time to be addjusted
set tomAmp(setdrag) 1
bind $SS <ButtonPress-1> {set tomAmp(setdrag) 0}
bind $SS <ButtonRelease-1> {set tomAmp(setdrag) 1 ; PlayOffset}
;# Collapsable frame
set CF [cframe .hull "MP3 Files"]
pack .hull -side top -fill both -expand true
cframe.close $CF
;# Filter box
pack [frame $CF.filter -borderwidth 2 -relief ridge] -side top -expand no -fill x
pack [label $CF.filter.label -text "Filter Selection"] -side left -expand no -fill x
pack [entry $CF.filter.entry -textvariable tomAmp(filter) -width 50] -side left -expand no -fill x
bind $CF.filter.entry <Return> "filterMusic"
bind $CF.filter.entry <Double-1> {set tomAmp(filter) "";filterMusic}
balloon $CF.filter.entry "Enter text to restrict files to play,\nEnter or 'Replace' to replace list\n'Append' to add to bottom of current list\nDouble-click to clear"
;# Append/Replace buttons for filter
pack [button $CF.filter.btApp -text "Append" -command {filterMusic append} -pady 0] -side left
balloon $CF.filter.btApp "Modify the filter box and then press this to append files to files below"
pack [button $CF.filter.btRep -text "Replace" -command {filterMusic replace} -pady 0] -side left
balloon $CF.filter.btApp "Modify the filter box and then press this to replace list below with newly filtered files"
;##
;# Scrolled Listbox
;#
set LB [Scrolled_Listbox $CF.frame -selectmode extended -exportselection no -height 20 \
-background black -foreground green -font {Helvetica 9 bold}]
pack $CF.frame -side top -expand yes -fill both
# set w $LB
# Listbox popup menu
set m $LB.popup
menu $m -tearoff 0
$m add command -label "Play" -command {Play}
$m add command -label "Remove" -command {Cut}
$m add command -label "Delete from Disk" -command {Delete}
$m add command -label "Append to Config File" -command {}
bind $LB <ButtonPress-3> {
tk_popup %W.popup %X %Y
}
# Bindings
bind $LB <Double-ButtonPress-1> Play
bind $LB <B1-Motion> {Drag %y}
bind $LB <ButtonPress-1> {focus %W;Select %y}
bind $LB <BackSpace> Cut
bind $LB <Delete> Cut
;# Entry box to allow renaming of current selection
pack [frame $CF.fname] -side top -expand no -fill x
pack [label $CF.fname.fname -textvariable tomAmp(fullName) -justify left -borderwidth 2 -relief ridge] -side top -expand no -fill x
pack [entry $CF.fname.name -textvariable tomAmp(entryName) ] -side top -expand false -fill x
balloon $CF.fname.name "Change the file name here and press enter when complete"
bind $CF.fname.name <Return> {
if {$tomAmp(entryName) != $tomAmp(origEntryName)} {
if {$tomAmp(currentMP3)==$taFiles($tomAmp(origEntryName))} {
Stop
s destroy
snack::sound s
} ;# end if
set newFileName [file join [file dirname $taFiles($tomAmp(origEntryName))] $tomAmp(entryName)]
# puts "$tomAmp(entryName) vs $tomAmp(origEntryName) -> '$newFileName'"
file rename -force $taFiles($tomAmp(origEntryName)) $newFileName
unset taFiles($tomAmp(origEntryName))
set tomAmp(origEntryName) $tomAmp(entryName)
set taFiles($tomAmp(entryName)) $newFileName
$LB delete $tomAmp(entryIndex)
;# Insert either with or without folder name
$LB insert $tomAmp(entryIndex) $tomAmp(entryName)
Highlight $tomAmp(entryIndex)
} ;# end if
}
InstallMenu
}
proc Scrolled_Listbox { f args } {
frame $f
listbox $f.list \
-xscrollcommand [list Scrolled_Listbox.set $f.xscroll [list grid $f.xscroll -row 1 -column 0 -sticky news]] \
-yscrollcommand [list Scrolled_Listbox.set $f.yscroll [list grid $f.yscroll -row 0 -column 1 -sticky news]]
eval {$f.list configure} $args
scrollbar $f.xscroll -orient horizontal -command [list $f.list xview]
scrollbar $f.yscroll -orient vertical -command [list $f.list yview]
grid $f.list -sticky news
;##
;# Only the data should expand, not the scroll bars
;#
grid rowconfigure $f 0 -weight 1
grid columnconfigure $f 0 -weight 1
;##
;# Modify to not resize when the scroll bars go away (make a minimum size)
;#
grid columnconfigure $f 1 -minsize 18
grid rowconfigure $f 1 -minsize 18
return $f.list
}
#******************************************************#
# Function : Scroll_set
# Description: callback for the scroll list box, hide
# scroll bars if they aren't needed
# Author : Tom Wilkason
# Date : 6/4/1999
#*******************************************************#
proc Scrolled_Listbox.set {scrollbar geoCmd offset size} {
if {$offset != 0.0 || $size != 1.0} {
eval $geoCmd
$scrollbar set $offset $size
} else {
set manager [lindex $geoCmd 0]
$manager forget $scrollbar
} ;# end if
}
;##
;# Build the menu bar at the top of the GUI
;#
proc InstallMenu {} {
global taFiles tomAmp LB tomAmpSettings tcl_platform
set M .bRmenubar
catch {menu $M}
# attach it to the main window
. config -menu $M
# Create more cascade menus
foreach m {File Play-Lists Folders Settings Help} {
if {$m == "Play-Lists"} {
set $m [menu $M.m$m -postcommand [list configFiles $M.m$m]]
$M.m$m add command -label "Clear" -command {Clear}
$M.m$m add command -label "Save..." -command {SavePlaylistFile}
$M.m$m add separator
$M.m$m add cascade -label "Append" -menu [menu $M.m$m.mAppend -tearoff 0]
$M.m$m add cascade -label "Replace" -menu [menu $M.m$m.mReplace -tearoff 0]
} else {
set $m [menu $M.m$m]
}
$M add cascade -label $m -menu $M.m$m
}
$Folders add command -label "Clear All" -command {
global taFolders
foreach {item} [array name taFolders *] {
set taFolders($item) 0
} ;# end foreach
filterMusic
}
$Folders add command -label "Set All" -command {
global taFolders
foreach {item} [array name taFolders *] {
set taFolders($item) 1
} ;# end foreach
filterMusic
}
$Folders add command -label "Save Folder List..." -command {SaveFolderFile}
$Folders add cascade -label "Folder Lists..." -menu [menu $Folders.settings -tearoff 0 -postcommand [list folderFiles $Folders.settings]]
$Folders add separator
set tomAmp(FolderMenu) $Folders
set tomAmp(FolderSettings) $Folders.settings
$File add command -label "Add a file to playlist" -command {OpenFile}
$File add command -label "Rescan Folders" -command {Rescan}
$File add separator
$File add command -label "Exit" -command {exit}
if {$tcl_platform(platform) == "windows"} {
$Settings add check -label "Show Console" -variable tomAmp(Console) -command Console
$Settings add separator
} ;# end if
$Settings add check -label "Random Play" -variable tomAmpSettings(randomPlay) -command filterMusic
$Settings add check -label "Continuous Play" -variable tomAmpSettings(ContinuousPlay)
$Settings add check -label "Rescan Folders on Startup" -variable tomAmpSettings(AutoRescan)
$Settings add check -label "Show folder names with files" -variable tomAmpSettings(ShowFolder) -command showFolders
$Settings add check -label "Monitor base folders for new files" -variable tomAmpSettings(MonitorFolders) -command MonitorFolders
$Settings add separator
$Settings add command -label "Set Defaults" -command settingsGui
}
###############################################################################
# Function : Console
# Description: Toggle the console for debugging purposes (WIN32 only)
# Author : Tom Wilkason
# Date : 12/27/2000
###############################################################################
proc Console {args} {
global taFiles tomAmp LB
if {$tomAmp(Console)==0} {
console hide
} else {
console show
}
}
;##
;# Callback to show config files on menu, called from postcommand
;#
proc configFiles {menu} {
global taFiles tomAmp LB
# Rescan
if {[catch {set Files [glob ~/*.taf]} result]} {
return
}
$menu.mAppend delete 0 end
$menu.mReplace delete 0 end
;##
;# Need to sort the list by decending date
;#
foreach File $Files {
set Date [file mtime $File]
lappend FileList [list $File $Date]
}
set FileList [lsort -index 1 -decreasing $FileList]
foreach {File} $FileList {
;##
;# Pull out only the file name and add it to the menu
;#
set F [lindex $File 0]
$menu.mAppend add command -label "[file tail $F]" -command [list ReadPlaylistFile $F "append"]
$menu.mReplace add command -label "[file tail $F]" -command [list ReadPlaylistFile $F "replace"]
}
}
;##
;# Callback to show folder setting files
;#
proc folderFiles {menu} {
global taFiles tomAmp LB
# Rescan
if {[catch {set Files [glob ~/*.tafs]} result]} {
return
}
$menu delete 0 end
;##
;# Need to sort the list by decending date
;#
foreach File $Files {
set Date [file mtime $File]
lappend FileList [list $File $Date]
}
set FileList [lsort -index 1 -decreasing $FileList]
foreach {File} $FileList {
;##
;# Pull out only the file name and add it to the menu
;#
set F [lindex $File 0]
$menu add command -label "[file tail $F]" -command [list ReadFolderFile $F]
}
}
###############################################################################
# Function : toggleMute
# Description: Toggle muting of sound, bound to click on main label
# Author : Tom Wilkason
# Date : 12/31/2000
###############################################################################
proc toggleMute {widget} {
global tomAmp
if {$tomAmp(Mute)} {
set tomAmp(Mute) 0
$widget configure -foreground green
snack::audio play_gain $tomAmp(saveGain)
} else {
set tomAmp(Mute) 1
set tomAmp(saveGain) [snack::audio play_gain]
snack::audio play_gain 0
$widget configure -foreground red
} ;# end if
set tomAmp(saveMute) $tomAmp(Mute)
}
###############################################################################
# Function : settingsGui
# Description: Small GUI to allow the user to set the defaults
# Author : Tom Wilkason
# Date : 12/30/2000
###############################################################################
proc settingsGui {args} {
global taFiles tomAmp LB tomAmpSettings
set B .settings
toplevel $B
set i 0
grid [label $B.[incr i] -text "Please set the defaults below and press OK to save\nRescan folders if you change them here" ]\
-columnspan 2
grid [frame $B.[incr i] -height 2 -borderwidth 2 -relief sunken] -columnspan 2 -sticky nsew
#----------------------------------------------------------------------------------------------
grid [label $B.[incr i] -text "List of base directories to scan" -justify left] \
[entry $B.[incr i] -textvariable tomAmpSettings(mediaDirs) -width 50] -sticky ew
grid [label $B.[incr i] -text "Start with random play" -justify left] \
[checkbutton $B.[incr i] -variable tomAmpSettings(randomPlay)] -sticky ew
grid [label $B.[incr i] -text "Continuous Play Mode" -justify left] \
[checkbutton $B.[incr i] -variable tomAmpSettings(ContinuousPlay)] -sticky ew
grid [label $B.[incr i] -text "Rescan Folders on Startup" -justify left] \
[checkbutton $B.[incr i] -variable tomAmpSettings(AutoRescan)] -sticky ew
grid [label $B.[incr i] -text "Show folder names with song names" -justify left] \
[checkbutton $B.[incr i] -variable tomAmpSettings(ShowFolder)] -sticky ew
grid [label $B.[incr i] -text "Monitor base folders for changes" -justify left] \
[checkbutton $B.[incr i] -variable tomAmpSettings(MonitorFolders)] -sticky ew
grid [label $B.[incr i] -text "Folder level to show on Folder Menu" -justify left] \
[entry $B.[incr i] -textvariable tomAmpSettings(FolderDepth)] -sticky ew
grid [label $B.[incr i] -text "Subfolders to show in Song List" -justify left] \
[entry $B.[incr i] -textvariable tomAmpSettings(ListDepth)] -sticky ew
#----------------------------------------------------------------------------------------------
grid [frame $B.[incr i] -height 2 -borderwidth 2 -relief sunken] -columnspan 2 -sticky nsew
grid [button $B.[incr i] -text "OK" -command saveSettings] \
[button $B.[incr i] -text "Cancel" -command {destroy .settings}]
after idle raise $B
}
###############################################################################
# Function : saveSettings
# Description: Save the settings from the settingsGui
# Author : Tom Wilkason
# Date : 12/30/2000
###############################################################################
proc saveSettings {args} {
global tomAmpSettings tomAmp
set fid [open $tomAmp(settingsFile) w]
puts $fid [array get tomAmpSettings]
close $fid
destroy .settings
MonitorFolders
}
###############################################################################
# Function : MonitorFolders
# Description: Monitor the base folders for incoming data, useful
# for napaster adding files.
# Author : Tom Wilkason
# Date : 12/30/2000
###############################################################################
proc MonitorFolders {args} {
global tomAmpSettings tomAmp
if {$tomAmpSettings(MonitorFolders)} {
foreach {Folder} $tomAmpSettings(mediaDirs) {
;# First time will be empty
set tomAmp($Folder,thisData) [glob -nocomplain [file join $Folder *.mp3]]
if {![info exists tomAmp($Folder,lastData)]} {
set tomAmp($Folder,lastData) $tomAmp($Folder,thisData)
} elseif {$tomAmp($Folder,lastData) != $tomAmp($Folder,thisData)} {
puts "Changes detected"
foreach {item} $tomAmp($Folder,thisData) {
if {[lsearch $tomAmp($Folder,lastData) $item] < 0} {
Append $item
puts "Detected new file $item"
} ;# end if
} ;# end foreach
set tomAmp($Folder,lastData) $tomAmp($Folder,thisData)
} ;# end if
} ;# end foreach
after cancel MonitorFolders
after 5000 MonitorFolders
}
}
;##
;# Read the default settings from the user home dir
;#
proc readSettings {args} {
global tomAmpSettings tomAmp
set tomAmpSettings(mediaDirs) ~/mp3
set tomAmpSettings(randomPlay) 0
set tomAmpSettings(ContinuousPlay) 1
set tomAmpSettings(AutoRescan) 0
set tomAmpSettings(ShowFolder) 0
set tomAmpSettings(MonitorFolders) 0
set tomAmpSettings(ListDepth) 10 ;# Will show last folder
set tomAmpSettings(FolderDepth) 10 ;# Will show last folder
if {[catch {
set fid [open $tomAmp(settingsFile) r]
array set tomAmpSettings [read $fid]
} result]} {
settingsGui
} else {
close $fid
}
}
;##
;# Save the current folder settings to a file
;#
proc SaveFolderFile {args} {
global taFiles tomAmp LB taFolders
;##
;# If a list for GlobData is passed in, the second item should be the name to save as (if different)
;#
set types [list [list "Tom Amp Files" .tafs] [list "All Files" "*"]]
set fName [tk_getSaveFile -title "Save Folder Setting File" -filetypes $types \
-initialdir ~ -defaultextension tafs]
catch {focus $ThisWin}
if { $fName == "" } {
return ""
}
if {[catch {open $fName w} InFile]} {
return -code error "Save Error: Unable to open '$fName' for writing\n"
}
if {$InFile!=0} {
foreach {File} [array names taFolders] {
puts $InFile [list $File $taFolders($File)]
} ;# end foreach
close $InFile
return $fName
} else {
return -1
}
}
;##
;# Read a file and change the favorate folders
;#
proc ReadFolderFile {fName} {
global taFolders
if {[file exists $fName]} {
set fid [open $fName r]
set full [split [read $fid] \n]
;# Insert the files if they are not already in the list
foreach line $full {
set taFolders([lindex $line 0]) [lindex $line 1]
} ;# end foreach
close $fid
} ;# end if
filterMusic
}
;##
;# Save current files in list
;#
proc SavePlaylistFile {args} {
global taFiles tomAmp LB
;##
;# If a list for GlobData is passed in, the second item should be the name to save as (if different)
;#
set types [list [list "Tom Amp Files" .taf] [list "All Files" "*"]]
set fName [tk_getSaveFile -title "Save Configuration File" -filetypes $types \
-initialdir ~ -defaultextension taf]
catch {focus $ThisWin}
if { $fName == "" } {
return ""
}
if {[catch {open $fName w} InFile]} {
return -code error "Save Error: Unable to open '$fName' for writing\n"
}
if {$InFile!=0} {
foreach {File} [getSelection 0 end] {
puts $InFile $taFiles($File)
} ;# end foreach
close $InFile
return $fName
} else {
return -1
}
}
;##
;# Read a file and append/replace current list
;#
proc ReadPlaylistFile {fName {how "replace"}} {
global taFiles tomAmp LB tomAmpSettings
set fid [open $fName r]
set full [split [read $fid] \n]
if {$how == "replace"} {
$LB delete 0 end
} ;# end if
;# Insert the files if they are not already in the list
foreach file $full {
if {[file exists $file]} {
set name [getListName $file]
$LB insert end $name
set taFiles($name) $file
} ;# end if
} ;# end foreach
close $fid
}
###############################################################################
# Function : Clear
# Description: Clear the playlist
# Author : Tom Wilkason
# Date : 12/27/2000
###############################################################################
proc Clear {args} {
global taFiles tomAmp LB
# catch {unset taFiles} result
$LB delete 0 end
}
;##
;# Open a single file for playing, add to play list (should we play immed?)
;#
proc OpenFile {} {
global taFiles tomAmp LB
set file [snack::getOpenFile -format MP3]
if {$file != ""} {
Append $file
}
}
;# Play a list item.
proc Play {{offset 0}} {
global taFiles tomAmp LB SS
if {[$LB index active] == ""} {
set i 0
} else {
set i [$LB index active]
}
;# Note: Using current selection causes a problem if the song didn't change
;# but the selection did an time scale change that changes the time.
# if no offset specified then see if random play
Highlight $i
Stop
;# Check file existance
set Selection [getSelection $i]
if {$Selection!={}} {
if {! [file exists $taFiles($Selection)]} {
after 10 Next
return
} ;# end if
set errorInfo ""
;##
;# It seems faster on play -start to have the short file name and cd to that directory
;# Also, UNC names are really slow (on Win2K anyway)!
;# Strangly, network drive mappings are also fast (if not using UNC)
;#
set tomAmp(currentMP3) $taFiles($Selection)
cd [file dirname $taFiles($Selection)]
s config -file $Selection
# length samprate "maximum sample" "minimum sample" "STRencoding" "number of channels" "file format" "header size in bytes"
set Info [s info]
;# This can check for an invalid header
if {[lindex $Info 0] == -1} {
puts stderr "Invalid file: $taFiles($Selection)\n $Info"
set tomAmp(timestr) "Invalid header for:\n$Selection"
update
after 10 Next
return
} else {
#puts "OK: $taFiles($Selection)\n $Info"
#update
}
;# See if user changed the slider to adjust where to play
if {$offset == 0} {
s play -command Next ;# After complete call 'Next' function
} else {
;# Fires Next command at end of this file
s play -start $offset -command Next
}
;# What ~10 ticks on 5 or multiple sec intervals
set trackTime [s length -units SECONDS]
set Interval [expr {(round($trackTime/10)/5)*5}]
if {$Interval == 0} {
set interval 5
} ;# end if
$SS configure -to $trackTime -tickinterval $Interval
set songTitle [file root $Selection]
wm title . "$songTitle"
set tomAmp(current) $songTitle
file stat $tomAmp(currentMP3) Stat
append tomAmp(current) " - ($Stat(size))"
balloon .panel.l "$taFiles($Selection)"
Timer
}
}
;##
;# Play next sound file in list
;#
proc Next {} {
global taFiles tomAmp LB tomAmpSettings
catch {
# puts "$tomAmp(elapsed) of [s length -units sec] - $tomAmp(current)"
}
set i [$LB index active]
if {$i == ""} {
set i 0
} else {
incr i
}
;# check for continouos play
if {$i >= [$LB index end]} {
if {$tomAmpSettings(ContinuousPlay)} {
set i 0
} else {
return
}
} ;# end if
Highlight $i
after 10 Play
}
;##
;# Play previous sound file in list
;#
proc Prev {} {
global taFiles tomAmp LB tomAmpSettings
set i [$LB index active]
if {$i == ""} {
set i 0
} elseif {$i==0} {
set i [$LB index end]
} else {
if {$i > 0} {
incr i -1
} ;# end if
}
Highlight $i
after 10 Play
}
;##
;# Play a mp3 at some offset, likely bound to slider control
;#
proc PlayOffset {{manual 0}} {
global taFiles tomAmp LB
;# Make sure we have an open file
if {[s length] > 0} {
Stop
;# Some files are fast and some are slow to respond to -start = 0
if {$manual == 0} {
set offset [expr {int(double($tomAmp(p))/[s length -units sec]*[s length])}]
} else {
set offset $manual
}
s play -start $offset -command Next
Timer
} ;# end if
}
###############################################################################
# Function : Highlight
# Description: Highlight only one selection
# Author : Tom Wilkason
# Date : 12/27/2000
###############################################################################
proc Highlight {i} {
global taFiles tomAmp LB
$LB selection clear 0 end
$LB selection set $i
$LB activate $i
$LB see $i
set Entry [getSelection $i]
catch {
set tomAmp(entryName) $Entry
set tomAmp(fullName) [file dirname $taFiles($Entry)]
}
}
###############################################################################
# Function : getSelection
# Description: Return the selection(s) with no folder names (for index use)
# Author : Tom Wilkason
# Date : 1/1/2001
###############################################################################
proc getSelection {start {end ""}} {
global LB
if {$end==""} {
return [file tail [$LB get $start]]
} else {
foreach {item} [$LB get $start $end] {
lappend result [file tail $item]
} ;# end foreach
return $result
} ;# end if
}
proc showFolders {args} {
global LB tomAmpSettings taFiles
foreach {item} [getSelection 0 end] {
lappend insertList [getListName $taFiles($item)]
}
$LB delete 0 end
if {[llength $insertList] > 0} {
eval $LB insert end $insertList
}
}
;##
;# Apend a file to the bottom of the play list
;#
proc Append {file} {
global taFiles tomAmp LB
set name [file tail $file]
if {$file != "" && ![info exists taFiles($name)]} {
$LB insert end $name
set taFiles($name) $file
} ;# end if
}
;##
;# Stop playback of a file and cancle the update timer
;#
proc Stop {} {
global taFiles tomAmp LB
pauseRelief 0
s stop
after cancel Timer
}
;##
;# Pause/resume playback
;#
proc Pause {args} {
global taFiles tomAmp LB
s pause
if {$tomAmp(pause)} {
pauseRelief 0
Timer
} else {
pauseRelief 1
after cancel Timer
}
set tomAmp(savePause) $tomAmp(pause)
}
;##
;# Timer to update the display data, active while MP3 playing
;#
proc Timer {} {
global taFiles tomAmp LB SS
# Time is curren pos/total len * total time
# set elapsed [expr {round(double([s current_position])/[s length]*[s length -units sec])}]
set elapsed [expr {round([s current_position -units sec])}]
set tomAmp(elapsed) $elapsed
set tomAmp(timestr) "$tomAmp(current)\n[clock format $elapsed -format %M:%S] of [clock format [expr {int([s length -units sec])}] -format %M:%S]"
;# If user dragging slider, don't also try to set slider
if $tomAmp(setdrag) {
catch {
$SS set $elapsed
}
}
# Draw
after 500 Timer
}
;##
;# GUI Bindings
;#
proc Cut {} {
global taFiles tomAmp LB
if {[$LB curselection] != ""} {
set Index [$LB index active]
if {$Index} {incr Index -1}
foreach {ind} [lsort -decreasing [$LB curselection]] {
set cut [getSelection $ind]
unset taFiles($cut)
$LB delete $ind
} ;# end foreach
Highlight $Index
}
}
;##
;# Callback to remove the current selections from the display
;#
proc Delete {} {
global taFiles tomAmp LB
if {[$LB curselection] != ""} {
set Index [$LB index active]
if {$Index} {incr Index -1}
foreach {ind} [lsort -decreasing [$LB curselection]] {
set File [getSelection $ind]
if {$tomAmp(currentMP3)==$taFiles($File)} {
Stop
s destroy
snack::sound s
} ;# end if
file delete $taFiles($File)
unset taFiles($File)
$LB delete $ind
} ;# end foreach
Highlight $Index
}
}
;##
;# Select/Drag
;#
proc Select y {
global taFiles tomAmp LB
set tomAmp(old) [$LB nearest $y]
set Value [$LB get $tomAmp(old)]
if {$Value != {}} {
set tomAmp(entryName) [file tail $Value]
set tomAmp(fullName) [file dirname $taFiles([file tail $Value])]
set tomAmp(origEntryName) [file tail $Value] ;# for renaming
set tomAmp(entryIndex) $tomAmp(old)
} ;# end if
}
proc Drag y {
global taFiles tomAmp LB
set new [$LB nearest $y]
if {$new == -1} return
set tmp [$LB get $tomAmp(old)]
$LB delete $tomAmp(old)
$LB insert $new $tmp
$LB selection set $new
set tomAmp(old) $new
}
###############################################################################
# Function : filterMusic
# Description: Restrict files shown based on the filter & folder settings
# Author : Tom Wilkason
# Date : 12/26/2000
###############################################################################
proc filterMusic {{how replace}} {
global taFiles tomAmp LB tomAmpSettings taFolders
if {$how == "replace"} {
$LB delete 0 end
} ;# end if
set insertList [list]
;# Below will prevent duplicates due to hashing
foreach {File} [array names taFiles *] {
if {$File != "" && [string match -nocase "*$tomAmp(filter)*" $taFiles($File)]} {
;# Verify this file is in a checked folder
if {[catch {
# See if this file matches folder menu entry
if {$taFolders([getFolderName [file dirname $taFiles($File)]])} {
set File [getListName $taFiles($File)]
lappend insertList $File
} ;# end if
} result]} {
puts stderr $result
}
} ;# end if
} ;# end foreach
;# Shuffle if needed
if {$tomAmpSettings(randomPlay)} {
set insertList [shuffle $insertList]
} else {
set insertList [lsort -dictionary $insertList]
}
if {[llength $insertList] > 0} {
eval $LB insert end $insertList
} ;# end if
Highlight 0
}
;##
;# Shuffle a list, used to randomize play list
;#
proc shuffle {list} {
set tmp [list]
foreach item $list {
lappend tmp [list $item [expr {rand()}]]
}
set res [list]
foreach item [lsort -real -index 1 $tmp] {
foreach {orig num} $item {
lappend res $orig
} ;# end foreach
}
return $res
}
###############################################################################
# Function : getListName
# Description: Return a song name with the appropriate folders prepended
# Author : Tom Wilkason
# Date : 1/3/2001
###############################################################################
proc getListName {File} {
global tomAmpSettings
set File [string map {// /} $File] ;# remove UNC stuff
if {$tomAmpSettings(ShowFolder)} {
set parts [lrange [file split $File] end-$tomAmpSettings(ListDepth) end]
set name [join $parts /]
} else {
set name [file tail $File]
}
return $name
}
###############################################################################
# Function : getListName
# Description: Return a folder name with the appropriate depth away from base
# Author : Tom Wilkason
# Date : 1/3/2001
###############################################################################
proc getFolderName {File} {
global tomAmpSettings
set File [string map {// /} $File] ;# remove UNC stuff
set parts [file split $File]
set len [llength $parts]
if {$tomAmpSettings(FolderDepth) >= $len} {
set name [lindex $parts end]
} else {
set name [lindex $parts $tomAmpSettings(FolderDepth)]
}
# puts "getFolderName:($tomAmpSettings(FolderDepth)) $name - $File"
return $name
}
###############################################################################
# Function : buildFolderMenu
# Description: Build the folder menu base on folder names in taFolders
# Author : Tom Wilkason
# Date : 12/26/2000
###############################################################################
proc buildFolderMenu {args} {
global taFiles tomAmp LB tomAmpSettings taFolders
$LB delete 0 end
# Remove after the last fixed menu
$tomAmp(FolderMenu) delete 5 end
$tomAmp(FolderMenu) add separator
foreach {folder} [lsort -dictionary [array names taFolders *]] {
$tomAmp(FolderMenu) add check -label "$folder" -variable taFolders($folder) -command filterMusic
} ;# end foreach
}
###############################################################################
# Function : Rescan
# Description: Reread the directories for files, include subdirectories
# For each folder, add a menu entry
# Author : Tom Wilkason
# Date : 12/26/2000
###############################################################################
proc Rescan {args} {
global taFiles tomAmp LB tomAmpSettings taFolders
set here [pwd]
catch {unset taFiles} result
;# save folder settings
catch {array set saveTaFolders [array get taFolders]}
catch {unset taFolders} result
foreach dir $tomAmpSettings(mediaDirs) {
# set taFolders([file tail $dir]) 1
set taFolders([getFolderName $dir]) 1
Rescan.getRecurseFiles $dir
} ;# end foreach
;# Restore folder settings
foreach {index dir} [array get taFolders] {
if {[info exists saveTaFolders($index)]} {
set taFolders($index) $saveTaFolders($index)
}
} ;# end foreach
;##
;# Build the folder list for the menu
;#
buildFolderMenu
filterMusic
;##
;# Save the settings
;#
set fid [open $tomAmp(cacheFile) w]
puts $fid [array get taFiles]
puts $fid [array get taFolders]
close $fid
}
;##
;# Recursively scan a directory and build a list of all files
;#
proc Rescan.getRecurseFiles {dir} {
global taFiles tomAmp LB taFolders
set dirList [list]
set fileCount 0
foreach file [glob -nocomplain [file join $dir *]] {
if {[file isdirectory $file]} {
lappend dirList $file
} else {
if {[string match -nocase "*.mp3" $file]} {
set name [file tail $file]
set taFiles($name) [file join $dir $file]
incr fileCount
} ;# end if
}
}
;# If this dir contained files, the create a menu entry for it
if {$fileCount} {
set taFolders([getFolderName $dir]) 1 ;# checkbox on menu
} ;# end if
;# process each directory recursively
foreach {file} $dirList {
Rescan.getRecurseFiles [file join $dir $file]
} ;# end foreach
}
;####################################################################################
;# C O L L A P S A B L E F R A M E
;####################################################################################
;# cframe: Collapsable frame
;# base: name of outer collapsable frame, user is responsible for packing
;# text: title for the window frame, next to collapse button
;# args: additional user settings passed to inner frame
;# returns hull: user can pack into this frame
;#
proc cframe {base text args} {
#-----------------------------------------------------------
# Add the widget to the parent.
#-----------------------------------------------------------
# create button icons
image create photo im_Close -data {
R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADNhi63BMg
yinFAy0HC3Xj2EJoIEOM32WeaSeeqFK+say+2azUi+5ttx/QJeQIjshkcsBsOp/MBAA7
}
image create photo im_Open -data {
R0lGODlhEAAQAKIAAP///9TQyICAgEBAQAAAAAAAAAAAAAAAACwAAAAAEAAQAAADMxi63BMg
yinFAy0HC3XjmLeA4ngpRKoSZoeuDLmo38mwtVvKu93rIo5gSCwWB8ikcolMAAA7
}
frame $base
# let the user pack the outside base frame
frame $base.ohull -borderwidth 2 -height 16 -relief ridge
label $base.button -borderwidth 0 -image im_Open -relief raised -text "101"
bind $base.button <Button-1> {cframe.toggle [winfo parent %W].ohull.ihull}
label $base.label -anchor w -borderwidth 1 -text $text
#
# pack special frame/button
#
pack $base.ohull -anchor nw -expand 1 -fill both -side left -ipadx 2 -ipady 8
place $base.button -x 5 -y -1 -width 21 -height 21 -anchor nw -bordermode ignore
place $base.label -x 23 -y 3 -height 13 -anchor nw -bordermode ignore
#
# Create a label underneath the "title" to prevent overlap
# then pack a frame in below that which will be the hull i.e. childsite for users
#
label $base.ohull.padder -text ""
pack $base.ohull.padder -side top
eval set hull $base.ohull.ihull
;# Create the inner frame using any additional arguments passed in
eval frame $hull $args
pack $hull -expand true -fill both
return $hull
}
#-----------------------------------------------------------
# Toggle the widget, toggle the 'can be opened' icon.
# can also called as cframe.toggle $cframeWidget
#-----------------------------------------------------------
proc cframe.toggle {ihull} {
set button "[winfo parent [winfo parent $ihull]].button"
set a [$button cget -image]
if { $a == "im_Open" } {
cframe.close $ihull
} else {
cframe.open $ihull
}
}
#-----------------------------------------------------------
# Collapse the widget, display the 'can be opened' icon.
# can also called as cframe.close $cframeWidget
#-----------------------------------------------------------
proc cframe.close {ihull} {
set base [winfo parent [winfo parent $ihull]]
$base.button configure -image im_Close
pack forget $base.ohull
;# Make outer frame just small enough for button and title
$base configure -height 16 -width 50
# Force the screen back to its requested size in case the
# user manually changed it's size.
wm geometry [winfo toplevel $base] {}
}
#-----------------------------------------------------------
# Open the widget, display the 'can be closed' icon.
# cal also called as cframe.open $cframeWidget
#-----------------------------------------------------------
proc cframe.open {ihull} {
set base [winfo parent [winfo parent $ihull]]
$base.button configure -image im_Open
pack $base.ohull -anchor nw -expand 1 -fill both -side left -ipadx 2 -ipady 10
;# Below will force the toplevel to refresh it's size incase the user
;# Manually resized the toplevel. In those cases the packing areas
;# won't automatically contract unless you tell the toplevel to
;# use it's requested size.
wm geometry [winfo toplevel $base] {}
}
#//////////////////////////////////////////////////////////////////////////////
# B A L L O O N H E L P
#//////////////////////////////////////////////////////////////////////////////
###############################################################################
# Function : balloon
# Description: Bind ballon help to some widget
# Author : Tom Wilkason
# Date : 1/2/2000
###############################################################################
proc balloon {w help} {
bind $w <Any-Enter> "after 300 [list balloon:show %W [list $help]]"
bind $w <Any-Leave> "destroy %W.balloon"
}
###############################################################################
# Function : balloon:show
# Description: Pop-up the ballon help based on a callback for the widget enter
# Author : Tom Wilkason
# Date : 1/2/2000
###############################################################################
proc balloon:show {w arg} {
if {[eval winfo containing [winfo pointerxy .]]!=$w} {return}
set top $w.balloon
catch {destroy $top}
toplevel $top -bd 1 -bg black
wm overrideredirect $top 1
pack [message $top.txt -aspect 10000 -bg lightyellow \
-font {Arial 8} -text $arg]
set wmx [winfo rootx $w]
set wmy [expr [winfo rooty $w]+[winfo height $w]]
wm geometry $top \
[winfo reqwidth $top.txt]x[winfo reqheight $top.txt]+$wmx+$wmy
raise $top
}
#
###############################################################################
# Fire it up
###############################################################################
#
buildGui
readSettings
if {$tomAmpSettings(AutoRescan)} {
Rescan
;##
;# Apply the default folder settings
;#
ReadFolderFile $tomAmp(defaultFolderFile)
} else {
if {[catch {set fid [open $tomAmp(cacheFile) r]} result]} {
Rescan
} else {
;##
;# Read the cached data
;#
gets $fid TaFiles
array set taFiles $TaFiles
gets $fid TaFolders
array set taFolders $TaFolders
close $fid
buildFolderMenu
ReadFolderFile $tomAmp(defaultFolderFile)
}
}
MonitorFolders
###############################################################################
# Function : tst
# Description:
# Author : Tom Wilkason
# Date : 12/31/2000
###############################################################################
proc tst {{offset 0}} {
set file "d:/media/incoming/Classic Rock/Crosby, Stills, Nash & Young - Everybody I Love You.mp3"
set file "//Toms/K6 D/Media/Incoming/Classic Rock/Crosby, Stills, Nash & Young - Everybody I Love You.mp3"
Stop
s config -file $file
set now [clock seconds]
set xxx [expr {int(double(100.)/[s length -units sec]*[s length])}]
s play -start $offset -command Next
puts "Time:[expr {[clock seconds] - $now}]"
puts [s info]
Timer
after 3000 s stop
}
|