freesci 0.6.4-7.2 / usr / games / freesci-setup

#!/usr/bin/wish
#################################################################################
#                                                                               #
#   Freesci-setup, a GUI for FreeSci's configuration file		     	#
#   Copyright (C) 2001 Rune Orsval, fixed by Vyacheslav Dikonov		     	#
#									     	#
#   This program is free software; you can redistribute it and/or modify     	#
#   it under the terms of version 2 of the GNU General Public License as        #
#   published by the Free Software Foundation.                                  #
#									     	#
#   This program is distributed in the hope that it will be useful,	     	#
#   but WITHOUT ANY WARRANTY; without even the implied warranty of	     	#
#   MERCHANTABILITY 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA	#
#									     	#
#################################################################################

set configfiles "~/.freesci/config.template /usr/share/freesci/config.template /usr/share/games/freesci/config.template"
wm title . "FreeSci configuration"

proc new_game {} {
    global games configuration currentgame name
    toplevel .newgame
    label .newgame.label -text "New game name:"
    entry .newgame.entry -textvariable name
    frame .newgame.buttonframe
    button .newgame.buttonframe.ok -text Ok -command {
	set name [string map {\  _} $name]
	if {$name != "" && [lsearch $games $name] == -1} {
	    lappend games $name
	    setdefault $name
	    set currentgame $name
	}
	set name [string map {_ \ } $name]
	destroy .newgame
    }
    button .newgame.buttonframe.cancel -text Cancel -command {destroy .newgame}
    pack .newgame.label .newgame.entry .newgame.buttonframe -padx 12 -pady 4
    pack .newgame.buttonframe.ok .newgame.buttonframe.cancel -side left
    grab set .newgame
    focus .newgame.entry
    bind .newgame <Return> {.newgame.buttonframe.ok invoke}
    tkwait window .newgame
}

proc show_help {option} {
    global template
    toplevel .help
    wm title .help "FreeSci configuration help - $option"
    message .help.msg -aspect 400 -text $template($option,help)
    pack .help.msg -padx 8 -pady 2
    button .help.ok -text "Ok" -command {destroy .help}
    pack .help.ok -pady 4
    grab .help
    tkwait window .help
}

proc show_about {} {
    toplevel .about
    wm title . "About FreeSci configuration"
    message .about.msg -aspect 400 -text "FreeSCI-Setup - a graphical configuration tool for FreeSci written by Rune Orsval.\n\nThis program is distributed under GNU General Public license version 2"
    pack .about.msg -padx 8 -pady 2
    button .about.ok -text "Ok" -command {destroy .about}
    pack .about.ok -pady 4
    grab .about
    tkwait window .about
}

proc saveit {} {
    global env games options template configuration

    set f [open $env(HOME)/.freesci/config w]
    foreach game $games {
	if [string compare "$game" "Global"] {
	    set printgame 1
	} else {
	    set printgame 0
	}
	foreach option $options {
	    if $configuration($game,$option,selected) {
		if $printgame {
		    puts $f ""
		    puts $f "\[$game\]"
		    set printgame 0
		}
		if {$configuration($game,$option,value) != ""} {
		    puts $f "$option=$configuration($game,$option,value)"
		}
	    }
	}
    }
    close $f
}

# Read config.template #
set options ""
set area all
set f ""
foreach filename $configfiles {
    if [file exists $filename] {
	set f [open $filename r]
	break
    }
}
if {$f == ""} {
    puts "Can't find config.template"
    exit 1
}
while {![eof $f]} {
    gets $f line
    if [string match {\[*\]} $line] {
	scan $line {[%[^]]]} area
    } elseif [string match {\{*} $line] {
	set help ""
	if [string match {\{*\}} $line] {
	    append template($option,help) [string trim $line {\{\}}]
	} else {
	    set line [string trimleft $line {\{}]
	    while {![string match {*\}} $line]} {
		append template($option,help) $line " "
		gets $f line
	    }
	    append template($option,help) [string trimright $line {\}}]
	}
    } else {
	set indx [string first {=} $line]
	set option [string range $line 0 [expr $indx-1]]
	set option [string trim $option]
	set options [concat $options $option]
	set template($option,values) ""
	set template($option,help) ""
	set template($option,area) $area
	set line [string range $line [expr $indx+1] end]
	if ![string compare [string trim $line] <text>] {
	    set template($option,values) {}
	    set template($option,type) text
	} else {
	    while {[string length $line]} {
		set indx [string first {|} $line]
		if {$indx<0} {
		    set indx [string length $line]
		}
		set value [string trim [string range $line 0 [expr $indx-1]]]
		set line [string range $line [expr $indx+1] end]
		
		lappend template($option,values) $value
		set template($option,type) option
	    }
	}
    }
}
close $f

