# Convert numbers between decimal, hexadecimal, octal and binary. Useful for programmers.
# Run as "wish num.tcl"
#

wm title . "Num-Re-Base"
wm resizable . 1 0

label .dec -text "Decimal:" -font { 30 }
label .hex -text "Hex:"     -font { 30 }
label .oct -text "Octal:"   -font { 30 }
label .bin -text "Binary:"  -font { 30 }

entry .edec -width 32 -validate key -vcmd { valdec %d %P %S } -textvariable d -font { 30 }
entry .ehex -width 32 -validate key -vcmd { valhex %d %P %S } -textvariable h -font { 30 }
entry .eoct -width 32 -validate key -vcmd { valoct %d %P %S } -textvariable o -font { 30 }
entry .ebin -width 32 -validate key -vcmd { valbin %d %P %S } -textvariable b -font { 30 }

label .errmsg -textvariable errmsg -justify center

grid columnconfigure . 1 -weight 1

grid  .dec -row 0 -column 0 -sticky e
grid  .hex -row 1 -column 0 -sticky e
grid  .oct -row 2 -column 0 -sticky e
grid  .bin -row 3 -column 0 -sticky e

grid  .edec -row 0 -column 1 -sticky ew
grid  .ehex -row 1 -column 1 -sticky ew
grid  .eoct -row 2 -column 1 -sticky ew
grid  .ebin -row 3 -column 1 -sticky ew

grid  .errmsg -row 4 -columnspan 2 -sticky ew

# For a error log display...
frame .f
text .f.log -yscrollcommand { .f.ys set } -state disabled -takefocus 0
scrollbar .f.ys -command { .f.log yview } -orient vertical -takefocus 0

# Set condition variable to 1 to enable a log display window
if {0} {
grid .f     -row 5 -columnspan 2 -sticky news
grid .f.log -row 0 -column 0     -sticky news
grid .f.ys  -row 0 -column 1     -sticky news
}

proc turn_validation_off { ew1 ew2 ew3 } {
        $ew1 configure -validate none
        $ew2 configure -validate none
        $ew3 configure -validate none
}

proc turn_validation_on { ew1 ew2 ew3 } {
        $ew1 configure -validate key
        $ew2 configure -validate key
        $ew3 configure -validate key
}

proc log { str } {
	.f.log configure -state normal
	.f.log insert 1.0 "$str\n"
	.f.log configure -state disabled
}

proc valdec { action ifvalidstr newentrystr } {
        global d h o b errmsg

        set errmsg ""

        if { $action != 1 } {
		log "Dec: Nothing inserted: $ifvalidstr $newentrystr"

               	turn_validation_off .ehex .eoct .ebin

		if { ![string length $ifvalidstr] ||
	              [string match - $ifvalidstr] } {
                	set h ""
                	set o ""
                	set b ""
		} else {
			set trimstr [string trimleft $ifvalidstr 0]
			if { ![string length $trimstr] } {
				set trimstr 0
			}

                 	set h [format "%X" $trimstr]
                	set o [format "%o" $trimstr]
			set hexstr [binary format I* $trimstr]
                	binary scan $hexstr B* b
		}

               	turn_validation_on .ehex .eoct .ebin

                return 1
        }

	log "Dec: Something inserted: $ifvalidstr $newentrystr"

	if { ![regexp {([-][0-9]*)|([0-9]+)} $ifvalidstr match] ||
	     ![string equal $ifvalidstr $match] } {
		bell
		return 0
	}
	if { [string match - $ifvalidstr] } {
		return 1
	}

	# Strip leading 0's to protect against being used as octal
	set trimstr [string trimleft $ifvalidstr 0]
	if { ![string length $trimstr] } {
		set trimstr 0
	}

        if { [catch { format "%X" $trimstr } result] } {
                bell
                set errmsg "Error: $result"
                return 0
        } else {
                turn_validation_off .ehex .eoct .ebin

                set h $result
        	set o [format "%o" $trimstr]
		set hexstr [binary format I* $trimstr]
                binary scan $hexstr B* b

                turn_validation_on .ehex .eoct .ebin
        }

        return 1
}

