Fun with canvas

ZB 2023-05-31 Inspiration was the image on this page: https://pl.pinterest.com/pin/uiinfographic--112027109830987715/

package require Tk

proc sprayDots { path dist {colour firebrick} } {
  set width  [$path cget -width]
  set height [$path cget -height]
  for { set x 0 } { $x <= $width } { incr x $dist } {
    for { set y 0 } { $y <= $height } { incr y $dist } {
      $path create rectangle $x $y $x $y -outline $colour -tag "dot_[set x]_[set y]"
    }
  }
}

proc coordinateSystem { path {colour firebrick} } {
  set width  [$path cget -width]
  set height [$path cget -height]
  set halfWidth  [expr {$width/2}]
  set halfHeight [expr {$height/2}]
  $path create line $halfWidth 0 $halfWidth $height -fill $colour \
    -arrow first -tag "vertical axis"
  $path create line 0 $halfHeight $width $halfHeight -fill $colour \
    -arrow last -tag "horizontal axis"
}

proc newCircle { path x1 y1 x2 y2 {colour firebrick} } {
global circles
  lappend circles [$path create oval $x1 $y1 $x2 $y2 -outline $colour]
}

proc inflate { path id } {
  set cc [$path coords $id]
  foreach {x1 y1 x2 y2} $cc break
  $path coords $id $x1 [expr {$y1-1}] [expr {$x2+2}] [expr {$y2+1}]
}

proc deleteOldest { path } {
global circles
  set id [lindex $circles 0]
  $path delete $id
  set circles [lreplace $circles 0 0]
}

proc mainLoop { path density interval howMany } {
global circles goOn
  set i 0
  while { $goOn } {
    if { [llength $circles] > $howMany } { deleteOldest $path }
    if { $i > $density } { set i 0 ; newCircle $path 50 250 50 250 }
    foreach id $circles { inflate $path $id }
    update
    after $interval
    incr i
  }
}

set canvasPath .c
pack [canvas $canvasPath -height 500 -width 500 -background black]
set id ""
set circles [list]
set goOn 1
bind . <Escape> { exit 0 }
wm protocol . WM_DELETE_WINDOW { set goOn 0 ; exit 0 }
sprayDots $canvasPath 25
coordinateSystem $canvasPath
newCircle $canvasPath 50 250 50 250
# Below: distance between circles 30 pixels, each 20ms new frame, 10 circles kept on canvas
mainLoop $canvasPath 29 20 10

saito - 2023-06-06 Nice animation!


Jeff Smith 2023-06-07 : Below is an online demo using CloudTk. This demo runs "Fun-with-canvas" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Fun-with-canvas.kit + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.

ZB 2023-06-26 Works OK :)