#
# $Source: /home/nlfm/Working/Zircon/Released/lib/RCS/Sound.tcl,v $
# $Date: 2001/07/10 15:36:12 $
# $Revision: 1.18.1.19 $
#
package provide zircon 1.18
#
proc handleSound {net unusedusr fl chan prefix} {
    global zircon
    switch {} [set plyrs [$net players]] {} default {
	switch {} [file extension $fl] {append fl .wav}
	foreach x $plyrs {
	    foreach {ptn pth ply txt} $x break
	    if {[string match $ptn $fl]} break
	    set ply {}
	}
	switch {} $ply return
	set ptn [lindex $ptn 0]
	switch [file pathtype $fl] absolute {
	    set dirs [file dirname $fl]
	    set fl [file tail $fl]
	} default {
	    set dirs [split $pth :]
	    lappend dirs [file join $zircon(prefdir) sounds] \
	      [file join $zircon(lib) sounds]
	}
	foreach x $dirs {
	    if {[file exists [file join $x $fl]]} {
		set fl [native [file join $x $fl]]
		if {[regsub -all %s $ply $fl cmd] == 0} {
		    append cmd " [list $fl]"
		}
		if {[catch {eval exec $cmd &} msg]} {
		    $net inform "Error executing wav player - \"$msg\""
		}
		return
	    }
	}
	switch {} $chan {} default {
	    handleOn $net NOSOUND [list $fl $chan $prefix]
	}
    }
}
#
proc doSendSound {net nk fl} {
    switch {} $fl return
    set tfl [file tail [file rootname $fl]]
    $net CTCP SOUND $nk "[file tail $fl] <$tfl>"
    handleSound $net [$net nickname] $fl {} {}
}
#
proc addSoundMenu {net smenu chid} {
    switch {} [$net players] return
    global zircon
    $smenu add cascade -label [trans sound] -menu $smenu.sound
    menu $smenu.sound -postcommand "buildSMenu $net $smenu.sound $chid"
    catch {$smenu.sound configure  -tearoffcommand "retitle {Sounds for [$chid name]}"}
}
#
proc buildSMenu {net smenu chid} {
    global zircon
    $smenu delete 0 end
    catch {destroy $smenu.more}
    $smenu add command -label {Other file} -command "sendSound $net {[$chid name]}"
    $smenu add separator
    foreach x  [$net players] {
        foreach {ptn pth ply txt} $x break
	set ptn [lindex $ptn 0]
	set fls {}
	set dirs [split $pth :]
	lappend dirs [file join $zircon(prefdir) sounds] [file join $zircon(lib) sounds]
	foreach z $dirs {
	    switch {} [set dfs [glob -nocomplain [file join $z $ptn]]] {} default {
	        foreach y $dfs { lappend fls [file tail $y] }
	    }
	}
	switch {} $fls {
	    foreach y [glob -nocomplain $ptn] { lappend fls [file tail $y] }
	}
	set cnt 0
	foreach z [lsort $fls] {
            if {[incr cnt] >= 20} {
	        set cnt 0
	        $smenu add cascade -label [trans more] \
		  -menu [set m [menu $smenu.more -tearoff 0]]
	        set smenu $m
	    }
	    $smenu add command -label [file tail [file rootname $z]] \
	      -command "doSendSound $net [list [$chid name]] [list $z]"
        }
    }
}
#
proc net_addWP {this path} {
    upvar #0 $this ndata
    set wptn [list {*.[wW][aA][vV]}]
    set mptn [list {*.[mM][iI][dD]}]
    switch {} $ndata(players) {} default {
    	set ply {}
	set fnd 0
        foreach x $ndata(players) {
	    switch -- [lindex $x 0] $wptn - $mptn {
	    	incr fnd
		set x [lreplace $x 1 1 $path]
	    }
	    lappend ply $x
	}
	switch $fnd 2 { set ndata(players) $ply ; return } 1 {
	    lappend ply [list [list $mptn] {} $path {Midi format files}]
	    set ndata(players) $ply
	    return 
	}
    }
    lappend ndata(players) \
      [list [list $wptn $path {} {WAV format sound files}]]\
      [list [list $mptn $path {} {Midi format files}]]
}
#
proc net_addWPl {this player} {
    upvar #0 $this ndata
    set wptn [list {*.[wW][aA][vV]}]
    set mptn [list {*.[mM][iI][dD]}]
    switch {} $ndata(players) {} default {
    	set ply {}
	set fnd 0
        foreach x $ndata(players) {
	    set tp [lindex $x 0]
	    switch -- $tp $wptn - $mptn {
	    	incr fnd
		set x [lreplace $x 2 2 $player]
	    }
	    lappend ply $x
	}
	switch $fnd 2 { set ndata(players) $ply ; return } 1 {
	    lappend ply [list [list $mptn {}] $player {Midi format files}]
	    set ndata(players) $ply
	    return 
	}
    }
    lappend ndata(players) \
      [list [list $wptn {} $player {WAV format sound files}]]\
      [list [list $mptn {} $player {Midi format files}]]
}