#!/usr/bin/env perl
# runjongg - Wrapper that runs "mohave", "xmahjongg", or both
# License:  Creative Commons Attribution-NonCommercial-ShareAlike 2.5
# Revision: 070920

# Note: The license indicated above applies to  this file.  It doesn't
# apply to the "mohave" or "xmahjongg" source code, or to any file de-
# rived from the code in question.

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

# This notice may not be  modified  except as  approved by  the author
# (and licensor), or to make non-content changes related to HTML tags,
# paragraph formatting, white space, etc.

# 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 text  provided by the
# original version must be preserved and operational. b. Additionally,
# whether or not clause (a) applies, the operating system and/or desk-
# top environment used must provide attribution that is readily acces-
# sible to the  end user at runtime. Note: "Readily accessible"  means
# that  attribution  should be  directly accessible  from  the desktop
# environment's highest-level Start menu or a similar location.

# The following techniques do *not* meet the attribution requirements:
# Attribution through  text files  whose contents aren't actually dis-
# played, attribution  through printed documentation,  verbal attribu-
# tion, or postings on external web sites (i.e., web sites that aren't
# an  intrinsic  local component of the  operating system  or  desktop
# environment used). These examples are provided for illustrative pur-
# poses only.

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

# This  isn't a  complete explanation of the  terms and conditions in-
# volved.  For more information,  see the  applicable Creative Commons
# Attribution NonCommercial ShareAlike license[s].  If Internet access
# is enabled, the official copies of these license[s] should be avail-
# able at:
#
#     http://creativecommons.org/

#---------------------------------------------------------------------
#                           important note
#---------------------------------------------------------------------

# This software is provided on an  AS IS basis with ABSOLUTELY NO WAR-
# RANTY.  The  entire risk as to the  quality and  performance of  the
# software is with you.  Should the software prove defective,  you as-
# sume the cost of all necessary  servicing, repair or correction.  In
# no event will any of the developers,  or any other party, be  liable
# to anyone for damages arising out of use of the software, or inabil-
# ity to use the software.

#---------------------------------------------------------------------
#                              overview
#---------------------------------------------------------------------

# 1. "runjongg"  is a  wrapper for  "xmahjongg" and a  related program
# named "mohave".

# Note: This script requires "gtk2-perl".

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

# 2. Usage: runjongg MODE arg1 arg2 ...
#
# where MODE is one of the following keywords:
#
#     mohave    - Runs "mohave".  If either "mohave" or "xmahjongg" is
#                 already running, displays an "Error" dialog instead.
#
#     xmahjongg - Runs "xmahjongg".  If either "mohave" or "xmahjongg"
#                 is already running,  displays an  "Error" dialog in-
#                 stead.
#
#     both      - Runs "xmahjongg",  then  runs "mohave"  after "xmah-
#                 jongg" exits.  Displays an  "Error" dialog if "xmah-
#                 jongg" is already running.  Doesn't check the status
#                 of "mohave". For more information, see the following
#                 sections.

# If any arguments are specified after the MODE keyword, they're pass-
# ed to the  program  that's executed.  [If the keyword is "both", the
# arguments are passed to "xmahjongg".]  The arguments  shouldn't con-
# tain shell meta-characters or embedded white space.

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

# 3. You can make  "mohave" behave two ways:  it can start "xmahjongg"
# (period) or it can start  "xmahjongg" and redisplay its  own screens
# after "xmahjongg" exits.

# To use the first mode,  locate "mohave's" "exec" code and modify the
# code so that it uses a calling sequence similar to the following:
#
#     -command { global tileset;
#         exec runjongg xmahjongg arg1 arg2 ... &
#         clipboard clear
#         exit
#     }

# To use  the second mode,  proceed the same way,  but  substitute the
# word "both" for "xmahjongg":
#
#     -command { global tileset;
#         exec runjongg both arg1 arg2 ... &
#         clipboard clear
#         exit
#     }

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

# 4. As noted  previously,  if MODE is "both",  "runjongg" runs "xmah-
# jongg", followed by "mohave". In this mode, "runjongg" verifies that
# "xmahjongg" isn't already running.  However,  it doesn't verify that
# "mohave" isn't running.

# Explanation:

# The  plan is for "mohave" to  initiate  "runjongg both",  then exit.
# "runjongg both" should execute  "xmahjongg",  then  restart "mohave"
# after "xmahjongg" exits.
                 
