summaryrefslogtreecommitdiff
path: root/lib/simulator/virtual_uart_term.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/simulator/virtual_uart_term.tcl')
-rwxr-xr-xlib/simulator/virtual_uart_term.tcl646
1 files changed, 0 insertions, 646 deletions
diff --git a/lib/simulator/virtual_uart_term.tcl b/lib/simulator/virtual_uart_term.tcl
deleted file mode 100755
index 29f3199..0000000
--- a/lib/simulator/virtual_uart_term.tcl
+++ /dev/null
@@ -1,646 +0,0 @@
-#!/usr/bin/tclsh
-# Part of MCU 8051 IDE ( http://mcu8051ide.sf.net )
-
-############################################################################
-# Copyright (C) 2010 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
-# UART monitor
-# -------------------------------------------------------------------------
-
-# LOAD PROGRAM ICONS
-# -----------------------------
-if {$argv0 != {./virtual_uart_term.tcl}} {
- set D 0
-} {
- set D 1
-}
-if {$D} {
- package require Tk
- package require img::png
- package require Itcl
- namespace import -force ::itcl::*
- package require msgcat
- namespace import -force ::msgcat::*
- package require BWidget
- set ::DEFAULT_FIXED_FONT {DejaVu Sans Mono}
- set ::MICROSOFT_WINDOWS 0
-
- set LIB_DIRNAME "/media/disk/mcu8051ide/lib"
- source "$LIB_DIRNAME/lib/hexeditor.tcl"
-
- foreach directory {16x16 22x22 32x32} ns {16 22 32} {
- namespace eval ::ICONS::${ns} {}
- foreach filename [glob "${::LIB_DIRNAME}/../icons/${directory}/*.png"] {
- set filename [file normalize $filename]
- set iconname [file tail $filename]
- regexp {^\w+} $iconname iconname
- if {[catch {
- image create photo ::ICONS::${ns}::${iconname} -format png -file $filename
- } result]} then {
- puts stderr {}
- puts -nonewline stderr $result
- image create photo ::ICONS::${ns}::${iconname}
- }
- }
- }
-
- proc menuFactory {pattern path tearoff cmdPrefix shortcuts options} {
-
- # Create menu widget
- eval "menu $path -tearoff $tearoff $options"
-
- # Iterate over menu definition list
- foreach menuitem $pattern {
- # Create array of options
- for {set i 0} {$i < 9} {incr i} {
- set menu($i) [lindex $menuitem $i]
- }
- # Determinate kind of operation
- switch $menu(0) {
- {command} {
- # Item icon
- if {$menu(5) != {}} {
- set menu(5) "::ICONS::16::$menu(5)"
- }
-
- # Adjust accelerator value
- set menu(2) $menu(2)
-
- # Create menu command
- $path add command \
- -label [mc $menu(1)] \
- -accelerator $menu(2) \
- -underline $menu(3) \
- -command "$cmdPrefix$menu(4)" \
- -image $menu(5) -compound left
-
- # Status bar tip
- if {$menu(6) != {}} {
- set itemIndex [$path index end]
- menu_Sbar_add $path $itemIndex [mc $menu(6)]
- bind $path <<MenuSelect>> "menu_Sbar $path \[%W index active\]"
- bind $path <Leave> {Sbar {}}
- }
- }
- {separator} {$path add separator}
- {radiobutton} {
- # Adjust command
- if {$menu(5) != {}} {
- set menu(5) "${cmdPrefix}$menu(5)"
- }
-
- # Adjust accelerator value
- set menu(2) [adjust_menu_accelerator $menu(2)]
-
- # Create radio button item
- $path add radiobutton \
- -label [mc $menu(1)] \
- -accelerator $menu(2) \
- -variable $menu(3) \
- -value $menu(4) \
- -command $menu(5) \
- -underline $menu(6) \
- -compound left \
- -indicatoron 0 \
- -image ::ICONS::raoff \
- -selectimage ::ICONS::raon \
- -selectcolor {#EEEEEE}
-
- # Status bar tip
- if {$menu(7) != {}} {
- set itemIndex [$path index end]
- menu_Sbar_add $path $itemIndex [mc $menu(7)]
- bind $path <<MenuSelect>> "menu_Sbar $path \[%W index active\]"
- bind $path <Leave> {Sbar {}}
- }
- }
- {checkbutton} {
- # Adjust command
- if {$menu(7) != {}} {
- set menu(7) "${cmdPrefix}$menu(7)"
- }
- # Adjust accelerator value
- set menu(2) [adjust_menu_accelerator $menu(2)]
-
- # Create checkbutton item
- $path add checkbutton \
- -label [mc $menu(1)] \
- -accelerator $menu(2) \
- -variable $menu(3) \
- -onvalue $menu(4) \
- -offvalue $menu(5) \
- -underline $menu(6) \
- -command $menu(7) \
- -compound left \
- -image ::ICONS::choff \
- -indicatoron 0 \
- -selectimage ::ICONS::chon \
- -selectcolor {#EEEEEE}
- # Status bar tip
- if {$menu(8) != {}} {
- set itemIndex [$path index end]
- menu_Sbar_add $path $itemIndex [mc $menu(8)]
- bind $path <<MenuSelect>> "menu_Sbar $path \[%W index active\]"
- bind $path <Leave> {Sbar {}}
- }
- }
- {cascade} {
- # Adjust menu name
- set menu(4) "$path$menu(4)"
- # Create new menu for cascade
- if {$menu(7) != {}} {
- menuFactory $menu(7) $menu(4) $menu(5) $cmdPrefix $menu(6) $options
- }
- # Item icon
- if {$menu(3) != {}} {
- set menu(3) "::ICONS::16::$menu(3)"
- }
- # Add cascade to this menu
- $path add cascade -label [mc $menu(1)] -underline $menu(2) \
- -image $menu(3) -menu $menu(4) -compound left
- }
- {} {return}
- default {
- error "Menu creation failed -- unknown type: $menu(0)"
- return -code 1
- }
- }
- }
- }
-
- ttk::style theme use clam
- # - ttk
- set TTK_COMMON_BG {#E0E0E0}
- ttk::style configure TFrame \
- -background {#EEEEEE}
-
- ttk::style configure TNotebook \
- -background {#EEEEEE} \
- -fieldbackground {red}
- ttk::style map TNotebook \
- -background [list \
- active red \
- pressed blue \
- pressed green \
- ]
-
- font configure TkTextFont -family {helvetica} -size -12 -weight {normal}
- font configure TkDefaultFont -family {helvetica} -size -12 -weight {normal}
-
- ttk::style configure StringNotFound.TEntry \
- -fieldbackground {#FFDDDD}
- ttk::style configure StringFound.TEntry \
- -fieldbackground {#DDFFDD}
-
- ttk::style configure Simulator.TEntry
- ttk::style map Simulator.TEntry \
- -fieldbackground [list readonly {#F8F8F8}] \
- -foreground [list readonly {#888888}]
- ttk::style configure Simulator_HG.TEntry \
- -foreground {#CC8800}
- ttk::style configure Simulator_WhiteBg.TEntry \
- -fieldbackground {#FFFFFF} \
- -fielddisabledbackground {#FFFFFF}
- ttk::style configure Simulator_WhiteBg_HG.TEntry \
- -fieldbackground {#FFFFFF} \
- -fielddisabledbackground {#FFFFFF} \
- -foreground {#CC8800}
- ttk::style configure Simulator_WhiteBg_Sel.TEntry \
- -fieldbackground {#DDDDFF} \
- -fielddisabledbackground {#DDDDFF}
- ttk::style configure Simulator_WhiteBg_HG_Sel.TEntry \
- -foreground {#CC8800} \
- -fieldbackground {#DDDDFF} \
- -fielddisabledbackground {#DDDDFF}
-
- ttk::style configure Simulator_watchdogEntry_0.TEntry \
- -fieldbackground {#88FF88} \
- -fielddisabledbackground {#66DD66}
- ttk::style map Simulator_watchdogEntry_0.TEntry \
- -foreground [list readonly {#888888}]
-
- ttk::style configure Simulator_watchdogEntry_1.TEntry \
- -fieldbackground {#FFFF55} \
- -fielddisabledbackground {#DDDD33}
- ttk::style map Simulator_watchdogEntry_1.TEntry \
- -foreground [list readonly {#888888}]
-
- ttk::style configure Simulator_watchdogEntry_2.TEntry \
- -fieldbackground {#FF5555} \
- -fielddisabledbackground {#DD3333}
- ttk::style map Simulator_watchdogEntry_2.TEntry \
- -foreground [list readonly {#888888}]
-
- ttk::style configure TLabelframe \
- -background {#EEEEEE}
- ttk::style configure TLabel \
- -background {#EEEEEE}
-
- ttk::style configure TButton \
- -background $TTK_COMMON_BG \
- -padding 0
- ttk::style configure RedBg.TButton \
- -padding 0
- ttk::style map RedBg.TButton \
- -background [list \
- active {#FFBBBB} \
- !active {#FF8888} \
- ] \
- -foreground [list \
- active {#FF0000} \
- !active {#000000} \
- ]
- ttk::style configure GreenBg.TButton \
- -padding 0
- ttk::style map GreenBg.TButton \
- -background [list \
- active {#BBFFBB} \
- !active {#88FF88} \
- ] \
- -foreground [list \
- active {#00FF00} \
- !active {#000000} \
- ]
-
- ttk::style configure Flat.TButton \
- -background {#EEEEEE} \
- -padding 0 \
- -borderwidth 1 \
- -relief flat
- ttk::style map Flat.TButton \
- -relief [list active raised] \
- -background [list disabled {#EEEEEE}]
-
- ttk::style configure TMenubutton \
- -padding 0 \
- -background $TTK_COMMON_BG
- ttk::style configure Flat.TMenubutton \
- -padding 0 \
- -background {#EEEEEE} \
- -borderwidth 1 \
- -relief flat
- ttk::style map Flat.TMenubutton \
- -relief [list active raised] \
- -background [list disabled {#EEEEEE}]
-
- ttk::style configure FlatWhite.TButton \
- -padding 0 \
- -background {#FFFFFF} \
- -borderwidth 1 \
- -relief flat
- ttk::style map FlatWhite.TButton \
- -relief [list active raised] \
- -background [list disabled {#FFFFFF}]
-
- ttk::style configure ToolButton.TButton \
- -background {#EEEEEE} \
- -padding 1 \
- -borderwidth 1 \
- -relief flat
- ttk::style map ToolButton.TButton \
- -relief [list active raised] \
- -background [list disabled {#EEEEEE}]
-
- ttk::style configure TCombobox \
- -background $TTK_COMMON_BG \
- -fieldfont [font create -family {helvetica} -size -12 -weight {normal}]
- ttk::style map TCombobox \
- -foreground [list disabled {#888888}] \
- -fieldbackground [list \
- readonly $TTK_COMMON_BG \
- disabled {#EEEEEE} \
- {!readonly !disabled} {#FFFFFF} \
- ]
-
- ttk::style configure TScrollbar \
- -background $TTK_COMMON_BG \
- -troughcolor {#F8F8F8}
-
- ttk::style configure TScale \
- -background $TTK_COMMON_BG
- ttk::style map TScale \
- -troughcolor [list \
- disabled $TTK_COMMON_BG \
- !disabled {#F8F8F8} \
- ]
-
- ttk::style configure TProgressbar \
- -background $TTK_COMMON_BG \
- -troughcolor {#F8F8F8}
- wm withdraw .
-}
-
-class VirtualUartTerminal {
- ## COMMON
- common count 0 ;# Counter of intances
- # 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} \
- ]
- # 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
- }
-
- ## PRIVATE
- private variable dialog_opened 0 ;# Bool: Dialog window opened
- private variable win ;# Widget: Dialog window
- private variable status_bar_label ;# Widget: Status bar
-
- private variable too_baud_conf {9600} ;# Int: Selected baud rate for communication
- private variable too_parity_conf {n} ;# Char: Selected type of parity
- private variable too_data_conf {8} ;# Int: Number of data bits
- private variable too_stop_conf {1} ;# Int: Number of stop bits
-
- constructor {} {
- }
-
- destructor {
- }
-
- ## Close interrupt monitor window and free its resources
- # @return void
- public method virtual_uart_termial_close {} {
- if {!$dialog_opened} {
- return
- }
-
- set geometry [wm geometry $win]
- set dialog_opened 0
- set in_progress_wdg {}
- set in_progress_flg {}
- set pending_flg {}
- set intr_priorities {}
- set avaliable_interrs {}
-
- if {[winfo exists $win]} {
- destroy $win
- }
- }
-
- ## Invoke interrupt monitor window
- # @return void
- public method virtual_uart_termial_invoke_dialog {} {
- set dialog_opened 1
-
- # Create window
- set win [toplevel .virtual_uart_term$count -class [mc "UART Monitor"] -bg {#EEEEEE}]
- incr count
-
- # 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
-
- # Configure window
- wm title $win [mc "Virtual UART Terminal - MCU 8051 IDE"]
- wm iconphoto $win ::ICONS::16::_blockdevice
- wm resizable $win 0 0
- wm protocol $win WM_DELETE_WINDOW "$this virtual_uart_termial_close"
- }
-
- ## Set status bar tip for specified widget
- # @parm Widget widget - Target widget
- # @parm String text - Text of the stutus tip
- # @return void
- private method virtual_uart_termial_set_status_tip {widget text} {
- bind $widget <Enter> "$status_bar_label configure -text {$text}"
- bind $widget <Leave> "$status_bar_label configure -text {}"
- }
-
- ## 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} {
- #
- ## FRAME: OUR MICROCONTROLLER
- #
-
- # Create labelframe
- set our_mcu_frame [ttk::labelframe $target_frame.our_mcu_frame \
- -padding 5 \
- -labelwidget [label $target_frame.our_mcu_label \
- -font $bold_font \
- -compound left \
- -text [mc "\"Our Microcontroller\""] \
- -image ::ICONS::16::configure \
- ] \
- ]
- pack [label $our_mcu_frame.l -text "AAAA"]
- pack $our_mcu_frame -side left -fill x -expand 1 -padx 5
-
-
- #
- ## FRAME: THE OTHER DEVICE
- #
-
- # Create labelframe
- set the_other_one_frame [ttk::labelframe \
- $target_frame.the_other_one_frame \
- -padding 5 \
- -labelwidget [label $target_frame.too_label \
- -font $bold_font \
- -compound left \
- -text [mc "Terminal configuration"] \
- -image ::ICONS::16::configure \
- ] \
- ]
- # - Baud rate
- grid [label $the_other_one_frame.baud_lbl \
- -text [mc "Baud rate"] \
- ] -row 3 -column 1 -sticky w
- set baud_cb [ttk::combobox $the_other_one_frame.baud_cb \
- -state readonly \
- -width 6 \
- -exportselection 0 \
- -values $available_baud_rates \
- ]
- bind $baud_cb <<ComboboxSelected>> \
- "$this change_port_config b \[$the_other_one_frame.baud_cb get\]"
- virtual_uart_termial_set_status_tip $baud_cb [mc "Connection speed in bps"]
- grid $baud_cb -row 3 -column 2 -sticky w
- $the_other_one_frame.baud_cb current [lsearch [$the_other_one_frame.baud_cb cget -values] $too_baud_conf]
- # - Parity
- grid [label $the_other_one_frame.parity_lbl \
- -text [mc "Parity"] \
- ] -row 4 -column 1 -sticky w
- set parity_cb [ttk::combobox $the_other_one_frame.parity_cb \
- -values {none odd even mark space} \
- -state readonly \
- -width 6 \
- -exportselection 0 \
- ]
- bind $parity_cb <<ComboboxSelected>> \
- "$this change_port_config p \[$the_other_one_frame.parity_cb get\]"
- virtual_uart_termial_set_status_tip $parity_cb [mc "Parity"]
- grid $parity_cb -row 4 -column 2 -sticky w
- $the_other_one_frame.parity_cb current [lsearch {n o e m s} $too_parity_conf]
- # - Data bits
- grid [label $the_other_one_frame.data_lbl \
- -text [mc "Data bits"] \
- ] -row 5 -column 1 -sticky w
- set data_cb [ttk::combobox $the_other_one_frame.data_cb \
- -state readonly \
- -width 1 \
- -values {5 6 7 8} \
- -exportselection 0 \
- ]
- bind $data_cb <<ComboboxSelected>> \
- "$this change_port_config d \[$the_other_one_frame.data_cb get\]"
- virtual_uart_termial_set_status_tip $data_cb [mc "Number of data bits"]
- grid $data_cb -row 5 -column 2 -sticky w
- $the_other_one_frame.data_cb current [lsearch [$the_other_one_frame.data_cb cget -values] $too_data_conf]
- # - Stop bits
- grid [label $the_other_one_frame.stop_lbl \
- -text [mc "Stop bits"] \
- ] -row 6 -column 1 -sticky w
- set stop_cb [ttk::combobox $the_other_one_frame.stop_cb \
- -state readonly \
- -width 1 \
- -values {1 2} \
- -exportselection 0 \
- ]
- bind $stop_cb <<ComboboxSelected>> \
- "$this change_port_config s \[$the_other_one_frame.stop_cb get\]"
- virtual_uart_termial_set_status_tip $stop_cb [mc "Number of stop bits"]
- grid $stop_cb -row 6 -column 2 -sticky w
- $the_other_one_frame.stop_cb current [lsearch [$the_other_one_frame.stop_cb cget -values] $too_stop_conf]
- pack $the_other_one_frame -side left -fill x -expand 1 -padx 5
- }
-
- ## 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 \
- ]
- virtual_uart_termial_set_status_tip $send_selected_button [mc "Send selected data"]
- virtual_uart_termial_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 \
- ]
- virtual_uart_termial_set_status_tip $receive_here_button [mc "Receive data on current cursor position"]
- virtual_uart_termial_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
- }
-}
-
-if {$D} {
- VirtualUartTerminal virtual_uart_term
- virtual_uart_term virtual_uart_termial_invoke_dialog
-}
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-29 23:35:08 +0000