Description:
Written in pure tcl, uses Snack, triggers user's
callback procedure on "voice on" and "voice off" conditions.
License : BSD
Created: 13-Mar-2005The vox tcl package is written in pure tcl and uses the Snack Sound Toolkit to provide "sound on" and "sound off" triggers from an incoming sound. To create these triggers, a frame logic is used in the following manner:Starting from an "sound off" condition, a sound portion of length offframe samples is examined, and if the value of any sample exceeds the desired squelch level value then the "sound on" trigger is created at the end of the frame and a user callback procedure oncommand is called. While in the "sound on" condition, frames of onframe length are examined. If all samples in an onframe have values lower than the squelch level, the "sound off" trigger is created and the user callback procedure offcommand is called. All offframes but the last are cut out of the sound object by default.
A sample application : voxrecorder.tcl creates a minimal voice operated recorder that saves wav files for each utterance.
package require snack
package require Tk
package require vox
package require tile
snack::sound ss
label .l -text "Ready to record" -width 20 -anchor w -bg white \
-textvariable ::level
pack .l -side top -anchor nw -fill x
ttk::button .b -text "Start" -command Rec -padding 0
pack .b -side top -anchor nw -fill both -expand 1
ttk::scale .s -orient horizontal -length 125 -from 0 -to 32768 \
-variable ::sq -command setSq
pack .s -side top -anchor nw -fill both
# Start/Stop sound recording
proc Rec {} {
if {$::stopped} {
set ::stopped 0
vox::record ss -sqvariable ::sq -slvariable ::level -offcommand save
.b configure -bg red -text "Stop"
} else {
set ::stopped 1
vox::stop ss
.b configure -bg green -text "Start"
.l configure -bg white
}
}
# procedure to call when sound goes off: Save sound and clear sound object
proc save {snd start end} {
ss write [clock seconds].wav -start $start -end $end
vox::clear ss
}
# procedure called when the squelch value changes
proc setSq {v} {
set ::sq $v
}
# set initial squelch level
set ::sq 2500
.s set $::sq
set ::stopped 1
bind . RecHere is how it looks in winXP and tile
Package code edit
# vox.tcl
# Voice Operated Switch/Recorder package
# (C) 2004-2005 Dimitrios Zachariadis
# Licensed under a BSD license
package provide vox 0.1
if {[catch {package req snack}]} {
error "package snack is required by vox"
}
namespace eval vox {
proc createVox {w} {
namespace eval [namespace current]::${w} {
variable var
}
array set [namespace current]::${w}::var [list \
-onframe 4000 \
-offframe 400 \
-oncommand "vox::dummy" \
-offcommand "vox::dummy" \
-sqvariable "[namespace current]::${w}::var(squelch)" \
-slvariable "[namespace current]::${w}::var(slevel)" \
frlen 0 \
s0 0 \
on 0 \
clear 0 \
recording 0 \
squelch 2500 \
after {}
]
}
proc record {snd args} {
createVox $snd
upvar vox::${snd}::var a
array set a $args
if {$a(-sqvariable) != "vox::${snd}::var(squelch)"} {
# user has supplied a -sqvariable. Use it.
set a(squelch) [set $a(-sqvariable)]
} else {
# set the default variable in a(-sqvariable) i.e. vox::${snd}::var(squelch)
# to the squelch value
set $a(-sqvariable) $a(squelch)
}
if {!$a(recording)} {
$snd flush
# start with scanning input every offframe samples
set a(frlen) $a(-offframe)
set a(recording) 1
$snd record
set a(after) [after 0 [list vox::detect $snd 0 0]]
}
}
# stops vox and gets last piece of sound left
proc stop {snd args} {
upvar [namespace current]::${snd}::var a
$snd stop
set a(recording) 0
after cancel $a(after)
set slen [expr {[$snd length]-1}]
# get last piece of sound
detect $snd $a(s0) $slen
set slen [expr {[$snd length]-1}]
if {!$a(on) && $slen>0} {
# these are the last off frames, throw them away
$snd cut $a(s0) [expr {[$snd length]-1}]
}
# do what the user wants here
if {$args!={}} {namespace eval :: [list $args]}
# reset pointers
set a(s0) 0
set a(on) 0
}
# empty vox sound. Avoids timing problems in cutting out sound
proc clear {snd} {
upvar [namespace current]::${snd}::var a
set a(clear) 1
}
# detect a sound in the microphone and serve vox callbacks
proc detect {snd s1 s} {
upvar [namespace current]::${snd}::var a
set slen [$snd length]
while {$slen>$a(frlen) && $s < $slen} {
set __slev [$snd max -start $s1 -end $s ]
if {($__slev < $a(squelch)) || !$a(recording)} {
# sound has been below squelch level before last frame or we just stopped recording
if {$a(on)} {
if {$a(recording)} {
# Sound just dropped below squelch level before this frame
$snd cut [expr {$s1+1}] $s
} else {
# stopped recording while sound was on
set s1 $s
}
# use only sound that lasts for at least one onframe
if {[expr {$s1-$a(s0)}]>=$a(-onframe)} {
# a(s0) is the start of the previous frame that just completed
set s $s1
# offcommand callback
namespace eval :: [list $a(-offcommand) $snd $a(s0) $s1]
if {[$snd length]==0} {
# user cleared sound
set s1 0
set s 0
}
set a(s0) $s1
set a(frlen) $a(-offframe)
if {$a(recording)} {set a(on) 0}
}
} else {
# sound below squelch during last two frames
if {$a(clear)} {
# reset pointers
set a(clear) 0
set a(s0) 0
set s1 0
set s 0
# clear sound
$snd cut 0 [expr {[$snd length]-1}]
} else {
# cut last offframe
$snd cut $a(s0) $s
# adjust s
set s [expr {$a(s0) + $a(-offframe)}]
}
}
} else {
# sound is coming in or we just started recording
if {!$a(on)} {
# sound raised above squelch level in last frame
# oncommand callback
namespace eval :: [list $a(-oncommand) $snd $a(s0) $s1]
# advance s to the new frame start
set s [expr {$a(s0) + $a(-offframe)}]
# we are now working on an onframe sample length
set a(frlen) $a(-onframe)
# sound is on
set a(on) 1
} else {
# sound remained above squelch level during last two frames
}
}
# notify outer world about sound level
set $a(-slvariable) $__slev
# advance s1
set s1 $s
# advance s by a frlen
set s [expr {$s1 + $a(frlen)}]
set slen [$snd length]
set a(squelch) [set $a(-sqvariable)]
}
if {$a(recording)} {set a(after) [after [expr {$a(frlen)/16}] [list vox::detect $snd $s1 $s]]}
}
proc dummy {snd s0 s1} {
}
}
# pkgIndex.tcl
package ifneeded vox 0.1 [list source [file join $dir vox.tcl]]vox package manual edit
The vox commands operate on a snack sound object named soundName, configured for 1 channel (mono), 16000 samples per second. This is the snack sound created with the snack default values. To create and manipulate the snack sound object follow the Snack Toolkit documentation.Commands
NAME
vox::clear - Clear sound object and reset internal pointersSYNOPSIS
vox::clear soundNameDESCRIPTION
The clear command is used to clear the sound object and reset the internal pointers. Clearing the sound object is done with the proper timing. Clearing the sound object otherwise could result to errors due to dangling sound pointers.NAME
vox::record - starts vox operationSYNOPSIS
vox::record soundName ?option value ...?OPTIONS
-onframe value : "On" frame length in number of samples. Default value 4000-offframe value : "Off" frame length in number of samples. Default value 40.-oncommand callback : User proc to run when a sound "On" condition is detected. The callback procedure is called as follows:callback soundName startSample endSamplewhere startSample and endSample are sample pointers in the snack sound object. The sound between these samples corresponds to the last offframe, where the "sound on" condition was detected. The callback procedure is executed in the global namespace context.-offcommand callback : User proc to run when a sound "Off" condition is detected. The callback procedure is called as follows:callback soundName startSample endSamplewhere startSample and endSample are sample pointers in the snack sound object. The sound between these samples corresponds to the duration of the "on" vox condition, i.e. the total number of onframes until the "sound of" condition was detected. The callback procedure is executed in the global namespace context.-sqvariable value : User variable setting the desired squelch level. Default value 2500.-slvariable value : Read only variable, indicating sound signal level. Values come between 0 and 32767.DESCRIPTION
The vox::record command is used to start vox operation. During vox operation, the incoming sound is recorded in the soundName snack sound object. If only the "sound on" and "sound off" triggers are needed, but not the sound itself, the user should clear the recorded sound by using the vox::clear command in an offcommand callback proc. Otherwise, some kind of save operation should be used, like the snack's write operation, followed, if necessary, by a vox::clear command.NAME
vox::stop - stops vox operationSYNOPSIS
vox::stop soundName ?args?DESCRIPTION
The vox::stop command is used to stop vox recording. Internal vox pointers are reset. If args are specified, they are considered a user command which is executed in the global namespace context.HJG 2013-12-21 - That page is offline. archive.org has the last version, from 2008-04
dzach 2013-12-22 - Just checked. The page is online and viewable.HJG 2013-12-24 - Website not reachable:
dzach 2013-12-22 - Just checked. The page is online and viewable.HJG 2013-12-24 - Website not reachable:traceroute to users.hol.gr (194.30.193.61), 30 hops max, 60 byte packets 1 static.33.75.46.78.clients.your-server.de (78.46.75.33) 3.976 ms 3.974 ms 3.968 ms 2 hos-tr2.juniper1.rz12.hetzner.de (213.239.228.161) 0.251 ms hos-tr4.juniper2.rz12.hetzner.de (213.239.228.225) 0.215 ms hos-tr3.juniper2.rz12.hetzner.de (213.239.228.193) 0.222 ms 3 core21.hetzner.de (213.239.245.77) 11.850 ms core22.hetzner.de (213.239.245.117) 0.220 ms core21.hetzner.de (213.239.245.77) 0.216 ms 4 core12.hetzner.de (213.239.245.214) 2.820 ms 2.833 ms 2.831 ms 5 juniper4.rz2.hetzner.de (213.239.245.26) 2.827 ms 2.824 ms 2.819 ms 6 nbg-s1-rou-1001.DE.eurorings.net (134.222.107.20) 7.597 ms 7.471 ms 7.582 ms 7 ffm-s1-rou-1102.DE.eurorings.net (134.222.227.117) 7.439 ms 7.444 ms 7.431 ms 8 ffm-s2-rou-1041.DE.eurorings.net (134.222.229.74) 7.359 ms 7.326 ms 7.308 ms 9 * * * 10 xe-2-0-0.atene7.ate.seabone.net (213.144.178.204) 75.824 ms 75.154 ms 75.145 ms 11 79.140.91.3 (79.140.91.3) 66.004 ms hol.atene7.ate.seabone.net (213.144.178.142) 71.657 ms 195.22.193.26 (195.22.193.26) 57.509 ms 12 tengigaeth00-01-00-02.adr00.ccr.hol.gr (62.38.96.29) 70.930 ms 62.38.96.149 (62.38.96.149) 63.001 ms tengigaeth00-01-00-02.adr00.ccr.hol.gr (62.38.96.29) 70.872 ms 13 tengigaeth01-00-00.adr00.ssw.hol.gr (62.38.96.34) 76.043 ms 77.047 ms 77.033 ms 14 62.38.96.197 (62.38.96.197) 86.070 ms 74.964 ms 87.517 ms 15 62.38.36.78 (62.38.36.78) 75.980 ms 63.399 ms 75.872 ms 16 * * * ... 30 * * * traceroute to users.hol.gr (194.30.193.61), 30 hops max, 60 byte packets 1 swiCS5-V108.switch.ch (130.59.108.5) 0.591 ms 0.620 ms 0.653 ms 2 swiZH2-10GE-3-1.switch.ch (130.59.36.138) 8.714 ms 9.014 ms 9.005 ms 3 swiIX1-10GE-3-3.switch.ch (130.59.36.129) 62.907 ms 62.906 ms 62.888 ms 4 zch-b1-geth3-1.telia.net (213.248.79.189) 0.538 ms 0.627 ms 0.603 ms 5 ffm-bb1-link.telia.net (213.155.133.214) 11.715 ms ffm-bb2-link.telia.net (80.91.249.115) 11.717 ms 11.698 ms 6 ffm-b7-link.telia.net (80.91.249.107) 11.684 ms ffm-b7-link.telia.net (80.91.254.249) 11.914 ms ffm-b7-link.telia.net (80.91.249.107) 11.912 ms 7 globalcrossing-ic-130855-ffm-b7.c.telia.net (213.248.89.182) 12.314 ms 12.350 ms ethernet7-1.ar4.fra4.gblx.net (64.208.110.85) 12.265 ms 8 ae8.scr4.FRA4.gblx.net (67.16.145.241) 12.133 ms 12.191 ms ae8.scr3.FRA4.gblx.net (67.16.145.237) 12.187 ms 9 so2-0-0-2488M.ar5.LON3.gblx.net (67.16.130.146) 24.452 ms 24.604 ms 24.586 ms 10 ote-international-solutions-s-a.so-2-2-0.ar5.lon3.gblx.net (64.210.19.38) 167.206 ms 167.205 ms 164.960 ms 11 tengigaeth00-01-00-02.med00.ccr.hol.gr (62.38.97.29) 100.890 ms 100.556 ms 100.522 ms 12 tengigaeth09-00-00.adr01.ssw.hol.gr (62.38.97.38) 78.600 ms 78.595 ms 78.447 ms 13 62.38.96.201 (62.38.96.201) 97.124 ms 97.288 ms 97.155 ms 14 62.38.36.70 (62.38.36.70) 78.976 ms 79.052 ms 78.983 ms 15 * * * 16 * * * ... dzach 2013-12-24 I'm not sure the above traceroute proves that the site is unreachable. But as I re-checked the page, the server seems to be slow to respond, and maybe that is causing timeouts to routers or browsers? In any case, I'll try to move the code here. dzach 2013-12-24 Changed the license to from GPL to BSD
