1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442
|
#!/usr/bin/tclsh
# Part of MCU 8051 IDE ( http://https://sourceforge.net/projects/mcu8051ide/ )
############################################################################
# Copyright (C) 2007, 2008, 2009, 2010, 2011, 2012 by Martin Ošmera #
# martin.osmera@gmail.com #
# #
# Copyright (C) 2014 by Moravia Microsystems, s.r.o. #
# martin.osmera@gmail.com #
# #
# This program is free software; you can redistribute it and#or modify #
# it under the terms of the GNU General Public License as published by #
# the Free Software Foundation; either version 2 of the License, or #
# (at your option) any later version. #
# #
# This program is distributed in the hope that it will be useful, #
# but WITHOUT ANY WARRANTY; without even the implied warranty of #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the #
# GNU General Public License for more details. #
# #
# You should have received a copy of the GNU General Public License #
# along with this program; if not, write to the #
# Free Software Foundation, Inc., #
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. #
############################################################################
# >>> File inclusion guard
if { ! [ info exists _VIRTUAL_HW_COMPONENT_TCL ] } {
set _VIRTUAL_HW_COMPONENT_TCL _
# <<< File inclusion guard
# --------------------------------------------------------------------------
# DESCRIPTION
# Base class for virtual hardware components
# --------------------------------------------------------------------------
class VirtualHWComponent {
public common count 0 ;# Int: Counter of object instances
public common hlp_dlg_count 0 ;# Int: Counter of help dialog instances
# Create fonts used in the text
public common hlp_normal_font [font create \
-family {helvetica} \
-size [expr {int(-14 * $::font_size_factor)}] \
-weight {normal} \
]
public common hlp_bold_font [font create \
-family {helvetica} \
-size [expr {int(-14 * $::font_size_factor)}] \
-weight {bold} \
]
protected variable config_menu_created 0 ;# Bool: COnfiguration menu created
protected variable conf_menu {} ;# Widget: Menu - Configuration menu
protected variable modified 0 ;# Bool: Flag modified
protected variable project ;# Object: Project object
protected variable win {} ;# Widget: Dialog window
protected variable drawing_on 1 ;# Bool: Flag panel enabled
protected variable canvas_widget {} ;# Widget: Canvas widget - crucial part of the window
protected variable start_stop_button ;# Widget: Button "ON/OFF"
protected variable conf_button ;# Widget: Button to invoke configuration menu
protected variable component_name {} ;# String: Name of this VHW component
protected variable class_name {} ;# String: Name of class of this VHW component
protected variable component_icon {} ;# String: Name of icon of this VHW component
protected variable current_filename {} ;# String: Full name of file the current configuration
## Object constructor
# Increments counter of class instances
constructor {} {
incr count
}
## Object destructor
destructor {
}
## Close dialog window
# Ask user for save, call "close_window_special" and destroy the object
# @return void
public method close_window {} {
if {$modified} {
switch -- [tk_messageBox \
-type yesnocancel \
-icon question \
-parent $win \
-title [mc "Component modified"] \
-message [mc "Do you want to save the configuration of this panel before closing?"] \
] {
{yes} {
save_as
if {$modified} {
return
}
}
{no} {
}
default {
return
}
}
}
$this close_window_special
delete object $this
}
## Set modified flag to 1, here and in whole PALE system
# @return void
public method set_modified {} {
set modified 1
$project pale_set_modified
if {[winfo exists $win]} {
wm title $win "\[modified\] [regsub {^\[modified\] } [wm title $win] {}]"
}
return 1
}
## Set modified flag to 0
# @return void
public method clear_modified {} {
set modified 0
if {[winfo exists $win]} {
wm title $win [regsub {^\[modified\] } [wm title $win] {}]
}
}
## Invoke configuration menu
# Call "config_menu_special" before popup
# @return void
public method config_menu {} {
if {!$config_menu_created} {
create_config_menu
}
set x [winfo rootx $conf_button]
set y [winfo rooty $conf_button]
incr y [winfo height $conf_button]
$this config_menu_special
tk_popup $conf_menu $x $y
}
## Create configuration menu widgets
# Call create_config_menu_special after widgets were created
# @return void
protected method create_config_menu {} {
set config_menu_created 1
set conf_menu $win.conf_menu
menuFactory [subst -nocommands "\${${class_name}::CONFMENU}"] \
$conf_menu 0 "$this " 0 {} [$this info class]
$this create_config_menu_special
}
## Action "Save as"
# @return void
public method save_as {} {
# Create file selection dialog
catch {delete object ::fsd}
KIFSD::FSD ::fsd \
-title "[mc {Save configuration}] - [mc $component_name] - [$project cget -projectName] - MCU 8051 IDE" \
-master $win \
-directory [$project cget -projectPath] \
-initialfile [file tail $current_filename] \
-defaultmask 0 -multiple 0 -filetypes [list \
[list [mc "VH component"] {*.vhc} ] \
[list [mc "All files"] {*} ] \
]
# Open file after press of OK button
::fsd setokcmd "$this save_config_to_file \[::fsd get\]"
# activate the dialog
::fsd activate
}
## Action "Open file"
# @return void
public method load_from {} {
# Create file selection dialog
catch {delete object ::fsd}
KIFSD::FSD ::fsd \
-title "[mc {Load configuration}] - [mc $component_name] - [$project cget -projectName] - MCU 8051 IDE" \
-master $win \
-directory [$project cget -projectPath] \
-initialfile [file tail $current_filename] \
-defaultmask 0 -multiple 0 -filetypes [list \
[list [mc "VH component"] {*.vhc} ] \
[list [mc "All files"] {*} ] \
]
# Open file after press of OK button
::fsd setokcmd "$this load_config_from_file \[::fsd get\]"
# activate the dialog
::fsd activate
}
## Save configuration to the specified file
# @parm String filename - Name of target file
# @return Bool - 1 upon success; 0 upon fail
public method save_config_to_file {filename} {
# Adjust file name
if {![string length $filename]} {
return 0
}
set filename [file join [$project cget -ProjectDir] $filename]
# Adjust file extension
if {![regexp {\.vhc$} $filename]} {
append filename {.vhc}
}
if {[file exists $filename]} {
if {[tk_messageBox \
-type yesno \
-icon question \
-parent $win \
-title [mc "Overwrite file"] \
-message [mc "A file with name '%s' already exists. Do you want to overwrite it?" [file tail $filename]]
] != {yes}
} then {
return 0
}
}
# Create backup file
if {[file isfile $filename]} {
catch {
file rename -force $filename "$filename~"
}
}
# Try to open the file
if {[catch {
set file [open $filename {w} 0640]
}]} then {
tk_messageBox \
-type ok \
-icon error \
-parent $win \
-title [mc "IO Error"] \
-message [mc "Unable to write to file:\n\"%s\"" $filename]
return 0
}
# Gain configuration list
set config [$this get_config]
lset config {1 2} {} ;# Remove geometry information
# Save configuration to the file
puts $file "# MCU 8051 IDE: Virtual HW component configuration file"
puts $file "# Project: [$project cget -projectName]"
puts $file "# Component: $component_name\n"
puts $file $config
# Finalize
set current_filename $filename
close $file
clear_modified
return 1
}
## Load configuration from the specified file
# @parm String filename - Name of source file
# @return void
public method load_config_from_file {filename} {
# Try to open the file
if {[catch {
set file [open $filename {r}]
}]} then {
tk_messageBox \
-type ok \
-icon error \
-parent $win \
-title [mc "IO Error"] \
-message [mc "Unable to read file:\n\"%s\"" $filename]
return 0
}
# Read file line by line
while {![eof $file]} {
set line [gets $file]
# Skip empty lines and comments
if {$line == {} || [regexp {^\s*#} $line]} {continue}
# Decomposite file records
set obj [lindex $line 0] ;# VHW Object
set conf [lindex $line 1] ;# Configuration
# Detect wrong object name
if {$obj != $class_name} {
tk_messageBox \
-type ok \
-parent $win \
-icon error \
-title [mc "File corrupted"] \
-message [mc "Unable to read configuration from file:\n\"%s\"" $filename]
return 0
}
# Set configuration for this component
if {![$this set_config $conf]} {
tk_messageBox \
-type ok \
-parent $win \
-icon error \
-title [mc "File corrupted"] \
-message [mc "Unable to read configuration from file:\n\"%s\"" $filename]
return 0
}
# Only first configuration record is accepted
break
}
# Finalize ...
set current_filename $filename
close $file
clear_modified
return 1
}
## Show help dialog
# @parm Bool leave_empty=0 - Do not write implicitly anything into the help window
# @return void
public method show_help {{leave_empty 0}} {
# Increment counter of help dialog instances
incr hlp_dlg_count
# Create toplevel window
set dialog [toplevel .help_dialog_${class_name}_${hlp_dlg_count} -class {Help} -bg ${::COMMON_BG_COLOR}]
## Create top frame (header and icon)
set top_frame [frame $dialog.top_frame]
# Icon
pack [label $top_frame.header_image \
-image ::ICONS::22::$component_icon \
] -side left -padx 10
# Header text
pack [label $top_frame.header_label \
-anchor w -justify left \
-text [namespace eval ::$class_name "mc {$component_name}"] \
] -side left
pack $top_frame -anchor n -pady 2
## Create main frame (text and scrollbar)
set main_frame [frame $dialog.main_frame]
# Text widget
set text_widget [text $main_frame.text \
-width 0 -height 0 -font $hlp_normal_font \
-yscrollcommand "$main_frame.scrollbar set" \
-wrap word -padx 5 -pady 5 \
]
pack $text_widget -side left -fill both -expand 1
# Scrollbar
pack [ttk::scrollbar $main_frame.scrollbar \
-orient vertical \
-command "$text_widget yview" \
] -side right -fill y
# Finalize ...
pack $main_frame -fill both -expand 1 -padx 2
# Button "Close"
pack [ttk::button $dialog.close_button \
-text [mc "Close"] \
-compound left \
-image ::ICONS::16::button_cancel \
-command "destroy $dialog" \
] -ipady 0 -pady 2
# Create text tags in the text widget
$text_widget tag configure tag_bold -font $hlp_bold_font
# Fill in the text widget with the help message
$this show_help_special $text_widget
if {!$leave_empty} {
## Display section "Wire colors"
$text_widget insert insert "\n\n"
$text_widget insert insert [mc "Wire colors:"]
$text_widget tag add tag_bold {insert linestart} {insert lineend}
$text_widget insert insert "\n"
# Create canvas widget
set cw [canvas $text_widget.canvas\
-bg {#FFFFFF} \
-takefocus 0 \
-cursor left_ptr \
-bd 0 -relief flat \
-width 170 -height 110 \
]
bind $cw <Button-5> "$text_widget yview scroll +5 units; break"
bind $cw <Button-4> "$text_widget yview scroll -5 units; break"
# Fill in the canvas widget
$project Graph_create_legend $cw 1
# Show the canvas widget
$text_widget window create insert -window $cw
}
# Finalize ...
$text_widget configure -state disabled
wm minsize $dialog [expr {int(300 * $::font_size_factor)}] [expr {int(300 * $::font_size_factor)}]
wm title $dialog [namespace eval ::$class_name "mc {$component_name}"]
wm iconphoto $dialog ::ICONS::16::help
focus -force $dialog.close_button
}
## Commit new on/off state
# @parm Bool state - 1 == ON; 0 == OFF
# @return void
public method on_off {state} {
# Adjust flag panel enabled
set drawing_on $state
## Adjust apparence of "ON/OFF" button
# Turn ON
if {$state} {
$start_stop_button configure -style GreenBg.TButton -text [mc "ON"]
# Turn OFF
} else {
$start_stop_button configure -style RedBg.TButton -text [mc "OFF"]
}
# Call component specific procedure
$this on_off_special
}
}
# >>> File inclusion guard
}
# <<< File inclusion guard
|