# If the correct calling sequence is used,  the  instance of  "mohave"
# that started "runjongg" may still be running when "runjongg" is exe-
# cuted,  but it'll usually  terminate within a  short period of time.
# Presently,  "runjongg both" ignores existing  instances of "mohave".
# This is the simplest thing to do, but it might be a good idea to add
# more checks in the future.

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

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

use Gtk2 '-init';
use Gtk2::Pango;

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

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

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

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

#  $IE specifies an internal-error message prefix string.

my $IE = 'runjongg: Internal error';

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

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

#---------------------------------------------------------------------
# Locate target program.

    my $TARGET_PROGRAM = shift (@ARGV);
    my $TARGET_BASE;

    if (!defined ($TARGET_PROGRAM))
    {
        print STDERR << 'END';
Usage: runjongg MODE arg1 ... where MODE is one of these keywords:

      mohave    - Runs "mohave".  If either "mohave" or "xmahjongg" is
                  already running, displays an "Error" dialog instead.

      xmahjongg - Runs "xmahjongg".  If either "mohave" or "xmahjongg"
                  is already running,  displays an  "Error" dialog in-
                  stead.

      both      - Runs "xmahjongg",  then  runs "mohave"  after "xmah-
                  jongg" exits.  Displays an  "Error" dialog if "xmah-
                  jongg" is already running.  Doesn't check the status
                  of "mohave".

If any arguments are specified after the MODE keyword,  they're passed
to the program  that's  executed. [If the keyword is "both", the argu-
ments are passed to "xmahjongg"]. Note:  The arguments  shouldn't con-
tain shell meta-characters or embedded white space.
END
        exit ONE;
    }

    $TARGET_PROGRAM =  lc ($TARGET_PROGRAM);
    $TARGET_BASE    =  $TARGET_PROGRAM;
    $TARGET_BASE    =~ s@^.*/@@;

    if ($TARGET_BASE !~ m@^(mohave|xmahjongg|both)\z@i)
    {
        die "$IE #0001\n";
    }

    my $FlagRunBoth = FALSE;

    if ($TARGET_BASE eq 'both')
    {
        $TARGET_PROGRAM = 'xmahjongg';
        $TARGET_BASE    = $TARGET_PROGRAM;
        $FlagRunBoth    = TRUE;
    }
                                # Do we have an  absolute path for the
                                # target executable?
    if ($TARGET_PROGRAM !~ m@^/@)
    {                           # No - Search PATH
        die "$IE #0002\n" if $TARGET_PROGRAM =~ m@/@;

        for $str (split (/:+/, $ENV {PATH}))
        {
            next unless ($str =~ m@^/@) && (-d $str);
            $str =~ s@([^/])\z@$1/@;
            $str .= $TARGET_PROGRAM;
            next unless (-f $str) && (-x $str);
            $TARGET_PROGRAM = $str;
            last;
        }
    }
                                # Traverse symbolic links
    while (($TARGET_PROGRAM =~ m@^/@) &&
           (-f $TARGET_PROGRAM) && (-l $TARGET_PROGRAM) &&
           (-x $TARGET_PROGRAM))
    {
        $str = readlink $TARGET_PROGRAM;
        last if $str !~ m@^/@;
        $TARGET_PROGRAM = $str;
    }
                                # Sanity checks
    if (($TARGET_PROGRAM !~ m@^/@) ||
        (!-f $TARGET_PROGRAM) || (!-x $TARGET_PROGRAM))
    {
        die "$IE #0003: $TARGET_PROGRAM\n";
    }

#---------------------------------------------------------------------
# Check existing instances.

# Note:  This code isn't 100% accurate,  but it should be close enough
# for our purposes.

    my $RunningProgram = "";
    my $proc = `/bin/ps ax`;
    my @proc = split (/\n+/, $proc);

    for my $line (@proc)
    {
        next if $line =~ m@/Topics/@;
        my ($p1, $p2) = $line =~ m@^(.{20})(.+)@;
        next if !defined ($p2);
        my ($pid) = $p1 =~ m@^\s*(\d+)\D@;
        next if !defined ($pid);

        if ($p2 =~ m@/xmahjongg\z@)
        {
            $RunningProgram = 'xmahjongg';
        }
        elsif (!$FlagRunBoth && ($p2 =~ m@/mohave\z@))
        {
                                # The next line is distro-specific
            next if $p2 =~ m@/groups/Programs/Games/mohave\z@;
            $RunningProgram = 'mohave';
        }
    }

#---------------------------------------------------------------------
# Future change: Document this code.

    if (!length ($RunningProgram))
    {
        if ($FlagRunBoth)
        {
            system ("$TARGET_PROGRAM " . join (' ', @ARGV));
            exec 'mohave';
        }
        else
        {
            exec $TARGET_PROGRAM, @ARGV;
        }
    }

