# procs
proc getIndex {i j} \
{
  if {$i < 0} { set i [expr {$::size - 1}] }
  if {$i == $::size} { set i 0 }
  if {$j < 0} { set j [expr {$::size - 1}] }
  if {$j == $::size} { set j 0 }
  return [lsearch -exact $::colors [lindex $::data0 $i $j]]
}
proc createColors {} \
{
  set s 128
  for {set n 1} {$n <= $::count} {incr n} \
  {
    set h [expr {256 / ($::count + 1) * $n}]
    set v [expr {256 - $h}]
    # convert to RGB
    if {$s == 0} \
    { foreach c {r g b} { set $c [expr {int($v)}] } } \
    else \
    {
      set f [expr {$h / 60.0}]
      set i [expr {int($f)}]
      set f [expr {$f - $i}]
      set p [expr {$v * (1 - $s)}]
      set q [expr {$v * (1 - $s * $f)}]
      set t [expr {$v * (1 - $s * (1 - $f))}]
      set list \
      {
        {v t p}
        {q v p}
        {p v t}
        {p q v}
        {t p v}
        {v p q}
      }
      foreach c {r g b} u [lindex $list $i] \
      {
        set $c [expr {int([set $u])}]
        if {[set $c] < 0} { set $c 0 }
        if {[set $c] > 255} { set $c 255 }
      }
    }
    lappend ::colors [format #%02x%02x%02x $r $g $b]
  }
}

# parameters
set size 256
set count 15
# init
createColors
package require Tk
wm title . "ordre et chaos"
wm protocol . WM_DELETE_WINDOW exit
image create photo _img_ -width $size -height $size
canvas .c -width $size -height $size
.c create image 1 1 -anchor nw -image _img_
pack .c
raise .
focus -force .
set data1 [_img_ data]
set data0 $data1
for {set i 0} {$i < $size} {incr i} \
{
  for {set j 0} {$j < $size} {incr j} \
  {
    set index [expr {int(rand() * $count)}]
    if {$index == $::count} { set index [expr {$::count - 1}] }
    lset ::data1 $i $j [lindex $::colors $index]
  }
}
# pensive crystal
while {1} \
{
  _img_ put $data1
  set data0 $data1
  update
  for {set i 0} {$i < $size} {incr i} \
  {
    for {set j 0} {$j < $size} {incr j} \
    {
      set index [getIndex $i $j]
      set next [expr {($index + 1) % $::count}]
      incr i -1
      set list [list [getIndex $i $j]]
      incr i
      incr j -1
      lappend list [getIndex $i $j]
      incr j 2
      lappend list [getIndex $i $j]
      incr i
      incr j -1
      lappend list [getIndex $i $j]
      incr i -1
      foreach ndx $list \
      {
        if {$ndx == $next} \
        {
          lset ::data1 $i $j [lindex $::colors $ndx]
          break
        }
      }
    }
  }
}