#!/usr/bin/env perl
# megazeux.wrapper - Launcher for "megazeux" main program
# License:  Creative Commons Attribution-NonCommercial-ShareAlike 2.5
# Revision: 110724

# Note:  The license indicated above applies to this file.  It doesn't
# apply to MegaZeux, or to any files derived from that package.

#---------------------------------------------------------------------
#                         license information
#---------------------------------------------------------------------

# This section may not be modified except as approved by the author or
# licensor, or to make non-content changes such as adjustments to par-
# agraph formatting or white space.

# This  version of this software is  distributed  under  the following
# license:
#
#       Creative Commons Attribution-NonCommercial-ShareAlike 2.5

# You may use, modify, and redistribute this software without fees  or
# royalties, but only under the terms and conditions set forth  by the
# license.  In particular, copies and derived works cannot be used for
# commercial purposes.  Additionally, the license propagates to copies
# and derived works. Furthermore, you must provide attribution "in the
# manner  specified  by the  author or licensor".  The latter point is
# discussed below.

# The author [and licensor] hereby specifies that  attribution must be
# handled in the following manner:  a. If the software is interactive,
# any  About or Credits dialog boxes, windows, or output text provided
# by the  original version must be preserved and readily accessible to
# the end user at runtime.  b. If the software is non-interactive,  or
# if it does not  provide  About or Credits dialog boxes, windows,  or
# output text,  the  operating system and/or  desktop environment used
# must provide attribution that is  visible and/or  readily accessible
# to the end user at runtime.

# The following techniques  do not meet the  attribution requirements:
# Attribution through  text files, attribution  through  printed docu-
# mentation,  verbal  attribution, or postings on  external  web sites
# [i.e.,  web  sites  that are not an intrinsic local component of the
# operating system or  desktop environment used].  These  examples are
# provided for illustrative purposes only.

# It should be noted that trademarks are an additional issue.  If this
# software  uses any  trademarks,  trademark-related  restrictions may
# apply.

# This is not a  complete explanation of the  terms and conditions in-
# volved.  For more information, see the Creative Commons Attribution-
# NonCommercial-ShareAlike 2.5 license.

#---------------------------------------------------------------------
#                             explanation
#---------------------------------------------------------------------

# 1. Overview:

# This program (megazeux)  is a  simple GUI that provides  a selection
# screen for MegaZeux worlds and launches MegaZeux using a world chos-
# en from the screen.

#---------------------------------------------------------------------

# 2. Requirements:

# At the GUI level,  this program requires  Perl 5, Perl-Gtk2, LACSUB,
# and "glxinfo". These components are standard, except for LACSUB. You
# should  be able to obtain  LACSUB from the  same place as this file.
# Note: LACSUB (like this file)  is distributed  under a Creative Com-
# mons license.

#---------------------------------------------------------------------
#                        standard module setup
#---------------------------------------------------------------------

require 5.6.1;
use strict;
use Carp;
use warnings;
                                # Trap warnings
$SIG {__WARN__} = sub { die @_; };

#---------------------------------------------------------------------
#                         add CPAN module[s]
#---------------------------------------------------------------------

use Gtk2 '-init';
use Gtk2::SimpleList;
use Gtk2::Gdk::Keysyms;

#---------------------------------------------------------------------
#                        add LACSUB module[s]
#---------------------------------------------------------------------

use LACSUB::GUI
 ( @LACSUB::GUI::EXPORT_OK );

#---------------------------------------------------------------------
#                           basic constants
#---------------------------------------------------------------------

use constant ZERO  => 0;        # Zero
use constant ONE   => 1;        # One
use constant TWO   => 2;        # Two

use constant FALSE => 0;        # Boolean FALSE
use constant TRUE  => 1;        # Boolean TRUE

#---------------------------------------------------------------------
#                         program parameters
#---------------------------------------------------------------------

