Gamemenugen.pl

#!/usr/bin/env perl

# Generates a DOS batch file for launching games described in a YAML file in
# the current directory.

use strict;
use warnings;

our $VERSION = 2.0.0;

# Modules
use English qw(-no_match_vars);                 # Core
use Getopt::Long qw(:config no_ignore_case);    # Core
use Pod::Usage;                                 # Core
use POSIX qw(ceil);                             # Core
use Text::Wrap qw(fill $columns);               # Core
use YAML::Tiny;                                 # dpkg libyaml-tiny-perl

# Per screen; going over this limit will make additional screens at
# $MAX_GAMES - 2 (to allow for next/back slots)
my $MAX_GAMES = 18;

# Flag letting us know that (we think) everything will fit on one screen
my $ONEPAGE;

# Set the column to wrap at for informational text
$columns = 61;    # 60 characters + accounting for the newline, apparently

# Handle options
GetOptions(
    'help|h'        => \my $help,
    'man'           => \my $man,
    'version'       => \my $version,
    'm|max_games=i' => \$MAX_GAMES,

) or pod2usage( -verbose => 0 );

if ($help) {
    pod2usage( -verbose => 0 );
}
if ($man) {
    pod2usage( -verbose => 2 );
}
if ($version) {
    die "$PROGRAM_NAME v$VERSION\n";
}

if ( $MAX_GAMES <= 2 ) {
    print "Invalid value for --max_games: $MAX_GAMES. Setting to 18.\n";
    $MAX_GAMES = 18;
}

# Misc. variables
my $output_file = 'MENU.BAT';

# Generate a chart correlating numbers and ASCII letters in both directions
my %chart;
for ( 1 .. 26 ) {
    $chart{$_} = chr 64 + $_;
    $chart{ chr 64 + $_ } = $_;
}

# Line-drawing characters.
## no critic [ValuesAndExpressions::ProhibitEscapedCharacters]
# The names are huge. See https://en.wikipedia.org/wiki/Code_page_437
my $UL = "\x{C9}";
my $HO = "\x{CD}";
my $VE = "\x{BA}";
my $UR = "\x{BB}";
my $LL = "\x{C8}";
my $LR = "\x{BC}";

# Returns a given arrayref after surrounding it with a border
sub make_border {
    my $input = shift;
    my @output;
    my $length = 0;

    # Determine the longest line length
    for ( @{$input} ) {
        if ( length $_ > $length ) {
            $length = length;
        }
    }

    # Create the borders
    push @output, sprintf "echo $UL%s$UR", $HO x ($length);
    for ( @{$input} ) {
        push @output, sprintf "echo $VE%-${length}s$VE", "$_";
    }
    push @output, sprintf "echo $LL%s$LR", $HO x ($length);

    return \@output;
}

