#============================================================================== # Contains the implementation of a multi-entry widget for real numbers in # fixed-point format. # # Copyright (c) 1999-2004 Csaba Nemethi (E-mail: csaba.nemethi@t-online.de) #============================================================================== # # Public procedures # ================= # #------------------------------------------------------------------------------ # mentry::fixedPointMentry # # Creates a new mentry widget win that allows to display and edit real numbers # in fixed-point format, with cnt1 characters before and cnt2 digits after the # decimal point. Sets the type attribute of the widget to FixedPoint and # returns the name of the newly created widget. #------------------------------------------------------------------------------ proc mentry::fixedPointMentry {win cnt1 cnt2 args} { # # Check the arguments # if {[catch {format "%d" $cnt1}] != 0 || $cnt1 <= 0} { return -code error "expected positive integer but got \"$cnt1\"" } if {[catch {format "%d" $cnt2}] != 0 || $cnt2 <= 0} { return -code error "expected positive integer but got \"$cnt2\"" } # # Change the default separator if the first optional argument is -comma # set sep . if {[string compare [lindex $args 0] "-comma"] == 0} { set sep , set args [lrange $args 1 end] } # # Create the widget and set its type to FixedPoint # eval [list mentry $win] $args ::$win configure -body [list $cnt1 $sep $cnt2] ::$win attrib type FixedPoint # # Allow only integer input in the first entry child # set w [::$win entrypath 0] $w configure -justify right wcb::cbappend $w before insert wcb::checkEntryForInt #danilo bind $w { if [winfo exists %W] { tk::TabToWindow [tk_focusPrev [tk_focusPrev %W]] } } # # Allow only decimal digits in the second entry child # set w [::$win entrypath 1] $w configure -justify left wcb::cbappend $w before insert wcb::checkStrForNum bind $w { if [winfo exists %W] { tk::TabToWindow [tk_focusPrev [tk_focusPrev %W]] } } return $win } #------------------------------------------------------------------------------ # mentry::putReal # # Outputs the number num to the mentry widget win of type FixedPoint. #------------------------------------------------------------------------------ proc mentry::putReal {num win} { checkIfFixedPointMentry $win # # Get the expected number of digits after the decimal point # from the value of the -body configuration option of # the mentry win and format the number num accordingly # set body [::$win cget -body] if {[catch {format "%.*f" [lindex $body 2] $num} str] != 0} { return -code error $str } # # Check whether the result of the format command fits into the widget # set lst [split $str .] if {[string length [lindex $lst 0]] > [lindex $body 0]} { return -code error \ "the string \"$str\" does not fit into the mentry widget\ \"$win\"" } eval [list ::$win put 0] $lst } #------------------------------------------------------------------------------ # mentry::getReal # # Returns the number contained in the mentry widget win of type FixedPoint. #------------------------------------------------------------------------------ proc mentry::getReal win { checkIfFixedPointMentry $win # # Generate an error if the widget is empty # if {[::$win isempty]} { focus [::$win entrypath 0] return -code error EMPTY } # # Scan the contents of the widget # ::$win getarray strs scan $strs(0).$strs(1) "%f" val return $val } # # Private procedure # ================= # #------------------------------------------------------------------------------ # mentry::checkIfFixedPointMentry # # Generates an error if win is not a mentry widget of type FixedPoint. #------------------------------------------------------------------------------ proc mentry::checkIfFixedPointMentry win { if {![winfo exists $win]} { return -code error "bad window path name \"$win\"" } if {[string compare [winfo class $win] "Mentry"] != 0 || [string compare [::$win attrib type] "FixedPoint"] != 0} { return -code error \ "window \"$win\" is not a mentry widget for fixed-point numbers" } }