hwcanvas.tcl

手写识别是模式识别中研究得一个热点

set HWList {}
set CurMag 1

proc HWCanvasInit InitFrame {
    global Frame
    global Canvas
    set Frame $InitFrame
    set Canvas $InitFrame.canvas

    frame $Frame -relief sunken
    canvas $Canvas -xscroll "$Frame.hscroll set" -yscroll "$Frame.vscroll set" -relief sunken
    bind $Canvas <Button-1> {
	puts "Time of item closest to [$Canvas canvasx %x] [$Canvas canvasy %y] is [$Canvas gettags [$Canvas find closest [$Canvas canvasx %x] [$Canvas canvasy %y]]]"
    }
    scrollbar $Frame.vscroll -relief sunken -command "$Canvas yview"
    scrollbar $Frame.hscroll -orient horiz -relief sunken -command "$Canvas xview"
    pack append $Frame $Frame.vscroll {right filly} $Frame.hscroll {bottom fillx} $Canvas {top fill expand}

    after 1000 HWAnimate

    return $Canvas
}


proc HWCSetMag NewMag {
    global CurMag
    set CurMag $NewMag

    global HWList
    HWCSetContents $HWList
}


proc HWCSetContents List {
    set PenDown No
    set MaxX 0
    set MaxY 0

    global CurMag
    global Canvas
    global HWList
    set HWList $List

    set OldCursor [lindex [$Canvas config -cursor] 4]
    $Canvas config -cursor watch

    eval [concat $Canvas delete [$Canvas find all]]
    
    foreach Line $HWList {
	case [lindex $Line 0] in {
	    0 { 
		set X [expr [lindex $Line 2]*$CurMag]
		set Y [expr [lindex $Line 3]*$CurMag]
		if {$X > $MaxX} {set MaxX $X}
		if {$Y > $MaxY} {set MaxY $Y}
		
		if {$PenDown == "No"} {
		    set rect [$Canvas create rectangle $X $Y $X $Y -width 1 -tag [lindex $Line 1]]
		} else { 
		    set rect [$Canvas create rectangle [expr $X-2] [expr $Y-2] [expr $X+2] [expr $Y+2] -width 1 -fill black -tag [lindex $Line 1]]
		}
	    }
	    1 { 
		set PenDown Yes
	    }
	    2 { 
		set PenDown No
	    }
	    5 {break}
	    * { 
		set Colors {red orange yellow green blue purple brown magenta azure "misty rose" cyan OliveDrab1 sienna1 maroon \
"WhiteSmoke" "OldLace" "PapayaWhip" "PeachPuff" "ivory" "mint cream" "lavender" "white" "DimGrey" "LightGrey" "navy blue" "DarkSlateBlue" "light slate" "RoyalBlue" "DeepSkyBlue" "steel blue" "LightBlue" "dark turquoise" "cyan" "medium aquamarine" "SeaGreen" "pale green" "LawnGreen" "green yellow" "YellowGreen" "dark khaki" "light goldenrod" "gold" "DarkGoldenrod" "saddle brown" "beige" "chocolate" "salmon" "DarkOrange" "orange red" "deep pink" "violet red" "orchid" "dark violet" "medium purple" "snow3" "seashell4" "bisque1" "PeachPuff2" "NavajoWhite3" "LemonChiffon4" "ivory1" "honeydew2" "LavenderBlush3" "MistyRose4" "SlateBlue1" "RoyalBlue2" "blue3" "DodgerBlue4" "DeepSkyBlue1" "SkyBlue2" "LightSkyBlue3" "SlateGray4" "LightBlue1" "LightCyan2" "PaleTurquoise3" "CadetBlue4" "cyan1" "DarkSlateGray2" "aquamarine3" "DarkSeaGreen4" "PaleGreen1" "SpringGreen2" "green3" "chartreuse4" "DarkOliveGreen1" "khaki2" "LightGoldenrod3" "LightYellow4" "gold1" "goldenrod2" "DarkGoldenrod3" "RosyBrown4" "sienna1" "burlywood2" "wheat3" "tan4" "firebrick1" "brown2" "salmon3" "LightSalmon4" "DarkOrange1" "coral2" "tomato3" "OrangeRed4" "DeepPink1" "HotPink2" "pink3" "LightPink4" "maroon1" "VioletRed2" "magenta3" "orchid4" "MediumOrchid1" "DarkOrchid2" "purple3" "MediumPurple4" \
}

		set all [$Canvas find all]
		set Pos [expr [llength $all]-1]
		set id [lindex $all $Pos]
		set NX [expr [lindex [$Canvas coords $id] 0]/2+[lindex [$Canvas coords $id] 2]/2]
		set NY [expr [lindex [$Canvas coords $id] 1]/2+[lindex [$Canvas coords $id] 3]/2]
		$Canvas coords $id [expr $NX-5] [expr $NY-5] [expr $NX+5] [expr $NY+5] 
		$Canvas itemconfig $id -fill [lindex $Colors [expr [lindex $Line 0]-6]]
	    }
	}
    }
    $Canvas config -width $MaxX -height $MaxY -scrollregion "0 0 [expr $MaxX+30] [expr $MaxY+30]"
    $Canvas config -cursor $OldCursor
}


set HWCAnimRate 50
set LastAnim 0
proc HWAnimate {} {
    global HWCAnimRate
    update
    after $HWCAnimRate HWAnimate

    global Canvas
    if {[winfo ismapped $Canvas] != 1} {
	return
    }

    global LastAnim
    global HWList

    set LastAnim [$Canvas find withtag $LastAnim]
    if {$LastAnim == ""} {
	set LastAnim [lindex [$Canvas find all] 0]
	return
    }

    $Canvas itemconfig $LastAnim -outline black

    set NextAnim [$Canvas find withtag [expr $LastAnim+1]]
    if {$NextAnim == ""} {
	set NextAnim [lindex [$Canvas find all] 0]
	if {$NextAnim == ""} {
	    return
	}
    }

    $Canvas itemconfig $NextAnim -outline white
    $Canvas raise $NextAnim

    set LastAnim $NextAnim
}