# Returns an arrayref containing the opening pages of the menu
# This actually reduces complexity since it eliminates the need for a dedicated single-page sub
## no critic [Subroutines::ProhibitExcessComplexity]
sub make_title_page {
    my ( $games, $total_games ) = @_;
    my $pages;

   # If we think the games will fit on one page, set the pages to 1 and toggle
   # the flag...
    if ( $total_games <= $MAX_GAMES ) {
        $pages   = 1;
        $ONEPAGE = 1;
    }
    else {

  # ...otherwise determine how many pages are needed (+1 since we need to know
  # *extra* pages)
        $pages = 1 + int( $total_games / ( $MAX_GAMES - 2 ) );
    }

    # Mark which page each game goes on, so we know where to "goto" later
    my $game_num = 1;
    for ( sort keys %{ $games->[0] } ) {

        # -2 to allow for extra slots for back and next
        $games->[0]->{$_}{page}
            = POSIX::ceil( $game_num / ( $MAX_GAMES - 2 ) );
        $game_num++;
    }

    ## no critic [ValuesAndExpressions::RequireInterpolationOfMetachars]
    # Define the full menu and its unique opening command(s)
    my @full_menu = '@echo off';

    # Create each page of the full menu
    for my $page ( 1 .. $pages ) {

        # Add an aesthetic whitespace between sub-menus
        push @full_menu, q();

        my ( @menu, @header );
        if ($ONEPAGE) {
            @header = ( ':start', 'cls', );
        }
        else {
            @header = ( ":start${page}", 'cls', );
        }

        # Track the game number for the option letter
        $game_num = 0;

        # Greeting
        push @menu, 'Choose a game';

        # Aesthetic whitespace; done this way to work with the border
        push @menu, q( );

        # Game titles (alphabetised)
        for ( sort keys %{ $games->[0] } ) {

            # Only process a game that belongs on this page
            if ( $games->[0]->{$_}{page} != $page ) {
                next;
            }
            $game_num++;

            # Option letter, title, and genre
            push @menu, sprintf '%s) %s [%s]', $chart{$game_num},
                $games->[0]->{$_}{title}, $games->[0]->{$_}{genre};
        }

        # Aesthetic whitespace; done this way to work with the border
        for ( 0 .. ( $MAX_GAMES - 2 ) - $game_num ) {
            push @menu, q( );
        }

        # Final options, which break the pattern
        # Sometimes you just need to break the rules
        ## no critic [ControlStructures::ProhibitCascadingIfElse]
        if ( $page > 1 && $page < $pages ) {
            push @menu, 'X) Back', 'Y) Next';
        }
        elsif ( $page > 1 ) {
            push @menu, q(), 'X) Back';
        }
        elsif ( $page < $pages ) {
            push @menu, q(), 'Y) Next';
        }
        elsif ( $page == $pages ) {
            push @menu, q(), q();
        }
        push @menu, 'Z) Quit';

        # Apply the border
        @menu = @{ make_border( \@menu ) };

        # Aesthetic whitespace, then the "choice" line, then another
        my $choices = q();    # Blank to silence the warning
        for ( 'A' .. $chart{$game_num} ) {
            $choices = $choices . lc;
        }

        # Additional commands
        my $commands;
        if ( $page > 1 ) {
            $commands = 'x';
        }
        if ( $page < $pages ) {
            $commands .= 'y';
        }
        $commands .= 'z';

        push @menu, "\nchoice /c:$choices" . "$commands\n";

        # Put it all together
        unshift @menu, @header;

        # With the physical menu done, create the errorlevel code
        for ( reverse 1 .. $game_num + 1 ) {
            if ( $_ == $game_num + 1 ) {

                # Only one page
                if ($ONEPAGE) {
                    push @menu, sprintf 'if errorlevel %d goto fin', $_;
                }

                # First page
                elsif ( $page == 1 ) {
                    push @menu, sprintf 'if errorlevel %d goto fin', $_ + 1;
                    push @menu, sprintf 'if errorlevel %d goto start%s', $_,
                        $page + 1;
                }

                # Second page and beyond
                elsif ( $page > 1 && $page < $pages ) {
                    push @menu, sprintf 'if errorlevel %d goto fin', $_ + 2;
                    push @menu, sprintf 'if errorlevel %d goto start%s',
                        $_ + 1,
                        $page + 1;
                    push @menu, sprintf 'if errorlevel %d goto start%s', $_,
                        $page - 1;
                }

                # Final page
                elsif ( $page > 1 ) {
                    push @menu, sprintf 'if errorlevel %d goto fin', $_ + 1;
                    push @menu, sprintf 'if errorlevel %d goto start%s', $_,
                        $page - 1;
                }
            }
            else {
            # Handle the offset; otherwise we get the games from earlier pages
                my $offset = ( $MAX_GAMES - 2 ) * ( $page - 1 );
                push @menu, sprintf 'if errorlevel %d goto %s', $_,
                    ( sort keys %{ $games->[0] } )[ ( $_ + $offset ) - 1 ];
            }
        }

        # Put the sub-menu into the overall menu
        push @full_menu, @menu;
    }

    return \@full_menu;
}

