source: trunk/lang/tcl/scripts/objects/number/number.rp @ 2138

# ----------------------------------------------------------------------
#  RAPPTURE OBJECT: number
#
#  A number is a real value with units of measure.  It is usually
#  used as an input, but it can also be an output from a simulation.
#
# ======================================================================
#  AUTHOR:  Michael McLennan, Purdue University
#  Copyright (c) 2004-2011  Purdue Research Foundation
#
#  See the file "license.terms" for information on usage and
#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
# ======================================================================

object number -extends base {
    palettes "Inputs" "Outputs"

    help http://rappture.org/wiki/rp_xml_ele_number

    attr default -title "Default Value" -type string:validate=number -path default
    attr units -title "Units of Measurement" -type units -path units
    attr min -title "Minimum Value" -type string:validate=number -path min
    attr max -title "Maximum Value" -type string:validate=number -path max
    attr color -title "Color" -type color -path color

    check default {
        if {[string length [string trim $attr(default)]] == 0} {
            return [list error "Must have a default value for this number."]
        }
        if {"" != $attr(units)} {
            set base [Rappture::Units::System::for $attr(units)]
            if {[validate_number_parse $attr(default) num units]
               && "" != $units
               && ![string equal [Rappture::Units::System::for $units] $base]} {
                return [list error "Units for default value don't match the expected units for this value"]
            }

            set dval [Rappture::Units::convert $attr(default) -context $attr(units) -to $attr(units) -units off]

            if {[validate_number_parse $attr(min) num units]
                 && [catch {Rappture::Units::convert $attr(min) -context $attr(units) -to $attr(units) -units off} min] == 0
                 && $dval < $min} {
                return [list error "Default value is less than the minimum that you've specified for this value."]
            }

            if {[validate_number_parse $attr(max) num units]
                 && [catch {Rappture::Units::convert $attr(max) -context $attr(units) -to $attr(units) -units off} max] == 0
                 && $dval > $max} {
                return [list error "Default value is greater than the maximum that you've specified for this value."]
            }
        }
    }

    check min {
        if {"" != $attr(units)} {
            set base [Rappture::Units::System::for $attr(units)]
            if {[validate_number_parse $attr(min) num units]
               && "" != $units
               && ![string equal [Rappture::Units::System::for $units] $base]} {
                return [list error "Units for minimum value don't match the expected units for this value"]
            }
        }
        if {[catch {Rappture::Units::convert $attr(min) -context $attr(units) -to $attr(units) -units off} min] == 0
              && [catch {Rappture::Units::convert $attr(max) -context $attr(units) -to $attr(units) -units off} max] == 0
              && $min >= $max} {
            return [list error "Minimum value should be less than the maximum.  If you don't want to see a min/max range, you can clear out either or both values."]
        }
    }

    check max {
        if {"" != $attr(units)} {
            set base [Rappture::Units::System::for $attr(units)]
            if {[validate_number_parse $attr(max) num units]
               && "" != $units
               && ![string equal [Rappture::Units::System::for $units] $base]} {
                return [list error "Units for maximum value don't match the expected units for this value"]
            }
        }
    }

    storage {
        private variable _num 0.0   ;# real number value
        private variable _units ""  ;# physical units
    }

    import xml {xmlobj path} {
        attr import $xmlobj $path
        import_string [$xmlobj get $path.current] [attr get units]
    }

    export xml {xmlobj path} {
        $xmlobj put $path "${_num}${_units}"
    }

    import string {val {defunits ""}} {
puts "IMPORTING: $val (number with units $defunits)"
        if {[regexp {^([-+]?(?:[0-9]+\.|\.)?[0-9]+(?:[eE][-+]?[0-9]+)?)( *(?:[a-zA-Z]+[0-9]*)+(?:\/(?:[a-zA-Z]+[0-9]*)+)*)*$} $val match num units]} {
            set sys [Rappture::Units::System::for $units]
            set base [Rappture::Units::System::for $defunits]
            if {$sys eq "" && $base ne ""} {
                error "don't recognize value"
            }
            if {$sys ne $base} {
                error "bad units \"$sys\": should be $base"
            }
            set _num $num
            set _units $units
        } elseif {[string is double -strict $val]} {
            set _num $val
            set _units $defunits
        } else {
            error "don't recognize value"
        }
    }

    export string {var} {
        upvar $var val
        set val "${_num}${_units}"
    }

    compare {
        set sys1 [Rappture::Units::System::for $_units]
        set sys2 [Rappture::Units::System::for $_units2]
        if {$sys1 ne $sys2} {
            # different units systems -- order by physical quantities
            return [string compare $sys1 $sys2]
        }

        # normalize the value of num1
        if {$_units ne ""} {
            set num1 [Rappture::Units::convert $_num \
                -context $_units -to $_units -units off]
        } else {
            set num1 $_num
        }

        # normalize the value of num2
        if {$_units2 ne ""} {
            set num2 [Rappture::Units::convert $_num2 \
                -context $_units2 -to $_units -units off]
        } else {
            set num2 $_num2
        }

        return [cmpdbl $num1 $num2]
    }
}