#!/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:26THANK A LOT , IT'S THE PROGRAM OF MY DREAM . i probably try to make the same think with Octave to do my calcul . ++
| [Category Electronics] | Category Application |
