My TCL 7-Segment Display generator is a single TCL script, that can easily map display segments to data pins, and customize each digits segment pattern.

This was needed after I switched from four individual 7-segment modules, to using a single module with 4 digits contained within.

As the anode segment pins were internally wired together, the 8 wires from the EEPROM data pins only needed connecting to the module once, which greatly simplified things!

Another benefit came from mounting the display "upside down" on the breadboard. As it turned out, this aligned 5 segment pins on the top of the board, and 3 segment pins on the bottom, which perfectly matched the EEPROM pinout! It also had the common-cathode pins arranged with one on the top and three on the bottom, so only the single top cathode needed to be wired from the top to the bottom of the breadboard to connect to the mux chip.

As the whole display was upside down, my code can easily remap segment names, to 'draw' the digits correctly no matter what the screen layout was.

Here's a close-up of the much improved Output Module wiring:

• 7seg-display.tcl

# # Initialization

#

set outFile "7seg-rom.bin"

# ### Segment to data line mapping (0-7)

#

# A

# -----

# F| G |B

# -----

# E| |C

# ----- .

# D

# 4-digit module installed upside down for easier wiring:

#

set segmentDataPins {A 6 B 7 C 1 D 0 E 2 F 4 G 3 . 5}

# Digit patterns

#

set digitPatterns {

0 "ABCDEF"

1 "BC"

2 "ABGED"

3 "AGDBC"

4 "FGBC"

5 "AFGCD"

6 "FEDCG"

7 "ABC"

8 "ABCDEFG"

9 "ABGFC"

- "G"

}

#

# ################################################################

#

proc buildDigitArray {} {

global segmentDataPins

global digitPatterns

# Segment data pin value array

set segmentDataValue {}

foreach {Seg Pin} $segmentDataPins {

switch -- "$Pin" {

"0" { lappend segmentDataValue $Seg 1 }

"1" { lappend segmentDataValue $Seg 2 }

"2" { lappend segmentDataValue $Seg 4 }

"3" { lappend segmentDataValue $Seg 8 }

"4" { lappend segmentDataValue $Seg 16 }

"5" { lappend segmentDataValue $Seg 32 }

"6" { lappend segmentDataValue $Seg 64 }

"7" { lappend segmentDataValue $Seg 128 }

}

}

array set aDataValue $segmentDataValue

# Digit value array

global Digit

array set Digit {}

set tempList {}

foreach {D P} $digitPatterns {

set V 0

while {[string length $P]} {

set C [string index $P 0]

set P [string range $P 1 end]

set V [expr $V + $aDataValue($C)]

}

lappend tempList $D $V

}

array set Digit $tempList

unset tempList

return

}

# a0-a7 binary number in

# a8-a9 digit select

# a10 normal / twos-compliment

#

# 28C16 is 2k bytes

#

set DATA [lrepeat 2048 0]

buildDigitArray

# Ones place

for {set V 0} {$V <= 255} {incr V +1} {

set A [expr $V +0]

set DATA [lreplace $DATA $A $A $Digit([expr $V %10])]

}

# Tens place

for {set V 0} {$V <= 255} {incr V +1} {

set A [expr $V +256]

set DATA [lreplace $DATA $A $A $Digit([expr ( $V /10) %10])]

}

# Hundreds place

for {set V 0} {$V <= 255} {incr V +1} {

set A [expr $V +512]

set DATA [lreplace $DATA $A $A $Digit([expr ( $V /100) %10])]

}

# Sign

for {set V 0} {$V <= 255} {incr V +1} {

set A [expr $V +768]

set DATA [lreplace $DATA $A $A 0]

}

# Ones place, twos complement

for {set V -128} {$V <= 127} {incr V +1} {

set A [expr $V +128 +1024]

set DATA [lreplace $DATA $A $A $Digit([expr abs($V) %10 ])]

}

# Tens place, twos complement

for {set V -128} {$V <= 127} {incr V +1} {

set A [expr $V +128 +1280]

set DATA [lreplace $DATA $A $A $Digit([expr abs($V) /10 %10])]

}

# Hundreds place, twos complement

for {set V -128} {$V <= 127} {incr V +1} {

set A [expr $V +128 +1536]

set DATA [lreplace $DATA $A $A $Digit([expr abs($V) /100 %10])]

}

# Sign, twos complement

for {set V -128} {$V <= 127} {incr V +1} {

set A [expr $V +128 +1792]

if {$V < 0} {

set DATA [lreplace $DATA $A $A $Digit(-)]

} else {

set DATA [lreplace $DATA $A $A 0]

}

}

# ### Write binary to disk

#

set fid [open $outFile w]

fconfigure $fid -encoding binary -translation binary

foreach B $DATA { puts -nonewline $fid [binary format c1 $B] }

flush $fid

close $fid

exit 0