#!/usr/local/bin/wish -f

################################################################################
#
# Budge - a puzzle/arcade game for X, written using Tcl/Tk
#
# Copyright 1994, Nat Pryce
#
################################################################################

# Default option settings

set budge(lib)			~np2/lib/games/budge

set budge(level_file)		$budge(lib)/levels
set budge(iconbitmap)		@$budge(lib)/bitmaps/icon.xbm
set budge(iconmask)		@$budge(lib)/bitmaps/iconmask.xbm
set budge(monster_delay)	250
set budge(freeze_delay)		10000
set budge(bg)			white
set budge(fg)			black
set budge(lives)		3

# Key definitions: these can be set by the X resources

set budge(up)			Up
set budge(down)			Down
set budge(left)			Left
set budge(right)		Right
set budge(die)			F3
set budge(pause)		F2
set budge(quit)			F8
set budge(play)			F1
set budge(keys)			F4


# These cannot be changed via the X resources:
#
set budge(bitmap_width)		24
set budge(bitmap_height)	24
set budge(screen_width)		20
set budge(screen_height)	15
set budge(num_levels)		0

set budge(canvas)		"" ;# This is set in the open_window proc

set budge(game_over)		1
set budge(game_paused)		0


################################################################################
# Game element arrays (for conversions from level-file format to internal format
# and from internal format to bitmaps)

