#!/usr/bin/wish
# 抵抗値のカラーコード変換プログラム, Version 1.0.1 (June 10. 1999)
# Copyright(C) 1999, H. Nakahara
#    作者の連絡先: nakahara@nuqe.nagoya-u.ac.jp
#    一次配布元: http://www.surf.nuqe.nagoya-u.ac.jp/documents/

# Version History
# 1.0   : June 8. 1999   : First Release
# 1.0.1 : June 10. 1999  : added +/- 3 % precision

# 本プログラムはフリー・ソフトウェアです。使用に際して対価を支払う必要は
# ありません。

# あなたは、Free Software Foundationが公表したGNU一般公有使用許諾(GPL)の
# 「バージョン2」或いはそれ以降の 各バージョンの中からいずれかを選択し、
# そのバージョンが定める条項に従って 本プログラムを再頒布または変更す
# ることができます。

# 本プログラムは有用とは思いますが、頒布にあたっては、市場性及び特定目
# 的適合性についての暗黙の保証を含めて、いかなる保証も行ないません。詳
# 細につい てはGNU一般公有使用許諾書をお読みください。
# (http://www.key.ne.jp/Report/Counter/GPL.html)

# バグ・不具合などありましたら上記連絡先までお知らせください。
# 可能な限り対応します。

######### Constants

puts "抵抗値のカラーコード変換プログラム, Version 1.0 (June 8. 1999)"
puts "                              Copyright(C) 1999, H. Nakahara"
puts " * 使用に際しては、本スクリプト先頭のコメントを読んでください"

# メッセージを書き換えるときは、以下の gConstXxxx の内容を変えてください

set gConstBlack 黒
set gConstBrown 茶
set gConstRed 赤
set gConstOrange 橙
set gConstYellow 黄
set gConstGreen 緑
set gConstBlue 青
set gConstViolet 紫
set gConstGray 灰
set gConstWhite 白
set gConstGold 金
set gConstSilver 銀
set gConstNone 無

set gConstOhm Ω
set gConstKOhm kΩ
set gConstMOhm MΩ

set gConstPM20 ±20%
set gConstPM10 ±10%
set gConstPM5 ±5%
set gConstPM3 ±3%
set gConstPM2 ±2%
set gConstPM1 ±1%
set gConstPM05 ±0.5%
set gConstPM025 ±0.25%
set gConstPM01 ±0.1%

set gConstExit 終了
set gConstValue 抵抗値:
set gConstBadValue 値が不正です

# 以下は変更しないでください

set gColors($gConstBlack) #000000
set gColors($gConstBrown) #a02626
set gColors($gConstRed) #ff0000
set gColors($gConstOrange) #ff8800
set gColors($gConstYellow) #ffff00
set gColors($gConstGreen) #00ff00
set gColors($gConstBlue) #0000ff
set gColors($gConstViolet) #ff00ff
set gColors($gConstGray) #808080
set gColors($gConstWhite) #ffffff
set gColors($gConstGold) #dbdb70
set gColors($gConstSilver) #c0c8c8
set gColors($gConstNone) #d8d8d8

set gCodes(-2) $gConstSilver
set gCodes(-1) $gConstGold
set gCodes(0) $gConstBlack
set gCodes(1) $gConstBrown
set gCodes(2) $gConstRed
set gCodes(3) $gConstOrange
set gCodes(4) $gConstYellow
set gCodes(5) $gConstGreen
set gCodes(6) $gConstBlue
set gCodes(7) $gConstViolet
set gCodes(8) $gConstGray
set gCodes(9) $gConstWhite
set gCodes($gConstSilver) -2
set gCodes($gConstGold) -1
set gCodes($gConstBlack) 0
set gCodes($gConstBrown) 1
set gCodes($gConstRed) 2
set gCodes($gConstOrange) 3
set gCodes($gConstYellow) 4
set gCodes($gConstGreen) 5
set gCodes($gConstBlue) 6
set gCodes($gConstViolet) 7
set gCodes($gConstGray) 8
set gCodes($gConstWhite) 9
set gCodes($gConstPM20) $gConstBlack
set gCodes($gConstPM10) $gConstSilver
set gCodes($gConstPM5) $gConstGold
set gCodes($gConstPM3) $gConstOrange
set gCodes($gConstPM2) $gConstRed
set gCodes($gConstPM1) $gConstBrown
set gCodes($gConstPM05) $gConstGreen
set gCodes($gConstPM025) $gConstBlue
set gCodes($gConstPM01) $gConstViolet

