#!/usr/bin/wish -f

#
# Search for *CONFIG* and edit variables to your needs
#

# Program "Launcher for XBlast 2.0"
# (C) by Oliver Vogel (e-mail: vogel@ikp.uni-koeln.de)
# May 1st 1996
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public Licences as by published
# by the Free Software Foundation; either version 2; or (at your option)
# any later version
#
# This program is distributed in the hope that it will entertaining,
# but WITHOUT ANY WARRANTY; without even the implied warranty of 
# MERCHANTABILTY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.
# 675 Mass Ave, Cambridge, MA 02139, USA.

# 
# User configurable variables
#

#
# *CONFIG*: filename of the xblast binary
#
set xblastCommand "/usr/games/xblast"
#
# *CONFIG*: name of the savefile for your xblast settings
#
set saveFile "$env(HOME)/.xblast"              
#
# *CONFIG*: path for the bitmaps needed 
#
set bitmapPath "/usr/lib/games/xblast/tcl/bitmap"
#
# *CONFIG*: font names 
#
set fontLarge  "-*-helvetica-bold-r-*-*-24-*-*-*-*-*-iso8859-*"
set fontMedium "-*-helvetica-bold-r-*-*-18-*-*-*-*-*-iso8859-*"
set fontSmall  "-*-helvetica-bold-r-*-*-14-*-*-*-*-*-iso8859-*"

#
# no further user configurable variables
#

#
# first low level routines
#
proc createPlayerWidget {W player} {
    global bitmapPath
    global fontLarge 
    global fontMedium 
    global fontSmall 
    #
    # set global variables
    #
    global widgetState 
    set widgetState($W) enabled
    global playerID
    set playerID($W) $player

    #
    # first make a surrounding frame
    #
    frame $W -borderwidth 4 -relief groove
    #
    # player n label
    #
    label $W.player -text "Player $player" -font $fontMedium
    #
    # player image
    #
    frame $W.image -borderwidth 2 -relief sunken 
    label $W.image.bits -bitmap "@${bitmapPath}/winner_${player}.xbm" \
	    -bg white
    pack $W.image.bits -fill both -expand yes 
    #
    # player name entry
    #
    entry $W.name -bg white -font $fontSmall -relief sunken
    #
    # at sign
    #
    label $W.at -text "@" -font $fontLarge
    #
    # player disp entry
    #
    entry $W.disp -bg white -font $fontSmall -relief sunken
    # 
    # pack all
    # 
    pack $W.player $W.image $W.name $W.at $W.disp \
	    -side top -fill both -expand yes -padx 4 -pady 2 
}

proc disablePlayerWidget {W} {
    global bitmapPath
    global playerID
    global widgetState
    #
    # check if necessary
    #
    if {$widgetState($W)=="enabled"} {
	#
	# set global variable
	#
	set widgetState($W) disabled
	#
	# set entries disabled
	#
	$W.name config -state disabled -fg white
	$W.disp config -state disabled -fg white
	#
	# set players to looser bitmap
	#
	$W.image.bits config \
		-bitmap "@${bitmapPath}/player_$playerID($W)_4.xbm"
	
    }
}
    
proc enablePlayerWidget {W} {
    global bitmapPath
    global playerID
    global widgetState
    #
    # check if necessary
    #
    if {$widgetState($W)=="disabled"} {
	#
	# set global variable
	#
	set widgetState($W) enabled
	#
	# set entries disabled
	#
	$W.name config -state normal -fg black
	$W.disp config -state normal -fg black
	#
	# set players to looser bitmap
	#
	$W.image.bits config \
		-bitmap "@${bitmapPath}/winner_$playerID($W).xbm"
	
    }
}
    

proc createSetupWidget {W} {
    global playerWidget
    set playerWidget(1) ${W}.pa.p1
    set playerWidget(2) ${W}.pa.p2
    set playerWidget(3) ${W}.pb.p3
    set playerWidget(4) ${W}.pb.p4
    
    frame ${W} -borderwidth 2 -relief sunken
    frame ${W}.pa
    frame ${W}.pb
    foreach i {1 2 3 4} {
	createPlayerWidget $playerWidget($i) ${i}
    }
    pack $playerWidget(1) $playerWidget(2) \
	    -padx 4 -pady 4 \
	    -side left -fill both -expand yes 
    pack $playerWidget(3) $playerWidget(4) \
	    -padx 4 -pady 4 \
	    -side right -fill both -expand yes
    pack ${W}.pa ${W}.pb -fill both -expand yes -side top
}