proc valhex { action ifvalidstr newentrystr } {
        global d h o b errmsg

        set errmsg ""

        if { $action != 1 } {
		log "Hex: Nothing inserted: $ifvalidstr $newentrystr"

                turn_validation_off .edec .eoct .ebin

		if { [string length $ifvalidstr] } {
                	set d [format "%d" 0x$ifvalidstr]
                	set o [format "%o" 0x$ifvalidstr]
			set hexstr [binary format I* 0x$ifvalidstr]
                	binary scan $hexstr B* b
		} else {
			set d ""
			set o ""
			set b ""
		}

                turn_validation_on .edec .eoct .ebin

                return 1
        }

	log "Hex: Something inserted: $ifvalidstr $newentrystr"

	if { ![string is xdigit $ifvalidstr] } {
		bell
		return 0
	}

        if { [catch { format "%d" 0x$ifvalidstr } result] } {
                bell
                set errmsg "Error: $result"
                return 0
        } else {
        	turn_validation_off .edec .eoct .ebin

                set d $result
        	set o [format "%o" 0x$ifvalidstr]
		set hexstr [binary format I* 0x$ifvalidstr]
               	binary scan $hexstr B* b

        	turn_validation_on .edec .eoct .ebin
        }

        return 1
}

proc valoct { action ifvalidstr newentrystr } {
        global d h o b errmsg

        set errmsg ""

        if { $action != 1 } {
		log "Oct: Nothing inserted: $ifvalidstr $newentrystr"

                turn_validation_off .edec .ehex .ebin

		if { [string length $ifvalidstr] } {
                	set d [format "%d" 0$ifvalidstr]
                	set h [format "%X" 0$ifvalidstr]
			set hexstr [binary format I* 0$ifvalidstr]
                	binary scan $hexstr B* b
		} else {
			set d ""
			set h ""
			set b ""
		}

                turn_validation_on .edec .ehex .ebin

                return 1
        }

	log "Oct: Something inserted: $ifvalidstr $newentrystr"

	if { ![regexp {[0-7]+} $ifvalidstr match] ||
	     ![string equal $ifvalidstr $match] } {
		bell
		return 0
	}

        if { [catch { format "%d" 0$ifvalidstr } result] } {
                bell
                set errmsg "Error: $result"
                return 0
        } else {
        	turn_validation_off .edec .ehex .ebin

                set d $result
        	set h [format "%X" 0$ifvalidstr]
		set hexstr [binary format I* 0$ifvalidstr]
                binary scan $hexstr B* b

        	turn_validation_on .edec .ehex .ebin
        }

        return 1;
}

proc bintodec { binstr } {
	set dec 0

	for {set i 0} {$i < [string length $binstr]} {incr i} {
		set nextbit [string index $binstr end-$i]
		set dec [expr ($nextbit << $i) | $dec]
	}

	return $dec
}

proc valbin { action ifvalidstr newentrystr } {
	global d h o b errmsg

        set errmsg ""

	set len [string length $ifvalidstr]
        if { $action != 1 } {
		log "Bin: Nothing inserted: $ifvalidstr $newentrystr"

                turn_validation_off .edec .ehex .eoct

		if { $len } {
			set d [bintodec $ifvalidstr]
        		set h [format "%X" $d]
        		set o [format "%o" $d]
		} else {
			set d ""
			set h ""
			set o ""
		}

                turn_validation_on .edec .ehex .eoct

                return 1
        }

	log "Bin: Something inserted: $ifvalidstr $newentrystr"

	if { ![regexp {[0-1]+} $ifvalidstr match] ||
	     ![string equal $ifvalidstr $match] } {
		bell
		return 0
	}

	if { $len > 32 } {
		set errmsg "Error: only 32 bits are allowed"
		bell
		return 0
	}

       	turn_validation_off .edec .ehex .eoct

	set d [bintodec $ifvalidstr]
       	set h [format "%X" $d]
       	set o [format "%o" $d]

        turn_validation_on .edec .ehex .eoct

        return 1;
}