A stained glass effect in Tcl

Download the stained glass images and put them in a folder with this source code (named something appropriate, like glass.tcl), and then run br glass.tcl.

#
# create the layer and ensure that z-hint sorting is enabled
#
set l [br::layer add]
set sl [lindex [br::layer info $l] 0]

br::layer sorted $l on



#
# now, we're going to create a stained-glass effect by combining two sprites:
# a color-adjustment sprite to give the glass some color, and a displacement
# sprite to give it the fuzzy, mottled look.  first we'll create a
# displacement map for the fuzzy effect, by making a list of small random
# pixel displacement values, which will comprise the displacement sprite.
#

for { set i 0 } { $i < 16000 } { incr i } {
  lappend map [expr {int( rand() * 5 ) - 2}]
}

set glass [br::sprite create]
br::sprite add-frame $glass [br::frame convert [br::frame from-disk window.png] lt]
br::sprite add-subframe $glass 0 [br::frame create displ 80 100 [binary format s16000 $map]]
br::sprite position $glass 100 20
br::sprite z-hint $glass 5
br::list add $sl $glass



#
# and last, load the bear sprite
#
set bear [br::sprite create]
br::sprite add-frame $bear [br::frame from-disk bear.png 255 0 255]
br::sprite z-hint $bear 0
br::list add $sl $bear



#
# set up the graphics display
#
br::graphics open accel 256 180 off 3



#
# and loop until esc key is pressed
#
set bx 5
set by 5

while 1 {

  # fetch the input status
  set io [br::io fetch 0]

  # read the `hat' of input 0 and update the bear position accordingly
  lassign [lindex $io 1] horiz vert
  incr bx $horiz
  incr by $vert

  br::sprite position $bear $bx $by

  # display the frame
  br::render display
  br::delay 50

  # quit on escape-keypress
  if { [lindex $io 7] || [br::io has-quit] } { exit }

}