summaryrefslogtreecommitdiff
path: root/lib/utilities/eightsegment.tcl
blob: 6bbefbbc632747378bca16b6916deb5da2d57923 (plain)
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
#!/usr/bin/tclsh
# Part of MCU 8051 IDE ( http://http://www.moravia-microsystems.com/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@moravia-microsystems.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 _EIGHTSEGMENT_TCL ] } {
set _EIGHTSEGMENT_TCL _
# <<< File inclusion guard

# --------------------------------------------------------------------------
# DESCRIPTION
# 8 segment LED display configurator
# --------------------------------------------------------------------------

class EightSegment {
	public common ld_ed_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 cathode - Hex"
	private variable cc_dec_entry	;# Widget: Entrybox "Common cathode - Dec"
	private variable cc_bin_entry	;# Widget: Entrybox "Common cathode - 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${ld_ed_count} -class {8 segment editor} -bg ${::COMMON_BG_COLOR}]
		set obj_idx $ld_ed_count
		incr ld_ed_count

		# Restore last session
		for {set i 0} {$i < 8} {incr i} {
			set seg2pin($i) $i
			set leds($i) 0
		}
		array set seg2pin	[lindex ${::EightSegment::config} 0]
		array set leds		[lindex ${::EightSegment::config} 1]
		for {set i 0} {$i < 8} {incr i} {
			set ::EightSegment::con_${obj_idx}_$i $seg2pin($i)
		}

		create_gui		;# Create GUI elements
		refresh_canvas		;# Initialize canvas (LED diaplay)
		reconnect 0		;# Highight badly connected pins
		refresh_entryboxes	;# Refresh EntryBoxes with values

		# Set event bindings for the dialog window
		bindtags $win [list $win Toplevel all .]
		bind $win <Control-Key-q> "::itcl::delete object $this; break"