#---------------------------------------------------------------------
# Create dialog window.

    my $window = Gtk2::Window->new;
    $window->signal_connect (destroy => sub { Gtk2->main_quit; });
    $window->set_border_width (2);

    $window->set_default_size (325, 200);
    $window->set_size_request (325, 200);

    $window->set_position ('center');
    $window->set_resizable (FALSE);
    $window->set_title ('Error');

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

#---------------------------------------------------------------------
# Define some regions.

    my $vbox = Gtk2::VBox->new (FALSE, 6);
    $window->add ($vbox);

    my $frame2 = Gtk2::Frame->new();
    $vbox->pack_start ($frame2, TRUE, TRUE, 0);
    $frame2->set_border_width (3);

    my $msgbox = Gtk2::HBox->new (FALSE, 6);
    $frame2->add ($msgbox);

#---------------------------------------------------------------------
# Hide superfluous cursor.

# The  following block serves  one purpose,  and one purpose only:  It
# hides a superflous text insertion cursor.  Note:  There  must be  an
# easier way to do this.

    Gtk2::Rc->parse_string(<<END);
    style "my_text" {
        GtkTextView::cursor-color = "white"
    }
    widget "*Text*" style "my_text"
END

#---------------------------------------------------------------------
# Add text message(s).

    my $textview = new Gtk2::TextView();
    $textview->set (editable => FALSE);
    $textview->set (wrap_mode => 'word');
    my $textbuffer = $textview->get_buffer();

    $textbuffer->create_tag ('normal'   ,
        family     => 'Sans Serif'      ,
        size       => 12 * PANGO_SCALE);

    $textbuffer->create_tag ('label'    ,
        family     => 'Sans Serif'      ,
        foreground => '#008800'         ,
        size       => 12 * PANGO_SCALE  ,
        weight     => PANGO_WEIGHT_HEAVY);

    $textbuffer->create_tag ('note'     ,
        family     => 'Sans Serif'      ,
        foreground => '#880000'         ,
        size       => 12 * PANGO_SCALE  ,
        weight     => PANGO_WEIGHT_HEAVY);

    my $iter = $textbuffer->get_start_iter();

    $str = "\nError:";
    $textbuffer->insert_with_tags_by_name ($iter, $str , 'note'   );

    my $conflicter;
    my $runmsg;

    if ($TARGET_BASE eq $RunningProgram)
    {
        $conflicter = $TARGET_BASE;
        $runmsg     = 'is already running.';
    }
    else
    {
        $conflicter = $RunningProgram;

        $runmsg = << 'END';
is already running. You can only run one of these two programs
at a time.
END
        $runmsg =~ s@\s+@ @gs;
        $runmsg =~ s@\s+\z@@s;
    }

    $str = " $conflicter";
    $textbuffer->insert_with_tags_by_name ($iter, $str , 'label'  );

    $str = ' ' . $runmsg;
    $textbuffer->insert_with_tags_by_name ($iter, $str , 'normal' );

    my $scrolled_window;
    my $USE_SCROLLED_WINDOW = FALSE;

    if ($USE_SCROLLED_WINDOW)
    {
        $scrolled_window = new Gtk2::ScrolledWindow;
        $scrolled_window->set_border_width (0);
        $scrolled_window->set_shadow_type ('etched-in');
        $scrolled_window->set_policy ('automatic', 'automatic');
        $msgbox->pack_start ($scrolled_window, TRUE, TRUE, 0);

        $scrolled_window->show();
        $scrolled_window->add ($textview);
    }
    else
    {
        $msgbox->pack_start ($textview, TRUE, TRUE, 0);
    }

    $textview->show();

#---------------------------------------------------------------------
# Create buttons.

    my $frame3 = Gtk2::Frame->new();
    $vbox->pack_start ($frame3, FALSE, FALSE, 0);
    $frame3->set_border_width (3);

    my $box_control = Gtk2::HBox->new (FALSE, 6);
    $frame3->add ($box_control);

    my $button_quit = Gtk2::Button->new_from_stock ('gtk-quit');
    $box_control->pack_start ($button_quit , FALSE, FALSE, 0);

#---------------------------------------------------------------------
# Connect button to action.

    $button_quit->signal_connect
    (
        clicked => sub { Gtk2->main_quit(); }
    );

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

    $window->show_all();
    Gtk2->main();
    undef;                      # Not reached
}

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

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