proc createOptionsWidget {W} {
    global fontMedium 
    global fontSmall 
    #
    # first outer frame
    #
    frame $W -borderwidth 2 -relief sunken
    #
    # left/right frame
    #
    frame $W.l 
    frame $W.r
    #
    # numplayer box
    #
    global numPlayer
    label $W.l.numPlayer -text "Number of Players" -font $fontMedium
    frame $W.r.numPlayer -relief sunken
    foreach i {2 3 4} {
	radiobutton $W.r.numPlayer.b${i} \
		-variable numPlayer \
		-text "${i} " \
		-value ${i}\
		-command {setNumPlayer $numPlayer} \
		-font $fontMedium
	pack $W.r.numPlayer.b${i} -side left -fill y -expand yes -pady 2 
    }
    setNumPlayer $numPlayer
    #
    # numlives box
    #
    global numLives
    label $W.l.numLives -text "Number of Lives" -font $fontMedium
    frame $W.r.numLives -relief sunken
    foreach i {1 2 3} {
	radiobutton $W.r.numLives.b${i} \
		-variable numLives \
		-text "${i} " \
		-value ${i}\
		-font $fontMedium
	pack $W.r.numLives.b${i} -side left -fill y -expand yes -pady 2 
    }
    #
    # numVictories box
    #
    global numVictories
    label $W.l.numVictories -text "Number of Victories" -font $fontMedium
    scale $W.r.numVictories \
	    -from 1 \
	    -to 9 \
	    -orient horizontal \
	    -showvalue yes \
	    -command "set numVictories"
    $W.r.numVictories set $numVictories 
    set numVictories [$W.r.numVictories get]
    
    #
    # random player box
    #
    global randomPlayer
    label $W.l.randomPlayer -text "Random player position" -font $fontMedium
    frame $W.r.randomPlayer -relief sunken
    radiobutton $W.r.randomPlayer.b1 \
	    -variable randomPlayer \
	    -text "yes " \
	    -value "-rp" \
	    -font $fontMedium
    radiobutton $W.r.randomPlayer.b0 \
	    -variable randomPlayer \
	    -text "no " \
	    -value "+rp" \
	    -font $fontMedium
    pack $W.r.randomPlayer.b1 $W.r.randomPlayer.b0 \
	    -side left -fill y -expand yes -pady 2 

    #
    # random player box
    #
    global randomLevel
    label $W.l.randomLevel -text "Random level order" -font $fontMedium
    frame $W.r.randomLevel -relief sunken
    radiobutton $W.r.randomLevel.b1 \
	    -variable randomLevel \
	    -text "yes " \
	    -value "-rl" \
	    -font $fontMedium
    radiobutton $W.r.randomLevel.b0 \
	    -variable randomLevel \
	    -text "no " \
	    -value "+rl" \
	    -font $fontMedium
    pack $W.r.randomLevel.b1 $W.r.randomLevel.b0 \
	    -side left -fill y -expand yes -pady 2 

    #
    # force block and white box
    #
    global blackWhite
    label $W.l.blackWhite -text "Allow color mode" -font $fontMedium
    frame $W.r.blackWhite -relief sunken
    radiobutton $W.r.blackWhite.b1 \
	    -variable blackWhite \
	    -text "yes " \
	    -value "+bw" \
	    -font $fontMedium
    radiobutton $W.r.blackWhite.b0 \
	    -variable blackWhite \
	    -text "no " \
	    -value "-bw" \
	    -font $fontMedium
    pack $W.r.blackWhite.b1 $W.r.blackWhite.b0 \
	    -side left -fill y -expand yes -pady 2 
    #
    # override wm box
    #
    global overRide
    label $W.l.overRide -text "Override Window Manager" -font $fontMedium
    frame $W.r.overRide -relief sunken
    radiobutton $W.r.overRide.b1 \
	    -variable overRide \
	    -text "yes " \
	    -value "-wm" \
	    -font $fontMedium
    radiobutton $W.r.overRide.b0 \
	    -variable overRide \
	    -text "no " \
	    -value "+wm" \
	    -font $fontMedium
    pack $W.r.overRide.b1 $W.r.overRide.b0 \
	    -side left -fill y -expand yes -pady 2 
    

    #
    # frameRate box
    #
    global frameRate
    label $W.l.frameRate -text "Frame rate" -font $fontMedium
    scale $W.r.frameRate \
	    -from 12 \
	    -to 36 \
	    -orient horizontal \
	    -showvalue yes \
	    -command "set frameRate"
    $W.r.frameRate set $frameRate
    set frameRate [$W.r.frameRate get]
    
    #
    # bell sound box
    #
    global bellSound
    label $W.l.bellSound -text "Bell sound" -font $fontMedium
    frame $W.r.bellSound -relief sunken
    radiobutton $W.r.bellSound.b1 \
	    -variable bellSound \
	    -text "yes " \
	    -value "+q" \
	    -font $fontMedium
    radiobutton $W.r.bellSound.b0 \
	    -variable bellSound \
	    -text "no " \
	    -value "-q" \
	    -font $fontMedium
    pack $W.r.bellSound.b1 $W.r.bellSound.b0 \
	    -side left -fill y -expand yes -pady 2 


    

    #
    # pack left/right
    #
    foreach w [winfo children $W.l] {
	pack $w -side top -fill x -expand yes 
    }
    foreach w [winfo children $W.r] {
	pack $w -side top -fill x -expand yes 
    }
    #
    # pack all
    #
    pack $W.l $W.r -side left -fill both -expand yes -padx 8
}