my $DIR_BASE             = '__META_PREFIX__';
my $DIR_BIN              = "$DIR_BASE/bin";
my $DIR_DATA             = "$DIR_BASE/data";
my $DIR_LEVELS           = "$DIR_BASE/worlds";
my $ALERT_ICON_PATH      = "$DIR_DATA/icons/alert.png";

my $MAIN_WIDTH           = 700; # Main-window width  (in pixels)
my $MAIN_HEIGHT          = 400; # Main-window height (in pixels)
                                # Revision (or release) string
my $REVISION             = '110724';

#---------------------------------------------------------------------

# @ProgNames specifies single-word names for one or more programs that
# are associated (directly or indirectly) with this package.  At least
# one name  should be  specified.  Note: List order and/or  alphabetic
# case don't matter.

# $ProgNames contains the strings listed by  @ProgNames,  separated by
# vertical bars.

# @ProgNames isn't used after $ProgNames is constructed. $ProgNames is
# used to post-process message text.

my @ProgNames = qw
(
    megazeux MegaZeux
);

my $ProgNames = join '|', @ProgNames;
undef @ProgNames;

#---------------------------------------------------------------------

#  $DEFAULT_PATTERN should be a Perl pattern string enclosed in paren-
# theses. "megazeux" checks world names against the specified pattern.
# Note: The check is done using base directory names. For the purposes
# of this check, pathname components  ignored.

# If one world name matches the specified pattern (ignoring alphabetic
# case),  "megazeux"  uses  the  world  in question as a  default.  If
# there's more than one match, an arbitrary selection is made.

my $DEFAULT_PATTERN = '(no-default)';

#---------------------------------------------------------------------
#                       misc. global variables
#---------------------------------------------------------------------

my $FlagDirectRendering;        # Flag: Direct rendering is available
my $FlagHighResolution;         # Flag: High-resolution mode

my $MainWindow;                 # GTK2 main window
my %FileMap = ();               # Maps file descriptions to pathnames

# The following variables are Perl-Gtk2 objects:

my $SimpleList;                 # SimpleList: List of level names

#---------------------------------------------------------------------
#                          support routines
#---------------------------------------------------------------------

# Future change: Document this routine.

sub PanicDialog
{
    my ($msg, $details) = @_;

    $msg =  "" unless defined $msg;
    $msg =~ s@^\s+@@s;
    $msg =~ s@\s+\z@@s;
    $msg =~ s@\s+@ @gs;
    $msg =  '???' if !length $msg;

    $msg =  "#$msg"  if     $msg =~ m@^\d+\z@;
    $msg =  ": $msg" unless $msg =~ m@^#@;
    $msg =  " $msg"  unless $msg =~ m@^:@;

    $details =  "" unless defined $details;
    $details =~ s@^\s+@@s;
    $details =~ s@\s+\z@@s;
    $details =~ s@\s+@ @gs;

    if (!length ($details))
    {
        $details = << 'END';    # 'END' must be single-quoted here
This might be an I/O problem, a privileges problem, or a bug in the
program.
END
    }

    my $text = << "END";        # "END" must be double-quoted here
<p><note>Internal error$msg</note></p>
<p>$details</p>
END
    my %args =
    (
        -dimensions  => '500x225'        ,
        -text        => $text            ,
        -title       => 'Internal error' ,
        -action_quit => "quit"           ,
        -top_space   => 2
    );

    $args {-icon_path} = $ALERT_ICON_PATH if
        defined ($ALERT_ICON_PATH) &&
        (-f $ALERT_ICON_PATH) && (-r $ALERT_ICON_PATH) &&
        (-B $ALERT_ICON_PATH);

    &SimpleDialogBox (%args);
    undef;
}

#---------------------------------------------------------------------

# "CheckDirectRendering"  checks the  status of  direct rendering  and
# sets the associated global flag appropriately.  Note: If the flag in
# question has already been set, this code simply returns.

sub CheckDirectRendering
{
    return if defined $FlagDirectRendering;

    my $str;                    # Scratch

    $str = `glxinfo 2>&1`;
    $str = "" unless defined $str;
                                # Is direct rendering supported?
    if ($str =~ m@direct rendering: Yes@)
    {                           # Yes
        $FlagDirectRendering = TRUE;
    }
    else
    {                           # No
        $FlagDirectRendering = FALSE;
    }

    undef;
}