proc setdefault {game} {
    global template options configuration
    foreach option $options {
	set configuration($game,$option,selected) 0
	switch $template($option,type) {
	    option {
		#		puts $template($option,values)
		set configuration($game,$option,value) [lindex $template($option,values) 0]
	    }
	    text {
		set configuration($game,$option,value) ""
	    }
	}
    }
}

# Read ~/.freesci/config #
set path $env(HOME)/.freesci
if ![file isdirectory $path] {
    file mkdir $path
}
if [file exists $path/config] {
    set f [open $path/config r]
    set game Global
    set games $game
    setdefault $game
    while {![eof $f]} {
	gets $f line
	if [string match {*=*} $line] {
	    scan $line {%[^=]=%[^=]} a b
	    set option [string trim $a]
	    set configuration($game,$option,selected) 1
	    set configuration($game,$option,value) [string trim $b]
	} elseif [string match {\[*\]} $line] {
	    scan $line {[%[^]]]} game
	    lappend games $game
	    setdefault $game
	}
    }
    close $f
} else {
    set game Global
    set games $game
    setdefault $game
}


menu .m -tearoff 0

menu .m.file -tearoff 1
.m add cascade -label "File" -menu .m.file
.m.file add command -label "Save" -accelerator "(C-x C-s)" -command {saveit}
bind . <Control-x><Control-s> {saveit}
.m.file add command -label "New game" -command {new_game}
.m.file add command -label "Quit" -command {exit} -accelerator "(C-x C-c)"
bind . <Control-x><Control-c> exit

menu .m.help -tearoff 1
.m add cascade -label "Help" -menu .m.help
.m.help add command -label "About" -command {show_about}
.m.help add separator
foreach option $options {
    if [string length $template($option,help)] {
	.m.help add command -label [string totitle [string map {_ \ } $option]] -command "show_help $option"
    }
}

. configure -menu .m
set currentgame Global


while {1} {

    frame .main
    pack  .main

    frame .main.games
    pack .main.games -padx 4 -pady 4 -anchor w -in .main
    label .main.games.gamelabel -text "Choose game or global settings:"
    pack .main.games.gamelabel -side top -anchor w -in .main.games
    set incol 3
    foreach i $games {
	if "$incol == 3" {
	    frame .main.games.fr$i
	    pack .main.games.fr$i -side left -anchor n -pady 2 -in .main.games
	    set currentframe .main.games.fr$i
	    set incol 1
	} else {
	    set incol [expr $incol + 1]
	}
	radiobutton .main.games.rb$i -text [string map {_ " "} $i ] -variable currentgame -value $i
	pack .main.games.rb$i -in $currentframe -anchor w
    }

    frame .main.options -relief groove -borderwidth 4
    pack  .main.options -padx 4 -pady 4 -in .main
    frame .main.options.optionlabelframe
    pack  .main.options.optionlabelframe -side top -anchor w -in .main.options
    label .main.options.varoptionlabel -text [string map {_ \ } $currentgame]
    label .main.options.optionlabel -text options:
    pack  .main.options.varoptionlabel .main.options.optionlabel -side left -in .main.options.optionlabelframe 

    set incol 16
    set c 0
    set r 0
    foreach i $options {
	if [string compare Global $currentgame]||![string compare all $template($i,area)] {

	    if "$incol == 16" {
	        set c [expr $c + 1]
		frame .main.options.cf$c
		pack  .main.options.cf$c -side left -anchor n -padx 4 -pady 2 -in .main.options
    		set currentframe .main.options.cf$c
		set incol 1
	    } else {
	        set incol [expr $incol + 1]
	    }
	    
	    set r [expr $r + 1]
	    frame $currentframe.fr$r
	    pack $currentframe.fr$r -in $currentframe -fill x

	    checkbutton $currentframe.cb$r -text [string totitle [string map {_ \ } $i]] -variable configuration($currentgame,$i,selected)
	    pack $currentframe.cb$r -in $currentframe.fr$r -side left 
	    if [string compare $template($i,type) text] {
		eval tk_optionMenu $currentframe.op$r configuration($currentgame,$i,value) $template($i,values)
		pack $currentframe.op$r -in $currentframe.fr$r -side right
	    } else {
		entry $currentframe.op$r -textvariable configuration($currentgame,$i,value)
		pack $currentframe.op$r -in $currentframe.fr$r -side right -pady 4
	    }
	}
    }
    
    tkwait variable currentgame
    destroy .main
}

tkwait window .

exit