File: sfrwatches.tcl

package info (click to toggle)
mcu8051ide 1.4.9-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye, buster, sid
  • size: 18,820 kB
  • sloc: tcl: 94,956; xml: 2,122; sh: 2,114; asm: 246; ansic: 96; makefile: 30; awk: 18
file content (636 lines) | stat: -rw-r--r-- 20,009 bytes parent folder | download
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
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
#!/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 _SFRWATCHES_TCL ] } {
set _SFRWATCHES_TCL _
# <<< File inclusion guard

# --------------------------------------------------------------------------
# DESCRIPTION
# Provides SFR watches for left panel
# --------------------------------------------------------------------------

class SFRWatches {

	## COMMON
	 # Font for addresses and register names
	public common main_font	[font create			\
		-family $::DEFAULT_FIXED_FONT			\
		-size [expr {int(-14 * $::font_size_factor)}]	\
		-weight bold					\
	]
	 # Just another font but not bold
	public common roman_font	[font create			\
		-family $::DEFAULT_FIXED_FONT			\
		-size [expr {int(-14 * $::font_size_factor)}]	\
	]
	 # Fonr for register entry boxes
	public common entry_font	[font create			\
		-family $::DEFAULT_FIXED_FONT			\
		-size [expr {int(-12 * $::font_size_factor)}]	\
		-weight bold					\
	]

	## PRIVATE
	private variable text_widget			;# Widget: Text widget containing SFR watches
	private variable scrollbar		{}	;# Widget: Scrollbar for $text_widget
	private variable search_entry			;# Widget: Search entry box at the bottom of the panel
	private variable search_clear_but		;# Widget: Button "Clear" at the bottom of the panel
	private variable main_left_frame		;# Widget: Frame containing $text_widget and its header label
	private variable entry_count		0	;# Int: Number of SFRs
	private variable validation_ena		1	;# Bool: SFR entry box validation enabled
	private variable haddr2idx			;# Array: $haddr2idx($hex_addr) --> row_in_text_widget - 1
	private variable addr2idx			;# Array: $addr2idx($dec_addr) --> row_in_text_widget - 1
	private variable reg2idx			;# Array: $addr2idx($register_name_uppercase) --> row_in_text_widget - 1
	private variable last_selected_line	0	;# Int: Selected row in the text widget
	private variable search_ena		1	;# Bool: Search enabled
	private variable menu				;# Widget: Popup menu for the text widget

	# Variables related to object initialization
	private variable parent				;# Parent GUI object (tempotary variable)
	private variable sfrw_gui_initialized	0	;# GUI ready

	constructor {} {
	}

	destructor {
		if {$sfrw_gui_initialized} {
			menu_Sbar_remove $menu
		}
	}

	## Prepare object for creating its GUI
	 # @parm Widget _parent - parent container (some frame)
	 # @return void
	public method PrepareSFRWatches {_parent} {
		set parent $_parent
		set sfrw_gui_initialized 0
	}

	## Initialize SFR watches GUI
	 # @return void
	public method CreateSFRWatchesGUI {} {
		if {$sfrw_gui_initialized} {return}
		set sfrw_gui_initialized 1

		set validation_ena 0
		create_GUI
		fill_gui
		set validation_ena 1

		if {![$this is_frozen]} {
			sfr_watches_disable
		}
	}