#
# create title widget
#
proc createTitleWidget {W} {
    global fontSmall
    global fontLarge
    global bitmapPath
    #
    # frames et al
    #
    frame ${W} -borderwidth 2 -relief raised
    #
    # frame with title
    #
    frame ${W}.inner -borderwidth 4 -relief ridge
    label ${W}.inner.a -text "Launcher for XBlast 2.0" -font $fontLarge 
    label ${W}.inner.b -text "Copyright \251 1996 by Oliver Vogel" \
	    -font $fontSmall
    pack ${W}.inner.a ${W}.inner.b -fill both -expand yes -padx 48 -pady 4
    #
    # left frame with bomb
    #
    frame ${W}.left -borderwidth 4 -relief ridge
    label ${W}.left.b -bg white \
	    -bitmap "@${bitmapPath}/bomb1.xbm"
    pack ${W}.left.b -fill both -expand yes
    #
    # right frame with bomb
    #
    frame ${W}.right -borderwidth 4 -relief ridge
    label ${W}.right.b -bg white \
	    -bitmap "@${bitmapPath}/bomb1.xbm"
    pack ${W}.right.b -fill both -expand yes
    #
    # pack all
    #
    pack ${W}.left ${W}.inner ${W}.right \
	    -side left -expand yes -fill both -padx 16 -pady 8
}

#
# create buttons
#    
proc createButtonWidget {W} {
    global fontMedium
    #
    # surounding frame
    #
    frame $W -borderwidth 2 -relief sunken
    #
    # START button
    #
    frame $W.start -borderwidth 4 -relief ridge
    button $W.start.b -text "  Start XBlast  " \
	    -command "startXBlast" \
	    -font $fontMedium -padx 16 -pady 8 
    pack $W.start.b -padx 8 -pady 4 -fill both 
    bind . <Return> "$W.start.b invoke"
    #
    # load button
    #
    button $W.load -text "  Load setup  "\
	    -command "loadSetup" \
	    -font $fontMedium -padx 16 -pady 8 
    #
    # save button
    #
    button $W.save -text "  Save setup  " \
	    -command "saveSetup" \
	    -font $fontMedium -padx 16 -pady 8 
    #
    #
    # cancel button
    #
    button $W.cancel -text "  Exit  " \
	    -command "destroy ." \
	    -font $fontMedium -padx 16 -pady 8 
    #
    # pack buttons
    #
    pack $W.start $W.load $W.save $W.cancel -side left -expand yes -padx 16 -pady 8
}