#---------------------------------------------------------------------

# "ExecTarget"  runs the  target program or passes  control  to  a new
# screen. The details are as follows:

# "ExecTarget" assumes that $SimpleList is the current  selection list
# and that the user has selected one of the entries in $SimpleList.

# This version of "ExecTarget" supports one entry type:
#
#     a. Any string that's a valid %FileMap key.

# In  case (a),  "ExecTarget"  looks  up  the  specified string  using
# "%FileMap". One result type is supported:
#
#     a.  A directrory pathname. This result tells "ExecTarget" to use
#         the megazeux world stored in the specified directory.
#
# "ExecTarget" uses "system" (as opposed to "exec")  to run the target
# program.  This allows "ExecTarget" to clean up temporary files after
# the target program exits.

#---------------------------------------------------------------------

sub ExecTarget
{
    my $n;                      # Scratch (integer)
    my $str;                    # Scratch (string )

    my $datafile;               # data-file pathname (or a meta-symbol
                                # that selects a data-file mode)

#---------------------------------------------------------------------
# Identify selected level [or mode].

    my ($model, $iter) = $SimpleList->get_selection->get_selected;
    my $selected       = $model->get ($iter, ZERO);

                                # See notes preceding this routine
    $datafile = $FileMap {$selected};
                                # Consistency check
    &PanicDialog ("#$REVISION-0001") unless defined $datafile;
                                # Build target-file name
    $selected =   lc ($selected);
    $selected =~  s@ +@_@g;
    $datafile =   "$datafile/$selected.mzx";
    print "Running $datafile\n";

#---------------------------------------------------------------------
# Get initial display dimensions (if possible).

    my $X11DIM;
    $str =  `/laclin/lacutil/getx11dim 2>&1`;
    $str =  "" unless defined $str;
    $str =~ s@\s+\z@@s;
    $X11DIM = $str if $str =~ m@^\d+x\d+\z@;

#---------------------------------------------------------------------
# Run the target program.

    @ARGV = ();
    push (@ARGV, 'fullscreen=1') if $FlagDirectRendering;
    push (@ARGV, $datafile);
    system "$DIR_BASE/bin/mzxrun", @ARGV;

#---------------------------------------------------------------------
# Fix resulting display problems (if necessary).

    if (defined ($X11DIM))
    {
        $str =  `/laclin/lacutil/getx11dim 2>&1`;
        $str =  "" unless defined $str;
        $str =~ s@\s+\z@@s;

        system "/laclin/lacutil/setx11dim --fast $X11DIM"
            unless $str eq $X11DIM;
    }

#---------------------------------------------------------------------
# Wrap it up.

    exit ZERO;
}

#---------------------------------------------------------------------
#                         special-key handler
#---------------------------------------------------------------------

sub SpecialKeyHandler
{
    my $widget   = shift;
    my $event    = shift;
    my $keypress = $event->keyval;

    if ($keypress == $Gtk2::Gdk::Keysyms {Escape})
    {
        Gtk2->main_quit;
        $MainWindow->destroy;
        exit (ONE);
    }

    if ($keypress == $Gtk2::Gdk::Keysyms {KP_Enter} ||
        $keypress == $Gtk2::Gdk::Keysyms {Return  })
    {
        &ExecTarget();
                                # Shouldn't get here
        &PanicDialog ("#$REVISION-0002");

#ifdef NOTDEF                   # Not presently used
#       return TRUE;            # Consume the event
#endif
    }

    return FALSE;               # Pass the event on to GTK2
}

#---------------------------------------------------------------------
#                   selection-window setup routine
#---------------------------------------------------------------------

# Future change: Document this routine.

