summaryrefslogtreecommitdiff
path: root/lib/lib/Math.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/lib/Math.tcl')
-rwxr-xr-xlib/lib/Math.tcl954
1 files changed, 954 insertions, 0 deletions
diff --git a/lib/lib/Math.tcl b/lib/lib/Math.tcl
new file mode 100755
index 0000000..bf2be0d
--- /dev/null
+++ b/lib/lib/Math.tcl
@@ -0,0 +1,954 @@
+#!/usr/bin/tclsh
+
+############################################################################
+# Copyright (C) 2007-2009 by Martin Ošmera #
+# martin.osmera@gmail.com #
+# #
+# This program is free software; you can redistribute it and#or modify #
+# it under the terms of the GNU General Public License as published by #
+# the Free Software Foundation; either version 2 of the License, or #
+# (at your option) any later version. #
+# #
+# This program is distributed in the hope that it will be useful, #
+# but WITHOUT ANY WARRANTY; without even the implied warranty of #
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
+# GNU General Public License for more details. #
+# #
+# You should have received a copy of the GNU General Public License #
+# along with this program; if not, write to the #
+# Free Software Foundation, Inc., #
+# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
+############################################################################
+
+# --------------------------------------------------------------------------
+# DESCRIPTION
+# Primarily implements convertions between numeric systems and angle units.
+# --------------------------------------------------------------------------
+
+## ----------------------------------------------------------------------
+## Converts between numeric systems and checks numbers types
+ #
+ # Supported num. systems: binary, octal, decimal, hexadecimal and ASCII.
+ # note: Excepting H->Q and Q->H, are all convertions computed
+ # directly (for speed improvement).
+ # By default maximal number length after dot is 20 (for DEC -> ...).
+ # ----------------------------------------------------------------------
+ #
+ # USAGE:
+ #
+ # puts [ NumSystem::hex2dec F.4 ] ;# --> 15.25
+ # puts [ NumSystem::hex2oct F.4 ] ;# --> 17.2
+ # puts [ NumSystem::hex2bin F.4 ] ;# --> 1111.01
+ #
+ # puts [ NumSystem::dec2hex 15.25 ] ;# --> F.4
+ # puts [ NumSystem::dec2oct 15.25 ] ;# --> 17.2
+ # puts [ NumSystem::dec2bin 15.25 ] ;# --> 1111.01
+ #
+ # puts [ NumSystem::oct2hex 17.2 ] ;# --> F.4
+ # puts [ NumSystem::oct2dec 17.2 ] ;# --> 15.25
+ # puts [ NumSystem::oct2bin 17.2 ] ;# --> 1111.01
+ #
+ # puts [ NumSystem::bin2hex 1111.01 ] ;# --> F.4
+ # puts [ NumSystem::bin2dec 1111.01 ] ;# --> 15.25
+ # puts [ NumSystem::bin2oct 1111.01 ] ;# --> 17.2
+ #
+ # puts [ NumSystem::ascii2dec @ ] ;# --> 64
+ # puts [ NumSystem::ascii2bin @ ] ;# --> 01000000
+ #
+ # puts [ NumSystem::ishex F.4 ] ;# --> 1
+ # puts [ NumSystem::isdec 15.25 ] ;# --> 1
+ # puts [ NumSystem::isoct 17.2 ] ;# --> 1
+ # puts [ NumSystem::isbin 1111.01 ] ;# --> 1
+ # -----------------------------------------------------------------------
+
+namespace eval NumSystem {
+
+ variable precision {20} ;# maximal number of digits after dot
+
+ # -----------------------------------------------------------------------
+ # NUMERIC SYSTEMS CONVERTIONS
+ # -----------------------------------------------------------------------
+
+ # HEX -> ...
+
+ ## Hexadecimal -> Decimal
+ # required procedures: `is_X', `hexoct_to_dec', `aux_hexoct_to_dec', `asserthex', `ishex'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc hex2dec {number} {
+ return [hexoct_to_dec 16 $number]
+ }
+
+ ## Hexadecimal -> Octal
+ # required procedures: `is_X', `bin2oct', `hex2bin', `asserthex', `assertbin', `ishex', isbin'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc hex2oct {number} {
+ return [bin2oct [hex2bin $number]]
+ }
+
+ ## Hexadecimal -> Binary
+ # required procedures: `asserthex', `ishex'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc hex2bin {number} {
+
+ # verify value validity
+ asserthex $number
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # make it upper-case
+ set number [string toupper $number]
+
+ # split value to list of chars
+ set number [split $number ""]
+
+ # convert value
+ set result {}
+ foreach char $number {
+ switch $char {
+ {0} {append result {0000}}
+ {1} {append result {0001}}
+ {2} {append result {0010}}
+ {3} {append result {0011}}
+ {4} {append result {0100}}
+ {5} {append result {0101}}
+ {6} {append result {0110}}
+ {7} {append result {0111}}
+ {8} {append result {1000}}
+ {9} {append result {1001}}
+ {A} {append result {1010}}
+ {B} {append result {1011}}
+ {C} {append result {1100}}
+ {D} {append result {1101}}
+ {E} {append result {1110}}
+ {F} {append result {1111}}
+ {.} {append result {.}}
+ }
+ }
+
+ # return result
+ regsub {^0+} $result {} result
+ if {[regexp {\.} $result]} {
+ regsub {0+$} $result {} result
+ }
+ regsub {\.$} $result {} result
+ regsub {^\.} $result {0.} result
+ if {[string length $result] == 0} {
+ set result 0
+ }
+ return $sign$result
+ }
+
+ # DEC -> ...
+
+ ## Decimal -> Hexadecimal
+ # required procedures: `is_X', `assertdec', isdec'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc dec2hex {number} {
+ return [dec_to_X 16 $number]
+ }
+
+ ## Decimal -> Octal
+ # required procedures: `is_X', `assertdec', isdec'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc dec2oct {number} {
+ return [dec_to_X 8 $number]
+ }
+
+ ## Decimal -> Binary
+ # required procedures: `is_X', `assertdec', `isdec'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc dec2bin {number} {
+ return [dec_to_X 2 $number]
+ }
+
+ # OCT -> ...
+
+ ## Octal -> Hexadecimal
+ # required procedures: `is_X', `bin2hex', `oct2bin', `bin_to_hexoct',
+ # `aux_hexoct_to_dec', `assertoct', `assertbin',`isbin',`isoct'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc oct2hex {number} {
+ return [bin2hex [oct2bin $number]]
+ }
+
+ ## Octal -> Decimal
+ # required procedures: `is_X', `bin_to_hexoct', `aux_hexoct_to_dec', `assertoct',`isoct'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc oct2dec {number} {
+ return [hexoct_to_dec 8 $number]
+ }
+
+ ## Octal -> Binary
+ # required procedures: `is_X', `assertoct', isoct'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc oct2bin {number} {
+
+ # verify value validity
+ assertoct $number
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # split value to list of chars
+ set number [split $number ""]
+
+ # convert value
+ set result {}
+ foreach char $number {
+ switch $char {
+ {0} {append result {000}}
+ {1} {append result {001}}
+ {2} {append result {010}}
+ {3} {append result {011}}
+ {4} {append result {100}}
+ {5} {append result {101}}
+ {6} {append result {110}}
+ {7} {append result {111}}
+ {.} {append result {.}}
+ }
+ }
+
+ # return result
+ regsub {^0+} $result {} result
+ if {[regexp {\.} $result]} {
+ regsub {0+$} $result {} result
+ }
+ regsub {\.$} $result {} result
+ regsub {^\.} $result {0.} result
+ if {[string length $result] == 0} {
+ set result 0
+ }
+ return $sign$result
+ }
+
+ # BIN -> ...
+
+ ## Binary -> Hexadecimal
+ # required procedures: `is_X', `assertbin', isbin', `bin_to_hexoct'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc bin2hex {number} {
+ assertbin $number ;# verify value validity
+ return [bin_to_hexoct 16 $number] ;# convert value
+ }
+
+ ## Binary -> Decimal
+ # required procedures: `is_X', `assertbin', isbin'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc bin2dec {number} {
+
+ # verify value validity
+ assertdec $number
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # split value to int. part
+ regexp {^\d+} $number int
+
+ # split value to frac. part
+ if {[regexp {\.\d+$} $number frac]} {
+ set frac [string range $frac 1 end]
+ set nofrac 0
+ } {
+ set frac {}
+ set nofrac 1
+ }
+
+ # compute int. part
+ set tmp [expr [string length $int] -1]
+ regexp {^\d+} [expr pow(2,$tmp)] tmp
+ set result 0
+ foreach value [split $int ""] {
+ if {$value} {
+ set result [expr {$result+$tmp}]
+ }
+ set tmp [expr {$tmp / 2}]
+ if {$tmp == 0} {break}
+ }
+ set int $result
+
+ # compute frac. part
+ if {!$nofrac} {
+ set tmp 0.5
+ set result 0
+ foreach value [split $frac ""] {
+ if {$value} {
+ set result [expr {$result+$tmp}]
+ }
+ set tmp [expr {$tmp / 2}]
+ }
+ regexp {\d+$} $result frac
+
+ # return converted value with frac.
+ return $sign$int.$frac
+ }
+
+ # return converted value without frac.
+ return $sign$int
+ }
+
+ ## Binary -> Octal
+ # required procedures: `is_X', `assertbin', isbin', `bin_to_hexoct'
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc bin2oct {number} {
+ assertbin $number ;# verify value validity
+ return [bin_to_hexoct 8 $number] ;# convert value
+ }
+
+ ## Ascii char -> Bin
+ # required procedures: (none)
+ # @parm Char number - value to convert
+ # @return mixed - converted value or an empty string
+ proc ascii2bin {number} {
+ if {[string bytelength $number] != 1} {
+ return {}
+ }
+
+ set result {}
+ scan $number {%c} result
+ if {$result != {}} {
+ return [dec2bin $result]
+ }
+
+ return $result
+ }
+
+ ## Ascii char -> Dec
+ # required procedures: (none)
+ # @parm Char number - value to convert
+ # @return mixed - converted value or an empty string
+ proc ascii2dec {number} {
+ if {[string bytelength $number] != 1} {
+ return {}
+ }
+ set result {}
+ scan $number {%c} result
+
+ return $result
+ }
+
+ # -----------------------------------------------------------------------
+ # TYPE ASSERTION
+ # -----------------------------------------------------------------------
+
+ ## Raise error if the given string is not an hexadecimal value
+ # require procedures: `is_X',`ishex'
+ # @parm String number - string to evaluate
+ # @return mixed - void (failure) or 1 (successful)
+ proc asserthex {number} {
+ if {![ishex $number]} {
+ error "asserthex: Excepted hexadecimal value but got \"$number\""
+ } {
+ return 1
+ }
+ }
+
+ ## Raise error if the given string is not an decimal value
+ # require procedures: `is_X',`isdec'
+ # @parm String number - string to evaluate
+ # @return mixed - void (failure) or 1 (successful)
+ proc assertdec {number} {
+ if {![isdec $number]} {
+ error "assertdec: Excepted decimal value but got \"$number\""
+ } {
+ return 1
+ }
+ }
+
+ ## Raise error if the given string is not an octal value
+ # require procedures: `is_X',`isoct'
+ # @parm String number - string to evaluate
+ # @return mixed - void (failure) or 1 (successful)
+ proc assertoct {number} {
+ if {![isoct $number]} {
+ error "assertoct: Excepted octal value but got \"$number\""
+ } {
+ return 1
+ }
+ }
+
+ ## Raise error if the given string is not an binary value
+ # require procedures: `is_X',`isbin'
+ # @parm String number - string to evaluate
+ # @return mixed - void (failure) or 1 (successful)
+ proc assertbin {number} {
+ if {![isbin $number]} {
+ error "assertbin: Excepted binary value but got \"$number\""
+ } {
+ return 1
+ }
+ }
+
+ # -----------------------------------------------------------------------
+ # TYPE CHECKING
+ # -----------------------------------------------------------------------
+
+ ## Check if the given string can be an Hexadecimal value
+ # require procedure: `is_X'
+ # @parm String number - value to evaluate
+ # @return bool
+ proc ishex {number} {
+ return [is_X {^[0-9A-Fa-f\.]+$} $number]
+ }
+
+ ## Check if the given string can be an Decimal value
+ # require procedure: `is_X'
+ # @parm String number - value to evaluate
+ # @return bool
+ proc isdec {number} {
+ return [is_X {^[0-9\.]+$} $number]
+ }
+
+ ## Check if the given string can be an Octal value
+ # require procedure: `is_X'
+ # @parm String number - value to evaluate
+ # @return bool
+ proc isoct {number} {
+ return [is_X {^[0-7\.]+$} $number]
+ }
+
+ ## Check if the given string can be an Binary value
+ # require procedure: `is_X'
+ # @parm String number - value to evaluate
+ # @return bool
+ proc isbin {number} {
+ return [is_X {^[01\.]+$} $number]
+ }
+
+ # -----------------------------------------------------------------------
+ # AUXILIARY PROCEDURES
+ # -----------------------------------------------------------------------
+
+ ## Auxiliary procedure for convering hex. and oct. to dec.
+ # require procedures: `is_X',`aux_hexoct_to_dec', `assertoct', `asserthex', `ishex', `isoct'
+ # @access PRIVATE
+ # @parm base - source numeric system, posible values are: 8 and 16
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc hexoct_to_dec {base number} {
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # make number upper-case
+ set number [string toupper $number]
+
+ # verify value validity
+ if {$base == 8} {
+ assertoct $number
+ set char_len 3
+ } {
+ asserthex $number
+ set char_len 4
+ }
+
+ # split value to int. part
+ regexp {^[^\.]+} $number int
+
+ # split value to frac. part
+ if {[regexp {\.[^\.]+$} $number frac]} {
+ set frac [string range $frac 1 end]
+ set nofrac 0
+ } {
+ set frac {}
+ set nofrac 1
+ }
+
+ # compute int. part
+ if {$base == 8} {
+ set int [expr "0$int"]
+ } {
+ set int [expr "0x$int"]
+ }
+
+ # compute frac. part
+ if {!$nofrac} {
+ set frac [aux_hexoct_to_dec [split $frac {}] 1.0 $base]
+ regexp {\d+$} $frac frac
+ return $sign$int.$frac
+ }
+ return $sign$int
+ }
+
+ ## Auxiliary procedure for convering hex. and oct. to dec.
+ # require procedures: none
+ # @access PRIVATE
+ # @parm List vals_list - value to convert splited to a single characters
+ # @parm Number v0 - decimal value of highes bit in the number multipled by 2
+ # @parm base - source numeric system, posible values are: 8 and 16
+ # @return Number - converted value
+ proc aux_hexoct_to_dec {vals_list v0 base} {
+ set result 0
+
+ foreach char $vals_list {
+
+ if {$base == 8} {
+ set v3 $v0
+ } {
+ set v3 [expr {$v0 / 2}]
+ }
+ set v2 [expr {$v3 / 2}]
+ set v1 [expr {$v2 / 2}]
+ set v0 [expr {$v1 / 2}]
+
+ switch $char {
+ {0} {set bool_map {0 0 0 0}}
+ {1} {set bool_map {0 0 0 1}}
+ {2} {set bool_map {0 0 1 0}}
+ {3} {set bool_map {0 0 1 1}}
+ {4} {set bool_map {0 1 0 0}}
+ {5} {set bool_map {0 1 0 1}}
+ {6} {set bool_map {0 1 1 0}}
+ {7} {set bool_map {0 1 1 1}}
+ {8} {set bool_map {1 0 0 0}}
+ {9} {set bool_map {1 0 0 1}}
+ {A} {set bool_map {1 0 1 0}}
+ {B} {set bool_map {1 0 1 1}}
+ {C} {set bool_map {1 1 0 0}}
+ {D} {set bool_map {1 1 0 1}}
+ {E} {set bool_map {1 1 1 0}}
+ {F} {set bool_map {1 1 1 1}}
+ }
+
+ foreach cond $bool_map value "$v3 $v2 $v1 $v0" {
+ if {$cond} {
+ set result [expr {$result+$value}]
+ }
+ }
+ }
+ return $result
+ }
+
+ ## Auxiliary procedure for convering bin. to hex. and oct.
+ # require procedures: none
+ # @access PRIVATE
+ # @parm Int base - target numeric system, posible values are: 8 and 16
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc bin_to_hexoct {base number} {
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # set some essential variables
+ if {$base == 8} {
+ set modulo 3
+ set mod_1 2
+ set padding {}
+ set convCmd {oct_to_bin}
+ } {
+ set modulo 4
+ set mod_1 3
+ set padding {0}
+ set convCmd {hex_to_bin}
+ }
+
+ # split value to int. and frac. part
+ regexp {^\d+} $number int
+ if {[regexp {\.\d+$} $number frac]} {
+ set frac [string range $frac 1 end]
+ set nofrac 0
+ } {
+ set frac {}
+ set nofrac 1
+ }
+
+ # convert int
+ set result {}
+
+ set length [string length $int]
+ set length [expr {($length % $modulo) - 1}]
+ if {$length >= 0} {
+ set firstvalue [string range $int 0 $length]
+ set int [string range $int [expr {$length + 1}] end]
+
+ switch $length {
+ {0} {set firstvalue "${padding}00$firstvalue"}
+ {1} {set firstvalue "${padding}0$firstvalue"}
+ {2} {set firstvalue "${padding}$firstvalue"}
+ }
+
+ lappend result $firstvalue
+ }
+
+ while {$int != ""} {
+ lappend result [string range $int 0 $mod_1]
+ set int [string range $int $modulo end]
+ }
+
+ set int [$convCmd $result]
+ regsub {^0+} $int {} int
+ if {$int == {}} {set int 0}
+
+ # convert frac
+ set result {}
+ if {!$nofrac} {
+ # make list
+ set idx -1
+ while {$frac != ""} {
+ lappend result [string range $frac 0 $mod_1]
+ set frac [string range $frac $modulo end]
+ incr idx
+ }
+
+ set lastValue [lindex $result $idx]
+ switch [string length $lastValue] {
+ {1} {lset result $idx "${lastValue}${padding}00"}
+ {2} {lset result $idx "${lastValue}${padding}0"}
+ {3} {lset result $idx "${lastValue}${padding}"}
+ }
+
+ set frac [$convCmd $result]
+ regsub {0+$} $frac {} frac
+ if {$frac == {}} {set frac 0}
+
+ # return converted value with frac.
+ return $sign$int.$frac
+ }
+
+ # return converted value without frac.
+ return $sign$int
+ }
+
+ ## Auxiliary procedure for convering dec to hex, oct, bin
+ # require procedures: `is_X', `assertdec', `isdec'
+ # @access PRIVATE
+ # @parm Int base - target numeric system, posible values are: 2, 8, 10, 16
+ # @parm Number number - value to convert
+ # @return Number - converted value
+ proc dec_to_X {base number} {
+ variable precision
+
+ # verify values validity
+ if {!($base==16 || $base==10 || $base==8 || $base==2)} {
+ error "dec_to_X: Unrecognized numeric system \"$base\". Possible values are: 2, 8, 10, 16"
+ }
+ assertdec $number
+
+ # Number can be negative value
+ set sign {}
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ set sign {-}
+ }
+
+ # split value to int. and frac. part
+ regexp {^\d+} $number int
+ if {[regexp {\.\d+$} $number frac]} {
+ set frac [string range $frac 1 end]
+ set nofrac 0
+ } {
+ set frac {}
+ set nofrac 1
+ }
+
+ if {[string length $int] > 12} {
+ error "Unable to convert, value is too high"
+ }
+
+ # convert integer part
+ set reminder $int
+ set int ""
+ while {$reminder > 0} {
+ set tmp [expr {$reminder % $base}]
+ if {$base == 16} {
+ switch $tmp {
+ 10 {set tmp A}
+ 11 {set tmp B}
+ 12 {set tmp C}
+ 13 {set tmp D}
+ 14 {set tmp E}
+ 15 {set tmp F}
+ }
+ }
+ set int ${tmp}${int}
+ regexp {^\d+} [expr {$reminder / $base}] reminder
+ }
+ if {$int == {}} {set int 0}
+
+ # convert frac. part
+ if {!$nofrac} {
+ set reminder "0.$frac"
+ set frac ""
+ for {set i 0} {$i < $precision} {incr i} {
+ set reminder [expr {$reminder * $base}]
+ regexp {^\d+} $reminder tmp
+ set reminder [expr {$reminder - $tmp}]
+ if {$base == 16} {
+ switch $tmp {
+ 10 {set tmp A}
+ 11 {set tmp B}
+ 12 {set tmp C}
+ 13 {set tmp D}
+ 14 {set tmp E}
+ 15 {set tmp F}
+ }
+ }
+ append frac $tmp
+ if {$reminder == 0} {break}
+ }
+ if {$frac == {}} {set frac 0}
+
+ # return converted value with frac.
+ return $sign$int.$frac
+ }
+
+ # return converted value without frac.
+ return $sign$int
+ }
+
+ ## Auxiliary procedure for convering oct to bin
+ # require procedures: none
+ # @access PRIVATE
+ # @parm List vals_list - value to convert splited to single characters
+ # @return Number - converted value
+ proc oct_to_bin {vals_list} {
+
+ # iterate over items in list and traslate them
+ set result ""
+ foreach char $vals_list {
+ # convert item
+ switch $char {
+ {000} {append result 0}
+ {001} {append result 1}
+ {010} {append result 2}
+ {011} {append result 3}
+ {100} {append result 4}
+ {101} {append result 5}
+ {110} {append result 6}
+ {111} {append result 7}
+ }
+ }
+
+ # done
+ return $result
+ }
+
+ ## Auxiliary procedure for convering hex to bin
+ # require procedures: none
+ # @access PRIVATE
+ # @parm List vals_list - value to convert splited to single characters
+ # @return Number - converted value
+ proc hex_to_bin {vals_list} {
+
+ # iterate over items in list and traslate them
+ set result ""
+ foreach char $vals_list {
+ # convert item
+ switch $char {
+ {0000} {append result 0}
+ {0001} {append result 1}
+ {0010} {append result 2}
+ {0011} {append result 3}
+ {0100} {append result 4}
+ {0101} {append result 5}
+ {0110} {append result 6}
+ {0111} {append result 7}
+ {1000} {append result 8}
+ {1001} {append result 9}
+ {1010} {append result A}
+ {1011} {append result B}
+ {1100} {append result C}
+ {1101} {append result D}
+ {1110} {append result E}
+ {1111} {append result F}
+ }
+ }
+
+ # done
+ return $result
+ }
+
+ ## Auxiliary procedure for num. checking
+ # Check if the given string contain 0 or 1 dot and match the given
+ # regular expression
+ # @access PRIVATE
+ # @parm String regexpr - reg. exp. of allowed symbols
+ # @parm String number - string to evaluate
+ # return bool
+ proc is_X {regexpr number} {
+
+ # The given number can begin with minus sign
+ if {[string index $number 0] == {-}} {
+ set number [string range $number 1 end]
+ }
+
+ # 1st condition (check for allowed symbols)
+ if {![regexp $regexpr $number]} {
+ return 0
+ }
+
+ # 2nd condition (must contain maximaly one dot)
+ set cnd1 [split $number {\.}]
+ if {[llength $cnd1] > 2} {
+ return 0
+ }
+
+ # 3rd condition (dot must not be at the begining or end)
+ if {[regexp {^\.} $number]} {return 0}
+ if {[regexp {\.$} $number]} {return 0}
+
+ # return result
+ return 1
+ }
+}
+
+
+## ----------------------------------------------------------------------
+## Converts between angle units and normalizes angle values
+ #
+ # Supported angle units: rad, deg, grad
+ # note: all converted angles are normalized before convertion
+ # -----------------------------------------------------------------------
+ #
+ # USAGE:
+ #
+ # puts [ Angle::adjustAngle deg -700 ] ;# --> 20.0000000016 (should be exactly 20)
+ #
+ # puts [ Angle::rad2deg $Angle::PI] ;# --> 180.0
+ # puts [ Angle::rad2grad $Angle::PI] ;# --> 200.0
+ #
+ # puts [ Angle::deg2rad 180 ] ;# --> 3.141592654
+ # puts [ Angle::deg2grad 180 ] ;# --> 200.0
+ #
+ # puts [ Angle::grad2deg 200 ] ;# --> 180.0
+ # puts [ Angle::grad2rad 200 ] ;# --> 3.141592654
+ #
+ # puts $Angle::PI ;# --> 3.141592654
+ # -----------------------------------------------------------------------
+
+namespace eval Angle {
+
+ variable PI {3.141592654} ;# Pi
+
+ # CONVERSION OF ANGLE VALUES
+ # --------------------------
+
+ ## Radians -> Degrees
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc rad2deg {angle} {
+ variable PI
+
+ set angle [adjustAngle rad $angle]
+ return [expr {(180 / $PI) * $angle}]
+ }
+
+ ## Radians -> GRAD
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc rad2grad {angle} {
+ variable PI
+
+ set angle [adjustAngle rad $angle]
+ return [expr {(200 / $PI) * $angle}]
+ }
+
+ ## Degrees -> Radians
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc deg2rad {angle} {
+ variable PI
+
+ set angle [adjustAngle deg $angle]
+ return [expr {($PI / 180) * $angle}]
+ }
+
+ ## Degrees -> Radians
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc deg2grad {angle} {
+ set angle [adjustAngle deg $angle]
+ return [expr {(10 / 9.0) * $angle}]
+ }
+
+ ## GRAD -> Degrees
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc grad2deg {angle} {
+ set angle [adjustAngle grad $angle]
+ return [expr {0.9 * $angle}]
+ }
+
+ ## GRAD -> Radians
+ # require procedure: `adjustAngle'
+ # @parm Number angle - angle value to convert
+ # @return Nubmber - converted value
+ proc grad2rad {angle} {
+ variable PI
+
+ set angle [adjustAngle grad $angle]
+ return [expr {($PI / 200) * $angle}]
+ }
+
+ ## Ajust angle value and polarity
+ # @parm String unit - unit of angle (rad | deg | grad)
+ # @parm angle angle - value of angle
+ # @return angle - adjusted angle value
+ proc adjustAngle {unit angle} {
+ variable PI
+
+ # verify if the given angle is a valid number
+ if {![regexp {^\-?\d+(\.\d+)?$} $angle]} {
+ error "adjustAngle: Excepted integer or float but got \"$angle\""
+ }
+
+ # determinate base for division
+ switch $unit {
+ {rad} {set base [expr {$PI * 2}]}
+ {deg} {set base 360.0}
+ {grad} {set base 400.0}
+ default {error "Unrecognized option \"$unit\""}
+ }
+
+ # is negative or something else ?
+ if {$angle < 0} {set minus 1} {set minus 0}
+
+ # adjust angle value
+ set angle [expr {$angle / $base}]
+ regsub {^[-]?\d+} $angle {0} angle
+ set angle [expr {$angle * $base}]
+
+ # adjust angle polarity
+ if {$minus} {return [expr {$base - $angle}]}
+ return $angle
+ }
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-19 01:47:26 +0000