Trees in Tcl

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

#
# some definitions
#
set layerct 5
set treect { 0 12 24 60 120 }



#
# simple helper procs
#
proc rand { min max } { expr {int( $min + rand() * ($max-$min+1) )} }
proc limit { min val max } { expr { $val < $min ? $min : ($val > $max ? $max : $val)} }




#
# load the trees
#
foreach file {mountain1 tree1 tree2 tree3 tree4} {
  set sprites($file) [br::sprite create]
  br::sprite add-frame $sprites($file) [br::frame convert [br::frame from-disk $file.png] lt]
}



#
# make some layers
#
for { set i 0 } { $i < $layerct } { incr i } {

  set layers($i) [br::layer add]

  # place a mountain on layer 0
  if { !$i } {

    set s [br::sprite copy $sprites(mountain1)]
    br::sprite pos $s 0 80
    br::list add [lindex [br::layer info $layers($i)] 0] $s

  } else {

    # all other layers get trees
    for { set j 0 } { $j < [lindex $treect $i] } { incr j } {
      set s [br::sprite copy $sprites(tree[rand 1 4])]
      br::sprite pos $s [rand 20 [expr {$i*600}]] [rand [expr {$i*10+90}] [expr {$i*20+120}]]
      br::list add [lindex [br::layer info $layers($i)] 0] $s
    }

  }

}



#
# open graphics
#
br::graphics open accel 384 240 off 2



#
# initialize the camera position and enter the main loop
#
set cx 0
set cy 0

while 1 {

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

  # update the camera position and limit cx to the range 20 .. 400
  incr cx [lindex $io 1 0]
  incr cy [lindex $io 1 1]

  set cx [limit 20 $cx 200]



  # and scroll the layers .. move the mountain at half-speed and
  # the rest at various speeds, to give a nice parallax effect
  br::layer camera $layers(0) [expr {$cx/2}] 0
  for { set i 1 } { $i < $layerct } { incr i } {
    br::layer camera $layers($i) [expr {$cx*($i+1)}] 0
  }

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

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

}