#!/bin/sh

# $Id: quake2,v 1.5 1998/03/05 04:33:17 roderick Exp $

user_dir=$HOME/.quake2
data_dir=/usr/local/lib/games/quake2
binary_dir=/usr/lib/games/quake2
verbose=

[ -f $HOME/.quake2.conf ] && {
    if [ -f $HOME/.quake2deb.conf ]
    then
    	echo "\
You have both .quake2.conf and .quake2deb.conf files in your home
directory.  You should switch to using only the latter."
    else
    	echo "\
You have a .quake2.conf file in your home directory.  The name for this
file changed to .quake2deb.conf with the version 3.14 release of the
quake2 package.  The old name still works for now, but you should rename
this file."
	echo
	echo -n "Should I rename it for you? [n] "
	read response
	case x-$response in
	    x-[yY]*)
	    	echo "Renaming $HOME/.quake2.conf to $HOME/.quake2deb.conf"
		mv $HOME/.quake2.conf $HOME/.quake2deb.conf || {
		    echo "`basename $0`: error renaming file, aborting" >&2
		    exit 1
		}
		;;
	esac
    fi
}

# Allow system and user configuration overrides.

for file in /etc/quake2deb.conf $HOME/.quake2.conf $HOME/.quake2deb.conf
do
    [ -f $file ] && . $file
done

# Do the rest in Perl.

exec perl -Sx "$0" "$user_dir" "$data_dir" "$binary_dir" "$verbose" "$@"

#!perl -w
use strict;

my ($Me, %Set, $Top_user, $User_dir, $Verbose);

($Me = $0) =~ s-.*/--;

use File::Find qw(find);

sub conf_err {
    die "$Me: $_[0], see /etc/quake2deb.conf\n";
}

sub dirents {
    my $dir = shift;
    local *DIR;

    opendir DIR, $dir	or die "$Me: can't opendir $dir: $!\n";
    my @ents = grep { $_ ne '.' && $_ ne '..' } readdir DIR;
    closedir DIR	or die "$Me: error doing closedir on $dir: $!\n";
    return @ents;
}

sub mkpath {
    require File::Path;
    File::Path::mkpath($_[0], $Verbose);
}

{
my $on_console;

sub on_console {
    if (!defined $on_console) {
	my $tty = `tty`;
	$? == 0 or die "$Me: non-zero exit ($?) from tty\n";
	$on_console = $tty =~ /^(tty\d+|console)$/;
    }
    return $on_console;
}

}

# Create %Set from the args which will be passed to quake.  %Set contains
# cvars set with +set.  Keys are lower case, values are as-is.
#
# XXX This isn't quite right  because a multi-arg command could actually
# eat a +set but I'll still use it.

sub parse_quake_args {
    my (@arg) = @_;
    while (@arg) {
    	my $arg = shift @arg;
    	if (lc($arg) eq '+set') {
    	    next unless @arg;
	    my $var = lc shift @arg;
	    next unless @arg;
	    $Set{$var} = shift @arg;
	}
    }
}

# Add links to quake binary and data files.

sub wanted {
    # skip directories
    return if !lstat || -d _;

    # skip existing dirents
    my $partial_name = $File::Find::name;
    $partial_name =~ s-^\./--
    	or die "$Me: invalid path `$partial_name'\n";
    my $full_name = "$User_dir/$partial_name";
    return if lstat $full_name;

    # create directory if required
    if ($partial_name =~ m-(.*)/- && ! -d "$User_dir/$1") {
	mkpath "$User_dir/$1";
    }

    # XXX Use relative links.
    my $from = "$Top_user/$partial_name";
    print "ln -s $from $full_name\n" if $Verbose;
    symlink $from, $full_name
	or die "$Me: can't symlink $from to $full_name: $!\n";
}

sub main {
    my ($data_dir, $binary_dir);

    ($User_dir, $data_dir, $binary_dir, $Verbose) = splice @ARGV, 0, 4;
    $Verbose = $Verbose ne '';

    $User_dir ne '' or conf_err "\$user_dir isn't set";
    $data_dir ne '' or conf_err "\$data_dir isn't set";
    $binary_dir ne '' or conf_err "\$binary_dir isn't set";
    -d $data_dir or conf_err "\$data_dir ($data_dir) isn't a directory";
    -d $binary_dir or conf_err "\$binary_dir ($binary_dir) isn't a directory";
    -f "$data_dir/baseq2/pak0.pak"
	or conf_err "baseq2/pak0.pak isn't present in \$data_dir ($data_dir)";

    parse_quake_args @ARGV;

    # Create ~/.quake2.  Don't chdir there yet because find() is going to do
    # some directory changing.

    if (! -d $User_dir) {
	mkpath $User_dir;
    }

    # find() won't follow symlinks in its argument list, so chdir to
    # each base before running find.

    $Top_user = $data_dir;
    chdir $Top_user or die "$Me: can't chdir to $Top_user: $!\n";
    find \&wanted, map { "./$_" } grep { lc($_) ne 'docs' && -d } dirents '.';

    $Top_user = $binary_dir;
    chdir $Top_user or die "$Me: can't chdir to $Top_user: $!\n";
    find \&wanted, '.';

    # Nothing else will cd, change to the user's directory.

    chdir $User_dir or die "$Me: can't chdir to $User_dir: $!\n";

    # Handle vid_ref settings in config.cfg which won't work with the
    # current setup.  Originally I tried to handle this completely, but
    # there are too many variables (eg, it depends on the version of
    # svgalib and whether you own the current console).  So, I ignore the
    # cases where you had to make a change to get yourself in trouble
    # (selecting GL) and just handle soft/softx mismatches.  For sanity's
    # sake I also assume that svgalib will only spawn a VC for you if
    # you're root.
    #
    # I handle the situations which look like they won't work by just
    # stripping the vid_ref setting, counting on Quake to do its best
    # given no requested refresh library.

    my $game = $Set{'game'};
    my $file;
    if ((defined($game)
		&& do { $file = "$game/config.cfg"; open(CFG, $file) })
	    || do { $file = 'baseq2/config.cfg'; open(CFG, $file) }) {
    	my (@cfg);
	while (<CFG>) {
	    if (/^set\s+vid_ref\s+("?)(.*?)\1\s*($|;)/) {
	    	my $ref = lc $2;

		# VGA and not on VC when not root
		if ($ref eq 'soft' && !on_console && $< != 0) {
		    print "Stripping vid_ref $ref, ",
		    	    "not on a console and not root\n";
		    next;
		}

		# X and no $DISPLAY
		elsif ($ref eq 'softx' && !exists $ENV{DISPLAY}) {
		    print "Stripping vid_ref $ref, \$DISPLAY isn't set\n";
		    next;
		}
	    }
	    push @cfg, $_;
	}
	open CFG, ">$file"	or die "$Me: can't write to $file: $!\n";
	print CFG @cfg		or die "$Me: error writing to $file: $!\n";
	close CFG		or die "$Me: error closing $file: $!\n";
    }

    # Add the game directory to $LD_LIBRARY_PATH so that it picks up the
    # MesaGL library from there.  The included library is newer than the
    # Debian package of it and Zoid says the newer version is required.  XXX
    # This screws people who want to make quake2 set-uid root.

    $ENV{LD_LIBRARY_PATH} .= ':' if exists $ENV{LD_LIBRARY_PATH};
    $ENV{LD_LIBRARY_PATH} .= $User_dir;

    exec "./quake2.real", @ARGV or die "$Me: can't exec ./quake2: $!\n";

}

main;