sub RunSelectionWindow
{
    my (%args) = @_;            # Argument list
    my $str;                    # Scratch

#---------------------------------------------------------------------
# Extract arguments.

    my $ref_list   = $args { -ref_list   };
    my $text       = $args { -text       };
    my $title_list = $args { -title_list };
    my $title_main = $args { -title_main };

    &PanicDialog ("#$REVISION-0003")
        unless defined ($ref_list  ) || !defined ($text) ||
           !defined ($title_list) || !defined ($title_main);

#---------------------------------------------------------------------
# Close old window (if necessary).

    if (defined $MainWindow)
    {
        Gtk2->main_quit;
        $MainWindow->destroy;
        undef $MainWindow;
    }

#---------------------------------------------------------------------
# Create main window.

    $MainWindow = Gtk2::Window->new;
    $MainWindow->set_position ('GTK_WIN_POS_CENTER');
    $MainWindow->set_title ($title_main);
    $MainWindow->signal_connect
        (delete_event => sub { Gtk2->main_quit; TRUE; });

    $MainWindow->set_default_size ($MAIN_WIDTH, $MAIN_HEIGHT);
    my $white = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
    $MainWindow->modify_bg ('normal', $white);

    $MainWindow->signal_connect
        ('key_release_event' => \&SpecialKeyHandler);

#---------------------------------------------------------------------
# Create some regions.

    my $vbox = Gtk2::VBox->new (FALSE, 6);
    $MainWindow->add ($vbox);
        
    my $frame2 = Gtk2::Frame->new();
    $vbox->pack_start ($frame2, TRUE, TRUE, ZERO);
    $frame2->set_border_width (3);
                    
#---------------------------------------------------------------------
# Create a Gtk2 "SimpleList" for the level-name list.

    $SimpleList = Gtk2::SimpleList->new ($title_list => 'text');

    for (@$ref_list)
    {
        $str = $_;
        $FileMap {$_} = $FileMap {$str} if s@^=\d+@=@;
        $FileMap {$_} = $FileMap {$str}
            if s@^= default level\z@(default level)@;
    }
                                # This part is admittedly complicated
    @{$SimpleList->{data}} = map { $_ = [ $_ ]; } @$ref_list;
    $SimpleList->signal_connect (row_activated  => \&ExecTarget);
    $SimpleList->select (ZERO);

#---------------------------------------------------------------------
# Put the "SimpleList" in a Gtk2 "ScrolledWindow".

    my $ListWindow = Gtk2::ScrolledWindow->new (undef, undef);
    $ListWindow -> set_policy ('automatic', 'automatic');
    $ListWindow -> add ($SimpleList);

    $text .= << 'END';
</p>
END

#---------------------------------------------------------------------
# Create a Gtk2 "TextView" for the message text.

    my $textview = &LACGTK2_CreateTextView
    (
        -text      => $text ,
        -top_space => ONE
    );

#---------------------------------------------------------------------
# Assemble all the pieces.

    my $FrameText    = Gtk2::Frame->new ('Instructions');
    $FrameText    -> set_border_width (3);
    $FrameText    -> add ($textview);

    my $RightSide    = Gtk2::VBox->new (FALSE, 6);
    $RightSide    -> pack_start ($FrameText    , TRUE , 1, 0);

    my $MainTable = Gtk2::Table->new (1, 4, TRUE);
    $MainTable    -> attach_defaults ($ListWindow , 0, 1, 0, 1);
    $MainTable    -> attach_defaults ($RightSide  , 1, 4, 0, 1);
    $frame2       -> add ($MainTable);

#---------------------------------------------------------------------
# Add OK/Quit buttons.

    &LACGTK2_AddButtons
    (
        -vbox        => $vbox         ,
        -action_ok   => '&ExecTarget' ,
        -action_quit => 'quit'
    );

#---------------------------------------------------------------------
# Make everything visible.

    $MainWindow->show_all;

#---------------------------------------------------------------------
# Wrap it up.
                                                                                            
    Gtk2->main;                 # Start Gtk2 main loop
    undef;
}

#---------------------------------------------------------------------
#                    normal level-selection screen
#---------------------------------------------------------------------

