[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? :) [http://www.freemove.it/images/ResistorFinder.gif] ---- #!/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 "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 end ---- See also: [Ohm-O-Graph] ---- [[ [Category Electronics] | [Category Application] ]]