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)}]
 }
 callback

SS 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