proc startXBlast {} {
    global playerWidget
    global xblastCommand
    #
    global numPlayer
    global numLives
    global numVictories
    global randomPlayer
    global randomLevel
    global blackWhite
    global overRide
    global bellSound
    global frameRate
    #
    # first set player string
    #
    set P1 "\"[$playerWidget(1).name get]@[$playerWidget(1).disp get]\""
    set P2 "\"[$playerWidget(2).name get]@[$playerWidget(2).disp get]\""
    set P3 "\"[$playerWidget(3).name get]@[$playerWidget(3).disp get]\""
    set P4 "\"[$playerWidget(4).name get]@[$playerWidget(4).disp get]\""
    switch $numPlayer {
	{2} {
	    set playerString "$P1 $P2"
	}
	{3} {
	    set playerString "$P1 $P2 $P3"
	}
	{4} {
	    set playerString "$P1 $P2 $P3 $P4"
	}
    }
    set optionString "-L $numLives -v $numVictories $randomPlayer\
	    $randomLevel $blackWhite $overRide -f $frameRate $bellSound" 
    wm withdraw .
    catch "exec $xblastCommand $playerString $optionString" output
    # puts $output
    wm deiconify .
}

#
# now something more sophisticated
#
proc setNumPlayer {N} {
    global playerWidget
    for {set i 1} {$i <= $N} {incr i} {
	enablePlayerWidget $playerWidget($i)
    }
    for {} {$i <= 4} {incr i} {
	disablePlayerWidget $playerWidget($i)
    }
} 


