dec_plot_1.tcl.in

这是处理语音信号的程序

#! @TCL@ -f
# file: dec_plot_1.tcl
#

# procedures to draw a network of words generated using a 
# Viterbi trace-passing decoder
#

# procedure to draw the word graph
#
proc draw_network_proc {} {
    
    # import globals
    #
    global p

    global hyp_list
    global current_frame

    global black_color
    global red_color

    global num_frames
    global num_n_best

    global x_off
    global y_off

    global row_space
    global col_space
    global dec_factor

    global coords_list

    global font_0
    global font_1
    global font_2
    global font_3

    # set column separation
    #
    set col_sep [expr $dec_factor * $col_space]

    # remove everything if there is already some network
    #
    catch {$p.words delete all}
    
    # create a stack of words currently on display
    #
    set word_stack {}
    set coords_list {}

    # create a count array
    #
    set count_list {}
    for {set ii 0} {$ii <= $current_frame} {incr ii} {
	lappend count_list 1
    }

    # keep track of rows
    #
    set row_index 0

    # keep track of drawing distances
    #
    set last_end 1
    set last_xx [expr $x_off * 4]

    # read the hypotheses off the list one by one
    #
    foreach hypothesis $hyp_list {

	# check each word in the hypothesis
	#
	foreach word $hypothesis {

	    # check if it is already on the stack
	    #
	    if {[lsearch -exact $word_stack $word] == -1} {
		
		# put the word on the stack
		#
		lappend word_stack $word
	    }
	}
    }

    # sort the word stack in order of end times
    #
    set word_stack [lsort -integer -increasing -index 1 $word_stack]

    # draw a node for the words
    #
    foreach word $word_stack {

	# set the color of the node
	#
	set color $black_color
	if {[lsearch -exact [lindex $hyp_list 0] $word] != -1} {
	    
	    # this is on the best path
	    #
	    set color $red_color
	}
	
	# set the screen coordinates for the word node
	#
	foreach {start_f end_f score word_txt} $word {

	    # keep a count of how many words end at this frame
	    #
	    set end_count [lindex $count_list $end_f]
	    set yy [eval expr $end_count * $row_space]
	    incr end_count
	    set count_list [lreplace $count_list $end_f $end_f $end_count]

	    # if this word ended later than the previous word processed
	    #
	    if {$end_f > $last_end} {
		set xx  [eval expr ($end_f - $last_end) * 5 + $col_sep + \
			$last_xx]
	    } else {
		set xx $last_xx
	    }
	    
	    # save the coordinates for this word
	    #
	    set coord [list $xx $yy $end_f $color]
	    lappend coords_list $coord

	    set last_xx $xx
	    set last_end $end_f
	    
	    # draw the node in the set color
	    #
	    make_node $xx $yy $word_txt $score $color
	}
    }
    
    # plot all the frame numbers
    #
    foreach coord $coords_list {
	$p.words create text [expr 2*$x_off] $y_off -text "0" -font $font_2 \
		-anchor c -tags node
	foreach {xx yy end_f color} $coord {
	    $p.words create text $xx $y_off -text $end_f -font $font_2 \
		    -anchor c -tags node
	}
    }

    # now connect the appropriate words
    #
    set c 0
    set edge_list {}
    foreach hypothesis $hyp_list {
	
	# set the color of the node
	#
	set color $black_color
	if {$c == 0} {
	    set color $red_color
	    set c 1
	}
	
	# check each word in the hypothesis
	#
	set i 0
	foreach word $hypothesis {
	    
	    # find the index for this word in the stack
	    #
	    set word_ind [lsearch -exact $word_stack $word]
	    
	    # find the coordinates for this word on the canvas
	    #
	    if {$i == 0} {
		set x1 [expr 2*$x_off]
		set y1 $x_off
	    } else {
		set x1 $x2
		set y1 $y2
	    }
	    set x2 [lindex [lindex $coords_list $word_ind] 0]
	    set y2 [lindex [lindex $coords_list $word_ind] 1]
	    
	    # find where this word points to
	    #
	    incr i

	    # draw line from point 1 to point 2
	    #
	    set edge {}
	    lappend edge $x1 $y1 $x2 $y2
	    if {[lsearch -exact $edge_list $edge] == -1} {
		lappend edge_list $edge
		make_edge $x1 $y1 $x2 $y2 $color
	    }
	}
    }
    
    # update the scroll region
    #
    set size [$p.words bbox all]
    set x0 [expr [lindex $size 0] - $y_off]
    set y0 [expr [lindex $size 1] - 5]
    set x1 [expr [lindex $size 2] + $y_off]
    set y1 [expr [lindex $size 3] + 2]
    
    set size {}
    set size [linsert $size 0 $x0 $y0 $x1 $y1]
    
    $p.words configure -scrollregion $size
}

# procedure to draw a node at (x, y) with tag ii and text label tt
#
proc make_node { x y tt score color } {
    
    # declare globals
    #
    global p

    global x_off
    global y_off

    global font_0
    global font_1
    global font_2
    global font_3

    # draw the node
    #
    $p.words create oval [expr $x-$x_off] [expr $y-$y_off] \
	    [expr $x+$x_off] [expr $y+$y_off] -outline $color -fill white \
	    -tags node -width 3

    # set the label
    #
    $p.words create text $x $y -text $tt -font $font_2 -anchor c \
	    -fill $color -tags node

    # set the score
    #
    $p.words create text [expr $x-$y_off] [expr $y+2*$y_off] -text $score \
	    -font $font_2 -anchor sw -fill $color -tags node
}

# procedure to draw an ellipse-to-ellipse line
#
proc make_edge {x1 y1 x2 y2 color} {

    # declare globals
    #
    global x_off
    global y_off

    global p

    # compute the actual endpoints of the arrow
    #
    # find the cosine and sine of the angle with the horizontal
    #
    set angle 90
    set x_diff [expr $x2 - $x1]
    set y_diff [expr $y2 - $y1]
    set hyp [expr sqrt($x_diff*$x_diff + $y_diff*$y_diff)]
    set cos_angle [expr $x_diff/$hyp]
    set sin_angle [expr $y_diff/$hyp]

    # compute the offsets in x and y directions
    #
    set del_x [expr $x_off * $cos_angle]
    set del_y [expr $y_off * $sin_angle]

    # draw the line joining the two ellipses
    #
    $p.words create line [expr $x1+$del_x] [expr $y1+$del_y] \
	    [expr $x2-$del_x]  [expr $y2-$del_y] -arrow last -width 2 \
	    -fill $color
}

# end of file
#