From 5b8466f7fae0e071c0f4eda13051c93313910028 Mon Sep 17 00:00:00 2001 From: Andrej Shadura Date: Tue, 8 May 2018 15:59:29 +0200 Subject: Import Upstream version 1.3.7 --- lib/utilities/asciichart.tcl | 752 ++++++++++++ lib/utilities/baseconvertor.tcl | 912 +++++++++++++++ lib/utilities/eightsegment.tcl | 509 +++++++++ lib/utilities/hexeditdlg.tcl | 1793 +++++++++++++++++++++++++++++ lib/utilities/notes.tcl | 896 +++++++++++++++ lib/utilities/rs232debugger.tcl | 1460 ++++++++++++++++++++++++ lib/utilities/speccalc.tcl | 2390 +++++++++++++++++++++++++++++++++++++++ lib/utilities/symbol_viewer.tcl | 837 ++++++++++++++ 8 files changed, 9549 insertions(+) create mode 100755 lib/utilities/asciichart.tcl create mode 100755 lib/utilities/baseconvertor.tcl create mode 100755 lib/utilities/eightsegment.tcl create mode 100755 lib/utilities/hexeditdlg.tcl create mode 100755 lib/utilities/notes.tcl create mode 100755 lib/utilities/rs232debugger.tcl create mode 100755 lib/utilities/speccalc.tcl create mode 100755 lib/utilities/symbol_viewer.tcl (limited to 'lib/utilities') 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 "::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 "$this cell_enter $address" + bind $wdg "$this cell_leave $address" + bind $wdg "$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 \ + "$status_bar_lbl configure -text {[mc {Copy to clipboard}]}" + bind $details_frame.copy_${type}_but \ + "$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 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 on canvas widget with bits, + # @parm Int r - Row number (0..5) + # @parm Int b - Bit number (0..7) + # @return void + public method bit_leave {r b} { + # Determinate current rectangle fill and outline + set fill [$entry_t($r) itemcget $bit($r,$b) -fill] + set outline [$entry_t($r) itemcget $bit($r,$b) -outline] + + # Determinate new rectangle fill and outline + if {$fill == ${::BitMap::one_a_fill}} { + set fill ${::BitMap::one_fill} + set outline ${::BitMap::one_outline} + } elseif {$fill == ${::BitMap::zero_a_fill}} { + set fill ${::BitMap::zero_fill} + set outline ${::BitMap::zero_outline} + } + + # Set new rectangle fill and outline and adjust cursor + $entry_t($r) itemconfigure $bit($r,$b) \ + -fill $fill -outline $outline + $entry_t($r) configure -cursor left_ptr + } + + ## Handles event on canvas widget with bits, + # @parm Int r - Row number (0..5) + # @parm Int b - Bit number (0..7) + # @return void + public method bit_click {r b} { + # Determinate current rectangle fill + set fill [$entry_t($r) itemcget $bit($r,$b) -fill] + + # Determinate new bit value + if { + $fill == ${::BitMap::one_a_fill} + || + $fill == ${::BitMap::one_fill} + } then { + set value 0 + } else { + set value [expr {1 << $b}] + } + + # Determinate new value for the whole row + set dec [$entry_d($r) get] + if {![string length $dec]} { + set dec 0 + } + set dec [expr {$dec & (0x0FF ^ (1 << $b))}] + incr dec $value + + # Set new value for the whole row + validate {t} $r $dec + } + + ## Set envent binds specific to this appliaction for the specified entrybox + # @parm Widget w - Entrybox widget + # @parm Char t - Entrybox type + # h - Hexadecimal + # d - Decimal + # b - Binary + # o - Octal + # c0 - BCD - Low order nibble + # c1 - BCD - High order nibble + # a - ASCII + # @parm Int r - Row number (0..5) + # @return void + private method set_bindings_for_an_entrybox {w t r} { + bind $w "$this entry_key $t $r u; break" + bind $w "$this entry_key $t $r d; break" + bind $w "$this entry_key $t $r l; break" + bind $w "$this entry_key $t $r r; break" + bind $w "$this entry_key $t $r t; break" + if {!$::MICROSOFT_WINDOWS} { + bind $w "$this entry_key $t $r s; break" + } + bind $w "$this entry_key $t $r e; break" + bind $w "$this entry_key $t $r e; break" + + bind $w "$this entry_focus $t $r 1" + bind $w "$this entry_focus $t $r 0" + } + + ## Create the left frame of the window + # @return void + private method create_left_frame {} { + # Create labels + if {!$left_rows_created} { + set col 1 + foreach text { + {HEX} {DEC} {BIN} {OCT} + } { + grid [label $left_top_frame.header_lbl_${col} \ + -font $::smallfont -text [mc $text] -pady 0 \ + ] -pady 0 -ipady 0 -row 1 -column $col + incr col + } + } + + # Create entryboxes + set row 0 + for {set row $left_rows_created} {$row < ($large ? 6 : 3)} {incr row} { + set col 1 + foreach width { + 2 3 8 3 + } type { + h d b o + } \ + { + set entry_wgd [ttk::entry $left_top_frame.e_${type}_$row \ + -width $width \ + -validate key \ + -validatecommand "$this validate $type $row %P" \ + ] + 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) "$this bit_enter $row $b" + $canvas bind $bit($row,$b) "$this bit_leave $row $b" + $canvas bind $bit($row,$b) "$this bit_click $row $b" + + # Adjust X position for the next rectagle + incr x0 14 + if {$b == 4} { + incr x0 3 + } + } + } + } + + incr col + } + } + set right_rows_created $row + } + + ## Switch between modes "Enlarged" and "Shrinked" + # @return void + public method enlarge_shrink {} { + # Invert the mode flag + set large [expr {!$large}] + + # Adjust buttons on the bottom bar and create the missing widgets if nessesary + if {$large} { + create_right_frame + create_left_frame + $win_obj geometry {} [expr {[winfo height $entry_h(0)] * 3 + 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 and + # Change entryboxes background colors + # @parm Char type - Entrybox type + # h - Hexadecimal + # d - Decimal + # b - Binary + # o - Octal + # c0 - BCD - Low order nibble + # c1 - BCD - High order nibble + # a - ASCII + # @parm Int row - Row number (0..5) + # @parm Bool focused - 1 == ; 0 == + # @return void + public method entry_focus {type row focused} { + if {$focused} { + set style 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 , , , , , + #+ , and + # @parm Char type - Entrybox type + # h - Hexadecimal + # d - Decimal + # b - Binary + # o - Octal + # c0 - BCD - Low order nibble + # c1 - BCD - High order nibble + # a - ASCII + # @parm Int y - Row number (0..5) + # @parm Char key - Key pressed + # u - Up + # d - Down + # l - Left + # r - Right + # t - Tab + # s - Shift-Tab + # e - Enter + # @return void + public method entry_key {type y key} { + set entrybox [subst "\$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 "::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) "$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 "$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) <> "$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 [list $status_bar configure -text $text] + bind $widget [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 "$this openhex; break" + bind $widget "$this save; break" + bind $widget "$this saveas; break" + bind $widget "$this reload; break" + bind $widget "$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 <> "$this menu_sbar_show 0 \[%W index active\]" + bind $edit_menu <> "$this menu_sbar_show 1 \[%W index active\]" + bind $mode_menu <> "$this menu_sbar_show 2 \[%W index active\]" + bind $file_menu "$this sbar_show {}" + bind $edit_menu "$this sbar_show {}" + bind $mode_menu "$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 <> [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 [list $this sbar_show $txt] + bind $wdg [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 + # @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 + # @return void + public method title_B1_release {} { + $title_label configure -cursor left_ptr + } + + ## Event handler: title bar + # @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 + # @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 + # @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 "$this collapse_expand" + bind $title_label "$this title_B1 %X %Y" + bind $title_label "$this title_B1_motion %X %Y" + bind $title_label "$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 "$this canvas_B1 %x %y" + bind $canvas_widget "$this canvas_B1_motion %x %y" + bind $canvas_widget "$this canvas_motion %x %y" + bind $canvas_widget "$this canvas_B1_release %x %y" + bind $canvas_widget "$this popup_menu %x %y %X %Y" + bind $canvas_widget "$this canvas_leave" + bind $canvas_widget "$this canvas_enter %x %y" + + bind $canvas_widget "$this canvas_zoom_in %x %y" + bind $canvas_widget "$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 "$this resize_B1" + bind $bottom_frame.resize "$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 "$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 " + grab release $dialog + destroy $dialog + " + bind $entry " + 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 + # @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 + # @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 + # @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 + # @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 + # @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 + # @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 "$status_bar_label configure -text {$text}" + bind $widget "$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 "$this wire_enter gnd" + $connector_canvas bind gnd_wire "$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) "$this wire_enter dcd" + bind $leds(dcd) "$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) "$this wire_enter dsr" + bind $leds(dsr) "$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) "$this wire_enter cts" + bind $leds(cts) "$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) "$this wire_enter ri" + bind $leds(ri) "$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 "$this wire_enter dtr" + bind $dtr_button "$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 "$this wire_enter rts" + bind $rts_button "$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 "$this wire_enter txd" + bind $break_button "$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 "$this wire_enter $wire" + $connector_canvas bind ${wire}_wire "$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 <> \ + "$this port_combobox_accept" + bind $port_combobox "$this port_combobox_accept" + bind $port_combobox "$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 <> \ + "$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 <> \ + "$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 <> \ + "$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 <> \ + "$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 "" 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 "" 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 "$status_bar configure -fg black -text {$text}" + bind $widget "$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) <> \ + "$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) <> \ + "$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) "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) "$this calc loops compute_but {}" + bind $widgets(loops,$w) "$this calc loops compute_but {}" + } + for {set i 0} {$i < 8} {incr i} { + bind $widgets(loops,reg_ent$i) "$this calc loops compute_but {}" + bind $widgets(loops,reg_ent$i) "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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) <> \ + "$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 "$this invoke_popup_menu %X %Y %x %y; break" + bind $text_widget <> "false_selection $text_widget; break" + bind $text_widget "focus %W; $this select_line %x %y" + bind $text_widget "$this key_down" + bind $text_widget "$this key_up" + bind $text_widget "$this text_copy_proc line; break" + + bind $win "$this open_file_dialog; break" + bind $win "$this reload; break" + bind $win "$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 [list $status_bar_lbl configure -text $text] + bind $widget [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: ) + # @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 + # 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 + # 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]] + } +} -- cgit v1.2.3