#
# simple file browser
#
proc fileSelect {path} {
    global fontMedium
    global fontLarge
    global env
    #
    # create toplevel
    #
    toplevel .fs 
    wm title .fs "Select file"
    wm transient .fs .
    #
    frame .fs.lb 
    frame .fs.buttons -relief sunken -borderwidth 2 
    #
    listbox .fs.lb.list -font $fontMedium -yscrollcommand ".fs.lb.scroll set"
    tk_listboxSingleSelect .fs.lb.list
    scrollbar .fs.lb.scroll -relief sunken \
	    -orient vertical \
	    -command ".fs.lb.list yview"
    #
    foreach f [glob ${path}/*] {
	set name [file tail $f] 
	if {0!=[string first "." $name]} {
	    .fs.lb.list insert end $name
	}
	
    }
    #
    pack .fs.lb.list -fill both -expand yes -side left
    pack .fs.lb.scroll -fill y -expand yes -side left
    #
    button .fs.buttons.ok -text "  Select  " -font $fontMedium
    button .fs.buttons.no -text "  Cancel  " -font $fontMedium
    pack .fs.buttons.ok .fs.buttons.no -padx 8 -pady 4 -side left -expand yes
    #
    pack .fs.lb -side top -fill both -expand yes
    pack .fs.buttons -side top -fill x -expand yes
    
}


#
# save setup
#
proc saveSetup {} {
    global saveFile
    global playerWidget
    global numPlayer
    global numLives
    global numVictories
    global randomPlayer
    global randomLevel
    global blackWhite
    global overRide
    global bellSound
    global frameRate
    #
    set fp [open $saveFile "w"]
    puts $fp "xblast.numberOfPlayers: $numPlayer"
    for {set i 1} {$i <= $numPlayer} {incr i} {
	set name [$playerWidget($i).name get]
	if {$name != ""} {
	    puts $fp "xblast.player${i}: $name"
	}
	set disp [$playerWidget($i).disp get]
	if {$disp != ""} {
	    puts $fp "xblast.display${i}: $disp"
	}
    }
    
    puts $fp "xblast.numberOfLives: $numLives"
    puts $fp "xblast.numberOfVictories: $numVictories"
    if {$randomPlayer=="-rp"} {
	puts $fp "xblast.randomPlayerPosition: True"
    } else {
	puts $fp "xblast.randomPlayerPosition: False"
    }
    if {$randomLevel=="-rl"} {
	puts $fp "xblast.randomLevelOrder: True"
    } else {
	puts $fp "xblast.randomLevelOrder: False"
    }
    if {$blackWhite=="-bw"} {
	puts $fp "xblast.allowColorMode: False"
    } else {
	puts $fp "xblast.allowColorMode: True"
    }
    if {$overRide=="-wm"} {
	puts $fp "xblast.forceOverride: True"
    } else {
	puts $fp "xblast.forceOverride: False"
    }
    if {$bellSound=="-q"} {
	puts $fp "xblast.bellSound: False"
    } else {
	puts $fp "xblast.bellSound: True"
    }
    puts $fp "xblast.frameRate: $frameRate"
    #
    close $fp
}

proc loadSetup {} {
    global saveFile
    #
    global playerWidget
    global numPlayer
    global numLives
    global numVictories
    global randomPlayer
    global randomLevel
    global blackWhite
    global overRide
    global bellSound
    global frameRate
    #
    set fp [open $saveFile "r"]
    #
    while {-1!=[gets $fp line]} {
	#
	# check resource line
	#
	set tmp [lindex $line 0] 
	set resource [string range $tmp 0 [expr [string first : $tmp]-1]]
	set value [string range $line [string first [lindex $line 1] $line] end]
#	puts "$resource -> $value"
	case $resource {
	    {xblast.numberOfPlayers} {
		# number of players
		scan $value "%d" numPlayer
		setNumPlayer $numPlayer
	    }
	    {xblast.player1} {
		# name of player 1
		$playerWidget(1).name delete 0 end
		$playerWidget(1).name insert 0 $value
	    }
	    {xblast.player2} {
		# name of player 2
		$playerWidget(2).name delete 0 end
		$playerWidget(2).name insert 0 $value
	    }
	    {xblast.player3} {
		# name of player 3
		$playerWidget(3).name delete 0 end
		$playerWidget(3).name insert 0 $value
	    }
	    {xblast.player4} {
		# name of player 4
		$playerWidget(4).name delete 0 end
		$playerWidget(4).name insert 0 $value
	    }
	    {xblast.display1} {
		# name of player 1
		$playerWidget(1).disp delete 0 end
		$playerWidget(1).disp insert 0 $value
	    }
	    {xblast.display2} {
		# name of player 2
		$playerWidget(2).disp delete 0 end
		$playerWidget(2).disp insert 0 $value
	    }
	    {xblast.display3} {
		# name of player 3
		$playerWidget(3).disp delete 0 end
		$playerWidget(3).disp insert 0 $value
	    }
	    {xblast.display4} {
		# name of player 4
		$playerWidget(4).disp delete 0 end
		$playerWidget(4).disp insert 0 $value
	    }
	    {xblast.numberOfLives} {
		# num lives
		scan $value "%d" numLives
	    }
	    {xblast.numberOfVictories} {
		# num victories
		scan $value "%d" numVictories
	    }
	    {xblast.randomPlayerPosition} {
		# random playyer pos
		if {$value} {
		    set randomPlayer "-rp"
		} else {
		    set randomPlayer "+rp"
		}
	    }
	    {xblast.randomLevelOrder} {
		# random level order
		if {$value} {
		    set randomLevel "-rl"
		} else {
		    set randomLevel "+rl"
		}
	    }
	    {xblast.allowColorMode} {
		# black and white mode
		if {$value} {
		    set blackWhite "+bw"
		} else {
		    set blackWhite "-bw"
		}
	    }
	    {xblast.forceOverride} {
		# override WM
		if {$value} {
		    set overRide "-wm"
		} else {
		    set overRide "+wm"
		}
	    }
	    {xblast.bellSound} {
		# toggle bell sound
		if {$value} {
		    set bellSound "+q"
		} else {
		    set bellSound "-q"
		}
	    }
	    {xblast.frameRate} {
		# frame rate
		scan $value "%d" frameRate
	    }
	    default {
		#
		# default
		#
		puts "Unknown resource \"$resource\""
	    }
	}
    }
    #
    close $fp
}

#
# the main program
#

#
# wm options
#
wm title . "XBlast Launcher"

#
# global Config vars
#
global numPlayer
set numPlayer 2
#
global numLives
set numLives 3
#
global numVictories
set numVictories 5
#
global randomPlayer
set randomPlayer "+rp"
#
global randomLevel
set randomLevel "+rl"
#
global blackWhite
set blackWhite "+bw"
#
global overRide
set overRide "+wm"
#
global bellSound
set bellSound "+q"
#
global frameRate
set frameRate 20

#
# create title
#
createTitleWidget .title

#
# create setup widgets
#
frame .setup
createSetupWidget .setup.p
createOptionsWidget .setup.opt

#
# create button widget 
#
createButtonWidget .buttons

#
# pack it
#
pack .setup.p .setup.opt -side left -fill both -expand yes
pack .title .setup .buttons -side top -fill x -expand yes






