Wireworld/Tcl

From Rosetta Code

This is a graphical implementation of Wireworld.

Works with: Tcl version 8.6
or
Library: TclOO
Library: Tk

<lang tcl>package require TclOO package require Tk

  1. The color scheme.
  2. The order is: empty, conductor, electronTail, electronHead

set colors "#000000 #000080 #8080ff #ffffff"

  1. Encapsulate the per-cell logic in a class to simplify it

oo::class create wireCell {

   variable X Y S0 S1 Neighbours

   constructor {state x y} {

upvar 1 at at

set X $x set Y $y

switch -- $state { conductor { set S0 1 } electronTail { set S0 2 } electronHead { set S0 3 } default { return -code error "invalid state name \"$state\"" } } set at($x,$y) [self]

   }

   # Method used to allow each (non-background) cell to know about its
   # surrouding non-background cells. This makes the connectivity
   # calculations much simpler and faster!
   method initConnectivity {} {

upvar 1 at at foreach dx {-1 -1 -1 0 0 1 1 1} dy {-1 0 1 -1 1 -1 0 1} { set pos [expr {$X+$dx}],[expr {$Y+$dy}] if {[info exists at($pos)]} { lappend Neighbours $at($pos) } }

   }

   method state {} {return $S0}
   method x {} {return $X}
   method y {} {return $Y}

   # Perform the transition in two stages, so that we can do the transition
   # "simultaneously" across all cells. The transition0 method calculates
   # what state we're going to change to, and the transition1 method actually
   # moves to the state.
   method transition0 {} {

if {$S0 == 3} { set S1 2 } elseif {$S0 == 2} { set S1 1 } else { set count 0 foreach n $Neighbours { incr count [expr {[$n state] == 3}] } set S1 [expr {($count == 1 || $count == 2) ? 3 : 1}] }

   }
   method transition1 {} {

set S0 $S1

   }

}

  1. A subclass that knows how to display state changes on the GUI

oo::class create GUIwireCell {

   superclass wireCell
   variable S0 S1 X Y
   constructor {state x y} {

global colors next $state $x $y pixels put [lindex $colors $S0] -to $X $Y

   }
   method transition1 {} {

# Only do the plot of the state changed; more efficient if {$S0 != $S1} { global colors pixels put [lindex $colors [next]] -to $X $Y }

   }

}

  1. How to load a layout/program from a file

proc loadWires filename {

   global cells colors

   # Read the file in
   set f [open $filename]
   set data [read $f]
   close $f

   # Initialize the list of interacting cells and the connectivity map
   set cells {}
   array set at {}

   # Calculate the width of the program
   set lines [split $data \n]
   set len 0
   foreach line $lines {

if {[string length $line] > $len} { set len [string length $line] }

   }

   # Create the arena image
   image create photo pixels

   # Initialize the image to "empty cell"s; interacting parts will be overlaid
   pixels put [lindex $colors 0] -to 0 0 $len [llength $lines]

   # Parse the input data and create the interacting cells
   set y 0
   foreach line $lines {

set x 0 foreach char [split $line {}] { switch $char { H { lappend cells [GUIwireCell new electronHead $x $y] } t { lappend cells [GUIwireCell new electronTail $x $y] } . { lappend cells [GUIwireCell new conductor $x $y] } } incr x } incr y

   }

   # Now inform each cell about its connectivity
   foreach cell $cells {

$cell initConnectivity

   }
   unset at

}

  1. How to save the current state as a layout that [loadWires] can load

proc saveWires {filename} {

   global cells
   # Make a grid of empty characters of the right size
   set chs [lrepeat [image height pixels] [lrepeat [image width pixels] " "]]
   # Transcribe the non-empty cells into the grid
   foreach cell $cells {

lset chs [$cell y] [$cell x] [string index " .tH" [$cell state]]

   }
   # Write the characters to stdout or a file
   if {$filename eq "-"} {set f stdout} else {set f [open $filename w]}
   foreach row $chs {

puts $f [join $row ""]

   }
   if {$f ne "stdout"} {close $f}

}

  1. How to perform the animation timestep

proc timeStep {t} {

   global cells

   # Arm the transition for all interacting cells
   foreach cell $cells {

$cell transition0

   }
   # Perform the transition for all interacting cells
   foreach cell $cells {

$cell transition1

   }

   # Reschedule
   after $t [list timeStep $t]

}

  1. Initialize the GUI (such as it is) and load and start the animation

wm title . "Wireworld: [lindex $argv 0]" loadWires [lindex $argv 0] pack [label .l -image pixels] bind . <KeyPress> {saveWires -} after 1000 timeStep 250</lang>