sub NormalScreen
{
    my $dirent;                 # Directory entry
    my $str;                    # Scratch

#---------------------------------------------------------------------
# Initial setup.

    &CheckDirectRendering();    # Check status of direct rendering

#---------------------------------------------------------------------
# Build list of levels.

    my $DEFAULT_PATH;
    opendir (DIR, $DIR_LEVELS) ||
        &PanicDialog ("#$REVISION-0004: $DIR_LEVELS");

    while (defined ($dirent = readdir (DIR)))
    {
        next unless $dirent =~ m@^([a-z0-9_\-]+)\z@i;
        my $path = "$DIR_LEVELS/$dirent";
        next unless -d $path;

        $str =  $1;
        $str =~ s@_+@ @g;

        $str =~ s@(^| )([a-z])@$1 . uc ($2)@geis;
        $FileMap {$str} = $path;

        $str = $dirent;
        $DEFAULT_PATH = $path if $str =~ m@$DEFAULT_PATTERN@i;
    }

    closedir DIR;
    $FileMap {'=0 default level'} = $DEFAULT_PATH
                        if defined $DEFAULT_PATH;

#---------------------------------------------------------------------
# Define message text (with tags).

# Notes:
#
# a. The message text can use certain HTML-like tags,  but HTML per se
# isn't supported. For more information, see the LACSUB code.
#
# b. <label> tags are used to display the program names used here in a
# separate style. To simplify things, program names are handled retro-
# actively.  For more information,  see the code immediately after the
# "$text" block.

    my $text = << 'END';
<p>
Welcome to MegaZeux. Use the box on the left to select a world.
Left-click on a world name and press <section>Enter</section>
or click <section>OK.</section> If you double-click, you shouldn't
need to press any keys.
To quit at this point, press <section>Escape</section> or
<section>alt-Q,</section> or click <section>Quit.</section>
</p>
</p><p>
Tips:
</p><p>
1. The help screen in MegaZeux is a bit odd; commands listed on the
screen won't work unless you exit the screen first.
</p><p>
2. Fullscreen mode may not work unless your system includes an
OpenGL compatible card that's supported by the local distro.
</p><p>
END
    $text =~ s@\b($ProgNames)('s|[\.,;]|\b)@<label>$1$2</label>@gi;
    $text =~ s@__META_FREEDOOM__@FreeDoom@g;

#---------------------------------------------------------------------
# Create/run selection window.

    my @list       = sort keys %FileMap;
    my $title_list = 'Worlds';
    my $title_main = "megazeux $REVISION";

    &RunSelectionWindow
    (
        -ref_list   => \@list      ,
        -text       => $text       ,
        -title_list => $title_list ,
        -title_main => $title_main
    );

    undef;
}

#---------------------------------------------------------------------
#                            main routine
#---------------------------------------------------------------------

sub Main
{
    my $str;                    # Scratch

#---------------------------------------------------------------------
# Verify that program isn't already running.

    &VerifyNotRunning
    (
        -icon_path    => $ALERT_ICON_PATH                     ,
        -name         => 'megazeux'                           ,
        -pattern_this => ':\d\d\s(perl |)(\S+/|)megazeux\s'   ,
        -pattern_next => ':\d\d\s(\S+/|)mzxrun\s'
    );

#---------------------------------------------------------------------
# Abort if user is connected through VNC.

    &AbortIfVNC
    (
        -icon_path    => $ALERT_ICON_PATH ,
        -name         => 'megazeux'
    );

#---------------------------------------------------------------------
# Adjust PATH.

    $str =  $ENV {PATH};
    $str =  "" unless defined $str;
    $str =  "$DIR_BIN:$str";
    $str =~ s@:+\z@@;
    $ENV {PATH} = $str;

#---------------------------------------------------------------------
# Display appropriate screen.

    &NormalScreen();
    undef;
}

#---------------------------------------------------------------------
#                            main program
#---------------------------------------------------------------------

&Main();                        # Call the main routine
exit ZERO;                      # Normal exit