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]. [http://www.edapi.cl] 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: } 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 . {exec wish $argv0 &; exit} bind . {console show} if 0 { ---- If this is beginning to bore you, here's a slightly more complex example with three lamps: [http://mini.net/files/circuit1.gif] 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]David 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's 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 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: [http://mini.net/files/circuit2.gif] 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] ---- [Arts and crafts of Tcl-Tk programming] [Category Toys] }