Last updated: 2021/05/17
A plain-text version can be found here.
#!/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