disphw.tcl

来自「手写识别是模式识别中研究得一个热点」· TCL 代码 · 共 79 行

#!/usr/local/bin/wish -f

# Thanks to Sven Delmas for the FSBox.
set InstallDir ~marwood/599/src/DispHW
source $InstallDir/FSBox.tcl
source $InstallDir/ModalBoxes.tcl
source $InstallDir/HWCanvas.tcl

proc NewFile {} {
    set FName [FSBox]
    if {$FName == ""} return
    HWCSetContents [LoadFile $FName]
}

proc Help {} {
    if {[winfo exists .help]} {destroy .help}
    toplevel .help
    label .help.title -text "DispHW" -font lucidasans-bold-24
    label .help.author -text "by David Marwood" -font lucidasans-18
    message .help.mess -text "DispHW is a program to display handwriting files.  To display a handwriting file, press \"New File\" and select the file from the file browser.  If the loaded file exceeds the screen size, it may be shrunk with the magnification slider.  Loading new files and changing their magnification can be slow on large files, so please be patient." -aspect 400
    button .help.close -command "destroy .help" -text "Close"
    pack append .help .help.close bottom .help.title top .help.author top .help.mess top
}

proc LoadFile FName {
    set fid [open $FName]
    set Ans {}

    if {[gets $fid Line] != -1} {
	if {$Line != "HW_file"} {
	    ModalInfoBox "The file header line indicates it is not a handwriting file.  The file will not loaded."
	    .string.text config -text ""
	    close $fid
	    return {}
	}
    }
    .string.text config -text [gets $fid]
    while {[gets $fid Line] != -1} {
	if {[string index $Line 0] == "#"} {continue}
	lappend Ans $Line
    }
    close $fid
    return $Ans
}


frame .buttons -relief raised
button .buttons.quit -command {exit 0} -text Quit
scale .buttons.mag -orient horiz -label "Magnification x 10" -from 1 -to 20
if {[lindex $argv 1] == ""} {
    .buttons.mag set 10 
} else {
    .buttons.mag set [lindex $argv 1]
}
	
bind .buttons.mag <ButtonRelease-1> {HWCSetMag [expr [.buttons.mag get]/10.]}
button .buttons.load -command NewFile -text "New File"
button .buttons.help -command Help -text "Help"
pack append .buttons .buttons.mag {left fill expand} .buttons.load {left fill} .buttons.help {left fill} .buttons.quit {left fill}
pack append . .buttons {top fillx}

frame .string -relief sunken
label .string.text -anchor w
label .string.label -text "String: "
pack append .string .string.label {left fill} .string.text {left fill expand}
pack append . .string {top fill}

set Canvas [HWCanvasInit .display]
pack append . .display {top fill expand}

HWCSetMag [expr [.buttons.mag get]/10.]
if {[lindex $argv 0] != ""} {
    HWCSetContents [LoadFile [lindex $argv 0]]
}

wm minsize . 300 200

catch {source ~/.DispHWrc}