########## Subroutines

proc valChanged {} {
    global gColors gCodes gStatus gR gUnit gPrec gCol gOldCol
    global gConstOhm gConstKOhm gConstMOhm
    global gConstPM20 gConstPM10 gConstPM5 gConstPM3 gConstPM2 gConstPM1
    global gConstPM05 gConstPM025 gConstPM01
    global gConstBadValue gConstNone

    if {[string length $gR] == 0} {
	set gStatus $gConstBadValue
	return
    }
    scan $gR "%f" num
    set onum $num

    if {$gUnit == $gConstKOhm} {
	set num [expr $num*1000.]
    }
    if {$gUnit == $gConstMOhm} {
	set num [expr $num*1000000.]
    }

    if {($num > 20000000.) || ($num < 1.)} {
	set gStatus $gConstBadValue
	return
    }
    set gStatus ""

    set num [expr int($num)]
    set onum [expr int(($onum-$num+0.0051)*100.)]
    
    set len [string length $num]
    set olen [string length $onum]
    if {($gPrec == $gConstPM20)
    || ($gPrec == $gConstPM10)
    || ($gPrec == $gConstPM5)} {
	set preclen 2
    } else {
	set preclen 3
    }
    
    for {set i 0; set j 0} {$i < $preclen} {incr i} {
	if {$i >= $len} {
	    if {$j >= $olen} {
		set char 0
	    } else {
		set char [string index $onum $j]
	    }
	    incr j
	} else {
	    set char [string index $num $i]
	}
	set gCol($i) $gCodes($char)
    }
    set gCol($preclen) $gCodes([expr $len-$preclen])
    set gCol([expr $preclen+1]) $gCodes($gPrec)
    if {$preclen == 2} {
	set gCol(4) $gConstNone
    }
    for {set i 0} {$i < 5} {incr i} {
	set gOldCol($i) $gCol($i)
	.f1.f$i configure -background $gColors($gCol($i))
    }
}

proc colChanged {} {
    global gColors gCodes gStatus gR gUnit gPrec gOldR gOldUnit gOldPrec gCol
    global gConstBlack gConstBrown gConstRed gConstOrange gConstYellow
    global gConstGreen gConstBlue gConstViolet gConstGray gConstWhite
    global gConstGold gConstSilver gConstNone
    global gConstOhm gConstKOhm gConstMOhm
    global gConstPM20 gConstPM10 gConstPM5 gConstPM3 gConstPM2 gConstPM1
    global gConstPM05 gConstPM025 gConstPM01
    global gConstBadValue

    if {$gCol(4) == $gConstNone} {
	set preclen 2
	if {$gCol(3) == $gConstNone} {
	    set gPrec $gConstPM20
	} elseif {$gCol(3) == $gConstSilver} {
	    set gPrec $gConstPM10
	} elseif {$gCol(3) == $gConstGold} {
	    set gPrec $gConstPM5
	} elseif {$gCol(3) == $gConstOrange} {
	    set gPrec $gConstPM3
	} elseif {$gCol(3) == $gConstRed} {
	    set gPrec $gConstPM2
	} elseif {$gCol(3) == $gConstBrown} {
	    set gPrec $gConstPM1
	} else {
	    set gStatus $gConstBadValue
	    return
	}
    } else {
	set preclen 3
	if {$gCol(4) == $gConstRed} {
	    set gPrec $gConstPM2
	} elseif {$gCol(4) == $gConstBrown} {
	    set gPrec $gConstPM1
	} elseif {$gCol(4) == $gConstOrange} {
	    set gPrec $gConstPM3
	} elseif {$gCol(4) == $gConstGreen} {
	    set gPrec $gConstPM05
	} elseif {$gCol(4) == $gConstBlue} {
	    set gPrec $gConstPM025
	} elseif {$gCol(4) == $gConstViolet} {
	    set gPrec $gConstPM01
	} elseif {$gCol(4) == $gConstSilver} {
	    set gPrec $gConstPM10
	} elseif {$gCol(4) == $gConstGold} {
	    set gPrec $gConstPM5
	} else {
	    set gStatus $gConstBadValue
	    return
	}
	if {$gCol(3) == $gConstNone} {
	    set gStatus $gConstBadValue
	    return
	}
    }
    set gStatus ""

    set num 0
    for {set i 0} {$i < $preclen} {incr i} {
	set num [expr $num * 10 + $gCodes($gCol($i))]
    }
    set num [expr $num * pow(10,$gCodes($gCol($preclen)))]
    if {$num >= 1000000} {
	set gR [expr $num/1000000.]
	set gUnit $gConstMOhm
    } elseif {$num >= 1000} {
	set gR [expr $num/1000.]
	set gUnit $gConstKOhm
    } else {
	set gR $num
	set gUnit $gConstOhm
    }

    set gOldR $gR
    set gOldUnit $gUnit
    set gOldPrec $gPrec

}

