#!/usr/bin/tclsh # Part of MCU 8051 IDE ( http://https://sourceforge.net/projects/mcu8051ide/ ) ############################################################################ # Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera # # martin.osmera@gmail.com # # # # Copyright (C) 2014 by Moravia Microsystems, s.r.o. # # 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. # ############################################################################ # >>> File inclusion guard if { ! [ info exists _BASECONVERTER_TCL ] } { set _BASECONVERTER_TCL _ # <<< File inclusion guard # -------------------------------------------------------------------------- # DESCRIPTION # Utility "Base Converter" # -------------------------------------------------------------------------- class BaseConverter { ## COMMON public common base_c_count 0 ;# Int: Counter of class instances public common INITIAL_HEIGHT 130 ;# Int: Initial heightof the window in pixels public common INITIAL_WIDTH 150 ;# Int: Initial width of the window in pixels public common EXTENDED_WIDTH 340 ;# Int: Width of the window when it is in extended mode # On MS Windows these values has to be a bit different if {$::MICROSOFT_WINDOWS} { set INITIAL_HEIGHT 125 set INITIAL_WIDTH 165 set EXTENDED_WIDTH 355 } # Font entryboxes public common entry_font [font create \ -size -12 \ -family $::DEFAULT_FIXED_FONT \ -weight bold \ ] ## PRIVATE private variable win ;# Widget: Window private variable win_obj ;# Object: Window object private variable less_more_button ;# Widget: Button "Less/More" private variable enlarge_shrink_button ;# Widget: Button "Enlarge/Shrink" private variable right_top_frame ;# Widget: Right top frame private variable left_top_frame ;# Widget: Left top frame private variable less_more 0 ;# Bool: Mode flag "More" private variable large 0 ;# Bool: Flag enlarged private variable left_rows_created 0 ;# Int: Number of created rows in the left frame private variable right_rows_created 0 ;# Int: Number of created rows in the right frame private variable validation_in_progress 0 ;# Bool: Validation procedure in progress private variable val_to_set [list {} {} {}] ;# List: Decimal values to set in the bottom 3 entryboxes after enlarge private variable entry_h ;# Array of Widget: Entrybox "HEX", index is row (starting from 0) private variable entry_d ;# Array of Widget: Entrybox "DEC", index is row (starting from 0) private variable entry_b ;# Array of Widget: Entrybox "BIN", index is row (starting from 0) private variable entry_o ;# Array of Widget: Entrybox "OCT", index is row (starting from 0) private variable entry_t ;# Array of Widget: Canvas containing bits private variable entry_c0 ;# Array of Widget: Entrybox "BCD L", index is row (starting from 0) private variable entry_c1 ;# Array of Widget: Entrybox "BCD H", index is row (starting from 0) private variable entry_a ;# Array of Widget: Entrybox "ASCII", index is row (starting from 0) private variable bit ;# CanvasObject: bit rectangle, $bit(row_number,bit_number) ## Object constructor constructor {} { # Configure ttk styles if {!$base_c_count} { ttk::style configure BaseConverter_Focused_D.TEntry -fieldbackground {#AAAAFF} ttk::style configure BaseConverter_Focused_I.TEntry -fieldbackground {#DDDDFF} ttk::style configure BaseConverter_NotFocused.TEntry } incr base_c_count create_window create_gui } ## Object destructor destructor { } ## Commence a new configuration # @parm List conf_list - Configuration list previously returned by proc. "get_config" # @return void public method set_config {conf_list} { # Set window position $win_obj geometry \ {} {} \ [lindex $conf_list {0 2}] \ [lindex $conf_list {0 3}] # Adjust modes if {[lindex $conf_list 2]} { less_more } if {[lindex $conf_list 3]} { enlarge_shrink } # Fill in the entryboxes for {set i 0} {$i < $left_rows_created} {incr i} { validate {t} $i [lindex $conf_list [list 4 $i]] } if {$left_rows_created < 6} { for {set i 0; set j 3} {$i < 3} {incr i; incr j} { lset val_to_set $i [lindex $conf_list [list 4 $j]] } } # Adjust flag "Shaded" if {[lindex $conf_list 1]} { update $win_obj collapse_expand } } ## Get configuration list # @return List - Configuration list public method get_config {} { # Create list of current values in the entryboxes set values {} lappend values [$entry_d(0) get] [$entry_d(1) get] [$entry_d(2) get] if {$left_rows_created > 3} { lappend values \ [$entry_d(3) get] \ [$entry_d(4) get] \ [$entry_d(5) get] } else { lappend values {} {} {} } # Finalize configuration list return [list \ [$win_obj geometry] \ [$win_obj get_minim_flag] \ $less_more \ $large \ $values \ ] } ## Create window using class "InnerWindow" # @return void private method create_window {} { set win_obj [InnerWindow #auto \ .baseconverter_${base_c_count} \ [list $INITIAL_WIDTH $INITIAL_HEIGHT 100 100] \ [mc "Converter"] \ ::ICONS::16::kaboodleloop \ "$this close_window" \ ] set win [$win_obj get_frame] } ## Create all window GUI # @return void private method create_gui {} { # Create frames set top_frame [frame $win.top_frame] set left_top_frame [frame $top_frame.left_frame] set right_top_frame [frame $top_frame.right_frame] set bottom_frame [frame $win.bottom_frame] # Start in mode "Shirked" + !"More" create_left_frame ## Create buttons in the bottom frame # Button "Enlarge"/"Shrink" set enlarge_shrink_button \ [ttk::button $bottom_frame.enlarge_shrink_button \ -text [mc "Enlarge"] \ -compound left \ -image ::ICONS::16::1downarrow \ -command "$this enlarge_shrink" \ -width 7 \ -style Flat.TButton \ ] pack $enlarge_shrink_button -side left -padx 2 -pady 2 # Button "More"/"Less" set less_more_button [ttk::button $bottom_frame.less_more_button\ -text [mc "More"] \ -compound right \ -image ::ICONS::16::1rightarrow \ -command "$this less_more" \ -width 5 \ -style Flat.TButton \ ] pack $less_more_button -side right -padx 2 -pady 2 # Pack frames pack $left_top_frame -side left -anchor nw pack $top_frame -fill both -expand 1 pack $bottom_frame -fill x # Focus the firts hexadecimal entrybox focus -force $entry_h(0) } ## Close the window and forget configuration # Calls proc. "::X::__base_converter_close" # @return void public method close_window {} { ::X::__base_converter_close $this $win_obj close_window delete object $this } ## Validator for entryboxes # Can be used to set a certain value for a certain row in this way: # validate {t} $row_number $decimal_value # @parm Char type - Value source # h - Hexadecimal # d - Decimal # b - Binary # o - Octal # c0 - BCD - Low order nibble # c1 - BCD - High order nibble # a - ASCII # t - Bits (Do not validate, just accept) # @parm Int row - Row number, starting at zero # @parm String content - String to validate and evaluate # @return Bool - 1 == Legal; 0 == Illegal public method validate {type row content} { # This method cannot be recursive in any way if {$validation_in_progress} {return 1} set validation_in_progress 1 # Local variables set result 1 ;# Bool: Result of validation set zero_length 0 ;# Bool: Zero length input string set value {} ;# Mixed: Decimal representation the validate value or {} (no value) # Detect zero length input string if {[string length $content]} { set zero_length 0 } else { set zero_length 1 set content 0 } # Validate input string switch -- $type { {h} { ;# Hexadecimal if {![regexp {^[[:xdigit:]]{0,2}$} $content]} { set result 0 } else { scan $content "%x" value } } {d} { ;# Decimal if {![regexp {^[[:digit:]]{0,3}$} $content]} { set result 0 } elseif {$content > 255} { set result 0 } else { set value $content } } {b} { ;# Binary if {![regexp {^[01]{0,8}$} $content]} { set result 0 } else { set value [NumSystem::bin2dec $content] } } {o} { ;# Octal if {![regexp {^[0-7]{0,3}$} $content]} { set result 0 } elseif {$content > 377} { set result 0 } else { scan $content "%o" value } } {c0} { ;# BCD - Low order nibble if {![regexp {^[[:digit:]]{0,2}$} $content]} { set result 0 } elseif {$content > 15} { set result 0 } else { set value [$entry_c1($row) get] if {![string length $value]} { set value 0 } set value [expr {$content + ($value << 4)}] } set zero_length 0 } {c1} { ;# BCD - High order nibble if {![regexp {^[[:digit:]]{0,2}$} $content]} { set result 0 } elseif {$content > 15} { set result 0 } else { set value [$entry_c0($row) get] if {![string length $value]} { set value 0 } set value [expr {$value + ($content << 4)}] } set zero_length 0 } {a} { ;# ASCII if {$zero_length} { set content {} } set zero_length 0 if {[string length $content] > 1} { set result 0 } else { set value [NumSystem::ascii2dec $content] } if {![string length $value]} { set value [$entry_d($row) get] if {![string length $value]} { set zero_length 1 } } } {t} { ;# Bits (Do not validate, just accept) set value $content } } # Synchronize with the other entryboxes on the row if {$result} { fill_entryboxes $row $value $zero_length $type } # Finish ... set validation_in_progress 0 return $result } ## Synchronize the specified value with the other entryboxes on the row # @parm Int row - Row number # @parm Int value - Value to fill in (in decimal) # @parm Bool zero_length - Just clear all entryboxes # @parm Char exclude - Entrybox to exclude during filling # h - Hexadecimal # d - Decimal # b - Binary # o - Octal # c0 - BCD - Low order nibble # c1 - BCD - High order nibble # a - ASCII # t - No meaning ... # @return void private method fill_entryboxes {row value zero_length exclude} { # Clear entryboxes on the left foreach w [list \ $entry_h($row) $entry_d($row) \ $entry_b($row) $entry_o($row) \ ] t { h d b o } \ { if {$exclude == $t} { continue } $w delete 0 end } # Fill in entryboxes on the left if {!$zero_length} { if {$exclude != {h}} { $entry_h($row) insert 0 [format {%X} $value] } if {$exclude != {d}} { $entry_d($row) insert 0 $value } if {$exclude != {b}} { $entry_b($row) insert 0 [NumSystem::dec2bin $value] } if {$exclude != {o}} { $entry_o($row) insert 0 [format {%o} $value] } } if {$row < $right_rows_created} { # Clear entryboxes on the right foreach w [list $entry_c0($row) $entry_c1($row) $entry_a($row)] \ t {c0 c1 a} \ { if {$exclude == $t} { continue } $w delete 0 end } # Adjust canvas widget with bit rectangles set mask 1 for {set i 0} {$i < 8} {incr i} { if {$zero_length} { set fill {#FFFFFF} set outline {#888888} } elseif {[expr $value & $mask]} { set fill ${::BitMap::one_fill} set outline ${::BitMap::one_outline} } else { set fill ${::BitMap::zero_fill} set outline ${::BitMap::zero_outline} } $entry_t($row) itemconfigure $bit($row,$i) \ -fill $fill -outline $outline set mask [expr {$mask << 1}] } # Fill in entryboxes on the right if {!$zero_length} { if {$exclude != {c0}} { $entry_c0($row) insert 0 [expr {$value & 0x0F}] } if {$exclude != {c1}} { $entry_c1($row) insert 0 [expr {$value >> 4}] } if {$exclude != {a}} { if {$value > 31 && $value < 127} { $entry_a($row) insert 0 [format {%c} $value] } } } } } ## Handles event on canvas widget with bits, # @parm Int r - Row number (0..5) # @parm Int b - Bit number (0..7) # @return void public method bit_enter {r b} { # Determinate current rectangle fill and outline set fill [$entry_t($r) itemcget $bit($r,$b) -fill] set outline [$entry_t($r) itemcget $bit($r,$b) -outline] # Determinate new rectangle fill and outline if {$fill == ${::BitMap::one_fill}} { set fill ${::BitMap::one_a_fill} set outline ${::BitMap::one_a_outline} } elseif {$fill == ${::BitMap::zero_fill}} { set fill ${::BitMap::zero_a_fill} set outline ${::BitMap::zero_a_outline} } # Set new rectangle fill and outline and adjust cursor $entry_t($r) itemconfigure $bit($r,$b) \ -fill $fill -outline $outline $entry_t($r) configure -cursor hand2 } ## Handles event on canvas widget with bits, # @parm Int r - Row number (0..5) # @parm Int b - Bit number (0..7) # @return void public method bit_leave {r b} { # Determinate current rectangle fill and outline set fill [$entry_t($r) itemcget $bit($r,$b) -fill] set outline [$entry_t($r) itemcget $bit($r,$b) -outline] # Determinate new rectangle fill and outline if {$fill == ${::BitMap::one_a_fill}} { set fill ${::BitMap::one_fill} set outline ${::BitMap::one_outline} } elseif {$fill == ${::BitMap::zero_a_fill}} { set fill ${::BitMap::zero_fill} set outline ${::BitMap::zero_outline} } # Set new rectangle fill and outline and adjust cursor $entry_t($r) itemconfigure $bit($r,$b) \ -fill $fill -outline $outline $entry_t($r) configure -cursor left_ptr } ## Handles event on canvas widget with bits, # @parm Int r - Row number (0..5) # @parm Int b - Bit number (0..7) # @return void public method bit_click {r b} { # Determinate current rectangle fill set fill [$entry_t($r) itemcget $bit($r,$b) -fill] # Determinate new bit value if { $fill == ${::BitMap::one_a_fill} || $fill == ${::BitMap::one_fill} } then { set value 0 } else { set value [expr {1 << $b}] } # Determinate new value for the whole row set dec [$entry_d($r) get] if {![string length $dec]} { set dec 0 } set dec [expr {$dec & (0x0FF ^ (1 << $b))}] incr dec $value # Set new value for the whole row validate {t} $r $dec } ## Set envent binds specific to this appliaction for the specified entrybox # @parm Widget w - Entrybox widget # @parm Char t - Entrybox type # h - Hexadecimal # d - Decimal # b - Binary # o - Octal # c0 - BCD - Low order nibble # c1 - BCD - High order nibble # a - ASCII # @parm Int r - Row number (0..5) # @return void private method set_bindings_for_an_entrybox {w t r} { bind $w "$this entry_key $t $r u; break" bind $w "$this entry_key $t $r d; break" bind $w "$this entry_key $t $r l; break" bind $w "$this entry_key $t $r r; break" bind $w "$this entry_key $t $r t; break" if {!$::MICROSOFT_WINDOWS} { bind $w "$this entry_key $t $r s; break" } bind $w "$this entry_key $t $r e; break" bind $w "$this entry_key $t $r e; break" bind $w "$this entry_focus $t $r 1" bind $w "$this entry_focus $t $r 0" } ## Create the left frame of the window # @return void private method create_left_frame {} { # Create labels if {!$left_rows_created} { set col 1 foreach text { {HEX} {DEC} {BIN} {OCT} } { grid [label $left_top_frame.header_lbl_${col} \ -font $::smallfont -text [mc $text] -pady 0 \ ] -pady 0 -ipady 0 -row 1 -column $col incr col } } # Create entryboxes set row 0 for {set row $left_rows_created} {$row < ($large ? 6 : 3)} {incr row} { set col 1 foreach width { 2 3 8 3 } type { h d b o } \ { set entry_wgd [ttk::entry $left_top_frame.e_${type}_$row \ -width $width \ -validate key \ -validatecommand "$this validate $type $row %P" \ -style BaseConverter_NotFocused.TEntry \ -font $entry_font \ ] set entry_${type}($row) $entry_wgd grid $entry_wgd -row [expr {$row + 2}] -column $col set_bindings_for_an_entrybox $entry_wgd $type $row incr col } } set left_rows_created $row if {$large} { for {set i 0; set j 3} {$i < 3} {incr i; incr j} { validate {t} $j [lindex $val_to_set $i] } } } ## Create the left frame of the window # @return void private method create_right_frame {} { # Create labels if {!$right_rows_created} { set col 1 grid [label $right_top_frame.header_lbl_${col} \ -font $::smallfont -text [mc "Bits"] -pady 0 \ ] -pady 0 -ipady 0 -row 1 -column $col incr col grid [label $right_top_frame.header_lbl_${col} \ -font $::smallfont -text [mc "BCD"] -pady 0 \ ] -pady 0 -ipady 0 -row 1 -column $col -columnspan 2 incr col 2 grid [label $right_top_frame.header_lbl_${col} \ -font $::smallfont -text [mc "ASCII"] -pady 0\ ] -pady 0 -ipady 0 -row 1 -column $col incr col } # Create entryboxes and canvas widget set row 0 for {set row $right_rows_created} {$row < ($large ? 6 : 3)} {incr row} { set col 1 foreach type { t c a } \ { switch -- $type { {a} { ;# ASCII set entry_wgd [ttk::entry $right_top_frame.e_${type}_$row \ -width 2 \ -validate all \ -validatecommand "$this validate ${type} $row %P" \ -style BaseConverter_NotFocused.TEntry \ -font $entry_font \ ] set entry_${type}($row) $entry_wgd grid $entry_wgd -row [expr {$row + 2}] -column $col set_bindings_for_an_entrybox $entry_wgd $type $row } {c} { ;# BCD set entry_wgd [ttk::entry $right_top_frame.e_${type}1_$row \ -width 2 \ -validate all \ -validatecommand "$this validate ${type}1 $row %P" \ -style BaseConverter_NotFocused.TEntry \ -font $entry_font \ ] set entry_${type}1($row) $entry_wgd grid $entry_wgd -row [expr {$row + 2}] -column $col set_bindings_for_an_entrybox $entry_wgd "${type}1" $row incr col set entry_wgd [ttk::entry $right_top_frame.e_${type}0_$row \ -width 2 \ -validate all \ -validatecommand "$this validate ${type}0 $row %P" \ -style BaseConverter_NotFocused.TEntry \ -font $entry_font \ ] set entry_${type}0($row) $entry_wgd grid $entry_wgd -row [expr {$row + 2}] -column $col set_bindings_for_an_entrybox $entry_wgd "${type}0" $row } {t} { ;# Bits set x0 2 set y0 0 set y1 2 set canvas [canvas $right_top_frame.canvas_${row} \ -width 118 -height 18 -bd 0 -bg white \ -relief flat -highlightthickness 0 \ ] grid $canvas -row [expr {$row + 2}] -column $col set entry_${type}($row) $canvas for {set b 7} {$b >= 0} {incr b -1} { # Create bit rectagle set bit($row,$b) [$canvas create \ rectangle $x0 $y1 \ [expr {$x0 + 12}] \ [expr {$y1 + 12}] \ -fill {#FFFFFF} \ -outline {#888888} \ ] $canvas bind $bit($row,$b) "$this bit_enter $row $b" $canvas bind $bit($row,$b) "$this bit_leave $row $b" $canvas bind $bit($row,$b) "$this bit_click $row $b" # Adjust X position for the next rectagle incr x0 14 if {$b == 4} { incr x0 3 } } } } incr col } } set right_rows_created $row } ## Switch between modes "Enlarged" and "Shrinked" # @return void public method enlarge_shrink {} { # Invert the mode flag set large [expr {!$large}] # Adjust buttons on the bottom bar and create the missing widgets if nessesary if {$large} { create_right_frame create_left_frame $win_obj geometry {} [expr {[winfo height $entry_h(0)] * 3 + $INITIAL_HEIGHT}] {} {} $enlarge_shrink_button configure \ -image ::ICONS::16::1uparrow \ -text [mc "Shrink"] } else { $win_obj geometry {} $INITIAL_HEIGHT {} {} $enlarge_shrink_button configure \ -image ::ICONS::16::1downarrow \ -text [mc "Enlarge"] for {set i 0; set j 3} {$i < 3} {incr i; incr j} { lset val_to_set $i [$entry_d($j) get] } } # Show or hide appropriate GUI elements foreach w [list \ entry_h entry_d entry_b \ entry_o entry_t entry_c1\ entry_c0 entry_a \ ] c { 1 2 3 4 1 2 3 4 } { for {set i 3; set r 5} {$i < 6} {incr i; incr r} { if {$large} { grid [subst -nocommands "\$${w}($i)"] -column $c -row $r } else { grid forget [subst -nocommands "\$${w}($i)"] } } } } ## Switch between modes "More" and "Less" # @return void public method less_more {} { # Invert the mode flag set less_more [expr {!$less_more}] # Adjust GUI if {$less_more} { create_right_frame pack $right_top_frame -side left -anchor nw $less_more_button configure \ -compound left -text [mc "Less"] \ -image ::ICONS::16::1leftarrow $win_obj geometry $EXTENDED_WIDTH {} {} {} for {set i 0} {$i < $right_rows_created} {incr i} { validate {t} $i [$entry_d($i) get] } } else { pack forget $right_top_frame $less_more_button configure \ -compound right -text [mc "More"] \ -image ::ICONS::16::1rightarrow $win_obj geometry $INITIAL_WIDTH {} {} {} } } ## Entybox event handler for and # Change entryboxes background colors # @parm Char type - Entrybox type # h - Hexadecimal # d - Decimal # b - Binary # o - Octal # c0 - BCD - Low order nibble # c1 - BCD - High order nibble # a - ASCII # @parm Int row - Row number (0..5) # @parm Bool focused - 1 == ; 0 == # @return void public method entry_focus {type row focused} { if {$focused} { set style BaseConverter_Focused_I.TEntry set bg {#DDDDFF} } else { set style BaseConverter_NotFocused.TEntry set bg {#FFFFFF} } foreach w [list \ $entry_h($row) $entry_d($row) \ $entry_b($row) $entry_o($row) \ ] \ { $w configure -style $style } if {$right_rows_created > $row} { foreach w [list \ $entry_c1($row) \ $entry_c0($row) \ $entry_a($row) \ ] \ { $w configure -style $style } $entry_t($row) configure -bg $bg } if {$focused} { [subst -nocommands "\$entry_${type}($row)"] configure -style BaseConverter_Focused_D.TEntry } else { [subst -nocommands "\$entry_${type}($row)"] selection clear } } ## Entybox event handler for , , , , , #+ , and # @parm Char type - Entrybox type # h - Hexadecimal # d - Decimal # b - Binary # o - Octal # c0 - BCD - Low order nibble # c1 - BCD - High order nibble # a - ASCII # @parm Int y - Row number (0..5) # @parm Char key - Key pressed # u - Up # d - Down # l - Left # r - Right # t - Tab # s - Shift-Tab # e - Enter # @return void public method entry_key {type y key} { set entrybox [subst -nocommands "\$entry_${type}($y)"] set insert [$entrybox index insert] set max_y $left_rows_created incr max_y -1 switch -- $type { {h} {set x 0} {d} {set x 1} {b} {set x 2} {o} {set x 3} {c1} {set x 4} {c0} {set x 5} {a} {set x 6} } $entrybox selection clear switch -- $key { {u} { ;# Up if {!$y} { return } incr y -1 } {d} { ;# Down if {$y == $max_y} { return } incr y } {l} { ;# Left if {!$x || $insert} { $entrybox icursor [expr {$insert-1}] return } incr x -1 } {r} { ;# Right if {($x == 6) || ($insert != [$entrybox index end])} { $entrybox icursor [expr {$insert+1}] return } incr x } {t} { ;# Tab if {$x == 6} { return } incr x } {s} { ;# Shift-Tab if {!$x} { return } incr x -1 } {e} { ;# Enter if {$y == $max_y} { return } incr y } } if {$x > 3 && $y >= $right_rows_created} { return } set insert [expr {[$entrybox index end] - $insert}] switch -- $x { {0} {set type h} {1} {set type d} {2} {set type b} {3} {set type o} {4} {set type c1} {5} {set type c0} {6} {set type a} } set entrybox [subst -nocommands "\$entry_${type}($y)"] $entrybox selection range 0 end $entrybox icursor [expr {[$entrybox index end] - $insert}] focus $entrybox } } # >>> File inclusion guard } # <<< File inclusion guard