Updated 2013-12-24 22:53:29 by dzach

dzach What: A Voice Operated Switch / Recorder package
  Description:
        Written in pure tcl, uses Snack, triggers user's
        callback procedure on "voice on" and "voice off" conditions.
 License : BSD
 Created: 13-Mar-2005

The 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 . Rec

Here 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 pointers

SYNOPSIS

vox::clear soundName

DESCRIPTION

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 operation

SYNOPSIS

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 endSample

where 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 endSample

where 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 operation

SYNOPSIS

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:
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