	## Create entry box to embedd in the text widget
	 # @parm Int i		- Entry index (row - 1)
	 # @parm String type	- Entry type (hex or dec)
	 # @parm Int addr	- SFR address (128..255)
	 # @parm String reg	- SFR name (e.g. PSW)
	 # @return Widget - Created entry box
	private method create_entry {i type addr reg} {
		# Determine entry box width
		if {$type == {hex}} {
			set width 2
		} else {
			set width 3
		}

		# Create entry widget
		set entry [entry $text_widget.${type}_entry_${i}		\
			-width $width 		-font $entry_font		\
			-bg {#FFFFFF}		-validate all			\
			-takefocus 0		-highlightthickness 0		\
			-disabledbackground {#FFFFFF}				\
			-vcmd "$this sfr_watches_validate ${type} $addr %P"	\
			-bd 0			-justify right			\
		]

		# Perform name correction for accumulators
		if {$reg == {A} || $reg == {B}} {
			append reg {_hex}
		}

		# Set event bindins
		bind $entry <Motion>	{help_window_show %X %Y}
		bind $entry <Leave>	{help_window_hide}
		bind $entry <FocusIn>	"$this unmark_entry $addr"
		bind $entry <Enter>	"$this create_help_window_ram $reg"
		bind $entry <Button-1>	"$this sfr_watches_select_line 0 [expr {$i + 1}] $type"
		bind $entry <Key-Up>	"$this sfr_watches_up $type 1"
		bind $entry <Key-Down>	"$this sfr_watches_down $type 1"
		bind $entry <Key-Next>	"$this sfr_watches_down $type 4"
		bind $entry <Key-Prior>	"$this sfr_watches_up $type 4"
		bind $entry <Button-4>	"$text_widget yview scroll -5 units"
		bind $entry <Button-5>	"$text_widget yview scroll +5 units"
		if {$type == {hex}} {
			bind $entry <Key-Right>	"
				focus $text_widget.dec_entry_${i}
				$text_widget.dec_entry_${i} selection clear
				update
				$text_widget.dec_entry_${i} icursor 0"
		} else {
			bind $entry <Key-Left>	"
				focus $text_widget.hex_entry_${i}
				$text_widget.hex_entry_${i} selection clear
				update
				$text_widget.dec_entry_${i} icursor end"
		}

		return $entry
	}

	## Complite GUI initialization (load all SFRs into the text widget)
	 # @return void
	private method fill_gui {} {
		set entry_count 0
		set validation_ena 0

		# Iterate over defined SFRs ({{addr name} ... })
		foreach reg [$this simulator_get_sfrs] {
			# Determine hexadecimal address
			set addr [lindex $reg 0]
			set hex_addr [format %X $addr]
			if {[string length $hex_addr] == 1} {
				set hex_addr "0$hex_addr"
			} elseif {[string length $hex_addr] == 3} {
				set hex_addr [string replace $hex_addr 0 0]
			}
			# Determine register name and make it 8 characters long
			set reg [lindex $reg 1]
			set reg_org $reg
			switch -- $reg {
				SBUFR {
					set reg {SBUF R}
				}
				SBUFT {
					set reg {SBUF T}
				}
				default {
					set reg $reg
				}
			}
			append reg [string repeat { } [expr {8 - [string length $reg]}]]

			# Register this SFR
			set haddr2idx($hex_addr) $entry_count
			set addr2idx($addr) $entry_count
			set reg2idx($reg_org) $entry_count

			# Insert address and name into the text widget
			$text_widget insert end $hex_addr
			$text_widget insert end { }
			$text_widget insert end $reg

			# Set highlighting tags
			set line [expr {int([$text_widget index insert])}]
			$text_widget tag add tag_addr $line.0 $line.2
			$text_widget tag add tag_name $line.3 $line.11

			# Create and insert embedded entry boxes
			set entry [create_entry $entry_count hex $addr $reg_org]
			$entry insert 0 [$this getSfr $addr]
			$text_widget window create end -window $entry -pady 0
			$text_widget insert end { }
			set entry [create_entry $entry_count dec $addr $reg_org]
			$entry insert 0 [$this getSfrDEC $addr]
			$text_widget window create end -window $entry -pady 0

			# Finalize this row
			$text_widget insert end "\n"
			incr entry_count
		}

		# Remove the last line (empty line) and disable the text widget
		$text_widget delete end-1l end
		set validation_ena 1
	}

	## Set value of SFR at current line to the specified value
	 # @parm String value - Hexadecimal value
	 # @return void
	public method sfr_watches_set_current_to {value} {
		set idx [expr {$last_selected_line - 1}]
		set addr [lindex [$this simulator_get_sfrs] [list $idx 0]]

		$this setSfr $addr $value
		$this Simulator_GUI_sync S $addr
	}

	## Create GUI elements of this panel
	 # @return void
	private method create_GUI {} {
		# Create and pack panel frames
		set main_frame [frame $parent.main_frame]
		set main_left_frame [frame $main_frame.left]
		pack $main_left_frame -side left -fill both -expand 1
		pack $main_frame -fill both -expand 1

		# Create text widget and its header
		pack [label $main_left_frame.header_label	\
			-anchor w -justify left -pady 0 -padx 2	\
			-fg ${::Simulator_GUI::small_color}	\
			-font ${::Simulator_GUI::smallfont}	\
			-text "[mc {Register}]		[mc {HEX}]    [mc {DEC}]" -width 1	\
		] -fill x -pady 0 -anchor nw
		set text_widget [text $main_left_frame.text		\
			-bg {#FFFFFF} -font $roman_font -bd 2		\
			-width 0 -height 0 -wrap none			\
			-yscrollcommand "$this sfr_watches_scroll_set"	\
			-cursor left_ptr				\
		]

		# Create popup menu for the text widget
		set menu $text_widget.menu
		menuFactory {
			{command	{Set to 0x00}	{}	9	"sfr_watches_set_current_to 00"
				{}	"Set this register to 0"}
			{command	{Set to 0xFF}	{}	9	"sfr_watches_set_current_to FF"
				{}	"Set this register to 255"}
		} $menu 0 "$this " 0 {} [namespace current]

		# Set event bindings for the text widget
		bindtags $text_widget $text_widget
		foreach event {
			<ButtonRelease-1>	<B1-Enter>	<B1-Leave>
			<B2-Motion>		<Button-5>	<Button-4>
			<MouseWheel>
		} {
			bind $text_widget $event [bind Text $event]
		}
		bind $text_widget <Button-1>	\
			"$this sfr_watches_select_line 0 \[expr {int(\[%W index @%x,%y\])}\] hex"
		bind $text_widget <ButtonRelease-3>	\
			"$this sfr_watches_select_line 0 \[expr {int(\[%W index @%x,%y\])}\] hex
			tk_popup $menu %X %Y"

		# Pack the text widget and create its scrollbar
		pack $text_widget -fill both -expand 1
		set scrollbar [ttk::scrollbar $main_frame.scrollbar	\
			-orient vertical -command "$text_widget yview"	\
		]

		# Create bottom frame (search bar)
		set search_frame [frame $parent.top]
		pack [label $search_frame.lbl	\
			-text [mc "Search:"]	\
		] -side left
		set search_entry [ttk::entry $search_frame.entry		\
			-width 0						\
			-validate all						\
			-validatecommand "$this sfr_watches_search_validate %P"	\
		]
		pack $search_entry -side left -fill x -expand 1
		set search_clear_but [ttk::button $search_frame.button	\
			-style Flat.TButton				\
			-state disabled					\
			-image ::ICONS::16::clear_left			\
			-command "$search_entry delete 0 end"		\
		]
		pack $search_clear_but -side right -after $search_entry
		pack $search_frame -fill x

		# Create highlighting tags for the text widget
		$text_widget tag configure tag_addr	\
			-foreground {#000000} -font $main_font
		$text_widget tag configure tag_name	\
			-foreground {#0000DD} -font $main_font
		$text_widget tag configure tag_curLine	\
			-background ${::RightPanel::selection_color_dark}
	}

	## Adjust scrollbar
	 # @parm Float frac0 - 1st fraction
	 # @parm Float frac1 - 2nd fraction
	 # @return void
	public method sfr_watches_scroll_set {frac0 frac1} {
		if {$scrollbar == {}} {
			return
		}

		# Hide scrollbar
		if {$frac0 == 0 && $frac1 == 1} {
			if {[winfo ismapped $scrollbar]} {
				pack forget $scrollbar
			}
		# Show scrollbar
		} else {
			if {![winfo ismapped $scrollbar]} {
				pack $scrollbar			\
					-side left		\
					-fill y			\
					-after $main_left_frame
			}
			$scrollbar set $frac0 $frac1
		}
	}

	## Validate content of search entry box at the bottom bar
	 # @parm String string - String to validate
	 # @return Bool - Always 1
	public method sfr_watches_search_validate {string} {
		# Check if searching is enabled
		if {!$search_ena} {return 1}

		# Adjust state of clear button (+ clear selection on the text widget)
		if {$string == {}} {
			$search_clear_but configure -state disabled
			$search_entry configure -style TEntry
			sfr_watches_select_line 1 0 hex
			return 1
		} else {
			$search_clear_but configure -state normal
		}

		set string [string toupper $string]

		# Perform case insensitive search for the given chunk of SFR name and address
		foreach arr {reg2idx haddr2idx} {
			foreach str [lsort -ascii -increasing [array names $arr]] {
				# Search successful
				if {![string first $string $str]} {
					$search_entry configure -style StringFound.TEntry
					sfr_watches_select_line 1 [expr {[subst -nocommands "\${${arr}(${str})}"] + 1}] hex
					return 1
				}
			}
		}

		# Search failed
		$search_entry configure -style StringNotFound.TEntry
		return 1
	}

	## Select line in the text widget
	 # @parm Bool search	- Invoked form search validator (do not clear search entry box)
	 # @parm Int line	- Target line
	 # @parm String type	- Entry box to select (hex or dec)
	 # @return void
	public method sfr_watches_select_line {search line type} {

		# Unselect the last selected line and determinate cursor position
		if {$last_selected_line} {
			$text_widget tag remove tag_curLine 0.0 end
			$this simulator_reg_label_set_highlighted $last_selected_line 0
			incr last_selected_line -1
			foreach tp {dec hex} {
				$text_widget.${tp}_entry_$last_selected_line selection clear
				$text_widget.${tp}_entry_$last_selected_line configure	\
					-bg {#FFFFFF} -disabledbackground {#FFFFFF}
			}
			set cursor [$text_widget.${type}_entry_$last_selected_line index insert]
		} else {
			set cursor 0
		}

		# Adjust last selected line (if 0 the return)
		set last_selected_line $line
		if {!$line} {
			return
		}


		# Highlight this line as selected in the text widget
		$text_widget tag add tag_curLine	\
			$last_selected_line.0		\
			$last_selected_line.0+1l
		$text_widget see $last_selected_line.0

		# Highlight SFR on this line in simulator control panel
		$this simulator_reg_label_set_highlighted $last_selected_line 1

		# Adjust background color for entry boxes at this line
		incr line -1
		$text_widget.dec_entry_$line configure			\
			-fg ${Simulator::normal_color}			\
			-bg ${::RightPanel::selection_color_dark}	\
			-disabledbackground ${::RightPanel::selection_color_dark}
		$text_widget.hex_entry_$line configure			\
			-fg ${Simulator::normal_color}			\
			-bg ${::RightPanel::selection_color_dark}	\
			-disabledbackground ${::RightPanel::selection_color_dark}

		# Clear search entry box and focus and entry box at this line
		if {!$search} {
			$text_widget.${type}_entry_$line icursor $cursor
			$text_widget.${type}_entry_$line selection range 0 end
			focus $text_widget.${type}_entry_$line
			set search_ena 0
			$search_entry delete 0 end
			set search_ena 1
		}
	}

	## Validator for SFR value entry boxes
	 # @parm String type	- Entry box type (hex or dec)
	 # @parm Int addr	- Register address
	 # @parm String value	- String to validate
	 # @return Bool - Validation result
	public method sfr_watches_validate {type addr value} {
		# Prevent recursion
		if {!$validation_ena} {return 1}
		set validation_ena 0

		# Validate value
		if {$value == {}} {
			set value 0
		}
		if {$type == {hex}} {
			if {![string is xdigit $value]} {
				set validation_ena 1
				return 0
			}
			set value [expr "0x$value"]
		} else {
			if {![string is digit $value]} {
				set validation_ena 1
				return 0
			}
		}
		if {$value > 255 || $value < 0} {
			set validation_ena 1
			return 0
		}

		# Synchronize with engine and simulator control panel
		$this setSfr $addr [format %X $value]
		$this SimGUI_disable_sync
		$this Simulator_GUI_sync S $addr
		$this SimGUI_enable_sync

		# Synchronize with the other one entry box
		if {$type == {hex}} {
			$text_widget.dec_entry_$addr2idx($addr) delete 0 end
			$text_widget.dec_entry_$addr2idx($addr) insert 0 $value
		} else {
			set value [format %X $value]
			if {[string length $value] == 1} {
				set value "0$value"
			}
			$text_widget.hex_entry_$addr2idx($addr) delete 0 end
			$text_widget.hex_entry_$addr2idx($addr) insert 0 $value
		}

		# Done
		set validation_ena 1
		return 1
	}

	## Remove all SFRs for the text widget and unregister them
	 # @return void
	private method clear_gui {} {
		if {!$sfrw_gui_initialized} {return}

		# Clear SFR name label highlight in simultor contol panel
		if {$last_selected_line} {
			$this simulator_reg_label_set_highlighted $last_selected_line 0
		}

		# Reset object variables
		array unset haddr2idx
		array unset addr2idx
		array unset reg2idx
		set last_selected_line 0
		set entry_count 0

		# Clear the text widget
		$text_widget delete 1.0 end
		foreach wdg [$text_widget window names] {
			destroy $wdg
		}
	}

	## Set new value of certain SFR in this panel
	 # @parm Int addr	- SFR address
	 # @parm Int new_val	- New SFR value
	 # @return void
	public method sfr_watches_sync {addr new_val} {
		if {!$sfrw_gui_initialized} {return}

		# Prevent recursion
		if {!$validation_ena} {return}
		set validation_ena 0

		# Check if this SFR is available here
		if {[lsearch [array names addr2idx] $addr] == -1} {
			set validation_ena 1
			return
		}

		# Determinate references of HEX and DEC entry boxes
		set hex_entry $text_widget.hex_entry_$addr2idx($addr)
		set dec_entry $text_widget.dec_entry_$addr2idx($addr)

		# Highlight entry boxes
		set org_val [$dec_entry get]
		if {$org_val != $new_val} {
			$hex_entry configure -fg ${::Simulator_GUI::hcolor}
			$dec_entry configure -fg ${::Simulator_GUI::hcolor}
		}

		# Set decimal value
		$dec_entry delete 0 end
		$dec_entry insert 0 $new_val

		# Set hexadecimal value
		set new_val [format %X $new_val]
		if {[string length $new_val] == 1} {
			set new_val "0$new_val"
		}
		$hex_entry delete 0 end
		$hex_entry insert 0 $new_val

		# Reenable entry box value validations
		set validation_ena 1
	}

	## Enable this panel
	 # @return vois
	public method sfr_watches_enable {} {
		if {!$sfrw_gui_initialized} {return}
		$menu entryconfigure [::mc "Set to 0x00"] -state normal
		$menu entryconfigure [::mc "Set to 0xFF"] -state normal
		for {set i 0} {$i < $entry_count} {incr i} {
			$text_widget.hex_entry_$i configure -state normal
			$text_widget.dec_entry_$i configure -state normal
		}
	}

	## Disable this panel
	 # @return vois
	public method sfr_watches_disable {} {
		if {!$sfrw_gui_initialized} {return}
		$menu entryconfigure [::mc "Set to 0x00"] -state disabled
		$menu entryconfigure [::mc "Set to 0xFF"] -state disabled
		for {set i 0} {$i < $entry_count} {incr i} {
			$text_widget.hex_entry_$i configure -state disabled
			$text_widget.dec_entry_$i configure -state disabled
		}
	}

	## This function shuld be call after processor was changed
	 # Reload available SFRs
	 # @return void
	public method sfr_watches_commit_new_sfr_set {} {
		if {!$sfrw_gui_initialized} {return}
		clear_gui
		fill_gui
	}

	## Move selected line up
	 # @parm String type	- Which entry box should be selected (hex or dec)
	 # @parm Int lines	- Number of lines to move by
	 # @return void
	public method sfr_watches_up {type lines} {
		set line $last_selected_line
		incr line -$lines
		if {$line <= 0} {
			set line $entry_count
		}

		sfr_watches_select_line 0 $line $type
	}

	## Move selected line down
	 # @parm String type	- Which entry box should be selected (hex or dec)
	 # @parm Int lines	- Number of lines to move by
	 # @return void
	public method sfr_watches_down {type lines} {
		set line $last_selected_line
		incr line $lines
		if {$line >= $entry_count} {
			set line 0
		}

		sfr_watches_select_line 0 $line $type
	}
}

# >>> File inclusion guard
}
# <<< File inclusion guard