console show
focus -force .

array set _G {}

set _G(DISP_X) 320
set _G(DISP_Y) 240

proc bgerror {message} {puts $message}

proc recur_expr {dimension expr_list} {
	global _G
	set n [llength $expr_list]
	for {set i 0} {$i < $n} {incr i} {
		set x [lindex $expr_list $i]
		if {$dimension > 1} then {
			set x [recur_expr [expr $dimension-1] $x]
		} else {
			set x [expr $x]
		}
		lset expr_list $i $x
	}
	return $expr_list
}

set _G(tex_pic) [image create photo -file pic-2.gif]
set _G(spr_pic) [recur_expr 2 {
	{31*0 15*0 31 15}
	{31*0 15*1 31 15}
	{31*0 15*2 31 15}
	{31*0 15*3 31 15}
	{31*0 15*4 31 15}
	{31*0 15*5 31 15}
	{31*0 15*6 31 15}
	{31*0 15*7 31 15}}]

proc sprite_draw {dx dy i_spr} {
	global _G
	lassign [lindex $_G(spr_pic) $i_spr] sx sy w h
	$_G(vbuff) copy $_G(tex_pic) \
		-to $dx $dy \
		-from $sx $sy [expr $sx+$w] [expr $sy+$h]
}

proc surface_clear {} {
	global _G
	$_G(vbuff) blank
}

canvas .c -width $_G(DISP_X) -height $_G(DISP_Y) -highlightthickness 0 -background white
pack .c
set _G(vbuff) [image create photo -width $_G(DISP_X) -height $_G(DISP_Y)]
set _G(surface) [.c create image 0 0 -image $_G(vbuff) -anchor nw]

proc main_loop {} {
	global _G
	update
	surface_clear
	sprite_draw $_G(x) $_G(y) [expr int(rand()*8)]
	incr _G(x) 2
	incr _G(y) 1
	set _G(x) [expr $_G(x)%$_G(DISP_X)]
	set _G(y) [expr $_G(y)%$_G(DISP_Y)]
}

bind . <Destroy> {exit}


proc MainLoop_Init {} {
	global stMainLoop
	set stMainLoop(FPS)	30
	set stMainLoop(t0)	[clock milliseconds]
	set stMainLoop(tError)	0
}

proc MainLoop_Exec {} {
	global stMainLoop
	while 1 {
		update
		set t1 [clock milliseconds]
		set dt [expr $t1-$stMainLoop(t0)]
		set stMainLoop(t0) $t1
		incr stMainLoop(tError) [expr $dt*$stMainLoop(FPS)]
		if {$stMainLoop(tError) >= 0} { break }
		after 100
	}
	set stMainLoop(tError) [expr min($stMainLoop(tError)-1000,0)]
}

set _G(x) 0
set _G(y) 0

MainLoop_Init
while 1 {
	MainLoop_Exec
	main_loop
}
