ResistorFinder
FF 2007-05-13: Resistor finder is a little application for electronic amateurs like me, for approximately finding a specific value of resistor. It happens that while mounting a little circuit on a bredboard, one donesn't have a specific resistor value, so has to do something like adding two resistors in serie or in parallel, searching to the available values he owns.... Here you put all your resistor in the program "database", then type a value and the program will find the best try for you (choosing the better match between: single resistor you own, serie between 2 r, or parallel between 2 r).
Cool, uh? :)
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec wish "$0" ${1+"$@"}
#######################################################################
#
# ResistorFinder v0.1
# written by Federico Ferri - 2007
#
#######################################################################
#
# 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; version 2 of the License.
#
# 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.
#
#######################################################################
# put your values below ;P
# value qty tolrnc watts
set rdb {
4100000 4 5 0.25
2200000 1 5 0.25
1000000 32 5 0.25
2200000 5 5 0.25
100000 6 5 0.25
68000 1 5 0.25
22000 3 5 0.25
10000 28 5 0.25
4700 19 5 0.25
3300 1 5 0.25
2200 13 5 0.25
1500 1 5 0.25
1000 20 5 0.25
470 1 5 0.5
410 10 5 0.25
220 7 5 0.25
220 17 6 0.25
200 1 6 0.25
100 20 5 0.25
41 10 5 0.25
22.1 1 1 0.25
22 10 5 0.25
10 10 5 0.25
4.1 10 5 0.25
2.2 10 5 0.25
1 9 5 0.25
}
set debug 0
proc par {r1 r2} {
return [expr 1.*$r1*$r2/($r1+$r2)]
}
proc parse {v} {
set dgt {}
set mult 1
foreach ch [split $v {}] {
switch $ch {
0 - 1 - 2 - 3 - 4 - 5 - 6 - 7 - 8 - 9
{set dgt "$dgt$ch"}
k
{set dgt "$dgt."; set mult 1000}
M
{set dgt "$dgt."; set mult 1000000}
}
}
return [expr $dgt * $mult]
}
proc find1 {val} {
# find single
set delta 1000000000
set best [list [list $val 0 0 0]]
foreach {v q t w} $::rdb {
set delta2 [expr abs($val-$v)]
if $::debug {
puts "find1: {$v $q $t $w} (delta=$delta2)"
}
if {$delta2 < $delta} {
set delta $delta2
if $::debug {
puts "found better delta: $delta"
}
set best [list [list $v $q $t $w]]
}
}
set best
}
proc find2 {val} {
# find parallel(2)
set delta 1000000000
set best [list [list $val 0 0 0] [list 1000000000 0 0 0]]
foreach {v q t w} $::rdb {
foreach {vp qp tp wp} $::rdb {
if {$v == $vp && $t == $tp && $w == $wp} {
if {$q < 2} continue
}
set par [par $v $vp]
set delta2 [expr abs($val-$par)]
if $::debug {
puts "find2: {$v $q $t $w}{$vp $qp $tp $wp} (par=$par) (delta=$delta2)"
}
if {$delta2 < $delta} {
set delta $delta2
if $::debug {
puts "found better delta: $delta"
}
set best [list [list $v $q $t $w] [list $vp $qp $tp $wp]]
}
}
}
set best
}
proc find3 {val} {
# find serie(2)
set delta 1000000000
set best [list [list $val 0 0 0]]
foreach {v q t w} $::rdb {
foreach {vp qp tp wp} $::rdb {
if {$v == $vp && $t == $tp && $w == $wp} {
if {$q < 2} continue
}
set par [expr $v + $vp]
set delta2 [expr abs($val-$par)]
if $::debug {
puts "find3: {$v $q $t $w}{$vp $qp $tp $wp} (ser=$par) (delta=$delta2)"
}
if {$delta2 < $delta} {
set delta $delta2
if $::debug {
puts "found better delta: $delta"
}
set best [list [list $v $q $t $w] [list $vp $qp $tp $wp]]
}
}
}
set best
}
proc draw_r {c tag x y val} {
set v1 [lindex [split "$val" ""] 0]
set v2 [lindex [split "$val" ""] 1]
if {$v2 == "."} {set v2 [lindex [split "$val" ""] 2]}
set v3 [r_mult $val]
set v4 g
set r [$c create polygon \
4 0 12 0 14 2 18 4 40 4 44 2 46 0 54 0 56 2\
58 6 58 14 56 18 54 20 46 20 44 18 40 16 18 16 14 18\
12 20 4 20 2 18 0 14 0 6 2 2 4 0\
-fill [r_color bg1] -outline [r_color bdr] -tags $tag]
set c1 [$c create rectangle 6 0 12 20 -fill [r_color $v1] -tags $tag]
set c2 [$c create rectangle 18 4 24 16 -fill [r_color $v2] -tags $tag]
set c3 [$c create rectangle 30 4 36 16 -fill [r_color $v3] -tags $tag]
set c4 [$c create rectangle 46 0 52 20 -fill [r_color $v4] -tags $tag]
$c move $tag $x $y
}
proc draw_r1 {c tag x y val1} {
set W 56 ; set H 20 ; set U 12
set Ax [expr $x+0] ; set Ay [expr ($H/2)+$y+0]
set Bx [expr $x+$U] ; set By [expr ($H/2)+$y+0]
set Cx [expr $x+$U+$W] ; set Cy [expr ($H/2)+$y+0]
set Dx [expr $x+$U*2+$W] ; set Dy [expr ($H/2)+$y+0]
set Tw $tag.wire
set Ta $tag.A
$c create line $Ax $Ay $Bx $By -tags $Tw
$c create line $Cx $Cy $Dx $Dy -tags $Tw
draw_r $c $Ta $Bx [expr $Dy-($H/2)] $val1
}
proc draw_rp {c tag x y val1 val2} {
set W 56 ; set H 20 ; set U 12
set Ax [expr $x+0] ; set Ay [expr ($H/2)+$y+$U]
set Bx [expr $x+$U] ; set By [expr ($H/2)+$y+$U]
set Cx [expr $x+$U] ; set Cy [expr ($H/2)+$y+0]
set Dx [expr $x+$U*2] ; set Dy [expr ($H/2)+$y+0]
set Ex [expr $x+$U*2+$W] ; set Ey [expr ($H/2)+$y+0]
set Fx [expr $x+$U*3+$W] ; set Fy [expr ($H/2)+$y+0]
set Gx [expr $x+$U*3+$W] ; set Gy [expr ($H/2)+$y+$U]
set Hx [expr $x+$U*4+$W] ; set Hy [expr ($H/2)+$y+$U]
set Ix [expr $x+$U] ; set Iy [expr ($H/2)+$y+$U*2]
set Jx [expr $x+$U*2] ; set Jy [expr ($H/2)+$y+$U*2]
set Kx [expr $x+$U*2+$W] ; set Ky [expr ($H/2)+$y+$U*2]
set Lx [expr $x+$U*3+$W] ; set Ly [expr ($H/2)+$y+$U*2]
set Tw $tag.wire
set Ta $tag.A
set Tb $tag.B
$c create line $Ax $Ay $Bx $By -tags $Tw
$c create line $Gx $Gy $Hx $Hy -tags $Tw
$c create line $Dx $Dy $Cx $Cy $Ix $Iy $Jx $Jy -tags $Tw
$c create line $Ex $Ey $Fx $Fy $Lx $Ly $Kx $Ky -tags $Tw
draw_r $c $Ta $Dx [expr $Dy-($H/2)] $val1
draw_r $c $Tb $Jx [expr $Jy-($H/2)] $val2
}
proc draw_rs {c tag x y val1 val2} {
set W 56 ; set H 20 ; set U 12
set Ax [expr $x+0] ; set Ay [expr ($H/2)+$y+0]
set Bx [expr $x+$U] ; set By [expr ($H/2)+$y+0]
set Cx [expr $x+$U+$W] ; set Cy [expr ($H/2)+$y+0]
set Dx [expr $x+$U*2+$W] ; set Dy [expr ($H/2)+$y+0]
set Ex [expr $x+$U*2+$W*2] ; set Ey [expr ($H/2)+$y+0]
set Fx [expr $x+$U*3+$W*2] ; set Fy [expr ($H/2)+$y+0]
set Tw $tag.wire
set Ta $tag.A
set Tb $tag.B
$c create line $Ax $Ay $Bx $By -tags $Tw
$c create line $Cx $Cy $Dx $Dy -tags $Tw
$c create line $Ex $Ey $Fx $Fy -tags $Tw
draw_r $c $Ta $Bx [expr $Dy-($H/2)] $val1
draw_r $c $Tb $Dx [expr $Dy-($H/2)] $val2
}
proc r_mult {v} {
if {$v < 10} {
return g
} elseif {$v < 100} {
return 0
} elseif {$v < 1000} {
return 1
} elseif {$v < 10000} {
return 2
} elseif {$v < 100000} {
return 3
} elseif {$v < 1000000} {
return 4
} elseif {$v < 10000000} {
return 5
} elseif {$v < 100000000} {
return 6
} elseif {$v < 1000000000} {
return 7
}
}
proc r_color {n} {
switch $n {
0 { return "#000000"}
1 { return "#653332"}
2 { return "#fe0000"}
3 { return "#ff5b10"}
4 { return "#fffd01"}
5 { return "#33cc33"}
6 { return "#6666fa"}
7 { return "#cd66ff"}
8 { return "#939393"}
9 { return "#ffffff"}
g { return "#ce9836"}
s { return "#cccccc"}
bg1 { return "#cece9a"}
bg2 { return "#6799f8"}
bdr { return "#000000"}
}
}
proc float {v {n 2}} {
return [expr 1.*floor($v*pow(10,$n))/pow(10,$n)]
}
proc burzum {} {
set vv $::reval
foreach t {R_orig R_parl R_serie R_orig.wire R_parl.wire R_serie.wire R_orig.A R_parl.A R_serie.A R_orig.B R_parl.B R_serie.B R_m R_m.wire R_m.A R_m.B} {
.c delete $t
.cp delete $t
.cs delete $t
.cm delete $t
}
.cm configure -background [.c cget -background]
.cs configure -background [.c cget -background]
.cp configure -background [.c cget -background]
set v [parse $vv]
set m1 [find1 $v]
set m1a [lindex [lindex $m1 0] 0]
set err [expr 100*($v-$m1a)/$v]
set m2 [find2 $v]
set m2a [lindex [lindex $m2 0] 0]
set m2b [lindex [lindex $m2 1] 0]
set m2p [par $m2a $m2b]
set errp [expr 100*($v-$m2p)/$v]
set m3 [find3 $v]
set m3a [lindex [lindex $m3 0] 0]
set m3b [lindex [lindex $m3 1] 0]
set m3s [expr $m3a + $m3b]
set errs [expr 100*($v-$m3s)/$v]
draw_r1 .c R_orig 0 4 $v
draw_r1 .cm R_m 40 8 $m1a
draw_rp .cp R_parl 36 8 $m2a $m2b
draw_rs .cs R_serie 12 8 $m3a $m3b
set ::txtlm "Best match:\n[float $m1a] Ohm\nError: [float $err]%"
set ::txtlp "Best parallel:\n[float $m2a] // [float $m2b] = [float $m2p] Ohm\nError: [float $errp]%"
set ::txtls "Best serie:\n[float $m3a] + [float $m3b] = [float $m3s] Ohm\nError: [float $errs]%"
set err [expr abs($err)]
set errs [expr abs($errs)]
set errp [expr abs($errp)]
if {$err < $errs} {
if {$err < $errp} {
.cm configure -background "#ffffff"
} else {
.cp configure -background "#ffffff"
}
} else {
if {$errs < $errp} {
.cs configure -background "#ffffff"
} else {
.cp configure -background "#ffffff"
}
}
#set ::reval $v
.r selection range 0 end
}
set reval 4k7
set txtlp ""
set txtls ""
set txtlm ""
font create tFnt -family Helvetica -size 18 -weight bold -slant roman
font create tFn2 -family Helvetica -size 8
label .ttle -text "ResistorFinder" -font tFnt
grid .ttle -row 0 -column 0 -columnspan 3
label .copy -text "by Federico Ferri - 2007\nreleased under the GNU/GPL license\nsee the source code for full license agreement\n\n" -font tFn2
grid .copy -row 1 -column 0 -columnspan 3
entry .r -textvar ::reval
bind .r <Return> "burzum"
grid .r -row 2 -column 0
label .spc1 -text " "
grid .spc1 -row 2 -column 1
canvas .c -width 79 -height 27
grid .c -row 2 -column 2
label .lm -textvar ::txtlm
grid .lm -row 3 -column 0 -columnspan 3
canvas .cm -width 179 -height 37
grid .cm -row 4 -column 0 -columnspan 3
label .ls -textvar ::txtls
grid .ls -row 5 -column 0 -columnspan 3
canvas .cs -width 179 -height 37
grid .cs -row 6 -column 0 -columnspan 3
label .lp -textvar ::txtlp
grid .lp -row 7 -column 0 -columnspan 3
canvas .cp -width 179 -height 67
grid .cp -row 8 -column 0 -columnspan 3
focus .r
.r selection range 0 end
.r icursor endSee also: Ohm-O-Graph
S_M 2007-07-06 : there are a couple of issues entering the value 1.0. The 1 ohm resistor is drawn without the black band. To fix it add in draw_r after if {$v2 == '.'}:
if {$v2 == ""} {set v2 0}Also the value 1.0 is read as 10, add in parse the case for '.' (also add uppercase K):
switch $ch {
.
{set dgt "$dgt."}swatz - 2009-11-23 15:56:26
THANK A LOT , IT'S THE PROGRAM OF MY DREAM . i probably try to make the same think with Octave to do my calcul . ++