# Returns an arrayref containing a game section
sub make_game_page {
    my ( $name, $game ) = @_;
    my @menu;
    my @header = ( ":$name", 'cls' );

    # If it's one page, null the page count, as it's unneeded
    if ($ONEPAGE) {
        $game->{page} = q();
    }

    # Add the title
    push @menu,
        "$game->{title} ($game->{genre}, $game->{author}, $game->{year})";

    # Aesthetic whitespace; done this way to work with the border
    push @menu, q();

    # Lay out the options, with Back on its own line and with 'Z'
    my @options = qw(Information Manual Configure Play Back);
    for ( 0 .. $#options - 1 ) {
        push @menu, sprintf '%s) %s', $chart{ $_ + 1 }, $options[$_];
    }
    push @menu, q();
    push @menu, sprintf 'Z) %s', $options[-1];

    # Add a border
    @menu = @{ make_border( \@menu ) };

    # Add the header
    unshift @menu, @header;

    # Aesthetic whitespace, then the "choice" line, then another
    my $choices = q();    # Blank to silence the warning
    for ( 0 .. $#options - 1 ) {
        $choices .= lc $chart{ $_ + 1 };
    }
    push @menu, "\nchoice /c:$choices" . "z\n";

    # With the physical menu done, create the errorlevel code
    for ( reverse 1 .. $#options + 1 ) {
        push @menu, sprintf 'if errorlevel %d goto %s', $_,
            $_ == $#options + 1
            ? 'start' . $game->{page}
            : lc sprintf '%s%s', $name, $options[ $_ - 1 ];
    }
    push @menu, q();    # Whitespace; can't put the \n above like usual

    # Create hooks for each errorlevel code

    ### Information ###
    # Add the header
    push @menu, ":$name" . lc $options[0], 'cls';

    # Add the info

   # To work around YAML::Tiny's newline compression, make fake newlines real.
    $game->{information} =~ s/\\n/\n/xms;

    # Correct for lines that are shorter than $columns, otherwise the
    # hanging newline is replaced with a space, breaking consistency.
    if ( length $game->{information} < $columns ) {
        chomp $game->{information};
    }
    push @menu,
        @{
        make_border(
            [ split /\n/xms, fill( q(), q(), $game->{information} ) ]
        )
        };

    # Add the final commands
    push @menu, 'pause', "goto $name\n";

    ### Manual (splits below remove extra newlines) ###
    push @menu, ":$name" . lc $options[1], 'cls';
    if ( $game->{manual} ) {
        push @menu, split /\n/xms, $game->{manual};
        push @menu, 'cd\\';
    }
    else {
        push @menu, 'cls', 'echo This title has help in-game.', 'pause';
    }
    push @menu, "goto $name\n";

    ### Configure (splits below remove extra newlines) ###
    push @menu, ":$name" . lc $options[2], 'cls';
    if ( $game->{configure} ) {
        push @menu, split /\n/xms, $game->{configure};
        push @menu, 'cd\\';
    }
    else {
        push @menu, 'cls', 'echo This title is configured in-game.', 'pause';
    }
    push @menu, "goto $name\n";

    ### Play (splits below remove extra newlines) ###
    # For one-episode games or games with their own menus
    if ( $game->{play} ) {
        push @menu, ":$name" . lc $options[3];
        push @menu, split /\n/xms, $game->{play};
        push @menu, 'pause', 'cd\\', 'goto start' . $game->{page};
    }

    # For games with distinct physical episodes
    elsif ( $game->{episodes} ) {
        my @episode_menu;
        push @episode_menu, q();
        for my $episode ( sort keys %{ $game->{episodes} } ) {
            push @episode_menu, sprintf '%s) %s', $chart{$episode},
                $game->{episodes}->{$episode}->{title};
        }

        # Aesthetic whitespace and 'Back'
        push @episode_menu, q();
        push @episode_menu, sprintf '%s) %s', 'Z', 'Back';
        @episode_menu = @{ make_border( \@episode_menu ) };

        # Slip the label in
        unshift @episode_menu, ":$name" . lc $options[3], 'cls';

        # Aesthetic whitespace, then the "choice" line, then another
        $choices = q();    # Blank to silence the warning
        for ( 1 .. ( keys %{ $game->{episodes} } ) ) {
            $choices .= lc $chart{$_};
        }
        push @episode_menu, "\nchoice /c:$choices" . "z\n";

        # With the physical menu done, create the errorlevel code
        for ( reverse 1 .. scalar( keys %{ $game->{episodes} } ) + 1 ) {
            push @episode_menu, sprintf 'if errorlevel %d goto %s', $_,
                $_ == scalar( keys %{ $game->{episodes} } ) + 1
                ? $name
                : lc sprintf '%s%s', $name, $_;
        }

        # Create hooks for each errorlevel code
        for my $episode ( sort keys %{ $game->{episodes} } ) {
            push @episode_menu, q();
            push @episode_menu, ":${name}${episode}";
            push @episode_menu, split /\n/xms,
                $game->{episodes}->{$episode}->{play};
            push @episode_menu, 'pause', 'cd\\', 'goto start' . $game->{page};
        }

        # Put it all together
        push @menu, @episode_menu;
    }

    return \@menu;
}

