summaryrefslogtreecommitdiff
path: root/lib/utilities
diff options
context:
space:
mode:
authorAndrej Shadura <andrewsh@debian.org>2018-05-08 15:59:29 +0200
committerAndrej Shadura <andrewsh@debian.org>2018-05-08 15:59:29 +0200
commit5b8466f7fae0e071c0f4eda13051c93313910028 (patch)
tree7061957f770e5e245ba00666dad912a2d44e7fdc /lib/utilities
Import Upstream version 1.3.7
Diffstat (limited to 'lib/utilities')
-rwxr-xr-xlib/utilities/asciichart.tcl752
-rwxr-xr-xlib/utilities/baseconvertor.tcl912
-rwxr-xr-xlib/utilities/eightsegment.tcl509
-rwxr-xr-xlib/utilities/hexeditdlg.tcl1793
-rwxr-xr-xlib/utilities/notes.tcl896
-rwxr-xr-xlib/utilities/rs232debugger.tcl1460
-rwxr-xr-xlib/utilities/speccalc.tcl2390
-rwxr-xr-xlib/utilities/symbol_viewer.tcl837
8 files changed, 9549 insertions, 0 deletions
diff --git a/lib/utilities/asciichart.tcl b/lib/utilities/asciichart.tcl
new file mode 100755
index 0000000..01ac86e
--- /dev/null
+++ b/lib/utilities/asciichart.tcl
@@ -0,0 +1,752 @@
+#!/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
+# Interactive ASCII chart
+# --------------------------------------------------------------------------
+
+class AsciiChart {
+ common count 0 ;# Int: Counter of object instances
+ common ASCII_TABLE ;# Array of List: ASCII table
+ array set ASCII_TABLE {
+ 0 {NUL ^@ \\0 {Null character}}
+ 1 {SOH ^A {} {Start of Header}}
+ 2 {STX ^B {} {Start of Text}}
+ 3 {ETX ^C {} {End of Text}}
+ 4 {EOT ^D {} {End of Transmission}}
+ 5 {ENQ ^E {} {Enquiry}}
+ 6 {ACK ^F {} {Acknowledgment}}
+ 7 {BEL ^G \\a {Bell}}
+ 8 {BS ^H \\b {Backspace}}
+ 9 {HT ^I \\t {Horizontal Tab}}
+ 10 {LF ^J \\n {Line feed}}
+ 11 {VT ^K \\v {Vertical Tab}}
+ 12 {FF ^L \\f {Form feed}}
+ 13 {CR ^M \\r {Carriage return}}
+ 14 {SO ^N {} {Shift Out}}
+ 15 {SI ^O {} {Shift In}}
+ 16 {DLE ^P {} {Data Link Escape}}
+ 17 {DC1 ^Q {} {Device Control 1 (oft. XON)}}
+ 18 {DC2 ^R {} {Device Control 2}}
+ 19 {DC3 ^S {} {Device Control 3 (oft. XOFF)}}
+ 20 {DC4 ^T {} {Device Control 4}}
+ 21 {NAK ^U {} {Negative Acknowledgement}}
+ 22 {SYN ^V {} {Synchronous Idle}}
+ 23 {ETB ^W {} {End of Trans. Block}}
+ 24 {CAN ^X {} {Cancel}}
+ 25 {EM ^Y {} {End of Medium}}
+ 26 {SUB ^Z {} {Substitute}}
+ 27 {ESC ^[ \\e {Escape}}
+ 28 {FS ^\\ {} {File Separator}}
+ 29 {GS ^] {} {Group Separator}}
+ 30 {RS ^^ {} {Record Separator}}
+ 31 {US ^_ {} {Unit Separator}}
+ 127 {DEL ^? {} {Delete}}
+
+ 32 {{ }} 33 ! 34 \\\" 35 #
+ 36 $ 37 % 38 & 39 '
+ 40 ( 41 ) 42 * 43 +
+ 44 , 45 - 46 . 47 /
+ 48 0 49 1 50 2 51 3
+ 52 4 53 5 54 6 55 7
+ 56 8 57 9 58 : 59 ;
+ 60 < 61 = 62 > 63 ?
+ 64 @ 65 A 66 B 67 C
+ 68 D 69 E 70 F 71 G
+ 72 H 73 I 74 J 75 K
+ 76 L 77 M 78 N 79 O
+ 80 P 81 Q 82 R 83 S
+ 84 T 85 U 86 V 87 W
+ 88 X 89 Y 90 Z 91 [
+ 92 \\ 93 ] 94 ^ 95 _
+ 96 ` 97 a 98 b 99 c
+ 100 d 101 e 102 f 103 g
+ 104 h 105 i 106 j 107 k
+ 108 l 109 m 110 n 111 o
+ 112 p 113 q 114 r 115 s
+ 116 t 117 u 118 v 119 w
+ 120 x 121 y 122 z 123 \\\{
+ 124 | 125 \\\} 126 ~
+ }
+
+ private variable obj_idx ;# Int: Object index (for entrybox textvariables)
+ private variable selected_cell -1 ;# Int: Currently selected cell
+ private variable validation_ena 1 ;# Bool: EntryBox validation enabled
+ private variable win ;# Widget: Dialog window
+ private variable window_visible 0 ;# Bool: Visibility flag
+ private variable cells ;# Array of Widget: Chart cell frames
+ private variable vh_cells ;# Array of Widget: Vertical headers
+ private variable hh_cells ;# Array of Widget: Horizontal headers
+
+ private variable status_bar_lbl ;# Widget: Status bar
+ private variable char_ent ;# Widget: Entrybox "Character:"
+ private variable hex_addr_ent ;# Widget: Entrybox "Hexadecimal address:"
+ private variable dec_addr_ent ;# Widget: Entrybox "Decimal address:"
+ private variable oct_addr_ent ;# Widget: Entrybox "Octal address:"
+ private variable bin_addr_ent ;# Widget: Entrybox "Binary address:"
+ private variable caret_not_ent ;# Widget: Entrybox "Caret notation:"
+ private variable escape_seq_ent ;# Widget: Entrybox "C escape sequence:"
+
+ constructor {} {
+ # Configure local ttk styles
+ ttk::style configure AsciiChart_BlueFg.TEntry -foreground {#0000DD}
+ ttk::style configure AsciiChart_RedFg.TEntry -foreground {#DD0000}
+
+ # Create dialog window
+ set window_visible 1
+ set win [toplevel .asciichart$count -class {ASCII chart} -bg {#EEEEEE}]
+ set obj_idx $count
+ incr count
+
+ # Create dialog GUI
+ create_gui
+
+ # Set window event bindings
+ bind $win <Control-Key-q> "::itcl::delete object $this; break"
+ bindtags $win [list $win Toplevel all .]
+
+ # Set window parameters
+ wm iconphoto $win ::ICONS::16::math_matrix
+ wm title $win "ASCII chart - MCU 8051 IDE"
+ wm resizable $win 0 0
+ wm protocol $win WM_DELETE_WINDOW "$this close_window"
+ }
+
+ destructor {
+ destroy $win
+ }
+
+ ## Determinate wheather the window is visble or not
+ # @return Bool - Visibility flag
+ public method is_visible {} {
+ return $window_visible
+ }
+
+ ## Close dialog window, but keep object
+ # @return void
+ public method close_window {} {
+ set window_visible 0
+ wm withdraw $win
+ }
+
+ ## Restore dialog window
+ # @return void
+ public method restore_window {} {
+ set window_visible 1
+ wm deiconify $win
+ raise $win .
+ }
+
+ ## Raise dialog window (insure than it is visible)
+ # @return void
+ public method raise_window {} {
+ if {!$window_visible} {return}
+ raise $win .
+ }
+
+ ## Create window GUI
+ # @return void
+ private method create_gui {} {
+ # Create bottom frame
+ set bottom_frame [frame $win.bottom_frame]
+ set status_bar_lbl [label $bottom_frame.status_bar_lbl -justify left -anchor w]
+ pack $status_bar_lbl -side left -fill x -in $bottom_frame
+ pack [ttk::button $bottom_frame.close_but \
+ -text "Exit" \
+ -command "$this close_window" \
+ -compound left \
+ -image ::ICONS::16::exit \
+ ] -side right -padx 5 -pady 5
+
+ ## Create main frame
+ set main_frame [frame $win.main_frame -bg {#DDDDDD}]
+ # Create vertical header
+ grid [frame $main_frame.top_right_lbl -bg {#EEEEEE}] -sticky wens -row 0 -column 0
+ set header [list {} \
+ {0x0_} {0x1_} {0x2_} {0x3_} \
+ {0x4_} {0x5_} {0x6_} {0x7_} \
+ ]
+ for {set y 1} {$y < 9} {incr y} {
+ grid [label $main_frame.vh_lbl$y -text [lindex $header $y] -bg {#FFFFFF}] \
+ -row $y -column 0 -pady [expr {$y % 2}] -sticky ns
+ set vh_cells([expr {$y - 1}]) $main_frame.vh_lbl$y
+ }
+ # Create horizontal header
+ set header [list {} \
+ {0x_0} {0x_1} {0x_2} {0x_3} \
+ {0x_4} {0x_5} {0x_6} {0x_7} \
+ {0x_8} {0x_9} {0x_A} {0x_B} \
+ {0x_C} {0x_D} {0x_E} {0x_F} \
+ ]
+ for {set x 1} {$x < 17} {incr x} {
+ grid [label $main_frame.hh_lbl$x -text [lindex $header $x] -bg {#FFFFFF}] \
+ -row 0 -column $x -padx [expr {$x % 2}] -sticky we
+ set hh_cells([expr {$x - 1}]) $main_frame.hh_lbl$x
+ }
+ # Create ASCII chart matrix
+ set hex_addr 0
+ set address 0
+ for {set y 1} {$y < 9} {incr y} {
+ for {set x 1} {$x < 17} {incr x} {
+ # Create cell frame
+ set frame [frame $main_frame.cell_$address \
+ -bg white -bd 0 \
+ ]
+
+ # Determinate hexadecimal address
+ set hex_addr [format %X $address]
+ if {$address < 16} {
+ set hex_addr "0$hex_addr"
+ }
+ set hex_addr "0x$hex_addr"
+
+ # Determinate character in the chart and color for it
+ set val [lindex $ASCII_TABLE($address) 0]
+ if {[string length $val] > 1} {
+ set foreground {#DD0000}
+ } {
+ set foreground {#0000DD}
+ }
+
+ # Create label containing character name
+ pack [label $frame.char_lbl -pady 0 \
+ -fg $foreground -bg white -text $val \
+ ]
+ # Create label containing character address
+ pack [label $frame.val_lbl \
+ -fg {#00DD00} -text $hex_addr \
+ -bg white -pady 0 \
+ ]
+
+ grid $frame -row $y -column $x -padx [expr {$x % 2}] -pady [expr {$y % 2}] -sticky we
+ set cells($address) $frame
+ foreach wdg [list $frame $frame.val_lbl $frame.char_lbl] {
+ bind $wdg <Enter> "$this cell_enter $address"
+ bind $wdg <Leave> "$this cell_leave $address"
+ bind $wdg <Button-1> "$this cell_click $address"
+ }
+ incr address
+ }
+ }
+ # Show ASCII chart
+ pack $main_frame -pady 5 -side top
+
+ ## Create details frame (character details)
+ # Create labelframe
+ set details_frame_header_frm [frame $win.details_frame_header_frm]
+ pack [label $details_frame_header_frm.lbl -text "Character: "] -side left
+ set char_ent [ttk::entry $details_frame_header_frm.ent \
+ -validatecommand "$this char_ent_validator %P" \
+ -width 4 \
+ -validate key \
+ ]
+ pack $char_ent -side left
+ set details_frame [ttk::labelframe $win.details_frame \
+ -labelwidget $details_frame_header_frm \
+ -padding 10 \
+ ]
+ # Entryboxes: HEX and DEC
+ grid [label $details_frame.hex_addr_lbl \
+ -text [mc "Hex address"] \
+ ] -row 0 -column 0 -sticky w
+ grid [label $details_frame.dec_addr_lbl \
+ -text [mc "Dec address"] \
+ ] -row 1 -column 0 -sticky w
+ set hex_addr_ent [ttk::entry $details_frame.hex_addr_ent \
+ -validatecommand "$this addr_ent_validator H %P" \
+ -validate key \
+ -width 3 \
+ ]
+ set dec_addr_ent [ttk::entry $details_frame.dec_addr_ent \
+ -validatecommand "$this addr_ent_validator D %P" \
+ -validate key \
+ -width 3 \
+ ]
+ grid $hex_addr_ent -row 0 -column 2 -sticky w
+ grid $dec_addr_ent -row 1 -column 2 -sticky w
+ # Entryboxes: OCT and BIN
+ grid [label $details_frame.oct_addr_lbl \
+ -text [mc "Oct address"] \
+ ] -row 0 -column 4 -sticky w
+ grid [label $details_frame.bin_addr_lbl \
+ -text [mc "Bin address"] \
+ ] -row 1 -column 4 -sticky w
+ set oct_addr_ent [ttk::entry $details_frame.oct_addr_ent \
+ -validate key \
+ -width 3 \
+ -validatecommand "$this addr_ent_validator O %P" \
+ ]
+ set bin_addr_ent [ttk::entry $details_frame.bin_addr_ent \
+ -validate key \
+ -width 8 \
+ -validatecommand "$this addr_ent_validator B %P" \
+ ]
+ grid $oct_addr_ent -row 0 -column 6 -sticky w
+ grid $bin_addr_ent -row 1 -column 6 -sticky w
+ # Entryboxes: "Caret notation" and "C Escape Code"
+ grid [label $details_frame.caret_not_lbl \
+ -text [mc "Caret notation"] \
+ ] -row 0 -column 8 -sticky w
+ grid [label $details_frame.escape_seq_lbl \
+ -text [mc "C Escape Code"] \
+ ] -row 1 -column 8 -sticky w
+ set caret_not_ent [ttk::entry $details_frame.caret_not_ent \
+ -validate key \
+ -width 3 \
+ -validatecommand "$this more_detail_ent_validator C %P" \
+ ]
+ set escape_seq_ent [ttk::entry $details_frame.escape_seq_ent \
+ -validate key \
+ -width 3 \
+ -validatecommand "$this more_detail_ent_validator E %P" \
+ ]
+ grid $caret_not_ent -row 0 -column 10 -sticky w
+ grid $escape_seq_ent -row 1 -column 10 -sticky w
+ # Create copy buttons (copy entrybox contents to clipboard)
+ foreach type {H D O B C E} \
+ row {0 1 0 1 0 1} \
+ col {1 1 5 5 9 9} \
+ {
+ grid [ttk::button $details_frame.copy_${type}_but \
+ -command "$this copy_contents ${type}" \
+ -image ::ICONS::16::editcopy \
+ -style Flat.TButton \
+ ] -row $row -column $col -sticky w -padx 3
+ DynamicHelp::add $details_frame.copy_${type}_but \
+ -text [mc "%s - Copy contents of entrybox to clipboard" $type]
+ bind $details_frame.copy_${type}_but <Enter> \
+ "$status_bar_lbl configure -text {[mc {Copy to clipboard}]}"
+ bind $details_frame.copy_${type}_but <Leave> \
+ "$status_bar_lbl configure -text {}"
+ }
+ # Configure event bindings for entryboxes
+ foreach widget [list \
+ $char_ent $hex_addr_ent $dec_addr_ent $oct_addr_ent \
+ $bin_addr_ent $caret_not_ent $escape_seq_ent \
+ ] {
+ bindtags $widget [list $widget TEntry $win all .]
+ }
+ # Configure details frame
+ grid columnconfigure $details_frame 3 -minsize 20
+ grid columnconfigure $details_frame 7 -minsize 20
+ grid columnconfigure $details_frame 11 -weight 1
+
+ # Finalize ...
+ pack $details_frame -padx 5 -anchor w -fill x
+ pack $bottom_frame -fill x
+ focus -force $char_ent
+ }
+
+ ## Set background color for certain cell in ASCII chart matrix
+ # @parm Int address - Cell address
+ # @parm Color color - New background color
+ # @return void
+ private method sel_bg_color {address color} {
+ $cells($address) configure -bg $color
+ $cells($address).char_lbl configure -bg $color
+ $cells($address).val_lbl configure -bg $color
+
+ $hh_cells([expr {$address & 0x0F}]) configure -bg $color
+ $vh_cells([expr {($address & 0xF0) >> 4}]) configure -bg $color
+ }
+
+ ## Handles event when mouse pointer enters certain cell in the ASCII chart
+ # @parm Int address - Cell address
+ # @return void
+ public method cell_enter {address} {
+ $status_bar_lbl configure -text [lindex $ASCII_TABLE($address) 3]
+ if {$selected_cell == $address} {
+ return
+ }
+ sel_bg_color $address {#DDFFDD}
+ }
+
+ ## Handles event when mouse pointer leaves certain cell in the ASCII chart
+ # @parm Int address - Cell address
+ # @return void
+ public method cell_leave {address} {
+ if {$selected_cell == $address} {
+ return
+ }
+ sel_bg_color $address {#FFFFFF}
+ $status_bar_lbl configure -text {}
+
+ if {$selected_cell != -1} {
+ $hh_cells([expr {$selected_cell & 0x0F}]) configure -bg {#BBBBFF}
+ $vh_cells([expr {($selected_cell & 0xF0) >> 4}]) configure -bg {#BBBBFF}
+ }
+ }
+
+ ## Handles event when clicks on certain cell in the ASCII chart
+ # @parm Int address - Cell address
+ # @return void
+ public method cell_click {address} {
+ if {$selected_cell == $address} {
+ unselect_current_cell 1 1
+ set selected_cell -1
+ return
+ }
+ select_cell $address
+ if {$selected_cell != -1} {
+ fill_entryboxes $address {}
+ }
+ }
+
+ ## Copy contents of certain entrybox to clipboard
+ # @parm Char type - Entrybox ID
+ # H - Hexadecimal address
+ # D - Decimal address
+ # O - Octal address
+ # B - Binary address
+ # C - Caret notation
+ # E - C escape sequence
+ # @return void
+ public method copy_contents {type} {
+ switch -- $type {
+ {H} {set widget $hex_addr_ent}
+ {D} {set widget $dec_addr_ent}
+ {O} {set widget $oct_addr_ent}
+ {B} {set widget $bin_addr_ent}
+ {C} {set widget $caret_not_ent}
+ {E} {set widget $escape_seq_ent}
+ }
+
+ clipboard clear
+ clipboard append [$widget get]
+ }
+
+ ## Select specified cell in ASCII chart (mark as selected and adjust details frame)
+ # @parm Int address - Cell address
+ # @return void
+ private method select_cell {address} {
+ if {$selected_cell != -1} {
+ unselect_current_cell 0 0
+ }
+ set selected_cell $address
+ sel_bg_color $address {#BBBBFF}
+ }
+
+ ## Unselect specified cell in ASCII chart (mark as normal and clear details frame)
+ # @parm Bool keep_current - Mark cell as a cell under mouse pointer (light green bg. color)
+ # @parm Bool affect_entryboxes - Clear entryboxes in details frame
+ # @return void
+ private method unselect_current_cell {keep_current affect_entryboxes} {
+ if {$selected_cell == -1} {
+ return
+ }
+
+ # Set new background color
+ if {$keep_current} {
+ sel_bg_color $selected_cell {#DDFFDD}
+ } {
+ sel_bg_color $selected_cell {#FFFFFF}
+ }
+
+ # Clear entryboxes in details frame
+ if {$affect_entryboxes} {
+ set validation_ena 0
+ foreach widget [list \
+ $char_ent $hex_addr_ent $dec_addr_ent $oct_addr_ent \
+ $bin_addr_ent $caret_not_ent $escape_seq_ent \
+ ] {
+ $widget delete 0 end
+ $widget configure -style TEntry
+ }
+ $char_ent configure -style TEntry
+ set validation_ena 1
+ }
+ }
+
+ ## Clear entryboxes in details frame
+ # @parm Char type - Entrybox to exclude
+ # M - Character
+ # H - Hexadecimal address
+ # D - Decimal address
+ # O - Octal address
+ # B - Binary address
+ # C - Caret notation
+ # E - C escape sequence
+ # @return void
+ private method clear_entryboxes {type} {
+ set validation_ena 0
+ foreach entry_type {M H D O B C E} \
+ entry_widget [list \
+ $char_ent $hex_addr_ent $dec_addr_ent $oct_addr_ent \
+ $bin_addr_ent $caret_not_ent $escape_seq_ent \
+ ] \
+ {
+ if {$type == $entry_type} {
+ continue
+ }
+ $entry_widget delete 0 end
+ $entry_widget configure -style TEntry
+ }
+ set validation_ena 1
+ }
+
+ ## Show details for character in specified address
+ # @parm Int address - Cell address
+ # @parm Char type - Entrybox to exclude
+ # M - Character
+ # H - Hexadecimal address
+ # D - Decimal address
+ # O - Octal address
+ # B - Binary address
+ # C - Caret notation
+ # E - C escape sequence
+ # @return void
+ private method fill_entryboxes {address type} {
+ clear_entryboxes $type
+ set validation_ena 0
+
+ # Character
+ if {$type != {M}} {
+ set value [lindex $ASCII_TABLE($address) 0]
+ $char_ent insert insert $value
+ if {[string length $value] > 1} {
+ $char_ent configure -style AsciiChart_RedFg.TEntry
+ } {
+ $char_ent configure -style AsciiChart_BlueFg.TEntry
+ }
+ }
+ # Hexadecimal address
+ if {$type != {H}} {
+ set value [format %X $address]
+ if {$address < 16} {
+ set value "0$value"
+ }
+ $hex_addr_ent insert insert $value
+ }
+ # Decimal address
+ if {$type != {D}} {
+ $dec_addr_ent insert insert $address
+ }
+ # Octal address
+ if {$type != {O}} {
+ $oct_addr_ent insert insert [::NumSystem::dec2oct $address]
+ }
+ # Binary address
+ if {$type != {B}} {
+ set value [::NumSystem::dec2bin $address]
+ set len [string length $value]
+ if {$len < 8} {
+ set value "[string repeat 0 [expr {8 - $len}]]$value"
+ }
+ $bin_addr_ent insert insert $value
+ }
+ # Caret notation
+ if {$type != {C}} {
+ $caret_not_ent insert insert [lindex $ASCII_TABLE($address) 1]
+ }
+ # C escape sequence
+ if {$type != {E}} {
+ $escape_seq_ent insert insert [lindex $ASCII_TABLE($address) 2]
+ }
+
+ set validation_ena 1
+ }
+
+ ## Validator for entrybox "Character"
+ # @parm String string - New entrybox contents
+ # @return Bool - Allways 1
+ public method char_ent_validator {string} {
+ if {!$validation_ena} {return 1}
+ set validation_ena 0
+
+ ## Validate input string
+ set length [string length $string]
+ if {!$length} {
+ $char_ent configure -style TEntry
+ clear_entryboxes M
+ unselect_current_cell 0 0
+ set validation_ena 1
+ return 1
+ }
+ if {$length > 3} {
+ set validation_ena 1
+ return 0
+ }
+
+ # Search for the given character in the ASCII chart
+ if {$length > 1} {
+ set string [string toupper $string]
+ }
+ for {set i 0} {$i < 128} {incr i} {
+ if {![string compare [lindex $ASCII_TABLE($i) 0] $string]} {
+ select_cell $i
+ fill_entryboxes $i M
+
+ if {$length > 1} {
+ $char_ent configure -style AsciiChart_RedFg.TEntry
+ } {
+ $char_ent configure -style AsciiChart_BlueFg.TEntry
+ }
+
+ set validation_ena 1
+ return 1
+ }
+ }
+
+ # Character not found
+ clear_entryboxes M
+ unselect_current_cell 0 0
+ $char_ent configure -style StringNotFound.TEntry
+ set validation_ena 1
+ return 1
+ }
+
+ ## Validator for entryboxes "Hex","Dec","Oct" and "Bin"
+ # @parm Char type - Source entry box
+ # H - Hexadecimal address
+ # D - Decimal address
+ # O - Octal address
+ # B - Binary address
+ # @parm String string - New entrybox contents
+ # @return Bool - Allways 1
+ public method addr_ent_validator {type string} {
+ if {!$validation_ena} {return 1}
+ set validation_ena 0
+
+ switch -- $type {
+ H {set widget $hex_addr_ent}
+ D {set widget $dec_addr_ent}
+ O {set widget $oct_addr_ent}
+ B {set widget $bin_addr_ent}
+ }
+
+ # Empty input string
+ set length [string length $string]
+ if {!$length} {
+ $widget configure -bg {#FFFFFF}
+ clear_entryboxes $type
+ unselect_current_cell 0 0
+ set validation_ena 1
+ return 1
+ }
+
+ # Validate input string and convert it into integer
+ switch -- $type {
+ H { ;# Hexadecimal
+ if {$length > 2 || ![string is xdigit -strict $string]} {
+ set validation_ena 1
+ return 0
+ }
+ set string [expr "0x$string"]
+ }
+ D { ;# Decimal
+ if {$length > 3 || ![string is digit -strict $string]} {
+ set validation_ena 1
+ return 0
+ }
+ }
+ O { ;# Octal
+ if {$length > 3 || ![regexp {^[0-7]+$} $string]} {
+ set validation_ena 1
+ return 0
+ }
+ set string [expr "0$string"]
+ }
+ B { ;# Binary
+ if {$length > 8 || ![regexp {^[01]+$} $string]} {
+ set validation_ena 1
+ return 0
+ }
+ set string [::NumSystem::bin2dec $string]
+ }
+ }
+ set string [string trimleft $string 0]
+ if {$string == {}} {
+ set string 0
+ }
+
+ # Check value range
+ if {$string > 127 || $string < 0} {
+ clear_entryboxes $type
+ unselect_current_cell 0 0
+ $widget configure -bg {#FFDDDD}
+ set validation_ena 1
+ return 1
+ }
+
+ # Adjust GUI (ACII chart and details frame)
+ select_cell $string
+ fill_entryboxes $string $type
+ $widget configure -bg {#DDFFDD}
+ return 1
+ }
+
+ ## Validator for entryboxes "Caret notation" and "C escape sequence"
+ # @parm Char type - Source entry box
+ # C - Caret notation
+ # E - C escape sequence
+ # @parm String string - New entrybox contents
+ # @return Bool - Allways 1
+ public method more_detail_ent_validator {type string} {
+ if {!$validation_ena} {return 1}
+ set validation_ena 0
+
+ # Dterminate widget object and index in ASCII chart array
+ if {$type == {C}} {
+ set widget $caret_not_ent
+ set index 1
+ } {
+ set widget $escape_seq_ent
+ set index 2
+ }
+
+ # Empty input string
+ if {![string length $string]} {
+ $widget configure -bg {#FFFFFF}
+ clear_entryboxes $type
+ unselect_current_cell 0 0
+ set validation_ena 1
+ return 1
+ }
+
+ # Inputs string must not be longer than 2 characters
+ if {[string length $string] > 2} {
+ set validation_ena 1
+ return 0
+ }
+
+ # Search for the given string in the ASCII chart array
+ for {set i 0} {$i < 128} {incr i} {
+ if {![string compare [lindex $ASCII_TABLE($i) $index] $string]} {
+ select_cell $i
+ fill_entryboxes $i $type
+
+ $widget configure -bg {#DDFFDD}
+ set validation_ena 1
+ return 1
+ }
+ }
+
+ # String not found
+ clear_entryboxes $type
+ unselect_current_cell 0 0
+ $widget configure -bg {#FFDDDD}
+ set validation_ena 1
+ return 1
+ }
+}
diff --git a/lib/utilities/baseconvertor.tcl b/lib/utilities/baseconvertor.tcl
new file mode 100755
index 0000000..ded53cb
--- /dev/null
+++ b/lib/utilities/baseconvertor.tcl
@@ -0,0 +1,912 @@
+#!/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
+# Utility "Base Convertor"
+# --------------------------------------------------------------------------
+
+class BaseConvertor {
+ ## COMMON
+ common count 0 ;# Int: Counter of class instances
+
+ ## 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 {!$count} {
+ ttk::style configure BaseConvertor_Focused_D.TEntry -fieldbackground {#AAAAFF}
+ ttk::style configure BaseConvertor_Focused_I.TEntry -fieldbackground {#DDDDFF}
+ }
+
+ incr 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]
+ } {
+ 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 \
+ .baseconvertor_${count} \
+ [list 160 130 100 100] \
+ [mc "Convertor"] \
+ ::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 \
+ ]
+ pack $enlarge_shrink_button -side left
+ # 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 \
+ ]
+ pack $less_more_button -side right
+
+ # 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_convertor_close"
+ # @return void
+ public method close_window {} {
+ ::X::__base_convertor_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
+ } {
+ set zero_length 1
+ set content 0
+ }
+
+ # Validate input string
+ switch -- $type {
+ {h} { ;# Hexadecimal
+ if {![regexp {^[[:xdigit:]]{0,2}$} $content]} {
+ set result 0
+ } {
+ scan $content "%x" value
+ }
+ }
+ {d} { ;# Decimal
+ if {![regexp {^[[:digit:]]{0,3}$} $content]} {
+ set result 0
+ } elseif {$content > 255} {
+ set result 0
+ } {
+ set value $content
+ }
+ }
+ {b} { ;# Binary
+ if {![regexp {^[01]{0,8}$} $content]} {
+ set result 0
+ } {
+ set value [NumSystem::bin2dec $content]
+ }
+ }
+ {o} { ;# Octal
+ if {![regexp {^[0-7]{0,3}$} $content]} {
+ set result 0
+ } elseif {$content > 377} {
+ set result 0
+ } {
+ scan $content "%o" value
+ }
+ }
+ {c0} { ;# BCD - Low order nibble
+ if {![regexp {^[[:digit:]]{0,2}$} $content]} {
+ set result 0
+ } elseif {$content > 15} {
+ set result 0
+ } {
+ 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
+ } {
+ 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
+ } {
+ 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}
+ } {
+ 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 <Enter> 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 hand1
+ }
+
+ ## Handles event <leave> 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 <Button-1> 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 <Key-Up> "$this entry_key $t $r u; break"
+ bind $w <Key-Down> "$this entry_key $t $r d; break"
+ bind $w <Key-Left> "$this entry_key $t $r l; break"
+ bind $w <Key-Right> "$this entry_key $t $r r; break"
+ bind $w <Key-Tab> "$this entry_key $t $r t; break"
+ if {!$::MICROSOFT_WINDOWS} {
+ bind $w <Key-ISO_Left_Tab> "$this entry_key $t $r s; break"
+ }
+ bind $w <Key-Return> "$this entry_key $t $r e; break"
+ bind $w <Key-KP_Enter> "$this entry_key $t $r e; break"
+
+ bind $w <FocusIn> "$this entry_focus $t $r 1"
+ bind $w <FocusOut> "$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" \
+ ]
+ 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" \
+ ]
+ 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" \
+ ]
+ 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" \
+ ]
+ 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) <Enter> "$this bit_enter $row $b"
+ $canvas bind $bit($row,$b) <Leave> "$this bit_leave $row $b"
+ $canvas bind $bit($row,$b) <Button-1> "$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 + 130}] {} {}
+ $enlarge_shrink_button configure \
+ -image ::ICONS::16::1uparrow \
+ -text [mc "Shrink"]
+ } {
+ $win_obj geometry {} 130 {} {}
+ $enlarge_shrink_button configure \
+ -image ::ICONS::16::1downarrow \
+ -text [mc "Enlarge"]
+ }
+
+ # 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 "\$${w}($i)"] -column $c -row $r
+ } {
+ grid forget [subst "\$${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 350 {} {} {}
+
+ for {set i 0} {$i < $right_rows_created} {incr i} {
+ validate {t} $i [$entry_d($i) get]
+ }
+ } {
+ pack forget $right_top_frame
+ $less_more_button configure \
+ -compound right -text [mc "More"] \
+ -image ::ICONS::16::1rightarrow
+ $win_obj geometry 160 {} {} {}
+ }
+ }
+
+ ## Entybox event handler for <FocusIn> and <FocusOut>
+ # 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 == <FocusIn>; 0 == <FocusOut>
+ # @return void
+ public method entry_focus {type row focused} {
+ if {$focused} {
+ set style BaseConvertor_Focused_I.TEntry
+ set bg {#DDDDFF}
+ } {
+ set style 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 "\$entry_${type}($row)"] configure -style BaseConvertor_Focused_D.TEntry
+ } {
+ [subst "\$entry_${type}($row)"] selection clear
+ }
+
+ }
+
+
+ ## Entybox event handler for <Key-Up>, <Key-Down>, <Key-Left>, <Key-Right>, <Key-Tab>,
+ #+ <Key-ISO_Left_Tab>, <Key-Return> and <Key-KP_Enter>
+ # @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 "\$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 "\$entry_${type}($y)"]
+ $entrybox selection range 0 end
+ $entrybox icursor [expr {[$entrybox index end] - $insert}]
+ focus $entrybox
+ }
+}
diff --git a/lib/utilities/eightsegment.tcl b/lib/utilities/eightsegment.tcl
new file mode 100755
index 0000000..de1903b
--- /dev/null
+++ b/lib/utilities/eightsegment.tcl
@@ -0,0 +1,509 @@
+#!/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
+# 8 segment LED display configurator
+# --------------------------------------------------------------------------
+
+class EightSegment {
+ common count 0 ;# Int: Counter of object instances
+
+ private variable obj_idx ;# Int: Current object ID
+ private variable win ;# Widget: Dialog window
+ private variable canvas_widget ;# Widget: Canvas widget for LED display
+ private variable status_bar ;# Widget: Status bar label
+ private variable leds ;# Array of Bool: key == "Segment number" (0..7); value == ON/OFF (0|1)
+ private variable canvas_objects ;# Array: LED segments in canvas widget
+ private variable validation_ena 1 ;# Bool: Entryboxs validation enabled
+
+ private variable cc_hex_entry ;# Widget: Entrybox "Common catode - Hex"
+ private variable cc_dec_entry ;# Widget: Entrybox "Common catode - Dec"
+ private variable cc_bin_entry ;# Widget: Entrybox "Common catode - Bin"
+ private variable ca_hex_entry ;# Widget: Entrybox "Common anode - Hex"
+ private variable ca_dec_entry ;# Widget: Entrybox "Common anode - Dec"
+ private variable ca_bin_entry ;# Widget: Entrybox "Common anode - Bin"
+
+ private variable seg2pin ;# Array of Int: Segment no. -> Pin no.
+ private variable cbx ;# Array of widget: ComboBox widgets for connecting LED's to pins
+
+ constructor {} {
+ # Create dialog window
+ set win [toplevel .eightsegment$count -class {8 segment editor} -bg {#EEEEEE}]
+ set obj_idx $count
+ incr count
+
+ # Restore last session
+ for {set i 0} {$i < 8} {incr i} {
+ set seg2pin($i) $i
+ set leds($i) 0
+ }
+ array set seg2pin [lindex ${::EightSegment::config} 0]
+ array set leds [lindex ${::EightSegment::config} 1]
+ for {set i 0} {$i < 8} {incr i} {
+ set ::EightSegment::con_${obj_idx}_$i $seg2pin($i)
+ }
+
+ create_gui ;# Create GUI elements
+ refresh_canvas ;# Initialize canvas (LED diaplay)
+ reconnect 0 ;# Highight badly connected pins
+ refresh_entryboxes ;# Refresh EntryBoxes with values
+
+ # Set event bindings for the dialog window
+ bindtags $win [list $win Toplevel all .]
+ bind $win <Control-Key-q> "::itcl::delete object $this; break"
+
+ # Set window parameters
+ wm iconphoto $win ::ICONS::16::8seg
+ wm title $win "8 segment editor"
+ wm resizable $win 0 0
+ wm protocol $win WM_DELETE_WINDOW "::itcl::delete object $this"
+ }
+
+ destructor {
+ for {set i 0} {$i < 8} {incr i} {
+ unset ::EightSegment::con_${obj_idx}_$i
+ }
+
+ set ::EightSegment::config [list [array get seg2pin] [array get leds]]
+ destroy $win
+ }
+
+ ## LED <-> PIN connection changed
+ # @parm Int segment - Number of segment LED
+ # @return void
+ public method reconnect {segment} {
+ # Unhighlight all ComboBoxes
+ for {set i 0} {$i < 8} {incr i} {
+ $cbx($i) configure -style TCombobox
+ }
+
+ # Highlight ComboBoxes related to pins which are in confict
+ for {set segment 0} {$segment < 8} {incr segment} {
+ set pin [subst "\$::EightSegment::con_${obj_idx}_$segment"]
+ set seg2pin($segment) $pin
+
+ for {set i 0} {$i < 8} {incr i} {
+ if {$i == $segment} {
+ continue
+ }
+
+ if {$seg2pin($i) == $pin} {
+ $cbx($i) configure -style EightSegment_RedFg.TCombobox
+ }
+ }
+ }
+
+ # Adjust display
+ refresh_canvas
+ }
+
+ ## Create window GUI
+ # @return void
+ private method create_gui {} {
+ # Create frames
+ set main_frame [frame $win.main_frame] ;# Entryboxes (left) and canvas (right)
+ set bottom_frame [frame $win.bottom_frame] ;# Status bar and button "Exit"
+
+ # Create status bar
+ set status_bar [label $bottom_frame.status_bar \
+ -justify left -anchor w \
+ ]
+
+ ttk::style configure EightSegment_RedFg.TCombobox -foreground {#FF0000}
+
+ ## Create entryboxes
+ # - Common catode
+ set left_frame [frame $main_frame.left_frame]
+ grid [label $left_frame.header_CC_lbl -text [mc "Common catode"]] \
+ -row 0 -column 0 -columnspan 4 -sticky w
+ grid [label $left_frame.sub_header_CC_hex_lbl -text [mc "Hex:"]] \
+ -row 1 -column 1 -sticky w
+ grid [label $left_frame.sub_header_CC_dec_lbl -text [mc "Dec:"]] \
+ -row 2 -column 1 -sticky w
+ grid [label $left_frame.sub_header_CC_bin_lbl -text [mc "Bin:"]] \
+ -row 3 -column 1 -sticky w
+ set cc_hex_entry [ttk::entry $left_frame.cc_hex_ent \
+ -width 3 \
+ -validate all \
+ -validatecommand "$this entry_validate C H %P" \
+ ]
+ set cc_dec_entry [ttk::entry $left_frame.cc_dec_ent \
+ -width 3 \
+ -validate all \
+ -validatecommand "$this entry_validate C D %P" \
+ ]
+ set cc_bin_entry [ttk::entry $left_frame.cc_bin_ent \
+ -width 8 \
+ -validate all \
+ -validatecommand "$this entry_validate C B %P" \
+ ]
+ grid $cc_hex_entry -row 1 -column 3 -sticky w
+ grid $cc_dec_entry -row 2 -column 3 -sticky w
+ grid $cc_bin_entry -row 3 -column 3 -sticky w
+ foreach type {H D B} row {1 2 3} {
+ grid [ttk::button $left_frame.copy_C${type}_but \
+ -command "$this copy_contents C ${type}" \
+ -image ::ICONS::16::editcopy \
+ -style Flat.TButton \
+ ] -row $row -column 2 -sticky w -padx 3
+ DynamicHelp::add $left_frame.copy_C${type}_but -text \
+ [mc "Copy contents of the entrybox to clipboard"]
+ set_local_status_tip $left_frame.copy_C${type}_but [mc "Copy to clipboard"]
+ }
+ # - Common anode
+ grid [label $left_frame.header_CA_lbl -text [mc "Common anode"]] \
+ -row 5 -column 0 -columnspan 4 -sticky w
+ grid [label $left_frame.sub_header_CA_hex_lbl -text [mc "Hex:"]] \
+ -row 6 -column 1 -sticky w
+ grid [label $left_frame.sub_header_CA_dec_lbl -text [mc "Dec:"]] \
+ -row 7 -column 1 -sticky w
+ grid [label $left_frame.sub_header_CA_bin_lbl -text [mc "Bin:"]] \
+ -row 8 -column 1 -sticky w
+ set ca_hex_entry [ttk::entry $left_frame.ca_hex_ent \
+ -width 3 \
+ -validate all \
+ -validatecommand "$this entry_validate A H %P" \
+ ]
+ set ca_dec_entry [ttk::entry $left_frame.ca_dec_ent \
+ -width 3 \
+ -validate all \
+ -validatecommand "$this entry_validate A D %P" \
+ ]
+ set ca_bin_entry [ttk::entry $left_frame.ca_bin_ent \
+ -width 8 \
+ -validate all \
+ -validatecommand "$this entry_validate A B %P" \
+ ]
+ grid $ca_hex_entry -row 6 -column 3 -sticky w
+ grid $ca_dec_entry -row 7 -column 3 -sticky w
+ grid $ca_bin_entry -row 8 -column 3 -sticky w
+ foreach type {H D B} row {6 7 8} {
+ grid [ttk::button $left_frame.copy_A${type}_but \
+ -command "$this copy_contents A ${type}" \
+ -image ::ICONS::16::editcopy \
+ -style Flat.TButton \
+ ] -row $row -column 2 -sticky w -padx 3
+ DynamicHelp::add $left_frame.copy_A${type}_but -text \
+ [mc "Copy contents of the entrybox to clipboard"]
+ set_local_status_tip $left_frame.copy_A${type}_but [mc "Copy to clipboard"]
+ }
+ # Set event bindings for entryboxes
+ foreach widget [list \
+ ${cc_hex_entry} ${cc_dec_entry} ${cc_bin_entry} \
+ ${ca_hex_entry} ${ca_dec_entry} ${ca_bin_entry} \
+ ] {
+ bindtags $widget [list $widget TEntry $win all .]
+ }
+ # Configure and pack left top frame
+ grid rowconfigure $left_frame 4 -minsize 10
+ grid columnconfigure $left_frame 0 -minsize 20
+ pack $left_frame -side left -padx 5
+
+ # Create canvas widget - LED display
+ set canvas_widget [canvas $main_frame.canvas \
+ -width 125 -height 180 -bg white \
+ -bd 1 -relief solid \
+ ]
+ set canvas_objects(0) [$canvas_widget create polygon \
+ 36 15 46 5 97 5 107 15 97 25 46 25 \
+ ]
+ set canvas_objects(1) [$canvas_widget create polygon \
+ 110 18 120 28 112 72 100 84 91 75 99 29 \
+ ]
+ set canvas_objects(2) [$canvas_widget create polygon \
+ 100 90 110 100 102 144 90 156 81 147 89 101 \
+ ]
+ set canvas_objects(3) [$canvas_widget create polygon \
+ 87 159 77 169 26 169 16 159 26 149 77 149 \
+ ]
+ set canvas_objects(4) [$canvas_widget create polygon \
+ 13 156 25 144 33 100 23 90 12 101 4 147 \
+ ]
+ set canvas_objects(5) [$canvas_widget create polygon \
+ 23 84 35 72 43 28 33 18 22 29 14 75 \
+ ]
+ set canvas_objects(6) [$canvas_widget create polygon \
+ 26 87 36 97 87 97 97 87 87 77 36 77 \
+ ]
+ set canvas_objects(7) [$canvas_widget create oval 98 155 116 173]
+ for {set i 0} {$i < 8} {incr i} {
+ $canvas_widget itemconfigure $canvas_objects($i) \
+ -outline {#FF0000} -activeoutline {#00FF00}
+ $canvas_widget bind $canvas_objects($i) <Button-1> "$this select_segment $i"
+ }
+ foreach coords {{70 15} {105 50} {95 125} {50 160} {20 125} {30 50} {60 88} {107 164}} \
+ text {A B C D E F G P} \
+ i {0 1 2 3 4 5 6 7} \
+ {
+ set obj [$canvas_widget create text \
+ [lindex $coords 0] [lindex $coords 1] \
+ -text $text -fill {#000000} \
+ ]
+ $canvas_widget bind $obj <Button-1> "$this select_segment $i"
+ }
+ pack $canvas_widget -side left -padx 5
+
+ ## Create right frame (Connections)
+ set right_frame [frame $main_frame.right_frame]
+ # Header - "LED"
+ grid [label $right_frame.header_0_lbl \
+ -text [mc "LED"] \
+ ] -row 0 -column 0
+ # Header - "PIN"
+ grid [label $right_frame.header_1_lbl \
+ -text [mc "PIN"] \
+ ] -row 0 -column 1
+ # Create ComboBoxes and their labels
+ for {set i 0} {$i < 8} {incr i} {
+ grid [label $right_frame.pin_${i}_lbl \
+ -text [lindex {A B C D E F G P} $i] \
+ ] -row [expr {$i + 1}] -column 0
+ set cbx($i) [ttk::combobox $right_frame.cb_p$i \
+ -width 1 \
+ -state readonly \
+ -values {0 1 2 3 4 5 6 7} \
+ -textvariable ::EightSegment::con_${obj_idx}_$i \
+ ]
+ bind $cbx($i) <<ComboboxSelected>> "$this reconnect $i"
+ grid $cbx($i) -row [expr {$i + 1}] -column 1
+ }
+ # Pack the right frame
+ pack $right_frame -side left -padx 5 -anchor nw
+
+ # Create button "Exit"
+ pack [ttk::button $bottom_frame.close_but \
+ -compound left \
+ -text [mc "Close"] \
+ -command "::itcl::delete object $this" \
+ -image ::ICONS::16::exit \
+ ] -side right -pady 5
+ pack $status_bar -side left -fill x
+
+ # Pack window frames
+ pack $main_frame -fill both -expand 1 -pady 5 -side top
+ pack $bottom_frame -fill x -side top
+ }
+
+ ## Set status bar tip in this window only
+ # @parm Widget widget - Widget related to the status tip
+ # @parm String text - Status bar tip text
+ # @return void
+ private method set_local_status_tip {widget text} {
+ bind $widget <Enter> [list $status_bar configure -text $text]
+ bind $widget <Leave> [list $status_bar configure -text {}]
+ }
+
+ ## Copy contents of the specified exntrybox to clipboard
+ # @parm Char common_electrode - C == Catode; A == Anode
+ # @parm Char radix - H == Hexadecimal; D == Decimal; B == Binary
+ # @return void
+ public method copy_contents {common_electrode radix} {
+ # Common catode
+ if {$common_electrode == {C}} {
+ switch -- $radix {
+ {H} {set widget ${cc_hex_entry}}
+ {D} {set widget ${cc_dec_entry}}
+ {B} {set widget ${cc_bin_entry}}
+ }
+ # Common anode
+ } {
+ switch -- $radix {
+ {H} {set widget ${ca_hex_entry}}
+ {D} {set widget ${ca_dec_entry}}
+ {B} {set widget ${ca_bin_entry}}
+ }
+ }
+
+ clipboard clear
+ clipboard append [$widget get]
+ }
+
+ ## Invert LED in specified segment
+ # @parm Int i - Segment number
+ # @return void
+ public method select_segment {i} {
+ set leds($seg2pin($i)) [expr {!$leds($seg2pin($i))}]
+ refresh_canvas
+ refresh_entryboxes
+ }
+
+ ## Value entrybox validator
+ # @parm Char common_electrode - C == Catode; A == Anode
+ # @parm Char radix - H == Hexadecimal; D == Decimal; B == Binary
+ # @parm String value - String to validate
+ # @return Bool - always 1
+ public method entry_validate {common_electrode radix value} {
+ if {![string length $value]} {return 1}
+ if {!$validation_ena} {return 1}
+ set validation_ena 0
+
+ ## Validate extrybox contents
+ switch -- $radix {
+ H {
+ set max_length 2
+ set char_class xdigit
+ }
+ D {
+ set max_length 3
+ set char_class digit
+ }
+ B {
+ set max_length 8
+ set char_class digit
+ if {![regexp {^[01]*$} $value]} {
+ set validation_ena 1
+ return 0
+ }
+ }
+ }
+ if {[string length $value] > $max_length} {
+ set validation_ena 1
+ return 0
+ }
+ if {![string is $char_class -strict $value]} {
+ set validation_ena 1
+ return 0
+ }
+
+ # Convert value to decimal
+ if {$radix == {H}} {
+ set value [expr "0x$value"]
+ } elseif {$radix == {B}} {
+ set value [::NumSystem::bin2dec $value]
+ }
+
+ # Adjust array $led() (LED states)
+ if {$common_electrode == {C}} {
+ set mask 1
+ for {set i 0} {$i < 8} {incr i} {
+ set leds($i) [expr {$value & $mask}]
+ set mask [expr {$mask * 2}]
+ }
+ } {
+ set mask 1
+ for {set i 0} {$i < 8} {incr i} {
+ set leds($i) [expr {!($value & $mask)}]
+ set mask [expr {$mask * 2}]
+ }
+ }
+
+ # Adjust canvas and other entryboxes
+ refresh_entryboxes ${common_electrode}${radix}
+ refresh_canvas
+
+ set validation_ena 1
+ return 1
+ }
+
+ ## Adjust canvas (LED display) to array $led (LED states)
+ # @return void
+ private method refresh_canvas {} {
+ for {set i 0} {$i < 8} {incr i} {
+ if {$leds($seg2pin($i))} {
+ $canvas_widget itemconfigure $canvas_objects($i) -fill #FF0000
+ } {
+ $canvas_widget itemconfigure $canvas_objects($i) -fill #FFFFFF
+ }
+ }
+ }
+
+ ## Adjust entryboxes to array $led (LED states)
+ # @parm String - Entrybox to exclude; value == ${common_electrode}${Number system}
+ # @return void
+ private method refresh_entryboxes args {
+ set validation_ena 0
+
+ # Determinate value displayed on LED display
+ set value 0
+ set inv_value 255
+ set mask 1
+ for {set i 0} {$i < 8} {incr i} {
+ if {$leds($i)} {
+ incr value $mask
+ incr inv_value -$mask
+ }
+ set mask [expr {$mask * 2}]
+ }
+
+ ## Clear entryboxes
+ if {$args != {CH}} {
+ $cc_hex_entry delete 0 end
+ }
+ if {$args != {CD}} {
+ $cc_dec_entry delete 0 end
+ }
+ if {$args != {CB}} {
+ $cc_bin_entry delete 0 end
+ }
+ if {$args != {AH}} {
+ $ca_hex_entry delete 0 end
+ }
+ if {$args != {AD}} {
+ $ca_dec_entry delete 0 end
+ }
+ if {$args != {AB}} {
+ $ca_bin_entry delete 0 end
+ }
+
+ ## Fill in entryboxes
+ if {$args != {CD}} {
+ $cc_dec_entry insert insert $value
+ }
+ if {$args != {CH}} {
+ set foo_value [format %X $value]
+ if {[string length $foo_value] < 2} {
+ set foo_value "0$foo_value"
+ }
+ $cc_hex_entry insert insert $foo_value
+ }
+ if {$args != {CB}} {
+ set foo_value [::NumSystem::dec2bin $value]
+ if {[string length $foo_value] < 8} {
+ set foo_value "[string repeat 0 [expr {8 - [string length $foo_value]}]]$foo_value"
+ }
+ $cc_bin_entry insert insert $foo_value
+ }
+
+ if {$args != {AD}} {
+ $ca_dec_entry insert insert $inv_value
+ }
+ if {$args != {AH}} {
+ set foo_value [format %X $inv_value]
+ if {[string length $foo_value] < 2} {
+ set foo_value "0$foo_value"
+ }
+ $ca_hex_entry insert insert $foo_value
+ }
+ if {$args != {AB}} {
+ set foo_value [::NumSystem::dec2bin $inv_value]
+ if {[string length $foo_value] < 8} {
+ set foo_value "[string repeat 0 [expr {8 - [string length $foo_value]}]]$foo_value"
+ }
+ $ca_bin_entry insert insert $foo_value
+ }
+
+ set validation_ena 1
+ }
+}
+set ::EightSegment::config $::CONFIG(EIGHT_SEG_EDITOR)
diff --git a/lib/utilities/hexeditdlg.tcl b/lib/utilities/hexeditdlg.tcl
new file mode 100755
index 0000000..42175f1
--- /dev/null
+++ b/lib/utilities/hexeditdlg.tcl
@@ -0,0 +1,1793 @@
+#!/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
+# Prodides hexadecimal editor for external data and program memory.
+# This editor uses dynamic data loading.
+# --------------------------------------------------------------------------
+
+class HexEditDlg {
+ common count 0 ;# Instance counter
+ common win_pos {+0+0} ;# Window position (+X+Y)
+ common mode {hex} ;# View mode {hex dec oct}
+ common cell {0} ;# Current cell (0 - 0xFFFF)
+ common current_view {left} ;# Focused view {left right}
+ # Font for mode combobox
+ common mode_cb_font [font create \
+ -family {Helvetica} \
+ -size -17 \
+ -weight bold \
+ ]
+ # General normal size bold font
+ common bold_font [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -12 \
+ -weight bold \
+ ]
+ # Status bar tips for main menu for XDATA mode
+ common HELPFILE_XDATA {
+ {
+ {Load IHEX8 file into editor and simulator XDATA memory}
+ {}
+ {Save current content of XDATA memory to IHEX8 file}
+ {Save current document under a different name}
+ {}
+ {Reload data from simulator XDATA memory}
+ {}
+ {Exit editor}
+ } {
+ {Copy selected text to clipboard}
+ {Paste clipboard contents}
+ {}
+ {}
+ {Invoke dialog for searching strings in the text}
+ {Find next occurence of the search string}
+ {Find previous occurence of the search string}
+ } {
+ {Switch view mode to hexadecimal}
+ {Switch view mode to decimal}
+ {Switch view mode to octal}
+ }
+ }
+ # Status bar tips for main menu for CODE mode
+ common HELPFILE_CODE {
+ {
+ {Load IHEX8 file into editor and simulator XDATA memory}
+ {Save current content of program (CODE) memory to IHEX8 file}
+ {}
+ {Save}
+ {Save current document under a different name}
+ {}
+ {Exit editor}
+ } {
+ {Copy selected text to clipboard}
+ {Paste clipboard contents}
+ {}
+ {}
+ {Invoke dialog for searching strings in the text}
+ {Find next occurence of the search string}
+ {Find previous occurence of the search string}
+ } {
+ {Switch view mode to hexadecimal}
+ {Switch view mode to decimal}
+ {Switch view mode to octal}
+ }
+ }
+
+ ## PRIVATE
+ private variable project ;# Object: Project realted to this editor
+ private variable type ;# String: HexEditor type (one of {xdata code})
+ private variable hexeditor ;# Object: Hexadecimal editor pseudowidget
+ private variable win ;# Widget: Dialog toplevel window
+ private variable mainmenu ;# ID of dialog main menu
+ private variable edit_menu ;# ID of dialog edit menu
+ private variable mode_combo_box ;# ID of mode combobox
+ private variable right_sbar_label ;# ID of right label on dialog status bar
+ private variable middle_sbar_label ;# ID of middle label on dialog status bar
+ private variable left_sbar_label ;# ID of left label on dialog status bar
+ private variable current_cell ;# Current cell (0 - 0xFFFF)
+ private variable validation_ena 0 ;# Bool: EntryBox validation enable
+ private variable dec_val_entry ;# EntryBox: Value - Decimal
+ private variable oct_val_entry ;# EntryBox: Value - Octal
+ private variable hex_val_entry ;# EntryBox: Value - Hexadecimal
+ private variable bin_val_entry ;# EntryBox: Value - Binary
+ private variable dec_addr_entry ;# EntryBox: Address - Decimal
+ private variable oct_addr_entry ;# EntryBox: Address - Octal
+ private variable hex_addr_entry ;# EntryBox: Address - Hexadecimal
+ private variable bin_addr_entry ;# EntryBox: Address - Binary
+ private variable sub_call_but ;# Button: Call subprogram
+ private variable prg_jump_but ;# Button: Perform program jump
+ private variable obj_idx ;# Index of the current instance
+ private variable loaded_lines {} ;# Map of loaded lines (for dynamic data loading)
+ private variable opened_file {} ;# Name of opened file
+ private variable modified 0 ;# Bool: fag modified
+ private variable capacity 0 ;# Int: Memory capacity
+ private variable last_PC -1 ;# Int: Last position of PC pointer
+ private variable last_PC_length 0 ;# Int: Length of the last PC pointer
+ private variable last_PC_d -1 ;# Int: Last position of PC pointer (func move_program_pointer_directly)
+ private variable last_PC_length_d 0 ;# Int: Length of the last PC pointer (func move_program_pointer_directly)
+ private variable pre_last_PC -1 ;# Int: Last value of $last_PC
+ private variable pre_last_PC_length 0 ;# Int: Last value of $last_PC_length
+
+ ## Object constructor
+ # @parm Object _project - Parent project
+ # @parm String _type - Type of contents (one of {xdata code eram eeprom uni})
+ constructor {_project _type} {
+ # Initalize object variables
+ set project $_project
+ set type $_type
+ set obj_idx $count
+ set win [toplevel .hexeditdlg${obj_idx} -class {Hex Editor} -bg {#EEEEEE}]
+ set loaded_lines [string repeat [string repeat 0 0xFF] 0xFF]
+
+ incr count ;# Increment instance counter
+
+ # Determinate memory capacity
+ switch -- $type {
+ {code} {
+ set capacity [$project cget -P_option_mcu_xcode]
+ incr capacity [expr {[lindex [$project cget -procData] 2] * 1024}]
+ }
+ {xdata} {
+ set capacity [$project cget -P_option_mcu_xdata]
+ }
+ {eram} {
+ set capacity [lindex [$project cget -procData] 8]
+ }
+ {eeprom} {
+ set capacity [lindex [$project cget -procData] 32]
+ }
+ {uni} {
+ set capacity 0x10000
+ }
+ }
+
+ # Create dialog frames
+ set tool_bar_frame [frame $win.tool_bar] ;# Toolbar
+ set middle_frame $win.middle_frame ;# Left view and right view
+ set bottom_frame [frame $win.bottom_frame] ;# EntryBoxes: Value & Address
+ set statusbar_frame [frame $win.statusbar_frame] ;# Dialog statusbar
+
+ # Create dialog componets
+ create_status_bar $statusbar_frame
+ create_main_menu
+ create_tool_bar $tool_bar_frame
+ create_middle_bottom_frame $middle_frame $bottom_frame
+ create_main_win_bindings
+
+ # Add items "LJMP" and "LCALL" to popup menu
+ if {$type == {code}} {
+ if {[$project is_frozen]} {
+ set state normal
+ } {
+ set state disabled
+ }
+
+ [$hexeditor get_popup_menu] add separator
+ [$hexeditor get_popup_menu] add command -label [mc "LJMP this_address"] \
+ -underline 1 -command "$this prog_jump" -state $state \
+ -compound left -image ::ICONS::16::exec
+ [$hexeditor get_popup_menu] add command -label [mc "LCALL this_address"]\
+ -underline 1 -command "$this sub_call" -state $state \
+ -compound left -image ::ICONS::16::exec
+ }
+
+ # Load data from simulator engine to current visible area
+ load_data_to_current_view
+
+ # Fill EntryBoxes
+ if {$cell >= $capacity} {
+ set current_cell [expr {$capacity - 1}]
+ } {
+ set current_cell $cell
+ }
+ set value [$hexeditor get_values $current_cell $current_cell]
+ fill_entries {} val $value
+ fill_entries {} addr $current_cell
+ set validation_ena 1
+
+ # Pack dialog frames
+ pack $tool_bar_frame -fill x -anchor w
+ pack $middle_frame -anchor nw -after $tool_bar_frame -pady 10
+ pack $bottom_frame -anchor w -after $middle_frame
+ pack $statusbar_frame -side bottom -fill x -after $bottom_frame
+
+ # Set window title
+ if {$type == {code}} {
+ set window_icon {kcmmemory_C}
+ wm title $win "[mc {Code memory}] - $project - MCU 8051 IDE"
+ } elseif {$type == {eram}} {
+ set window_icon {kcmmemory_E}
+ wm title $win "[mc {Expanded RAM}] - $project - MCU 8051 IDE"
+ } elseif {$type == {eeprom}} {
+ set window_icon {kcmmemory_P}
+ wm title $win "[mc {Data EEPROM}] - $project - MCU 8051 IDE"
+ } elseif {$type == {xdata}} {
+ set window_icon {kcmmemory_X}
+ wm title $win "[mc {XDATA memory}] - $project - MCU 8051 IDE"
+ } else {
+ set window_icon {ascii}
+ wm title $win "[mc {untitled}] - [mc {Hexadecimal editor}] - MCU 8051 IDE"
+ }
+
+ # Set window geometry
+ wm resizable $win 0 0
+ if {$mode == {hex}} {
+ wm geometry $win ${win_pos}
+ } {
+ wm geometry $win ${win_pos}
+ }
+
+ # Finalize window configuration
+ wm iconphoto $win ::ICONS::16::$window_icon
+ if {$type == {uni}} {
+ wm protocol $win WM_DELETE_WINDOW "$this quit"
+ } {
+ wm protocol $win WM_DELETE_WINDOW \
+ [list ::X::close_hexedit $type $project]
+ }
+ }
+
+ ## Object destructor
+ destructor {
+ # Save current window parameters
+ set win_pos [wm geometry $win]
+ set win_pos [split $win_pos {+}]
+ set win_pos "+[lindex $win_pos 1]+[lindex $win_pos 2]"
+ set cell [$hexeditor getCurrentCell]
+ set current_view [$hexeditor getCurrentView]
+
+ # Remove dialog window and uset its variables
+ destroy $win
+ unset ::HexEditDlg::dec_val_${obj_idx}
+ unset ::HexEditDlg::hex_val_${obj_idx}
+ unset ::HexEditDlg::oct_val_${obj_idx}
+ unset ::HexEditDlg::bin_val_${obj_idx}
+ unset ::HexEditDlg::dec_addr_${obj_idx}
+ unset ::HexEditDlg::hex_addr_${obj_idx}
+ unset ::HexEditDlg::oct_addr_${obj_idx}
+ unset ::HexEditDlg::bin_addr_${obj_idx}
+ unset ::HexEditDlg::mode_${obj_idx}
+ }
+
+ ## Create key event bindings for dialog window
+ # @return void
+ private method create_main_win_bindings {} {
+ foreach widget [list $win [$hexeditor getLeftView] [$hexeditor getRightView]] {
+ bind $widget <Control-Key-o> "$this openhex; break"
+ bind $widget <Control-Key-s> "$this save; break"
+ bind $widget <Control-Key-S> "$this saveas; break"
+ bind $widget <Key-F5> "$this reload; break"
+ bind $widget <Control-Key-q> "$this quit; break"
+ }
+ }
+
+ ## Create main dialog menu
+ # @return voi
+ private method create_main_menu {} {
+ ## Create menu widgets
+ # Main
+ set mainmenu [menu $win.mainmenu \
+ -bd 0 -tearoff 0 -bg {#EEEEEE} \
+ -activeforeground {#6666FF} \
+ -activebackground {#EEEEEE} \
+ ]
+ set file_menu [menu $mainmenu.file_menu -tearoff 0] ;# Main -> File
+ set edit_menu [menu $mainmenu.edit_menu -tearoff 0] ;# Main -> Edit
+ set mode_menu [menu $mainmenu.mode_menu -tearoff 0] ;# Main -> Mode
+
+ # Create menu event bindings for purpose of status bar tips
+ bind $file_menu <<MenuSelect>> "$this menu_sbar_show 0 \[%W index active\]"
+ bind $edit_menu <<MenuSelect>> "$this menu_sbar_show 1 \[%W index active\]"
+ bind $mode_menu <<MenuSelect>> "$this menu_sbar_show 2 \[%W index active\]"
+ bind $file_menu <Leave> "$this sbar_show {}"
+ bind $edit_menu <Leave> "$this sbar_show {}"
+ bind $mode_menu <Leave> "$this sbar_show {}"
+
+ # Create File menu
+ if {$type == {code}} {
+ $file_menu add command -label "Open ADF" -compound left \
+ -command "$this opensim" -underline 0 \
+ -image ::ICONS::16::fileopen
+ }
+ $file_menu add command -label "Open IHEX8" -compound left \
+ -accelerator "Ctrl+O" -command "$this openhex" \
+ -image ::ICONS::16::fileopen -underline 1
+ $file_menu add separator
+ $file_menu add command -label "Save" -compound left \
+ -accelerator "Ctrl+S" -command "$this save" \
+ -image ::ICONS::16::filesave -underline 0
+ $file_menu add command -label "Save as" -compound left \
+ -accelerator "Ctrl+Shift+S" -command "$this saveas" \
+ -image ::ICONS::16::filesaveas -underline 1
+ $file_menu add separator
+ if {$type != {code}} {
+ $file_menu add command -label "Reload" -compound left \
+ -accelerator "F5" -command "$this reload" \
+ -image ::ICONS::16::reload -underline 1
+ $file_menu add separator
+ }
+ $file_menu add command -label "Exit" -compound left \
+ -accelerator "Ctrl+Q" -command "$this quit" \
+ -image ::ICONS::16::exit -underline 1
+
+ # Create Edit menu
+ $edit_menu add command -label "Copy" -compound left \
+ -accelerator "Ctrl+C" -command "$this text_copy" \
+ -image ::ICONS::16::editcopy -underline 0
+ $edit_menu add command -label "Paste" -compound left \
+ -accelerator "Ctrl+V" -command "$this text_paste" \
+ -image ::ICONS::16::editpaste -underline 0
+ $edit_menu add separator
+ $edit_menu add command -label "Find" -compound left \
+ -accelerator "Ctrl+F" -command "$this find_string 0" \
+ -image ::ICONS::16::find -underline 0
+ $edit_menu add command -label "Find next" -compound left \
+ -accelerator "F3" -command "$this find_string 1" \
+ -image ::ICONS::16::1downarrow -underline 5
+ $edit_menu add command -label "Find previous" -compound left \
+ -accelerator "Shift+F3" -command "$this find_string 2" \
+ -image ::ICONS::16::1uparrow -underline 8
+
+ # Create Mode menu
+ set ::HexEditDlg::mode_${obj_idx} $mode
+ $mode_menu add radiobutton -label "HEX" \
+ -variable ::HexEditDlg::mode_${obj_idx} \
+ -indicatoron 0 -compound left -image ::ICONS::raoff \
+ -selectimage ::ICONS::raon -value {hex} -underline 0 \
+ -command [list $this adjust_mode]
+ $mode_menu add radiobutton -label "DEC" \
+ -variable ::HexEditDlg::mode_${obj_idx} \
+ -indicatoron 0 -compound left -image ::ICONS::raoff \
+ -selectimage ::ICONS::raon -value {dec} -underline 0 \
+ -command [list $this adjust_mode]
+ $mode_menu add radiobutton -label "OCT" \
+ -variable ::HexEditDlg::mode_${obj_idx} \
+ -indicatoron 0 -compound left -image ::ICONS::raoff \
+ -selectimage ::ICONS::raon -value {oct} -underline 0 \
+ -command [list $this adjust_mode]
+
+ # Create Main menu
+ $mainmenu add cascade -label "File" -underline 0 -menu $file_menu
+ $mainmenu add cascade -label "Edit" -underline 0 -menu $edit_menu
+ $mainmenu add cascade -label "Mode" -underline 0 -menu $mode_menu
+ $win configure -menu $mainmenu
+ }
+
+ ## Create dialog toolbar
+ # @parm Widget frame -target frame
+ # @return void
+ private method create_tool_bar {frame} {
+ # Create toolbar frame
+ set toolbar_frame [frame $frame.toolbar]
+ # - Button "Open Hex"
+ pack [ttk::button $toolbar_frame.openhex \
+ -command "$this openhex" \
+ -image ::ICONS::22::fileopen \
+ -style Flat.TButton \
+ ] -side left -padx 2
+ DynamicHelp::add $toolbar_frame.openhex -text [mc "Load IHEX8 file"]
+ set_sbar_tip $toolbar_frame.openhex [mc "Open file"]
+ # - Separator
+ pack [ttk::separator $toolbar_frame.sep0 \
+ -orient vertical \
+ ] -side left -padx 4 -fill y -expand 1
+ # - Button "Save"
+ pack [ttk::button $toolbar_frame.save \
+ -command "$this save" \
+ -image ::ICONS::22::filesave \
+ -style Flat.TButton \
+ ] -side left -padx 2
+ DynamicHelp::add $toolbar_frame.save -text [mc "Save current data to IHEX8 file"]
+ set_sbar_tip $toolbar_frame.save [mc "Save file"]
+ # - Button "Save as"
+ pack [ttk::button $toolbar_frame.saveas \
+ -command "$this saveas" \
+ -image ::ICONS::22::filesaveas \
+ -style Flat.TButton \
+ ] -side left -padx 2
+ DynamicHelp::add $toolbar_frame.saveas -text [mc "Save current data to IHEX8 file under a different name"]
+ set_sbar_tip $toolbar_frame.saveas [mc "Save as"]
+ # - Separator
+ pack [ttk::separator $toolbar_frame.sep1 \
+ -orient vertical \
+ ] -side left -padx 4 -fill y -expand 1
+ if {$type != {code}} {
+ # - Button "Reload"
+ pack [ttk::button $toolbar_frame.reload \
+ -command "$this reload" \
+ -image ::ICONS::22::reload \
+ -style Flat.TButton \
+ ] -side left -padx 2
+ DynamicHelp::add $toolbar_frame.reload -text [mc "Reload data from simulator"]
+ set_sbar_tip $toolbar_frame.reload [mc "Reload"]
+ # - Separator
+ pack [ttk::separator $toolbar_frame.sep2 \
+ -orient vertical \
+ ] -side left -padx 4 -fill y -expand 1
+ }
+ # - Button "Exit"
+ pack [ttk::button $toolbar_frame.exit \
+ -style Flat.TButton \
+ -command "$this quit" \
+ -image ::ICONS::22::exit \
+ ] -side left -padx 2
+ DynamicHelp::add $toolbar_frame.exit -text [mc "Exit editor"]
+ set_sbar_tip $toolbar_frame.exit [mc "Exit"]
+
+ pack $toolbar_frame -side left -anchor w
+
+ # - Mode ComboBox
+ set mode_combo_box [ttk::combobox $frame.mode_cb \
+ -values {HEX DEC OCT} \
+ -state readonly \
+ -font $mode_cb_font \
+ -width 4 \
+ ]
+ bind $mode_combo_box <<ComboboxSelected>> [list $this switch_mode]
+ DynamicHelp::add $mode_combo_box -text [mc "Current view mode"]
+ set_sbar_tip $frame.mode_cb \
+ [mc "View mode"]
+ $mode_combo_box current [lsearch {hex dec oct} $mode]
+ pack $mode_combo_box -side right -anchor e -fill y -expand 0
+ }
+
+ ## Set status tip for the given widget
+ # @parm Widget wdg - Target widget
+ # @parm String txt - Status tip
+ # @return void
+ private method set_sbar_tip {wdg txt} {
+ bind $wdg <Enter> [list $this sbar_show $txt]
+ bind $wdg <Leave> [list $this sbar_show {}]
+ }
+
+ ## Create hexeditor and entryboxes for address and value
+ # @parm Widget middle_frame - Frame for hexeditor
+ # @parm Widget bottom_frame - Frame for entryboxes
+ # @return void
+ private method create_middle_bottom_frame {middle_frame bottom_frame} {
+ ## Create and configure HexEditor
+ set hg [expr {$capacity / 16}]
+ if {[expr {$capacity % 16}]} {
+ incr hg
+ }
+ set hexeditor [HexEditor editor${obj_idx} $middle_frame 16 $hg 4 $mode 1 0 16 $capacity]
+ if {$current_view == {left}} {
+ $hexeditor focus_left_view
+ } {
+ $hexeditor focus_right_view
+ }
+ $hexeditor setCurrentCell $cell
+ $hexeditor bindCellEnter "$this change_right_stat_bar_addr"
+ $hexeditor bindCellLeave "$this change_right_stat_bar_addr {}"
+ $hexeditor bindCurrentCellChanged "$this current_cell_changed"
+ $hexeditor bindCellValueChanged "$this cell_value_changed"
+ $hexeditor bindScrollAction "$this load_data_to_current_view"
+
+ # Create labelframes for Value & Address
+ set value_lframe [ttk::labelframe $bottom_frame.value_label_frame \
+ -text [mc "VALUE"] -padding 5 \
+ ]
+ set address_lframe [ttk::labelframe $bottom_frame.address_label_frame \
+ -text [mc "ADDRESS"] -padding 5 \
+ ]
+
+ # Create entryboxes
+ set i 0
+ set width [list 4 4 9 9 8 8 17 17]
+ foreach valtype {val addr} frm [list $value_lframe $address_lframe] {
+ foreach radix {dec oct hex bin} {
+ set ${radix}_${valtype}_entry [ttk::entry $frm.${radix}_${valtype}_entry \
+ -width [lindex $width $i] \
+ -validate all \
+ -textvariable ::HexEditDlg::${radix}_${valtype}_${obj_idx} \
+ -validatecommand [list $this validate_entry ${valtype} ${radix} %P] \
+ ]
+ bindtags $frm.${radix}_${valtype}_entry \
+ [list $frm.${radix}_${valtype}_entry TEntry $win all .]
+ incr i
+ }
+ }
+
+ # Pack entry boxes and create labels for them
+ grid [label $value_lframe.dec_label -text [mc "DEC: "]] -row 0 -column 0
+ grid [label $value_lframe.oct_label -text [mc "OCT: "]] -row 1 -column 0
+ grid [label $value_lframe.hex_label -text [mc "HEX: "]] -row 0 -column 3
+ grid [label $value_lframe.bin_label -text [mc "BIN: "]] -row 1 -column 3
+ grid $dec_val_entry -row 0 -column 1 -sticky e
+ grid $oct_val_entry -row 1 -column 1 -sticky e
+ grid $hex_val_entry -row 0 -column 4 -sticky e
+ grid $bin_val_entry -row 1 -column 4 -sticky e
+ grid columnconfigure $value_lframe 2 -minsize 10
+
+ grid [label $address_lframe.dec_label -text [mc "DEC: "]] -row 0 -column 0
+ grid [label $address_lframe.oct_label -text [mc "OCT: "]] -row 1 -column 0
+ grid [label $address_lframe.hex_label -text [mc "HEX: "]] -row 0 -column 3
+ grid [label $address_lframe.bin_label -text [mc "BIN: "]] -row 1 -column 3
+ grid $dec_addr_entry -row 0 -column 1 -sticky e
+ grid $oct_addr_entry -row 1 -column 1 -sticky e
+ grid $hex_addr_entry -row 0 -column 4 -sticky e
+ grid $bin_addr_entry -row 1 -column 4 -sticky e
+ grid columnconfigure $address_lframe 2 -minsize 10
+
+ # Create buttons "Call" and "Jump"
+ if {$type == {code}} {
+ if {[$project is_frozen]} {
+ set state normal
+ } {
+ set state disabled
+ }
+
+ set prg_jump_but [ttk::button $address_lframe.prg_jump_but \
+ -text [mc "LJMP"] \
+ -state $state \
+ -command "$this prog_jump" \
+ -width 6 \
+ ]
+ DynamicHelp::add $prg_jump_but -text [mc "Perform program jump"]
+ set_sbar_tip $prg_jump_but [mc "Program jump"]
+ set sub_call_but [ttk::button $address_lframe.sub_call_but \
+ -text [mc "LCALL"] \
+ -state $state \
+ -command "$this sub_call" \
+ -width 6 \
+ ]
+ DynamicHelp::add $sub_call_but -text [mc "Perform subprogram call"]
+ set_sbar_tip $sub_call_but [mc "Subprogram call"]
+
+ grid [ttk::separator $address_lframe.sep -orient vertical] \
+ -row 0 -column 5 -sticky ns -padx 5 -rowspan 2
+ grid $prg_jump_but -row 0 -column 6 -sticky we
+ grid $sub_call_but -row 1 -column 6 -sticky we
+ }
+
+ pack $value_lframe -side left -padx 10
+ pack $address_lframe -side left -padx 10
+ }
+
+ ## Create dialog status bar
+ # @parm Widget frame - Frame for the status bar
+ # @return void
+ private method create_status_bar {frame} {
+ # Create status bar labels
+ set left_sbar_label [label $frame.left -anchor w]
+ set middle_sbar_label [Label $frame.middle]
+ set right_sbar_label [label $frame.right \
+ -fg {#0000FF} -font $bold_font -width 6 \
+ ]
+
+ # Set filename to "untitled" if editor is universal
+ $middle_sbar_label configure -text {untitled}
+
+ # Pack status bar labels
+ pack $left_sbar_label -side left -fill x -expand 1 -anchor w
+ pack $middle_sbar_label -side left -fill none -anchor w -after $left_sbar_label -padx 10
+ pack [label $frame.left_left \
+ -text [mc "Cursor:"] \
+ -font $bold_font \
+ -fg {#555555} \
+ ] -side left -after $middle_sbar_label
+ pack $right_sbar_label -side left -after $frame.left_left
+
+ # Set status tips for right part of the status bar
+ set_sbar_tip $frame.left_left [mc "Address of entry under mouse cursor"]
+ set_sbar_tip $right_sbar_label [mc "Address of entry under mouse cursor"]
+
+ # Initialize pointer address display
+ change_right_stat_bar_addr {}
+ }
+
+ ## Write value to simulator engine and synchronize with all watchers
+ # @parm Int addr - Target address
+ # @parm int val - Register value
+ # @return void
+ private method write_to_simulator {addr val} {
+ if {$type == {uni}} {
+ return
+ }
+
+ # XRAM or ERAM
+ if {$type != {code}} {
+ set hex_addr [format "%X" $addr]
+ set len [string length $hex_addr]
+ if {$len < 4} {
+ set hex_addr "[string repeat 0 [expr {4 - $len}]]$hex_addr"
+ }
+ if {$type == {xdata}} {
+ $project setXdataDEC $addr $val
+ } elseif {$type == {eeprom}} {
+ $project setEepromDEC $addr $val
+ } else {
+ $project setEramDEC $addr $val
+ }
+ $project rightPanel_watch_sync $hex_addr
+
+ # Code memory
+ } {
+ $project setCodeDEC $addr $val
+ }
+ }
+
+ ## Set flag modified and adjust dialog window title
+ # @parm Bool bool - New flag value
+ # @return void
+ private method setModified {bool} {
+ if {$opened_file == {} || $modified == $bool} {
+ return
+ }
+ set modified $bool
+ if {$modified} {
+ wm title $win "\[modified\] [wm title $win]"
+ } {
+ wm title $win [string range [wm title $win] 11 end]
+ }
+ }
+
+
+ ## Parse given data (IHEX-8 and load it into the editor + sync with external components)
+ # @parm String hex_data - input data
+ # @return void
+ private method readHex {hex_data} {
+ # Any EOL -> LF
+ regsub -all {\r\n?} $hex_data "\n" hex_data
+ # Split by lines
+ set hex_data [split $hex_data "\n"]
+
+ # Local variables
+ set pointer 0 ;# Current address
+ set line_number 0 ;# Number of the current line
+ set errors_count 0 ;# Number of errors occured while parsing ihex file
+ set eof 0 ;# Bool: EOF detected
+ set error_string {} ;# Text of error message
+
+ # Clear current data
+ if {$type != {code} && $type != {uni}} {
+ if {$type == {xdata}} {
+ for {set i 0} {$i < $capacity} {incr i} {
+ $project setXdataDEC $i 0
+ }
+ } elseif {$type == {eram}} {
+ for {set i 0} {$i < $capacity} {incr i} {
+ $project setEramDEC $i 0
+ }
+ }
+ $project rightPanel_watch_sync_all
+ }
+
+ # Iterate over data lines
+ foreach line $hex_data {
+ incr line_number
+
+ # Skip comments
+ if {[string index $line 0] != {:}} {continue}
+
+ # Check for allowed characters
+ if {![regexp {^:[0-9A-Fa-f]+$} $line]} {
+ incr errors_count
+ append error_string [mc "Line\t%s:\tInvalid characters\n"] $line_number
+ continue
+ }
+
+ # Local variables
+ set check [string range $line {end-1} end] ;# Control count
+ set line [string range $line 1 {end-2}] ;# Whole line (just without Control count)
+ set data [string range $line 8 end] ;# Data
+ set len [string range $line 0 1] ;# Length of data
+ set addr [string range $line 2 5] ;# Address
+ set rectype [string range $line 6 7] ;# Record type
+
+ # Convert address and length to decimal
+ set addr [expr "0x$addr"]
+ set len [expr "0x$len"]
+
+ # Check for valid control count
+ if {$check != [::IHexTools::getCheckSum $line]} {
+ incr errors_count
+ append error_string [mc "Line\t%s:\tInvalid chceksum\n" $line_number]
+ continue
+ }
+ # Check for valid lenght
+ if {($len * 2) != [string bytelength $data]} {
+ incr errors_count
+ append error_string [mc "Line\t%s:\tInvalid length\n" $line_number]
+ continue
+ }
+ # Check for supported record types
+ if {$rectype == {01}} {
+ set eof 1
+ break
+ }
+ if {$rectype != {00}} {
+ incr errors_count
+ append error_string [mc "Line\t%s:\tUnknown record type: '%s'\n" $line_number $rectype]
+ continue
+ }
+
+ # Set current address
+ set pointer $addr
+ if {$pointer >= $capacity} {
+ break
+ }
+
+ # Parse data field
+ set len [expr {$len * 2}]
+ for {set i 0; set j 1} {$i < $len} {incr i 2; incr j 2} {
+ set number [string range $data $i $j]
+ if {$type == {uni}} {
+ $hexeditor setValue $pointer [expr "0x$number"]
+ } {
+ write_to_simulator $pointer [expr "0x$number"]
+ }
+ incr pointer
+ }
+ }
+
+ # Append error if there is no EOF
+ if {!$eof} {
+ incr errors_count
+ append error_string [mc "Line\t%s:\tMissing EOF" [expr {$line_number + 1}]]
+ }
+
+ # Invoke error dialog
+ if {$errors_count} {
+ # Create dialog window
+ set dialog [toplevel .error_message_dialog -bg {#EEEEEE}]
+
+ # Create main frame (text widget and scrolbar)
+ set main_frame [frame $dialog.main_frame]
+
+ # Create text widget
+ set text [text $main_frame.text \
+ -yscrollcommand "$main_frame.scrollbar set" \
+ -bg {#FFFFFF} -width 0 -height 0 \
+ ]
+ pack $text -side left -fill both -expand 1
+ # Create scrollbar
+ pack [ttk::scrollbar $main_frame.scrollbar \
+ -orient vertical \
+ -command "$text yview" \
+ ] -side right -fill y
+
+ # Pack main frame and create button "Close"
+ pack $main_frame -fill both -expand 1
+ pack [ttk::button $dialog.ok_button \
+ -text [mc "Close"] \
+ -command "
+ grab release $dialog
+ destroy $dialog
+ " \
+ ]
+
+ # Show error string and disable the text widget
+ $text insert end $error_string
+ $text configure -state disabled
+
+ # Set window attributes
+ wm iconphoto $dialog ::ICONS::16::no
+ wm title $dialog [mc "Error(s) occured while parsing IHEX file"]
+ wm minsize $dialog 500 250
+ wm protocol $dialog WM_DELETE_WINDOW "grab release $dialog; destroy $dialog"
+ wm transient $dialog $win
+ grab $dialog
+ raise $dialog
+ tkwait window $dialog
+ }
+ }
+
+ ## Synchronize all EntryBoxes with the given value
+ # @parm String exclude - Name entry to exclude from synchronization {dec hex oct bin}
+ # @parm String valtype - Value type (one of {val addr}) (Value | Address)
+ # @parm Int value - Value (must be in decimal)
+ # @return void
+ private method fill_entries {exclude valtype value} {
+ # Determinate maximum value length (number of digits)
+ if {$valtype == {val}} {
+ set hexlen 2
+ set octlen 3
+ set binlen 8
+ } {
+ set hexlen 4
+ set octlen 7
+ set binlen 16
+ }
+
+ # Empty value -> clear entry boxes
+ if {$value == {}} {
+ set hex {}
+ set oct {}
+ set bin {}
+ # Non empty value -> convert
+ } {
+ # To hexadecimal
+ set hex [format %X $value]
+ set len [string length $hex]
+ if {$len != $hexlen} {
+ set hex "[string repeat {0} [expr {$hexlen - $len}]]$hex"
+ }
+
+ # To octal
+ set oct [format %o $value]
+ set len [string length $oct]
+ if {$len != $octlen} {
+ set oct "[string repeat {0} [expr {$octlen - $len}]]$oct"
+ }
+
+ # To binary
+ set bin [NumSystem::dec2bin $value]
+ set len [string length $bin]
+ if {$len < $binlen} {
+ set bin "[string repeat {0} [expr {$binlen - $len}]]$bin"
+ }
+ }
+
+ # Synchronize EntryBoxes
+ if {$valtype == {val}} {
+ if {$exclude != {dec}} {
+ set ::HexEditDlg::dec_val_${obj_idx} $value
+ }
+ if {$exclude != {hex}} {
+ set ::HexEditDlg::hex_val_${obj_idx} $hex
+ }
+ if {$exclude != {oct}} {
+ set ::HexEditDlg::oct_val_${obj_idx} $oct
+ }
+ if {$exclude != {bin}} {
+ set ::HexEditDlg::bin_val_${obj_idx} $bin
+ }
+ } else {
+ if {$exclude != {dec}} {
+ set ::HexEditDlg::dec_addr_${obj_idx} $value
+ }
+ if {$exclude != {hex}} {
+ set ::HexEditDlg::hex_addr_${obj_idx} $hex
+ }
+ if {$exclude != {oct}} {
+ set ::HexEditDlg::oct_addr_${obj_idx} $oct
+ }
+ if {$exclude != {bin}} {
+ set ::HexEditDlg::bin_addr_${obj_idx} $bin
+ }
+ }
+ }
+
+ ## Change content of cursor address display on status bar
+ # @parm Mixed args - [lindex $args 0] == Decimal address
+ # @return void
+ public method change_right_stat_bar_addr args {
+ set address [lindex $args 0]
+
+ # Empty address
+ if {$address == {}} {
+ $right_sbar_label configure -text " --- "
+ return
+ }
+
+ # Non empty address -> convert to HEX and display
+ set address [format %X $address]
+ set len [string length $address]
+ if {$len < 4} {
+ set address "[string repeat {0} [expr {4 - $len}]]$address"
+ }
+ $right_sbar_label configure -text "0x$address"
+ }
+
+ ## Adjust view mode to content of mode combobox
+ # @return void
+ public method switch_mode {} {
+ set mode [lindex {hex dec oct} [$mode_combo_box current]]
+ set ::HexEditDlg::mode_${obj_idx} $mode
+ sbar_show {Working ...}
+ update
+ $hexeditor switch_mode $mode
+ sbar_show {}
+ }
+
+ ## This method should be called after value change in hexeditor
+ # This method writes new value to simulator engine, watchers and EntryBoxes
+ # @parm Int addr - Address of changed cell
+ # @parm int val - New value of the entry
+ # @return void
+ public method cell_value_changed {addr val} {
+ set current_cell $addr
+ set validation_ena 0
+ fill_entries {} val $val
+ write_to_simulator $addr $val
+ setModified 1
+ set validation_ena 1
+ }
+
+ ## This method should be called after current cell change in hexeditor
+ # Synchronizes EntryBoxes
+ # @parm Int addr - New cell address
+ # @return void
+ public method current_cell_changed {addr} {
+ set validation_ena 0
+ set current_cell $addr
+ set value [$hexeditor get_values $addr $addr]
+ fill_entries {} val $value
+ fill_entries {} addr $addr
+ set validation_ena 1
+ }
+
+ ## Validate content of EntryBox in bottom frame
+ # + Synchronize value with all others (if valid)
+ # @parm String valtype - Value type (Address {addr} | Value {val})
+ # @parm String radix - Number base (one of {oct hex dec bin})
+ # @parm String value - Value to validate (and synchronize)
+ # @return void
+ public method validate_entry {valtype radix value} {
+ # If validation is disabled or value is empty -> abort
+ if {!$validation_ena || $value == {}} {
+ return 1
+ }
+
+ # Check for valid characters
+ if {$valtype == {val}} {
+ set m 1
+ } {
+ set m 2
+ }
+ set len [string length $value]
+ switch -- $radix {
+ {dec} {
+ if {$len > (3 * $m) || ![string is digit $value]} {
+ return 0
+ }
+ }
+ {hex} {
+ if {$len > (2 * $m) || ![string is xdigit $value]} {
+ return 0
+ }
+ }
+ {oct} {
+ if {!$len > (3 * $m) || [regexp {^[0-7]+$} $value]} {
+ return 0
+ }
+ }
+ {bin} {
+ if {$len > (8 * $m) || ![regexp {^[01]+$} $value]} {
+ return 0
+ }
+ }
+ }
+
+ # Tempotary disable validations (to prevent infinite event loops)
+ set validation_ena 0
+
+ # Convert value to decimal
+ set value [string trimleft $value 0]
+ if {$value == {}} {
+ set value 0
+ }
+ switch -- $radix {
+ {hex} {
+ set value [expr "0x$value"]
+ }
+ {oct} {
+ set value [expr "0$value"]
+ }
+ {bin} {
+ set value [NumSystem::bin2dec $value]
+ }
+ }
+
+ # Check for allowed value range
+ if {$valtype == {val}} {
+ if {$value > 255} {
+ set validation_ena 1
+ return 0
+ }
+ } {
+ if {$value >= $capacity} {
+ set validation_ena 1
+ return 0
+ }
+ }
+
+ # Synchronize with all other
+ fill_entries $radix $valtype $value
+ if {$valtype == {val}} {
+ $hexeditor setValue $current_cell $value
+ write_to_simulator $current_cell $value
+ } {
+ set current_cell $value
+ $hexeditor setCurrentCell $value
+ }
+
+ # Set flag modified + Reenable validations
+ setModified 1
+ set validation_ena 1
+
+ return 1
+ }
+
+ ## Perform program jump
+ # @return void
+ public method prog_jump {} {
+ if {$type != {code}} {return}
+ $project setPC [subst "\$::HexEditDlg::dec_addr_${obj_idx}"]
+ set lineNum [$project simulator_getCurrentLine]
+ if {$lineNum != {}} {
+ $project move_simulator_line $lineNum
+ } {
+ $project editor_procedure {} unset_simulator_line {}
+ }
+ $project Simulator_sync_PC_etc
+ }
+
+ ## Perform subprogram call
+ # @return void
+ public method sub_call {} {
+ if {$type != {code}} {return}
+ $project simulator_subprog_call [subst "\$::HexEditDlg::dec_addr_${obj_idx}"]
+ set lineNum [$project simulator_getCurrentLine]
+ if {$lineNum != {}} {
+ $project move_simulator_line $lineNum
+ } {
+ $project editor_procedure {} unset_simulator_line {}
+ }
+ $project Simulator_sync_PC_etc
+ }
+
+ ## Adjust view mode to state of mode menu
+ # @return void
+ public method adjust_mode {} {
+ $mode_combo_box current [lsearch {hex dec oct} [subst "\$::HexEditDlg::mode_${obj_idx}"]]
+ sbar_show {Working ...}
+ update
+ $hexeditor switch_mode [subst "\$::HexEditDlg::mode_${obj_idx}"]
+ sbar_show {Working}
+ }
+
+ ## Quit dialog
+ # @return void
+ public method quit {} {
+ if {$modified} {
+ set response [tk_messageBox \
+ -parent $win \
+ -type yesnocancel \
+ -icon question \
+ -title [mc "File modified"] \
+ -message [mc "File %s has been modifed.\nDo you want to save it ?" [file tail $opened_file]]]
+ if {$response == {yes}} {
+ save
+ } elseif {$response != {no}} {
+ return
+ }
+ }
+ if {$type == {uni}} {
+ delete object $this
+ } {
+ ::X::close_hexedit $type $project
+ }
+ }
+
+ ## Show status tip for menu entry
+ # @parm Int help_file_index - Menu index
+ # @parm Int entry_index - Entry index
+ # @return void
+ public method menu_sbar_show {help_file_index entry_index} {
+ # Validate input data
+ if {![string is digit $entry_index]} {
+ $left_sbar_label configure -text {}
+ return
+ }
+ if {![string is digit $help_file_index]} {
+ $left_sbar_label configure -text {}
+ return
+ }
+
+ # Show status tip
+ if {$type == {code}} {
+ $left_sbar_label configure -text \
+ [mc [lindex $HELPFILE_CODE [list $help_file_index $entry_index]]]
+ } {
+ $left_sbar_label configure -text \
+ [mc [lindex $HELPFILE_XDATA [list $help_file_index $entry_index]]]
+ }
+ }
+
+ ## Load data from simulator engine to current visible area
+ # @return void
+ public method load_data_to_current_view {} {
+ if {$type == {uni}} {return}
+
+ # Local variables
+ set startrow [$hexeditor getTopRow] ;# Start row
+ set endrow [expr {$startrow + 15}] ;# End row
+ set startaddr [expr {$startrow * 16}] ;# Start address for 1st row
+ set endaddr [expr {($startrow + 1) * 16 - 1}] ;# End address for 1st row
+
+ # Determinate command to gain data
+ if {$type == {code}} {
+ set cmd {getCodeDEC}
+ } elseif {$type == {xdata}} {
+ set cmd {getXdataDEC}
+ } elseif {$type == {eeprom}} {
+ set cmd {getEepromDEC}
+ } else {
+ set cmd {getEramDEC}
+ }
+
+ # Iterate over visible rows and load data to them
+ for {set row $startrow} {$row <= $endrow} {incr row} {
+ if {[string index $loaded_lines $row] == 1} {
+ incr startaddr 16
+ incr endaddr 16
+ continue
+ }
+
+ for {set addr $startaddr} {$addr <= $endaddr} {incr addr} {
+ if {$addr >= $capacity} {
+ break
+ }
+ $hexeditor setValue $addr [$project $cmd $addr]
+ }
+
+ incr startaddr 16
+ incr endaddr 16
+ }
+
+ # Adjust map of loaded lines
+ set loaded_lines [string replace $loaded_lines $startrow $endrow [string repeat 1 16]]
+ }
+
+ ## Show text in status bar
+ # @parm String text - Text to show
+ # @return void
+ public method sbar_show {text} {
+ $left_sbar_label configure -text $text
+ }
+
+ ## Action for Menu/Toolbar - Copy
+ # Invoke dialog "Find string"
+ # @return void
+ public method text_copy {} {
+ $hexeditor text_copy
+ }
+
+ ## Action for Menu/Toolbar - Paste
+ # Invoke dialog "Find string"
+ # @return void
+ public method text_paste {} {
+ $hexeditor text_paste
+ }
+
+ ## Action for Menu/Toolbar - "Find" or "Find next" or "Find previous"
+ # Invoke dialog "Find string"
+ # @return void
+ public method find_string {action} {
+ switch -- $action {
+ 0 {$hexeditor find_dialog}
+ 1 {$hexeditor find_next}
+ 2 {$hexeditor find_prev}
+ }
+ }
+
+ ## Action for Menu/Toolbar - Reload
+ # Reload content of HexEditor
+ # @return void
+ public method reload {} {
+ # Store original cursor position
+ set current_cursor_pos [$hexeditor getCurrentCell]
+
+ if {$type != {xdata} && $type != {uni}} {return}
+ if {$type == {uni}} {
+ set ext [string replace [file extension $opened_file] 0 0]
+ if {$ext != {} && $opened_file != {}} {
+ open_file $opened_file $ext
+ }
+ } {
+ refresh
+ }
+
+ # Restore original cursor position
+ update
+ $hexeditor setCurrentCell $current_cursor_pos
+ $hexeditor seeCell $current_cursor_pos
+ }
+
+ ## Action for Menu/Toolbar - Save as
+ # Save current content of hexeditor as IHEX8 file and ask for file name
+ # @return void
+ public method saveas {} {
+ set directory [file dirname $opened_file]
+ if {$type == {uni}} {
+ if {${::X::project_menu_locked}} {
+ set project {}
+ } {
+ set project ${::X::actualProject}
+ }
+ }
+ if {$directory == {.}} {
+ if {$project == {}} {
+ set directory ${::X::defaultDirectory}
+ } {
+ set directory [$project cget -projectPath]
+ }
+ }
+ catch {delete object fsd}
+ KIFSD::FSD fsd \
+ -title [mc "Save file - MCU 8051 IDE"] \
+ -master $win \
+ -directory $directory \
+ -initialfile [$middle_sbar_label cget -text] \
+ -defaultmask 0 -multiple 0 -filetypes {
+ {{IHEX8} {*.{hex,ihx}} }
+ {{All files} {*} }
+ }
+ fsd setokcmd "$this save_file_proc \[::HexEditDlg::fsd get\]"
+ fsd activate
+ }
+
+ ## Action for Menu/Toolbar - Save
+ # Save current content of the editor to $opened_file
+ # @return void
+ public method save {} {
+ if {$opened_file == {}} {
+ saveas
+ return
+ }
+ save_file_proc $opened_file
+ }
+
+ ## Action for Menu/Toolbar - Open Hex
+ # @return void
+ public method openhex {} {
+ set directory [file dirname $opened_file]
+ if {$type == {uni}} {
+ if {${::X::project_menu_locked}} {
+ set project {}
+ } {
+ set project ${::X::actualProject}
+ }
+ }
+ if {$directory == {.}} {
+ if {$project == {}} {
+ set directory ${::X::defaultDirectory}
+ } {
+ set directory [$project cget -projectPath]
+ }
+ }
+ catch {delete object fsd}
+ KIFSD::FSD fsd \
+ -title [mc "Open file - MCU 8051 IDE"] \
+ -master $win -directory $directory \
+ -defaultmask 0 -multiple 0 -filetypes {
+ {{IHEX8} {*.{hex,ihx}} }
+ {{All files} {*} }
+ }
+ fsd setokcmd "$this open_file \[::HexEditDlg::fsd get\] hex"
+ fsd activate
+ }
+
+ ## Action for Menu/Toolbar - Open Adb
+ # @return void
+ public method opensim {} {
+ if {$type != {code}} {return}
+ set directory [file dirname $opened_file]
+ if {$directory == {.}} {
+ set directory [$project cget -projectPath]
+ }
+ catch {delete object fsd}
+ KIFSD::FSD fsd \
+ -title [mc "Open file - MCU 8051 IDE"] \
+ -master $win -directory $directory \
+ -defaultmask 0 -multiple 0 -filetypes {
+ {{Simulator file} {*.adb} }
+ {{All files} {*} }
+ }
+ fsd setokcmd "$this open_file \[::HexEditDlg::fsd get\] adf"
+ fsd activate
+ }
+
+ ## Open the give file and load its contents into editor
+ # @parm String filename - Relative or absolute filename
+ # @parm String extension - Fily type {adf hex}
+ # @return void
+ public method open_file {filename extension} {
+ # Store original cursor position
+ set current_cursor_pos [$hexeditor getCurrentCell]
+
+ # Normalize filename
+ set filename [file normalize $filename]
+ set directory [file dirname $filename]
+ if {$type == {uni}} {
+ if {${::X::project_menu_locked}} {
+ set project {}
+ } {
+ set project ${::X::actualProject}
+ }
+ }
+ if {$directory == {.}} {
+ if {$project == {}} {
+ set directory ${::X::defaultDirectory}
+ } {
+ set directory [$project cget -projectPath]
+ }
+ }
+ if {!$::MICROSOFT_WINDOWS} { ;# POSIX way
+ if {![regexp "^(~|/)" $filename]} {
+ set filename "$directory/$filename"
+ }
+ } { ;# Microsoft windows way
+ if {![regexp "^\w:" $filename]} {
+ set filename [file join $directory $filename]
+ }
+ }
+
+ # Open file
+ if {[catch {
+ set file [open $filename r]
+ }]} then {
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon warning \
+ -title [mc "Permission denied"] \
+ -message [mc "Unable to open file:\n%s" $filename]
+ return
+ }
+
+ # Clear editor
+ if {$type == {uni}} {
+ $hexeditor fill_views
+ } {
+ $project simulator_clear_memory $type
+ }
+
+ # Load contents
+ if {$extension == {adf}} {
+ $project load_program_from_adf $filename
+ } {
+ readHex [read $file]
+ }
+
+ # Finalize
+ close $file
+ set_filename $filename
+ refresh
+
+ # Restore original cursor position
+ update
+ $hexeditor setCurrentCell $current_cursor_pos
+ $hexeditor seeCell $current_cursor_pos
+ }
+
+ ## Save content of the editor into the given file in format IHEX8
+ # @parm String filename - target filename
+ # @return void
+ public method save_file_proc {filename} {
+ # Adjust filename
+ set filename [file normalize $filename]
+ set directory [file dirname $filename]
+ set rootname $filename
+ if {$type == {uni}} {
+ if {${::X::project_menu_locked}} {
+ set project {}
+ } {
+ set project ${::X::actualProject}
+ }
+ }
+ if {$directory == {.}} {
+ if {$project == {}} {
+ set directory ${::X::defaultDirectory}
+ } {
+ set directory [$project cget -projectPath]
+ }
+ }
+ if {!$::MICROSOFT_WINDOWS} { ;# POSIX way
+ if {![regexp "^(~|/)" $filename]} {
+ set filename "$directory/$filename"
+ }
+ } { ;# Microsoft windows way
+ if {![regexp "^\w:" $filename]} {
+ set filename [file join $directory $filename]
+ }
+ }
+
+ # Adjust file extension
+ if {![regexp {\.(hex|ihx)$} $filename]} {
+ if {$type != {code} && $type != {uni} } {
+ append filename {.xdata.hex}
+ } {
+ append filename {.hex}
+ }
+ }
+
+ if {[file exists $filename]} {
+ # Check if the file is writable
+ if {![file writable $filename]} {
+ tk_messageBox -type ok -icon error -title [mc "Permission denied"] \
+ -message [mc "Unable to access file: %s" $filename] -parent $win
+ return
+ }
+ # Ask user for overwrite existing file
+ if {[tk_messageBox \
+ -type yesno \
+ -icon question \
+ -parent $win \
+ -title [mc "Overwrite file"] \
+ -message [mc "A file name '%s' already exists. Are you sure you want to overwrite it ?" [file tail $filename]]
+ ] != {yes}
+ } {
+ return
+ }
+ # Create a backup file
+ catch {
+ file rename -force $filename "$filename~"
+ }
+ }
+
+ # Write filename on statusbar
+ set_filename $filename
+
+ if {$type == {xdata}} {
+ set getDataCommand {getXdata}
+
+ } elseif {$type == {eram}} {
+ set getDataCommand {getEram}
+
+ } elseif {$type == {eeprom}} {
+ set getDataCommand {getEeprom}
+
+ } else {
+ set getDataCommand {getCode}
+ }
+
+ # Open file
+ if {[catch {
+ set file [open $filename w 420]
+ }]} {
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon warning \
+ -title [mc "Permission denied"] \
+ -message [mc "Unable to open file:\n%s" $filename]
+ return
+ }
+
+ # Determinate number of 2048 B blocks
+ set maximum [expr {$capacity / 2048 + 1}]
+
+ # Create progress dialog
+ set ::X::saving_progress 0
+ set ::X::abort_saving 0
+
+ create_progress_bar .prgDl \
+ $win \
+ {} \
+ "Saving: $rootname" \
+ ::X::saving_progress \
+ $maximum \
+ [mc "Saving file"] \
+ ::ICONS::16::filesave \
+ [mc "Abort"] \
+ {set ::X::abort_saving 1}
+
+ # Local variables
+ set addr 0 ;# Address
+ set len 0 ;# Length
+ set data {} ;# Data field
+ set pointer -1 ;# Current address
+
+ # $maximum* update Progress Dialog
+ for {set i 0} {$i < $maximum} {incr i} {
+
+ # Create 8*32 IHEX records
+ for {set j 0} {$j < 2048} {incr j} {
+
+ # Increment address pointer
+ incr pointer
+ if {$pointer >= $capacity} {
+ break
+ }
+
+ # Get register value
+ set code [$hexeditor get_values $pointer $pointer]
+ if {$code != {}} {
+ set code [format {%X} $code]
+ if {[string length $code] == 1} {
+ set code "0$code"
+ }
+ }
+
+ # If buffer is full -> create record
+ if {$code == {} || $len == 255} {
+ # Save record
+ if {$len != 0} {
+ puts -nonewline $file {:}
+ puts $file [createHexRecord \
+ [format "%X" $len] \
+ [format "%X" $addr] \
+ 00 $data \
+ ]
+ }
+ # Reset some variables related to the last record
+ set addr $pointer
+ incr addr
+ set len 0
+ set data {}
+ if {$len != 255} {continue}
+ }
+
+ # Increment length field and append register value to data field
+ incr len
+ append data $code
+ }
+
+ # Update Progress Dialog
+ incr ::X::saving_progress
+ update
+ # Optionaly abort
+ if {${::X::abort_saving}} {
+ set abort_saving 0
+ destroy .prgDl
+ return
+ }
+ }
+
+ # Destroy Progress Dialog
+ catch {destroy .prgDl}
+
+ # Save the last (incomplete) record
+ if {$len != 0} {
+ puts -nonewline $file {:}
+ puts $file [::HexEditDlg::createHexRecord \
+ [format "%X" $len] [format "%X" $addr] 00 $data]
+ }
+
+ # Save EOF
+ puts -nonewline $file {:00000001FF}
+
+ # Done ...
+ close $file
+ setModified 0
+ sbar_show [mc "File %s saved" $filename]
+ }
+
+ ## Create Intel HEX 8 field
+ # @parm String len - field length (max. 2 hex digits)
+ # @parm String addr - field address (max. 4 hex digits)
+ # @parm String type - field type (exaclty 2 hex digits (eg. '00' or '01'))
+ # @parm String data - data (even number of hex digits, max. 512)
+ # @return String - Intel HEX 8 field
+ proc createHexRecord {len addr rectype data} {
+ # Adjust length
+ if {[string length $len] == 1} {set len "0$len"}
+ # Adjust address
+ set addr_len [string length $addr]
+ if {$addr_len < 4} {
+ set addr "[string repeat 0 [expr {4 - $addr_len}]]$addr"
+ }
+ # Create field
+ set result "${len}${addr}${rectype}"
+ append result $data
+ # Compute control count (see Compiler)
+ append result [::IHexTools::getCheckSum $result]
+ # Return result
+ return $result
+ }
+
+ # -------------------------------------------------------------------
+ # GENERAL PUBLIC INTERFACE
+ # -------------------------------------------------------------------
+
+ ## Inform hexeditor about simulator start or shutdown
+ # @parm Bool started - 1 == Simulator started; 0 == Simulator stopped
+ # @return void
+ public method simulator_stared_stopped {started} {
+ if {$type != {code}} {
+ return
+ }
+
+ if {$started} {
+ set state {normal}
+ } {
+ set state {disabled}
+ }
+ $sub_call_but configure -state $state
+ $prg_jump_but configure -state $state
+ [$hexeditor get_popup_menu] entryconfigure [::mc "LJMP this_address"] -state $state
+ [$hexeditor get_popup_menu] entryconfigure [::mc "LCALL this_address"] -state $state
+ }
+
+ ## Move program pointer (highlight cells) -- Avaliable only for code memory hexeditor
+ # @parm Int new_PC - New program counter
+ # @parm Int int_length - Instruction length
+ # @return void
+ public method move_program_pointer {new_PC int_length} {
+ if {$type != {code}} {
+ return
+ }
+
+ if {$pre_last_PC > -1} {
+ for {set i 0} {$i < $pre_last_PC_length} {incr i} {
+ $hexeditor set_bg_hg $pre_last_PC 0 1
+ incr pre_last_PC
+ }
+ }
+ set pre_last_PC $last_PC
+ set pre_last_PC_length $last_PC_length
+
+ if {$last_PC > -1} {
+ for {set i 0} {$i < $last_PC_length} {incr i} {
+ $hexeditor set_bg_hg $last_PC 1 1
+ $hexeditor set_bg_hg $last_PC 0 2
+ incr last_PC
+ }
+ }
+
+ set last_PC_length_d 0
+ set last_PC_d -1
+ set last_PC_length $int_length
+ set last_PC $new_PC
+
+ for {set i 0} {$i < $int_length} {incr i} {
+ $hexeditor set_bg_hg $new_PC 1 2
+ incr new_PC
+ }
+ $hexeditor seeCell $new_PC
+ }
+
+ ## Directly move program pointer (do not affect previous PC pointer) -- Avaliable only for code memory hexeditor
+ # @parm Int new_PC - New program counter (-1 == unresolved)
+ # @parm Int int_length - Instruction length
+ # @return void
+ public method move_program_pointer_directly {new_PC int_length} {
+ if {$type != {code}} {
+ return
+ }
+
+ if {$last_PC_d > -1} {
+ for {set i 0} {$i < $last_PC_length_d} {incr i} {
+ $hexeditor set_bg_hg $last_PC_d 0 0
+ incr last_PC_d
+ }
+ }
+ if {$new_PC == -1} {
+ set last_PC_length_d 0
+ set last_PC_d -1
+ return
+ }
+ set last_PC_length_d $int_length
+ set last_PC_d $new_PC
+
+ for {set i 0} {$i < $int_length} {incr i} {
+ $hexeditor set_bg_hg $new_PC 1 0
+ incr new_PC
+ }
+ $hexeditor seeCell $new_PC
+ }
+
+ ## Clear highlight for all cells in the editor
+ # @return void
+ public method clear_highlight {} {
+ $hexeditor clearHighlighting
+ }
+
+ ## Set background highlight
+ # @parm Int addr - Cell address
+ # @parm Bool bool - 1 == Set; 0 == Clear
+ # @return void
+ public method set_bg_hg_clr {addr bool} {
+ $hexeditor set_bg_hg $addr $bool 0
+ }
+
+ ## Write value to the editor
+ # - avaliable only in modes: XDATA and ERAM
+ # @parm String address - hexadecimal address
+ # @return void
+ public method reg_sync {address} {
+ if {$type == {code}} {
+ return
+ }
+
+ set address [expr "0x$address"]
+ if {$type == {xdata}} {
+ set val [$project getXdataDEC $address]
+ } elseif {$type == {eeprom}} {
+ set val [$project getEepromDEC $address]
+ } else {
+ set val [$project getEramDEC $address]
+ }
+ set org_val [$hexeditor get_values $address $address]
+ $hexeditor setValue $address $val
+ if {$org_val != $val} {
+ $hexeditor setHighlighted $address 1
+ }
+ if {$address == $current_cell} {
+ set validation_ena 0
+ fill_entries {} val $val
+ set validation_ena 1
+ }
+ setModified 1
+ }
+
+ ## Reload content of the editor
+ # @return void
+ public method refresh {} {
+ if {$type == {uni}} {return}
+
+ set loaded_lines [string repeat [string repeat 0 0xFF] 0xFF]
+ load_data_to_current_view
+ setModified 1
+ }
+
+ ## Get configuration list
+ # @return List - config list for procedure loadConfig
+ proc getConfig {} {
+ return [list $win_pos $mode $cell $current_view [::HexEditor::get_config]]
+ }
+
+ ## Load config list (result of procedure getConfig)
+ # @parm List - config list
+ # @return void
+ proc loadConfig {config} {
+ # Parse config list
+ set win_pos [lindex $config 0]
+ set mode [lindex $config 1]
+ set cell [lindex $config 2]
+ set current_view [lindex $config 3]
+
+ # load configuration for hexeditor widget
+ ::HexEditor::load_config_list [lindex $config 4]
+
+ # Validate loaded values
+ if {![regexp {^\+\d+\+\d+$} $win_pos]} {
+ puts stderr "Invalid value of key win_pos (`$win_pos')"
+ set win_pos {+0+0}
+ }
+ if {$mode != {hex} && $mode != {dec} && $mode != {oct}} {
+ puts stderr "Invalid value of key mode (`$mode')"
+ set mode {hex}
+ }
+ if {![string is digit -strict $cell]} {
+ puts stderr "Invalid value of key cell (`$cell')"
+ set cell 0
+ }
+ if {$current_view != {left} && $current_view != {right}} {
+ puts stderr "Invalid value of key current_view (`$current_view')"
+ set current_view {left}
+ }
+ }
+
+ ## Set name of current file (for purpose of saving and for status bar)
+ # @parm String filename - Full filename
+ # @return void
+ public method set_filename {filename} {
+ set opened_file $filename
+
+ set filename [file tail $filename]
+ $middle_sbar_label configure -text $filename -helptext $opened_file
+ if {$type == {uni}} {
+ if {$modified} {
+ wm title $win "\[modified\] $filename - [mc {Hexadecimal editor}] - MCU 8051 IDE"
+ } {
+ wm title $win "$filename - [mc {Hexadecimal editor}] - MCU 8051 IDE"
+ }
+ }
+ }
+}
diff --git a/lib/utilities/notes.tcl b/lib/utilities/notes.tcl
new file mode 100755
index 0000000..f39312f
--- /dev/null
+++ b/lib/utilities/notes.tcl
@@ -0,0 +1,896 @@
+#!/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:
+# Scribble notes independent on project
+# --------------------------------------------------------------------------
+
+class Notes {
+ ## COMMON
+ common count 0 ;# Int: Counter of object instances
+ common bgcolor {#EEEE55} ;# Color: Background color for title bar and window border
+ common bgcolor2 {#FFFF88} ;# Color: Background color for the canvas widget
+ # Font: For inserted text
+ common canvas_text_font [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -14 \
+ -weight bold \
+ ]
+ # List: Popup menu for the canvas widget
+ common MENU {
+ {radiobutton "Pencil" {} ::Notes::__mode {P}
+ "change_mode P" 0}
+ {radiobutton "Line" {} ::Notes::__mode {L}
+ "change_mode L" 0}
+ {radiobutton "Arrow" {} ::Notes::__mode {A}
+ "change_mode A" 0}
+ {radiobutton "Rectangle" {} ::Notes::__mode {R}
+ "change_mode R" 0}
+ {radiobutton "Oval" {} ::Notes::__mode {O}
+ "change_mode O" 0}
+ {radiobutton "Insert text" {} ::Notes::__mode {T}
+ "change_mode T" 0}
+ {radiobutton "Move canvas" {} ::Notes::__mode {M}
+ "change_mode M" 0}
+ {radiobutton "Eraser" {} ::Notes::__mode {C}
+ "change_mode C" 0}
+ {separator}
+ {command "Zoom in" "" 0 {canvas_zoom_in_from_pmenu}
+ {viewmag_in}}
+ {command "Zoom out" "" 0 {canvas_zoom_out_from_pmenu}
+ {viewmag_out}}
+ {separator}
+ {command "Insert image" "" 0 {load_image}
+ {fileimport}}
+ {command "Select color" "" 0 {select_color}
+ {colorize}}
+ {separator}
+ {command "Clear all" "" 0 {canvas_clear_all}
+ {emptytrash}}
+ }
+
+ ## PRIVATE
+ private variable filename ;# String: Nothing yet ...
+ private variable geometry ;# Geometry: Window geometry
+ private variable win ;# Widget: Dialog window (widget class Frame)
+
+ private variable main_frame ;# Widget: Main window frame
+ private variable canvas_widget ;# Widget: Canvas widget for writing notes
+ 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 minim_flag 0 ;# Bool: Shaded or not
+ private variable allow_raise_win 1 ;# Bool: Allows to use command "raise" to force window visibility
+ private variable popup_menu_created 0 ;# Bool: Canvas widget popup menu has been created
+ private variable menu ;# Widget: Popup menu for he canvas widget
+
+ private variable drawing_mode P ;# Char: Current drawing mode
+ private variable selected_color black ;# Color: Selected drawing color
+ private variable loaded_image {} ;# Image: Image to insert (image object not filename)
+ private variable text_to_write {} ;# String: Text to insert
+
+ private variable click_X ;# Int: Auxiliary variable for storing last position
+ private variable click_Y ;# Int: Auxiliary variable for storing last position
+
+ 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 mode_pen_but ;# Widget: Button "Pencil" mode
+ private variable mode_line_but ;# Widget: Button "Line" mode
+ private variable mode_arrow_but ;# Widget: Button "Arrow" mode
+ private variable mode_rectangle_but ;# Widget: Button "Rectangle" mode
+ private variable mode_oval_but ;# Widget: Button "Oval" mode
+ private variable mode_text_but ;# Widget: Button "Insert text" mode
+ private variable mode_clear_but ;# Widget: Button "Eraser" mode
+ private variable load_image_but ;# Widget: Button "Import image"
+ private variable select_color_but ;# Widget: Button "Select color"
+ private variable move_but ;# Widget: Button "Move canvas" mode
+ private variable flag_modified 0 ;# Bool: Flag modified
+
+ ## contructor
+ # @parm String _file_name - (Nothing yet)
+ # @parm List _geometry - {X Y W H}
+ constructor {_file_name _geometry} {
+ incr count
+
+ set filename $_file_name
+ if {$_geometry == {}} {
+ set geometry {50 50 300 300}
+ } {
+ set geometry $_geometry
+ }
+
+ # Configure specific ttk styles
+ ttk::style configure Notes.TButton \
+ -padding 0 \
+ -background $bgcolor
+ ttk::style configure Notes_Flat.TButton \
+ -background $bgcolor \
+ -padding 0 \
+ -borderwidth 1 \
+ -relief flat
+ ttk::style map Notes_Flat.TButton \
+ -relief [list active raised] \
+ -background [list disabled {#EEEEEE}]
+
+ create_win
+ }
+
+ destructor {
+ destroy $win
+ }
+
+ ## Close the window
+ # @return void
+ public method close {} {
+ if {$flag_modified} {
+ if {[tk_messageBox \
+ -type yesno \
+ -icon question \
+ -parent $win \
+ -title [mc "Really close ?"] \
+ -message [mc "Do you really want to close your notes ? (There is no save function ...)"] \
+ ] != {yes}} then {
+ return
+ }
+ }
+ delete object $this
+ }
+
+ ## 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 $title_label
+ $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 <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
+ }
+ }
+
+ ## Event handler: right bottom corner <Button-1>
+ # @return void
+ public method resize_B1 {} {
+ set click_X [expr {-[winfo x $win] - [winfo x .]}]
+ set click_Y [expr {-[winfo y $win] - [winfo y .]}]
+
+ set max_X [expr {[winfo width .] + [winfo x .]}]
+ set max_Y [expr {[winfo height .] + [winfo y .]}]
+ }
+
+ ## Event handler: right bottom corner <B1-Motion>
+ # @parm Int x - Absolute X coordinate
+ # @parm Int y - Absolute Y coordinate
+ # @return void
+ public method resize_B1_motion {x y} {
+ set _x $x
+ set _y $y
+ incr x $click_X
+ incr y $click_Y
+
+ if {$x < 200 || $_x > $max_X} {
+ set x [winfo width $win]
+ }
+ if {$y < 200 || $_y > $max_Y} {
+ set y [winfo height $win]
+ }
+ place $win -width $x -height $y
+ }
+
+ ## Change drawing mode
+ # @parm Char mode - New mode
+ # A - Arrow
+ # C - Eraser
+ # T - Insert text
+ # O - Oval
+ # R - Rectangle
+ # L - Line
+ # P - Pencil
+ # I - Insert image
+ # M - Move canvas
+ # @return void
+ public method change_mode {mode} {
+ # Local variables
+ set drawing_mode_org $drawing_mode
+
+ # Object variables
+ set drawing_mode $mode
+
+ # Bring toolbar buttons to default states
+ foreach w [list \
+ $mode_pen_but $mode_line_but $mode_arrow_but \
+ $mode_rectangle_but $mode_oval_but $mode_text_but \
+ $mode_clear_but $load_image_but $move_but \
+ ] {
+ $w configure -style Notes_Flat.TButton
+ }
+
+ # Switch drawing mode
+ set w {}
+ switch -- $drawing_mode {
+ A { ;# Arrow
+ $canvas_widget configure -cursor cross
+ set w $mode_arrow_but
+ }
+ C { ;# Eraser
+ $canvas_widget configure -cursor left_ptr
+ set w $mode_clear_but
+ }
+ T { ;# Insert text
+ if {[prompt_for_text]} {
+ $canvas_widget configure -cursor cross
+ set w $mode_text_but
+ } {
+ if {$drawing_mode_org == {T}} {
+ set drawing_mode_org {M}
+ }
+ change_mode $drawing_mode_org
+ }
+ }
+ O { ;# Draw oval
+ $canvas_widget configure -cursor cross
+ set w $mode_oval_but
+ }
+ R { ;# Draw rectangle
+ $canvas_widget configure -cursor cross
+ set w $mode_rectangle_but
+ }
+ L { ;# Draw line
+ $canvas_widget configure -cursor cross
+ set w $mode_line_but
+ }
+ P { ;# Pencil
+ $canvas_widget configure -cursor pencil
+ set w $mode_pen_but
+ }
+ I { ;# Insert image
+ $canvas_widget configure -cursor cross
+ set w $load_image_but
+ }
+ M { ;# Move canvas
+ $canvas_widget configure -cursor fleur
+ set w $move_but
+ }
+ }
+
+ # Highlight toolbar button belonging to the selected mode
+ if {$w != {}} {
+ $w configure -style Notes.TButton
+ }
+ }
+
+ ## (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 -padx 2 -pady 2
+ place $win -height [expr {[lindex $geometry 3] + 2}]
+ }
+ $coll_exp_but configure -image ::ICONS::16::$image
+ }
+
+ ## Create popup menu
+ # @return void
+ private method create_popup_menu {} {
+ if {$popup_menu_created} {return}
+ set popup_menu_created 1
+
+ set menu $canvas_widget.menu
+ menuFactory $MENU $menu 0 "$this " 0 {}
+ }
+
+ ## Popup menu
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @parm Int X - Absolute X coordinate
+ # @parm Int Y - Absolute Y coordinate
+ # @return void
+ public method popup_menu {x y X Y} {
+ create_popup_menu
+ set ::Notes::__mode $drawing_mode
+ set ::Notes::_menu_x $x
+ set ::Notes::_menu_y $y
+
+ tk_popup $menu $X $Y
+ focus $title_label
+ }
+
+ ## Zoom in canvas contents from the specified coordinates
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_zoom_in {x y} {
+ $canvas_widget scale all $x $y 1.5 1.5
+ }
+
+ ## Zoom out canvas contents from the specified coordinates
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_zoom_out {x y} {
+ $canvas_widget scale all $x $y 0.75 0.75
+ }
+
+ ## Zoom in canvas contents (from popup menu)
+ # @return void
+ public method canvas_zoom_in_from_pmenu {} {
+ canvas_zoom_in $::Notes::_menu_x $::Notes::_menu_y
+ }
+
+ ## Zoom out canvas contents (from popup menu)
+ # @return void
+ public method canvas_zoom_out_from_pmenu {} {
+ canvas_zoom_out $::Notes::_menu_x $::Notes::_menu_y
+ }
+
+ ## Create notepad window
+ # @return void
+ private method create_win {} {
+ # Create window frame
+ set win [frame .notes$count -bd 1 -relief raised -bg $bgcolor]
+
+ ## Create title bar
+ # - Title bar frame
+ set title_bar [frame $win.title_bar -bg $bgcolor]
+ set title_label [label $title_bar.text \
+ -bg $bgcolor -compound left \
+ -text [mc "Scribble notepad"] \
+ -image ::ICONS::16::pencil \
+ -pady 0 \
+ ]
+ # - Button "Close"
+ set close_button [ttk::button $title_bar.close_but \
+ -style Notes_Flat.TButton \
+ -command "$this close" \
+ -image ::ICONS::16::button_cancel \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $title_bar.close_but -text [mc "Close"]
+ setStatusTip -widget $close_button -text [mc "Close"]
+ # - Button "Shade"
+ set coll_exp_but [ttk::button $title_bar.col_exp_but \
+ -style Notes_Flat.TButton \
+ -command "$this collapse_expand" \
+ -image ::ICONS::16::_1uparrow \
+ -takefocus 0 \
+ ]
+ DynamicHelp::add $title_bar.col_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 $title_label -side left -fill x -pady 0 -ipady 0 -expand 1
+ pack $close_button -side right -pady 0 -ipady 0 -padx 3
+ # Set title bar event bindings
+ bind $title_label <Double-1> "$this collapse_expand"
+ bind $title_label <Button-1> "$this title_B1 %X %Y"
+ bind $title_label <B1-Motion> "$this title_B1_motion %X %Y"
+ bind $title_label <ButtonRelease-1> "$this title_B1_release"
+
+ ## Create main frame
+ set main_frame [frame $win.main_frame -bg $bgcolor2]
+ set canvas_widget [canvas $main_frame.canvas \
+ -bg $bgcolor2 -highlightthickness 0 \
+ -width 0 -height 0 -bd 0 \
+ ]
+ bind $canvas_widget <Button-1> "$this canvas_B1 %x %y"
+ bind $canvas_widget <B1-Motion> "$this canvas_B1_motion %x %y"
+ bind $canvas_widget <Motion> "$this canvas_motion %x %y"
+ bind $canvas_widget <ButtonRelease-1> "$this canvas_B1_release %x %y"
+ bind $canvas_widget <ButtonRelease-3> "$this popup_menu %x %y %X %Y"
+ bind $canvas_widget <Leave> "$this canvas_leave"
+ bind $canvas_widget <Enter> "$this canvas_enter %x %y"
+
+ bind $canvas_widget <Button-4> "$this canvas_zoom_in %x %y"
+ bind $canvas_widget <Button-5> "$this canvas_zoom_out %x %y"
+
+ ## Create bottom frame
+ # Create the frame
+ set bottom_frame [frame $main_frame.bottom_frame -bg $bgcolor]
+ # - Resizing corner
+ pack [label $bottom_frame.resize \
+ -bg $bgcolor -cursor lr_angle \
+ -image ::ICONS::16::corner \
+ ] -side right
+ # - Set event bindings for the resizing corner
+ bind $bottom_frame.resize <Button-1> "$this resize_B1"
+ bind $bottom_frame.resize <B1-Motion> "$this resize_B1_motion %X %Y"
+ # - Button "Pencil"
+ set mode_pen_but [ttk::button $bottom_frame.mode_pen_but \
+ -command "$this change_mode P" \
+ -image ::ICONS::16::pencil \
+ ]
+ DynamicHelp::add $bottom_frame.mode_pen_but -text [mc "Pencil"]
+ setStatusTip -widget $mode_pen_but -text [mc "Pencil"]
+ pack $mode_pen_but -side left -ipady 0
+ # - Button "Line"
+ set mode_line_but [ttk::button $bottom_frame.mode_line_but \
+ -command "$this change_mode L" \
+ -image ::ICONS::16::line \
+ ]
+ DynamicHelp::add $bottom_frame.mode_line_but -text [mc "Line"]
+ setStatusTip -widget $mode_line_but -text [mc "Draw lines"]
+ pack $mode_line_but -side left -ipady 0
+ # - Button "Arrow"
+ set mode_arrow_but [ttk::button $bottom_frame.mode_arrow_but \
+ -command "$this change_mode A" \
+ -image ::ICONS::16::arr \
+ ]
+ DynamicHelp::add $bottom_frame.mode_arrow_but -text [mc "Arrow"]
+ setStatusTip -widget $mode_arrow_but -text [mc "Draw arrows"]
+ pack $mode_arrow_but -side left -ipady 0
+ # - Button "Retangle"
+ set mode_rectangle_but [ttk::button $bottom_frame.mode_rectangle_but \
+ -command "$this change_mode R" \
+ -image ::ICONS::16::grid1 \
+ ]
+ DynamicHelp::add $bottom_frame.mode_rectangle_but -text [mc "Retangle"]
+ setStatusTip -widget $mode_rectangle_but -text [mc "Draw retangles"]
+ pack $mode_rectangle_but -side left -ipady 0
+ # - Button "Oval"
+ set mode_oval_but [ttk::button $bottom_frame.mode_oval_but \
+ -command "$this change_mode O" \
+ -image ::ICONS::16::oval \
+ ]
+ DynamicHelp::add $bottom_frame.mode_oval_but -text [mc "Oval"]
+ setStatusTip -widget $mode_oval_but -text [mc "Draw ovals"]
+ pack $mode_oval_but -side left -ipady 0
+ # - Button "Insert text"
+ set mode_text_but [ttk::button $bottom_frame.mode_text_but \
+ -command "$this change_mode T" \
+ -image ::ICONS::16::editclear \
+ ]
+ DynamicHelp::add $bottom_frame.mode_text_but -text [mc "Insert text"]
+ setStatusTip -widget $mode_text_but -text [mc "Insert text"]
+ pack $mode_text_but -side left -ipady 0
+ # - Button "Move"
+ set move_but [ttk::button $bottom_frame.move_but \
+ -command "$this change_mode M" \
+ -image ::ICONS::16::mouse \
+ ]
+ DynamicHelp::add $bottom_frame.move_but -text [mc "Move"]
+ setStatusTip -widget $move_but -text [mc "Move"]
+ pack $move_but -side left -ipady 0
+ # - Button "Eraser"
+ set mode_clear_but [ttk::button $bottom_frame.mode_clear_but \
+ -command "$this change_mode C" \
+ -image ::ICONS::16::eraser \
+ ]
+ DynamicHelp::add $bottom_frame.mode_clear_but -text [mc "Eraser"]
+ setStatusTip -widget $mode_clear_but -text [mc "Eraser"]
+ pack $mode_clear_but -side left -ipady 0
+ # - Button "Select color"
+ set select_color_but [button $bottom_frame.select_color_but \
+ -command "$this select_color" \
+ -bd 1 -relief raised -overrelief raised \
+ -activebackground $selected_color \
+ -bg $selected_color -pady 0 \
+ ]
+ DynamicHelp::add $bottom_frame.select_color_but -text [mc "Select color"]
+ setStatusTip -widget $select_color_but -text [mc "Select color"]
+ pack $select_color_but -side right -ipady 0 -pady 0 -padx 8
+ # - Button "Insert image"
+ set load_image_but [ttk::button $bottom_frame.load_image_but \
+ -command "$this load_image" \
+ -image ::ICONS::16::fileimport \
+ ]
+ DynamicHelp::add $bottom_frame.load_image_but -text [mc "Insert image"]
+ setStatusTip -widget $load_image_but -text [mc "Insert image"]
+ pack $load_image_but -side right -ipady 0
+ # - Button "Clear all"
+ set clear_all_but [ttk::button $bottom_frame.clear_all_but \
+ -command "$this canvas_clear_all" \
+ -image ::ICONS::16::emptytrash \
+ ]
+ DynamicHelp::add $bottom_frame.clear_all_but -text [mc "Clear all"]
+ setStatusTip -widget $clear_all_but -text [mc "Clear all"]
+ pack $clear_all_but -side right -ipady 0
+ # - Separator
+ pack [ttk::separator $bottom_frame.sep0 \
+ -orient vertical \
+ ] -fill y -padx 5 -side right
+ # Restore default states of buttons on the bottom bar
+ foreach w [list \
+ $mode_pen_but $mode_line_but $mode_arrow_but \
+ $mode_rectangle_but $mode_oval_but $mode_text_but \
+ $mode_clear_but $load_image_but $clear_all_but \
+ $move_but \
+ ] {
+ $w configure -style Notes_Flat.TButton
+ }
+
+ # Pack all components of the window
+ pack $title_bar -fill x
+ pack $canvas_widget -fill both -expand 1
+ pack $bottom_frame -fill x -side bottom
+ pack $main_frame -fill both -expand 1 -padx 2 -pady 2
+
+ # Set default drawing mode
+ change_mode P
+
+ # Show the window
+ bind $win <Visibility> "$this raise_win"
+ place $win \
+ -x [lindex $geometry 0] \
+ -y [lindex $geometry 1] \
+ -width [lindex $geometry 2] \
+ -height [lindex $geometry 3] \
+ -anchor nw
+ raise $win
+ }
+
+ ## 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
+ }
+
+ ## Prompt user for text to insert to the canvas
+ # @return void
+ private method prompt_for_text {} {
+ set ::Notes::text_prompt_text {}
+ set dialog [toplevel .notes_pd -bg {#EEEEEE}]
+
+ ## Create top frame
+ set frame [frame $dialog.frm]
+ # - Label "Text"
+ pack [label $frame.lbl \
+ -text [mc "Text:"] \
+ ] -side left
+ # - EntryBox
+ set entry [ttk::entry $frame.text_entry \
+ -textvariable ::Notes::text_prompt_text \
+ -width 30 \
+ ]
+ # Pack them
+ pack $entry -side left -fill x -expand 1
+ pack $frame -padx 5 -pady 5 -fill x -expand 1
+ # Set events bindings
+ bind $entry <Return> "
+ grab release $dialog
+ destroy $dialog
+ "
+ bind $entry <Escape> "
+ set ::Notes::text_prompt_text {}
+ grab release $dialog
+ destroy $dialog
+ "
+
+ ## Create bottom frame
+ set frame [frame $dialog.frm_b]
+ # - Button "Cancel"
+ pack [ttk::button $dialog.cancel_button \
+ -compound left \
+ -image ::ICONS::16::button_cancel \
+ -text [mc "Cancel"] \
+ -command "
+ set ::Notes::text_prompt_text {}
+ grab release $dialog
+ destroy $dialog
+ " \
+ ] -side right
+ # - Button "Ok"
+ pack [ttk::button $dialog.ok_button \
+ -compound left \
+ -image ::ICONS::16::ok \
+ -text [mc "Ok"] \
+ -command "
+ grab release $dialog
+ destroy $dialog
+ " \
+ ] -side right
+ pack $frame -pady 5 -padx 5 -fill x
+
+ wm title $dialog [mc "Enter text"]
+ wm transient $dialog .
+ wm geometry $dialog =250x70+[expr {[winfo screenwidth $win] / 2 - 250}]+[expr {[winfo screenheight $win] / 2 - 70}]
+ update
+ focus -force $entry
+ grab $dialog
+ raise $dialog
+ tkwait window $dialog
+
+ set text_to_write ${::Notes::text_prompt_text}
+ return [string length $text_to_write]
+ }
+
+ ## Event handler: canvas <Enter>
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_enter {x y} {
+ switch -- $drawing_mode {
+ T { ;# Insert text
+ $canvas_widget create text $x $y -text $text_to_write -anchor w -tags incomplete -font $canvas_text_font -fill $selected_color
+ }
+ I { ;# Import image
+ $canvas_widget create image $x $y -image $loaded_image -tags incomplete
+ }
+ }
+ }
+
+ ## Event handler: canvas <Button-1>
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_B1 {x y} {
+ set click_X $x
+ set click_Y $y
+
+ switch -- $drawing_mode {
+ C { ;# Eraser
+ set flag_modified 1
+ $canvas_widget create rectangle \
+ [expr {$x - 10}] [expr {$y - 10}] \
+ [expr {$x + 10}] [expr {$y + 10}] \
+ -outline $bgcolor2 -fill $bgcolor2
+ }
+ T { ;# Insert text
+ set flag_modified 1
+ $canvas_widget dtag incomplete incomplete
+ $canvas_widget create text $x $y -text $text_to_write -anchor w -tags incomplete -font $canvas_text_font -fill $selected_color
+ }
+ I { ;# Import image
+ set flag_modified 1
+ $canvas_widget dtag incomplete incomplete
+ $canvas_widget create image $x $y -image $loaded_image -tags incomplete
+ }
+ }
+
+ focus $canvas_widget
+ }
+
+ ## Event handler: canvas <Motion>
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_motion {x y} {
+ switch -- $drawing_mode {
+ C { ;# Eraser
+ $canvas_widget delete incomplete
+ $canvas_widget create rectangle \
+ [expr {$x - 10}] [expr {$y - 10}] \
+ [expr {$x + 10}] [expr {$y + 10}] \
+ -tag incomplete -outline #FF0000
+ }
+ T { ;# Insert text
+ $canvas_widget coords incomplete $x $y
+ }
+ I { ;# Import image
+ $canvas_widget coords incomplete $x $y
+ }
+ }
+ }
+
+ ## Event handler: canvas <B1-Motion>
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_B1_motion {x y} {
+ $canvas_widget delete incomplete
+ switch -- $drawing_mode {
+ C { ;# Eraser
+ set flag_modified 1
+ $canvas_widget create rectangle \
+ [expr {$x - 10}] [expr {$y - 10}] \
+ [expr {$x + 10}] [expr {$y + 10}] \
+ -outline $bgcolor2 -fill $bgcolor2
+ $canvas_widget create rectangle \
+ [expr {$x - 10}] [expr {$y - 10}] \
+ [expr {$x + 10}] [expr {$y + 10}] \
+ -tag incomplete -outline #FF0000
+ }
+ T { ;# Insert text
+ if {![llength [$canvas_widget find withtag incomplete]]} {
+ $canvas_widget create text $x $y -text $text_to_write -anchor w -tags incomplete -font $canvas_text_font -fill $selected_color
+ }
+ $canvas_widget coords incomplete $x $y
+ }
+ O { ;# Draw oval
+ $canvas_widget create oval $click_X $click_Y $x $y -tag incomplete -dash {_} -outline $selected_color
+ }
+ R { ;# Draw rectangle
+ $canvas_widget create rectangle $click_X $click_Y $x $y -tag incomplete -dash {_} -outline $selected_color
+ }
+ L { ;# Draw line
+ $canvas_widget create line $click_X $click_Y $x $y -tag incomplete -dash {_} -fill $selected_color
+ }
+ P { ;# Pencil
+ set flag_modified 1
+ $canvas_widget create line $click_X $click_Y $x $y -fill $selected_color
+ set click_X $x
+ set click_Y $y
+ }
+ A { ;# Draw arrow
+ $canvas_widget create line $click_X $click_Y $x $y -tag incomplete -dash {_} -arrow last -fill $selected_color
+ }
+ I { ;# Import image
+ if {![llength [$canvas_widget find withtag incomplete]]} {
+ $canvas_widget create image $x $y -image $loaded_image -tags incomplete
+ }
+ $canvas_widget coords incomplete $x $y
+ }
+ M { ;# Move canvas
+ $canvas_widget move all [expr {$x - $click_X}] [expr {$y - $click_Y}]
+
+ set click_X $x
+ set click_Y $y
+ }
+ }
+ }
+
+ ## Event handler: canvas <ButtonRelease-1>
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method canvas_B1_release {x y} {
+ switch -- $drawing_mode {
+ O { ;# Draw oval
+ set flag_modified 1
+ $canvas_widget itemconfigure incomplete -dash {} -outline $selected_color
+ $canvas_widget dtag incomplete incomplete
+ }
+ R { ;# Draw rectangle
+ set flag_modified 1
+ $canvas_widget itemconfigure incomplete -dash {} -outline $selected_color
+ $canvas_widget dtag incomplete incomplete
+ }
+ L { ;# Draw line
+ set flag_modified 1
+ $canvas_widget itemconfigure incomplete -dash {} -fill $selected_color
+ $canvas_widget dtag incomplete incomplete
+ }
+ A { ;# Draw arrow
+ set flag_modified 1
+ $canvas_widget itemconfigure incomplete -dash {} -fill $selected_color
+ $canvas_widget dtag incomplete incomplete
+ }
+ }
+ }
+
+ ## Event handler: canvas <Leave>
+ # @return void
+ public method canvas_leave {} {
+ $canvas_widget delete incomplete
+ }
+
+ ## Completely clear the canvas
+ # @return void
+ public method canvas_clear_all {} {
+ if {[tk_messageBox \
+ -parent . \
+ -type yesno \
+ -icon question \
+ -title [mc "Are you sure ?"] \
+ -message [mc "Do you really want to clear this notepad\n(there is no undo action)"] \
+ ] != {yes}} {
+ return
+ }
+ $canvas_widget delete all
+ }
+
+ ## Select drawing color
+ # @return void
+ public method select_color {} {
+ set color [SelectColor .select_color \
+ -parent . \
+ -color $selected_color \
+ -title [mc "Select color"] \
+ ]
+
+ if {$color != {}} {
+ set selected_color $color
+ $select_color_but configure -bg $color -activebackground $color
+ }
+ }
+
+ ## Select image file to import
+ # @return void
+ public method load_image {} {
+ catch {delete object ::fsd}
+
+ set directory {}
+ catch {
+ set directory [$::X::actualProject cget -projectPath]
+ }
+
+ KIFSD::FSD ::fsd \
+ -directory $directory \
+ -title [mc "Insert image from file"] \
+ -defaultmask 0 -multiple 0 -filetypes {
+ {{PNG files} {*.png}}
+ {{All files} {*}}
+ }
+
+ ::fsd setokcmd "$this load_image_file \[::fsd get\]"
+ ::fsd activate
+ }
+
+ ## Import image from file
+ # @parm String file - Full file name
+ # @return void
+ public method load_image_file {file} {
+ set loaded_image {}
+ if {[catch {
+ set loaded_image [image create photo -file $file]
+ }]} {
+ tk_messageBox \
+ -title [mc "Unable to read file"] \
+ -type ok -icon warning \
+ -message [mc "Unable to read file:\n%s" $file]
+ return
+ }
+
+ if {$loaded_image != {}} {
+ change_mode I
+ }
+ }
+}
diff --git a/lib/utilities/rs232debugger.tcl b/lib/utilities/rs232debugger.tcl
new file mode 100755
index 0000000..dacb8d5
--- /dev/null
+++ b/lib/utilities/rs232debugger.tcl
@@ -0,0 +1,1460 @@
+#!/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 RS232/UART debugger
+# --------------------------------------------------------------------------
+
+class RS232Debugger {
+ ## COMMON
+ common count 0 ;# Int: Counter of class instances
+ # Font: Big bold font
+ common bold_font [font create \
+ -family {helvetica} \
+ -size -12 -weight {bold} \
+ ]
+ # Font: Tiny normal font
+ common tiny_font [font create \
+ -family {helvetica} \
+ -size -9 -weight {normal} \
+ ]
+ # Font: Tiny bold font
+ common tiny_font_bold [font create \
+ -family {helvetica} \
+ -size -9 -weight {bold} \
+ ]
+ # Font: Normal font
+ common normal_font [font create \
+ -family {helvetica} \
+ -size -11 -weight {normal} \
+ ]
+ # Font: Also normal font, but a bit larger
+ common big_font [font create \
+ -family {helvetica} \
+ -size -12 -weight {normal} \
+ ]
+ # Int: Pool interval for selected RS232 interface
+ common POOL_INTERVAL 50 ;# mili-seconds
+ # List of Int: Available baud rates for RS232
+ common available_baud_rates {
+ 50 75 110 134 150 200
+ 300 600 1200 1800 2400 4800
+ 9600 19200 38400 57600 115200 230400
+ 460800
+ }
+
+ # List: Configuration list
+ common config_list $::CONFIG(RS232_DEBUGGER)
+
+
+ ## PRIVATE
+ private variable obj_idx ;# Int: Object index
+ private variable win ;# Widget: Dialog window
+ private variable connector_canvas ;# Widget: Canvas widget displaying the DE-9 connector
+ private variable port_combobox ;# Widget: Combobox for device file selection
+ private variable status_bar_label ;# Widget: Status bar
+
+ private variable baud_cb ;# Widget: ComboBox for selecting baud rate
+ private variable parity_cb ;# Widget: ComboBox for selecting type of parity
+ private variable data_cb ;# Widget: ComboBox for selecting number of data bits
+ private variable stop_cb ;# Widget: ComboBox for selecting number of stop bits
+ private variable enable_reception_chb ;# Widget: Check button "Enable reception"
+ private variable close_connection_button ;# Widget: Button "Close connection"
+
+ private variable leds ;# Array of CanvasObjects: LEDs indicating logical states on wires
+ private variable dtr_button ;# Widget: Button "DTR"
+ private variable rts_button ;# Widget: Button "RTS"
+ private variable break_button ;# Widget: Button "Break"
+
+ private variable send_selected_button ;# Widget: Button "Send selected"
+ private variable clear_selected_rec_button ;# Widget: Button "Clear selected" in section "Receive"
+ private variable receive_here_button ;# Widget: Button "Receive here"
+ private variable clear_selected_snd_button ;# Widget: Button "Clear selected" in section "Send"
+ private variable receive_hexeditor ;# Object: Hexeditor intented for reception
+ private variable send_hexeditor ;# Object: Hexeditor intented for sending
+
+ private variable pool_timer {} ;# Object: Pool timer object
+ private variable channel {} ;# Channel: Opened device file
+ private variable port_filename {} ;# String: Device file name
+ private variable reception_address 0 ;# Int: Address in reception hexeditor where received data are stored
+ private variable reception_enabled 1 ;# Bool: Reception enabled
+ private variable prev_tty_status ;# List: Previous TTY status (before any action performed by this code)
+
+ private variable baud_conf {9600} ;# Int: Selected baud rate for communication
+ private variable parity_conf {n} ;# Char: Selected type of parity
+ private variable data_conf {8} ;# Int: Number of data bits
+ private variable stop_conf {1} ;# Int: Number of stop bits
+
+
+ ## Object constructor
+ constructor {} {
+ # Configure local ttk styles
+ ttk::style configure RS232Debugger_FileInUse.TCombobox \
+ -fieldbackground {#DDFFDD}
+ ttk::style map RS232Debugger_FileInUse.TCombobox \
+ -fieldbackground [list {readonly !readonly} {#DDFFDD}]
+
+ ttk::style configure RS232Debugger_FileFound.TCombobox \
+ -fieldbackground {#FFFFAA}
+ ttk::style map RS232Debugger_FileFound.TCombobox \
+ -fieldbackground [list {readonly !readonly} {#FFFFAA}]
+
+ ttk::style configure RS232Debugger_FileNotFound.TCombobox \
+ -fieldbackground {#FFDDDD}
+ ttk::style map RS232Debugger_FileNotFound.TCombobox \
+ -fieldbackground [list {readonly !readonly} {#FFDDDD}]
+
+ ttk::style configure RS232Debugger_SignalAllDefault.TButton \
+ -foreground {#000000} \
+ -background {#DDDDDD}
+ ttk::style map RS232Debugger_SignalAllDefault.TButton \
+ -background [list active {#EEEEEE}]
+
+ ttk::style configure RS232Debugger_SignalTxDTrue.TButton \
+ -background {#AAFFAA} \
+ -foreground {#000000}
+ ttk::style map RS232Debugger_SignalTxDTrue.TButton \
+ -background [list active {#DDFFDD}] \
+ -foreground [list active {#00FF00}]
+
+ ttk::style configure RS232Debugger_SignalNormalTrue.TButton \
+ -background {#AAFFAA} \
+ -foreground {#000000}
+ ttk::style map RS232Debugger_SignalNormalTrue.TButton \
+ -background [list active {#DDFFDD}] \
+ -foreground [list active {#00FF00}]
+
+ ttk::style configure RS232Debugger_SignalTxDFalse.TButton \
+ -background {#DDDDDD} \
+ -foreground {#000000}
+ ttk::style map RS232Debugger_SignalTxDFalse.TButton \
+ -background [list active {#EEEEEE}] \
+ -foreground [list active {#000000}]
+
+ ttk::style configure RS232Debugger_SignalNormalFalse.TButton \
+ -background {#FFAAAA} \
+ -foreground {#000000}
+ ttk::style map RS232Debugger_SignalNormalFalse.TButton \
+ -background [list active {#FFDDDD}] \
+ -foreground [list active {#FF0000}]
+
+
+ incr count
+ set obj_idx $count
+
+ array set prev_tty_status {0 {} cts {} dsr {} ri {} dcd {} dtr {} rts {} break {}}
+
+ # Validate and possibly correct configuration list
+ if {[lsearch -ascii -exact $available_baud_rates [lindex $config_list 0]] == -1} {
+ puts stderr [mc "RS232 DBG: Invalid baud rate, setting to default: %s" $baud_conf]
+ lset config_list 0 $baud_conf
+ }
+ if {[lsearch -ascii -exact {n o e m s} [lindex $config_list 1]] == -1} {
+ puts stderr [mc "RS232 DBG: Invalid parity, setting to default: %s" $parity_conf]
+ lset config_list 1 $parity_conf
+ }
+ if {[lsearch -ascii -exact {5 6 7 8} [lindex $config_list 2]] == -1} {
+ puts stderr [mc "RS232 DBG: Invalid data length, setting to default: %s" $data_conf]
+ lset config_list 2 $data_conf
+ }
+ if {[lsearch -ascii -exact {1 2} [lindex $config_list 3]] == -1} {
+ puts stderr [mc "RS232 DBG: Invalid stop bit length, setting to default: %s" $stop_conf]
+ lset config_list 3 $stop_conf
+ }
+ if {[lsearch -ascii -exact {0 1} [lindex $config_list 4]] == -1} {
+ puts stderr [mc "RS232 DBG: Invalid flag reception_enabled, setting to default: %s" $reception_enabled]
+ lset config_list 4 $reception_enabled
+ }
+ if {![string is digit -strict [lindex $config_list 9]] || [lindex $config_list 9] < 0 || [lindex $config_list 9] > 256} {
+ puts ">> {[lindex $config_list 9]}"
+ puts stderr [mc "RS232 DBG: Invalid reception address, setting to default: %s" $reception_address]
+ lset config_list 9 $reception_address
+ }
+ if {![string is digit -strict [lindex $config_list 7]] || [lindex $config_list 7] < 0 || [lindex $config_list 7] > 255} {
+ puts stderr [mc "RS232 DBG: Invalid current cell address, setting to default: %s" "0"]
+ lset config_list 7 0
+ }
+ if {![string is digit -strict [lindex $config_list 8]] || [lindex $config_list 8] < 0 || [lindex $config_list 8] > 255} {
+ puts stderr [mc "RS232 DBG: Invalid current cell address, setting to default: %s" "0"]
+ lset config_list 8 0
+ }
+
+ # Load configuration list
+ set baud_conf [lindex $config_list 0]
+ set parity_conf [lindex $config_list 1]
+ set data_conf [lindex $config_list 2]
+ set stop_conf [lindex $config_list 3]
+ set reception_enabled [lindex $config_list 4]
+ set reception_address [expr {int([lindex $config_list 9])}]
+ if {$reception_address == 256} {
+ set reception_address 0
+ }
+
+ # Initialize GUI
+ create_gui
+ set_tty_controls_state 0
+
+ # Restore data displayed in hexeditors
+ foreach idx {5 6} hexedit [list $receive_hexeditor $send_hexeditor] {
+ set data [lindex $config_list $idx]
+ if {![llength $data]} {
+ continue
+ }
+
+ for {set i 0} {$i < 0x100} {incr i} {
+ $hexedit setValue $i [lindex $data $i]
+ }
+ }
+
+ # restore addresses of current cells in hexeditors
+ $receive_hexeditor setCurrentCell [lindex $config_list 7]
+ $send_hexeditor setCurrentCell [lindex $config_list 8]
+ }
+
+ ## Object destructor
+ destructor {
+ # Create a new configuration list
+ set config_list [list \
+ $baud_conf $parity_conf $data_conf \
+ $stop_conf $reception_enabled \
+ [$receive_hexeditor get_values 0 255] \
+ [$send_hexeditor get_values 0 255] \
+ [$receive_hexeditor getCurrentCell] \
+ [$send_hexeditor getCurrentCell] \
+ $reception_address \
+ ]
+
+ # Cancel pool timer
+ catch {after cancel $pool_timer}
+
+ # Close opended channel
+ if {$channel !={}} {
+ catch {fileevent $channel readable {}}
+ catch {close $channel}
+ }
+
+ # Destroy GUI
+ destroy $win
+ }
+
+ ## Create dialog GUI
+ # @return void
+ private method create_gui {} {
+ # Create window
+ set win [toplevel .rs232debugger$count -class [mc "RS232 Debugger"] -bg {#EEEEEE}]
+
+ # Create status bar
+ set status_bar_label [label $win.status_bar_label -justify left -pady 0 -anchor w]
+ pack $status_bar_label -side bottom -fill x
+
+ # Create top frame
+ set top_frame [frame $win.top_frame]
+ create_top_frame $top_frame
+ pack $top_frame -fill x -anchor nw
+
+ # Create bottom frame
+ set bottom_frame [frame $win.bottom_frame]
+ create_bottom_frame $bottom_frame
+ pack $bottom_frame -fill x -anchor nw
+
+ $receive_hexeditor clearBgHighlighting 0
+ $receive_hexeditor set_bg_hg $reception_address 1 0
+
+ # Configure window
+ wm title $win [mc "UART/RS232 Debugger - MCU 8051 IDE"]
+ wm iconphoto $win ::ICONS::16::chardevice
+ wm resizable $win 0 0
+ wm protocol $win WM_DELETE_WINDOW "catch {delete object $this}"
+ }
+
+ ## Set status bar tip for specified widget
+ # @parm Widget widget - Target widget
+ # @parm String text - Text of the stutus tip
+ # @return void
+ private method set_status_tip {widget text} {
+ bind $widget <Enter> "$status_bar_label configure -text {$text}"
+ bind $widget <Leave> "$status_bar_label configure -text {}"
+ }
+
+ ## Draw DE-9 connector in the $connector_canvas
+ # @parm Int x - X offset
+ # @parm Int y - Y offset
+ # @return void
+ private method draw_connector {x y} {
+ ## Draw package
+ set coords {
+ 1 19 3 16 27 1 33 1 37 6 37 88
+ 33 91 27 91 3 80 1 74 1 19
+ }
+
+ # Transform coordinates -- adjust them to the given origin
+ set coordinates [list]
+ set len [llength $coords]
+ for {set m 0; set n 1} {$n < $len} {incr m 2; incr n 2} {
+ lappend coordinates \
+ [expr {[lindex $coords $m] + $x}]
+ lappend coordinates \
+ [expr {[lindex $coords $n] + $y}]
+ }
+
+ $connector_canvas create line $coordinates \
+ -tags connector -width 1 -fill #000000
+
+ ## Draw pins
+ set coords {
+ 28 16 28 32 28 48 28 64 28 80
+ 12 24 12 40 12 56 12 72
+ }
+ set tags {dcd_pin rxd_pin txd_pin dtr_pin gnd_pin dsr_pin rts_pin cts_pin ri_pin}
+
+ # Transform coordinates -- adjust them to the given origin
+ set len [llength $coords]
+ for {set m 0; set n 1; set i 0} {$n < $len} {incr m 2; incr n 2; incr i} {
+ $connector_canvas create oval \
+ [expr {[lindex $coords $m] - 2 + $x}] \
+ [expr {[lindex $coords $n] - 2 + $y}] \
+ [expr {[lindex $coords $m] + 2 + $x}] \
+ [expr {[lindex $coords $n] + 2 + $y}] \
+ -tags connector -width 1 \
+ -outline #000000 -tags [lindex $tags $i]
+ }
+
+ ## Draw pin numbers
+ set coords {
+ 21 16 21 32 21 48 21 64 21 80
+ 5 24 5 40 5 56 5 72
+ }
+ set tags {{} dcd_num rxd_num txd_num dtr_num gnd_num dsr_num rts_num cts_num ri_num}
+
+ # Transform coordinates -- adjust them to the given origin
+ set len [llength $coords]
+ for {set m 0; set n 1; set i 1} {$n < $len} {incr m 2; incr n 2; incr i} {
+ $connector_canvas create text \
+ [expr {[lindex $coords $m] + $x}] \
+ [expr {[lindex $coords $n] + $y}] \
+ -tags connector -fill #000000 \
+ -anchor center -justify center -text $i \
+ -font $tiny_font -tags [lindex $tags $i]
+ }
+
+ ## Draw common ground
+ set coords {
+ 31 80 60 80 60 105 53 105 67 105
+ }
+
+ # Transform coordinates -- adjust them to the given origin
+ set coordinates [list]
+ set len [llength $coords]
+ for {set m 0; set n 1} {$n < $len} {incr m 2; incr n 2} {
+ lappend coordinates \
+ [expr {[lindex $coords $m] + $x}]
+ lappend coordinates \
+ [expr {[lindex $coords $n] + $y}]
+ }
+
+ $connector_canvas create line $coordinates \
+ -tags gnd_wire -width 1 -fill #000000
+
+ $connector_canvas bind gnd_wire <Enter> "$this wire_enter gnd"
+ $connector_canvas bind gnd_wire <Leave> "$this wire_leave gnd"
+
+ ## Write texts
+ $connector_canvas create text \
+ [expr {$x + 10}] [expr {$y - 25}] \
+ -anchor n -justify left \
+ -font $big_font -text [mc "RS-232\nDTE"]
+ $connector_canvas create text \
+ [expr {$x + 10}] [expr {$y + 100}] \
+ -anchor n -justify left \
+ -font $big_font -text [mc "DE-9"]
+ }
+
+ ## Draw wires, LEDs and buttons in the $connector_canvas
+ # @parm Int x - X offset
+ # @parm Int y - Y offset
+ # @return void
+ private method draw_wires_and_controls {x y} {
+ ## DCD
+ set leds(dcd) [label $connector_canvas.dcd_led \
+ -image ::ICONS::16::ledgray \
+ ]
+ bind $leds(dcd) <Enter> "$this wire_enter dcd"
+ bind $leds(dcd) <Leave> "$this wire_leave dcd"
+ $connector_canvas create window \
+ [expr {$x + 100}] [expr {$y + 1}] \
+ -anchor center -window $leds(dcd)
+ $connector_canvas create line \
+ [expr {$x + 31}] [expr {$y + 16}] \
+ [expr {$x + 100}] [expr {$y + 16}] \
+ [expr {$x + 100}] [expr {$y + 1}] \
+ -width 1 -fill {#888888} -tags dcd_wire
+ $connector_canvas create line \
+ [expr {$x + 74}] [expr {$y + 16}] \
+ [expr {$x + 75}] [expr {$y + 16}] \
+ -width 1 -fill {#888888} -tags dcd_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 100}] [expr {$y - 7}] \
+ -tags connector -fill #000000 \
+ -anchor s -justify left -text [mc "DCD"]\
+ -font $normal_font
+
+ ## DSR
+ set leds(dsr) [label $connector_canvas.dsr_led \
+ -image ::ICONS::16::ledgray \
+ ]
+ bind $leds(dsr) <Enter> "$this wire_enter dsr"
+ bind $leds(dsr) <Leave> "$this wire_leave dsr"
+ $connector_canvas create window \
+ [expr {$x + 135}] [expr {$y + 1}] \
+ -anchor center -window $leds(dsr)
+
+ $connector_canvas create line \
+ [expr {$x + 15}] [expr {$y + 24}] \
+ [expr {$x + 135}] [expr {$y + 24}] \
+ [expr {$x + 135}] [expr {$y + 1}] \
+ -width 1 -fill {#888888} -tags dsr_wire
+ $connector_canvas create line \
+ [expr {$x + 74}] [expr {$y + 24}] \
+ [expr {$x + 75}] [expr {$y + 24}] \
+ -width 1 -fill {#888888} -tags dsr_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 135}] [expr {$y - 7}] \
+ -tags connector -fill #000000 \
+ -anchor s -justify left -text [mc "DSR"]\
+ -font $normal_font
+
+ ## CTS
+ set leds(cts) [label $connector_canvas.cts_led \
+ -image ::ICONS::16::ledgray \
+ ]
+ bind $leds(cts) <Enter> "$this wire_enter cts"
+ bind $leds(cts) <Leave> "$this wire_leave cts"
+ $connector_canvas create window \
+ [expr {$x + 170}] [expr {$y + 1}] \
+ -anchor center -window $leds(cts)
+
+ $connector_canvas create line \
+ [expr {$x + 15}] [expr {$y + 56}] \
+ [expr {$x + 170}] [expr {$y + 56}] \
+ [expr {$x + 170}] [expr {$y + 1}] \
+ -width 1 -fill {#888888} -tags cts_wire
+ $connector_canvas create line \
+ [expr {$x + 74}] [expr {$y + 56}] \
+ [expr {$x + 75}] [expr {$y + 56}] \
+ -width 1 -fill {#888888} -tags cts_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 170}] [expr {$y - 7}] \
+ -tags connector -fill #000000 \
+ -anchor s -justify left -text [mc "CTS"]\
+ -font $normal_font
+
+ ## RI
+ set leds(ri) [label $connector_canvas.ri_led \
+ -image ::ICONS::16::ledgray \
+ ]
+ bind $leds(ri) <Enter> "$this wire_enter ri"
+ bind $leds(ri) <Leave> "$this wire_leave ri"
+ $connector_canvas create window \
+ [expr {$x + 205}] [expr {$y + 1}] \
+ -anchor center -window $leds(ri)
+
+ $connector_canvas create line \
+ [expr {$x + 15}] [expr {$y + 72}] \
+ [expr {$x + 205}] [expr {$y + 72}] \
+ [expr {$x + 205}] [expr {$y + 1}] \
+ -width 1 -fill {#888888} -tags ri_wire
+ $connector_canvas create line \
+ [expr {$x + 74}] [expr {$y + 72}] \
+ [expr {$x + 75}] [expr {$y + 72}] \
+ -width 1 -fill {#888888} -tags ri_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 205}] [expr {$y - 7}] \
+ -tags connector -fill #000000 \
+ -anchor s -justify left -text [mc "RI"] \
+ -font $normal_font
+
+
+ ## DTR
+ set dtr_button [ttk::button $connector_canvas.dtr_button \
+ -style RS232Debugger_SignalAllDefault.TButton \
+ -command "$this invert_tty_status_bit dtr" \
+ -text "-" \
+ -width 2 \
+ ]
+ bind $dtr_button <Enter> "$this wire_enter dtr"
+ bind $dtr_button <Leave> "$this wire_leave dtr"
+ $connector_canvas create window \
+ [expr {$x + 100}] [expr {$y + 95}] \
+ -anchor center -window $dtr_button
+
+ $connector_canvas create line \
+ [expr {$x + 31}] [expr {$y + 64}] \
+ [expr {$x + 100}] [expr {$y + 64}] \
+ [expr {$x + 100}] [expr {$y + 95}] \
+ -width 1 -fill {#888888} -tags dtr_wire
+ $connector_canvas create line \
+ [expr {$x + 46}] [expr {$y + 64}] \
+ [expr {$x + 45}] [expr {$y + 64}] \
+ -width 1 -fill {#888888} -tags dtr_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 100}] [expr {$y + 105}] \
+ -tags connector -fill #000000 \
+ -anchor n -justify left -text [mc "DTR"]\
+ -font $normal_font
+
+ ## RTS
+ set rts_button [ttk::button $connector_canvas.rts_button \
+ -style RS232Debugger_SignalAllDefault.TButton \
+ -command "$this invert_tty_status_bit rts" \
+ -text "-" \
+ -width 2 \
+ ]
+ bind $rts_button <Enter> "$this wire_enter rts"
+ bind $rts_button <Leave> "$this wire_leave rts"
+ $connector_canvas create window \
+ [expr {$x + 135}] [expr {$y + 95}] \
+ -anchor center -window $rts_button
+
+ $connector_canvas create line \
+ [expr {$x + 15}] [expr {$y + 40}] \
+ [expr {$x + 135}] [expr {$y + 40}] \
+ [expr {$x + 135}] [expr {$y + 95}] \
+ -width 1 -fill {#888888} -tags rts_wire
+ $connector_canvas create line \
+ [expr {$x + 46}] [expr {$y + 40}] \
+ [expr {$x + 45}] [expr {$y + 40}] \
+ -width 1 -fill {#888888} -tags rts_wire \
+ -arrow last
+ $connector_canvas create text \
+ [expr {$x + 135}] [expr {$y + 105}] \
+ -tags connector -fill #000000 \
+ -anchor n -justify left -text [mc "RTS"]\
+ -font $normal_font
+
+ ## TxD
+ set break_button [ttk::button $connector_canvas.break_button \
+ -style RS232Debugger_SignalAllDefault.TButton \
+ -command "$this invert_tty_status_bit break" \
+ -text [mc "Break"] \
+ -width 5 \
+ ]
+ bind $break_button <Enter> "$this wire_enter txd"
+ bind $break_button <Leave> "$this wire_leave txd"
+ $connector_canvas create window \
+ [expr {$x + 180}] [expr {$y + 95}] \
+ -anchor center -window $break_button
+
+ $connector_canvas create line \
+ [expr {$x + 31}] [expr {$y + 48}] \
+ [expr {$x + 180}] [expr {$y + 48}] \
+ [expr {$x + 180}] [expr {$y + 95}] \
+ -width 1 -fill {#0000FF} -tags txd_wire
+ $connector_canvas create line \
+ [expr {$x + 46}] [expr {$y + 48}] \
+ [expr {$x + 45}] [expr {$y + 48}] \
+ -width 1 -fill {#0000FF} -tags txd_wire \
+ -arrow last
+ $connector_canvas create line \
+ [expr {$x + 180}] [expr {$y + 120}] \
+ [expr {$x + 180}] [expr {$y + 105}] \
+ -width 1 -fill {#0000FF} -arrow last
+
+ ## RxD
+ $connector_canvas create line \
+ [expr {$x + 31}] [expr {$y + 32}] \
+ [expr {$x + 220}] [expr {$y + 32}] \
+ [expr {$x + 220}] [expr {$y + 90}] \
+ [expr {$x + 250}] [expr {$y + 120}] \
+ -width 1 -fill {#0000FF} -tags rxd_wire \
+ -arrow last
+ $connector_canvas create line \
+ [expr {$x + 74}] [expr {$y + 32}] \
+ [expr {$x + 75}] [expr {$y + 32}] \
+ -width 1 -fill {#0000FF} -tags rxd_wire \
+ -arrow last
+
+ foreach wire {dcd dsr cts ri dtr rts txd rxd} {
+ $connector_canvas bind ${wire}_wire <Enter> "$this wire_enter $wire"
+ $connector_canvas bind ${wire}_wire <Leave> "$this wire_leave $wire"
+ }
+ }
+
+ ## Create top frame in the dialog window (connector_canvas (left) and configuration (right))
+ # @parm Widget target_frame - Parent frame
+ # @return void
+ private method create_top_frame {target_frame} {
+
+ #
+ ## Connector canvas
+ #
+
+ # Create canvas widget
+ set connector_canvas [canvas $target_frame.canvas \
+ -width 280 -height 150 -bg {#EEEEEE} \
+ -bd 0 -relief flat -highlightthickness 0 \
+ ]
+ pack $connector_canvas -side left -anchor sw
+
+ # Fill in the connector canvas
+ draw_connector 20 30
+ draw_wires_and_controls 20 30
+
+
+
+ #
+ ## Configuration frame
+ #
+
+ # Create labelframe
+ set conf_frame [ttk::labelframe $target_frame.conf_frame\
+ -padding 5 \
+ -labelwidget [label $target_frame.conf_label \
+ -font $bold_font \
+ -compound left \
+ -text [mc "Port configuration"] \
+ -image ::ICONS::16::configure \
+ ] \
+ ]
+ pack $conf_frame -side left -anchor nw
+ # - Physical port
+ grid [label $conf_frame.port_lbl \
+ -text [mc "Physical port"] \
+ ] -row 1 -column 1 -sticky w
+ set port_combobox [ttk::combobox $conf_frame.port_cb \
+ -width 12 \
+ -validate all \
+ -validatecommand "$this port_combobox_validate %P" \
+ -exportselection 0 \
+ ]
+ bind $port_combobox <<ComboboxSelected>> \
+ "$this port_combobox_accept"
+ bind $port_combobox <Return> "$this port_combobox_accept"
+ bind $port_combobox <KP_Enter> "$this port_combobox_accept"
+
+ port_combobox_refresh
+ grid $port_combobox -row 1 -column 2 -sticky w
+ set_status_tip $port_combobox [mc "Special character file representing the target physical device"]
+ grid [ttk::button $conf_frame.port_combobox_refresh_button \
+ -image ::ICONS::16::reload \
+ -command "$this port_combobox_refresh" \
+ -style Flat.TButton \
+ ] -row 1 -column 3 -sticky w
+ set_status_tip $conf_frame.port_combobox_refresh_button [mc "Refresh list of relevant devices"]
+ # - Baud rate
+ grid [label $conf_frame.baud_lbl \
+ -text [mc "Baud rate"] \
+ ] -row 3 -column 1 -sticky w
+ set baud_cb [ttk::combobox $conf_frame.baud_cb \
+ -state readonly \
+ -width 6 \
+ -exportselection 0 \
+ -values $available_baud_rates \
+ ]
+ bind $baud_cb <<ComboboxSelected>> \
+ "$this change_port_config b \[$conf_frame.baud_cb get\]"
+ set_status_tip $baud_cb [mc "Connection speed in bps"]
+ grid $baud_cb -row 3 -column 2 -sticky w
+ $conf_frame.baud_cb current [lsearch [$conf_frame.baud_cb cget -values] $baud_conf]
+ # - Parity
+ grid [label $conf_frame.parity_lbl \
+ -text [mc "Parity"] \
+ ] -row 4 -column 1 -sticky w
+ set parity_cb [ttk::combobox $conf_frame.parity_cb \
+ -values {none odd even mark space} \
+ -state readonly \
+ -width 6 \
+ -exportselection 0 \
+ ]
+ bind $parity_cb <<ComboboxSelected>> \
+ "$this change_port_config p \[$conf_frame.parity_cb get\]"
+ set_status_tip $parity_cb [mc "Parity"]
+ grid $parity_cb -row 4 -column 2 -sticky w
+ $conf_frame.parity_cb current [lsearch {n o e m s} $parity_conf]
+ # - Data bits
+ grid [label $conf_frame.data_lbl \
+ -text [mc "Data bits"] \
+ ] -row 5 -column 1 -sticky w
+ set data_cb [ttk::combobox $conf_frame.data_cb \
+ -state readonly \
+ -width 1 \
+ -values {5 6 7 8} \
+ -exportselection 0 \
+ ]
+ bind $data_cb <<ComboboxSelected>> \
+ "$this change_port_config d \[$conf_frame.data_cb get\]"
+ set_status_tip $data_cb [mc "Number of data bits"]
+ grid $data_cb -row 5 -column 2 -sticky w
+ $conf_frame.data_cb current [lsearch [$conf_frame.data_cb cget -values] $data_conf]
+ # - Stop bits
+ grid [label $conf_frame.stop_lbl \
+ -text [mc "Stop bits"] \
+ ] -row 6 -column 1 -sticky w
+ set stop_cb [ttk::combobox $conf_frame.stop_cb \
+ -state readonly \
+ -width 1 \
+ -values {1 2} \
+ -exportselection 0 \
+ ]
+ bind $stop_cb <<ComboboxSelected>> \
+ "$this change_port_config s \[$conf_frame.stop_cb get\]"
+ set_status_tip $stop_cb [mc "Number of stop bits"]
+ grid $stop_cb -row 6 -column 2 -sticky w
+ $conf_frame.stop_cb current [lsearch [$conf_frame.stop_cb cget -values] $stop_conf]
+ # Bottom frame in configuration frame
+ set bottom_frame [frame $conf_frame.bottom_frame]
+ # - Enable reception
+ set enable_reception_chb [checkbutton $bottom_frame.enable_reception_chb\
+ -text [mc "Enable reception"] -onvalue 1 -offvalue 0 \
+ -command "$this reception_ena_dis" \
+ -variable "::RS232Debugger::enable_reception${obj_idx}" \
+ ]
+ set_status_tip $enable_reception_chb [mc "Display incoming data or discard them"]
+ set ::RS232Debugger::enable_reception${obj_idx} $reception_enabled
+ pack $enable_reception_chb -side left
+ # - Close connection
+ set close_connection_button [ttk::button \
+ $bottom_frame.close_connection_button \
+ -text [mc "Close"] \
+ -compound left \
+ -width 5 \
+ -image ::ICONS::16::fileclose \
+ -command "$this safely_terminate_connection" \
+ ]
+ set_status_tip $close_connection_button [mc "Terminate connection"]
+ pack $close_connection_button -side right -padx 5
+
+ grid $bottom_frame -row 7 -column 1 -sticky we -columnspan 3
+ }
+
+ ## Create bottom frame (hexadecimal editors)
+ # @parm Widget target_frame - Parent frame
+ # @return void
+ private method create_bottom_frame {target_frame} {
+ # Create headers ("Data to send", "Received data")
+ grid [label $target_frame.lbl_a \
+ -text [mc "Data to send"] \
+ -compound right \
+ -image ::ICONS::16::forward \
+ -padx 15 -font $bold_font \
+ ] -row 0 -column 1 -columnspan 2
+ grid [label $target_frame.lbl_b \
+ -text [mc "Received data"] \
+ -compound left \
+ -image ::ICONS::16::forward \
+ -padx 15 -font $bold_font \
+ ] -row 0 -column 3 -columnspan 2
+
+ # Create hexadecimal editors
+ set send_hexeditor [HexEditor #auto \
+ $target_frame.send_hexeditor 8 32 2 \
+ hex 1 1 5 256 \
+ ]
+ [$send_hexeditor getLeftView] configure -exportselection 0
+ $send_hexeditor bindSelectionAction "$this hexeditor_selection s"
+ grid $target_frame.send_hexeditor -row 1 -column 1 -columnspan 2
+
+ set receive_hexeditor [HexEditor #auto \
+ $target_frame.receive_hexeditor 8 32 2 \
+ hex 1 1 5 256 \
+ ]
+ [$send_hexeditor getLeftView] configure -exportselection 0
+ $receive_hexeditor bindSelectionAction "$this hexeditor_selection r"
+ grid $target_frame.receive_hexeditor -row 1 -column 3 -columnspan 2
+
+ # Create buttons "Send selected" and "Clear selected" in send part
+ set send_selected_button [ttk::button \
+ $target_frame.send_selected_button \
+ -text [mc "Send selected"] \
+ -image ::ICONS::16::forward \
+ -command "$this send_selected" \
+ -compound left \
+ -state disabled \
+ ]
+ set clear_selected_snd_button [ttk::button \
+ $target_frame.clear_selected_snd_button \
+ -text [mc "Clear selected"] \
+ -image ::ICONS::16::eraser \
+ -command "$this clear_selected_snd" \
+ -compound left \
+ -state disabled \
+ ]
+ set_status_tip $send_selected_button [mc "Send selected data"]
+ set_status_tip $clear_selected_snd_button [mc "Remove selected data"]
+ grid $send_selected_button -row 2 -column 1 -sticky we
+ grid $clear_selected_snd_button -row 2 -column 2 -sticky we
+
+ # Create buttons "Receive here" and "Clear selected" in reception part
+ set receive_here_button [ttk::button \
+ $target_frame.receive_here_button \
+ -text [mc "Receive here"] \
+ -image ::ICONS::16::down0 \
+ -command "$this receive_here" \
+ -compound left \
+ ]
+ set clear_selected_rec_button [ttk::button \
+ $target_frame.clear_selected_rec_button \
+ -text [mc "Clear selected"] \
+ -image ::ICONS::16::eraser \
+ -command "$this clear_selected_rec" \
+ -compound left \
+ -state disabled \
+ ]
+ set_status_tip $receive_here_button [mc "Receive data on current cursor position"]
+ set_status_tip $clear_selected_rec_button [mc "Remove selected data"]
+ grid $receive_here_button -row 2 -column 3 -sticky we
+ grid $clear_selected_rec_button -row 2 -column 4 -sticky we
+ }
+
+ ## Accept new device file
+ # @return void
+ public method port_combobox_accept {} {
+ change_port_file [$port_combobox get]
+ }
+
+ ## Validate contetnts of port combo box
+ # @parm String content - String to validate
+ # @return Bool - Allways true
+ public method port_combobox_validate {content} {
+ # Empty string
+ if {![string length $content]} {
+ $port_combobox configure -style TCombobox
+ return 1
+ }
+
+ # Exiting file
+ if {[file exists $content]} {
+ if {$port_filename == $content} {
+ $port_combobox configure -style RS232Debugger_FileInUse.TCombobox
+ } {
+ $port_combobox configure -style RS232Debugger_FileFound.TCombobox
+ }
+ # Not exiting file
+ } else {
+ $port_combobox configure -style RS232Debugger_FileNotFound.TCombobox
+ }
+
+ return 1
+ }
+
+ ## Refresh list of possible values on port combobox
+ # @return void
+ public method port_combobox_refresh {} {
+ if {!$::MICROSOFT_WINDOWS} { ;# POSIX way
+ $port_combobox configure -values \
+ [lsort -decreasing \
+ [glob -directory {/dev} -nocomplain -type {c} -- {tty{S,USB}*}] \
+ ]
+
+ } else { ;# Microsoft Widnows way
+ set available_ms_windows_ports [list]
+
+ for {set i 0} {$i < 10} {incr i} {
+ if {[file exists "COM${i}"]} {
+ lappend available_ms_windows_ports "COM${i}"
+ }
+ }
+
+ $port_combobox configure -values $available_ms_windows_ports
+ }
+ }
+
+ ## Change current device file
+ # @parm String filename - Path to the new device file
+ # @return void
+ private method change_port_file {filename} {
+ # File name is the same at the one already in use -> abort
+ if {$port_filename == $filename} {
+ return
+ }
+
+ # Safely terminate current connection
+ set channel_prev $channel
+ safely_terminate_connection
+ if {$channel_prev != {}} {
+ catch {
+ close $channel_prev
+ }
+ }
+
+ ## Try to open the device file
+ if {[catch {
+ if {!$::MICROSOFT_WINDOWS} { ;# POSIX way
+ set channel [open $filename {RDWR BINARY NONBLOCK}]
+ } { ;# MS Windows does not support NONBLOCK
+ set channel [open $filename {RDWR BINARY}]
+ }
+
+ # -> Fail
+ } reason]} then {
+ safely_terminate_connection
+ after idle "
+ set reason {$reason}
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon error \
+ -title {[mc {Access Error}]} \
+ -message \"[mc {Unable to open the specified file}]\n\n\${reason}\""
+ # -> Success
+ } else {
+ # Try to configure opened channel acording to specified parameters
+ if {[catch {
+ fconfigure $channel \
+ -handshake none \
+ -buffersize 0 \
+ -mode $baud_conf,$parity_conf,$data_conf,$stop_conf
+
+ fileevent $channel readable "$this receive_data"
+
+ set pool_timer [after $POOL_INTERVAL "catch {$this pool_ttystatus}"]
+ set_tty_controls_state 1
+
+ # -> Fail
+ } reason]} then {
+ safely_terminate_connection
+ after idle "
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon error \
+ -title {[mc {Access Error}]} \
+ -message \"[mc {Unable to use the specified file}]\""
+ # -> Success
+ } else {
+ $port_combobox configure -style RS232Debugger_FileInUse.TCombobox
+ set port_filename $filename
+ }
+ }
+ }
+
+ ## Modify comlink attributes
+ # @parm Char what - Attribute ID
+ # @parm String value - Attribute value
+ # @return void
+ public method change_port_config {what value} {
+ switch -- $what {
+ {b} { ;# Baud rate
+ set baud_conf $value
+ }
+ {p} { ;# Parity bit
+ switch -- $value {
+ {none} {
+ set value {n}
+ }
+ {odd} {
+ set value {o}
+ }
+ {even} {
+ set value {e}
+ }
+ {mark} {
+ set value {m}
+ }
+ {space} {
+ set value {s}
+ }
+ }
+ set parity_conf $value
+ }
+ {d} { ;# Data bits
+ set data_conf $value
+ }
+ {s} { ;# Stop bits
+ set stop_conf $value
+ }
+ }
+
+ # Cancel if there is no channel opened
+ if {$channel == {}} {
+ return
+ }
+
+ # Change channel configuration
+ if {[catch {
+ fconfigure $channel -mode $baud_conf,$parity_conf,$data_conf,$stop_conf
+ } reason]} {
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon error \
+ -title [mc "Uknown failure"] \
+ -message [mc "Unable to change port configuration"]
+ }
+ }
+
+ ## Handle selection event in hexeditor
+ # @parm Char editor - Editor ID
+ # @parm Bool anything_selected - 1 == anything selected; 0 == Nothing selected
+ # @return void
+ public method hexeditor_selection {editor anything_selected} {
+ if {$anything_selected} {
+ set state {normal}
+ } {
+ set state {disabled}
+ }
+
+ if {$editor == {s}} {
+ $send_selected_button configure -state $state
+ $clear_selected_snd_button configure -state $state
+ } {
+ $clear_selected_rec_button configure -state $state
+ }
+ }
+
+ ## Clear selected data in send hexeditor
+ # @return void
+ public method clear_selected_snd {} {
+ # Get range of text indexes determinating the selection
+ set rangeofselection [$send_hexeditor getRangeOfSelection]
+ if {$rangeofselection == {}} {
+ return
+ }
+
+ # Determinate index of the start and end cell
+ set start_cell [lindex $rangeofselection 0]
+ set end_cell [lindex $rangeofselection 1]
+
+ # Clear all selected cell one by one
+ for {set i $start_cell} {$i <= $end_cell} {incr i} {
+ $send_hexeditor setValue $i {}
+ }
+ }
+
+ ## Send selected data over RS232 interface
+ # @return void
+ public method send_selected {} {
+ # Get range of text indexes determinating the selection
+ set rangeofselection [$send_hexeditor getRangeOfSelection]
+ if {$rangeofselection == {}} {
+ return
+ }
+
+ # Abort if there was no channel opened
+ if {$channel == {}} {
+ tk_messageBox \
+ -parent $win \
+ -title [mc "IO Error"] \
+ -type ok -icon warning \
+ -message [mc "No port opened."]
+ return
+ }
+
+ # Generate binary data from the selected hexadecimal string
+ set data {}
+ set start_cell [lindex $rangeofselection 0]
+ set end_cell [lindex $rangeofselection 1]
+ foreach value [$send_hexeditor get_values $start_cell $end_cell] {
+ if {$value == {}} {
+ continue
+ }
+ append data [format %c $value]
+ }
+
+ # Send the generated binary data
+ if {[catch {
+ puts -nonewline $channel $data
+ flush $channel
+ } reason]} {
+ tk_messageBox \
+ -parent $win \
+ -title [mc "IO Error"] \
+ -type ok -icon warning \
+ -message [mc "Unable to send the data\n\n%s" $reason]
+ }
+ }
+
+ ## Change reception adddress to address of the current cell
+ # @return void
+ public method receive_here {} {
+ set cell [$receive_hexeditor getCurrentCell]
+ set reception_address $cell
+
+ $receive_hexeditor clearBgHighlighting 0
+ $receive_hexeditor set_bg_hg $cell 1 0
+ }
+
+ ## Receive data from the channel
+ # This function is trigered automatically by fileevent facitily
+ # @return void
+ public method receive_data {} {
+ # Read binary data
+ set data [read $channel]
+
+ # Discard the data if reception is not enabled
+ if {!$reception_enabled} {
+ return
+ }
+
+ # Check if the data has non zero length
+ if {![string length $data]} {
+ unknown_port_io_error
+ return
+ }
+
+ # Load the data into hexadecimal editor
+ set len [string bytelength $data]
+ $receive_hexeditor clearBgHighlighting 1
+ for {set i 0} {$i < $len} {incr i} {
+ if {$reception_address >= 256} {
+ receive_buffer_overflow_warning_dialog
+ break
+ }
+
+ scan [string index $data $i] %c byte
+ $receive_hexeditor setValue $reception_address $byte
+
+ incr reception_address
+ }
+ $receive_hexeditor set_bg_hg [expr {$reception_address - 1}] 1 1
+ $receive_hexeditor seeCell [expr {$reception_address - 1}]
+ }
+
+ ## Diaply dialog "Not enough space in the receive buffer !"
+ # @return void
+ private method receive_buffer_overflow_warning_dialog {} {
+ if {[winfo exists .data_lost_dialog]} {
+ return
+ }
+ set dialog [toplevel .data_lost_dialog -class [mc "Error message"] -bg {#EEEEEE}]
+
+ pack [label $dialog.label \
+ -font $bold_font -compound left -padx 5 \
+ -text [mc "Not enough space in the receive buffer !"] \
+ -image ::ICONS::22::stop \
+ ] -fill x -pady 5 -padx 5
+
+ pack [frame $dialog.frm] -pady 5
+ pack [ttk::button $dialog.frm.ok_button \
+ -text [mc "Ok"] \
+ -command "
+ grab release $dialog
+ destroy $dialog
+ " \
+ ] -side left
+
+ pack [ttk::separator $dialog.sep -orient horizontal] -fill x -pady 10
+ pack [checkbutton $dialog.enable_reception_chb \
+ -text [mc "Keep reception enabled"] -onvalue 1 -offvalue 0 \
+ -command "$this reception_ena_dis" \
+ -variable "::RS232Debugger::enable_reception${obj_idx}" \
+ ] -anchor w
+
+ # Set window attributes
+ wm iconphoto $dialog ::ICONS::16::status_unknown
+ wm title $dialog [mc "Data lost"]
+ wm resizable $dialog 0 0
+ wm transient $dialog $win
+ catch {grab $dialog}
+ wm protocol $dialog WM_DELETE_WINDOW "
+ grab release $dialog
+ destroy $dialog
+ "
+ raise $dialog
+ focus -force $dialog.frm.ok_button
+ tkwait window $dialog
+ }
+
+ ## Clear selected data in receive hexeditor
+ # @return void
+ public method clear_selected_rec {} {
+ set rangeofselection [$receive_hexeditor getRangeOfSelection]
+ if {$rangeofselection == {}} {
+ return
+ }
+
+ set start_cell [lindex $rangeofselection 0]
+ set end_cell [lindex $rangeofselection 1]
+
+ for {set i $start_cell} {$i <= $end_cell} {incr i} {
+ $receive_hexeditor setValue $i {}
+ }
+ }
+
+ ## Enable/Disable reception
+ # @return void
+ public method reception_ena_dis {} {
+ set reception_enabled [subst "\$::RS232Debugger::enable_reception${obj_idx}"]
+ }
+
+ ## Read TTY status from the interface and update GUI accordingly
+ # @return void
+ public method pool_ttystatus {} {
+ # Setup the pool timer
+ set pool_timer [after $POOL_INTERVAL "catch {$this pool_ttystatus}"]
+
+ # Read TTY status
+ if {[catch {
+ set ttystatus [fconfigure $channel -ttystatus]
+ }]} {
+ unknown_port_io_error
+ return
+ }
+
+ # Check whether any change occured
+ if {$prev_tty_status(0) == $ttystatus} {
+ return
+ } {
+ set prev_tty_status(0) $ttystatus
+ }
+
+ # Transform values read to these four variables:
+ set cts {}
+ set dsr {}
+ set ri {}
+ set dcd {}
+ set ts_len [llength $ttystatus]
+ for {set i 0; set j 1} {$i < $ts_len} {incr i 2; incr j 2} {
+ set key [lindex $ttystatus $i]
+ set val [lindex $ttystatus $j]
+
+ switch -- $key {
+ {CTS} {set cts $val}
+ {DSR} {set dsr $val}
+ {RING} {set ri $val}
+ {DCD} {set dcd $val}
+ }
+ }
+
+ # Update GUI accordingly
+ show_new_ttystatus $cts $dsr $ri $dcd
+ }
+
+ ## Show new TTY status in the GUI
+ # @parm Bool cts - CTS line state
+ # @parm Bool dsr - DSR line state
+ # @parm Bool ri - RI line state
+ # @parm Bool dcd - DCD line state
+ # @return void
+ private method show_new_ttystatus args {
+ foreach signal {cts dsr ri dcd} value $args {
+ if {$prev_tty_status($signal) == $value} {
+ continue
+ } {
+ set prev_tty_status($signal) $value
+ }
+
+ switch -- $value {
+ 0 {
+ set color {#FF0000}
+ set image ledred
+ }
+ 1 {
+ set color {#00FF00}
+ set image ledgreen
+ }
+ default {
+ set color {#888888}
+ set image ledgray
+ }
+ }
+
+ $connector_canvas itemconfigure ${signal}_wire -fill $color
+ $leds($signal) configure -image ::ICONS::16::$image
+ }
+ }
+
+ ## Report an unknown IO error occured on the interface
+ # Plus disable reception and safely terminate connection
+ # @return void
+ private method unknown_port_io_error {} {
+ # Disable reception
+ set reception_enabled 0
+ set ::RS232Debugger::enable_reception${obj_idx} 0
+
+ # Safely terminate connection
+ safely_terminate_connection
+ $port_combobox configure -style RS232Debugger_FileFound.TCombobox
+
+ # Display the error message
+ tk_messageBox \
+ -parent $win \
+ -title [mc "IO Error"] \
+ -type ok -icon warning \
+ -message [mc "There is something wrong with the port. Closing connection and disabling reception on this channel !"]
+
+ update
+ }
+
+ ## Safely terminate connection to the HW interface
+ # @return void
+ public method safely_terminate_connection {} {
+ catch {fileevent $channel readable {}}
+ catch {
+ after cancel $pool_timer
+ }
+ set prev_tty_status(0) {}
+ set channel {}
+ set port_filename {}
+
+ show_new_ttystatus {} {} {} {}
+ set_tty_controls_state 0
+ $port_combobox configure -style RS232Debugger_FileFound.TCombobox
+ }
+
+ ## Enable or disable TTY controls
+ # @parm Bool enabled - 1 == Enable; 0 == Disable
+ # @return void
+ private method set_tty_controls_state {enabled} {
+ if {$enabled} {
+ set state {normal}
+ set state2 {readonly}
+ set_tty_controls_to_defaults
+ } {
+ set state {disabled}
+ set state2 {disabled}
+ set_tty_controls_to_unknown_state
+ }
+
+ $dtr_button configure -state $state
+ $rts_button configure -state $state
+ $break_button configure -state $state
+
+ $enable_reception_chb configure -state $state
+ $close_connection_button configure -state $state
+
+ $baud_cb configure -state $state2
+ $parity_cb configure -state $state2
+ $data_cb configure -state $state2
+ $stop_cb configure -state $state2
+ }
+
+ ## Set tty controls to defaults
+ # @return void
+ private method set_tty_controls_to_defaults {} {
+ set_new_tty_status dtr 0
+ set_new_tty_status rts 0
+ set_new_tty_status break 0
+ }
+
+ ## Set tty controls to unknown state
+ # @return void
+ private method set_tty_controls_to_unknown_state {} {
+ set_new_tty_status dtr {}
+ set_new_tty_status rts {}
+ set_new_tty_status break {}
+ }
+
+ ## Invert tty status bit
+ # @parm String wire - Bit/Wire ID
+ # @return void
+ public method invert_tty_status_bit {wire} {
+ if {$prev_tty_status($wire) == {}} {
+ return
+ }
+
+ set_new_tty_status $wire [expr {!$prev_tty_status($wire)}]
+ }
+
+ ## Change color of the specified color
+ # @parm String wire - Wire ID
+ # @parm String value - New value (e.g. 0 or {})
+ # @return void
+ private method set_new_tty_status {wire value} {
+ set prev_tty_status($wire) $value
+
+ switch -- $value {
+ 0 { ;# Loical 0
+ if {$wire == {break}} {
+ [subst "\${${wire}_button}"] configure -text {Break} \
+ -style RS232Debugger_SignalTxDFalse.TButton
+ $connector_canvas itemconfigure txd_wire -fill {#0000FF}
+ } {
+ [subst "\${${wire}_button}"] configure -text {1} \
+ -style RS232Debugger_SignalNormalFalse.TButton
+ $connector_canvas itemconfigure ${wire}_wire -fill {#FF0000}
+ }
+ }
+ 1 { ;# Logical 1
+ if {$wire == {break}} {
+ [subst "\${${wire}_button}"] configure -text {BREAK} \
+ -style RS232Debugger_SignalTxDTrue.TButton
+ $connector_canvas itemconfigure txd_wire -fill {#00FF00}
+ } {
+ [subst "\${${wire}_button}"] configure -text {0} \
+ -style RS232Debugger_SignalNormalTrue.TButton
+ $connector_canvas itemconfigure ${wire}_wire -fill {#00FF00}
+ }
+ }
+ default { ;# Unknown state
+ if {$wire == {break}} {
+ [subst "\${${wire}_button}"] configure -text {Break} \
+ -style RS232Debugger_SignalAllDefault.TButton
+ $connector_canvas itemconfigure txd_wire -fill {#0000FF}
+ } {
+ [subst "\${${wire}_button}"] configure -text {-} \
+ -style RS232Debugger_SignalAllDefault.TButton
+ $connector_canvas itemconfigure ${wire}_wire -fill {#888888}
+ }
+ return
+ }
+ }
+
+ if {[catch {
+ fconfigure $channel -ttycontrol [list $wire $value]
+ }]} {
+ unknown_port_io_error
+ return
+ }
+ }
+
+ ## Handle "<Enter>" event on wire
+ # @parm String wire - Wire ID
+ # @return void
+ public method wire_enter {wire} {
+ $connector_canvas itemconfigure ${wire}_wire -width 2
+ $connector_canvas itemconfigure ${wire}_pin -fill {#000000}
+ $connector_canvas itemconfigure ${wire}_num -font $tiny_font_bold
+
+ set text {}
+ switch -- $wire {
+ {gnd} {set text [mc "RS232 pin: GND -- Common ground"]}
+ {dcd} {set text [mc "RS232 pin: DCD -- Carrier Detect"]}
+ {dsr} {set text [mc "RS232 pin: DSR -- Data Set Ready"]}
+ {cts} {set text [mc "RS232 pin: CTS -- Clear To Send"]}
+ {ri} {set text [mc "RS232 pin: RI -- Ring Indicator"]}
+ {dtr} {set text [mc "RS232 pin: DTR -- Data Terminal Ready"]}
+ {rts} {set text [mc "RS232 pin: RTS -- Request To Send"]}
+ {txd} {set text [mc "RS232 pin: TxD -- Transmitted Data"]}
+ {rxd} {set text [mc "RS232 pin: RxD -- Received Data"]}
+ }
+ $status_bar_label configure -text $text
+ }
+
+ ## Handle "<Leave>" event on wire
+ # @parm String wire - Wire ID
+ # @return void
+ public method wire_leave {wire} {
+ $connector_canvas itemconfigure ${wire}_wire -width 1
+ $connector_canvas itemconfigure ${wire}_pin -fill {#EEEEEE}
+ $connector_canvas itemconfigure ${wire}_num -font $tiny_font
+
+ $status_bar_label configure -text {}
+ }
+}
diff --git a/lib/utilities/speccalc.tcl b/lib/utilities/speccalc.tcl
new file mode 100755
index 0000000..67a9430
--- /dev/null
+++ b/lib/utilities/speccalc.tcl
@@ -0,0 +1,2390 @@
+#!/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 PARTMCULAR 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
+# Special calculator for computaions related to 8051 microcontroller
+# Functions:
+# * Timers preset (0, 1, 2)
+# * SPI
+# * Wait loops (code generation)
+# --------------------------------------------------------------------------
+
+class SpecCalc {
+ ## COMMON
+ common count 0 ;# Int: Counter of class instances
+ common diagram_counter 0 ;# Int: Counter of diagram dialogs instances
+ # List of pages descriptors for PagesManager
+ common page_list {
+ loops timer01 timer2 spi
+ }
+ # Configuration list
+ common config $::CONFIG(SPEC_CALC)
+
+ ## PRIVATE
+ private variable win ;# Widget: The dialog window
+ private variable obj_idx ;# Int: Object index
+ private variable pages_manager ;# Widget: PagesManager
+ private variable pages ;# Array of Widget: Pages in the PagesManager
+ private variable buttons ;# Array of Widget: Buttons to switch between pages
+ private variable widgets ;# Array of Widget: Widgets present in separate pages
+ private variable page_created ;# Array of Bool: Page GUI created
+
+ private variable status_bar ;# Widget: Left status bar (main)
+ private variable status_bar2 ;# Widget: Right status bar (complementary)
+
+ private variable calc_in_progress 0 ;# Bool: Calculation in progress
+
+ private variable active_page ;# String: ID of currently active page
+
+ ## Object constructor
+ constructor {} {
+ incr count
+ set obj_idx $count
+
+ # Configure ttk styles
+ ttk::style configure SpecCalc_RedBg.TCombobox -fieldbackground {#FFCCCC}
+
+ ttk::style configure SpecCalc_Flat.TButton -background {#FFFFFF} -padding 0 -borderwidth 1 -relief flat
+ ttk::style map SpecCalc_Flat.TButton -relief [list active raised] -background [list disabled {#EEEEEE} active {#EEEEFF}]
+
+ ttk::style configure SpecCalc_Spec.TButton -background {#CCCCFF} -padding 0
+ ttk::style map SpecCalc_Spec.TButton -background [list disabled {#EEEEEE} active {#DDDDFF}]
+
+ create_gui
+ }
+
+ ## Object destructor
+ destructor {
+ # Hide dialog window
+ wm withdraw $win
+ update
+
+ # Create configuration list
+ set config [list \
+ [list [$widgets(loops,time_ent) get] \
+ [$widgets(loops,time_cb) current] \
+ [$widgets(loops,clock_cb) get] \
+ [$widgets(loops,clock_type_cb) current] \
+ [$widgets(loops,reg_ent0) get] \
+ [$widgets(loops,reg_ent1) get] \
+ [$widgets(loops,reg_ent2) get] \
+ [$widgets(loops,reg_ent3) get] \
+ [$widgets(loops,reg_ent4) get] \
+ [$widgets(loops,reg_ent5) get] \
+ [$widgets(loops,reg_ent6) get] \
+ [$widgets(loops,reg_ent7) get] \
+ ] [list \
+ [$widgets(timer01,time_ent) get] \
+ [$widgets(timer01,time_cb) current] \
+ [$widgets(timer01,clock_cb) get] \
+ [$widgets(timer01,clock_type_cb) current] \
+ [$widgets(timer01,mode_cb) current] \
+ [$widgets(timer01,psc_cb) current] \
+ [subst "\${::SpecCalc::spec_chb_$obj_idx}"] \
+ ] [list \
+ [$widgets(timer2,time_ent) get] \
+ [$widgets(timer2,time_cb) current] \
+ [$widgets(timer2,clock_cb) get] \
+ [$widgets(timer2,clock_type_cb) current] \
+ [$widgets(timer2,mode_cb) current] \
+
+ ] [list \
+ [subst "\$::SpecCalc::timer2_clk_fosc_$obj_idx"]\
+ [subst "\$::SpecCalc::timer2_clk_freq_$obj_idx"]\
+ [subst "\$::SpecCalc::timer2_clk_x2_$obj_idx"] \
+ ] [list \
+ [wm geometry $win] \
+ $active_page \
+ ] [list \
+ [subst "\${::SpecCalc::double_chb_$obj_idx}"] \
+ [$widgets(spi,sck_ent00) get] \
+ ]
+ ]
+
+ # Destroy dialog window
+ destroy $win
+ }
+
+ ## Set status bar tip for certain widget
+ # @parm Widget widget - Some button or label ...
+ # @parm String text - Status tip
+ # @return void
+ private method set_status_tip {widget text} {
+ bind $widget <Enter> "$status_bar configure -fg black -text {$text}"
+ bind $widget <Leave> "$status_bar configure -text {}"
+ }
+
+ ## Show certain text on the right status bar for 10 seconds
+ # @parm String text - Text to display
+ # @return void
+ public method status_tip {text} {
+ $status_bar2 configure -text $text -fg red
+ after 10000 "catch {$status_bar2 configure -text {} -fg black}"
+ }
+
+ ## Create dialog GUI
+ # @return void
+ private method create_gui {} {
+ # Create dialog window and the main frame
+ set win [toplevel .spec_calc$count -class [mc "Special Calculator - MCU 8051 IDE"] -bg {#EEEEEE}]
+ set main_frame [frame $win.main_frame]
+
+ # Create status bar
+ set sbar_frame [frame $win.sbar_frame]
+ set status_bar [label $sbar_frame.status_bar \
+ -justify left -anchor w -padx 5 \
+ ]
+ # Create status bar
+ set status_bar2 [label $sbar_frame.status_bar2 \
+ -justify right -anchor w -padx 5 \
+ ]
+
+ # Create left frame
+ set left_frame [frame $main_frame.left_frame -bg white]
+ create_left_frame $left_frame
+ pack $left_frame -side left -fill y
+
+ # Create separator between left and right frame
+ pack [ttk::separator $main_frame.sep \
+ -orient vertical \
+ ] -side left -fill y
+
+ # Create right frame
+ set right_frame [frame $main_frame.right_frame]
+ create_right_frame $right_frame
+ pack $right_frame -side left -fill both -expand 1
+
+ # Pack status bar on the bottom
+ pack $sbar_frame -side bottom -fill x -anchor nw
+ pack $status_bar2 -side right -anchor ne
+ pack $status_bar -side left -fill x -anchor nw
+
+ # Pack the main frame
+ pack $main_frame -fill both -expand 1
+
+ wm title $win [mc "Special Calculator - MCU 8051 IDE"]
+ wm iconphoto $win ::ICONS::16::_blockdevice
+ wm minsize $win 400 350
+ wm protocol $win WM_DELETE_WINDOW "delete object $this"
+
+ if {[llength $config]} {
+ wm geometry $win [lindex $config {4 0}]
+ switch_page [lindex $config {4 1}]
+ } {
+ wm geometry $win 400x350
+ switch_page loops
+ }
+
+ # Create all pages when system "calms down"
+ after idle "catch {
+ foreach page {$page_list} {
+ update
+ $this create_page \$page
+ }
+ }"
+ }
+
+ ## Create left part of the GUI
+ # @parm Widget target_frame - Frame widget in which the GUI should be created
+ # @return void
+ private method create_left_frame {target_frame} {
+ foreach name {
+ {Loops} {Timer 0/1} {Timer 2} {SPI}
+ } icon {
+ fsview history history2 _kcmdf
+ } stip {
+ {}
+ {Calculate timer preset}
+ {Calculate timer preset}
+ {}
+ } page $page_list \
+ {
+ set buttons($page) [ttk::button $target_frame.${page}_button \
+ -image ::ICONS::22::$icon \
+ -text [mc $name] -compound top \
+ -command "$this switch_page $page" \
+ -style Flat.TButton \
+ ]
+ pack $buttons($page) -anchor n
+ set_status_tip $buttons($page) [mc $stip]
+ }
+ }
+
+ ## Create right part of the GUI
+ # @parm Widget target_frame - Frame widget in which the GUI should be created
+ # @return void
+ private method create_right_frame {target_frame} {
+ set pages_manager [PagesManager $target_frame.pages_manager -background {#eeeeee}]
+ pack $pages_manager -fill both -expand 1
+
+ foreach page $page_list {
+ set pages($page) [$pages_manager add $page]
+ set page_created($page) 0
+ }
+ }
+
+ ## Switch active page
+ # @parm String page - Page ID
+ # @return void
+ public method switch_page {page} {
+ if {!$page_created($page)} {
+ create_page $page
+ }
+ $pages_manager raise $page
+ foreach p $page_list {
+ $buttons($p) configure -style SpecCalc_Flat.TButton
+ }
+ $buttons($page) configure -style SpecCalc_Spec.TButton
+
+ set active_page $page
+ }
+
+ ## Create page for computing wait loops
+ # @return void
+ private method create_page_loops {} {
+ # Create frames
+ set page {loops}
+ set top_frame [frame $pages($page).top_frame]
+ set regs_frame [frame $pages($page).regs_frame]
+ set bottom_frame [frame $pages($page).bottom_frame]
+
+ # - Time
+ grid [label $top_frame.time_lbl \
+ -text [mc "Time"] \
+ ] -row 0 -column 0 -sticky w
+ set widgets(loops,time_ent) [ttk::entry $top_frame.time_ent \
+ -validatecommand "$this calc loops time_ent %P" \
+ -validate key \
+ -width 9 \
+ ]
+ grid $widgets(loops,time_ent) -row 0 -column 1 -sticky we
+ set widgets(loops,time_cb) [ttk::combobox $top_frame.time_cb \
+ -values {ns us ms s} \
+ -state readonly \
+ -width 7 \
+ ]
+ bind $widgets(loops,time_cb) <<ComboboxSelected>> \
+ "$this calc loops time_cb \[$top_frame.time_cb get\]"
+ grid $widgets(loops,time_cb) -row 0 -column 2 -sticky w
+ set_status_tip $widgets(loops,time_cb) [mc "Time unit"]
+
+ # - Clock
+ grid [label $top_frame.clock_lbl \
+ -text [mc "Clock \[kHz\]"] \
+ ] -row 1 -column 0 -sticky w
+ set widgets(loops,clock_cb) [ttk::combobox $top_frame.clock_cb \
+ -validate key \
+ -width 9 \
+ -validatecommand "$this calc loops clock_cb %P" \
+ -values {
+ 6000.0 11059.2 12000.0 14745.6
+ 16000.0 20000.0 24000.0 33000.0
+ } \
+ ]
+ set_status_tip $widgets(loops,clock_cb) [mc "MCU clock"]
+ grid $widgets(loops,clock_cb) -row 1 -column 1 -sticky we
+ set widgets(loops,clock_type_cb) [ttk::combobox \
+ $top_frame.clock_type_cb \
+ -values {{12 / MC} {6 / MC} {1 / MC}} \
+ -width 7 \
+ -state readonly \
+ ]
+ bind $widgets(loops,clock_type_cb) <<ComboboxSelected>> \
+ "$this calc loops clock_type_cb \[$top_frame.clock_type_cb get\]"
+ DynamicHelp::add $widgets(loops,clock_type_cb) \
+ -text [mc "Clock cycles per machine cycle\n 12 - Common 8051\n 6 - Core 51X2\n 1 - Single cycle core"]
+ set_status_tip $widgets(loops,clock_type_cb) [mc "Clock cycles per machine cycle"]
+ grid $widgets(loops,clock_type_cb) -row 1 -column 2 -sticky w
+
+ # - Registers to use
+ grid [label $regs_frame.regs_lbl \
+ -text [mc "Registers to use"] \
+ ] -row 0 -column 0 -columnspan 8 -sticky w
+ set i 0
+ foreach r {1 2} {
+ foreach c {0 2 4 6} {
+ grid [label $regs_frame.reg_lbl$i \
+ -text " $i:" \
+ ] -row $r -column $c -sticky e
+ incr c
+
+ set widgets(loops,reg_ent$i) [ttk::entry $regs_frame.reg_ent$i \
+ -validatecommand "$this calc loops reg_ent$i %P" \
+ -validate key \
+ -width 1 \
+ ]
+ grid $widgets(loops,reg_ent$i) -row $r -column $c -sticky we
+ grid columnconfigure $regs_frame $c -weight 1
+
+ incr i
+ }
+ }
+
+ # - Source code
+ set bottom_frame_t [frame $bottom_frame.top]
+ set bottom_frame_b [frame $bottom_frame.bottom]
+ pack [label $bottom_frame_t.label \
+ -text [mc "Source code:"] \
+ ] -side left
+ set widgets(loops,compute_but) [ttk::button $bottom_frame_t.comp_but \
+ -text [mc "Evaluate"] \
+ -compound left \
+ -image ::ICONS::16::exec \
+ -command "$this calc loops compute_but {}" \
+ ]
+ pack $widgets(loops,compute_but) -side right
+ set widgets(loops,copy_but) [ttk::button $bottom_frame_t.copy_but \
+ -text [mc "Copy"] \
+ -compound left \
+ -state disabled \
+ -image ::ICONS::16::editcopy \
+ -command "$this calc loops copy_but {}" \
+ ]
+ pack $widgets(loops,copy_but) -side right
+ set widgets(loops,results) [text $bottom_frame_b.text \
+ -state disabled -width 0 -height 0 -bg white \
+ -yscrollcommand "$bottom_frame_b.scrollbar set" \
+ -takefocus 1 -font [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -14 \
+ ] \
+ ]
+ ASMsyntaxHighlight::create_tags $widgets(loops,results) 14 $::DEFAULT_FIXED_FONT
+ bind $widgets(loops,results) <Button-1> "focus %W"
+ pack $widgets(loops,results) -fill both -expand 1 -side left
+ pack [ttk::scrollbar $bottom_frame_b.scrollbar \
+ -orient vertical \
+ -command "$widgets(loops,results) yview" \
+ ] -fill y -side right -after $widgets(loops,results)
+
+ pack $bottom_frame_t -fill x
+ pack $bottom_frame_b -fill both -expand 1
+
+ # Configure bindings
+ foreach w {time_ent time_cb clock_cb clock_type_cb compute_but} {
+ bind $widgets(loops,$w) <Return> "$this calc loops compute_but {}"
+ bind $widgets(loops,$w) <KP_Enter> "$this calc loops compute_but {}"
+ }
+ for {set i 0} {$i < 8} {incr i} {
+ bind $widgets(loops,reg_ent$i) <Return> "$this calc loops compute_but {}"
+ bind $widgets(loops,reg_ent$i) <KP_Enter> "$this calc loops compute_but {}"
+ }
+
+
+ # Create page header
+ pack [label $pages($page).header \
+ -text [mc "Create a wait loop"] \
+ -font [font create \
+ -family {helvetica} \
+ -size -17 \
+ -weight bold \
+ ] \
+ ] -pady 5
+ pack $top_frame -anchor nw
+ pack $regs_frame -anchor nw -fill x
+ pack [ttk::separator $pages($page).sep \
+ -orient horizontal \
+ ] -fill x -pady 5
+ pack $bottom_frame -anchor nw -fill both -expand 1
+
+ # Insert values from the last session
+ if {[llength $config]} {
+ $widgets(loops,time_ent) insert 0 [lindex $config {0 0}]
+ $widgets(loops,time_cb) current [lindex $config {0 1}]
+ $widgets(loops,clock_cb) delete 0 end
+ $widgets(loops,clock_cb) insert 0 [lindex $config {0 2}]
+ $widgets(loops,clock_type_cb) current [lindex $config {0 3}]
+
+ for {set i 0; set k 4} {$i < 8} {incr i; incr k} {
+ $widgets(loops,reg_ent$i) insert 0 [lindex $config [list 0 $k]]
+ }
+
+ } {
+ $widgets(loops,time_cb) current 1
+ $widgets(loops,clock_cb) current 2
+ $widgets(loops,clock_type_cb) current 0
+
+ for {set i 0} {$i < 8} {incr i} {
+ $widgets(loops,reg_ent$i) insert 0 "R$i"
+ }
+ }
+ }
+
+ ## Create page for computing timer 0/1 preset values
+ # @return void
+ private method create_page_timer01 {} {
+ # Create page frames
+ set page {timer01}
+ set top_frame [frame $pages($page).top_frame]
+ set bottom_frame [frame $pages($page).bottom_frame]
+
+ # - Time
+ grid [label $top_frame.time_lbl \
+ -text [mc "Time"] \
+ ] -row 0 -column 0 -sticky w
+ set widgets(timer01,time_ent) [ttk::entry $top_frame.time_ent \
+ -validatecommand "$this calc timer01 time_ent %P" \
+ -validate key \
+ -width 9 \
+ ]
+ grid $widgets(timer01,time_ent) -row 0 -column 1 -sticky we
+ set widgets(timer01,time_cb) [ttk::combobox $top_frame.time_cb \
+ -values {ns us ms s} \
+ -state readonly \
+ -width 7 \
+ ]
+ bind $widgets(timer01,time_cb) <<ComboboxSelected>> \
+ "$this calc timer01 time_cb \[$top_frame.time_cb get\]"
+ grid $widgets(timer01,time_cb) -row 0 -column 2 -sticky w
+ set_status_tip $widgets(timer01,time_cb) [mc "Time unit"]
+
+ # - Clock
+ grid [label $top_frame.clock_lbl \
+ -text [mc "Clock \[kHz\]"] \
+ ] -row 1 -column 0 -sticky w
+ set widgets(timer01,clock_cb) [ttk::combobox $top_frame.clock_cb\
+ -validate key \
+ -width 9 \
+ -validatecommand "$this calc timer01 clock_cb %P" \
+ -values {
+ 6000.0 11059.2 12000.0 14745.6
+ 16000.0 20000.0 24000.0 33000.0
+ } \
+ ]
+ set_status_tip $widgets(timer01,clock_cb) [mc "MCU clock"]
+ grid $widgets(timer01,clock_cb) -row 1 -column 1 -sticky we
+ set widgets(timer01,clock_type_cb) [ttk::combobox \
+ $top_frame.clock_type_cb \
+ -values {{12 / MC} {6 / MC} {1 / MC}} \
+ -width 7 \
+ -state readonly \
+ ]
+ bind $widgets(timer01,clock_type_cb) <<ComboboxSelected>> \
+ "$this calc timer01 clock_type_cb \[$top_frame.clock_type_cb get\]"
+ DynamicHelp::add $widgets(timer01,clock_type_cb) \
+ -text [mc "Clock cycles per machine cycle\n 12 - Common 8051\n 6 - Core 51X2\n 1 - Single cycle core"]
+ set_status_tip $widgets(timer01,clock_type_cb) [mc "Clock cycles per machine cycle"]
+ grid $widgets(timer01,clock_type_cb) -row 1 -column 2 -sticky w
+
+ # - Mode
+ grid [label $top_frame.mode_lbl \
+ -text [mc "Mode"] \
+ ] -row 2 -column 0 -sticky w
+ set widgets(timer01,mode_cb) [ttk::combobox $top_frame.mode_cb \
+ -width 18 \
+ -state readonly \
+ -values {
+ {0 - 13 bit}
+ {1 - 16 bit}
+ {2 - 8 bit auto r.}
+ } \
+ ]
+ bind $widgets(timer01,mode_cb) <<ComboboxSelected>> \
+ "$this calc timer01 mode_cb \[$top_frame.mode_cb get\]"
+ set_status_tip $widgets(timer01,mode_cb) [mc "Timer mode"]
+ grid $widgets(timer01,mode_cb) -row 2 -column 1 -sticky we -columnspan 2
+ grid [ttk::button $top_frame.show_diagram_button \
+ -image ::ICONS::16::info \
+ -style Flat.TButton \
+ -command "$this show_diagram timer01 {}" \
+ ] -row 2 -column 3 -sticky w
+ set_status_tip $top_frame.show_diagram_button [mc "Show functional block diagram"]
+
+ # - Enhanced timer/counter
+ set widgets(timer01,spec_chb) [checkbutton $top_frame.spec_chb \
+ -text [mc "Enhanced timer/counter"] -onvalue 1 -offvalue 0 \
+ -variable ::SpecCalc::spec_chb_$obj_idx \
+ -command "$this calc timer01 spec_chb \${::SpecCalc::spec_chb_$obj_idx}" \
+ ]
+ set_status_tip $widgets(timer01,spec_chb) [mc "Calculate for enhanced timers"]
+ grid $widgets(timer01,spec_chb) -row 3 -column 0 -sticky w -columnspan 3
+
+ # - PSC
+ set widgets(timer01,psc_lbl) [ \
+ label $top_frame.psc_lbl \
+ -text "PSC" \
+ ]
+ set widgets(timer01,psc_cb) [ttk::combobox $top_frame.psc_cb \
+ -values {0 1 2 3 4 5 6 7} \
+ -width 1 \
+ ]
+ bind $widgets(timer01,psc_cb) <<ComboboxSelected>> \
+ "$this calc timer01 psc_cb \[$top_frame.psc_cb get\]"
+ set_status_tip $widgets(timer01,psc_cb) [mc "The number of active bits in TL1 minus 1"]
+
+ ## Results ...
+ # Labels
+ grid [label $bottom_frame.res_lbl \
+ -text [mc "Results:"] \
+ ] -row 0 -column 0 -columnspan 3 -sticky w
+ grid [label $bottom_frame.th_l_lbl \
+ -text [mc "TH"] \
+ ] -row 1 -column 1 -sticky e
+ grid [label $bottom_frame.tl_l_lbl \
+ -text [mc "TL"] \
+ ] -row 2 -column 1 -sticky e
+ set widgets(timer01,rh_l) [label $bottom_frame.rh_l_lbl \
+ -text [mc "RH"] \
+ ]
+ set widgets(timer01,rl_l) [label $bottom_frame.rl_l_lbl \
+ -text [mc "RL"] \
+ ]
+ grid [label $bottom_frame.rep_l_lbl \
+ -text [mc "Repeats"] \
+ ] -row 5 -column 1 -sticky e
+ grid [label $bottom_frame.rest_l_lbl \
+ -text [mc "Rest"] \
+ ] -row 6 -column 1 -sticky e
+ # ":="
+ for {set i 1} {$i < 7} {incr i} {
+ set widgets(timer01,eq$i) \
+ [label $bottom_frame.equal_s_l$i -text ":="]
+ grid $widgets(timer01,eq$i) -row $i -column 2
+ }
+ grid forget $widgets(timer01,eq3)
+ grid forget $widgets(timer01,eq4)
+ ## Entryboxes with results themselfs
+ # - TH
+ set widgets(timer01,th) [ \
+ entry $bottom_frame.th_r_lbl -state readonly \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_th_$obj_idx \
+ ]
+ set ::SpecCalc::timer01_th_$obj_idx [mc "Do not change"]
+ grid $widgets(timer01,th) -row 1 -column 3 -sticky w
+ # - TL
+ set widgets(timer01,tl) [ \
+ entry $bottom_frame.tl_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_tl_$obj_idx \
+ ]
+ set ::SpecCalc::timer01_tl_$obj_idx [mc "Do not change"]
+ grid $widgets(timer01,tl) -row 2 -column 3 -sticky w
+ # - RH
+ set widgets(timer01,rh) [ \
+ entry $bottom_frame.rh_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_rh_$obj_idx \
+ ]
+ set ::SpecCalc::timer01_rh_$obj_idx [mc "Do not change"]
+ # - RL
+ set widgets(timer01,rl) [ \
+ entry $bottom_frame.rl_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_rl_$obj_idx \
+ ]
+ set ::SpecCalc::timer01_rl_$obj_idx [mc "Do not change"]
+ # - Repeats
+ set widgets(timer01,repeats) [ \
+ entry $bottom_frame.reps_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_repeats_$obj_idx\
+ ]
+ set ::SpecCalc::timer01_repeats_$obj_idx [mc "Zero"]
+ grid $widgets(timer01,repeats) -row 5 -column 3 -sticky w
+ # - Rest
+ set widgets(timer01,rest) [ \
+ entry $bottom_frame.rest_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer01_rest_$obj_idx \
+ ]
+ set ::SpecCalc::timer01_rest_$obj_idx [mc "none"]
+ grid $widgets(timer01,rest) -row 6 -column 3 -sticky w
+
+ # Configure grid layout
+ grid columnconfigure $bottom_frame 0 -minsize 15
+
+
+ # Create page header
+ pack [label $pages($page).header \
+ -text [mc "Calculate timer 0/1 preset"] \
+ -font [font create \
+ -family {helvetica} \
+ -size -17 \
+ -weight bold \
+ ] \
+ ] -pady 5
+ pack $top_frame -anchor nw
+ pack [ttk::separator $pages($page).sep \
+ -orient horizontal \
+ ] -fill x -pady 5
+ pack $bottom_frame -anchor nw -padx 10
+
+ # Restore values from the last session
+ set load_failure 1
+ catch {
+ if {[llength $config]} {
+ $widgets(timer01,time_ent) insert 0 [lindex $config {1 0}]
+ $widgets(timer01,time_cb) current [lindex $config {1 1}]
+ $widgets(timer01,clock_cb) delete 0 end
+ $widgets(timer01,clock_cb) insert 0 [lindex $config {1 2}]
+ $widgets(timer01,clock_type_cb) current [lindex $config {1 3}]
+ $widgets(timer01,mode_cb) current [lindex $config {1 4}]
+ $widgets(timer01,psc_cb) current [lindex $config {1 5}]
+ set ::SpecCalc::spec_chb_$obj_idx [lindex $config {1 6}]
+ if {[lindex $config {1 6}]} {
+ calc timer01 spec_chb 1
+ }
+ set load_failure 0
+ }
+ }
+ if {$load_failure} {
+ $widgets(timer01,time_cb) current 1
+ $widgets(timer01,clock_cb) current 2
+ $widgets(timer01,clock_type_cb) current 0
+ $widgets(timer01,mode_cb) current 1
+ $widgets(timer01,psc_cb) current 4
+ }
+ }
+
+ ## Create page for computing timer 2 preset values
+ # @return void
+ private method create_page_timer2 {} {
+ # Create notebook
+ set page {timer2}
+ set nb [NoteBook $pages($page).nb -side top -arcradius 4 -bg {#EEEEEE}]
+ # - Page "Preset"
+ set preset_frame [$nb insert end {Preset} \
+ -text [mc "Preset"] \
+ -image ::ICONS::16::player_time \
+ ]
+ # - Page "Clock"
+ set clock_out_frame [$nb insert end {Clock} \
+ -text [mc "Clock out"] \
+ -image ::ICONS::16::kcmpci \
+ ]
+
+
+ #
+ ## Create "Preset" page
+ #
+
+ # Create frames
+ set top_frame [frame $preset_frame.top_frame]
+ set bottom_frame [frame $preset_frame.bottom_frame]
+
+ # - Time
+ grid [label $top_frame.time_lbl \
+ -text [mc "Time"] \
+ ] -row 0 -column 0 -sticky w
+ set widgets(timer2,time_ent) [ttk::entry $top_frame.time_ent \
+ -validatecommand "$this calc timer2 time_ent %P" \
+ -validate key \
+ -width 9 \
+ ]
+ grid $widgets(timer2,time_ent) -row 0 -column 1 -sticky we
+ set widgets(timer2,time_cb) [ttk::combobox $top_frame.time_cb \
+ -values {ns us ms s} \
+ -state readonly \
+ -width 7 \
+ ]
+ bind $widgets(timer2,time_cb) <<ComboboxSelected>> \
+ "$this calc timer2 time_cb \[$top_frame.time_cb get\]"
+ grid $widgets(timer2,time_cb) -row 0 -column 2 -sticky w
+ set_status_tip $widgets(timer2,time_cb) [mc "Time unit"]
+
+ # - Clock
+ grid [label $top_frame.clock_lbl \
+ -text [mc "Clock \[kHz\]"] \
+ ] -row 1 -column 0 -sticky w
+ set widgets(timer2,clock_cb) [ttk::combobox $top_frame.clock_cb \
+ -validate key \
+ -width 9 \
+ -validatecommand "$this calc timer2 clock_cb %P" \
+ -values {
+ 6000.0 11059.2 12000.0 14745.6
+ 16000.0 20000.0 24000.0 33000.0
+ } \
+ ]
+ set_status_tip $widgets(timer2,clock_cb) [mc "MCU clock"]
+ grid $widgets(timer2,clock_cb) -row 1 -column 1 -sticky we
+ set widgets(timer2,clock_type_cb) [ttk::combobox \
+ $top_frame.clock_type_cb \
+ -values {{12 / MC} {6 / MC} {1 / MC}} \
+ -width 7 -state readonly \
+ -state readonly \
+ ]
+ bind $widgets(timer2,clock_type_cb) <<ComboboxSelected>> \
+ "$this calc timer2 clock_type_cb \[$top_frame.clock_type_cb get\]"
+ DynamicHelp::add $widgets(timer2,clock_type_cb) \
+ -text [mc "Clock cycles per machine cycle\n 12 - Common 8051\n 6 - Core 51X2\n 1 - Single cycle core"]
+ set_status_tip $widgets(timer2,clock_type_cb) [mc "Clock cycles per machine cycle"]
+ grid $widgets(timer2,clock_type_cb) -row 1 -column 2 -sticky w
+
+ # - Mode
+ grid [label $top_frame.mode_lbl \
+ -text [mc "Mode"] \
+ ] -row 2 -column 0 -sticky w
+ set widgets(timer2,mode_cb) [ttk::combobox $top_frame.mode_cb \
+ -state readonly \
+ -width 18 \
+ -values {
+ {UP counter (auto reload)}
+ {DOWN counter (auto reload)}
+ } \
+ ]
+ bind $widgets(timer2,mode_cb) <<ComboboxSelected>> \
+ "$this calc timer2 mode_cb \[$top_frame.mode_cb get\]"
+ set_status_tip $widgets(timer2,mode_cb) [mc "Timer mode"]
+ grid $widgets(timer2,mode_cb) -row 2 -column 1 -sticky we -columnspan 2
+ grid [ttk::button $top_frame.show_diagram_button \
+ -image ::ICONS::16::info \
+ -command "$this show_diagram timer2 0" \
+ -style Flat.TButton \
+ ] -row 2 -column 3 -sticky w
+ set_status_tip $top_frame.show_diagram_button [mc "Show functional block diagram"]
+
+ ## Results ...
+ # Labels
+ grid [label $bottom_frame.res_lbl \
+ -text [mc "Results:"] \
+ ] -row 0 -column 0 -columnspan 3 -sticky w
+ grid [label $bottom_frame.rcal2h_l_lbl \
+ -text [mc "RCAL2H"] \
+ ] -row 1 -column 1 -sticky e
+ grid [label $bottom_frame.rcal2l_l_lbl \
+ -text [mc "RCAL2L"] \
+ ] -row 2 -column 1 -sticky e
+ grid [label $bottom_frame.t2h_l_lbl \
+ -text [mc "T2H"] \
+ ] -row 3 -column 1 -sticky e
+ grid [label $bottom_frame.t2l_l_lbl \
+ -text [mc "T2L"] \
+ ] -row 4 -column 1 -sticky e
+ grid [label $bottom_frame.repeats_l_lbl \
+ -text [mc "Repeats"] \
+ ] -row 5 -column 1 -sticky e
+ grid [label $bottom_frame.rest_l_lbl \
+ -text [mc "Rest"] \
+ ] -row 6 -column 1 -sticky e
+ # ":="
+ for {set i 1} {$i < 7} {incr i} {
+ grid [label $bottom_frame.equal_s_l$i -text ":="] -row $i -column 2
+ }
+ ## Entryboxes with results themselfs
+ # - RCAL2H
+ set widgets(timer2,rcal2h) [
+ entry $bottom_frame.rcal2h_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer2_rcal2h_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_rcal2h_$obj_idx [mc "Do not change"]
+ grid $widgets(timer2,rcal2h) -row 1 -column 3 -sticky w
+ # - RCAL2L
+ set widgets(timer2,rcal2l) [
+ entry $bottom_frame.rcal2l_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer2_rcal2l_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_rcal2l_$obj_idx [mc "Do not change"]
+ grid $widgets(timer2,rcal2l) -row 2 -column 3 -sticky w
+ # - T2H
+ set widgets(timer2,t2h) [
+ entry $bottom_frame.t2h_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer2_t2h_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_t2h_$obj_idx [mc "Do not change"]
+ grid $widgets(timer2,t2h) -row 3 -column 3 -sticky w
+ # - T2L
+ set widgets(timer2,t2l) [
+ entry $bottom_frame.t2l_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -textvariable ::SpecCalc::timer2_t2l_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_t2l_$obj_idx [mc "Do not change"]
+ grid $widgets(timer2,t2l) -row 4 -column 3 -sticky w
+ # - Repeats
+ set widgets(timer2,repeats) [ \
+ entry $bottom_frame.repeats_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -textvariable ::SpecCalc::timer2_repeats_$obj_idx \
+ ]
+ set ::SpecCalc::timer2_repeats_$obj_idx [mc "none"]
+ grid $widgets(timer2,repeats) -row 5 -column 3 -sticky w
+ # - Rest
+ set widgets(timer2,rest) [ \
+ entry $bottom_frame.rest_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} \
+ -relief flat -highlightthickness 0 -bd 0 \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -textvariable ::SpecCalc::timer2_rest_$obj_idx \
+ ]
+ set ::SpecCalc::timer2_rest_$obj_idx [mc "none"]
+ grid $widgets(timer2,rest) -row 6 -column 3 -sticky w
+
+ # Configure grid layout
+ grid columnconfigure $bottom_frame 0 -minsize 15
+
+
+ # Create page header
+ pack [label $preset_frame.header \
+ -text [mc "Calculate timer 2 preset"] \
+ -font [font create \
+ -family {helvetica} \
+ -size -17 \
+ -weight bold \
+ ] \
+ ] -pady 5
+ pack $top_frame -pady 5 -anchor nw
+ pack [ttk::separator $preset_frame.sep \
+ -orient horizontal \
+ ] -fill x -pady 10
+ pack $bottom_frame -anchor nw -padx 10
+
+ # Restore values from the last session
+ if {[llength $config]} {
+ $widgets(timer2,time_ent) insert 0 [lindex $config {2 0}]
+ $widgets(timer2,time_cb) current [lindex $config {2 1}]
+ $widgets(timer2,clock_cb) delete 0 end
+ $widgets(timer2,clock_cb) insert 0 [lindex $config {1 2}]
+ $widgets(timer2,clock_type_cb) current [lindex $config {2 3}]
+ $widgets(timer2,mode_cb) current [lindex $config {2 4}]
+ } {
+ $widgets(timer2,time_cb) current 1
+ $widgets(timer2,clock_cb) current 2
+ $widgets(timer2,clock_type_cb) current 0
+ $widgets(timer2,mode_cb) current 0
+ }
+ set bottom_frame [frame $clock_out_frame.bottom_frame]
+
+
+ #
+ ## Create "Clock" page
+ #
+
+ # Labes ...
+ grid [label $bottom_frame.freq_l_lbl \
+ -text [mc "Frequency"] \
+ ] -row 1 -column 1 -sticky e
+ grid [label $bottom_frame.fosc_l_lbl \
+ -text [mc "F osc"] \
+ ] -row 2 -column 1 -sticky e
+ grid [label $bottom_frame.x2_l_lbl \
+ -text [mc "X2"] \
+ ] -row 3 -column 1 -sticky e
+ grid [label $bottom_frame.hex_lbl \
+ -text [mc "HEX"] -font $::smallfont \
+ ] -row 5 -column 2
+ grid [label $bottom_frame.dec_lbl \
+ -text [mc "DEC"] -font $::smallfont \
+ ] -row 5 -column 3
+ grid [label $bottom_frame.rcap2h_l_lbl \
+ -text [mc "RCAP2H"] \
+ ] -row 6 -column 1 -sticky e
+ grid [label $bottom_frame.rcap2l_l_lbl \
+ -text [mc "RCAP2L"] \
+ ] -row 7 -column 1 -sticky e
+ grid [label $bottom_frame.error_l_lbl \
+ -text [mc "Error"] \
+ ] -row 8 -column 1 -sticky e
+
+ # Separator
+ grid [ttk::separator $bottom_frame.sep \
+ -orient horizontal \
+ ] -row 4 -column 1 -sticky we -columnspan 3 -pady 5
+
+ ## EntryBoxes
+ # - Frequency
+ set widgets(timer2,clk_freq) [ttk::entry \
+ $bottom_frame.clk_freq_r_lbl \
+ -validate key \
+ -width 12 \
+ -textvariable ::SpecCalc::timer2_clk_freq_$obj_idx \
+ -validatecommand "$this calc clk_timer2 clk_freq %P" \
+ ]
+ grid $widgets(timer2,clk_freq) -row 1 -column 2 -sticky w -columnspan 3
+ set widgets(timer2,clk_fosc) [ttk::entry \
+ $bottom_frame.clk_fosc_r_lbl \
+ -validate key \
+ -width 12 \
+ -textvariable ::SpecCalc::timer2_clk_fosc_$obj_idx \
+ -validatecommand "$this calc clk_timer2 clk_fosc %P" \
+ ]
+ grid $widgets(timer2,clk_fosc) -row 2 -column 2 -sticky w -columnspan 3
+ # - X2
+ set widgets(timer2,clk_x2_cb) [ttk::combobox $bottom_frame.clock_type_cb \
+ -values {0 1} \
+ -width 1 \
+ -state readonly \
+ -textvariable ::SpecCalc::timer2_clk_x2_$obj_idx \
+ ]
+ bind $widgets(timer2,clk_x2_cb) <<ComboboxSelected>> \
+ "$this calc clk_timer2 clk_x2_cb \[$bottom_frame.clock_type_cb get\]"
+ set ::SpecCalc::timer2_clk_x2_$obj_idx {0}
+ grid $widgets(timer2,clk_x2_cb) -row 3 -column 2 -sticky w -columnspan 3
+ # - RCAL2H
+ set widgets(timer2,clk_rcal2h) [
+ entry $bottom_frame.clk_rcal2h_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} -validate key \
+ -relief flat -highlightthickness 0 -bd 0 -width 5 \
+ -textvariable ::SpecCalc::timer2_clk_rcal2h_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_clk_rcal2h_$obj_idx "--"
+ grid $widgets(timer2,clk_rcal2h) -row 6 -column 2 -sticky w
+ # - RCAL2L
+ set widgets(timer2,clk_rcal2l) [
+ entry $bottom_frame.clk_rcal2l_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} -validate key \
+ -relief flat -highlightthickness 0 -bd 0 -width 5 \
+ -textvariable ::SpecCalc::timer2_clk_rcal2l_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_clk_rcal2l_$obj_idx "--"
+ grid $widgets(timer2,clk_rcal2l) -row 7 -column 2 -sticky w
+ # RCAL2H
+ set widgets(timer2,clk_rcal2h_d) [
+ entry $bottom_frame.clk_rcal2h_d_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} -validate key \
+ -relief flat -highlightthickness 0 -bd 0 -width 5 \
+ -textvariable ::SpecCalc::timer2_clk_rcal2h_d_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_clk_rcal2h_d_$obj_idx "--"
+ grid $widgets(timer2,clk_rcal2h_d) -row 6 -column 3 -sticky w
+ # - RCAL2L
+ set widgets(timer2,clk_rcal2l_d) [
+ entry $bottom_frame.clk_rcal2l_d_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} -validate key \
+ -relief flat -highlightthickness 0 -bd 0 -width 5 \
+ -textvariable ::SpecCalc::timer2_clk_rcal2l_d_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_clk_rcal2l_d_$obj_idx "--"
+ grid $widgets(timer2,clk_rcal2l_d) -row 7 -column 3 -sticky w
+ # - Error
+ set widgets(timer2,clk_error) [
+ entry $bottom_frame.clk_error_r_lbl -state readonly \
+ -fg {#888888} -bg {#EEEEEE} -validate key \
+ -relief flat -highlightthickness 0 -bd 0 -width 12 \
+ -textvariable ::SpecCalc::timer2_clk_error_$obj_idx \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ ]
+ set ::SpecCalc::timer2_clk_error_$obj_idx "--"
+ grid $widgets(timer2,clk_error) -row 8 -column 2 -sticky w -columnspan 2
+
+ # Clear entry boxes with results
+ calculate_timer2_clk_clear_results
+
+ # Load values from the last session
+ if {[llength $config]} {
+ set ::SpecCalc::timer2_clk_fosc_$obj_idx [lindex $config {3 0}]
+ set ::SpecCalc::timer2_clk_freq_$obj_idx [lindex $config {3 1}]
+ set ::SpecCalc::timer2_clk_x2_$obj_idx [lindex $config {3 2}]
+ } {
+ set ::SpecCalc::timer2_clk_fosc_$obj_idx {}
+ set ::SpecCalc::timer2_clk_freq_$obj_idx {}
+ set ::SpecCalc::timer2_clk_x2_$obj_idx {0}
+ }
+
+ # Create page header
+ pack [label $clock_out_frame.header \
+ -text [mc "Calculate clock output"] \
+ -font [font create \
+ -family {helvetica} \
+ -size -17 \
+ -weight bold \
+ ] \
+ ] -pady 5
+ pack [label $clock_out_frame.math \
+ -image [image create photo \
+ -format png \
+ -file "${::LIB_DIRNAME}/../icons/other/math0.png" \
+ ] \
+ ] -pady 5
+ pack $bottom_frame -anchor nw
+ $nb raise {Preset}
+ pack $nb -fill both -expand 1
+ }
+
+ ## Create page for calculating SPI related values
+ # @return void
+ private method create_page_spi {} {
+ # Create page frames
+ set page {spi}
+ set top_frame [frame $pages($page).top_frame]
+ set bottom_frame [frame $pages($page).bottom_frame]
+
+ # - Mode X2 or single cycle core
+ set widgets(spi,double_chb) [ \
+ checkbutton $top_frame.double_chb \
+ -text [mc "Mode X2 or single cycle core"] \
+ -onvalue 1 -offvalue 2 \
+ -variable ::SpecCalc::double_chb_$obj_idx \
+ -command "$this calc spi double_chb \${::SpecCalc::double_chb_$obj_idx}" \
+ ]
+ grid $widgets(spi,double_chb) -row 0 -column 0 -columnspan 3 -sticky w
+
+ # Labels ...
+ grid [label $top_frame.spr1_lbl \
+ -text "SPR1" \
+ ] -row 1 -column 0
+ grid [label $top_frame.spr0_lbl \
+ -text "SPR0" \
+ ] -row 1 -column 1
+ grid [label $top_frame.sck_lbl \
+ -text [mc "SCK \[kHz\]"] \
+ ] -row 1 -column 2
+
+ grid [label $top_frame.spr1_0_lbl \
+ -text "0" \
+ ] -row 2 -column 0
+ grid [label $top_frame.spr0_0_lbl \
+ -text "0" \
+ ] -row 2 -column 1
+ set widgets(spi,sck_ent00) [ttk::entry $top_frame.sck_0_ent \
+ -width 9 \
+ -validate key \
+ -validatecommand "$this calc spi sck_ent00 %P" \
+ ]
+ grid $widgets(spi,sck_ent00) -row 2 -column 2
+
+ grid [label $top_frame.spr1_1_lbl \
+ -text "0" \
+ ] -row 3 -column 0
+ grid [label $top_frame.spr0_1_lbl \
+ -text "1" \
+ ] -row 3 -column 1
+ set widgets(spi,sck_ent01) [ttk::entry $top_frame.sck_1_ent \
+ -width 9 \
+ -validate key \
+ -validatecommand "$this calc spi sck_ent01 %P" \
+ ]
+ grid $widgets(spi,sck_ent01) -row 3 -column 2
+
+ grid [label $top_frame.spr1_2_lbl \
+ -text "1" \
+ ] -row 4 -column 0
+ grid [label $top_frame.spr0_2_lbl \
+ -text "0" \
+ ] -row 4 -column 1
+ set widgets(spi,sck_ent10) [ttk::entry $top_frame.sck_2_ent \
+ -width 9 \
+ -validate key \
+ -validatecommand "$this calc spi sck_ent10 %P" \
+ ]
+ grid $widgets(spi,sck_ent10) -row 4 -column 2
+
+ grid [label $top_frame.spr1_3_lbl \
+ -text "1" \
+ ] -row 5 -column 0
+ grid [label $top_frame.spr0_3_lbl \
+ -text "1" \
+ ] -row 5 -column 1
+ set widgets(spi,sck_ent11) [ttk::entry $top_frame.sck_3_ent \
+ -width 9 \
+ -validate key \
+ -validatecommand "$this calc spi sck_ent11 %P" \
+ ]
+ grid $widgets(spi,sck_ent11) -row 5 -column 2
+
+
+ pack [label $bottom_frame.res_lbl0 \
+ -text [mc "Set MCU oscillator to "] \
+ ] -side left
+ set widgets(spi,result) [ \
+ entry $bottom_frame.result_ent \
+ -readonlybackground {#EEEEEE} \
+ -disabledforeground {#000000} \
+ -bg {#EEEEEE} -width 0 -bd 1 -state readonly \
+ -relief flat -highlightthickness 0 \
+ -textvariable ::SpecCalc::spi_result_$obj_idx \
+ ]
+ pack $widgets(spi,result) -side left
+ pack [label $bottom_frame.res_lbl1 \
+ -text [mc " kHz"] \
+ ] -side left
+
+ pack [label $pages($page).header \
+ -text [mc "Calculate oscillator frequency"] \
+ -font [font create \
+ -family {helvetica} \
+ -size -17 \
+ -weight bold \
+ ] \
+ ] -pady 5
+ pack $top_frame -pady 5 -anchor nw
+ pack [ttk::separator $pages($page).sep \
+ -orient horizontal \
+ ] -fill x -pady 10
+ pack $bottom_frame -anchor nw -padx 10
+
+ set ::SpecCalc::spi_result_$obj_idx "--"
+
+ if {[llength $config]} {
+ set ::SpecCalc::double_chb_$obj_idx [lindex $config {5 0}]
+ calc spi double_chb [lindex $config {5 0}]
+
+ $widgets(spi,sck_ent00) delete 0 end
+ $widgets(spi,sck_ent00) insert 0 [lindex $config {5 1}]
+ }
+ }
+
+ ## Create GUI for page specified by parameter
+ # @parm String page -Page ID
+ # @return void
+ public method create_page {page} {
+ if {$page_created($page)} {return}
+ set page_created($page) 1
+
+ switch -- $page {
+ {loops} { ;# Wait loops
+ create_page_loops
+ }
+ {timer01} { ;# Timer 0/1
+ create_page_timer01
+ }
+ {timer2} { ;# Timer 2
+ create_page_timer2
+ }
+ {spi} { ;# SPI (Serial Peripheral Interface)
+ create_page_spi
+ }
+ }
+ }
+
+ ## Auxiliary procedure for procedure "calculate_loops"
+ # @parm float time
+ # @parm float rest
+ # @parm Bool is_spec
+ # @return List
+ private method calculate_loops_AUX {time rest is_spec} {
+ array set res {0 {} 1 {} 2 {} 3 {} 4 {} 5 {} 6 {} 7 {}}
+ set len 0
+ set div_all 1
+ for {set len 0} {$len < 9} {incr len} {
+ if {$len == 8} {
+ status_tip [mc "Unable to evaluate"]
+ calculate_loops_clear_results
+ return 0
+ } elseif {$len} {
+ set init 256
+ } else {
+ set init 257
+ }
+
+ set mod $init
+ set div $init
+ for {set i $init} {$i >= 2} {incr i -1} {
+ if {($time % $i) < $mod} {
+ set mod [expr {$time % $i}]
+ set div $i
+ }
+ }
+
+ set rest [expr {$rest + ($mod * $div_all)}]
+ set div_all [expr {$div_all * $div}]
+ set time [expr {$time / $div}]
+ if {$res($len) == 256} {
+ set res($len) 0
+ } {
+ set res($len) $div
+ }
+
+ if {$time == 1} {
+ break
+ }
+ }
+ incr len
+ if {$len > 1} {
+ incr res(0) -2
+ } {
+ incr res(0) -1
+ }
+ set correction 0
+ if {$len == 1} {
+ if {[lindex $is_spec 0]} {
+ set correction -1
+ }
+ }
+ for {set i 1} {$i < $len} {incr i} {
+ set div $res($i)
+ set div_all [expr {$div_all * $div}]
+
+ if {$i == 1} {
+ if {[lindex $is_spec $i]} {
+ set correction 1
+ } {
+ set correction 2
+ }
+ } {
+ if {[lindex $is_spec $i]} {
+ set correction [expr {($correction * $res($i)) + ($res($i) * 2) + 1}]
+ } {
+ set correction [expr {($correction * $res($i)) + ($res($i) * 3) + 2}]
+ }
+ }
+ }
+
+ set rest [expr {(2.0 * $rest) - $correction}]
+ return [list $rest $len [array get res]]
+ }
+
+ ## Report an error occured during evaluation of the wait loop
+ # @return void
+ private method calculate_loops_evaluation_error {} {
+ error "Please report this bug. Method ::SpecCalc::calculate_loops --> Evaluation error. Dump: \n\$widgets(loops,time_ent) == $widgets(loops,time_ent)\n\$widgets(loops,time_cb) == $widgets(loops,time_cb)\n\$widgets(loops,clock_cb) == $widgets(loops,clock_cb)\n\$widgets(loops,clock_type_cb) == $widgets(loops,clock_type_cb)\n\$widgets(loops,reg_ent0) == $widgets(loops,reg_ent0)\n\$widgets(loops,reg_ent1) == $widgets(loops,reg_ent1)\n\$widgets(loops,reg_ent2) == $widgets(loops,reg_ent2)\n\$widgets(loops,reg_ent3) == $widgets(loops,reg_ent3)\n\$widgets(loops,reg_ent4) == $widgets(loops,reg_ent4)\n\$widgets(loops,reg_ent5) == $widgets(loops,reg_ent5)\n\$widgets(loops,reg_ent6) == $widgets(loops,reg_ent6)\n\$widgets(loops,reg_ent7) == $widgets(loops,reg_ent7)"
+ }
+
+ ## Generate wait loop acoring to specified criteria
+ # @return void
+ private method calculate_loops {} {
+ $widgets(loops,results) configure -state normal
+ $widgets(loops,results) delete 0.0 end
+
+ set note {}
+
+ set is_spec [list]
+ for {set i 0} {$i < 8} {incr i} {
+ set reg($i) [$widgets(loops,reg_ent$i) get]
+
+ if {[lsearch -ascii -exact {R0 R1 R2 R3 R4 R5 R6 R7 A} [string toupper $reg($i)]] != -1} {
+ lappend is_spec 1
+ } {
+ lappend is_spec 0
+ }
+ }
+
+ set time [$widgets(loops,time_ent) get]
+ if {$time == {}} {
+ set time 1
+ append note [mc "ERROR: Missing time\n"]
+ } elseif {$time == 0} {
+ append note [mc "ERROR: Time rate cannot be 0\n"]
+ }
+
+ set clock [$widgets(loops,clock_cb) get]
+ if {$clock == {}} {
+ set clock 1
+ append note [mc "ERROR: Missing MCU clock rate\n"]
+ } elseif {$clock == 0} {
+ append note [mc "ERROR: MCU clock rate cannot be 0\n"]
+ }
+
+ if {[string length $note]} {
+ $widgets(loops,results) insert end $note
+ $widgets(loops,results) configure -state disabled
+ return 0
+ }
+
+ set time [expr {$time * [lindex {1.0 1000.0 1000000.0 1000000000.0} [$widgets(loops,time_cb) current]] / 2.0}]
+ set clock [expr {[lindex {12.0 6.0 1.0} [$widgets(loops,clock_type_cb) current]] / $clock}]
+ set time [expr {$time * $clock}]
+
+ set time_org $time
+ set i 0
+ set result [list]
+ set lowes_rest $time
+ set last_rest {}
+ set result_c {}
+ set result_fin_i 0
+ for {set i 0} {$i < 8} {incr i} {
+
+ set rest $time_org
+ set time [expr {int($time)}]
+ set rest [expr {$rest - $time}]
+
+ set result_c [calculate_loops_AUX $time $rest $is_spec]
+ if {$result_c == {0}} {
+ return 0
+ }
+ lappend result $result_c
+
+ if {$lowes_rest == {}} {
+ set lowes_rest [lindex $result_c 0]
+
+ } elseif {($lowes_rest < 0) && ([lindex $result_c 0] >= 0)} {
+ set result_fin_i $i
+ set lowes_rest [lindex $result_c 0]
+
+ } elseif {abs($lowes_rest) > abs([lindex $result_c 0])} {
+ set result_fin_i $i
+ set lowes_rest [lindex $result_c 0]
+ }
+
+ if {$last_rest == [lindex $result_c 0] || ![lindex $result_c 0]} {
+ break
+ }
+ set last_rest [lindex $result_c 0]
+ set time [expr {$time_org + ($last_rest / 2.0)}]
+ }
+ set time $time_org
+ set rest [lindex $result [list $result_fin_i 0]]
+ set len [lindex $result [list $result_fin_i 1]]
+ array set res [lindex $result [list $result_fin_i 2]]
+
+
+ for {set i 0} {$i < $len} {incr i} {
+ set error 0
+ if {![string length $reg($i)]} {
+ set error 1
+ $widgets(loops,results) insert end \
+ [mc "ERROR: Missing register name %s\n" $i]
+ } elseif {[$widgets(loops,reg_ent$i) cget -style] == {StringNotFound.TEntry}} {
+ set error 1
+ $widgets(loops,results) insert end \
+ [mc "ERROR: Ambiguous register name %s\n" $i]
+ }
+
+ if {$error} {
+ $widgets(loops,results) configure -state disabled
+ return 0
+ }
+ }
+ $widgets(loops,results) insert end [mc "; START: Wait loop, time: %s %s\n; Clock: %s kHz (%s)\n; Used registers: " [$widgets(loops,time_ent) get] [$widgets(loops,time_cb) get] [$widgets(loops,clock_cb) get] [$widgets(loops,clock_type_cb) get]]
+ for {set i 0} {$i < $len} {incr i} {
+ if {$i} {
+ $widgets(loops,results) insert end ", "
+ }
+ $widgets(loops,results) insert end $reg($i)
+ }
+ $widgets(loops,results) insert end "\n"
+
+ set last_branch 0
+ set branch 0
+ for {set i 0} {$i < $len} {incr i} {
+ set branch $last_branch
+ set val $res($i)
+
+ set val [string range [format {%X} $res($i)] end-1 end]
+ set val "[string repeat {0} [expr {3 - [string length $val]}]]$val"
+
+ set cmp {}
+ if {[lindex $is_spec $i]} {
+ if {!$i} {
+ set cmp "\n\tNOP"
+ incr branch 1
+ }
+ } {
+ incr branch 2
+ }
+ incr branch 4
+
+ set last_branch $branch
+ if {!$i} {
+ set branch 0
+ incr last_branch -4
+ }
+
+ if {$branch == {0}} {
+ set branch {}
+ } {
+ set branch "-$branch"
+ }
+
+ set res($i) [list \
+ "\tDJNZ\t$reg($i), \$$branch" \
+ "\tMOV\t$reg($i), #${val}h$cmp" \
+ ]
+ }
+
+ for {set i [expr {$len - 1}]} {$i >= 0} {incr i -1} {
+ $widgets(loops,results) insert end "[lindex $res($i) 1]\n"
+ }
+
+ for {set i 0} {$i < $len} {incr i} {
+ $widgets(loops,results) insert end "[lindex $res($i) 0]\n"
+ }
+
+ if {$rest <= 4} {
+ for {set i 0} {$i < 5} {incr i} {
+ if {int(ceil($rest)) > 0.5} {
+ $widgets(loops,results) insert end "\tNOP\n"
+ set rest [expr {$rest - 1}]
+ }
+ }
+ } {
+ if {[lindex $is_spec 0]} {
+ set rest [expr {$rest - 1}]
+ } {
+ set rest [expr {$rest - 2}]
+ }
+ set val [expr {int($rest / 2)}]
+ set rest [expr {$rest - ($val * 2.0)}]
+ if {$val == 256} {
+ set val 0
+ } elseif {$val > 256} {
+ status_tip [mc "Unable to evaluate"]
+ calculate_loops_clear_results
+ return 0
+ }
+ set val [string range [format {%X} $val] end-1 end]
+ set val "[string repeat {0} [expr {3 - [string length $val]}]]$val"
+
+ $widgets(loops,results) insert end "\tMOV\t$reg(0), #${val}h\n"
+ $widgets(loops,results) insert end "\tDJNZ\t$reg(0), \$\n"
+ if {int(ceil($rest)) > 0.5} {
+ $widgets(loops,results) insert end "\tNOP\n"
+ set rest [expr {$rest - 1}]
+ }
+ }
+ set rest [expr {$rest * 1.0 / $clock}]
+ $widgets(loops,results) insert end [mc "; Rest: %s\n" [adjust_rest $rest]]
+
+ $widgets(loops,results) insert end [mc "; END: Wait loop"]
+
+ set end [expr {int([$widgets(loops,results) index end])}]
+ for {set i 1} {$i < $end} {incr i} {
+ ASMsyntaxHighlight::highlight $widgets(loops,results) $i
+ }
+ $widgets(loops,results) configure -state disabled
+
+ return 1
+ }
+
+ ## Clear results of the last wait loop calculation
+ # @return void
+ private method calculate_loops_clear_results {} {
+ $widgets(loops,results) configure -state normal
+ $widgets(loops,results) delete 0.0 end
+ $widgets(loops,results) configure -state disabled
+
+ calculate_loops_enable_copy 0
+ }
+
+ ## Enable "Copy" button in page "Wait loops"
+ # @parm Bool enable - 1 == Enable; 0 == Disable
+ # @return void
+ private method calculate_loops_enable_copy {enable} {
+ if {$enable} {
+ set enable {normal}
+ } {
+ set enable {disabled}
+ }
+ $widgets(loops,copy_but) configure -state $enable
+ }
+
+ ## Calulate time 0 or 1 preset values
+ # @return void
+ public method calculate_timer01 {} {
+ set time [$widgets(timer01,time_ent) get]
+ if {$time == {} || $time == 0} {
+ status_tip [mc "Invalid time"]
+ return 0
+ }
+
+ set clock [$widgets(timer01,clock_cb) get]
+ if {$clock == {} || $clock == 0} {
+ status_tip [mc "Invalid clock rate"]
+ return 0
+ }
+ status_tip ""
+
+ set ::SpecCalc::timer01_th_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer01_tl_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer01_rh_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer01_rl_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer01_repeats_$obj_idx [mc "Zero"]
+ set ::SpecCalc::timer01_rest_$obj_idx [mc "none"]
+
+ foreach w {th tl rh rl repeats rest} {
+ $widgets(timer01,$w) configure -fg {#888888}
+ }
+
+ set time [expr {$time * [lindex {1.0 1000.0 1000000.0 1000000000.0} [$widgets(timer01,time_cb) current]]}]
+ set clock [expr {[lindex {12.0 6.0 1.0} [$widgets(timer01,clock_type_cb) current]] / $clock}]
+ set time [expr {$time * $clock}]
+ set time_int [expr {int($time)}]
+
+ set enhanced [subst "\$::SpecCalc::spec_chb_$obj_idx"]
+ set prescaler [$widgets(timer01,psc_cb) current]
+
+ # Set default results
+ set low 0
+ set high 0
+ set repeats 0
+ set rest 0
+
+ switch -- [$widgets(timer01,mode_cb) current] {
+ {0} { ;# 9 -> 16 bit counter
+ if {$enhanced} {
+ set bits [expr {$prescaler + 9}]
+ } {
+ set bits 13
+ }
+ set capacity [expr {1 << $bits}]
+ set full_mask [expr {$capacity - 1}]
+ set low_mask [expr {$full_mask >> 8}]
+
+ # Determinate apparent number of repeats
+ set repeats [expr {($time_int >> $bits) + 1}]
+ # Calculate tempotary results
+ if {[expr {!($time_int & $full_mask)}]} {
+ incr repeats -1
+ set stepsPerIter $full_mask
+ } {
+ set stepsPerIter [expr {$time_int / $repeats}]
+ set tmp [expr {$capacity - $stepsPerIter}]
+ set low [expr {$tmp & $low_mask}]
+ set high [expr {$tmp >> 5}]
+ set rest [expr {$time_int - (($full_mask - $tmp) * $repeats)}]
+ }
+
+ # Perform correction
+ if {$rest >= $stepsPerIter} {
+ incr repeats [expr {$rest / $stepsPerIter}]
+ set rest [expr {$rest % $stepsPerIter}]
+ }
+
+ set rest [expr {($rest + $time - $time_int) / $clock}]
+ set rest [adjust_rest $rest]
+
+ if {$repeats > 1} {
+ status_tip [mc "Value is too high"]
+ return 0
+ }
+
+ set low [format {%X} $low]
+ set low "[string repeat {0} [expr {3 - [string length $low]}]]${low}h"
+ set high [format {%X} $high]
+ set high "[string repeat {0} [expr {3 - [string length $high]}]]${high}h"
+
+ set ::SpecCalc::timer01_tl_$obj_idx $low
+ set ::SpecCalc::timer01_th_$obj_idx $high
+ set ::SpecCalc::timer01_rest_$obj_idx $rest
+ set ::SpecCalc::timer01_repeats_$obj_idx "One"
+
+ foreach w {th tl rest} {
+ $widgets(timer01,$w) configure -fg {#000000}
+ }
+ }
+ {1} { ;# 16 bit (maybe auto-reload)
+
+ # Determinate apparent number of repeats
+ set repeats [expr {($time_int >> 16) + 1}]
+ # Calculate tempotary results
+ if {[expr {!($time_int & 0xFFFF)}]} {
+ incr repeats -1
+ set stepsPerIter 0xFFFF
+ set tmp 0
+ } {
+ set stepsPerIter [expr {$time_int / $repeats}]
+ set tmp [expr {0x10000 - $stepsPerIter}]
+ set low [expr {$tmp & 0xFF}]
+ set high [expr {$tmp >> 8}]
+ set rest [expr {$time_int - ((0xFFFF - $tmp) * $repeats)}]
+ }
+
+ # Perform correction
+ if {$rest >= $stepsPerIter} {
+ incr repeats [expr {$rest / $stepsPerIter}]
+ set rest [expr {$rest % $stepsPerIter}]
+ }
+
+ incr tmp -$rest
+ if {$tmp < 0} {
+ set rest [expr {abs($tmp)}]
+ set tmp 0
+ } {
+ set rest 0
+ }
+ set tmp [expr {$tmp & 0x0FFFF}]
+ set low_p [expr {$tmp & 0xFF}]
+ set high_p [expr {$tmp >> 8}]
+
+ set rest [expr {($rest + $time - $time_int) / $clock}]
+ set rest [adjust_rest $rest]
+
+ set low [format {%X} $low]
+ set low "[string repeat {0} [expr {3 - [string length $low]}]]${low}h"
+ set high [format {%X} $high]
+ set high "[string repeat {0} [expr {3 - [string length $high]}]]${high}h"
+ set low_p [format {%X} $low_p]
+ set low_p "[string repeat {0} [expr {3 - [string length $low_p]}]]${low_p}h"
+ set high_p [format {%X} $high_p]
+ set high_p "[string repeat {0} [expr {3 - [string length $high_p]}]]${high_p}h"
+
+ if {$enhanced} {
+ set ::SpecCalc::timer01_tl_$obj_idx $low_p
+ set ::SpecCalc::timer01_th_$obj_idx $high_p
+ set ::SpecCalc::timer01_rl_$obj_idx $low
+ set ::SpecCalc::timer01_rh_$obj_idx $high
+ set ::SpecCalc::timer01_rest_$obj_idx $rest
+ set ::SpecCalc::timer01_repeats_$obj_idx $repeats
+ foreach w {rh rl tl th rest repeats} {
+ $widgets(timer01,$w) configure -fg {#000000}
+ }
+ } {
+ if {$repeats > 1} {
+ status_tip [mc "Value is too high"]
+ return 0
+ }
+ set ::SpecCalc::timer01_tl_$obj_idx $low
+ set ::SpecCalc::timer01_th_$obj_idx $high
+ set ::SpecCalc::timer01_rest_$obj_idx $rest
+ set ::SpecCalc::timer01_repeats_$obj_idx [mc "One"]
+ foreach w {th tl rest} {
+ $widgets(timer01,$w) configure -fg {#000000}
+ }
+ }
+ }
+ {2} { ;# 8 bit auto reload
+
+ # Determinate apparent number of repeats
+ set repeats [expr {($time_int >> 8) + 1}]
+ # Calculate tempotary results
+ if {[expr {!($time_int & 0xFF)}]} {
+ incr repeats -1
+ set stepsPerIter 0xFF
+ } {
+ set stepsPerIter [expr {$time_int / $repeats}]
+ set low [expr {0x100 - $stepsPerIter}]
+ set high $low
+ set rest [expr {$time_int - ((0xFF - $low) * $repeats)}]
+ }
+
+ # Perform correction
+ if {$rest >= $stepsPerIter} {
+ incr repeats [expr {$rest / $stepsPerIter}]
+ set rest [expr {$rest % $stepsPerIter}]
+ }
+
+ incr low -$rest
+ if {$low < 0} {
+ set rest [expr {abs($low)}]
+ set low 0
+ } {
+ set rest 0
+ }
+
+ set rest [expr {($rest + $time - $time_int) / $clock}]
+ set rest [adjust_rest $rest]
+
+ set low [format {%X} $low]
+ set low "[string repeat {0} [expr {3 - [string length $low]}]]${low}h"
+ set high [format {%X} $high]
+ set high "[string repeat {0} [expr {3 - [string length $high]}]]${high}h"
+
+ set ::SpecCalc::timer01_tl_$obj_idx $low
+ set ::SpecCalc::timer01_th_$obj_idx $high
+ set ::SpecCalc::timer01_rest_$obj_idx $rest
+ set ::SpecCalc::timer01_repeats_$obj_idx $repeats
+
+ foreach w {th tl rest repeats} {
+ $widgets(timer01,$w) configure -fg {#000000}
+ }
+ }
+ }
+
+ return 1
+ }
+
+ ## Calulate time 2 preset values
+ # @return void
+ public method calculate_timer2 {} {
+ set time [$widgets(timer2,time_ent) get]
+ if {$time == {} || $time == 0} {
+ status_tip [mc "Invalid time"]
+ return 0
+ }
+
+ set clock [$widgets(timer2,clock_cb) get]
+ if {$clock == {} || $clock == 0} {
+ status_tip [mc "Invalid clock rate"]
+ return 0
+ }
+ status_tip ""
+
+ set ::SpecCalc::timer2_rcal2h_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer2_rcal2l_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer2_t2l_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer2_t2h_$obj_idx [mc "Do not change"]
+ set ::SpecCalc::timer2_repeats_$obj_idx [mc "Zero"]
+ set ::SpecCalc::timer2_rest_$obj_idx [mc "none"]
+
+ foreach w {rcal2h rcal2l t2h t2l repeats rest} {
+ $widgets(timer2,$w) configure -fg {#888888}
+ }
+
+ set time [expr {$time * [lindex {1.0 1000.0 1000000.0 1000000000.0} [$widgets(timer2,time_cb) current]]}]
+ set clock [expr {[lindex {12.0 6.0 1.0} [$widgets(timer2,clock_type_cb) current]] / $clock}]
+ set time [expr {$time * $clock}]
+ set time_int [expr {int($time)}]
+ set mode [$widgets(timer2,mode_cb) current]
+
+ # Set default results
+ set low 0
+ set high 0
+ set repeats 0
+ set rest 0
+
+ # Determinate apparent number of repeats
+ set repeats [expr {($time_int >> 16) + 1}]
+
+ if {$mode} {
+ set tmp [expr {$time_int & 0xFFFF}]
+ set low [expr {$tmp & 0xFF}]
+ set high [expr {$tmp >> 8}]
+ set rest [expr {$time - $time_int}]
+
+ set low_p $low
+ set high_p $high
+ } {
+ # Calculate tempotary results
+ if {[expr {!($time_int & 0xFFFF)}]} {
+ incr repeats -1
+ set stepsPerIter 0xFFFF
+ set tmp 0
+ } {
+ set stepsPerIter [expr {$time_int / $repeats}]
+ set tmp [expr {0x10000 - $stepsPerIter}]
+ set rest [expr {$time_int - ((0x10000 - $tmp) * $repeats)}]
+ set low [expr {$tmp & 0xFF}]
+ set high [expr {$tmp >> 8}]
+ }
+
+ # Perform correction
+ if {$rest >= $stepsPerIter} {
+ incr repeats [expr {$rest / $stepsPerIter}]
+ set rest [expr {$rest % $stepsPerIter}]
+ }
+
+ incr tmp -$rest
+ if {$tmp < 0} {
+ set rest [expr {abs($tmp)}]
+ set tmp 0
+ } {
+ set rest 0
+ }
+ set tmp [expr {$tmp & 0x0FFFF}]
+ set low_p [expr {$tmp & 0xFF}]
+ set high_p [expr {$tmp >> 8}]
+
+ }
+ set rest [expr {($rest + $time - $time_int) / $clock}]
+ set rest [adjust_rest $rest]
+
+ set low [format {%X} $low]
+ set low "[string repeat {0} [expr {3 - [string length $low]}]]${low}h"
+ set high [format {%X} $high]
+ set high "[string repeat {0} [expr {3 - [string length $high]}]]${high}h"
+ set low_p [format {%X} $low_p]
+ set low_p "[string repeat {0} [expr {3 - [string length $low_p]}]]${low_p}h"
+ set high_p [format {%X} $high_p]
+ set high_p "[string repeat {0} [expr {3 - [string length $high_p]}]]${high_p}h"
+
+ if {!$mode} {
+ set ::SpecCalc::timer2_rcal2l_$obj_idx $low
+ set ::SpecCalc::timer2_rcal2h_$obj_idx $high
+ }
+ set ::SpecCalc::timer2_t2l_$obj_idx $low_p
+ set ::SpecCalc::timer2_t2h_$obj_idx $high_p
+ set ::SpecCalc::timer2_rest_$obj_idx $rest
+ set ::SpecCalc::timer2_repeats_$obj_idx $repeats
+ foreach w {rest repeats t2h t2l} {
+ $widgets(timer2,$w) configure -fg {#000000}
+ }
+ if {!$mode} {
+ foreach w {rcal2h rcal2l} {
+ $widgets(timer2,$w) configure -fg {#000000}
+ }
+ }
+
+ return 1
+ }
+
+ ## Convert number of nano-seconds to something like this: "10 s"
+ # @parm Int rest_in_ns - Some amount of nano-seconds
+ # @return String - Human readable string
+ private method adjust_rest {rest_in_ns} {
+ set tmp $rest_in_ns
+
+ if {$tmp == 0.0} {
+ return "0"
+ }
+
+ set tmp [expr {ceil($tmp * 1000.0) / 1000.0}]
+
+ set tmp_o $tmp
+ set tmp [expr ($tmp / 1000.0)]
+ if {$tmp != int($tmp)} {
+ return "$tmp_o ns"
+ }
+
+ set tmp_o $tmp
+ set tmp [expr ($tmp / 1000.0)]
+ if {$tmp != int($tmp)} {
+ return "$tmp_o us"
+ }
+
+ set tmp_o $tmp
+ set tmp [expr ($tmp / 1000.0)]
+ if {$tmp != int($tmp)} {
+ return "$tmp_o ms"
+ }
+
+ return "$tmp s"
+ }
+
+ ## Clear results from the last calculaton of timer 0/1 preset
+ # @return void
+ private method calculate_timer01_clear_results {} {
+ foreach w {rest rh rl th tl} {
+ $widgets(timer01,$w) delete 0
+ }
+ }
+
+ ## Clear results from the last calculaton of timer 2 preset
+ # @return void
+ private method calculate_timer2_clear_results {} {
+ foreach w {rest rcal2l rcal2h} {
+ $widgets(timer2,$w) delete 0
+ }
+ }
+
+ ## Clear results from the last calculaton of timer 2 clock output preset
+ # @return void
+ private method calculate_timer2_clk_clear_results {} {
+ set ::SpecCalc::timer2_clk_rcal2h_$obj_idx {--}
+ set ::SpecCalc::timer2_clk_rcal2l_$obj_idx {--}
+ set ::SpecCalc::timer2_clk_rcal2h_d_$obj_idx {--}
+ set ::SpecCalc::timer2_clk_rcal2l_d_$obj_idx {--}
+ set ::SpecCalc::timer2_clk_error_$obj_idx {--}
+
+ foreach w {rcal2h rcal2l rcal2h_d rcal2l_d error} {
+ $widgets(timer2,clk_${w}) configure -fg {#888888}
+ }
+ }
+
+ ## Perform calculation intented for page "Timer 2 clock output"
+ # @return void
+ public method calculate_timer2_clk {} {
+ set o [subst "\$::SpecCalc::timer2_clk_fosc_$obj_idx"]
+ set f [subst "\$::SpecCalc::timer2_clk_freq_$obj_idx"]
+ set x [subst "\$::SpecCalc::timer2_clk_x2_$obj_idx"]
+ if {
+ ![string length $o] || ![string length $f] || ![string length $x] ||
+ $f == 0 || $o == 0
+ } then {
+ calculate_timer2_clk_clear_results
+ return 0
+ }
+
+ set hl [expr {int(0x10000 - ($o * 1.0 * pow(2,$x))/(2.0 * $f))}]
+ set fr [expr {($o * 1.0 * pow(2,$x)) / (2.0 * (0x10000 - $hl))}]
+ set e [expr {round(($fr - $f) * 100000.0 / $f) / 1000.0}]
+
+ set h [expr {$hl >> 8}]
+ set l [expr {$hl & 0x0FF}]
+
+ set ::SpecCalc::timer2_clk_rcal2h_d_$obj_idx $h
+ set ::SpecCalc::timer2_clk_rcal2l_d_$obj_idx $l
+ set v [format {%X} $h]
+ set v "[string repeat {0} [expr {3 - [string length $v]}]]${v}h"
+ set ::SpecCalc::timer2_clk_rcal2h_$obj_idx $v
+ set v [format {%X} $l]
+ set v "[string repeat {0} [expr {3 - [string length $v]}]]${v}h"
+ set ::SpecCalc::timer2_clk_rcal2l_$obj_idx $v
+ set ::SpecCalc::timer2_clk_error_$obj_idx "$e %"
+
+
+ foreach w {rcal2h rcal2l rcal2h_d rcal2l_d error} {
+ $widgets(timer2,clk_${w}) configure -fg {#000000}
+ }
+ }
+
+ ## Perform calculation intented for page "SPI"
+ # @parm
+ # @parm
+ # @return void
+ private method calculate_spi {type value} {
+ set const [subst "\$::SpecCalc::double_chb_$obj_idx"]
+
+ switch -- $type {
+ {sck_ent00} {
+ set freq [expr {$value * $const * 2}]
+ }
+ {sck_ent01} {
+ set freq [expr {$value * $const * 8}]
+ }
+ {sck_ent10} {
+ set freq [expr {$value * $const * 32}]
+ }
+ {sck_ent11} {
+ set freq [expr {$value * $const * 64}]
+ }
+ {double_chb} {
+ set const $value
+
+ set freq [$widgets(spi,sck_ent00) get]
+ if {![string length $freq]} {
+ return 0
+ }
+ set freq [expr {$freq * ($const == 2 ? 1 : 2) * 2}]
+ }
+ default {
+ return 0
+ }
+ }
+
+ if {![string equal $type {sck_ent00}]} {
+ $widgets(spi,sck_ent00) delete 0 end
+ $widgets(spi,sck_ent00) insert end [expr {$freq / $const / 2.0}]
+ }
+ if {![string equal $type {sck_ent01}]} {
+ $widgets(spi,sck_ent01) delete 0 end
+ $widgets(spi,sck_ent01) insert end [expr {$freq / $const / 8.0}]
+ }
+ if {![string equal $type {sck_ent10}]} {
+ $widgets(spi,sck_ent10) delete 0 end
+ $widgets(spi,sck_ent10) insert end [expr {$freq / $const / 32.0}]
+ }
+ if {![string equal $type {sck_ent11}]} {
+ $widgets(spi,sck_ent11) delete 0 end
+ $widgets(spi,sck_ent11) insert end [expr {$freq / $const / 64.0}]
+ }
+
+ set ::SpecCalc::spi_result_$obj_idx $freq
+ return 1
+ }
+
+ ## Perform certain calculation
+ # @parm String page - Page ID
+ # @parm String type - Orininator ID
+ # @parm String value - Originator value
+ # @return void
+ public method calc {page type value} {
+ if {$calc_in_progress} {return 1}
+ set calc_in_progress 1
+
+ switch -- $page {
+ {loops} {
+ switch -glob -- $type {
+ {time_ent} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(loops,time_ent) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(loops,time_ent) configure -style TEntry
+ }
+
+
+ if {![string equal [$widgets(loops,$type) get] $value]} {
+ calculate_loops_clear_results
+ }
+ }
+ {time_cb} {
+ calculate_loops_clear_results
+ }
+ {clock_cb} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value] || [string length $value] > 9} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(loops,clock_cb) configure -style SpecCalc_RedBg.TCombobox
+
+ } else {
+ $widgets(loops,clock_cb) configure -style TCombobox
+ }
+
+ calculate_loops_clear_results
+ }
+ {clock_type_cb} {
+ calculate_loops_clear_results
+ }
+ {reg_ent?} {
+ for {set i 0} {$i < 8} {incr i} {
+ $widgets(loops,reg_ent$i) configure -style TEntry
+ }
+
+ for {set j 0} {$j < 8} {incr j} {
+ for {set i 0} {$i < 8} {incr i} {
+ if {[string equal "reg_ent$i" "reg_ent$j"]} {
+ continue
+ }
+
+ if {[string equal $type "reg_ent$j"]} {
+ set val $value
+ } else {
+ set val [$widgets(loops,reg_ent$j) get]
+ }
+
+ if {[string equal -nocase \
+ $val \
+ [$widgets(loops,reg_ent$i) get] \
+ ] \
+ } then {
+ $widgets(loops,reg_ent$i) configure -style StringNotFound.TEntry
+ $widgets(loops,reg_ent$j) configure -style StringNotFound.TEntry
+ }
+ }
+ }
+
+ if {![string equal [$widgets(loops,$type) get] $value]} {
+ calculate_loops_clear_results
+ }
+
+ set calc_in_progress 0
+ return 1
+ }
+ {compute_but} {
+ if {[catch {
+ if {[calculate_loops]} {
+ calculate_loops_enable_copy 1
+ } {
+ calculate_loops_enable_copy 0
+ }
+ }]} {
+ calculate_loops_evaluation_error
+ }
+ }
+ {copy_but} {
+ clipboard clear
+ clipboard append [$widgets(loops,results) get 0.0 end]
+ }
+ }
+ }
+ {timer01} {
+ switch -- $type {
+ {time_ent} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer01,time_ent) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(timer01,time_ent) configure -style TEntry
+ }
+
+
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ {time_cb} {
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ {clock_cb} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value] || [string length $value] > 9} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer01,clock_cb) configure -style SpecCalc_RedBg.TCombobox
+ } else {
+ $widgets(timer01,clock_cb) configure -style TCombobox
+ }
+
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ {clock_type_cb} {
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ {mode_cb} {
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ {spec_chb} {
+ if {$value} {
+ grid $widgets(timer01,psc_lbl) -row 4 -column 0 -sticky w
+ grid $widgets(timer01,psc_cb) -row 4 -column 1 -sticky w
+ grid $widgets(timer01,rh_l) -row 3 -column 1 -sticky e
+ grid $widgets(timer01,rl_l) -row 4 -column 1 -sticky e
+ grid $widgets(timer01,rh) -row 3 -column 3 -sticky w
+ grid $widgets(timer01,rl) -row 4 -column 3 -sticky w
+ grid $widgets(timer01,eq3) -row 3 -column 2
+ grid $widgets(timer01,eq4) -row 4 -column 2
+ } {
+ grid forget $widgets(timer01,psc_lbl)
+ grid forget $widgets(timer01,psc_cb)
+ grid forget $widgets(timer01,rh_l)
+ grid forget $widgets(timer01,rl_l)
+ grid forget $widgets(timer01,rh)
+ grid forget $widgets(timer01,rl)
+ grid forget $widgets(timer01,eq3)
+ grid forget $widgets(timer01,eq4)
+ }
+ calculate_timer01_clear_results
+ }
+ {psc_cb} {
+ if {![regexp {^[[:digit:]]{0,3}$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {$value > 255} {
+ set calc_in_progress 0
+ return 0
+ }
+
+
+ if {![string equal [$widgets(timer01,$type) get] $value]} {
+ calculate_timer01_clear_results
+ }
+ }
+ }
+
+ after idle "catch {$this calculate_timer01}"
+ set calc_in_progress 0
+ return 1
+ }
+
+ {timer2} {
+ switch -- $type {
+ {time_ent} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer2,time_ent) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(timer2,time_ent) configure -style TEntry
+ }
+
+
+ if {![string equal [$widgets(timer2,$type) get] $value]} {
+ calculate_timer2_clear_results
+ }
+ }
+ {time_cb} {
+ if {![string equal [$widgets(timer2,$type) get] $value]} {
+ calculate_timer2_clear_results
+ }
+ }
+ {clock_cb} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value] || [string length $value] > 9} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer2,clock_cb) configure -style SpecCalc_RedBg.TCombobox
+
+ } else {
+ $widgets(timer2,clock_cb) configure -style TCombobox
+ }
+
+
+ if {![string equal [$widgets(timer2,$type) get] $value]} {
+ calculate_timer2_clear_results
+ }
+ }
+ {clock_type_cb} {
+ if {![string equal [$widgets(timer2,$type) get] $value]} {
+ calculate_timer2_clear_results
+ }
+ }
+ {mode_cb} {
+ if {![string equal [$widgets(timer2,$type) get] $value]} {
+ calculate_timer2_clear_results
+ }
+ }
+ }
+
+ after idle "catch {$this calculate_timer2}"
+ set calc_in_progress 0
+ return 1
+ }
+ {clk_timer2} {
+ switch -- $type {
+ {clk_freq} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer2,clk_freq) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(timer2,clk_freq) configure -style TEntry
+ }
+ }
+ {clk_fosc} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(timer2,clk_fosc) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(timer2,clk_fosc) configure -style TEntry
+ }
+ }
+ {clk_x2_cb} {
+ }
+ }
+
+ after idle "catch {$this calculate_timer2_clk}"
+ set calc_in_progress 0
+ return 1
+ }
+ {spi} {
+ switch -regexp $type -- {
+ {double_chb} {
+ }
+ {(sck_ent00)|(sck_ent01)|(sck_ent10)|(sck_ent11)} {
+ if {![regexp {^[0-9]*(\.[0-9]*)?$} $value]} {
+ set calc_in_progress 0
+ return 0
+
+ } elseif {![string length $value]} {
+ $widgets(spi,$type) configure -style StringNotFound.TEntry
+
+ } else {
+ $widgets(spi,$type) configure -style TEntry
+ }
+ }
+ }
+
+ if {[string length $value]} {
+ $this calculate_spi $type $value
+ }
+
+ set calc_in_progress 0
+ return 1
+ }
+
+ }
+
+ set calc_in_progress 0
+ return 1
+ }
+
+ ## Show functional diagram of something
+ # @parm String section - Section ID
+ # @parm String which - More specific ID
+ # @return void
+ public method show_diagram {section which} {
+ switch -- $section {
+ {timer01} {
+ switch -- [$widgets(timer01,mode_cb) current] {
+ 0 {
+ set title [mc "Timer 0/1 in mode 0"]
+ if {[subst "\${::SpecCalc::spec_chb_$obj_idx}"]} {
+ set image {timer_01_0e}
+ } {
+ set image {timer_01_0}
+ }
+ }
+ 1 {
+ set title [mc "Timer 0/1 in mode 1"]
+ if {[subst "\${::SpecCalc::spec_chb_$obj_idx}"]} {
+ set image {timer_01_1e}
+ } {
+ set image {timer_01_1}
+ }
+ }
+ 2 {
+ set title [mc "Timer 0/1 in mode 2"]
+ if {[subst "\${::SpecCalc::spec_chb_$obj_idx}"]} {
+ set image {timer_01_2e}
+ } {
+ set image {timer_01_2}
+ }
+ }
+ }
+ }
+ {timer2} {
+ set image {timer2_updown}
+ set title [mc "Timer 2 as up/down counter"]
+ }
+ {uart} {
+ switch -- $which {
+ {0} {
+ set image {timer_brg}
+ set title [mc "Timer 1/2 as UART baud rate generator"]
+ }
+ {1} {
+ set image {timer_brg}
+ set title [mc "Timer 1/2 as UART baud rate generator"]
+ }
+ {2} {
+ set image {ibrg_brg}
+ set title [mc "Internal baud rate generator"]
+ }
+ default {
+ return
+ }
+ }
+ }
+ }
+
+ set dlg [toplevel .spec_calc_diagram_$diagram_counter -class [mc "Diagram or formula"] -bg {#EEEEEE}]
+ pack [label $dlg.image \
+ -image [image create photo -format png -file "${::LIB_DIRNAME}/../icons/other/$image.png"]
+ ] -fill both
+
+ wm title $dlg $title
+ wm iconphoto $dlg ::ICONS::16::info
+ wm resizable $dlg 0 0
+
+ incr diagram_counter
+ }
+}
diff --git a/lib/utilities/symbol_viewer.tcl b/lib/utilities/symbol_viewer.tcl
new file mode 100755
index 0000000..3df57b4
--- /dev/null
+++ b/lib/utilities/symbol_viewer.tcl
@@ -0,0 +1,837 @@
+#!/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 assembly language symbols viewer (from code listing)
+# --------------------------------------------------------------------------
+
+class SymbolViewer {
+ ## Class variables
+ # Int: Counter of object intances
+ common count 0
+ # Font: Just normal font used in the table
+ common normal_font [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -15 \
+ -weight normal \
+ ]
+ # Font: Bold font (the same size as $normal_font)
+ common bold_font [font create \
+ -family $::DEFAULT_FIXED_FONT \
+ -size -15 \
+ -weight bold \
+ ]
+ # Dialog configuration
+ common config_list $::CONFIG(SYMBOL_VIEWER_CONFIG)
+
+ ## Private object variables
+ private variable obj_idx ;# Int: Current object number
+ private variable symbol_table_data {} ;# List: Data loaded from the code listing (see func. open_file)
+ private variable current_line {} ;# List: Current line data (selected lide in the table)
+ private variable opened_file {} ;# String: Full file name of the currently loaded code listing file
+ private variable win ;# Widget: Dialog window
+ private variable menu ;# Widget: Popup menu for the text widget
+ private variable main_frame ;# Widget: Dialog main frame
+ private variable reload_but ;# Widget: Button "Reload"
+ private variable search_entry ;# Widget: EntryBox "Search"
+ private variable clear_but ;# Widget: Button "Clear search entrybox"
+ private variable status_bar_lbl ;# Widget: Status bar label widget
+ private variable opened_file_lbl ;# Widget: Label on statusbar showing name of currently opened file
+ private variable text_widget ;# Widget: Text widget containing the table of symbols
+
+ constructor {} {
+ # Create dialog window
+ set win [toplevel .symbolviewer$count -class {Defined symbols} -bg {#EEEEEE}]
+ set obj_idx $count
+ incr count
+
+ # Create dialog GUI
+ set main_frame [frame $win.main_frame]
+ create_gui ;# Create widgets
+ create_menus ;# Create menus
+ create_tags ;# Create text tags
+ create_bindings ;# Set event bindings
+
+ # Set values for checkboxes in panel "Display"
+ set i 0
+ foreach name {DATA IDATA XDATA CODE BIT Number used unused} {
+ set ::SymbolViewer::display_${obj_idx}($name) [lindex $config_list $i]
+ incr i
+ }
+ # Set values for radiobuttons in panel "Sort by"
+ set ::SymbolViewer::sort_by_${obj_idx} [lindex $config_list $i]
+ incr i
+ set ::SymbolViewer::sort_by_order_${obj_idx} [lindex $config_list $i]
+ incr i
+
+ # Finalize GUI
+ pack $main_frame -fill both -expand 1 -padx 5 -pady 5
+ bindtags $win [list $win Toplevel all .]
+ focus -force $search_entry
+
+ # Configure dialog window
+ wm iconphoto $win ::ICONS::16::symbol
+ wm title $win [mc "Assembly symbol table - MCU 8051 IDE"]
+ wm minsize $win 620 350
+ wm protocol $win WM_DELETE_WINDOW "$this close_window"
+ catch {
+ wm geometry $win [lindex $config_list $i]
+ }
+
+ # Set ...
+ incr i
+ set ::SymbolViewer::display_${obj_idx}(Special) [lindex $config_list $i]
+ if {[subst "\$::SymbolViewer::display_${obj_idx}(Special)"] == {}} {
+ set ::SymbolViewer::display_${obj_idx}(Special) 1
+ }
+ }
+
+ destructor {
+ # Save tool configuration
+ if {[llength $config_list] < 12} {
+ set config_list [list {} {} {} {} {} {} {} {} {} {} {} {}]
+ }
+ set i 0
+ foreach name {DATA IDATA XDATA CODE BIT Number used unused} {
+ lset config_list $i [subst "\$::SymbolViewer::display_${obj_idx}($name)"]
+ incr i
+ }
+ lset config_list $i [subst "\$::SymbolViewer::sort_by_${obj_idx}"]
+ incr i
+ lset config_list $i [subst "\$::SymbolViewer::sort_by_order_${obj_idx}"]
+ incr i
+ lset config_list $i [wm geometry $win]
+ incr i
+ lset config_list $i [subst "\$::SymbolViewer::display_${obj_idx}(Special)"]
+
+ # Clean up
+ unset ::SymbolViewer::sort_by_${obj_idx}
+ unset ::SymbolViewer::sort_by_order_${obj_idx}
+ array unset ::SymbolViewer::display_${obj_idx}
+
+ # Remove dialog window
+ destroy $win
+ }
+
+ ## Create menus
+ # @return void
+ private method create_menus {} {
+ ## Create text widget popup menu
+ set menu [menu $text_widget.menu]
+ $menu add command -label [mc "Copy symbol name"] -compound left \
+ -underline 12 -command "$this text_copy_proc name"
+ $menu add command -label [mc "Copy hex value"] -compound left \
+ -underline 5 -command "$this text_copy_proc hex"
+ $menu add command -label [mc "Copy dec value"] -compound left \
+ -underline 5 -command "$this text_copy_proc dec"
+ $menu add separator
+ $menu add command -label [mc "Copy line"] -compound left \
+ -underline 1 -command "$this text_copy_proc line" \
+ -image ::ICONS::16::editcopy -accelerator {Ctrl+C}
+ }
+
+ ## Set event bindings for window widgets
+ # @return void
+ private method create_bindings {} {
+ bind $text_widget <ButtonRelease-3> "$this invoke_popup_menu %X %Y %x %y; break"
+ bind $text_widget <<Selection>> "false_selection $text_widget; break"
+ bind $text_widget <Button-1> "focus %W; $this select_line %x %y"
+ bind $text_widget <Key-Down> "$this key_down"
+ bind $text_widget <Key-Up> "$this key_up"
+ bind $text_widget <Control-Key-c> "$this text_copy_proc line; break"
+
+ bind $win <Control-Key-o> "$this open_file_dialog; break"
+ bind $win <Key-F5> "$this reload; break"
+ bind $win <Control-Key-q> "$this close_window; break"
+
+ bindtags $search_entry [list $search_entry TEntry $win all .]
+ bindtags $text_widget [list $text_widget Text $win all .]
+ }
+
+ ## Create text tags
+ # @return void
+ private method create_tags {} {
+ $text_widget tag configure type_DATA -foreground {#00DD00}
+ $text_widget tag configure type_IDATA -foreground {#0000DD}
+ $text_widget tag configure type_XDATA -foreground {#DD0000}
+ $text_widget tag configure type_CODE -foreground {#00DDDD}
+ $text_widget tag configure type_BIT -foreground {#AA8800}
+ $text_widget tag configure type_Special -foreground {#AA00FF}
+ $text_widget tag configure type_Number -foreground {#DD00DD}
+ $text_widget tag configure used_YES -foreground {#00DD00}
+ $text_widget tag configure used_NO -foreground {#DD0000}
+ $text_widget tag configure tag_sel -background {#DDDDDD} -font $bold_font
+ $text_widget tag configure nth_row -background {#EEEEEE}
+
+ $text_widget tag raise tag_sel nth_row
+ }
+
+ ## Create window widgets
+ # @return void
+ private method create_gui {} {
+ # Create window frames
+ set top_frame [frame $main_frame.top_frame] ;# Button "Open"+"Reload" + Search bar
+ set middle_frame [frame $main_frame.middle_frame] ;# Table of symbols
+ set bottom_frame [frame $main_frame.bottom_frame] ;# Display options
+ set sbar_frame [frame $main_frame.sbar_frame] ;# Status bar
+
+ ## Create status bar
+ set status_bar_lbl [label $sbar_frame.main_lbl \
+ -justify left -anchor w \
+ ]
+ set opened_file_lbl [label $sbar_frame.opened_file_lbl -fg {#0000DD}]
+ pack $status_bar_lbl -fill x -side left
+ pack $opened_file_lbl -side right -after $status_bar_lbl
+
+ ## Create top frame
+ # Button "Open file"
+ pack [ttk::button $top_frame.open_but \
+ -image ::ICONS::16::fileopen \
+ -text [mc "Open *.LST"] \
+ -compound left \
+ -command "$this open_file_dialog" \
+ ] -side left
+ DynamicHelp::add $top_frame.open_but \
+ -text [mc "Load table of symbols from list file (*.lst)\n\tOnly for: ASEM-51, MCU8051IDE and ASM51"]
+ set_locat_status_tip $top_frame.open_but [mc "Open code listing"]
+ # Button "Reload"
+ set reload_but [ttk::button $top_frame.reload_but \
+ -image ::ICONS::16::reload \
+ -text [mc "Reload"] \
+ -compound left \
+ -command "$this reload" \
+ -state disabled \
+ ]
+ pack $reload_but -side left -padx 5
+ set_locat_status_tip $reload_but [mc "Reload opened file"]
+ ## Create search bar
+ set top_r_frame [frame $top_frame.right_frame]
+ # - Label
+ pack [label $top_r_frame.search_lbl \
+ -text [mc "Search:"] \
+ ] -side left
+ # - Entry
+ set search_entry [ttk::entry $top_r_frame.search_entry \
+ -validate all \
+ -validatecommand "$this search_validate %P" \
+ ]
+ DynamicHelp::add $search_entry \
+ -text [mc "Search for symbol by its name or value"]
+ set_locat_status_tip $search_entry [mc "Search for symbol"]
+ pack $search_entry -side left
+ # - Button
+ set clear_but [ttk::button $top_r_frame.clear_but \
+ -state disabled \
+ -style Flat.TButton \
+ -image ::ICONS::16::clear_left \
+ -command "$search_entry delete 0 end" \
+ ]
+ set_locat_status_tip $clear_but [mc "Clear search entry box"]
+ pack $clear_but -side left
+ pack $top_r_frame -side right
+
+ ## Create table of symbols
+ set middle_l_frame [frame $middle_frame.left_frame -bd 1 -relief sunken]
+ pack [label $middle_l_frame.header_lbl \
+ -bg white -padx 0 -pady 0 -width 0 \
+ -text [mc "Symbol\t\t\t\tType\tHEX\tDEC\tUsed"] \
+ -font $bold_font -anchor w -justify left \
+ ] -fill x
+ pack [ttk::separator $middle_l_frame.sep \
+ -orient horizontal \
+ ] -fill x
+ set text_widget [text $middle_l_frame.text \
+ -bg white -width 0 -height 0 -bd 0 -relief flat \
+ -yscrollcommand "$middle_frame.scrollbar set" \
+ -cursor left_ptr -font $normal_font \
+ -state disabled \
+ ]
+ pack $text_widget -fill both -expand 1
+
+ pack $middle_l_frame -side left -fill both -expand 1
+ pack [ttk::scrollbar $middle_frame.scrollbar \
+ -orient vertical -command "$text_widget yview" \
+ ] -fill y -side right -after $middle_l_frame
+
+ ## Create display options
+ set main_opt_frame [ttk::labelframe \
+ $bottom_frame.main_opt_frm \
+ -text [mc "Display"] \
+ -padding 10 \
+ ]
+ set row 0
+ set col 0
+ set i 0
+ foreach name {DATA IDATA XDATA CODE BIT Number Special} {
+ if {$col > 2} {
+ set col 0
+ incr row
+ }
+ grid [checkbutton $main_opt_frame.cb_x_$i \
+ -text $name -onvalue 1 -offvalue 0 \
+ -variable ::SymbolViewer::display_${obj_idx}($name) \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column $col
+ incr i
+ incr col
+ }
+ incr row
+ grid [ttk::separator $main_opt_frame.sep \
+ -orient horizontal \
+ ] -sticky we -row $row -column 0 -columnspan 3
+ incr row
+ grid [checkbutton $main_opt_frame.cb_x_us \
+ -text [mc "Used symbols"] -onvalue 1 -offvalue 0 \
+ -variable ::SymbolViewer::display_${obj_idx}(used) \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column 0 -columnspan 3
+ incr row
+ grid [checkbutton $main_opt_frame.cb_x_uus \
+ -text [mc "Unused symbols"] -onvalue 1 -offvalue 0 \
+ -variable ::SymbolViewer::display_${obj_idx}(unused) \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column 0 -columnspan 3
+ pack $main_opt_frame -side left -fill y -anchor n -padx 5
+
+ # Create frame "Sort by"
+ set sort_by_frame [ttk::labelframe \
+ $bottom_frame.sort_by_frm \
+ -text [mc "Sort by"] \
+ -padding 10 \
+ ]
+ set row 0
+ set col 0
+ set i 0
+ foreach name {{Symbol name} Type {Hex value} {Dec value} {Usage}} {
+ if {$col > 2} {
+ set col 0
+ incr row
+ }
+ grid [radiobutton $sort_by_frame.rb_x_$i \
+ -text $name -value $i \
+ -variable ::SymbolViewer::sort_by_${obj_idx} \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column $col
+ incr i
+ incr col
+ }
+ incr row
+ grid [ttk::separator $sort_by_frame.sep \
+ -orient horizontal \
+ ] -sticky we -row $row -column 0 -columnspan 3
+ incr row
+ grid [radiobutton $sort_by_frame.rb_x_inc \
+ -text [mc "Incremental order"] -value 0 \
+ -variable ::SymbolViewer::sort_by_order_${obj_idx} \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column 0 -columnspan 3
+ incr row
+ grid [radiobutton $sort_by_frame.rb_x_dec \
+ -text [mc "Decremental order"] -value 1 \
+ -variable ::SymbolViewer::sort_by_order_${obj_idx} \
+ -command "$this refresh" \
+ ] -sticky w -row $row -column 0 -columnspan 3
+ pack $sort_by_frame -side left -fill y -anchor n -padx 10
+
+ # Pack window frames
+ pack $top_frame -fill x
+ pack $middle_frame -fill both -expand 1 -pady 7
+ pack $bottom_frame -fill x
+ pack $sbar_frame -fill x
+ }
+
+ ## Set local statusbar tip
+ # @parm Widget widget - Target widget
+ # @parm String text - Statusbar tip itselft
+ # @return void
+ private method set_locat_status_tip {widget text} {
+ bind $widget <Enter> [list $status_bar_lbl configure -text $text]
+ bind $widget <Leave> [list $status_bar_lbl configure -text {}]
+ }
+
+ ## Close dialog window
+ # @return void
+ public method close_window {} {
+ ::itcl::delete object $this
+ }
+
+ ## Invoke file selection dialog to load a new table of symbols for LST file
+ # @return void
+ public method open_file_dialog {} {
+ # Determinate initial directory
+ if {$opened_file == {}} {
+ if {${::X::project_menu_locked}} {
+ set directory {~}
+ } {
+ set directory [${::X::actualProject} cget -projectPath]
+ }
+ } {
+ set directory [file dirname $opened_file]
+ }
+
+ # Invoke project selection dialog
+ KIFSD::FSD ::fsd \
+ -title [mc "Load symbol table - MCU 8051 IDE"] \
+ -directory $directory -master $win \
+ -defaultmask 0 -multiple 0 -filetypes {
+ {{Code listing} {*.lst} }
+ {{All files} {*} }
+ }
+
+ # Open the selected after press of OK button
+ ::fsd setokcmd "
+ ::fsd deactivate
+ $this open_file 0 \[::fsd get\]"
+
+ ::fsd activate ;# Activate the dialog
+ }
+
+ ## Reload opened file if any
+ # @return void
+ public method reload {} {
+ open_file 0 $opened_file
+ }
+
+ ## Try to open LST file and load table of symbols from it
+ # @parm Bool ignore_errors - Ignore erros while opening the file
+ # @parm String filename - Name of file to load
+ # @return void
+ public method open_file {ignore_errors filename} {
+ if {[catch {
+ set file [open $filename r]
+ }]} {
+ if {!$ignore_errors} {
+ tk_messageBox \
+ -parent $win \
+ -type ok \
+ -icon warning \
+ -title [mc "Invalid file"] \
+ -message [mc "Unable to use selected file. Please check your permissions. File: '%s'" $filename]
+ }
+ return
+ }
+
+ # Parse file
+ set symbol_table_data {}
+ set read_line 0
+ set line {}
+ set name {}
+ set addr {}
+ set type {}
+ set used 1
+ while {![eof $file]} {
+ set used 1
+ set line [gets $file]
+
+ # Empty line - stop reading
+ if {![string length [string trimright $line "  \f"]]} {
+ set read_line 0
+ continue
+
+ # MCU 8051 IDE Assembler symbol table
+ } elseif {![string first {SYMBOL TABLE:} $line]} {
+ set read_line 1
+ continue
+
+ # ASEM-51 Assembler symbol table
+ } elseif {![string first {------------------------------------------------------------} $line]} {
+ set read_line 2
+ continue
+ }
+
+
+ # MCU 8051 IDE Assembler symbol
+ if {$read_line == 1} {
+ if {![regexp {^(\?\?)?\w+} $line name]} {
+ continue
+ }
+ if {![regexp {[\w\s]+$} $line line]} {
+ continue
+ }
+ set type [lindex $line 0]
+ if {$type == {S}} {
+ set addr [lindex $line end]
+ } {
+ set addr [string replace [lindex $line 2] end end]
+ }
+
+ # Determinate whether symbol is used
+ if {[lindex $line end-1] == {NOT} || [lindex $line end-2] == {NOT}} {
+ set used 0
+ }
+
+ # ASEM-51 Assembler symbol
+ } elseif {$read_line == 2} {
+ # Remove dangerous characters
+ regsub -all {\{\}\"\"} $line {} line
+
+ if {[llength $line] < 4} {
+ set used 0
+ }
+ set addr [lindex $line 2]
+ set name [lindex $line 0]
+ set type [string index [lindex $line 1] 0]
+
+ # Hexadecimal address must be 4 characters long
+ if {!($type == {S} || $type == {R})} {
+ set addr "[string repeat 0 [expr {4 - [string length $addr]}]]$addr"
+ }
+
+ # This line is not a part of symbol table
+ } else {
+ continue
+ }
+
+ # Address must be a valid hexadecimal value
+ if {![string is xdigit -strict $addr] && !($type == {S} || $type == {R})} {
+ continue
+ }
+
+ # Create new register watch
+ if {[string length $name] > 31} {
+ set name [string range $name 0 27]
+ append name {...}
+ }
+
+ if {$type == {S} || $type == {R}} {
+ lappend symbol_table_data [list $name $type $addr {0} $used]
+ } {
+ lappend symbol_table_data [list $name $type $addr [expr "0x$addr"] $used]
+ }
+ }
+
+ set opened_file $filename
+ $reload_but configure -state normal
+ $opened_file_lbl configure -text [file tail $filename]
+ close $file
+ refresh
+ }
+
+ ## Sort list of loaded symbols acording to user settings
+ # @return void
+ private method sort_table {} {
+ if {[subst "\$::SymbolViewer::sort_by_order_${obj_idx}"]} {
+ set order {-decreasing}
+ } {
+ set order {-increasing}
+ }
+ set index [subst "\$::SymbolViewer::sort_by_${obj_idx}"]
+ if {$index == 3} {
+ set type {-integer}
+ } {
+ set type {-dictionary}
+ }
+
+ set symbol_table_data [lsort $order $type -index $index $symbol_table_data]
+ }
+
+ ## Filter record with the given type and use flag
+ # @parm Char type - Record type
+ # @parm Bool used - Used flag
+ # @return List - {$long_type $long_used} or {0}
+ private method filter_record {type used} {
+ # Adjust symbol type
+ switch -- $type {
+ {D} {set type {DATA}}
+ {I} {set type {IDATA}}
+ {X} {set type {XDATA}}
+ {C} {set type {CODE}}
+ {B} {set type {BIT}}
+ {N} {set type {Number}}
+ {S} {set type {Special}}
+ {R} {set type {Special}}
+ }
+ if {![subst "\$::SymbolViewer::display_${obj_idx}($type)"]} {
+ return 0
+ }
+
+ # Adjust flag USED
+ if {$used} {
+ if {![subst "\$::SymbolViewer::display_${obj_idx}(used)"]} {
+ return 0
+ }
+ set used {YES}
+ } {
+ if {![subst "\$::SymbolViewer::display_${obj_idx}(unused)"]} {
+ return 0
+ }
+ set used {NO}
+ }
+
+ return [list $type $used]
+ }
+
+ ## Refresh table of symbols (reload contents of the text widget from $symbol_table_data)
+ # @return void
+ public method refresh {} {
+ # There must be something loaded
+ if {$opened_file == {}} {
+ return
+ }
+
+ # Save data of the selected line
+ if {$current_line != {}} {
+ set current_line [$text_widget get $current_line.0 [list $current_line.0 lineend]]
+ set current_line [list \
+ [lindex $current_line 0] [lindex $current_line 1] \
+ [lindex $current_line 2] [lindex $current_line 3] \
+ [lindex $current_line 4] \
+ ]
+
+ lset current_line 1 [string index [lindex $current_line 1] 0]
+ if {[lindex $current_line 4] == {YES}} {
+ lset current_line 4 1
+ } {
+ lset current_line 4 0
+ }
+ }
+
+ # Sort loaded table of symbols
+ sort_table
+
+ # Clear the text widget
+ $text_widget configure -state normal
+ $text_widget delete 0.0 end
+
+ # Load table of symbols to the text widget
+ set idx 0 ;# Int: Symbol number (just index in the table, nothing more)
+ set name {} ;# String: Symbol name defined in source code
+ set type {} ;# Char: Symbol type (see func. code)
+ set hexv {} ;# String: Hexadecimal symbol value
+ set decv {} ;# Int: Decimal symbol value
+ set used {} ;# Bool: Symbol used in source code
+ set cur_found 0 ;# Bool: Current line found
+ foreach symbol_def $symbol_table_data {
+ set name [lindex $symbol_def 0]
+ set type [lindex $symbol_def 1]
+ set hexv [lindex $symbol_def 2]
+ set decv [lindex $symbol_def 3]
+ set used [lindex $symbol_def 4]
+
+ # Filter record
+ set used [filter_record $type $used]
+ if {$used == {0}} {
+ continue
+ }
+ set type [lindex $used 0]
+ set used [lindex $used 1]
+
+ # Insert new record into the table
+ $text_widget insert insert $name
+ $text_widget insert insert [string repeat { } [expr {32 - [string length $name]}]]
+ $text_widget insert insert $type
+ $text_widget insert insert [string repeat { } [expr {8 - [string length $type]}]]
+ $text_widget tag add type_${type} insert-8c insert
+ if {$type == {Special}} {
+ $text_widget insert insert $hexv
+ $text_widget insert insert [string repeat { } [expr {16 - [string length $hexv]}]]
+ } {
+ $text_widget insert insert $hexv
+ $text_widget insert insert { }
+ $text_widget insert insert $decv
+ $text_widget insert insert [string repeat { } [expr {8 - [string length $decv]}]]
+ }
+ $text_widget insert insert $used
+ $text_widget tag add used_${used} insert-3c insert
+ $text_widget insert insert "\n"
+ if {!($idx % 3)} {
+ $text_widget tag add nth_row insert-1l insert
+ }
+
+ # Try to find the selected line
+ if {!$cur_found && [string equal $current_line $symbol_def]} {
+ set cur_found 1
+ set current_line $idx
+ incr current_line
+ }
+
+ incr idx
+ }
+
+ # Restore selection
+ if {$cur_found} {
+ $text_widget tag add tag_sel $current_line.0 $current_line.0+1l
+ $text_widget see $current_line.0
+ } {
+ set current_line {}
+ }
+
+ # Disable the text widget and clear search entrybox
+ $text_widget configure -state disabled
+ $search_entry delete 0 end
+ }
+
+ ## Select line in the table (event: <Button-1>)
+ # @parm Int x - Relative X coordinate
+ # @parm Int y - Relative Y coordinate
+ # @return void
+ public method select_line {x y} {
+ set current_line [expr {int([$text_widget index @$x,$y])}]
+ if {$current_line == int([$text_widget index end])-1} {
+ set current_line {}
+ return
+ }
+ $search_entry delete 0 end
+ $text_widget tag remove tag_sel 0.0 end
+ $text_widget tag add tag_sel $current_line.0 $current_line.0+1l
+ }
+
+ ## Search entrybox validator
+ # @parm String string - String to validate (search for)
+ # @return Bool - always 1
+ public method search_validate {string} {
+ # Not empty string
+ if {[string length $string]} {
+ set string [string tolower [string trimleft $string 0]]
+ $clear_but configure -state normal
+ # Empty string -> abort
+ } {
+ $search_entry configure -style TEntry
+ $clear_but configure -state disabled
+ return 1
+ }
+
+ # Search in the table
+ set i 0
+ set found_idx -1
+ foreach symbol_def $symbol_table_data {
+ set name [string tolower [lindex $symbol_def 0]]
+ set type [lindex $symbol_def 1]
+ set hexv [string trimleft [string tolower [lindex $symbol_def 2]] 0]
+ set decv [lindex $symbol_def 3]
+ set used [lindex $symbol_def 4]
+
+ if {[filter_record $type $used] == {0}} {
+ continue
+ }
+
+ if {![string first $string $name]} {
+ set found_idx $i
+ break
+ }
+ if {![string first $string $hexv]} {
+ set found_idx $i
+ break
+ }
+ if {![string first $string $decv]} {
+ set found_idx $i
+ break
+ }
+
+ incr i
+ }
+
+ set current_line {}
+ $text_widget tag remove tag_sel 0.0 end
+
+ # String not found
+ if {$found_idx == -1} {
+ $search_entry configure -style StringNotFound.TEntry
+ # String found
+ } {
+ set current_line [expr {$found_idx + 1}]
+ $text_widget tag add tag_sel $current_line.0 $current_line.0+1l
+ $text_widget see $current_line.0
+ $search_entry configure -style StringFound.TEntry
+ }
+
+ return 1
+ }
+
+ ## Event handler of the text widget <Key-Up>
+ # Select line above the currently selected one
+ # @return void
+ public method key_up {} {
+ if {$current_line == {} || $current_line < 2} {
+ return
+ }
+ incr current_line -1
+ $text_widget tag remove tag_sel 0.0 end
+ $text_widget tag add tag_sel $current_line.0 $current_line.0+1l
+ $search_entry delete 0 end
+ }
+
+ ## Event handler of the text widget <Key-Down>
+ # Select line below the currently selected one
+ # @return void
+ public method key_down {} {
+ if {$current_line == {} || $current_line >= ([$text_widget index end] - 2)} {
+ return
+ }
+ incr current_line
+ $text_widget tag remove tag_sel 0.0 end
+ $text_widget tag add tag_sel $current_line.0 $current_line.0+1l
+ $search_entry delete 0 end
+ }
+
+ ## Invoke text widget popup menu
+ # @parm Int X - Absolute mouse pointer X coordinate
+ # @parm Int Y - Absolute mouse pointer X coordinate
+ # @parm Int x - Relative mouse pointer X coordinate
+ # @parm Int y - Relative mouse pointer X coordinate
+ # @return void
+ public method invoke_popup_menu {X Y x y} {
+ select_line $x $y
+ if {$current_line == {}} {
+ set state disabled
+ } {
+ set state normal
+ }
+ foreach entry {{Copy symbol name} {Copy hex value} {Copy dec value} {Copy line}} {
+ $menu entryconfigure [::mc $entry] -state $state
+ }
+ tk_popup $menu $X $Y
+ }
+
+ ## Copy piece of the table into clipboard
+ # @parm Char mode - What to copy
+ # name - Symbol name
+ # hex - Symbol hexadecimal value
+ # dec - Symbol decimal value
+ # line - Whole symbol definition
+ # @return void
+ public method text_copy_proc {mode} {
+ switch -- $mode {
+ {name} {
+ set s 0
+ set e 31
+ }
+ {hex} {
+ set s 39
+ set e 44
+ }
+ {dec} {
+ set s 47
+ set e 52
+ }
+ {line} {
+ set s 0
+ set e 63
+ }
+ }
+
+ clipboard clear
+ clipboard append [string trim [$text_widget get $current_line.$s $current_line.$e]]
+ }
+}