proc timerProc {} {
    global gColors gCodes gR gOldR gUnit gOldUnit gPrec gOldPrec gCol gOldCol


    if {($gR != $gOldR) || ($gUnit != $gOldUnit) || ($gPrec != $gOldPrec)} {
	set gOldR $gR
	set gOldUnit $gUnit
	set gOldPrec $gPrec
	valChanged
    } else {
	set colChg 0
	for {set i 0} {$i < 5} {incr i} {
	    if {$gCol($i) != $gOldCol($i)} {
		set gOldCol($i) $gCol($i)
		.f1.f$i configure -background $gColors($gCol($i))
		set colChg 1
	    }
	}
	if {$colChg == 1} {
	    colChanged
	}
    }

    after 500 timerProc
}

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

########## Global Variables

set gR 1
set gUnit $gConstKOhm
set gPrec $gConstPM5
set gOldR -1
set gOldUnit "0"
set gOldPrec "0"

set gCol(0) $gConstBrown
set gCol(1) $gConstBlack
set gCol(2) $gConstRed
set gCol(3) $gConstGold
set gCol(4) $gConstNone
set gOldCol(0) "0"
set gOldCol(1) "1"
set gOldCol(2) "2"
set gOldCol(3) "3"
set gOldCol(4) "4"

set gStatus ""

########## Main Routine

frame .f0
label .f0.l0 -text $gConstValue
entry .f0.e0 -textvariable gR -width 10
tk_optionMenu .f0.m0 gUnit $gConstOhm $gConstKOhm $gConstMOhm
tk_optionMenu .f0.m1 gPrec $gConstPM20 $gConstPM10 $gConstPM5 $gConstPM2 $gConstPM1 $gConstPM05 $gConstPM025 $gConstPM01
pack .f0.l0 .f0.e0 .f0.m0 .f0.m1 -side left -padx 1m

frame .f1
tk_optionMenu .f1.m0 gCol(0) $gConstBrown $gConstRed $gConstOrange $gConstYellow $gConstGreen $gConstBlue $gConstViolet $gConstGray $gConstWhite
tk_optionMenu .f1.m1 gCol(1) $gConstBlack $gConstBrown $gConstRed $gConstOrange $gConstYellow $gConstGreen $gConstBlue $gConstViolet $gConstGray $gConstWhite
tk_optionMenu .f1.m2 gCol(2) $gConstBlack $gConstBrown $gConstRed $gConstOrange $gConstYellow $gConstGreen $gConstBlue $gConstViolet $gConstGray $gConstWhite $gConstSilver $gConstGold
tk_optionMenu .f1.m3 gCol(3) $gConstBlack $gConstBrown $gConstRed $gConstOrange $gConstYellow $gConstGreen $gConstBlue $gConstViolet $gConstGray $gConstWhite $gConstSilver $gConstGold $gConstNone
tk_optionMenu .f1.m4 gCol(4) $gConstBrown $gConstRed $gConstGreen $gConstBlue $gConstViolet $gConstSilver $gConstGold $gConstNone
for {set i 0} {$i < 5} {incr i} {
    grid configure .f1.m$i -row 0 -column $i -padx 1m
}

for {set i 0} {$i < 5} {incr i} {
    frame .f1.f$i -width 9m -height 9m  -relief raise -borderwidth 2 -background $gColors($gCol($i))
    grid configure .f1.f$i -row 1 -column $i -padx 1m
}

wm resizable . false false
wm title . "Resistor Color Code"
label .lStatus -textvariable gStatus -relief ridge
button .bExit -text $gConstExit -command exit
pack .f0 .f1 .bExit .lStatus -pady 1m -fill x

timerProc