# Returns an arrayref containing the ending page
sub make_ending_page {
    my @menu;

    # Add the border and blurb
    push @menu, ( "\n", ':fin', 'cls' );
    my @blurb = 'Type "MENU" to bring up the menu, or "EXIT" to quit!';
    push @menu, @{ make_border( \@blurb ) };

    return \@menu;
}

# Returns an arrayref containing the menu
sub make_menu {
    my $games = shift;

    # Create the title page
    my $menu;
    my $total_games = scalar keys %{ $games->[0] };
    $menu = make_title_page( $games, $total_games );

    # Create the pages for each game
    for ( sort keys %{ $games->[0] } ) {
        push @{$menu}, "\n", @{ make_game_page( $_, $games->[0]->{$_} ) };
    }

    # Append the ending blurb
    push @{$menu}, @{ make_ending_page() };

    return $menu;
}

# Creates the final batch file. Returns 1 on success.
sub write_file {
    my $menu = shift;

    # Write the file DOS-style, using CRLF line-endings
    open my $fh, '>:crlf', $output_file or return 0;
    for ( @{$menu} ) {
        print {$fh} "$_\n";
    }
    close $fh or return 0;

    return 1;
}

# Main

# Import the game list, warn about bad metadata, and graft in a "page" section
my $games = YAML::Tiny->read('games.yml');
for my $name ( sort keys %{ $games->[0] } ) {
    my $entry = $games->[0]->{$name};
    for (qw(title author genre year information)) {
        if ( !$entry->{$_} ) {
            die "Entry $name has no $_\n";
        }
    }
    if ( !$entry->{play} && !$entry->{episodes} ) {
        die "No game commands provided for $name\n";
    }
    if ( $entry->{play} && $entry->{episodes} ) {
        die "Conflicting game commands provided for $name\n";
    }
    $entry->{page} = q();
}

# Create menu
my $menu = make_menu($games);

# Write out the menu or complain loudly
if ( write_file($menu) ) {
    print "$output_file created successfully.\n";
}
else {
    print "Error creating $output_file: $ERRNO. Terminating.\n";
}

__END__
=pod

=head1 NAME

Game Menu Generator -- Generates a DOS batch file for launching games

=head1 USAGE

    perl gamemenugen.pl    [OPTION...]
    -h, --help             Display this help text
        --man              Displays the full embedded manual
        --version          Displays the version and then exits
    -m, --max_games <num>  Sets the maximum games per page

=head1 DESCRIPTION

Game Menu Generator uses a simple YAML file containing metadata and commands
about arbitrary games in order to generate a DOS-format batch file containing a
menu for the games. The batch file is always named MENU.BAT and is generated in
the same directory as this program. It requires a YAML file called "games.yml"
to be in the same directory as this program. After playing a game, the batch
file will restart from the beginning; it can be exited via a menu option.

=head1 REQUIRED ARGUMENTS

