Playing with circuits
if 0 {Richard Suchenwirth 2004-08-21 - In this weekend fun project I play with one of the earliest applications Tcl was used for: electric circuit layout on a canvas.
So far you have "objects" of class Switch and Lamp (with Point objects for connectors), plus Wire to connect any two Points, directly or via the "waypoints" given as additional arguments.
You can click on a Switch to toggle its state. Every change in layout state leads to a proc, boringly named callback, being called, in which you can specify the behavior of the layout.
The demo example in the end shows the wiring of a lamp (e.g. in staircase lighting) that can be turned on or off from two switches, A and B, independently.
A refinement is possible in considering the layout a graph, and turning a Lamp on if it is on a path between the power supply connectors P1 and P2. Left as an exercise to the reader, or maybe myself later :) Other improvements can be thought of: interactively building a layout by dragging and dropping, automatically determining wiring paths, etc.
But for now here's my first shot, with "scripted layout" in a little language, which might still be of mildly educational use: }
package require Tk
proc Point {name w x y args} {
$w create oval [- $x 2] [- $y 2] [+ $x 2] [+ $y 2] -outline black \
-tag $name
set ::pos($name) [list $x $y]
}
proc Wire {name w from to args} {
$w create line [concat $::pos($from) $args $::pos($to)] \
-tag $name
}
proc Switch {name w x y args} {
array set "" [concat {-in left} $args]
$w create text $x [- $y 20] -text $name
$w create rect [- $x 6] [- $y 12] [+ $x 6] [+ $y 12] -tag $name \
-fill white -outline {}
if {$(-in) eq "left"} {
set x0 [- $x 6]
set x1 [+ $x 6]
} else {
set x0 [+ $x 6]
set x1 [- $x 6]
}
Point ${name}0 $w $x0 $y
Point ${name}1 $w $x1 [- $y 5]
Point ${name}2 $w $x1 [+ $y 5]
Wire W$name .c ${name}0 ${name}1
set ::g(to:$name) 1
$w bind $name <1> [list Switch'toggle $w $name]
}
proc Switch'toggle {w name} {
global g pos
set g(to:$name) [expr 1+2-$g(to:$name)]
set from [lrange [$w coords W$name] 0 1]
$w coords W$name [concat $from $pos($name$g(to:$name))]
callback
}
proc Lamp {name w x y args} {
Point ${name}0 $w $x [- $y 10]
Point ${name}1 $w $x [+ $y 10]
Wire W$name .c ${name}0 ${name}1
$w create text [+ $x 10] $y -text $name -anchor w
$w create oval [- $x 8] [- $y 8] [+ $x 8] [+ $y 8] -tag $name -fill yellow
$w create line [- $x 5] [+ $y 5] [+ $x 6] [- $y 6]
$w create line [- $x 5] [- $y 5] [+ $x 6] [+ $y 6]
}
proc Lamp'update {w name power} {
$w itemconfig $name -fill [expr {$power? "yellow" : "darkgray"}]
}
proc + args {expr [join $args +]}
proc - args {expr [join $args -]}#-- Testing (the "staircase lighting" example):
pack [canvas .c -width 200 -height 100] Point P1 .c 10 30 Point P2 .c 10 50 Switch A .c 50 30 -in left Switch B .c 120 30 -in right Lamp L .c 150 60 Wire W0 .c P1 A0 Wire W1 .c A1 B1 Wire W2 .c A2 B2 Wire W3 .c B0 L0 150 30 Wire W4 .c L1 P2 150 90 20 90 20 50
#-- defining the action explicitly:
proc callback {} {
global g
Lamp'update .c L [expr {$g(to:A) eq $g(to:B)}]
}
callback#-- useful debugging helpers (the F1 trick works only on Windows)
bind . <Escape> {exec wish $argv0 &; exit}
bind . <F1> {console show}if 0 {
If this is beginning to bore you, here's a slightly more complex example with three lamps:
pack [canvas .c -width 200 -height 100] Point P1 .c 10 30 Point P2 .c 10 50 Switch A .c 50 30 -in left Switch B .c 120 30 -in right Lamp L3 .c 150 60 Point P3 .c 70 25 Wire W0 .c P1 A0 Wire W1 .c A1 P3 Wire W1b .c P3 B1 Point P3b .c 100 35 Wire W2 .c A2 B2 Wire W3 .c B0 L30 150 30 Point P4 .c 100 90 Point P5 .c 70 90 Wire W4 .c L31 P4 150 90 Wire W5 .c P4 P5 Wire W6 .c P5 P2 20 90 20 50 Lamp L1 .c 70 60 Wire W1c .c P3 L10 Wire W1d .c L11 P5 Lamp L2 .c 100 60 Wire W3a .c P3b L20 Wire W3b .c L21 P4
#-- Again, defining the action explicitly:
proc callback {} {
global g
Lamp'update .c L1 [expr {$g(to:A) == 1}]
Lamp'update .c L2 [expr {$g(to:A) == 2}]
Lamp'update .c L3 [expr {$g(to:A) == $g(to:B)}]
}
callbackSS 21 Aug 2004. Very nice :) To have something like Spice for Tcl may be great. Actually even a simpler simulator for things like resistors, capacitors and voltage sources can be very interesting.
TV What can I say....
RS: Soon after writing this, I found that even if Tcl has no OO and I've not used any of the many OO frameworks at hand, this code is pretty much OO - it has "Classes" (even capitalized like in C++ - mainly because I wanted to avoid conflicts with switch), whose manifestations are "constructors"; some have "methods" (Switch'toggle, Lamp'update). Well, objects' state is kept in global arrays (pos(), g()).. but still, if you can do without the $obj method args syntax sugar, we have it all at hand in pure-Tcl - without a framework at all! :)
As a comment not on this (very very nice!) app, but rather on improvisation and electrical safety: I find that the staircase lights at my home are wired differently (so that you do not have the nice property that when the lamp is off it is not connected to the "live" pole). The wiring at home is described by
pack [canvas .c -width 200 -height 100]
Point P1 .c 10 25
Point P2 .c 10 95
Switch A .c 100 30 -in right
Switch B .c 100 90 -in right
Lamp L .c 150 60
Wire W0 .c P1 A1
Wire W1 .c P2 A2
Wire W2 .c A0 L0
Wire W3 .c P1 B1
Wire W4 .c P2 B2
Wire W5 .c B0 L1
proc callback {} {
global g
Lamp'update .c L [expr {$g(to:A) ne $g(to:B)}]
}RS: Thank you for this short-circuiting version, "anonymous"! (MS forgot to sign, sorry) Here's how it looks:
The screenshot was produced with the following lines, entered interactively into the console:
% package req Img 1.3 % image create photo -format window -data .c image1 % image1 write circuit2.png -format PNG
See also Full-adders, APIC
[ Arts and crafts of Tcl-Tk programming | Category Electronics | Category Toys ] }