summaryrefslogtreecommitdiff
path: root/lib/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib/lib')
-rwxr-xr-xlib/lib/Math.tcl954
-rwxr-xr-xlib/lib/hexeditor.tcl2705
-rwxr-xr-xlib/lib/ihextools.tcl523
-rwxr-xr-xlib/lib/innerwindow.tcl360
-rwxr-xr-xlib/lib/settings.tcl293
5 files changed, 4835 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
+ }
+}
diff --git a/lib/lib/hexeditor.tcl b/lib/lib/hexeditor.tcl
new file mode 100755
index 0000000..ceb9192
--- /dev/null
+++ b/lib/lib/hexeditor.tcl
@@ -0,0 +1,2705 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+# 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
+# This class provides simple hexeditor with selectable view mode
+# and optional ascii view. See constructor and section
+# "GENERAL PUBLIC INTERFACE" for more details.
+# --------------------------------------------------------------------------
+
+class HexEditor {
+ common DEBUG 0 ;# Bool: More secure input data checking
+ # Font for editor text widget(s) - normal size
+ common view_font_n [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -15 \
+ ]
+ # Font for editor headers - normal size
+ common header_font_n [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -15 \
+ -weight bold \
+ ]
+ # Font for editor headers - small size
+ common header_font_s [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -12 \
+ -weight bold \
+ ]
+ common view_font_s $header_font_s ;# Font for editor text widget(s) - small size
+ common header_bg {#9999FF} ;# Background color for headers
+ common header_fg {#FFFFFF} ;# Foreground color for headers
+ common n_row_bg {#DDDDDD} ;# Background color for Nth rows
+ common highlight_fg {#FFAA00} ;# Foreground color for chaged values
+ common highlight_bg {#888888} ;# Background color for background highlight (variant 0)
+ common highlight_bg1 {#FFDD33} ;# Background color for background highlight (variant 1)
+ common highlight_bg2 {#FFAA00} ;# Background color for background highlight (variant 2)
+ common unprintable_fg {#FF0000} ;# Foreground color for unprintable characters in ascii view
+ common current_full_bg {#00FF00} ;# Background color for cursor in active view
+ common current_half_bg {#AAFFAA} ;# Background color for cursor in inactive view
+ ## Variables related to find dialog
+ common find_dialog_win {} ;# Widget: Find dialog
+ common find_dialog_count 0 ;# Int: Counter find dialog opens
+ common text_to_find {} ;# String: Text/Value to find
+ common where_to_search left ;# String: Where to search (left or right view)
+ ## Array: Find options
+ # fc - Bool: Find option "From cursor"
+ # bw - Bool: Find option "Backwards"
+ common find_opt
+
+ private variable left_top_button ;# ID of button in left top corner (select all)
+ private variable left_address_bar ;# ID of left address bar
+ private variable left_header ;# ID of left header (horizontal address bar)
+ private variable right_header ;# ID of right header (horizontal address bar)
+ private variable left_view ;# ID of text of left view
+ private variable right_view ;# ID of text of right view
+ private variable scrollbar ;# ID of vertical crollbar
+ private variable main_frame ;# ID of main frame (frame for all these widgets)
+
+ private variable view_font ;# Current font for left (and right) view
+ private variable header_font ;# Current font for headers
+ private variable highlighted_cells ;# Array of Bool: highlighted cells
+ private variable bg_hg ;# Array of Bool: cells with background highlight (variant 0)
+ private variable bg_hg1 ;# Array of Bool: cells with background highlight (variant 1)
+ private variable bg_hg2 ;# Array of Bool: cells with background highlight (variant 2)
+
+ private variable current_cell_changed_cmd {} ;# Command to call on event "CurrentCellChanged"
+ private variable cell_value_changed_cmd {} ;# Command to call on event "CellValueChanged"
+ private variable cell_enter_cmd {} ;# Command to call on event "CellMouseEnter"
+ private variable cell_leave_cmd {} ;# Command to call on event "CellMouseLeave"
+ private variable cell_motion_cmd {} ;# Command to call on event "CellMouseMotion"
+ private variable scroll_action_cmd {} ;# Command to call on event "Scroll"
+ private variable selection_action_cmd {}
+ private variable current_cell_changed_cmd_set 0 ;# Bool: current_cell_changed_cmd not empty
+ private variable cell_value_changed_cmd_set 0 ;# Bool: cell_value_changed_cmd not empty
+ private variable cell_enter_cmd_set 0 ;# Bool: cell_enter_cmd not empty
+ private variable cell_leave_cmd_set 0 ;# Bool: cell_leave_cmd not empty
+ private variable cell_motion_cmd_set 0 ;# Bool: cell_motion_cmd not empty
+ private variable scroll_action_cmd_set 0 ;# Bool: scroll_action_cmd not empty
+ private variable selection_action_cmd_set 0
+
+ private variable cell_under_cursor {0.0} ;# Text index of cell under mouse pointer
+ private variable in_cell 0 ;# Bool: mouse pointer in cell (see code below)
+ private variable motion_binding 0 ;# Bool: Bindings for special mouse events set
+ private variable view_mode ;# Current view mode (one of {dec hec oct bin})
+ private variable ascii_view ;# Bool: Ascii view avaliable
+ private variable address_length ;# Int: Length of addresses on left address bar
+ private variable physical_height ;# Int: Height of view in rows
+ private variable width ;# Int: Number of cells in left view in one row
+ private variable height ;# Int: Number of rows in left view
+ private variable total_capacity ;# Int: Total editor capacity in bytes
+ private variable left_view_width ;# Int: Number of charcers in left view on one row
+ private variable value_length ;# Int: Number of characters in one cell
+ private variable cur_idx 0.0 ;# TextIndex: Last text index before selection
+ private variable selected_view {} ;# ID of active view
+ private variable popup_menu ;# ID of popup menu for both views
+ private variable selection_sync_in_P 0 ;# Bool: View selection synchronization in progress
+ private variable scroll_in_progress 0 ;# Bool: Scrolling procedure in progress
+ private variable cursor_address 0 ;# Int: Address of the current cell
+ private variable top_row 1 ;# Int: Number of topmost visible row
+ private variable disabled 0 ;# Bool: Editor disabled
+ private variable last_find_index {} ;# String: Index of first matched characted (find dialog)
+ private variable scrollbar_visible 0 ;# Bool: Scrollbar visibility flag
+
+ ## Costructor
+ # @parm WidgetPath mainframe - Path where to create editor main frame
+ # @parm Int Width - Number of columns in row (max. 16)
+ # @parm Int Height - Number rows
+ # @parm Int addresslength - Number of characters on one row in left address bar
+ # @parm String mode - Initial view mode (one of {hex dec bin oct})
+ # @parm Bool ascii - Display also ascii view
+ # @parm Bool small - Use small fonts
+ # @parm Int physicalheight - Heigh of views in rows
+ # @parm Int totalcapacity - Total capacity in Bytes
+ constructor {mainframe Width Height addresslength mode ascii small physicalheight totalcapacity} {
+ # Set object variables
+ set view_mode $mode
+ set ascii_view $ascii
+ set physical_height $physicalheight
+ set address_length $addresslength
+ set width $Width
+ set height $Height
+ set total_capacity $totalcapacity
+
+ # Initalize array of highlighted cells
+ for {set i 0} {$i < $total_capacity} {incr i} {
+ set highlighted_cells($i) 0
+ set bg_hg($i) 0
+ set bg_hg1($i) 0
+ set bg_hg2($i) 0
+ }
+
+ # Validate inputs arguments
+ if {$width > 16} {
+ error "Width cannot be grater than 16"
+ }
+ if {![string is boolean $small]} {
+ error "Invalid value for argument small: $small"
+ }
+
+ # Determinate fonts
+ if {$small} {
+ set view_font $view_font_s
+ set header_font $header_font_s
+ } {
+ set view_font $view_font_n
+ set header_font $header_font_n
+ }
+
+ # Create main frame
+ set main_frame [frame $mainframe]
+ bind $main_frame <Destroy> "catch {::itcl::delete object $this}"
+
+ # Create GUI components
+ create_gui ;# Create text widgets
+ create_popup_menu ;# Create popup menu
+ create_tags ;# Create text tags
+ create_bindings ;# Create bindings
+ fill_headers ;# Fill headers with appropriate addresses
+ fill_views ;# Fill views with spaces
+
+ # Finalize GUI initialization
+ $left_view mark set insert 1.0
+ set_selected_view {left}
+ }
+
+ ## Object destructor
+ destructor {
+ catch {
+ destroy $main_frame
+ }
+ }
+
+ ## Create popup menu (for left & right view)
+ # @return void
+ private method create_popup_menu {} {
+ set popup_menu $main_frame.popup_menu
+ menuFactory {
+ {command {Copy} {Ctrl+C} 0
+ "text_copy" {editcopy} {}}
+ {command {Paste} {Ctrl+V} 0
+ "text_paste" {editpaste} {}}
+ {separator}
+ {command {Select all} {Ctrl+A} 0
+ "text_selall" {} {}}
+ {separator}
+ {command {Find} {Ctrl+F} 0
+ "find_dialog" {find} {}}
+ {command {Find next} {F3} 5
+ "find_next" {1downarrow} {}}
+ {command {Find previous} {Shift+F3} 8
+ "find_prev" {1uparrow} {}}
+ } $popup_menu 0 "$this " 0 {}
+
+ # Configure menu entries
+ $popup_menu entryconfigure [::mc "Find next"] -state disabled
+ $popup_menu entryconfigure [::mc "Find previous"] -state disabled
+ }
+
+ ## Create all hexeditor widgets expect popup menu
+ # @return void
+ private method create_gui {} {
+ # Determinate width of left view text widget and cell width
+ switch -- $view_mode {
+ {hex} {
+ set left_view_width [expr {$width * 3 - 1}]
+ set value_length 2
+ }
+ {oct} {
+ set left_view_width [expr {$width * 4 - 1}]
+ set value_length 3
+ }
+ {dec} {
+ set left_view_width [expr {$width * 4 - 1}]
+ set value_length 3
+ }
+ default {
+ error "Invalid mode: $view_mode"
+ }
+ }
+
+ # Create button "Select All" in left top corner
+ set left_top_button [button $main_frame.left_top_button \
+ -bg $header_bg -bd 0 -padx 0 -pady 0 \
+ -activebackground white -relief flat \
+ -highlightthickness 0 \
+ -command "$main_frame.left_view tag add sel 1.0 end" \
+ ]
+ DynamicHelp::add $main_frame.left_top_button -text [mc "Select all"]
+ # Create left address bar
+ set left_address_bar [text $main_frame.left_address_bar \
+ -height $physical_height -width $address_length \
+ -font $header_font -bg $header_bg \
+ -relief flat -bd 1 -fg $header_fg \
+ -highlightthickness 0 -takefocus 0 \
+ -yscrollcommand "$this scrollSet" \
+ -cursor left_ptr \
+ ]
+ grid $left_top_button -row 0 -column 0 -sticky nsew
+ grid $left_address_bar -row 1 -column 0 -sticky ns
+
+ # Create horizontal header for left view
+ set left_header [text $main_frame.left_header \
+ -height 1 -width $left_view_width \
+ -font $header_font -bg $header_bg \
+ -relief flat -bd 1 -fg $header_fg \
+ -highlightthickness 0 -takefocus 0 \
+ -cursor left_ptr \
+ ]
+ grid $left_header -row 0 -column 1
+ # Create horizontal header for ascii view
+ if {$ascii_view} {
+ grid [ttk::separator $main_frame.sep \
+ -orient horizontal \
+ ] -row 0 -rowspan 2 -column 2 -sticky ns
+
+ set right_header [text $main_frame.right_header \
+ -height 1 -width $width -bg $header_bg \
+ -font $header_font -relief flat -bd 1 \
+ -fg $header_fg -highlightthickness 0 \
+ -takefocus 0 \
+ -cursor left_ptr \
+ ]
+ grid $right_header -row 0 -column 3
+ }
+
+ # Create text widget of the left view
+ set left_view [text $main_frame.left_view \
+ -font $header_font -relief flat -bd 1 \
+ -width $left_view_width -bg white \
+ -highlightthickness 0 -height $physical_height \
+ -yscrollcommand "$this scrollSet" \
+ ]
+ grid $left_view -row 1 -column 1 -sticky ns
+ # Create text widget for ascii view
+ if {$ascii_view} {
+ set right_view [text $main_frame.right_view \
+ -font $header_font -relief flat -bd 1 \
+ -width $width -bg white \
+ -highlightthickness 0 -height $physical_height \
+ -exportselection 0 -insertwidth 0 \
+ -yscrollcommand "$this scrollSet" \
+ ]
+ grid $right_view -row 1 -column 3 -sticky ns
+ }
+
+ # Create vertical scrollbar
+ set scrollbar [ttk::scrollbar $main_frame.scrollbar \
+ -orient vertical \
+ -command "$this scroll" \
+ ]
+ set scrollbar_visible 0
+ showHideScrollbar 1
+
+ grid rowconfigure $main_frame 1 -weight 1
+ }
+
+ ## Create event bindings for all hexeditor widgets (except popup menu)
+ # @return void
+ private method create_bindings {} {
+ ## LEFT PART
+ bindtags $left_header $left_header
+ bindtags $left_address_bar $left_address_bar
+ bindtags $left_view [list $left_view . all]
+
+ foreach key {Left Right Up Down Home End Prior Next} {
+ bind $left_view <Key-$key> "$this left_view_movement 0 {$key}; break"
+ bind $left_view <Shift-Key-$key> "$this left_view_movement 1 {$key}; break"
+ }
+ for {set i 1} {$i < 21} {incr i} {
+ bind $left_view <Key-F$i> {continue}
+ }
+ bind $left_view <Control-Key> {continue}
+ bind $left_view <Alt-Key> {continue}
+ bind $left_view <Key-BackSpace> "$this left_view_movement 0 Left; break"
+ bind $left_view <Key-Menu> "$this popup_menu left %x %y %X %Y; break"
+ bind $left_view <ButtonRelease-3> "$this popup_menu left %x %y %X %Y; break"
+ bind $left_view <Key-Tab> "$this switch_views; break"
+ if {!$::MICROSOFT_WINDOWS} {
+ bind $left_view <Key-ISO_Left_Tab> "$this switch_views; break"
+ }
+ bind $left_view <KeyPress> "$this left_view_key %A; break"
+ bind $left_view <Button-1> "$this left_view_B1 %x %y; break"
+ bind $left_view <<Paste>> "$this text_paste; break"
+ bind $left_view <Control-Key-a> "$left_view tag add sel 1.0 end"
+ bind $left_view <<Selection>> "$this left_view_selection; break"
+ bind $left_view <FocusIn> "$this set_selected_view left"
+ bind $left_view <Key-Escape> {catch {%W tag remove sel 0.0 end}; break}
+ bind $left_view <Control-Key-f> "$this find_dialog; break"
+ bind $left_view <Control-Key-F> "$this find_dialog; break"
+ bind $left_view <F3> "$this find_next; break"
+ if {!$::MICROSOFT_WINDOWS} {
+ bind $left_view <XF86_Switch_VT_3> "$this find_prev; break"
+ }
+ bind $left_view <B1-Motion> "
+ $this left_view_B1_Motion %x %y
+ $this text_view_leave
+ break"
+ foreach key {
+ <ButtonRelease-1> <B1-Enter> <B1-Leave>
+ <B2-Motion> <Button-5> <Button-4>
+ <MouseWheel> <<Copy>> <Double-Button-1>
+ } {
+ bind $left_view $key "[bind Text $key]; break"
+ }
+
+ bind $left_view <Button-4> "$this scroll scroll -3 units"
+ bind $left_view <Button-5> "$this scroll scroll +3 units"
+ bind $left_address_bar <Button-4> "$this scroll scroll -3 units"
+ bind $left_address_bar <Button-5> "$this scroll scroll +3 units"
+ bind $left_address_bar <MouseWheel> "[bind Text <MouseWheel>]; break"
+
+ ## RIGHT PART
+ if {$ascii_view} {
+ bindtags $right_view [list $right_view . all]
+ bindtags $right_header $right_header
+
+ foreach key {<Copy> Double-Button-1} {
+ bind $right_view <$key> {continue}
+ }
+ for {set i 1} {$i < 21} {incr i} {
+ bind $right_view <Key-F$i> {continue}
+ }
+ foreach event {
+ Key-Prior Key-Next Shift-Key-Up Shift-Key-Down
+ Shift-Key-Home Key-Home Shift-Key-Prior Shift-Key-Next
+ Button-1 Key-Up Key-Down
+ Shift-Key-Left Shift-Key-Right Shift-Key-End
+ } {
+ bind $right_view <$event> "
+ [bind Text <$event>]
+ $this right_view_adjust_cursor
+ break"
+ }
+ bind $right_view <Key-Left> "$this right_view_movement Left"
+ bind $right_view <Key-Right> "$this right_view_movement Right"
+ bind $right_view <Key-End> "$this right_view_movement End"
+
+ bind $right_view <B1-Motion> "
+ [bind Text <B1-Motion>]
+ $this right_view_adjust_cursor
+ $this text_view_leave
+ break"
+ bind $right_view <Key-BackSpace> "
+ [bind Text <Key-Left>]
+ $this right_view_adjust_cursor
+ break"
+ bind $right_view <Key-Menu> "$this popup_menu right %x %y %X %Y; break"
+ bind $right_view <ButtonRelease-3> "$this popup_menu right %x %y %X %Y; break"
+ bind $right_view <Key-Tab> "$this switch_views; break"
+ if {!$::MICROSOFT_WINDOWS} {
+ bind $right_view <Key-ISO_Left_Tab> "$this switch_views; break"
+ }
+ bind $right_view <KeyPress> "$this right_view_key %A; break"
+ bind $right_view <<Paste>> "$this text_paste; break"
+ bind $right_view <Control-Key-a> "$right_view tag add sel 1.0 end"
+ bind $right_view <<Selection>> "$this right_view_selection; break"
+ bind $right_view <FocusIn> "$this set_selected_view right"
+ bind $right_view <Key-Escape> {catch {%W tag remove sel 0.0 end}; break}
+ bind $right_view <Control-Key-f> "$this find_dialog; break"
+ bind $right_view <Control-Key-F> "$this find_dialog; break"
+ bind $right_view <F3> "$this find_next; break"
+ if {!$::MICROSOFT_WINDOWS} {
+ bind $right_view <XF86_Switch_VT_3> "$this find_prev; break"
+ }
+ foreach key {
+ <ButtonRelease-1> <B1-Enter> <B1-Leave>
+ <MouseWheel> <<Copy>> <Double-Button-1>
+ <B2-Motion>
+ } {
+ bind $right_view $key "[bind Text $key]; break"
+ }
+
+ bind $right_view <Button-4> "$this scroll scroll -3 units"
+ bind $right_view <Button-5> "$this scroll scroll +3 units"
+ }
+ }
+
+ ## Create text tags
+ # @return void
+ private method create_tags {} {
+ #
+ ## LEFT PART
+ #
+
+ # Cursor position
+ $left_address_bar tag configure tag_current_full \
+ -font $header_font \
+ -background $current_full_bg \
+ -foreground {#000000}
+ # Cursor position for active view and inactive view
+ foreach widget [list $left_header $left_view] {
+ $widget tag configure tag_current_full \
+ -font $header_font \
+ -background $current_full_bg \
+ -foreground {#000000}
+ $widget tag configure tag_current_half \
+ -font $header_font \
+ -background $current_half_bg \
+ -foreground {#000000}
+ }
+ # Nth row backrgound
+ $left_view tag configure tag_n_row -background $n_row_bg
+ # Cell highlight
+ $left_view tag configure tag_hg \
+ -foreground $highlight_fg \
+ -font $header_font
+ $left_view tag configure tag_bg_hg \
+ -background $highlight_bg \
+ -font $header_font
+ $left_view tag configure tag_bg_hg1 \
+ -background $highlight_bg1 \
+ -font $header_font
+ $left_view tag configure tag_bg_hg2 \
+ -background $highlight_bg2 \
+ -font $header_font
+ # Other tags
+ $left_view tag configure normal_font \
+ -font $view_font
+
+ # Set tags priorities
+ $left_view tag raise sel tag_n_row
+ $left_view tag raise sel tag_current_full
+ $left_view tag raise sel tag_current_half
+ $left_view tag raise sel tag_bg_hg
+ $left_view tag raise sel tag_bg_hg1
+ $left_view tag raise sel tag_bg_hg2
+ $left_view tag raise tag_current_full normal_font
+ $left_view tag raise tag_current_half normal_font
+ $left_view tag raise tag_bg_hg normal_font
+ $left_view tag raise tag_bg_hg1 normal_font
+ $left_view tag raise tag_bg_hg2 normal_font
+ $left_view tag raise tag_bg_hg2 tag_bg_hg1
+ $left_view tag raise tag_bg_hg tag_n_row
+ $left_view tag raise tag_bg_hg1 tag_n_row
+ $left_view tag raise tag_bg_hg2 tag_n_row
+ $left_view tag raise tag_current_full tag_n_row
+ $left_view tag raise tag_current_half tag_n_row
+ $left_view tag raise tag_current_full tag_bg_hg
+ $left_view tag raise tag_current_half tag_bg_hg
+ $left_view tag raise tag_current_full tag_bg_hg1
+ $left_view tag raise tag_current_half tag_bg_hg1
+ $left_view tag raise tag_current_full tag_bg_hg2
+ $left_view tag raise tag_current_half tag_bg_hg2
+
+ #
+ ## RIGHT PART
+ #
+ if {$ascii_view} {
+ # Unprintable characters
+ $right_view tag configure tag_np \
+ -font $view_font \
+ -foreground $unprintable_fg
+
+ # Cursor position for active view
+ $right_header tag configure tag_current_full \
+ -font $header_font \
+ -background $current_full_bg \
+ -foreground {#000000}
+ # Cursor position for inactive view
+ $right_header tag configure tag_current_half \
+ -font $header_font \
+ -background $current_half_bg \
+ -foreground {#000000}
+
+ # Cursor position for active view
+ $right_view tag configure tag_current_full \
+ -font $header_font \
+ -background $current_full_bg
+ # Cursor position for inactive view
+ $right_view tag configure tag_current_half \
+ -font $header_font \
+ -background $current_half_bg
+
+ # Nth row backrgound
+ $right_view tag configure tag_n_row -background $n_row_bg
+ # Cell highlight
+ $right_view tag configure tag_hg \
+ -foreground $highlight_fg \
+ -font $header_font
+ $right_view tag configure tag_bg_hg \
+ -background $highlight_bg \
+ -font $header_font
+ $right_view tag configure tag_bg_hg1 \
+ -background $highlight_bg1 \
+ -font $header_font
+ $right_view tag configure tag_bg_hg2 \
+ -background $highlight_bg2 \
+ -font $header_font
+
+ # Other tags
+ $right_view tag configure normal_font \
+ -font $view_font
+
+ # Set tags priorities
+ $right_view tag raise sel tag_current_full
+ $right_view tag raise sel tag_current_half
+ $right_view tag raise sel tag_n_row
+ $right_view tag raise sel tag_bg_hg
+ $right_view tag raise sel tag_bg_hg1
+ $right_view tag raise sel tag_bg_hg2
+ $right_view tag raise tag_current_full normal_font
+ $right_view tag raise tag_current_half normal_font
+ $right_view tag raise tag_bg_hg normal_font
+ $right_view tag raise tag_bg_hg1 normal_font
+ $right_view tag raise tag_bg_hg2 normal_font
+ $right_view tag raise tag_bg_hg2 tag_bg_hg1
+ $right_view tag raise tag_bg_hg tag_n_row
+ $right_view tag raise tag_bg_hg1 tag_n_row
+ $right_view tag raise tag_bg_hg2 tag_n_row
+ $right_view tag raise tag_current_full tag_n_row
+ $right_view tag raise tag_current_half tag_n_row
+ $right_view tag raise tag_current_full tag_bg_hg
+ $right_view tag raise tag_current_half tag_bg_hg
+ $right_view tag raise tag_current_full tag_bg_hg1
+ $right_view tag raise tag_current_half tag_bg_hg1
+ $right_view tag raise tag_current_full tag_bg_hg2
+ $right_view tag raise tag_current_half tag_bg_hg2
+ }
+ }
+
+ ## Restore cell highlight
+ # @parm Int address - Cell address
+ # @return void
+ private method restore_cell_highlight {address} {
+ if {$highlighted_cells($address)} {
+ set highlighted_cells($address) 0
+ setHighlighted $address 1
+ }
+ if {$bg_hg($address)} {
+ set bg_hg($address) 0
+ set_bg_hg $address 1 0
+ }
+ if {$bg_hg1($address)} {
+ set bg_hg1($address) 0
+ set_bg_hg $address 1 1
+ }
+ if {$bg_hg2($address)} {
+ set bg_hg2($address) 0
+ set_bg_hg $address 1 2
+ }
+ }
+
+ ## Fill headres with addresses
+ # @return void
+ private method fill_headers {} {
+ # Left horizontal header
+ fill_left_header
+
+ # Left address bar
+ $left_address_bar delete 1.0 end
+ $left_address_bar insert end [string repeat {0} $address_length]
+ set line {}
+ set address {}
+ for {set i 1} {$i < $height} {incr i} {
+ set address [format {%X} [expr {$i * $width}]]
+ set line "\n"
+ append line [string repeat {0} \
+ [expr {$address_length - [string length $address]}]]
+ append line $address
+ $left_address_bar insert end $line
+ }
+
+ # Right horizontal header
+ set header_values [list 0 1 2 3 4 5 6 7 8 9 A B C D E F]
+ if {$ascii_view} {
+ $right_header delete 1.0 end
+ for {set i 0} {$i < $width} {incr i} {
+ $right_header insert end [lindex $header_values $i]
+ }
+ }
+ }
+
+ ## Left horizontal header with cell addresses
+ # @return void
+ private method fill_left_header {} {
+ set header_values [list 0 1 2 3 4 5 6 7 8 9 A B C D E F]
+ $left_header delete 1.0 end
+ if {$view_mode == {hex}} {
+ set space { }
+ } {
+ $left_header insert end { }
+ set space { }
+ }
+ for {set i 0} {$i < $width} {incr i} {
+ if {$i} {
+ $left_header insert end $space
+ }
+ $left_header insert end {x}
+ $left_header insert end [lindex $header_values $i]
+ }
+ }
+
+ ## Fill all views with spaces
+ # @return void
+ public method fill_views {} {
+ # Fill left view with spaces
+ $left_view delete 1.0 end
+ set line [string repeat { } $left_view_width]
+ $left_view insert end $line
+ $left_view tag add normal_font {insert linestart} {insert lineend}
+ for {set i 1} {$i < $height} {incr i} {
+ $left_view insert end "\n"
+ $left_view tag add normal_font {insert linestart} {insert lineend}
+ $left_view insert end $line
+
+ if {![expr {$i % 3}]} {
+ $left_view tag add tag_n_row \
+ [expr {$i - 1}].$left_view_width \
+ [expr {$i + 1}].0
+ }
+ }
+
+ # Fill right view with spaces
+ if {$ascii_view} {
+ $right_view delete 1.0 end
+ set line [string repeat { } $width]
+ $right_view insert end $line
+ $right_view tag add normal_font {insert linestart} {insert lineend}
+ for {set i 1} {$i < $height} {incr i} {
+ $right_view insert end "\n"
+ $right_view tag add normal_font {insert linestart} {insert lineend}
+ $right_view insert end $line
+
+ if {![expr {$i % 3}]} {
+ $right_view tag add tag_n_row \
+ [expr {$i - 1}].$left_view_width \
+ [expr {$i + 1}].0
+ }
+ }
+ }
+ }
+
+ ## Translate cell address to text indexes
+ # @parm Int address - address to translate
+ # @return List {row column_in_right_view start_col_in_left_view end_col_in_left_view}
+ private method address_to_index {address} {
+ # Local variable
+ set row [expr {$address / $width + 1}] ;# Row
+ set cell [expr {$address % $width}] ;# Column in right view
+ set start_col 0 ;# Start column in left view
+
+ # Determinate start column
+ if {$cell} {
+ if {$view_mode != {hex}} {
+ set start_col [expr {$cell * 4}]
+ } {
+ set start_col [expr {$cell * 3}]
+ }
+ }
+
+ # Determinate end column
+ set end_col $start_col
+ if {$view_mode != {hex}} {
+ incr end_col 3
+ } {
+ incr end_col 2
+ }
+
+ # Return results
+ return [list $row $cell $start_col $end_col]
+ }
+
+ ## Translate text index to address
+ # @parm String view - View from which is index to translate
+ # @parm TextIndex index - Indext to translate
+ # @return Int address
+ private method index_to_address {view index} {
+ # Left view
+ if {$view == {left}} {
+ if {$view_mode != {hex}} {
+ set step 4
+ } {
+ set step 3
+ }
+ scan [$left_view index $index] {%d.%d} row col
+ set cell [expr {($col / $step)}]
+ # Right view
+ } {
+ scan [$right_view index $index] {%d.%d} row cell
+ }
+
+ # Return result
+ incr row -1
+ return [expr {$row * $width + $cell}]
+ }
+
+ ## Normalize column in left view
+ # @parm Int col - column to normalize
+ # @return {start_column end_column cell_number_in_row}
+ private method col_to_start_end {col} {
+ if {$view_mode != {hex}} {
+ set step 4
+ } {
+ set step 3
+ }
+
+ set cell [expr {($col / $step)}]
+ set start [expr {$cell * $step}]
+ set end [expr {$start + $step - 1}]
+
+ return [list $start $end $cell]
+ }
+
+ ## Adjust cursor tags to the current cursor positions (for left view)
+ # @return void
+ private method left_view_adjust_cursor {} {
+ scan [$left_view index insert] {%d.%d} row col
+
+ set boundaries [col_to_start_end $col]
+ set col_s [lindex $boundaries 0]
+ set col_e [lindex $boundaries 1]
+ set cell [lindex $boundaries 2]
+ set cursor_address_original $cursor_address
+ set cursor_address [expr {($row - 1) * $width + $cell}]
+ if {$cursor_address >= $total_capacity} {
+ set cursor_address $cursor_address_original
+ setCurrentCell $cursor_address_original
+ return
+ }
+
+ # Clear cell highlight
+ if {$highlighted_cells($cursor_address)} {
+ setHighlighted $cursor_address 0
+ }
+ # Execute command binded to event CurrentCellChanged
+ if {$current_cell_changed_cmd_set && $cursor_address_original != $cursor_address} {
+ eval "$current_cell_changed_cmd $cursor_address"
+ }
+
+ ## Create cursor tags in right view
+ if {$ascii_view} {
+ $right_header tag remove tag_current_half 0.0 end
+ $right_header tag add tag_current_half 1.$cell 1.$cell+1c
+
+ $right_view tag remove tag_current_half 0.0 end
+ $right_view tag add tag_current_half $row.$cell "$row.$cell +1c"
+ }
+
+ ## Create cursor tags in left view
+ $left_address_bar tag remove tag_current_full 0.0 end
+ $left_address_bar tag add tag_current_full $row.0 $row.0+1l
+
+ $left_header tag remove tag_current_full 0.0 end
+ $left_header tag add tag_current_full 1.$col_s 1.$col_e
+
+ $left_view tag remove tag_current_full 0.0 end
+ $left_view tag add tag_current_full $row.$col_s $row.$col_e
+ }
+
+ ## Create binding for <Motion> and <Leave> events for left and right view
+ # @return void
+ private method bind_mouse_motions {} {
+ if {$motion_binding} {return}
+ set motion_binding 1
+
+ bind $left_view <Motion> "$this left_view_motion %x %y %X %Y"
+ bind $left_view <Leave> "$this text_view_leave"
+
+ if {$ascii_view} {
+ bind $right_view <Motion> "$this right_view_motion %x %y %X %Y"
+ bind $right_view <Leave> "$this text_view_leave"
+ }
+ }
+
+ ## Binding for event <ButtonPress-1> in left view
+ # @parm Int x - Relative horizontal position of mouse pointer
+ # @parm Int y - Relative vertical position of mouse pointer
+ # @return void
+ private method left_view_move_insert {x y} {
+ set index [$left_view index @$x,$y]
+ scan $index {%d.%d} row col
+
+ if {$view_mode != {hex}} {
+ if {($col % 4) == 3} {
+ set index [$left_view index "$index+1c"]
+ }
+ } {
+ if {($col % 3) == 2} {
+ set index [$left_view index "$index+1c"]
+ }
+ }
+ $left_view mark set insert $index
+ left_view_adjust_cursor
+ }
+
+ ## Adjust cursor tags to the current cursor positions (for right view)
+ # @return void
+ public method right_view_adjust_cursor {} {
+ if {!$ascii_view} {
+ return
+ }
+
+ scan [$right_view index insert] {%d.%d} row cell
+ if {$view_mode != {hex}} {
+ set step 4
+ } {
+ set step 3
+ }
+ set cursor_address_original $cursor_address
+ set cursor_address [expr {($row - 1) * $width + $cell}]
+ if {$cursor_address >= $total_capacity} {
+ set cursor_address [expr {$total_capacity - 1}]
+ set index [address_to_index $cursor_address]
+ set row [lindex $index 0]
+ set cell [lindex $index 1]
+ $right_view mark set insert $row.$cell
+ }
+ set col_s [expr {$cell * $step}]
+ set col_e [expr {$col_s + $step - 1}]
+
+ # Clear cell highlight
+ if {$highlighted_cells($cursor_address)} {
+ setHighlighted $cursor_address 0
+ }
+ # Execute command binded to event CurrentCellChanged
+ if {$current_cell_changed_cmd_set && $cursor_address_original != $cursor_address} {
+ eval "$current_cell_changed_cmd $cursor_address"
+ }
+
+ ## Adjust cursor tags in right view
+ $right_header tag remove tag_current_full 0.0 end
+ $right_header tag add tag_current_full 1.$cell 1.$cell+1c
+
+ $right_view tag remove tag_current_full 0.0 end
+ $right_view tag add tag_current_full $row.$cell "$row.$cell +1c"
+
+ ## Adjust cursor tags in left view
+ $left_address_bar tag remove tag_current_full 0.0 end
+ $left_address_bar tag add tag_current_full $row.0 $row.0+1l
+
+ $left_header tag remove tag_current_half 0.0 end
+ $left_header tag add tag_current_half 1.$col_s 1.$col_e
+
+ $left_view tag remove tag_current_half 0.0 end
+ $left_view tag add tag_current_half $row.$col_s $row.$col_e
+ }
+
+ ## Binding for event <KeyPress> in right view
+ # @parm String key - binary key code
+ # @return void
+ public method right_view_key {key} {
+ if {$disabled} {return}
+ if {!$ascii_view} {
+ return
+ }
+ # Key must be 8 bit printable character
+ if {![string is print -strict $key] || ([string bytelength $key] > 1)} {
+ return
+ }
+
+ # Determinate row, column and index of insertion cursor
+ set index [$right_view index insert]
+ scan $index {%d.%d} row col
+
+ # Check for valid position (insert mustn't be after the end of editor)
+ if {($row == $height) && ($col >= $width)} {
+ return
+ }
+
+ # Convert value to decimal and check for valid ASCII value
+ binary scan $key c key
+ if {$key > 126 || $key < 0} {
+ return
+ }
+
+ # Synchronize views
+ incr row -1
+ set address [expr {$row * $width + $col}]
+ setValue $address $key
+ if {$cell_value_changed_cmd_set} {
+ eval "$cell_value_changed_cmd $address $key"
+ }
+ }
+
+ ## Synchronize selection in right view with left view
+ # Binding for event <<Selection>>
+ # @return void
+ public method right_view_selection {} {
+ if {$selection_sync_in_P} {return}
+ set selection_sync_in_P 1
+
+ $left_view tag remove sel 0.0 end
+ if {![llength [$right_view tag nextrange sel 0.0]]} {
+ set selection_sync_in_P 0
+ set anything_selected 0
+ } {
+ set anything_selected 1
+ }
+
+ if {$selection_action_cmd_set} {
+ set flag $anything_selected
+ if {$flag} {
+ if {![string length [string trim [$right_view get sel.first sel.last]]]} {
+ set flag 0
+ }
+ }
+ eval "$selection_action_cmd $flag"
+ }
+
+ if {!$anything_selected} {
+ return
+ }
+
+ if {!$ascii_view} {
+ return
+ }
+
+ if {$view_mode != {hex}} {
+ set step 4
+ } {
+ set step 3
+ }
+
+ scan [$right_view index sel.first] {%d.%d} start_row start_col
+ set start_col [expr {$start_col * $step}]
+ scan [$right_view index sel.last] {%d.%d} end_row end_col
+ set end_col [expr {$end_col * $step}]
+
+ $left_view tag add sel $start_row.$start_col $end_row.$end_col
+ set selection_sync_in_P 0
+ }
+
+ ## Make scrollbar visible or not
+ # @parm Bool display - 1 == Visible; 0 == Invisible
+ # @return void
+ public method showHideScrollbar {display} {
+
+ # Show scrollbar
+ if {!$scrollbar_visible && $display} {
+ set scrollbar_visible 1
+ grid $scrollbar -row 0 -rowspan 2 -column 4 -sticky ns
+
+ # Hide scrollbar
+ } elseif {$scrollbar_visible && !$display} {
+ set scrollbar_visible 0
+ grid forget $scrollbar
+ }
+ }
+
+ ## Set scrollbar and synchronize visible area in both views
+ # text $x -yscrollcommand "$this scrollSet"
+ # @parm float fraction0 - Fraction of topmost visible area
+ # @parm float fraction1 - Fraction of bottommost visible area
+ # @return void
+ public method scrollSet {fraction0 fraction1} {
+ $scrollbar set $fraction0 $fraction1
+ scroll moveto $fraction0
+ }
+
+ ## Scroll both views, left address bar and adjust scrollbar
+ # $scrollbar -command "$this scrollSet"
+ # @parm String args - Here should be something like "moveto 0.1234"
+ # @return void
+ public method scroll args {
+ if {$scroll_in_progress} {return}
+ set scroll_in_progress 1
+
+ eval "$left_view yview $args"
+
+ set idx [$left_view index @5,5]
+ scan $idx "%d.%d" row col
+ incr row -1
+ set top_row $row
+ $left_view yview $row
+ $left_address_bar yview $row
+
+ if {$ascii_view} {
+ $right_view yview $row
+ }
+
+ if {$scroll_action_cmd_set} {
+ eval $scroll_action_cmd
+ }
+
+ update idle
+ set scroll_in_progress 0
+ }
+
+ ## Synchronize selection in left view with left view
+ # Binding for event <<Selection>>
+ # @return void
+ public method left_view_selection {} {
+ if {$selection_sync_in_P} {return}
+ set selection_sync_in_P 1
+
+ if {$ascii_view} {
+ $right_view tag remove sel 0.0 end
+ }
+ if {![llength [$left_view tag nextrange sel 0.0]]} {
+ set selection_sync_in_P 0
+ set anything_selected 0
+ } {
+ set anything_selected 1
+ }
+
+ if {$selection_action_cmd_set} {
+ set flag $anything_selected
+ if {$flag} {
+ if {![string length [string trim [$left_view get sel.first sel.last]]]} {
+ set flag 0
+ }
+ }
+ eval "$selection_action_cmd $flag"
+ }
+
+ if {!$anything_selected} {
+ return
+ }
+
+ if {!$ascii_view} {
+ return
+ }
+
+ scan [$left_view index sel.first] {%d.%d} start_row start_col
+ set start_col [lindex [col_to_start_end $start_col] 2]
+ scan [$left_view index {sel.last-1c}] {%d.%d} end_row end_col
+ set end_col [lindex [col_to_start_end $end_col] 2]
+ incr end_col
+
+ $right_view tag add sel $start_row.$start_col $end_row.$end_col
+ set selection_sync_in_P 0
+ }
+
+ ## Copy text from selected view
+ # @return void
+ public method text_copy {} {
+ if {![llength [$left_view tag nextrange sel 0.0]]} {
+ return
+ }
+
+ if {$selected_view == {left}} {
+ clipboard clear
+ clipboard append [string trim [$left_view get sel.first sel.last]]
+ } elseif {($selected_view == {right}) && $ascii_view} {
+ clipboard clear
+ clipboard append [string trim [$right_view get sel.first sel.last]]
+ }
+ }
+
+ ## Paste text to active view
+ # @return void
+ public method text_paste {} {
+ if {$disabled} {return}
+
+ # Get clipboard contents
+ if {[catch {
+ set text [clipboard get]
+ }]} {
+ set text {}
+ }
+ # If clipboard empty then return
+ if {![string length $text]} {
+ return
+ }
+
+ # Paste to left view
+ if {$selected_view == {left}} {
+ # Remove all characters invalid in current view mode
+ switch -- $view_mode {
+ {hex} {
+ regsub -all {[^0-9a-fA-F ]} $text {} text
+ set step 1
+ }
+ {oct} {
+ regsub -all {[^0-7 ]} $text {} text
+ set step 2
+ }
+ {dec} {
+ regsub -all {[^0-9 ]} $text {} text
+ set step 2
+ }
+ }
+
+ # Determinate start address
+ set address [index_to_address left [$left_view index insert]]
+
+ # Iterate over the text and convert each pair/triad of charaters
+ set len [string length $text]
+ for {set i 0} {$i < $len} {incr i $value_length} {
+ # Get character pair/triad
+ set val [string range $text $i [expr {$i + $step}]]
+ if {[string is space -strict $val]} {
+ incr address
+ if {$address >= $total_capacity} {
+ break
+ }
+ continue
+ }
+ set val [string trim $val]
+ set val [string trimleft $val 0]
+
+ # Convert value to decimal
+ if {$val == {}} {
+ set val 0
+ }
+ if {$view_mode == {hex}} {
+ set val [expr int("0x$val")]
+ } elseif {$view_mode == {oct}} {
+ set val [expr int("0$val")]
+ }
+
+ # Check for allowed range
+ if {$val < 0 || $val > 255} {
+ continue
+ }
+
+ # Set value in editor, simulator and others
+ setValue $address $val
+ if {$cell_value_changed_cmd_set} {
+ eval "$cell_value_changed_cmd $address $val"
+ }
+ incr address
+ incr i
+ if {$address >= $total_capacity} {
+ break
+ }
+ }
+
+ # Adjust insertion cursor
+ set address [address_to_index $address]
+ $left_view mark set insert [lindex $address 0].[lindex $address 2]
+ $left_view see insert
+ left_view_adjust_cursor
+
+ # Paste to right view
+ } elseif {($selected_view == {right}) && $ascii_view} {
+ # Determinate start address, row and column
+ scan [$right_view index insert] {%d.%d} row col
+ incr row -1
+ set address [expr {$row * $width + $col}]
+
+ # Iterate over characters in the text
+ foreach val [split $text {}] {
+ # Convert to decimal
+ binary scan $val c val
+ if {$val < 0 || $val > 126} {
+ incr address
+ continue
+ }
+
+ # Check for valid address
+ if {$address >= $total_capacity} {
+ break
+ }
+
+ # Set value in editor, simulator and others
+ setValue $address $val
+ if {$cell_value_changed_cmd_set} {
+ eval "$cell_value_changed_cmd $address $val"
+ }
+ incr address
+ }
+
+ # Adjust insertion cursor
+ set address [address_to_index $address]
+ $right_view mark set insert [lindex $address 0].[lindex $address 1]
+ $right_view see insert
+ right_view_adjust_cursor
+ }
+ }
+
+ ## Select all text in both views
+ # @return void
+ public method text_selall {} {
+ $left_view tag add sel 1.0 end
+ }
+
+ ## Left view event handler: <B1-Motion>
+ # @parm Int x - Relative cursor position
+ # @parm Int y - Relative cursor position
+ # @return void
+ public method left_view_B1_Motion {x y} {
+ # If x,y overlaps widget area -> abort
+ set max_x [winfo width $left_view]
+ incr max_x -3
+ set max_y [winfo height $left_view]
+ incr max_y -3
+ if {($x < 3) || ($x > $max_x) || ($y < 3) || ($y > $max_y)} {
+ return
+ }
+
+ # If x,y is conresponding to current selection -> abort
+ set target_idx [$left_view index @$x,$y]
+ if {[llength [$left_view tag nextrange sel 0.0]]} {
+ if {
+ ([$left_view compare $cur_idx == sel.first]
+ &&
+ [$left_view compare $target_idx == sel.last])
+ ||
+ ([$left_view compare $cur_idx == sel.last]
+ &&
+ [$left_view compare $target_idx == sel.first])
+ } then {
+ return
+ }
+ }
+
+ # Adjust selection
+ $left_view tag remove sel 0.0 end
+ if {[$left_view compare $cur_idx < $target_idx]} {
+ $left_view tag add sel $cur_idx $target_idx
+ } elseif {[$left_view compare $cur_idx > $target_idx]} {
+ $left_view tag add sel $target_idx $cur_idx
+ }
+
+ # Adjust cursor
+ left_view_move_insert $x $y
+ update
+ }
+
+ ## Left view event handler: <Button-1>
+ # @parm Int x - Relative cursor position
+ # @parm Int y - Relative cursor position
+ # @return void
+ public method left_view_B1 {x y} {
+ $left_view tag remove sel 0.0 end
+ focus $left_view
+ left_view_move_insert $x $y
+ set cur_idx [$left_view index @$x,$y]
+ }
+
+ ## Set active view
+ # @parm String side - "left" or "right"
+ # @return void
+ public method set_selected_view {side} {
+ if {$selected_view == $side} {
+ return
+ }
+ set selected_view $side
+
+ # Remove cursor tags
+ foreach widget [list $left_header $left_view] {
+ $widget tag remove tag_current_full 0.0 end
+ $widget tag remove tag_current_half 0.0 end
+ }
+ if {$ascii_view} {
+ foreach widget [list $right_header $right_view] {
+ $widget tag remove tag_current_full 0.0 end
+ $widget tag remove tag_current_half 0.0 end
+ }
+ }
+
+ # Create new cursor tags
+ if {$selected_view == {left}} {
+ set index [address_to_index $cursor_address]
+ $left_view mark set insert [lindex $index 0].[lindex $index 2]
+ left_view_adjust_cursor
+
+ } elseif {$ascii_view && $selected_view == {right}} {
+ set row [expr {($cursor_address / $width) + 1}]
+ set col [expr {$cursor_address % $width}]
+
+ $right_view mark set insert $row.$col
+ right_view_adjust_cursor
+ }
+ }
+
+ ## Invoke hexeditor popup menu
+ # @parm String side - "left" or "right"
+ # @parm Int x - Relative mouse pointer position
+ # @parm Int y - Relative mouse pointer position
+ # @parm Int X - Absolute mouse pointer position
+ # @parm Int Y - Absolute mouse pointer position
+ # @return void
+ public method popup_menu {side x y X Y} {
+ # Set widget to deal with
+ if {$selected_view == {left}} {
+ set widget $left_view
+ left_view_move_insert $x $y
+ } {
+ set widget $right_view
+ }
+
+ # Fucus on that widget and determinate cursor position
+ focus $widget
+ set cur_idx [$widget index @$x,$y]
+ if {$ascii_view && $selected_view == {right}} {
+ $widget mark set insert $cur_idx
+ right_view_adjust_cursor
+ }
+
+ # Configure popup menu
+ if {[llength [$widget tag nextrange sel 0.0]]} {
+ $popup_menu entryconfigure [::mc "Copy"] -state normal
+ } {
+ $popup_menu entryconfigure [::mc "Copy"] -state disabled
+ }
+ if {[catch {
+ if {[string length [clipboard get]]} {
+ $popup_menu entryconfigure [::mc "Paste"] -state normal
+ } {
+ $popup_menu entryconfigure [::mc "Paste"] -state disabled
+ }
+ }]} {
+ $popup_menu entryconfigure [::mc "Paste"] -state disabled
+ }
+
+ # Invoke popup menu
+ tk_popup $popup_menu $X $Y
+ }
+
+ ## Left view event handler: <Key>
+ # Unprintable characters, invalid and non 8 bit characters will be ignored
+ # @parm Char key - Binary code of pressed key
+ # @return void
+ public method left_view_key {key} {
+ if {$disabled} {return}
+
+ # Check if the given value is printable character
+ if {![string is print -strict $key]} {
+ return
+ }
+
+ # Determinate current row and column
+ scan [$left_view index insert] {%d.%d} row col
+ if {($row == $height) && ($col >= $left_view_width)} {
+ return
+ }
+
+ # Validate the given value
+ switch -- $view_mode {
+ {dec} {
+ if {![string is integer -strict $key]} {
+ return
+ }
+ }
+ {hex} {
+ if {![string is xdigit -strict $key]} {
+ return
+ }
+ }
+ {oct} {
+ if {![regexp {^[0-7]+$} $key]} {
+ return
+ }
+ }
+ }
+
+ # Local variables
+ set boundaries [col_to_start_end $col] ;# Tempotary variable
+ set col_s [lindex $boundaries 0] ;# Starting column
+ set col_e [lindex $boundaries 1] ;# End column
+ set cell [lindex $boundaries 2] ;# Cell number in row
+ set org_val [$left_view get $row.$col_s $row.$col_e] ;# Original cell value
+ set org_idx [$left_view index insert] ;# Original insertion index
+
+ # Replace character at current insertion index with the new one
+ $left_view delete insert {insert+1c}
+ $left_view insert insert $key
+ $left_view mark set insert {insert-1c}
+ $left_view tag add normal_font {insert linestart} {insert lineend}
+
+ # Determinate new cell value
+ set val [$left_view get $row.$col_s $row.$col_e]
+ set val [string trim $val]
+ set val [string trimleft $val 0]
+ if {$val == {}} {
+ set val 0
+ }
+
+ # Convert new cell value to decimal integer
+ if {$view_mode == {hex}} {
+ set val [expr "0x$val"]
+ } elseif {$view_mode == {oct}} {
+ set val [expr "0$val"]
+ }
+
+ # Check for valid value range
+ if {$val > 255} {
+ $left_view delete $row.$col_s $row.$col_e
+ $left_view tag add normal_font [list $row.0 linestart] [list $row.0 lineend]
+ $left_view insert $row.$col_s $org_val
+ $left_view mark set insert $org_idx
+ left_view_adjust_cursor
+ return
+ }
+
+ # Invoke pseudo-event <cell_value_changed>
+ if {$cell_value_changed_cmd_set} {
+ eval "$cell_value_changed_cmd $cursor_address $val"
+ }
+
+ # Adjust right view
+ if {$ascii_view} {
+ set char [format %c $val]
+ set cell "$row.$cell"
+ $right_view delete $cell "$cell+1c"
+ if {($val < 127) && [string is print -strict $char]} {
+ $right_view insert $cell $char
+ $right_view tag remove tag_np $cell "$cell+1c"
+ } {
+ $right_view insert $cell {.}
+ $right_view tag add tag_np $cell "$cell+1c"
+ }
+ $right_view tag add normal_font [list $cell linestart] [list $cell lineend]
+ }
+
+ # Adjust insertion cursor
+ if {($row == $height) && ($col >= ($left_view_width - 1))} {
+ left_view_adjust_cursor
+ } {
+ left_view_movement 0 Right
+ }
+ }
+
+ ## Perform certain movement action on the right (ascii) view
+ # @parm String key - Action (one of {Left Right End})
+ # @return void
+ public method right_view_movement {key} {
+ # Remove selection and determinate current column and row
+ $right_view tag remove sel 0.0 end
+ scan [$right_view index insert] {%d.%d} row col
+
+ # Determinate correction for insertion cursor
+ switch -- $key {
+ {Left} { ;# Move left by one character
+ if {$row == 1 && $col == 0} {
+ return
+ }
+
+ incr col -1
+ if {$col < 0} {
+ set col [expr {$width - 1}]
+ incr row -1
+ }
+ }
+ {Right} { ;# Move right by one character
+ if {($row == $height) && ($col >= ($width - 1))} {
+ return
+ }
+
+ incr col
+ if {$col >= $width} {
+ set col 0
+ incr row
+ }
+ }
+ {End} { ;# Move to the end of the current line
+ if {$col >= ($width - 1)} {
+ return
+ }
+
+ set col [expr {$width - 1}]
+ }
+ default { ;# CRITICAL ERROR
+ error "Unrecognized key: $key"
+ return
+ }
+ }
+
+ # Adjust insertion cursor
+ $right_view mark set insert $row.$col
+ $right_view see insert
+
+ # Adjust cursor highlighting tags
+ right_view_adjust_cursor
+ }
+
+ ## Perform certain movement action on the left view
+ # @parm Bool select - Manipulate selection
+ # @parm String key - Action (one of {Left Right Up Down Home End Prior Next})
+ # @return void
+ public method left_view_movement {select key} {
+ # Remove selection and determinate current column and row
+ $left_view tag remove sel 0.0 end
+ scan [$left_view index insert] {%d.%d} row col
+
+ # Determinate cell boundaries
+ if {$key == {Left} || $key == {Right}} {
+ set boundaries [col_to_start_end $col]
+ set col_s [lindex $boundaries 0]
+ set col_e [lindex $boundaries 1]
+ }
+
+ # Determinate correction for insertion cursor
+ switch -- $key {
+ {Left} { ;# Move left by one character
+ if {$row == 1 && $col == 0} {
+ return
+ }
+ if {$col == $col_s} {
+ set correction {-2c}
+ } {
+ set correction {-1c}
+ }
+ }
+ {Right} { ;# Move right by one character
+ incr col_e -1
+ if {($row == $height) && ($col >= ($left_view_width - 1))} {
+ return
+ }
+ if {$col == $col_e} {
+ set correction {+2c}
+ } {
+ set correction {+1c}
+ }
+ }
+ {Up} { ;# Move up by one row
+ if {!$row} {
+ return
+ }
+ set correction {-1l}
+ }
+ {Down} { ;# Move down by one row
+ if {$row == $height} {
+ return
+ }
+ set correction {+1l}
+ }
+ {Home} { ;# Move to the beginning of the current line
+ if {!$col} {
+ return
+ }
+ set correction {linestart}
+ }
+ {End} { ;# Move to the end of the current line
+ if {$col >= ($left_view_width - 1)} {
+ return
+ }
+ set correction {lineend-1c}
+ }
+ {Prior} { ;# Move up by a few lines
+ set correction {-8l}
+ }
+ {Next} { ;# Move up by a few lines
+ set correction {+8l}
+ }
+ default { ;# CRITICAL ERROR
+ error "Unrecognized key: $key"
+ return
+ }
+ }
+
+ # Adjust insertion cursor
+ $left_view mark set insert [$left_view index "insert $correction"]
+ $left_view see insert
+
+ # Adjust selection
+ if {!$select} {
+ set cur_idx [$left_view index insert]
+ } {
+ if {[$left_view compare $cur_idx <= insert]} {
+ $left_view tag add sel $cur_idx insert
+ } {
+ $left_view tag add sel insert $cur_idx
+ }
+ }
+
+ # Adjust cursor highlighting tags
+ left_view_adjust_cursor
+ }
+
+ ## Left view event handler: <Leave>
+ # Manages pseudo-event <cell_leave>
+ # @return void
+ public method text_view_leave {} {
+ if {!$in_cell} {
+ return
+ }
+
+ set in_cell 0
+ set cell_under_cursor {0.0}
+
+ if {$cell_leave_cmd_set} {
+ eval $cell_leave_cmd
+ }
+ }
+
+ ## Right view event handler: <Motion>
+ # Manages pseuso-events <cell_motion>, <cell_enter> and <cell_leave>
+ # @parm Int x - Relative mouse pointer position
+ # @parm Int y - Relative mouse pointer position
+ # @parm Int X - Absolute mouse pointer position
+ # @parm Int Y - Absolute mouse pointer position
+ # @return void
+ public method right_view_motion {x y X Y} {
+ set index [$right_view index @$x,$y]
+ set dlineinfo [$right_view dlineinfo $index]
+ if {$y > ([lindex $dlineinfo 1] + [lindex $dlineinfo 3])} {
+ text_view_leave
+ return
+ }
+ scan $index {%d.%d} row col
+
+ # Motion
+ if {$cell_under_cursor == $index} {
+ if {$cell_motion_cmd_set} {
+ eval "$cell_motion_cmd $X $Y"
+ }
+
+ # (Leave + ) Enter
+ } else {
+ if {$in_cell} {
+ if {$cell_leave_cmd_set} {
+ eval $cell_leave_cmd
+ }
+ set in_cell 0
+ }
+ if {$cell_enter_cmd_set} {
+ set address [expr {($row - 1) * $width + $col}]
+ if {$address >= $total_capacity} {
+ set address $total_capacity
+ }
+ eval "$cell_enter_cmd $address $X $Y"
+ }
+ set in_cell 1
+ }
+
+ set cell_under_cursor $index
+ }
+
+ ## Left view event handler: <Motion>
+ # Manages pseuso-events <cell_motion>, <cell_enter> and <cell_leave>
+ # @parm Int x - Relative mouse pointer position
+ # @parm Int y - Relative mouse pointer position
+ # @parm Int X - Absolute mouse pointer position
+ # @parm Int Y - Absolute mouse pointer position
+ # @return void
+ public method left_view_motion {x y X Y} {
+ set index [$left_view index @$x,$y]
+ set dlineinfo [$left_view dlineinfo $index]
+ if {$y > ([lindex $dlineinfo 1] + [lindex $dlineinfo 3])} {
+ text_view_leave
+ return
+ }
+ scan $index {%d.%d} row col
+ if {$view_mode != {hex}} {
+ set step 4
+ } {
+ set step 3
+ }
+
+ # Enter
+ if {$cell_under_cursor != $index} {
+ if {$in_cell && $cell_leave_cmd_set} {
+ eval $cell_leave_cmd
+ }
+ if {$cell_enter_cmd_set} {
+ set address [expr {($row - 1) * $width + ($col / $step)}]
+ if {$address >= $total_capacity} {
+ set address $total_capacity
+ }
+ eval "$cell_enter_cmd $address $x $y $X $Y"
+ }
+ set in_cell 1
+
+ # Motion
+ } elseif {$cell_motion_cmd_set} {
+ eval "$cell_motion_cmd $X $Y"
+ }
+
+ set cell_under_cursor $index
+ }
+
+
+ # -------------------------------------------------------------------
+ # GENERAL PUBLIC INTERFACE
+ # -------------------------------------------------------------------
+
+ ## Get editor scroll bar object reference
+ # @return Widget - Scrolbar
+ public method get_scrollbar {} {
+ return $scrollbar
+ }
+
+ ## Get editor popup menu object reference
+ # @return Widget - Popup menu
+ public method get_popup_menu {} {
+ return $popup_menu
+ }
+
+ ## Get list of values from hexeditor
+ # @parm Int start - Start address
+ # @parm Int end - End address
+ # @return List - List of decimal values (e.g. {0 226 {} {} 126 {} 6 8})
+ public method get_values {start end} {
+ # Check for allowed address range
+ if {$DEBUG} {
+ if {$end >= $total_capacity} {
+ error "Address out of range"
+ }
+ if {$end != [expr {int($end)}]} {
+ error "Address must be integer"
+ }
+ if {$start < 0} {
+ error "Address out of range"
+ }
+ if {$start != [expr {int($start)}]} {
+ error "Address must be integer"
+ }
+ }
+
+ # Determinate text indexes of area to extract
+ set index [address_to_index $start]
+ set start_row [lindex $index 0]
+ set start_col [lindex $index 2]
+ set index [address_to_index $end]
+ set end_row [lindex $index 0]
+ set end_col [lindex $index 3]
+ incr end_col
+
+ # Determinate cell legth and cell length+space
+ if {$view_mode != {hex}} {
+ set step 4
+ set len 3
+ } {
+ set step 3
+ set len 2
+ }
+
+ # Initiate extraction
+ set result {}
+ set value {}
+ for {set row $start_row} {$row <= $end_row} {incr row} {
+ # Interate over cells withing the row
+ for {set col_s $start_col} {$col_s < $left_view_width} {incr col_s $step} {
+ # Determinate cell end index
+ set col_e $col_s
+ incr col_e $len
+ if {($row == $end_row) && ($col_s == $end_col)} {
+ break
+ }
+
+ # Determinate cell value
+ set value [$left_view get $row.$col_s $row.$col_e]
+ set value [string trim $value]
+
+ # Skip conversion for empty cells
+ if {$value == {}} {
+ lappend result {}
+ continue
+ }
+
+ # Convert cell value to decimal integer
+ set value [string trimleft $value 0]
+ if {$value == {}} {
+ set value 0
+ }
+ switch -- $view_mode {
+ {dec} {
+ lappend result $value
+ }
+ {hex} {
+ lappend result [expr "0x$value"]
+ }
+ {oct} {
+ lappend result [expr "0$value"]
+ }
+ }
+ }
+ }
+
+ if {$start == $end} {
+ return [lindex $result 0]
+ } {
+ return $result
+ }
+ }
+
+ ## Set value of the specified cell
+ # @parm Int address - Cell address
+ # @parm Int value - New cell value (must be withing interval [0;255])
+ # @return void
+ public method setValue {address value} {
+ # Local variables
+ set index [address_to_index $address] ;# Text index
+ set row [lindex $index 0] ;# Row in left view
+ set cell [lindex $index 1] ;# Column in right view / cell number in row
+ set start_col [lindex $index 2] ;# Starting column in left view
+ set end_col [lindex $index 3] ;# End column in left view
+ set index [$left_view index insert] ;# Current insertion index in left view
+
+ # Empty value means clear the cell
+ if {$value == {}} {
+ # Clear cell in the left view
+ $left_view delete $row.$start_col $row.$end_col
+ if {$view_mode != {hex}} {
+ $left_view insert $row.$start_col { }
+ } {
+ $left_view insert $row.$start_col { }
+ }
+ $left_view mark set insert $index
+ $left_view tag add normal_font [list $row.0 linestart] [list $row.0 lineend]
+
+ # Clear cell in the right view
+ if {$ascii_view} {
+ $right_view delete $row.$cell $row.$end_col
+ $right_view insert $row.$cell { }
+ $right_view tag add normal_font [list $row.0 linestart] [list $row.0 lineend]
+ }
+
+ # Restore insertion cursor tags
+ if {$cursor_address == $address} {
+ if {$selected_view == {left}} {
+ left_view_adjust_cursor
+ } {
+ right_view_adjust_cursor
+ }
+ }
+
+ # Restore cell highlight
+ restore_cell_highlight $address
+
+ # Abort the rest of procedure
+ return
+ }
+
+ # Validate input address and value
+ if {$DEBUG} {
+ if {$address >= $total_capacity} {
+ error "Address out of range"
+ }
+ if {$address != [expr {int($address)}]} {
+ error "Address must be integer"
+ }
+ if {$value > 255 || $value < 0} {
+ error "Value of of range"
+ }
+ if {$value != [expr {int($value)}]} {
+ error "Value must be integer"
+ }
+ }
+
+ # Convert the given value to appropriate string
+ set original_value $value
+ switch -- $view_mode {
+ {hex} {
+ set value [format %X $value]
+ if {[string length $value] == 1} {
+ set value "0$value"
+ }
+ }
+ {oct} {
+ set value [format %o $value]
+ set len [string length $value]
+ if {$len != 3} {
+ set value "[string repeat {0} [expr {3 - $len}]]$value"
+ }
+ }
+ {dec} {
+ set value [expr $value]
+ set len [string length $value]
+ if {$len != 3} {
+ set value "[string repeat {0} [expr {3 - $len}]]$value"
+ }
+ }
+ }
+
+ # Replace current content of the cell with new value
+ $left_view delete $row.$start_col $row.$end_col
+ $left_view insert $row.$start_col $value
+ $left_view mark set insert $index
+ $left_view tag add normal_font [list $row.0 linestart] [list $row.0 lineend]
+
+ # Adjust right view
+ if {$ascii_view} {
+ set end_col $cell
+ incr end_col
+
+ # Convert to character
+ set value [format %c $original_value]
+
+ # Insert value to the text widget
+ $right_view delete $row.$cell $row.$end_col
+ if {($original_value < 127) && [string is print -strict $value]} {
+ $right_view insert $row.$cell $value
+ $right_view tag remove tag_np $row.$cell "$row.$cell+1c"
+ } {
+ $right_view insert $row.$cell {.}
+ $right_view tag add tag_np $row.$cell $row.$end_col
+ }
+ $right_view tag add normal_font [list $row.0 linestart] [list $row.0 lineend]
+
+ # Adjust cursor postion
+ scan [$right_view index {insert}] {%d.%d} row cell
+ if {$cell == $width} {
+ set cell 0
+ incr row
+ }
+ $right_view mark set insert $row.$cell
+ }
+
+ # Restore insertion cursor tags
+ if {$cursor_address == $address} {
+ if {$selected_view == {left}} {
+ left_view_adjust_cursor
+ } {
+ right_view_adjust_cursor
+ }
+ }
+
+ # Restore cell highlight
+ restore_cell_highlight $address
+ }
+
+ ## Switch view (from left to right and on the contrary)
+ # @return void
+ public method switch_views {} {
+ if {!$ascii_view} {
+ return
+ }
+ if {$selected_view == {left}} {
+ focus $right_view
+ } {
+ focus $left_view
+ }
+ }
+
+ ## Get current view (left or right)
+ # @return String - "left" or "right"
+ public method getCurrentView {} {
+ return $selected_view
+ }
+
+ ## Focus on the left view
+ # @return void
+ public method focus_left_view {} {
+ focus -force $left_view
+ }
+
+ ## Focus on the right view
+ # @return void
+ public method focus_right_view {} {
+ if {$ascii_view} {
+ focus -force $right_view
+ }
+ }
+
+ ## Set cell background highlight (as write in progress)
+ # @parm Int address - Cell address
+ # @parm Bool bool - 1 == highlight; 0 == clear highlight
+ # @parm Int type - Type of highlight (color)
+ # @return void
+ public method set_bg_hg {address bool type} {
+ # Validate input address
+ if {$DEBUG} {
+ if {$address >= $total_capacity} {
+ error "Address out of range"
+ }
+ if {$address != [expr {int($address)}]} {
+ error "Address must be integer"
+ }
+ if {![string is boolean $bool]} {
+ error "'$bool' in not booleand value"
+ }
+ }
+
+ switch -- $type {
+ 0 {
+ set arr {bg_hg}
+ set tag {tag_bg_hg}
+ }
+ 1 {
+ set arr {bg_hg1}
+ set tag {tag_bg_hg1}
+ }
+ 2 {
+ set arr {bg_hg2}
+ set tag {tag_bg_hg2}
+ }
+ }
+ if {[subst "\$${arr}($address)"] == $bool} {
+ return
+ }
+ set ${arr}($address) $bool
+
+ # Local variables
+ set index [address_to_index $address] ;# (Auxiliary variable)
+ set row [lindex $index 0] ;# Cell row
+ set cell [lindex $index 1] ;# Cell number in the row
+ set start_col [lindex $index 2] ;# Starting column
+ set end_col [lindex $index 3] ;# End column
+
+ # Create highlight
+ if {$bool} {
+ set bool {add}
+ } {
+ set bool {remove}
+ }
+ $left_view tag $bool $tag $row.$start_col $row.$end_col
+ if {$ascii_view} {
+ $right_view tag $bool $tag $row.$cell "$row.$cell+1c"
+ }
+ }
+
+ ## Set cell highlight (as changed)
+ # @parm Int address - Cell address
+ # @parm Bool bool - 1 == highlight; 0 == clear highlight
+ # @return void
+ public method setHighlighted {address bool} {
+ # Validate input address
+ if {$DEBUG} {
+ if {$address >= $total_capacity} {
+ error "Address out of range"
+ }
+ if {$address != [expr {int($address)}]} {
+ error "Address must be integer"
+ }
+ if {![string is boolean $bool]} {
+ error "'$bool' in not booleand value"
+ }
+ }
+
+ if {$highlighted_cells($address) == $bool} {
+ return
+ }
+ set highlighted_cells($address) $bool
+
+ # Local variables
+ set index [address_to_index $address] ;# (Auxiliary variable)
+ set row [lindex $index 0] ;# Cell row
+ set cell [lindex $index 1] ;# Cell number in the row
+ set start_col [lindex $index 2] ;# Starting column
+ set end_col [lindex $index 3] ;# End column
+
+ # Create highlight
+ if {$bool} {
+ set bool {add}
+ } {
+ set bool {remove}
+ }
+ $left_view tag $bool tag_hg $row.$start_col $row.$end_col
+ if {$ascii_view} {
+ $right_view tag $bool tag_hg $row.$cell "$row.$cell+1c"
+ }
+ }
+
+ ## Remove all foreground highlighting tags
+ # @return void
+ public method clearHighlighting {} {
+ for {set i 0} {$i < $total_capacity} {incr i} {
+ set highlighted_cells($i) 0
+ }
+ $left_view tag remove tag_hg 0.0 end
+ if {$ascii_view} {
+ $right_view tag remove tag_hg 0.0 end
+ }
+ }
+
+ ## Remove all background highlighting tags
+ # @parm Int type - Type of highlight (color)
+ # @return void
+ public method clearBgHighlighting {type} {
+ switch -- $type {
+ 0 {
+ set arr {bg_hg}
+ set tag {tag_bg_hg}
+ }
+ 1 {
+ set arr {bg_hg1}
+ set tag {tag_bg_hg1}
+ }
+ 2 {
+ set arr {bg_hg2}
+ set tag {tag_bg_hg2}
+ }
+ }
+ for {set i 0} {$i < $total_capacity} {incr i} {
+ set ${arr}($i) 0
+ }
+ $left_view tag remove $tag 0.0 end
+ if {$ascii_view} {
+ $right_view tag remove $tag 0.0 end
+ }
+ }
+
+ ## Get address of current cell
+ # @return Int - Address
+ public method getCurrentCell {} {
+ return $cursor_address
+ }
+
+ ## Set current cell
+ # @parm Int address - Cell address
+ # @return void
+ public method setCurrentCell {address} {
+ # Check for allowed range
+ if {$address >= $total_capacity} {
+ return
+ }
+
+ # Local variables
+ set index [address_to_index $address] ;# (Auxiliary variable)
+ set row [lindex $index 0] ;# Cell row
+ set cell [lindex $index 1] ;# Cell number in the row
+ set start_col [lindex $index 2] ;# Cell starting column
+
+ # Adjust cursor
+ set cursor_address $address
+ if {$selected_view == {left}} {
+ $left_view mark set insert $row.$start_col
+ $left_view see insert
+ left_view_adjust_cursor
+ } {
+ $right_view mark set insert $row.$cell
+ $right_view see insert
+ right_view_adjust_cursor
+ }
+ }
+
+ ## Scroll to certain cell
+ # @parm Int address - Cell address
+ # @return void
+ public method seeCell {address} {
+ # Check for allowed range
+ if {$address >= $total_capacity} {
+ return
+ }
+
+ # Local variables
+ set index [address_to_index $address] ;# (Auxiliary variable)
+ set row [lindex $index 0] ;# Cell row
+ set cell [lindex $index 1] ;# Cell number in the row
+ set start_col [lindex $index 2] ;# Cell starting column
+
+ # Adjust cursor
+ if {$selected_view == {left}} {
+ $left_view see $row.$start_col
+ } {
+ $right_view see $row.$cell
+ }
+ }
+
+ ## Bind command to pseudo-event <current_cell_changed>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd $cursor_address"
+ # @return void
+ public method bindCurrentCellChanged {cmd} {
+ set current_cell_changed_cmd_set 1
+ set current_cell_changed_cmd $cmd
+ }
+
+ ## Bind command to pseudo-event <cell_value_changed>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd $cursor_address $new_value"
+ # @return void
+ public method bindCellValueChanged {cmd} {
+ set cell_value_changed_cmd_set 1
+ set cell_value_changed_cmd $cmd
+ }
+
+ ## Bind command to pseudo-event <cell_enter>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd $cursor_address $X $Y"
+ # @return void
+ public method bindCellEnter {cmd} {
+ set cell_enter_cmd_set 1
+ set cell_enter_cmd $cmd
+ bind_mouse_motions
+ }
+
+ ## Bind command to pseudo-event <cell_leave>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd"
+ # @return void
+ public method bindCellLeave {cmd} {
+ set cell_leave_cmd_set 1
+ set cell_leave_cmd $cmd
+ bind_mouse_motions
+ }
+
+ ## Bind command to pseudo-event <cell_motion>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd $X $Y"
+ # @return void
+ public method bindCellMotion {cmd} {
+ set cell_motion_cmd_set 1
+ set cell_motion_cmd $cmd
+ bind_mouse_motions
+ }
+
+ ## Bind command to pseudo-event <scroll_action>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd"
+ # @return void
+ public method bindScrollAction {cmd} {
+ set scroll_action_cmd_set 1
+ set scroll_action_cmd $cmd
+ }
+
+ ## Bind command to pseudo-event <selection_action>
+ # @parm String cmd - command to invoke from root namespace
+ # Command invocation: eval "$cmd bool__something_selected_or_not"
+ # @return void
+ public method bindSelectionAction {cmd} {
+ set selection_action_cmd_set 1
+ set selection_action_cmd $cmd
+ }
+
+ ##
+ # @return
+ public method getRangeOfSelection {} {
+ if {[llength [$left_view tag nextrange sel 0.0]]} {
+ return [list \
+ [index_to_address {left} [$left_view index sel.first+1c]] \
+ [index_to_address {left} [$left_view index sel.last-1c]] \
+ ]
+ } {
+ return {}
+ }
+ }
+
+ ## Get number of topmost visible row in both views
+ # @return Int - Row number (1st row has number 1)
+ public method getTopRow {} {
+ return $top_row
+ }
+
+ ## Switch view mode (HEX, DEC etc.)
+ # @parm String newmode - New mode for left view (one of {hex oct dec})
+ # @return void
+ public method switch_mode {newmode} {
+ if {$newmode == $view_mode} {
+ return
+ }
+ set original_mode $view_mode
+ set view_mode $newmode
+ switch -- $view_mode {
+ {hex} {
+ set new_value_length 2
+ set left_view_width [expr {$width * 3 - 1}]
+ }
+ {oct} {
+ set new_value_length 3
+ set left_view_width [expr {$width * 4 - 1}]
+ }
+ {dec} {
+ set new_value_length 3
+ set left_view_width [expr {$width * 4 - 1}]
+ }
+ default {
+ error "Invalid mode: $view_mode"
+ }
+ }
+ switch -- $original_mode {
+ {hex} {
+ set value_length 2
+ set skip 3
+ }
+ {oct} {
+ set value_length 3
+ set skip 4
+ }
+ {dec} {
+ set value_length 3
+ set skip 4
+ }
+ }
+
+ $left_view configure -cursor watch
+ $left_header configure -cursor watch
+ $left_address_bar configure -cursor watch
+ if {$ascii_view} {
+ $right_header configure -cursor watch
+ $right_view configure -cursor watch
+ }
+ update
+ $left_view configure -width $left_view_width
+ $left_header configure -width $left_view_width
+
+ # Iterate over rows in left view
+ for {set row 1} {$row <= $height} {incr row} {
+ set start 0
+ set end $value_length
+ set values {}
+ set lineend [$left_view index [list $row.0 lineend]]
+
+ # Save line to list
+ for {set cell 0} {$cell < $width} {incr cell} {
+ lappend values [string trim [$left_view get $row.$start $row.$end]]
+ incr start $skip
+ incr end $skip
+ }
+ $left_view delete $row.0 $lineend
+
+ # Convert list
+ set first 1
+ set space [string repeat { } $new_value_length]
+ foreach val $values {
+ if {!$first} {
+ $left_view insert $lineend { }
+ } {
+ set first 0
+ }
+ if {$val == {}} {
+ $left_view insert $lineend $space
+ continue
+ } {
+ set val [string trimleft $val 0]
+ if {$val == {}} {
+ set val 0
+ }
+ switch -- $original_mode {
+ {hex} {
+ # HEX -> DEC
+ if {$view_mode == {dec}} {
+ set val [expr "0x$val"]
+
+ # HEX -> OCT
+ } {
+ set val [expr "0x$val"]
+ set val [format {%o} $val]
+ }
+ }
+ {dec} {
+ # DEC -> HEX
+ if {$view_mode == {hex}} {
+ set val [format %X $val]
+
+ # DEC -> OCT
+ } {
+ set val [format %o $val]
+ }
+ }
+ {oct} {
+ # OCT -> HEX
+ if {$view_mode == {hex}} {
+ set val [expr "0$val"]
+ set val [format %X $val]
+
+ # OCT -> DEC
+ } {
+ set val [expr "0$val"]
+ }
+ }
+ }
+ }
+
+ set len [string length $val]
+ if {$len < $new_value_length} {
+ set len [expr {$new_value_length - $len}]
+ set val "[string repeat 0 $len]$val"
+ }
+
+ $left_view insert $lineend $val
+ $left_view tag add normal_font [list $lineend linestart] [list $lineend lineend]
+ }
+ }
+
+ fill_left_header
+ for {set i 0} {$i < $total_capacity} {incr i} {
+ if {$highlighted_cells($i)} {
+ set highlighted_cells($i) 0
+ setHighlighted $i 1
+ }
+ if {$bg_hg($i)} {
+ set bg_hg($i) 0
+ set_bg_hg $i 1
+ }
+ }
+ $left_view configure -cursor xterm
+ $left_header configure -cursor left_ptr
+ $left_address_bar configure -cursor left_ptr
+ if {$ascii_view} {
+ $right_header configure -cursor left_ptr
+ $right_view configure -cursor xterm
+ }
+ }
+
+ ## Set hexeditor enabled/disabled state
+ # @parm Bool bool - 1 == enabled; 0 == disabled
+ # @return void
+ public method setDisabled {bool} {
+ set disabled $bool
+
+ # Set state for left view
+ if {$bool} {
+ $left_view configure -state disabled
+ $left_view configure -bg {#F8F8F8} -fg {#999999} ;#DDDDDD
+ } {
+ $left_view configure -state normal
+ $left_view configure -bg {#FFFFFF} -fg {#000000}
+ }
+
+ # Set state for right view
+ if {$ascii_view} {
+ if {$bool} {
+ $right_view configure -state disabled
+ $right_view configure -bg {#F8F8F8} -fg {#999999} ;#DDDDDD
+ } {
+ $right_view configure -state normal
+ $right_view configure -bg {#FFFFFF} -fg {#000000}
+ }
+ }
+ }
+
+ ## Get reference of left view text widget
+ # @return Widget - Text widget
+ public method getLeftView {} {
+ return $left_view
+ }
+
+ ## Get reference of right view text widget
+ # @return Widget - Text widget or {}
+ public method getRightView {} {
+ return $right_view
+ }
+
+ ## Get configuration list
+ # @return List - Configuration list
+ proc get_config {} {
+ return [list $text_to_find $find_opt(fc) $find_opt(bw)]
+ }
+
+ ## Load configuration list generated by function `get_config'
+ # @param List config - Configuration list generated by `get_config'
+ # @return void
+ proc load_config_list {config_list} {
+ # Load configuration
+ set text_to_find [lindex $config_list 0]
+ set find_opt(fc) [lindex $config_list 1]
+ set find_opt(bw) [lindex $config_list 2]
+
+ # Validate loaded configuration
+ if {![string is boolean -strict $find_opt(fc)]} {
+ set find_opt(fc) 1
+ }
+ if {![string is boolean -strict $find_opt(bw)]} {
+ set find_opt(bw) 0
+ }
+ }
+
+ ## Find next occurence of search string
+ # @return Bool - 0 == Invalid call; 1 == Valid call
+ public method find_next {} {
+ if {$last_find_index == {}} {
+ return 0
+ }
+ if {$find_opt(bw)} {
+ set result [find_FIND $last_find_index-[string length $text_to_find]c]
+ } {
+ set result [find_FIND $last_find_index]
+ }
+ return $result
+ }
+
+ ## Find previous occurence of search string
+ # @return Bool - 0 == Invalid call; 1 == Valid call
+ public method find_prev {} {
+ if {$last_find_index == {}} {
+ return 0
+ }
+
+ set backward_org $find_opt(bw)
+ set find_opt(bw) [expr {!$find_opt(bw)}]
+
+ if {$find_opt(bw)} {
+ set result [find_FIND $last_find_index-[string length $text_to_find]c]
+ } {
+ set result [find_FIND $last_find_index]
+ }
+
+ set find_opt(bw) $backward_org
+ return $result
+ }
+
+ ## Invoke dialog: Find string
+ # @return Bool - 1 == string found; 0 == string not found
+ public method find_dialog {} {
+ # Create toplevel find_dialog_window
+ if {[winfo exists $find_dialog_win]} {
+ destroy $find_dialog_win
+ }
+ incr find_dialog_count
+ set find_dialog_win [toplevel .hex_editor_find_dialog_$find_dialog_count]
+
+ ## Create top frame
+ set top_frame [frame $find_dialog_win.top_frame]
+ # Text to find
+ grid [label $top_frame.string_lbl \
+ -text [mc "Text to find"] \
+ ] -row 0 -column 0 -columnspan 4 -sticky w
+ grid [ttk::entry $top_frame.string_entry \
+ -textvariable ::HexEditor::text_to_find \
+ -width 0 \
+ ] -row 1 -column 1 -sticky we -columnspan 3
+ # Where
+ grid [label $top_frame.where_lbl \
+ -text [mc "Where"] \
+ ] -row 2 -column 0 -columnspan 2 -sticky w
+ grid [radiobutton $top_frame.radio_0 \
+ -variable ::HexEditor::where_to_search \
+ -text [mc "Left view"] -value left \
+ ] -row 3 -column 1 -sticky w
+ grid [radiobutton $top_frame.radio_1 \
+ -variable ::HexEditor::where_to_search \
+ -text [mc "Right view"] -value right \
+ ] -row 4 -column 1 -sticky w
+ set ::HexEditor::where $selected_view
+ if {!$ascii_view} {
+ $top_frame.radio_1 configure -state disabled
+ }
+ # Options
+ grid [label $top_frame.options_lbl \
+ -text [mc "Options"] \
+ ] -row 2 -column 2 -columnspan 2 -sticky w
+ grid [checkbutton $top_frame.opt_fc_chb \
+ -variable ::HexEditor::find_opt(fc) \
+ -onvalue 1 -offvalue 0 \
+ -text [mc "From cursor"] \
+ ] -row 3 -column 3 -sticky w
+ grid [checkbutton $top_frame.opt_bw_chb \
+ -variable ::HexEditor::find_opt(bw) \
+ -onvalue 1 -offvalue 0 \
+ -text [mc "Backwards"] \
+ ] -row 4 -column 3 -sticky w
+
+ # Finalize top frame creation
+ grid columnconfigure $top_frame 0 -minsize 25
+ grid columnconfigure $top_frame 1 -weight 1
+ grid columnconfigure $top_frame 2 -minsize 25
+ grid columnconfigure $top_frame 3 -weight 1
+
+ # Create and pack 'OK' and 'CANCEL' buttons
+ set buttonFrame [frame $find_dialog_win.button_frame]
+ pack [ttk::button $buttonFrame.ok \
+ -text [mc "Ok"] \
+ -compound left \
+ -image ::ICONS::16::ok \
+ -command "$this find_FIND" \
+ ] -side left
+ pack [ttk::button $buttonFrame.cancel \
+ -text [mc "Cancel"] \
+ -compound left \
+ -image ::ICONS::16::button_cancel \
+ -command "$this find_CANCEL" \
+ ] -side left
+
+ # Events binding (Enter == Find; Escape == Cancel)
+ bind $find_dialog_win <KeyRelease-Return> "$this find_FIND; break"
+ bind $find_dialog_win <KeyRelease-KP_Enter> "$this find_FIND; break"
+ bind $find_dialog_win <KeyRelease-Escape> "$this find_CANCEL; break"
+
+ # Pack dialog frames
+ pack $top_frame -fill both -anchor nw -padx 5 -pady 5
+ pack $buttonFrame -side bottom -anchor e -padx 5
+
+ # Window manager options -- modal find_dialog_window
+ wm iconphoto $find_dialog_win ::ICONS::16::find
+ wm title $find_dialog_win [mc "Find"]
+ wm minsize $find_dialog_win 260 140
+ wm transient $find_dialog_win $main_frame
+ wm protocol $find_dialog_win WM_DELETE_WINDOW "
+ grab release $find_dialog_win
+ destroy $find_dialog_win
+ "
+ update
+ grab $find_dialog_win
+ $top_frame.string_entry selection range 0 end
+ focus -force $top_frame.string_entry
+
+ tkwait window $find_dialog_win
+ if {$last_find_index == {}} {
+ return 0
+ } {
+ return 1
+ }
+ }
+
+ # -------------------------------------------------------------------
+ # HELPER PROCEDURES
+ # -------------------------------------------------------------------
+
+ ## Initiate serach
+ # @return void
+ public method find_FIND args {
+ # Determinate search options
+ set start_index [lindex $args 0]
+ if {$where_to_search == {left}} {
+ set widget $left_view
+ } {
+ set widget $right_view
+ }
+ if {$find_opt(bw)} {
+ set direction {-backwards}
+ } {
+ set direction {-forwards}
+ }
+ if {$start_index == {}} {
+ if {$find_opt(fc)} {
+ set start_index [$widget index insert]
+ } {
+ set start_index 1.0
+ }
+ }
+
+ # Perform search
+ set last_find_index [$widget search $direction -nocase -- $text_to_find $start_index]
+
+ # String found
+ if {$last_find_index != {}} {
+ $popup_menu entryconfigure [::mc "Find next"] -state normal
+ $popup_menu entryconfigure [::mc "Find previous"] -state normal
+ catch {
+ $widget tag remove sel 0.0 end
+ }
+ set end_idx $last_find_index+[string length $text_to_find]c
+ $widget tag add sel $last_find_index $end_idx
+ $widget mark set insert $end_idx
+ $widget see $end_idx
+ set last_find_index $end_idx
+ set result 1
+
+ # String not found
+ } {
+ $popup_menu entryconfigure [::mc "Find next"] -state disabled
+ $popup_menu entryconfigure [::mc "Find previous"] -state disabled
+
+ if {[winfo exists $find_dialog_win]} {
+ set parent $find_dialog_win
+ } {
+ set $main_frame
+ }
+ tk_messageBox \
+ -parent $parent \
+ -type ok \
+ -icon warning \
+ -title [mc "String not found"] \
+ -message [mc "Search string '%s' not found !" $text_to_find]
+ set result 0
+ }
+
+ # Close find dialog
+ if {[winfo exists $find_dialog_win]} {
+ find_CANCEL
+ }
+
+ return $result
+ }
+
+ ## Close find dialog
+ # @return void
+ public method find_CANCEL {} {
+ grab release $find_dialog_win
+ destroy $find_dialog_win
+ }
+}
+
+## Initialize NS variables
+ # Find options
+array set ::HexEditor::find_opt {
+ fc 1
+ bw 0
+}
diff --git a/lib/lib/ihextools.tcl b/lib/lib/ihextools.tcl
new file mode 100755
index 0000000..071b178
--- /dev/null
+++ b/lib/lib/ihextools.tcl
@@ -0,0 +1,523 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+# 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
+# Provides some tools for manipulating IHEX8, binary and sim files.
+# It's intented for converting between these file types and for
+# normalizing hex files.
+# --------------------------------------------------------------------------
+
+namespace eval IHexTools {
+
+ ## PUBLIC
+ variable update 0 ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+ variable error_count 0 ;# Int: Count of errors
+ variable error_string {} ;# Error messages
+ variable highest_addr 0 ;# Int: Highest address in loaded IHEX file
+
+ ## PRIVATE
+ variable content ;# Array: Currently loaded data (content(0..65535) => 00..FF)
+ variable INITIALIZED 0 ;# Bool: Namespace variables initialized
+ variable data_field ;# Auxiliary variable for creating IHEX records
+ variable data_field_len ;# Auxiliary variable for creating IHEX records
+
+
+ # ----------------------------------------------------------------
+ # GENERAL PURPOSE PROCEDURES
+ # ----------------------------------------------------------------
+
+ ## Compute checksum for the given HEX field (without leading colon)
+ # @parm String hex_data - HEX field without leading colon
+ # @return String - resulting hexadecimal checksum
+ proc getCheckSum {hex_data} {
+
+ set sum 256 ;# Initial checksum
+ set hex_data [split $hex_data {}]
+
+ # Iterate over hex data
+ for {set i 0} {1} {incr i} {
+
+ # Gain 1st hex digit
+ set val [lindex $hex_data $i]
+
+ # If the 1st digit is empty -> return result
+ if {$val == {}} {
+ # Handle overflow
+ if {$sum == 256} {return {00}}
+ # Convert decimal checksum to hexadecimal
+ set sum [format "%X" $sum]
+ if {[string length $sum] == 1} {
+ set sum "0$sum"
+ }
+ return $sum
+ }
+
+ # Gain 2nd hex digit
+ incr i
+ append val [lindex $hex_data $i]
+ set val [expr "0x$val"]
+
+ # Decrement checksum
+ incr sum -$val
+
+ # Handle undeflow
+ if {$sum < 0} {incr sum 256}
+ }
+ }
+
+ ## Get maximum value for progressbar when loading hex or sim file
+ # @parm String data - input sim or hex data
+ # @return Int - number of iterations divided by 25
+ proc get_number_of_iterations {data} {
+ # Any EOL to LF
+ regsub -all {\r\n?} $data "\n" data
+
+ # Local variables
+ set result 0 ;# Resulting number
+ set index 0 ;# Last search result
+
+ # Get number of LF chracters
+ while 1 {
+ set index [string first "\n" $data $index]
+ if {$index == -1} {break}
+ incr index
+ }
+
+ # Return result
+ return [expr {$result / 25 + 1}]
+ }
+
+ ## Load IHEX 8 file into internal memory
+ # @parm String hex_data - Content of IHEX8 file to load
+ # @return Bool - result
+ proc load_hex_data {hex_data} {
+ variable INITIALIZED ;# Bool: Namespace variables initialized
+
+ variable content ;# Array: Currently loaded data
+ variable update ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+ variable error_count 0 ;# Int: Count of errors
+ variable error_string {} ;# Error messages
+ variable highest_addr 0 ;# Int: Highest address in loaded IHEX file
+
+ # Initialize array of loaded data
+ if {!$INITIALIZED} {
+ free_resources
+ }
+ # Convert any EOL to LF
+ regsub -all {\r\n?} $hex_data "\n" hex_data
+
+ # Local variables
+ set lineNum 0 ;# Number of the current line
+ set eof 0 ;# Bool: EOF detected
+
+ # Iterate over HEX records
+ foreach line [split $hex_data "\n"] {
+ incr lineNum ;# Increment line number
+
+ # Skip comments
+ if {[string index $line 0] != {:}} {continue}
+
+ # Check for valid charters
+ if {![regexp {^:[0-9A-Fa-f]+$} $line]} {
+ Error $lineNum [mc "Line contains invalid characters"]
+ continue
+ }
+ # Check for odd lenght
+ set len [string length $line]
+ if {[expr {$len % 2}] != 1} {
+ Error $lineNum [mc "Line contains even number of characters"]
+ continue
+ }
+
+ # Analize HEX record
+ set len [ string range $line 1 2 ] ;# Lenght field
+ set addr [ string range $line 3 6 ] ;# Address field
+ set type [ string range $line 7 8 ] ;# Type field
+ set data [ string range $line 9 {end-2} ] ;# Data field
+ set check [ string range $line {end-1} end ] ;# Checksum field
+ set line [ string range $line 1 {end-2} ] ;# Record without ':' and checksum
+
+ # Handle record type (01 == EOF; 00 == normal record)
+ if {$type == {01}} {
+ set eof 1
+ break
+ } elseif {$type != {00}} {
+ Error $lineNum [mc "Unknown record type '%s'" $type]
+ continue
+ }
+
+ # Check for valid checksum
+ set new_check [getCheckSum $line]
+ if {$new_check != $check} {
+ Error $lineNum [mc "Bad checksum"]
+ continue
+ }
+
+ # Check for correct value of the length field
+ set len [expr "0x$len"]
+ if {([string length $data] / 2) != $len} {
+ Error $lineNum [mc "Bad length"]
+ continue
+ }
+
+ # Parse and load data field
+ set addr [expr "0x$addr"]
+ for {set i 0; set j 1} {$i < ($len * 2)} {incr i 2; incr j 2} {
+ set content($addr) [string range $data $i $j]
+ incr addr
+ }
+
+ # Store highest address
+ if {$addr > $highest_addr} {
+ set highest_addr $addr
+ }
+
+ # Update GUI and progress variable
+ if {$update} {
+ if {![expr {$lineNum % 25}]} {
+ # Conditional abort
+ if {$abort} {return 0}
+ # Update progress variable and GUI
+ incr progress
+ update
+ }
+ }
+ }
+
+ # If there is no EOF then report that as an error
+ if {!$eof} {
+ Error - [mc "Missing EOF"]
+ }
+
+ # Return result
+ if {$error_count} {
+ return 0
+ } {
+ return 1
+ }
+ }
+
+ ## Load binary file into internal memory
+ # @parm String data - Binary data to load
+ # @return Bool - result
+ proc load_bin_data {data} {
+ variable INITIALIZED ;# Bool: Namespace variables initialized
+
+ variable content ;# Array: Currently loaded data
+ variable update ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+ variable error_count 0 ;# Int: Count of errors
+ variable error_string {} ;# Error messages
+
+ # Initialize array of loaded data
+ if {!$INITIALIZED} {
+ free_resources
+ }
+
+ # Check for allowed data length
+ set len [string length $data]
+ if {$len > 0x10000} {
+ Error - [mc "Data length exceeding limit 0x10000"]
+ return 0
+ }
+
+ # Load data
+ set val 0
+ for {set i 0} {$i < $len} {incr i} {
+ binary scan [string index $data $i] c val ;# bin -> dec
+ set content($i) [string range [format %X $val] end-1 end] ;# dec -> hex
+ }
+ return 1
+ }
+
+ ## Load simulator file into internal memory
+ # @parm String data - Content of simulator file to load
+ # @return Bool - result
+ proc load_sim_data {data} {
+ variable INITIALIZED ;# Bool: Namespace variables initialized
+
+ variable content ;# Array: Currently loaded data
+ variable update ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+ variable error_count 0 ;# Int: Count of errors
+ variable error_string {} ;# Error messages
+
+ # Initialize array of loaded data
+ if {!$INITIALIZED} {
+ free_resources
+ }
+
+ # Adjust input data
+ regsub -all {\r\n?} $data "\n" data ;# Any EOL to LF
+ regsub -all -line {\s*#.*$} $data {} data ;# Remove comments
+ regsub {^[^\n]+\n} $data {} data ;# Discard the first line
+
+ set lineNum 0 ;# Line number
+
+ # Iterate over lines in the given data
+ foreach line [split $data "\n"] {
+ incr lineNum ;# Increment line number
+
+ # Skip empty lines
+ if {$line == {}} {continue}
+
+ # Anylize line
+ set ln [lindex $line 0] ;# Line number
+ set addr [lindex $line 1] ;# Address
+ set line [lreplace $line 0 1] ;# Processor codes
+
+ # Check for validity of line number
+ if {![string is digit -strict $ln]} {
+ Error $lineNum [mc "Invalid line number '%s'" $ln]
+ continue
+ }
+ # Check for validity of address
+ if {![string is digit -strict $addr]} {
+ Error $lineNum [mc "Invalid address '%s'" $addr]
+ continue
+ }
+ # Check for allowed characters
+ if {![regexp {^[\d \t]+$} $line] || ![llength $line]} {
+ Error $lineNum [mc "Invalid data field"]
+ continue
+ }
+
+ # Load processor codes
+ foreach val $line {
+ set content($addr) [format %X $val]
+ incr addr
+ }
+
+ # Update GUI and progress variable
+ if {$update} {
+ if {![expr {$lineNum % 25}]} {
+ # Conditional abort
+ if {$abort} {return 0}
+ # Update progress variable and GUI
+ incr progress
+ update
+ }
+ }
+ }
+
+ # Return result
+ if {$error_count} {
+ return 0
+ } {
+ return 1
+ }
+ }
+
+ ## Get loaded data as binary string
+ # @return String - Resulting binary data
+ proc get_bin_data {} {
+ variable content ;# Array: Currently loaded data
+ variable update ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+
+ # Local variables
+ set addr 0 ;# Current address
+ set pad {} ;# Padding
+ set result {} ;# Resulting binary string
+
+ # Load data and convert them (16 x 4096 interations)
+ for {set j 0} {$j < 16} {incr j} {
+ for {set i 0} {$i < 4096} {incr i} {
+ # Get hexadecimal value
+ set hex $content($addr)
+ # Convert it to binary value
+ if {$hex == {}} {
+ append pad "\0"
+ } {
+ if {$pad != {}} {
+ append result $pad
+ set pad {}
+ }
+ append result [subst "\\x$hex"]
+ }
+ # Increment address
+ incr addr
+ }
+
+ # Update GUI and progress variable
+ if {$update} {
+ # Update progress variable and GUI
+ incr progress
+ update
+ # Conditional abort
+ if {$abort} {
+ return {}
+ }
+ }
+ }
+
+ # Return resulting binary string
+ return $result
+ }
+
+ ## Get loaded data as IHEX8
+ # @return String - Resulting IHEX8
+ proc get_hex_data {} {
+ variable content ;# Array: Currently loaded data
+ variable update ;# Bool: Periodicaly update GUI and increment progress
+ variable abort 0 ;# Bool: Abort currently running procedure
+ variable progress 1 ;# Int: Variable for progress bars
+ variable data_field ;# Auxiliary variable for creating IHEX records
+ variable data_field_len ;# Auxiliary variable for creating IHEX records
+
+ # Local variables
+ set pointer 0 ;# Current address
+ set data_field_len 0 ;# IHEX8 Data field lenght
+ set data_field {} ;# IHEX8 Data field
+ set result {} ;# Resulting IHEX8
+
+ # Load data (16 x 4096 interations)
+ for {set j 0} {$j < 16} {incr j} {
+ for {set i 0} {$i < 4096} {incr i} {
+ # Determinate HEX value
+ set hex $content($pointer)
+
+ # If HEX value if empty -> write record
+ if {$hex == {} && $data_field_len} {
+ create_hex_record [expr {$pointer - $data_field_len}]
+ append result $data_field
+ set data_field {}
+
+ # Append HEX value to the current data field
+ } elseif {$hex != {}} {
+ if {[string length $hex] == 1} {
+ set hex "0$hex"
+ }
+
+ append data_field $hex
+ incr data_field_len
+ }
+
+ # Increment current address
+ incr pointer
+
+ # If data field length is high -> write record
+ if {$data_field_len == ${::Compiler::Settings::max_ihex_rec_length}} {
+ create_hex_record [expr {$pointer - $data_field_len}]
+ append result $data_field
+ set data_field {}
+ }
+ }
+
+ # Update GUI and progress variable
+ if {$update} {
+ # Update progress variable and GUI
+ incr progress
+ update
+ # Conditional abort
+ if {$abort} {
+ return {}
+ }
+ }
+ }
+
+ # Append EOF and return result
+ append result {:00000001FF}
+ return $result
+ }
+
+ ## Free used resources
+ # @return void
+ proc free_resources {} {
+ variable content ;# Array: Currently loaded data
+ variable error_string {} ;# Error messages
+ variable data_field 0 ;# Auxiliary variable for creating IHEX records
+
+ # Reset array of loaded data
+ for {set i 0} {$i < 0x10000} {incr i} {
+ set content($i) {}
+ }
+ }
+
+ ## Get value of particular cell in the loaded array
+ # @parm Int addr - Must be 0..65535
+ # @return Int - -1 == Not defined; 0..255 loaded value
+ proc get_value {addr} {
+ variable content ;# Array: Currently loaded data
+
+ if {$addr < 0 || $addr > 0xFFFF} {
+ return -1
+ }
+ set result $content($addr)
+ if {$result == {}} {
+ return -1
+ } {
+ return $result
+ }
+ }
+
+
+
+ # ----------------------------------------------------------------
+ # INTERNAL AUXILIARY PROCEDURES
+ # ----------------------------------------------------------------
+
+ ## Create IHEX8 record (result -> data_field)
+ # @parm String addr - Content of address firld (decimal number)
+ # @return void
+ proc create_hex_record {addr} {
+ variable data_field ;# Auxiliary variable for creating IHEX records
+ variable data_field_len ;# Auxiliary variable for creating IHEX records
+
+ # Adjust address
+ set addr [format %X $addr]
+ set len [string length $addr]
+ if {$len != 4} {
+ set addr "[string repeat 0 [expr {4 - $len}]]$addr"
+ }
+ # Adjust lenght
+ set len [format %X $data_field_len]
+ if {[string length $len] == 1} {
+ set len "0$len"
+ }
+
+ # Create HEX field
+ set data_field ":${len}${addr}00${data_field}[getCheckSum ${len}${addr}00${data_field}]\n"
+ set data_field_len 0
+ }
+
+ ## Append error message to error_string
+ # @parm Int line - Number of line where the error occured
+ # @parm String - Error message
+ # @return void
+ proc Error {line string} {
+ variable error_count ;# Int: Count of errors
+ variable error_string ;# Error messages
+
+ incr error_count
+ append error_string [mc "Error at line %s:\t" $line] $string "\n"
+ }
+}
diff --git a/lib/lib/innerwindow.tcl b/lib/lib/innerwindow.tcl
new file mode 100755
index 0000000..f1d2505
--- /dev/null
+++ b/lib/lib/innerwindow.tcl
@@ -0,0 +1,360 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+# 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
+# Implements tool for creating application inner windows. That means windows
+# which are enclosed in the main window. And which are not managed by window
+# manager but by their own implementation. These windows are inside the main
+# window and cannot be dragged outside.
+#
+# REQUIREMENTS:
+# Librararies: "Incr TCL", "BWidget", "Tk"
+# This class also requires this: "namespace import ::itcl::*"
+# --------------------------------------------------------------------------
+
+class InnerWindow {
+ ## COMMON
+ common active_titclr {#AAAAFF} ;# Color: Active background color
+ common inactive_titclr {#DDDDDD} ;# Color: Inactive background color
+ common title_bar_height 10 ;# Int: Height of the titlebar in pixels
+
+ # List: Title bar popup menu
+ common MENU {
+ {command "Shade/Unshade" "" 0 {collapse_expand}
+ {}}
+ {command "Close" "" 0 {close_window}
+ {}}
+ }
+
+ ## PRIVATE
+ private variable win_height
+ private variable max_X ;# Int: Auxiliary variable for storing max. allowed position
+ private variable max_Y ;# Int: Auxiliary variable for storing max. allowed position
+ private variable click_X ;# Int: Auxiliary variable for storing last position
+ private variable click_Y ;# Int: Auxiliary variable for storing last position
+
+ private variable close_cmd
+ private variable title_bar ;# Widget: Window title bar
+ private variable title_label ;# Widget: Label containg text "Scribble notepad"
+ private variable close_button ;# Widget: Close button
+ private variable coll_exp_but ;# Widget: Shade button
+ private variable win
+ private variable main_frame ;# Widget: Main window frame
+ private variable minim_flag 0 ;# Bool: Shaded or not
+ private variable allow_raise_win 1 ;# Bool: Allows to use command
+
+ private variable menu ;# Widget: Title bar popup menu
+ private variable menu_created 0 ;# Bool: Title bar popup menu created
+
+ private variable close_window_in_progress 0 ;# Bool: Close procedure is in progress
+
+ ## Object constructor
+ # @parm Widget path - Window path (e.g. ".window_agent_007")
+ # @parm List geometry - {W H X Y} (Coordinates are raltive to the transient window)
+ # @parm String title - Window title
+ # @parm Image icon - Window icon, {} means no icon
+ # @parm String _close_cmd - Command to execute on close in the root namespace (stack frame #0)
+ constructor {path geometry title icon _close_cmd} {
+
+ # Configure specific ttk styles
+ ttk::style configure InnerWindow_Active.TButton \
+ -background $active_titclr \
+ -padding 0 \
+ -borderwidth 1 \
+ -relief flat
+ ttk::style map InnerWindow_Active.TButton \
+ -background [list active $active_titclr] \
+ -relief [list active raised]
+
+ ttk::style configure InnerWindow_Inactive.TButton \
+ -background $inactive_titclr \
+ -padding 0 \
+ -borderwidth 1 \
+ -relief flat
+ ttk::style map InnerWindow_Inactive.TButton \
+ -background [list active $inactive_titclr] \
+ -relief [list active raised]
+
+ # Set object variables
+ set max_X 1000
+ set max_Y 1000
+ set close_cmd $_close_cmd
+
+ # Create window GUI components
+ set win [frame $path -bd 1 -relief raised -bg $active_titclr -padx 2 -pady 2]
+ set main_frame [frame $win.main_frame]
+ set menu $win.menu
+
+ ## Create title bar
+ # - Title bar frame
+ set title_bar [frame $win.title_bar \
+ -bg $active_titclr \
+ -height $title_bar_height \
+ ]
+ set title_label [label $title_bar.text \
+ -bg $active_titclr -pady 0 \
+ -compound left -text $title \
+ -cursor left_ptr \
+ ]
+ if {$icon != {}} {
+ $title_label configure -image $icon -padx 5
+ }
+ # - Button "Close"
+ set close_button [ttk::button $title_bar.close_but \
+ -style InnerWindow_Active.TButton \
+ -command "$this close_window" \
+ -image ::ICONS::16::button_cancel \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $close_button -text [mc "Close"]
+ setStatusTip -widget $close_button -text [mc "Close"]
+ # - Button "Shade"
+ set coll_exp_but [ttk::button $title_bar.col_exp_but \
+ -style InnerWindow_Flat.TButton \
+ -command "$this collapse_expand" \
+ -image ::ICONS::16::_1uparrow \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $coll_exp_but -text [mc "Shade"]
+ setStatusTip -widget $coll_exp_but -text [mc "Shade"]
+ # Pack buttons
+ pack $coll_exp_but -padx 5 -side left -pady 0 -ipady 0
+ pack $close_button -side right -pady 0 -ipady 0 -padx 3
+ pack $title_label -side left -fill x -pady 0 -ipady 0 -expand 1
+ raise $close_button
+ # Set title bar event bindings
+ bind $title_label <Double-1> "$this collapse_expand; break"
+ bind $title_label <Button-1> "$this title_B1 %X %Y"
+ bind $title_label <B1-Motion> "$this title_B1_motion %X %Y; break"
+ bind $title_label <ButtonRelease-1> "$this title_B1_release; break"
+ bind $title_label <ButtonRelease-3> "$this title_B3_release %X %Y; break"
+
+
+ pack $title_bar -fill x
+ pack $main_frame -fill both -expand 1
+
+ # Show the window
+ set win_height [lindex $geometry 1]
+ bind $win <Destroy> "catch {delete object $this}"
+ bind $main_frame <Destroy> "catch {delete object $this}"
+ bind $win <Visibility> "$this raise_win"
+ bind $win <FocusIn> "$this focusin"
+ bind $win <FocusOut> "$this focusout"
+ place $win \
+ -width [lindex $geometry 0] \
+ -height [lindex $geometry 1] \
+ -x [lindex $geometry 2] \
+ -y [lindex $geometry 3] \
+ -anchor nw
+ raise $win
+ }
+
+ ## Object destructor
+ destructor {
+ close_window
+ }
+
+ ## Withdraw the window
+ # Note: Window can be taken back to visible state using method "geometry"
+ # @see geometry
+ # @return
+ public method withdraw {} {
+ place forget $win
+ }
+
+ ## Close the window
+ # @return void
+ public method close_window {} {
+ if {$close_window_in_progress} {return}
+ set close_window_in_progress 1
+
+ uplevel #0 $close_cmd
+ destroy $win
+ }
+
+ ## Get window inner frame where to map widgets in the window
+ # @return Widget - Inner frame
+ public method get_frame {} {
+ return $main_frame
+ }
+
+ ## Get and/or set window geometry including frame and title bar
+ # @parm Int = {} - Width
+ # @parm Int = {} - Height
+ # @parm Int = {} - Relative position -- X
+ # @parm Int = {} - Relative position -- Y
+ # Note: If you want to set only certain attributes then set others as {}
+ # @return Current window geometry {W H X Y}
+ public method geometry args {
+ # Set geometry
+ if {[llength $args]} {
+ if {[string length [lindex $args 0]]} {
+ place $win -width [lindex $args 0]
+ }
+ if {[string length [lindex $args 1]]} {
+ place $win -height [lindex $args 1]
+ set win_height [lindex $args 1]
+ }
+ if {[string length [lindex $args 2]]} {
+ place $win -x [lindex $args 2]
+ }
+ if {[string length [lindex $args 3]]} {
+ place $win -y [lindex $args 3]
+ }
+ update
+ }
+
+ # Get geometry
+ return [list \
+ [winfo width $win] \
+ [winfo height $win] \
+ [winfo x $win] \
+ [winfo y $win] \
+ ]
+ }
+
+ ## Event handler: window frame <FocusIn>
+ # @return void
+ public method focusin {} {
+ update
+ foreach widget [list $title_bar $title_label $win] {
+ $widget configure -bg $active_titclr
+ }
+ foreach widget [list $close_button $coll_exp_but] {
+ $widget configure -style InnerWindow_Active.TButton
+ }
+
+ update
+ }
+
+ ## Event handler: window frame <FocusOut>
+ # @return void
+ public method focusout {} {
+ update
+ foreach widget [list $title_bar $title_label $win] {
+ $widget configure -bg $inactive_titclr
+ }
+ foreach widget [list $close_button $coll_exp_but] {
+ $widget configure -style InnerWindow_Inactive.TButton
+ }
+
+ update
+ }
+
+ ## (Un)Shade window
+ # @return void
+ public method collapse_expand {} {
+ # Object variables
+ set minim_flag [expr {!$minim_flag}]
+
+ # Shade
+ if {$minim_flag} {
+ set image _1downarrow
+ pack forget $main_frame
+ place $win -height [expr {[winfo height $win.title_bar] + 4}]
+ # Unshade
+ } {
+ set image _1uparrow
+ pack $main_frame -fill both -expand 1
+ place $win -height $win_height
+ }
+ $coll_exp_but configure -image ::ICONS::16::$image
+ }
+
+ ## Determinate whether the window is shaded or not
+ # @return Bool - 1 == Shaded; 0 == Not shaded
+ public method get_minim_flag {} {
+ return $minim_flag
+ }
+
+ ## Insure window visibility
+ # @return void
+ public method raise_win {} {
+ if {!$allow_raise_win} {return}
+ set allow_raise_win 0
+ after 1000 "catch {$this set_allow_raise_win}"
+ raise $win
+ }
+
+ ## @see raise_win
+ # @return void
+ public method set_allow_raise_win {} {
+ set allow_raise_win 1
+ }
+
+ ## Event handler: title bar <Button-1>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B1 {x y} {
+ set click_X [expr {[winfo x $win] - $x}]
+ set click_Y [expr {[winfo y $win] - $y}]
+
+ set max_X [winfo width .]
+ set max_Y [winfo height .]
+ incr max_X -70
+ incr max_Y -70
+
+ focus $win
+ $title_label configure -cursor fleur
+ }
+
+ ## Event handler: title bar <ButtonRelease-1>
+ # @return void
+ public method title_B1_release {} {
+ $title_label configure -cursor left_ptr
+ }
+
+ ## Event handler: title bar <ButtonRelease-3>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B3_release {X Y} {
+ focus $win
+
+ if {!$menu_created} {
+ menuFactory $MENU $menu 0 "$this " 0 {}
+ set menu_created 1
+ }
+
+ tk_popup $menu $X $Y
+ }
+
+ ## Event handler: title bar <B1-Motion>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method title_B1_motion {x y} {
+ incr x $click_X
+ incr y $click_Y
+
+ if {$x > 0 && $x < $max_X} {
+ place $win -x $x
+ }
+ if {$y > 0 && $y < $max_Y} {
+ place $win -y $y
+ }
+ }
+}
diff --git a/lib/lib/settings.tcl b/lib/lib/settings.tcl
new file mode 100755
index 0000000..3c50466
--- /dev/null
+++ b/lib/lib/settings.tcl
@@ -0,0 +1,293 @@
+#!/usr/bin/tclsh
+# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
+
+############################################################################
+# 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
+# Implements interface to program settings (which are stored in a file)
+# --------------------------------------------------------------------------
+
+class Settings {
+ common dir_sep [file separator] ;# Directory separator (eg. '/')
+ common count 0 ;# Counter of instances
+
+ private variable isEmpty 1 ;# Is settings array empty
+ private variable isReady 0 ;# Is interface ready
+
+ private variable directory ;# Path to directory with settings file
+ private variable filename ;# Name of file with settings related to this instance
+ private variable fileFullPath ;# Full name of settings file (including directory)
+ private variable configArray {} ;# Content of settings maneged by this interface
+
+ ## Object contructor
+ # @parm String configDir - Path to directory with settings file
+ # @parm String configFileName - Name of file with settings
+ constructor {configDir configFileName} {
+ incr count ;# increment instance conter
+
+ # Incalize object variables
+ set configArray "::Settings::S$count" ;# Array of settings
+ set directory [string trimright $configDir "/\/"] ;# Path to directory with settings file
+ set filename [string trimleft $configFileName "/\/"] ;# Name of file with settings
+ set fileFullPath "${directory}${dir_sep}${filename}" ;# Full name of settings file
+
+ # If specified file does not exist -> create it
+ if {![file exists $fileFullPath]} {
+ if {[catch {
+ file mkdir $directory
+ close [open $fileFullPath w 420]
+ }]} then {
+ return
+ } else {
+ set isReady 1
+ }
+
+ # Else check if the file is readable and writable
+ } else {
+ if {$::MICROSOFT_WINDOWS || ([file readable $fileFullPath] && [file writable $fileFullPath])} {
+ set isReady 1
+ } {
+ return
+ }
+ }
+
+ # Load settings from the file
+ reLoadConfig
+ }
+
+ ## Object destructor
+ destructor {
+ }
+
+ ## (Re)load settings from config file
+ # @return result
+ public method reLoadConfig {} {
+
+ # Check if file is readable
+ if {!$::MICROSOFT_WINDOWS && ![file readable $fileFullPath]} {
+ return 0
+ }
+
+ # Read content of config file and store it as list of lines into fileData
+ set configFile [open $fileFullPath r]
+ set fileData [read $configFile]
+ set fileData [regsub -all {\r\n} $fileData "\n"]
+ set fileData [regsub -all {\r} $fileData "\n"]
+ set fileData [split $fileData "\n"]
+ close $configFile
+
+ # Parse content of the file
+ set category {general}
+ foreach line $fileData {
+ # Local variables
+ set line [string trim $line] ;# Line of config file
+ set key {} ;# Key
+ set value {} ;# Value for the key
+
+ # Skip empty lines
+ if {$line == {}} {continue}
+
+ # Handle category declaration
+ if {[regexp {^\[\s*[\w \t]+\s*\]$} $line]} {
+ set category [string trim $line "\[\] \t"]
+
+ # Handle key and its value
+ } elseif {[regexp {^\s*[\w \t:]+\s*\=\s*\".*\"\s*$} $line]} {
+ # Determinate key
+ regexp {^\s*[\w \t:]+\s*\=} $line key
+ set key [string trim $key "=\t "]
+ # Determinate value
+ regexp {\s*\".*\"\s*$} $line value
+ set value [string trim $value]
+ regsub {^\"} $value {} value
+ regsub {\"$} $value {} value
+ regsub -all "\a" $value "\n" value
+ # Set key and value to array
+ set "$configArray\($category/$key\)" $value
+ }
+ }
+
+ # Set variable isEmpty
+ if {[array size $configArray] != 0} {
+ set isEmpty 0
+ } {
+ set isEmpty 1
+ }
+
+ # return result
+ return 1
+ }
+
+ ## Save current content of $configArray to config file
+ # @return result
+ public method saveConfig {} {
+
+ # Check if file is writable
+ if {![file writable $fileFullPath]} {
+ return 0
+ }
+
+ # Local variables
+ set configFile [open $fileFullPath w 420] ;# ID of config file chanel
+ set categories {general} ;# Name of current category
+
+ # Determinate list of categories
+ foreach key [array names $configArray] {
+ # Determinate category
+ regexp {^.+/} $key category
+ set category [string trimright $category {/}]
+ # Append category to the list
+ if {[lsearch $categories $category] == -1} {
+ lappend categories $category
+ }
+ }
+
+ # Iterate over categories and save them to the file
+ foreach category $categories {
+ # Get names of keys in current category
+ set keys [array names $configArray -regexp "$category/"]
+ # Save category declaration
+ puts $configFile "\n\[$category\]"
+ # Iterate over keys in current category
+ foreach fullKey $keys {
+ # Determinate key
+ regsub {^[^/]*/} $fullKey {} key
+ # Determinate value
+ set value [subst "\$$configArray\(\$fullKey\)"]
+ regsub -all "\n" $value "\a" value
+ # Save key and value
+ puts $configFile "$key=\"$value\""
+ }
+ }
+
+ # Done ...
+ close $configFile
+ return 1
+ }
+
+ ## Return True if config array is empty
+ # @return Bool - result
+ public method isEmpty {} {
+ return $isEmpty
+ }
+
+ ## Return True if interface is ready
+ # @return Bool - result
+ public method isReady {} {
+ return $isReady
+ }
+
+ ## Clear all settings
+ # @return void
+ public method clear {} {
+ array unset $configArray
+ }
+
+ ## Remove specified key from settings
+ # @parm String key - name of key to remove
+ # @return Bool - result
+ public method remove {key} {
+ regsub -all {_} $key {__} key
+ regsub -all {\s} $key {_} key
+
+ if {[i_contains $key]} {
+ unset "$configArray\($key\)"
+ return 1
+ } {
+ return 0
+ }
+ }
+
+ ## Return True if the specified key is defined
+ # @parm String key - key to search for
+ # @return Bool - result
+ public method contains {key} {
+ regsub -all {_} $key {__} key
+ regsub -all {\s} $key {_} key
+
+ return [i_contains $key]
+ }
+
+ ## Internal key search (Does not peform key name adjusment)
+ # @parm String key - name of key to search for
+ # @return Bool - result
+ private method i_contains {key} {
+ if {[array names $configArray -exact $key] == {}} {
+ return 0
+ } {
+ return 1
+ }
+ }
+
+ ## Get value for the given key
+ # @parm String key - Key
+ # @parm Mixed default - Default value
+ # @return Mixed - value for the given key
+ public method getValue {key default} {
+
+ # Adjust key name
+ if {![regexp {^.+/} $key]} {
+ set key "general/$key"
+ }
+ regsub -all {_} $key {__} key
+ regsub -all {\s} $key {_} key
+
+ # Check for valid key format
+ if {![regexp {^[\w:]+/[\w:]+$} $key]} {
+ return $default
+ }
+
+ # Check if the given key is defined
+ if {[i_contains $key]} {
+ return [subst "\$$configArray\(\$key\)"]
+ } {
+ return $default
+ }
+ }
+
+ ## Set value for the given key
+ # @parm String key - Key
+ # @parm Mixed value - Value
+ # @return Bool - result
+ public method setValue {key value} {
+
+ ## Check for key validity
+ if {[regexp {[\!\=\$\^\*\+\?\.\[\]\{\}\(\)]} $key]} {
+ return 0
+ }
+
+ regsub -all {_} $key {__} key
+ regsub -all {\s} $key {_} key
+
+ if {![regexp {^.+/} $key]} {
+ set key "general/$key"
+ }
+
+ if {![regexp {^[\w:]+/[\w:]+$} $key]} {
+ return 0
+ }
+
+ ## Set value
+ set "$configArray\($key\)" $value
+ return 1
+ }
+}
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-29 04:33:39 +0000