None.

=head1 OPTIONS

=over

=item -m, --max_games <num>

Sets the maximum number of games per page. This defaults to 18, which, combined
with the border, instructions, and aesthetic whitespace is just enough to fit
perfectly in DOSBox. If there are more games than whatever value is given to
--max_games, then up to this number, sans two, will be placed on each
sub-screen; the other two slots will be reserved for "next" and "back"
commands.

=back

=head1 DIAGNOSTICS

Exits 0 on success, complains loudly otherwise.

=head1 EXIT STATUS

0 is a clean exit.

=head1 CONFIGURATION

The YAML file (games.yml) is fairly simple. Using "Jetpack" as an example:

 jetpack:
   title: Jetpack
   author: Adam Pedersen
   genre: Arcade/Action
   year: 1993
   information: |
     Jetpack is a game in which you, some guy with a jetpack and
     a phase-shifting laser, go on a grand journey of wealth
     acquisition, being especially interested in emerald gems. To
     complete each level, you must dodge enemies, make tunnels
     both permanent and temporary using your laser, collect every
     emerald on the screen, and finally make it to the
     newly-opened door.
   manual: |
     LESS JETPACK\MANUAL.TXT
   configure: |
     cd\JETPACK
     JSWITCH.EXE
   play: |
     cd\JETPACK
     JETPACK.EXE

Each game begins with a label, (which will be used in the batch file directly,
so keep it tidy), followed by several tags indented by two spaces. Omitting
meta-data tags ("title", "author", "genre", "year", and "information") is
considered a fatal error and will result in an error message.

The "information" tag is expected to simply contain a textual description of
the game. It will be wrapped to 60 characters if necessary. Note the presence
of the pipe character on this and all subsequent tags; this is mandatory in
order to preserve newlines, to an extent. If you wish to insert a line break,
use a literal "\n"; this isn't standard YAML, but YAML::Tiny will end up
breaking it otherwise, as it collapses multiple consecutive newlines.

The "manual" and "configure" tags must contain DOS commands; ideally, they'll
directly invoke a manual or batch file. They will be automatically prefixed
with a "cls" command and suffixed with a "cd\" command for aesthetic and state
reasons respectively. These tags are, notably, the only (intentionally)
optional ones -- if they're not a found, a generic message will be inserted
instead that explains that help or configuration, as appropriate, is handled
within the title in question; unlike with the metadata tags, no warning will be
printed, as this is envisioned to be a relatively common scenario.

The "play" tag should similarly contain the commands necessary to handle
execution of the game in question. Commands to reset the current directory to
the root of the drive will be automatically appended before the batch file
exits.

As an alternative to the "play" tag, specifically to handle episodic games
where each game is a distinct executable, there also exists an "episode" tag,
formatted as follows, with Commander Keen as an example:

  episodes:
    1:
        title: Marooned on Mars
        play: |
            cd\KEEN1
            KEEN1.EXE
    2:
        title: The Earth Explodes
        play: |
            cd\KEEN2
            KEEN2.EXE
    3:
        title: Keen Must Die!
        play: |
            cd\KEEN3
            KEEN3.EXE

Note the indentation of each tag. Regardless of how the episodes are numbered,
ensure that your tags are numbered sequentially starting from 1, as this is
used to generate the letters used in the menu. If both tags are missing or both
tags are present, the program will print an error message and abort.

=head1 DEPENDENCIES

=over

=item * YAML::Tiny

=back

=head1 INCOMPATIBILITIES

Not all of YAML is incorporated; see the manual for L<YAML::Tiny|YAML::Tiny>.

=head1 BUGS AND LIMITATIONS

Limitations:

There is no room in the grammar for anything other than what is described in
L</CONFIGURATION>.

Report any bugs found to the author.

=head1 AUTHOR

ShadowM00n <shadowm00n@airmail.cc>

=head1 LICENSE AND COPYRIGHT

Copyright 2020 ShadowM00n

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

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, see <http://www.gnu.org/licenses/>.

=cut