set element(\ )	Empty
set element(#)	Block
set element(-)	Invisible
set element(+)	Gate
set element(o)	Disc
set element(x)	Killer
set element(f)	Freeze
set element(P)	Player
set element(*)	Spiky
set element(@)	Fluffy
set element(!)	Dead

set bitmap(Empty)	""
set bitmap(Invisible)	""
set bitmap(Gate)	@$budge(lib)/bitmaps/gate.xbm
set bitmap(Killer)	@$budge(lib)/bitmaps/killer.xbm
set bitmap(Player)	@$budge(lib)/bitmaps/player.xbm
set bitmap(Disc)	@$budge(lib)/bitmaps/disk.xbm
set bitmap(Freeze)	@$budge(lib)/bitmaps/freeze.xbm
set bitmap(Spiky)	@$budge(lib)/bitmaps/spiky.xbm
set bitmap(Fluffy)	@$budge(lib)/bitmaps/squashy.xbm
set bitmap(Dead)	@$budge(lib)/bitmaps/dead.xbm
set bitmap(Heart)	@$budge(lib)/bitmaps/heart.xbm

set bitmap(Block,0)	@$budge(lib)/bitmaps/blocks/block.xbm
set bitmap(Block,1)	@$budge(lib)/bitmaps/blocks/block_u.xbm
set bitmap(Block,2)	@$budge(lib)/bitmaps/blocks/block_d.xbm
set bitmap(Block,3)	@$budge(lib)/bitmaps/blocks/block_ud.xbm
set bitmap(Block,4)	@$budge(lib)/bitmaps/blocks/block_l.xbm
set bitmap(Block,5)	@$budge(lib)/bitmaps/blocks/block_ul.xbm
set bitmap(Block,6)	@$budge(lib)/bitmaps/blocks/block_dl.xbm
set bitmap(Block,7)	@$budge(lib)/bitmaps/blocks/block_udl.xbm
set bitmap(Block,8)	@$budge(lib)/bitmaps/blocks/block_r.xbm
set bitmap(Block,9)	@$budge(lib)/bitmaps/blocks/block_ur.xbm
set bitmap(Block,10)	@$budge(lib)/bitmaps/blocks/block_dr.xbm
set bitmap(Block,11)	@$budge(lib)/bitmaps/blocks/block_udr.xbm
set bitmap(Block,12)	@$budge(lib)/bitmaps/blocks/block_lr.xbm
set bitmap(Block,13)	@$budge(lib)/bitmaps/blocks/block_ulr.xbm
set bitmap(Block,14)	@$budge(lib)/bitmaps/blocks/block_dlr.xbm
set bitmap(Block,15)	@$budge(lib)/bitmaps/blocks/block_udlr.xbm



################################################################################
# Manage the game windows

proc open_window {} {
   global budge bitmap

   # Toplevel window of class Budge
   #
   wm title . "Budge - by Nat Pryce"
   wm iconname . "Budge"
   wm iconbitmap . $budge(iconbitmap)
   wm iconmask . $budge(iconmask)
   wm protocol . WM_DELETE_WINDOW quit_dialog

   # Game frame
   #
   frame .game -relief flat -bd 0
   frame .game.buttons -relief raised -bd 2
   button .game.buttons.stop -text "Quit this game" -command end_of_game
   button .game.buttons.die -text "Lose a life" -command lose_a_life
   checkbutton .game.buttons.pause -text "Pause" -variable budge(game_paused) \
      -command { 
         if $budge(game_paused) {
            display_message "Game paused"
         } else {
            clear_message
         }
      }
   label .game.buttons.msg -textvariable budge(message) -anchor w
   pack append .game.buttons .game.buttons.stop {left padx 8 pady 8} \
                               .game.buttons.die {left padx 8 pady 8} \
                               .game.buttons.pause {left padx 8 pady 8} \
                               .game.buttons.msg {left padx 8 pady 8}
   frame .game.f -relief raised -bd 1
   canvas .game.f.canvas -relief flat -bg $budge(bg) \
               -width [expr "$budge(screen_width) * $budge(bitmap_width)"] \
               -height [expr "$budge(screen_height) * $budge(bitmap_height)"]
   set budge(canvas) .game.f.canvas
   focus $budge(canvas)
   pack append .game.f $budge(canvas) {padx 24 pady 24}
   frame .game.status -relief raised -bd 1
   frame .game.status.lives -relief sunken -bd 1 
   label .game.status.lives.title -text "Lives:" -anchor w
   label .game.status.lives.var -textvariable player(lives) -anchor w
   pack append .game.status.lives .game.status.lives.title {left} \
                                    .game.status.lives.var {fillx}
   frame .game.status.level -relief sunken -bd 1 
   label .game.status.level.title -text "Level:" -anchor w
   label .game.status.level.var -textvariable player(level) -anchor w
   pack append .game.status.level .game.status.level.title {left} \
                                    .game.status.level.var {fillx}
   label .game.status.title -relief sunken -bd 1 -text "Budge" \
                              -anchor center
   pack append .game.status .game.status.lives {left} \
                              .game.status.level {left} \
                              .game.status.title {fill expand}
   pack append .game .game.buttons {top fillx} \
                       .game.f {top} \
                       .game.status {fillx}
                       


   # Info frame
   #
   frame .info -relief flat -bd 0
   frame .info.buttons -relief raised -bd 2
   button .info.buttons.quit -text "Quit completely" -command quit_dialog
   button .info.buttons.play -text "Play game" -command start_game
   button .info.buttons.keys -text "Change Keys..." -command keys_dialog
   label .info.buttons.msg -textvariable budge(message) -anchor w
   pack append .info.buttons .info.buttons.quit {left padx 8 pady 8} \
                               .info.buttons.play {left padx 8 pady 8} \
                               .info.buttons.keys {left padx 8 pady 8} \
                               .info.buttons.msg {left padx 8 pady 8}
   message .info.msg -relief raised -bd 1 -aspect 500 -justify center \
      -text "Complete each screen by getting the monsters to bump into each other, using the objects scattered around to alter their paths. Beware, touching a monster is fatal and certain objects can kill you too!" 

   frame .info.chars -relief raised -bd 1
   label .info.chars.title -text "Characters"
   label .info.chars.player_pic -bitmap $bitmap(Player)
   message .info.chars.player_txt -aspect 1000 -justify center \
      -text "Budge\n(player character)"
   label .info.chars.fluffy_pic -bitmap $bitmap(Fluffy)
   message .info.chars.fluffy_txt -aspect 1000 -justify center \
      -text "Fluffy Monster\n(wanders about aimlessly)"
   label .info.chars.spiky_pic -bitmap $bitmap(Spiky)
   message .info.chars.spiky_txt -aspect 1000 -justify center \
      -text "Spiky Monster\n(chases you stupidly)"
   pack append .info.chars .info.chars.title {top fillx pady 16} \
                             .info.chars.player_pic {top} \
                             .info.chars.player_txt {top} \
                             .info.chars.fluffy_pic {top} \
                             .info.chars.fluffy_txt {top} \
                             .info.chars.spiky_pic {top} \
                             .info.chars.spiky_txt {top} \

   frame .info.objs -relief raised -bd 1
   label .info.objs.title -text "Objects"
   label .info.objs.block_pic -bitmap $bitmap(Block,0)
   message .info.objs.block_txt -aspect 1000 -justify center \
      -text "Wall"
   label .info.objs.gate_pic -bitmap $bitmap(Gate)
   message .info.objs.gate_txt  -aspect 1000 -justify center \
      -text "Gate\n(can be opened but not shut)"
   label .info.objs.disc_pic -bitmap $bitmap(Disc)
   message .info.objs.disc_txt -aspect 1000 -justify center \
      -text "Disc\n(can be pushed about)"
   label .info.objs.freeze_pic -bitmap $bitmap(Freeze)
   message .info.objs.freeze_txt -aspect 1000 -justify center \
      -text "Freeze Pill\n(pick up to temporarily freeze the monsters)"
   label .info.objs.killer_pic -bitmap $bitmap(Killer)
   message .info.objs.killer_txt -aspect 1000 -justify center \
      -text "Killer\n(don't walk into these!)"
   pack append .info.objs .info.objs.title {top fillx pady 16} \
                            .info.objs.block_pic {top} \
                            .info.objs.block_txt {top} \
                            .info.objs.gate_pic {top} \
                            .info.objs.gate_txt {top} \
                            .info.objs.disc_pic {top} \
                            .info.objs.disc_txt {top} \
                            .info.objs.freeze_pic {top} \
                            .info.objs.freeze_txt {top} \
                            .info.objs.killer_pic {top} \
                            .info.objs.killer_txt {top} \

   pack append .info .info.buttons {top fillx} \
                       .info.msg {top fillx} \
                       .info.chars {left filly} \
                       .info.objs {right filly}
}


proc display_info {} {
   pack unpack .game
   pack append . .info {fill}
   focus .info
   focus default .info
}

proc display_game {} {
   global budge
   pack unpack .info
   pack append . .game {fill}
   focus $budge(canvas)
   focus default $budge(canvas)
}

proc display_message {msg} {
   global budge
   set budge(message) $msg
   update
}

proc clear_message {} {
   global budge
   set budge(message) ""
   update
}

proc display_title {t} {
   .game.status.title configure -text $t
}



proc bind_keys {} {
   global budge

   bind $budge(canvas) <Key-$budge(up)>		up
   bind $budge(canvas) <Key-$budge(down)>	down
   bind $budge(canvas) <Key-$budge(left)>	left
   bind $budge(canvas) <Key-$budge(right)>	right
   bind $budge(canvas) <Key-$budge(pause)>	toggle_pause
   bind $budge(canvas) <Key-$budge(die)>	lose_a_life
   bind $budge(canvas) <Key-$budge(quit)>	end_of_game

   bind .info <Key-$budge(play)>	start_game
   bind .info <Key-$budge(keys)>	keys_dialog
   bind .info <Key-$budge(quit)>	quit_dialog	
}


# Pop up a window contining the current key settings which allows the to set
# the keys.
#
proc keys_dialog {} {
   global budge
   
   set w .keys 
   if [winfo exists $w] {
      # If the window already exists, reset its key settings and raise to the
      # top.
      $w.f.f2.up configure -text "$budge(up)" 
      $w.f.f2.down configure -text "$budge(down)" 
      $w.f.f2.left configure -text "$budge(left)"
      $w.f.f2.right configure -text "$budge(right)"
      $w.f.f2.play configure -text "$budge(play)" 
      $w.f.f2.pause configure -text "$budge(pause)"
      $w.f.f2.die configure -text "$budge(die)" 
      $w.f.f2.quit configure -text "$budge(quit)"
      $w.f.f2.keys configure -text "$budge(keys)"
      return
   }
   
   toplevel $w
   wm transient $w .
   wm title $w "Change Keys"
   wm withdraw $w
   
   frame $w.f -relief flat
   
   frame $w.f.f1 -relief raised -bd 1
   label $w.f.f1.up -relief flat -bd 2 -text "Up:" -anchor w
   label $w.f.f1.down -relief flat -bd 2 -text "Down:" -anchor w
   label $w.f.f1.left -relief flat -bd 2 -text "Left:" -anchor w
   label $w.f.f1.right -relief flat -bd 2 -text "Right:" -anchor w
   label $w.f.f1.play -relief flat -bd 2 -text "Start Game:" -anchor w
   label $w.f.f1.pause -relief flat -bd 2 -text "Pause:" -anchor w
   label $w.f.f1.die -relief flat -bd 2 -text "Lose a Life:" -anchor w
   label $w.f.f1.keys -relief flat -bd 2 -text "Change Keys:" -anchor w
   label $w.f.f1.quit -relief flat -bd 2 -text "Quit:" -anchor w
   pack append $w.f.f1 $w.f.f1.up {fillx} \
                     $w.f.f1.down {fillx} \
                     $w.f.f1.left {fillx} \
                     $w.f.f1.right {fillx} \
                     $w.f.f1.play {fillx} \
                     $w.f.f1.pause {fillx} \
                     $w.f.f1.die {fillx} \
                     $w.f.f1.keys {fillx} \
                     $w.f.f1.quit {fillx}
                                          
   frame $w.f.f2 -relief raised -bd 1
   label $w.f.f2.up -relief flat -bd 2 -text "$budge(up)" 
   bind $w.f.f2.up <Key> "%W configure -text %K; focus $w.f.f2.down"
   bind $w.f.f2.up <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.up <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.up <Button-1> "focus %W"
   label $w.f.f2.down -relief flat -bd 2 -text "$budge(down)" 
   bind $w.f.f2.down <Key> "%W configure -text %K; focus $w.f.f2.left"
   bind $w.f.f2.down <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.down <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.down <Button-1> "focus %W"
   label $w.f.f2.left -relief flat -bd 2 -text "$budge(left)"
   bind $w.f.f2.left <Key> "%W configure -text %K; focus $w.f.f2.right"
   bind $w.f.f2.left <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.left <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.left <Button-1> "focus %W"
   label $w.f.f2.right -relief flat -bd 2 -text "$budge(right)"
   bind $w.f.f2.right <Key> "%W configure -text %K; focus $w.f.f2.play"
   bind $w.f.f2.right <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.right <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.right <Button-1> "focus %W"
   label $w.f.f2.play -relief flat -bd 2 -text "$budge(play)" 
   bind $w.f.f2.play <Key> "%W configure -text %K; focus $w.f.f2.pause"
   bind $w.f.f2.play <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.play <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.play <Button-1> "focus %W"
   label $w.f.f2.pause -relief flat -bd 2 -text "$budge(pause)"
   bind $w.f.f2.pause <Key> "%W configure -text %K; focus $w.f.f2.die"
   bind $w.f.f2.pause <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.pause <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.pause <Button-1> "focus %W"
   label $w.f.f2.die -relief flat -bd 2 -text "$budge(die)" 
   bind $w.f.f2.die <Key> "%W configure -text %K; focus $w.f.f2.quit"
   bind $w.f.f2.die <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.die <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.die <Button-1> "focus %W"
   label $w.f.f2.keys -relief flat -bd 2 -text "$budge(keys)"
   bind $w.f.f2.keys <Key> "%W configure -text %K; focus $w.f.f2.up"
   bind $w.f.f2.keys <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.keys <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.keys <Button-1> "focus %W"
   label $w.f.f2.quit -relief flat -bd 2 -text "$budge(quit)"
   bind $w.f.f2.quit <Key> "%W configure -text %K; focus $w.f.f2.keys"
   bind $w.f.f2.quit <FocusIn> "%W configure -relief sunken"
   bind $w.f.f2.quit <FocusOut> "%W configure -relief flat"
   bind $w.f.f2.quit <Button-1> "focus %W"
   pack append $w.f.f2 $w.f.f2.up {fillx} \
                     $w.f.f2.down {fillx} \
                     $w.f.f2.left {fillx} \
                     $w.f.f2.right {fillx} \
                     $w.f.f2.play {fillx} \
                     $w.f.f2.pause {fillx} \
                     $w.f.f2.die {fillx} \
                     $w.f.f2.keys {fillx} \
                     $w.f.f2.quit {fillx}
   
   frame $w.buttons -relief raised -bd 1
   button $w.buttons.ok -text "Ok" \
      -command "set_keys_from_dialog $w;focus [focus default]; destroy $w"
   button $w.buttons.reset -text "Reset" -command "keys_dialog"
   button $w.buttons.cancel -text "Cancel" \
      -command "focus [focus default]; destroy $w"
   pack append $w.buttons $w.buttons.ok {left expand padx 16 pady 16} \
                          $w.buttons.reset {left expand padx 16 pady 16} \
                          $w.buttons.cancel {left expand padx 16 pady 16}

   pack append $w.f $w.f.f1 {left filly} $w.f.f2 {right fill expand}
   pack append $w $w.buttons {bottom fillx} $w.f {fill}
   center_window $w .
   focus $w.f.f2.up
   grab $w
}

proc set_keys_from_dialog {w} {
   global budge
   
   set budge(up) [lindex [$w.f.f2.up configure -text] 4]
   set budge(down) [lindex [$w.f.f2.down configure -text] 4]
   set budge(left) [lindex [$w.f.f2.left configure -text] 4]
   set budge(right) [lindex [$w.f.f2.right configure -text] 4]
   set budge(play) [lindex [$w.f.f2.play configure -text] 4]
   set budge(pause) [lindex [$w.f.f2.pause configure -text] 4]
   set budge(die) [lindex [$w.f.f2.die configure -text] 4]
   set budge(quit) [lindex [$w.f.f2.quit configure -text] 4]
   set budge(keys) [lindex [$w.f.f2.keys configure -text] 4]
   
   bind_keys
}


proc quit_dialog {} {
   set w .quit
   catch {destroy $w}
   
   toplevel $w
   wm transient $w .
   wm title $w "Really Quit?"
   wm withdraw $w
   
   message $w.msg -relief raised -bd 1 -text "Do you really want to quit?" \
                  -justify center -aspect 300
   frame $w.buttons -relief raised -bd 1
   button $w.yes -text "Yes" -command "exit"
   button $w.no -text "No" -command "destroy $w"
   pack append $w.buttons $w.yes {left padx 16 pady 16 expand} \
                          $w.no {left padx 16 pady 16 expand}
   pack append $w $w.buttons {bottom fillx} $w.msg {fill}
   
   bind $w <Return>	"$w.yes invoke"
   bind $w <y>		"$w.yes invoke"
   bind $w <Escape>	"$w.no invoke"
   bind $w <n>		"$w.no invoke"
   focus $w
   center_window $w .
   grab $w
}

proc center_window {w {p ""}} {
   update idletasks
   if {$p == ""} {
      set p [focus]
   }
        
   # Determine the toplevel window
   
   if {$p == "none"} {
      wm deiconify $w
      return
   }
   set p [winfo toplevel $p]
   if [winfo ismapped $w] {
      wm withdraw $w
   }
   update idletasks
   set winX [expr {(([winfo width  $p]-[winfo reqwidth  $w])/2)+[winfo x $p]}]
   if {$winX < 0} {set winX 0}
   set winY [expr {(([winfo height $p]-[winfo reqheight $w])/2)+[winfo y $p]}]
   if {$winY < 0} {set winY 0}
   wm geometry $w +${winX}+${winY}
   wm deiconify $w
}


################################################################################
# Get X Defaults

proc get_option {opt class default} {
   set result [option get . $opt $class]
   if [string match "" $result] {
      # puts "Used default of $default for resource $opt/$class"
      return $default
   } else {
      # puts "Found resource of $result for resource $opt/$class"
      return $result
   }
}


proc get_options {} {
   global budge

   set budge(level_file) \
      [get_option levelFile LevelFile $budge(level_file)]
   set budge(monster_delay) \
      [get_option monsterDelay MonsterDelay $budge(monster_delay)]
   set budge(freeze_delay) \
      [get_option freezeDelay FreezeDelay $budge(freeze_delay)]
   set budge(lives) \
      [get_option lives Lives $budge(lives)]

   set budge(up) \
      [get_option up Up $budge(up)]
   set budge(down) \
      [get_option down Down $budge(down)]
   set budge(left) \
      [get_option left Left $budge(left)]
   set budge(right) \
      [get_option right Right $budge(right)]
   set budge(die) \
      [get_option die Die $budge(die)]
   set budge(pause) \
      [get_option pause Pause $budge(pause)]
   set budge(quit) \
      [get_option quit Quit $budge(quit)]
   set budge(play) \
      [get_option play Play $budge(play)]
   set budge(keys) \
      [get_option changeKeys ChangeKeys $budge(keys)]
}


################################################################################

# What is at position (x,y)? Reuturn an empty string if (x,y) are not on screen.
#
proc element_at {x y} {
   global budge screen
   
   if {$x >= 0 && $x < $budge(screen_width) 
   &&  $y >= 0 && $y < $budge(screen_height) } {
      return $screen($x,$y)
   } else {
      return ""
   }
}

# Is there a block at (x,y)?
proc block_at {x y} {
   return [expr {[element_at $x $y] == "Block"}]
}


# Return the bitmap ID for the element at (x,y)
#
proc bitmap_for {x y} {
   global bitmap screen
   
   if [string match $screen($x,$y) Block] {
      global screen
      set bl [expr "([block_at $x [expr $y-1]] ? 1 : 0 ) + \
                    ([block_at $x [expr $y+1]] ? 2 : 0 ) + \
                    ([block_at [expr $x-1] $y] ? 4 : 0 ) + \
                    ([block_at [expr $x+1] $y] ? 8 : 0 )   "]
      return $bitmap(Block,$bl)
   } else {
      return $bitmap($screen($x,$y))
   }
}


# Read a level from the open budge level file into the screen array and display
# it on the canvas
# Note: The "for {set x ..." loop allows one to position monsters just beyond 
#       the right hand side of the screen for some nasty tricks on the players!
#       Note that the Spiky monster will move towards the player and come back 
#       on screen unless its path is blocked. The Fluffy monster will only move
#       if it is right next to the right hand edge of the screen and there is
#       an empty space for it to move onto. Otherwise, it will keep spinning on
#       the spot!
#
proc read_level {} {
   global budge screen element monsters player

   # Read the title - it must be in quotes
   gets $budge(level_stream) title
   display_title [lindex $title 0]

   # Read the screen
   for {set y 0} {$y < $budge(screen_height)} {incr y} {
      set len [gets $budge(level_stream) line]
      for {set x 0} {$x < $len && $x <= $budge(screen_width)} {incr x} {
         set screen($x,$y) $element([string index $line $x])
      }
      while {$x <= $budge(screen_width)} {
         set screen($x,$y) Empty
         incr x
      }
   }

   # Draw screen
   for {set y 0} {$y < $budge(screen_height)} {incr y} {
      for {set x 0} {$x <= $budge(screen_width)} {incr x} {
         set bit [bitmap_for $x $y]
         if ![string match "" $bit] {
            $budge(canvas) create bitmap [expr "$x * $budge(bitmap_width)"] \
               [expr "$y * $budge(bitmap_height)"] -tags element($x,$y) \
               -foreground $budge(fg) -bitmap $bit -anchor nw
         }
         
         if [string match $screen($x,$y) Spiky] {
            set screen($x,$y) Monster
            $budge(canvas) itemconfigure element($x,$y) -tags {spiky monster}
            set monsters(spiky,x) $x
            set monsters(spiky,y) $y
            
         } elseif [string match $screen($x,$y) Fluffy] {
            set screen($x,$y) Monster
            $budge(canvas) itemconfigure element($x,$y) -tags {fluffy monster}
            set monsters(fluffy,x) $x
            set monsters(fluffy,y) $y
            set monsters(fluffy,dx) 1
            set monsters(fluffy,dy) 0
            
         } elseif [string match $screen($x,$y) Player] {
            set screen($x,$y) Empty
            $budge(canvas) itemconfigure element($x,$y) -tags player
            set player(x) $x
            set player(y) $y
         }
      }
   }
}


# Open the level file and count the number of levels in it. The level stream
# is rewound by start_game
#
proc open_level_file {} {
   global budge
   
   if ![file readable $budge(level_file)] {
      puts stderr "level file $budge(level_file) not readable"
      exit 1
   }
   
   set budge(level_stream) [open $budge(level_file) r]

   # Count the number of levels
   set len 0
   set levels 0
   while 1 {
      # Read level header
      set len [gets $budge(level_stream) line]
      if {$len == -1} break
      
      incr levels
      
      # Read level body
      for {set i 0} {$i < $budge(screen_height)} {incr i} {
         set len [gets $budge(level_stream) line]
      }
      if {$len == -1} break
   }
   
   set budge(num_levels) $levels
}



################################################################################


# The player has lost a life. Pause the game, decrease the lives count, show
# a dead player. If the player still has some lives, rewind the level stream
# to the start of the current level and reread the level from the stream.
#
proc lose_a_life {} {
   global budge player bitmap monsters
   
   set budge(game_paused) 1
   
   display_message "AAAAaaaarrrrgggghhh..."
   
   incr player(lives) -1
   set monsters(freeze) 0
   $budge(canvas) itemconfigure player -bitmap $bitmap(Dead)
   update
   
   if $player(lives) {
      $budge(canvas) delete all
      seek $budge(level_stream) $budge(start_of_current_level) start
      read_level
      clear_message
      set budge(game_paused) 0
   } else {
      after 1000 end_of_game
   }
}

# End of game. The player is dead. Set the game-over flag and display the
# initial info window, after some delay (so the player can see why he died.
#
proc end_of_game {} {
   global budge player
   
   display_message "Game over at level $player(level)" 
   set budge(game_over) 1
   display_info
}


# Start a new game - set up initial stats and read in the first level
#
proc start_game {} {
   global budge player monsters
   
   set player(lives) $budge(lives)
   set player(level) 1
   set monsters(freeze) 0

   display_message "Loading first level"   
   $budge(canvas) delete all
   display_game
   seek $budge(level_stream) 0 start
   set budge(start_of_current_level) 0
   read_level
   clear_message
   set budge(game_paused) 0
   set budge(game_over) 0
}


# End of level - read in the new level, unfreeze any monsters and off we go...
#
proc end_of_level {} {
   global budge player monsters bitmap
   
   set budge(game_paused) 1
   
   $budge(canvas) itemconfigure monster -bitmap $bitmap(Heart) -foreground red
   display_message "Loading next level"
   
   incr player(level)
   if {$player(level) > $budge(num_levels)} {
      seek $budge(level_stream) 0 start
   } 
   
   $budge(canvas) delete all
   set budge(start_of_current_level) [tell $budge(level_stream)]
   read_level
   clear_message
   set monsters(freeze) 0
   set budge(game_paused) 0
}


# If the game is paused, unpause. If it is not paused, pause. Simple!
#
proc toggle_pause {} {
   global budge

   if {!$budge(game_over)} {
      if $budge(game_paused) {
         set budge(game_paused) 0
         clear_message
      } else {
         set budge(game_paused) 1
         display_message "Game paused"
      }
   }
}
   

################################################################################
# Player movement

proc disc_moves {from_x from_y dx dy} {
   global budge screen
   
   set x [expr "$from_x + $dx"]
   set y [expr "$from_y + $dy"]

   if {[element_at $x $y] == "Empty"} {
      $budge(canvas) move element($from_x,$from_y) \
         [expr $dx*$budge(bitmap_width)] [expr $dy*$budge(bitmap_height)]
      $budge(canvas) itemconfigure element($from_x,$from_y) -tags element($x,$y)
      set screen($from_x,$from_y) Empty
      set screen($x,$y) Disc
      return 1
   } else {
      return 0
   }
}

   

proc up {} {
   global budge
   if {$budge(game_paused) || $budge(game_over)} return
   
   global player screen monsters
   
   set y1 [expr "$player(y) - 1"]
   if {$y1 < 0} return
   
   case $screen($player(x),$y1) {
      Empty {
         set player(y) $y1
      }
      Gate {
         $budge(canvas) delete element($player(x),$y1)
         set screen($player(x),$y1) Empty
         set player(y) $y1
      }
      Disc {
         if [disc_moves $player(x) $y1 0 -1] {
            set player(y) $y1
         } else {
            return
         }
      }
      Freeze {
         $budge(canvas) delete element($player(x),$y1)
         set monsters(freeze) [expr $budge(freeze_delay)/$budge(monster_delay)]
         set screen($player(x),$y1) Empty
         set player(y) $y1
      }
      Monster {
         lose_a_life
         return
      }
      * {
         # Anything else blocks the player (ie: Block, Invisible, Dead)
         return
      }
   }
   $budge(canvas) move player 0 -$budge(bitmap_height)
}


proc down {} {
   global budge
   if {$budge(game_paused) || $budge(game_over)} return
   
   global player screen monsters
   
   set y1 [expr "$player(y) + 1"]
   if {$y1 >= $budge(screen_height)} return
   
   case $screen($player(x),$y1) {
      Empty {
         set player(y) $y1
      }
      Gate {
         $budge(canvas) delete element($player(x),$y1)
         set screen($player(x),$y1) Empty
         set player(y) $y1
      }
      Disc {
         if [disc_moves $player(x) $y1 0 1] {
            set player(y) $y1
         } else {
            return
         }
      }
      Freeze {
         $budge(canvas) delete element($player(x),$y1)
         set monsters(freeze) [expr $budge(freeze_delay)/$budge(monster_delay)]
         set screen($player(x),$y1) Empty
         set player(y) $y1
      }
      Monster {
         lose_a_life
         return
      }
      * {
         # Anything else blocks the player (ie: Block, Invisible, Dead)
         return
      }
   }
   $budge(canvas) move player 0 $budge(bitmap_height)
}


proc left {} {
   global budge
   if {$budge(game_paused) || $budge(game_over)} return
   
   global player screen monsters
   
   set x1 [expr "$player(x) - 1"]
   if {$x1 < 0} return
   
   case $screen($x1,$player(y)) {
      Empty {
         set player(x) $x1
      }
      Gate {
         $budge(canvas) delete element($x1,$player(y))
         set screen($x1,$player(y)) Empty
         set player(x) $x1
      }
      Disc {
         if [disc_moves $x1 $player(y) -1 0] {
         set player(x) $x1
         } else {
            return
         }
      }
      Freeze {
         $budge(canvas) delete element($x1,$player(y))
         set monsters(freeze) [expr $budge(freeze_delay)/$budge(monster_delay)]
         set screen($x1,$player(y)) Empty
         set player(x) $x1
      }
      Monster {
         lose_a_life
         return
      }
      * {
         # Anything else blocks the player (ie: Block, Invisible, Dead)
         return
      }
   }
   $budge(canvas) move player -$budge(bitmap_height) 0
}


proc right {} {
   global budge
   if {$budge(game_paused) || $budge(game_over)} return
   
   global player screen monsters
   
   set x1 [expr "$player(x) + 1"]
   if {$x1 >= $budge(screen_width)} return
   
   case $screen($x1,$player(y)) {
      Empty {
         set player(x) $x1
      }
      Gate {
         $budge(canvas) delete element($x1,$player(y))
         set screen($x1,$player(y)) Empty
         set player(x) $x1
      }
      Disc {
         if [disc_moves $x1 $player(y) 1 0] {
         set player(x) $x1
         } else {
            return
         }
      }
      Freeze {
         $budge(canvas) delete element($x1,$player(y))
         set monsters(freeze) [expr $budge(freeze_delay)/$budge(monster_delay)]
         set screen($x1,$player(y)) Empty
         set player(x) $x1
      }
      Monster {
         lose_a_life
         return
      }
      * {
         # Anything else blocks the player (ie: Block, Invisible, Dead)
         return
      }
   }
   $budge(canvas) move player $budge(bitmap_height) 0
}

################################################################################

proc move_monsters {} {
   global budge monsters player screen
   
   if {$budge(game_paused) || $budge(game_over)} {
      after $budge(monster_delay) move_monsters
      return
   }
   
   if {$monsters(freeze) > 0} {
      incr monsters(freeze) -1
      after $budge(monster_delay) move_monsters
      return
   }
   
   # Move Spiky monster
   
   if {$monsters(spiky,y) > $player(y)} {
      set y1 [expr "$monsters(spiky,y) - 1"]
      set dy -$budge(bitmap_height)
   } elseif {$monsters(spiky,y) < $player(y)} {
      set y1 [expr "$monsters(spiky,y) + 1"]
      set dy $budge(bitmap_height)
   } else {
      set y1 $monsters(spiky,y)
      set dy 0
   }
   if {$monsters(spiky,x) > $player(x)} {
      set x1 [expr "$monsters(spiky,x) - 1"]
      set dx -$budge(bitmap_width)
   } elseif {$monsters(spiky,x) < $player(x)} {
      set x1 [expr "$monsters(spiky,x) + 1"]
      set dx $budge(bitmap_width)
   } else {
      set x1 $monsters(spiky,x)
      set dx 0
   }

   if {$screen($x1,$y1) == "Empty" ||$screen($x1,$y1) == "Monster"}  {
      set screen($monsters(spiky,x),$monsters(spiky,y)) Empty
      set screen($x1,$y1) Monster
      set monsters(spiky,x) $x1
      set monsters(spiky,y) $y1
      $budge(canvas) move spiky $dx $dy
   }
   
   # Move Fluffy monster
   
   set x1 [expr "$monsters(fluffy,x) + $monsters(fluffy,dx)"]
   set y1 [expr "$monsters(fluffy,y) + $monsters(fluffy,dy)"]
   if {[element_at $x1 $y1] == "Empty" || [element_at $x1 $y1] == "Monster"} {
      set screen($monsters(fluffy,x),$monsters(fluffy,y)) Empty
      set screen($x1,$y1) Monster
      set monsters(fluffy,x) $x1
      set monsters(fluffy,y) $y1
      $budge(canvas) move fluffy \
         [expr "$monsters(fluffy,dx) * $budge(bitmap_width)"] \
         [expr "$monsters(fluffy,dy) * $budge(bitmap_height)"]
   } else {
      # Rotate anti-clockwise
      set temp $monsters(fluffy,dy)
      set monsters(fluffy,dy) [expr -$monsters(fluffy,dx)]
      set monsters(fluffy,dx) $temp
   }

   if {$screen($player(x),$player(y)) == "Monster"} {
      lose_a_life
   } elseif {$monsters(fluffy,x) == $monsters(spiky,x)
   && $monsters(fluffy,y) == $monsters(spiky,y) } {
      end_of_level
   }

   after $budge(monster_delay) move_monsters
}   

################################################################################

open_window
get_options
bind_keys

# Get command line options
for {set i 0} {$i < [llength $argv]} {incr i} {
   case [lindex $argv $i] {
      -iconic { # Start up as an icon
         wm iconify .
      }
      
      -lf { #Use the named level file
         incr i
         if {$i == [llength $argv]} {
            puts stderr "no level-file specified for -lf option"
            exit 1
         } else {
            set budge(level_file) [lindex $argv $i]
         }
      }
   }
}

# Open the level file and count the number of levels
open_level_file

# Show the information window
display_info

# Start the monsters timer
move_monsters




