#!/usr//bin/wish -f

################################################################################
#
# Budge - a puzzle/arcade game for X, written using Tcl/Tk
#
# Copyright (c) 1994, Nat Pryce
#
# THE AUTHOR OF Budge DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS 
# SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 
# FITNESS, IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY SPECIAL, 
# INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING 
# FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, 
# NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN  CONNECTION 
# WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
#
################################################################################

# Default option settings

set budge(lib)			/u1/X/tcl/budge/lib

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
         pack .game.buttons.stop -side left -padx 8 -pady 8
         button .game.buttons.die -text "Lose a life" -command lose_a_life
         pack .game.buttons.die -side left -padx 8 -pady 8
         checkbutton .game.buttons.pause -text "Pause" -variable budge(game_paused) \
            -command { 
               if $budge(game_paused) {
                  display_message "Game paused"
               } else {
                  clear_message
               }
            }
         pack .game.buttons.pause -side left -padx 8 -pady 8
         label .game.buttons.msg -textvariable budge(message) -anchor w
         pack .game.buttons.msg -side left -padx 8 -pady 8
      pack .game.buttons -side top -fill x

      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 $budge(canvas) -in .game.f -padx 24 -pady 24
      pack .game.f -side top
 
      frame .game.status -relief raised -bd 1
         frame .game.status.lives -relief sunken -bd 1 
            label .game.status.lives.title -text "Lives:" -anchor w
            pack .game.status.lives.title -side left
            label .game.status.lives.var -textvariable player(lives) -anchor w
            pack .game.status.lives.var -side left -fill x
         pack .game.status.lives -side left
         frame .game.status.level -relief sunken -bd 1 
            label .game.status.level.title -text "Level:" -anchor w
            pack .game.status.level.title -side left
            label .game.status.level.var -textvariable player(level) -anchor w
            pack .game.status.level.var -side left -fill x
         pack .game.status.level -side left
         label .game.status.title -relief sunken -bd 1 -text "Budge" \
                               -anchor center
         pack .game.status.title -fill both -expand yes
      pack .game.status -fill x


   # 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
         pack .info.buttons.quit -side left -padx 8 -pady 8                                                                        
         button .info.buttons.play -text "Play game" -command start_game
         pack .info.buttons.play -side left -padx 8 -pady 8
         button .info.buttons.keys -text "Change Keys..." -command keys_dialog
         pack .info.buttons.keys -side left -padx 8 -pady 8
         label .info.buttons.msg -textvariable budge(message) -anchor w
         pack .info.buttons.msg -side left -padx 8 -pady 8
      pack .info.buttons -side top -fill x
      
      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!" 
      pack .info.msg -side top -fill x

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

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


proc display_info {} {
   pack forget .game
   pack .info -fill both
   focus .info
   focus default .info
}

proc display_game {} {
   global budge
   pack forget .info
   pack .game -fill both
   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
         pack $w.f.f1.up -fill x
         label $w.f.f1.down -relief flat -bd 2 -text "Down:" -anchor w
         pack $w.f.f1.down -fill x
         label $w.f.f1.left -relief flat -bd 2 -text "Left:" -anchor w
         pack $w.f.f1.left -fill x
         label $w.f.f1.right -relief flat -bd 2 -text "Right:" -anchor w
         pack $w.f.f1.right -fill x
         label $w.f.f1.play -relief flat -bd 2 -text "Start Game:" -anchor w
         pack $w.f.f1.play -fill x
         label $w.f.f1.pause -relief flat -bd 2 -text "Pause:" -anchor w
         pack $w.f.f1.pause -fill x
         label $w.f.f1.die -relief flat -bd 2 -text "Lose a Life:" -anchor w
         pack $w.f.f1.die -fill x
         label $w.f.f1.keys -relief flat -bd 2 -text "Change Keys:" -anchor w
         pack $w.f.f1.keys -fill x
         label $w.f.f1.quit -relief flat -bd 2 -text "Quit:" -anchor w
         pack $w.f.f1.quit -fill x
      pack $w.f.f1 -side left -fill both -expand yes
                                          
      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"
         pack $w.f.f2 $w.f.f2.up -fill x
         
         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"
         pack $w.f.f2.down -fill x
         
         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"
         pack $w.f.f2.left -fill x
         
         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"
         pack $w.f.f2.right -fill x
         
         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"
         pack $w.f.f2.play -fill x
         
         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"
         pack $w.f.f2.pause -fill x
         
         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"
         pack $w.f.f2.die -fill x
         
         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"
         pack $w.f.f2.keys -fill x
         
         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 $w.f.f2.quit -fill x
      pack $w.f.f2 -side right -fill both -expand yes
   pack $w.f -fill both
   
   frame $w.buttons -relief raised -bd 1
      button $w.buttons.ok -text "Ok" \
         -command "set_keys_from_dialog $w;focus [focus default]; destroy $w"
      pack $w.buttons.ok -side left -expand yes -padx 16 -pady 16
      button $w.buttons.reset -text "Reset" -command "keys_dialog"
      pack $w.buttons.reset -side left -expand yes -padx 16 -padx 16
      button $w.buttons.cancel -text "Cancel" \
         -command "focus [focus default]; destroy $w"
      pack $w.buttons.cancel -side left -expand yes -padx 16 -pady 16
   pack $w.buttons -side bottom -fill x

   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
   pack $w.msg -side top -fill both
   
   frame $w.buttons -relief raised -bd 1
      button $w.yes -text "Yes" -command "exit"
      pack $w.yes -side left -padx 16 -pady 16 -expand yes
      button $w.no -text "No" -command "destroy $w"
      pack $w.no -side left -padx 16 -pady 16 -expand yes
   pack $w.buttons -side bottom -fill x
   
   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
   
   switch -glob -- $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
   
   switch -glob -- $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} {
   switch -glob -- [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





