/usr/share/tcltk/transcriber/convert/mdtm.tcl is in transcriber 1.5.1.1-10.
This file is owned by root:root, with mode 0o644.
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 | # RCS: @(#) $Id: mdtm.tcl,v 1.1 2003/11/13 15:59:56 barras Exp $
# mdtm.tcl - extension of the Transcriber program
# Copyright (C) 2003, LIMSI
# distributed under the GNU General Public License (see COPYING file)
namespace eval ::convert::mdtm {
variable msg "NIST .mdtm data"
variable ext ".mdtm"
# only needed for compatibility with version <1.4.6
proc readSegmt {content} {return [lindex [lindex [readSegmtSet $content] 0] 0]}
if {[info commands ::ColorMap] == ""} {proc ::ColorMap c {return}}
proc readSegmtSet {content args} {
global v
if {[info exists v(sig,name)]} {
set sid [file tail [file root $v(sig,name)]]
} else {
set sid ""
}
array set spk {}
array set gnd {}
foreach line [split $content "\n"] {
if {$line == "" || [string match ";;*" $line]} continue
set speaker ""
if {[scan $line "%s%s%f%f%s%s%s%s" id ch begin len type conf subtype speaker] >= 7} {
# filter on signal id if available, else choose first id met
if {$sid == ""} {
set sid $id
} elseif {$id != $sid} {
continue
}
# currently only process speaker tags
if {$type != "speaker"} continue
set end [expr $begin+$len]
set col [ColorMap $speaker]
lappend spk($ch) [list $begin $end $speaker $col]
switch -- $subtype {
"adult_male" { set val "Male"; set col "#00aaff" }
"adult_female" { set val "Female"; set col "#f67000"}
"child" { set val "Child"; set col green}
default { set val "?"; set col "#00cc00" }
}
lappend gnd($ch) [list $begin $end $val $col]
} else {
puts stderr "Warning - line '$line' ignored from .mdtm parsing"
}
}
set result {}
foreach ch [lsort [array names spk]] {
lappend result [list $spk($ch) "MDTM speaker (chn $ch)"]
lappend result [list $gnd($ch) "MDTM gender (chn $ch)" 0]
}
if {[llength $result] == 0} {
puts stderr "Warning - no line matched $sid basename during .mdtm parsing"
}
return $result
}
}
|