		# Set window parameters
		wm iconphoto $win ::ICONS::16::8seg
		wm title $win [mc "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 -nocommands "\$::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 cathode
		set left_frame [frame $main_frame.left_frame]
		grid [label $left_frame.header_CC_lbl -text [mc "Common cathode"]] \
			-row 0 -column 0 -columnspan 4 -sticky w
		grid [label $left_frame.sub_header_CC_hex_lbl -text [mc "Hex:"]] \
			-row 1 -column 1 -sticky w
		grid [label $left_frame.sub_header_CC_dec_lbl -text [mc "Dec:"]] \
			-row 2 -column 1 -sticky w
		grid [label $left_frame.sub_header_CC_bin_lbl -text [mc "Bin:"]] \
			-row 3 -column 1 -sticky w
		set cc_hex_entry [ttk::entry $left_frame.cc_hex_ent	\
			-width 3					\
			-validate all					\
			-validatecommand "$this entry_validate C H %P"	\
		]
		set cc_dec_entry [ttk::entry $left_frame.cc_dec_ent	\
			-width 3					\
			-validate all					\
			-validatecommand "$this entry_validate C D %P"	\
		]
		set cc_bin_entry [ttk::entry $left_frame.cc_bin_ent	\
			-width 8					\
			-validate all					\
			-validatecommand "$this entry_validate C B %P"	\
		]
		grid $cc_hex_entry -row 1 -column 3 -sticky w
		grid $cc_dec_entry -row 2 -column 3 -sticky w
		grid $cc_bin_entry -row 3 -column 3 -sticky w
		foreach type {H D B} row {1 2 3} {
			grid [ttk::button $left_frame.copy_C${type}_but		\
				-command "$this copy_contents C ${type}"	\
				-image ::ICONS::16::editcopy			\
				-style Flat.TButton				\
			] -row $row -column 2 -sticky w -padx 3
			DynamicHelp::add $left_frame.copy_C${type}_but -text	\
				[mc "Copy contents of the entrybox to clipboard"]
			set_local_status_tip $left_frame.copy_C${type}_but [mc "Copy to clipboard"]
		}
		 # - Common anode
		grid [label $left_frame.header_CA_lbl -text [mc "Common anode"]] \
			-row 5 -column 0 -columnspan 4 -sticky w
		grid [label $left_frame.sub_header_CA_hex_lbl -text [mc "Hex:"]] \
			-row 6 -column 1 -sticky w
		grid [label $left_frame.sub_header_CA_dec_lbl -text [mc "Dec:"]] \
			-row 7 -column 1 -sticky w
		grid [label $left_frame.sub_header_CA_bin_lbl -text [mc "Bin:"]] \
			-row 8 -column 1 -sticky w
		set ca_hex_entry [ttk::entry $left_frame.ca_hex_ent	\
			-width 3					\
			-validate all					\
			-validatecommand "$this entry_validate A H %P"	\
		]
		set ca_dec_entry [ttk::entry $left_frame.ca_dec_ent	\
			-width 3					\
			-validate all					\
			-validatecommand "$this entry_validate A D %P"	\
		]
		set ca_bin_entry [ttk::entry $left_frame.ca_bin_ent	\
			-width 8					\
			-validate all					\
			-validatecommand "$this entry_validate A B %P"	\
		]
		grid $ca_hex_entry -row 6 -column 3 -sticky w
		grid $ca_dec_entry -row 7 -column 3 -sticky w
		grid $ca_bin_entry -row 8 -column 3 -sticky w
		foreach type {H D B} row {6 7 8} {
			grid [ttk::button $left_frame.copy_A${type}_but		\
				-command "$this copy_contents A ${type}"	\
				-image ::ICONS::16::editcopy			\
				-style Flat.TButton				\
			] -row $row -column 2 -sticky w -padx 3
			DynamicHelp::add $left_frame.copy_A${type}_but -text	\
				[mc "Copy contents of the entrybox to clipboard"]
			set_local_status_tip $left_frame.copy_A${type}_but [mc "Copy to clipboard"]
		}
		 # Set event bindings for entryboxes
		foreach widget [list					\
			${cc_hex_entry}	${cc_dec_entry}	${cc_bin_entry}	\
			${ca_hex_entry}	${ca_dec_entry}	${ca_bin_entry}	\
		] {
			bindtags $widget [list $widget TEntry $win all .]
		}
		 # Configure and pack left top frame
		grid rowconfigure $left_frame 4 -minsize 10
		grid columnconfigure $left_frame 0 -minsize 20
		pack $left_frame -side left -padx 5

		# Create canvas widget - LED display
		set canvas_widget [canvas $main_frame.canvas	\
			-width 125 -height 180 -bg white	\
			-bd 1 -relief solid			\
		]
		set canvas_objects(0) [$canvas_widget create polygon	\
			36 15	46 5	97 5	107 15	97 25	46 25	\
		]
		set canvas_objects(1) [$canvas_widget create polygon	\
			110 18	120 28	112 72	100 84	91 75	99 29	\
		]
		set canvas_objects(2) [$canvas_widget create polygon	\
			100 90	110 100	102 144	90 156	81 147	89 101	\
		]
		set canvas_objects(3) [$canvas_widget create polygon	\
			87 159	77 169	26 169	16 159	26 149	77 149	\
		]
		set canvas_objects(4) [$canvas_widget create polygon	\
			13 156	25 144	33 100	23 90	12 101	4 147	\
		]
		set canvas_objects(5) [$canvas_widget create polygon	\
			23 84	35 72	43 28	33 18	22 29	14 75	\
		]
		set canvas_objects(6) [$canvas_widget create polygon	\
			26 87	36 97	87 97	97 87	87 77	36 77	\
		]
		set canvas_objects(7) [$canvas_widget create oval 98 155 116 173]
		for {set i 0} {$i < 8} {incr i} {
			$canvas_widget itemconfigure $canvas_objects($i)	\
				-outline {#FF0000} -activeoutline {#00FF00}
			$canvas_widget bind $canvas_objects($i) <Button-1> "$this select_segment $i"
		}
		foreach coords {{70 15} {105 50} {95 125} {50 160} {20 125} {30 50} {60 88} {107 164}} \
			text {A B C D E F G P} \
			i {0 1 2 3 4 5 6 7} \
		{
			set obj [$canvas_widget create text		\
				[lindex $coords 0] [lindex $coords 1]	\
				-text $text -fill {#000000}		\
			]
			$canvas_widget bind $obj <Button-1> "$this select_segment $i"
		}
		pack $canvas_widget -side left -padx 5

		## Create right frame (Connections)
		set right_frame [frame $main_frame.right_frame]
		 # Header - "LED"
		grid [label $right_frame.header_0_lbl	\
			-text [mc "LED"]		\
		] -row 0 -column 0
		 # Header - "PIN"
		grid [label $right_frame.header_1_lbl	\
			-text [mc "PIN"]		\
		] -row 0 -column 1
		 # Create ComboBoxes and their labels
		for {set i 0} {$i < 8} {incr i} {
			grid [label $right_frame.pin_${i}_lbl	\
				-text [lindex {A B C D E F G P} $i]	\
			] -row [expr {$i + 1}] -column 0
			set cbx($i) [ttk::combobox $right_frame.cb_p$i		\
				-width 1					\
				-state readonly					\
				-values {0 1 2 3 4 5 6 7}			\
				-textvariable ::EightSegment::con_${obj_idx}_$i	\
			]
			bind $cbx($i) <<ComboboxSelected>> "$this reconnect $i"
			grid $cbx($i) -row [expr {$i + 1}] -column 1
		}
		 # Pack the right frame
		pack $right_frame -side left -padx 5 -anchor nw

		# Create button "Exit"
		pack [ttk::button $bottom_frame.close_but	\
			-compound left				\
			-text [mc "Close"]			\
			-command "::itcl::delete object $this"	\
			-image ::ICONS::16::exit		\
		] -side right -pady 5 -padx 5
		pack $status_bar -side left -fill x

		# Pack window frames
		pack $main_frame -fill both -expand 1 -pady 5 -side top
		pack $bottom_frame -fill x -side top
	}

	## Set status bar tip in this window only
	 # @parm Widget widget	- Widget related to the status tip
	 # @parm String text	- Status bar tip text
	 # @return void
	private method set_local_status_tip {widget text} {
		bind $widget <Enter> [list $status_bar configure -text $text]
		bind $widget <Leave> [list $status_bar configure -text {}]
	}

	## Copy contents of the specified exntrybox to clipboard
	 # @parm Char common_electrode	- C == Cathode; A == Anode
	 # @parm Char radix		- H == Hexadecimal; D == Decimal; B == Binary
	 # @return void
	public method copy_contents {common_electrode radix} {
		# Common cathode
		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
		} else {
			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 == Cathode; 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
		switch -- $radix {
			{H} {
				set value [expr "0x$value"]
			}
			{B} {
				set value [::NumSystem::bin2dec $value]
			}
			{D} {
				set value [string trimleft $value 0]
				if {$value == {}} {
					set value 0
				}
			}
		}

		# 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}]
			}
		} else {
			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
			} else {
				$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)

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