--- /dev/null
+#! /usr/bin/env perl
+
+use strict;
+use warnings;
+use English;
+
+sub usage()
+{
+ print "Usage:\n pobj_comp INPUT_FILE\n\npobj_comp reads a single .permobj file INPUT_FILE and generates a permobj.cc\nand pobj_id.hh based on its contents.";
+ exit(1);
+}
+
+our @weapons;
+our @armour;
+our @potions;
+our @scrolls;
+our @rings;
+our @food;
+our @carrion;
+
+sub macroify_objname($)
+{
+ my $name = "".shift(@_);
+ $name =~ tr/'//d;
+ return uc(($name =~ tr/a-zA-Z/_/csr));
+}
+
+sub commit_object($)
+{
+ my $href = shift;
+ die("Attempt to commit an unnamed object!") if !exists($href->{name});
+ die("Attempt to commit a ASCIIless object ".$href->{name}."!") if !exists($href->{ascii});
+ die("Attempt to commit a UTF8less object ".$href->{name}."!") if !exists($href->{uni});
+ if (!exists($href->{plural}))
+ {
+ # naive fallback, guaranteed to look shit sooner or later
+ }
+ my $new_hash = {
+ 'name' => $href->{name},
+ 'plural' => $href->{plural},
+ 'desc' => $href->{desc},
+ 'ascii' => $href->{ascii},
+ 'uni' => $href->{uni},
+ 'colour' => $href->{colour},
+ 'rarity' => $href->{rarity},
+ 'power' => $href->{power},
+ 'power2' => $href->{power2},
+ 'depth' => $href->{depth}
+ };
+ if ($href->{tag} eq 'WEAPON')
+ {
+ push @weapons, $new_hash;
+ }
+ elsif ($href->{tag} eq 'ARMOUR')
+ {
+ push @armour, $new_hash;
+ }
+ elsif ($href->{tag} eq 'FOOD')
+ {
+ push @food, $new_hash;
+ }
+ elsif ($href->{tag} eq 'CARRION')
+ {
+ push @carrion, $new_hash;
+ }
+ elsif ($href->{tag} eq 'RING')
+ {
+ push @rings, $new_hash;
+ }
+ elsif ($href->{tag} eq 'SCROLL')
+ {
+ push @scrolls, $new_hash;
+ }
+ elsif ($href->{tag} eq 'POTION')
+ {
+ push @potions, $new_hash;
+ }
+}
+
+our $argc = scalar(@ARGV);
+usage() if ($argc != 1);
+our $output_fname;
+our $input_fname = "$ARGV[0]";
+open(INFILE, "<", $input_fname) or die "pobj_comp: could not open $input_fname for read: $!";
+our @input_file = <INFILE>;
+close INFILE;
+our %blank_object = (
+ 'desc' => "An object some useless slacker hasn't bothered to describe.",
+ 'rarity' => 100,
+ 'power' => 0,
+ 'power2' => 0,
+ 'depth' => 1
+);
+
+our %working_object;
+
+sub reinit_working_object($$)
+{
+ %working_object = %blank_object;
+ $working_object{name} = shift;
+ $working_object{plural} = "$working_object{name}s";
+ $working_object{tag} = shift;
+}
+
+my $input_line;
+
+print "Processing permobj database $input_fname";
+for $input_line (@input_file)
+{
+ chomp $input_line;
+ next if ($input_line =~ /^\s*$/);
+ next if ($input_line =~ /^\s*#/);
+ if ($input_line =~ /^\s*WEAPON\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'WEAPON');
+ print ".";
+ }
+ # Yes, the format enforces British spelling in tags
+ elsif ($input_line =~ /^\s*ARMOUR\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'ARMOUR');
+ print ".";
+ }
+ elsif ($input_line =~ /^\s*POTION\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'POTION');
+ print ".";
+ }
+ elsif ($input_line =~ /^\s*SCROLL\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'SCROLL');
+ print ".";
+ }
+ elsif ($input_line =~ /^\s*FOOD\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'FOOD');
+ print ".";
+ }
+ elsif ($input_line =~ /^\s*RING\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'RING');
+ print ".";
+ }
+ elsif ($input_line =~ /^\s*CARRION\s+([^[:space:]].*)$/)
+ {
+ my $name = $1;
+ if (exists($working_object{name}))
+ {
+ commit_object(\%working_object);
+ %working_object = ();
+ }
+ reinit_working_object($name, 'CARRION');
+ print ".";
+ }
+ elsif (!exists($working_object{name}))
+ {
+ die("Attempt to specify object properties without starting an object");
+ }
+ elsif ($input_line =~ /^\s*POWER\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^(-?[0-9]+)/)
+ {
+ $working_object{power} = $1;
+ }
+ else
+ {
+ die("Non-numeric power value $pm in object $working_object{name}");
+ }
+ }
+ elsif ($input_line =~ /^\s*POWER2\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^(-?[0-9]+)/)
+ {
+ $working_object{power2} = $1;
+ }
+ else
+ {
+ die("Non-numeric power2 value $pm in object $working_object{name}");
+ }
+ }
+ elsif ($input_line =~ /^\s*DEPTH\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^([0-9]+)/)
+ {
+ $working_object{depth} = $1;
+ }
+ else
+ {
+ die("Negative or non-numeric depth value $pm in object $working_object{name}");
+ }
+ }
+ elsif ($input_line =~ /^\s*RARITY\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^([0-9]+)/)
+ {
+ $working_object{rarity} = $1;
+ }
+ else
+ {
+ die("Negative or non-numeric rarity value $pm in object $working_object{name}");
+ }
+ }
+ elsif ($input_line =~ /^\s*COLOUR\s+/)
+ {
+ $working_object{colour} = "$POSTMATCH";
+ }
+ elsif ($input_line =~ /^\s*DESC\s+/)
+ {
+ $working_object{desc} = "$POSTMATCH";
+ }
+ elsif ($input_line =~ /^\s*PLURAL\s+/)
+ {
+ $working_object{plural} = "$POSTMATCH";
+ }
+ elsif ($input_line =~ /^\s*ASCII\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^'[[:ascii:]]'/)
+ {
+ $working_object{ascii} = "$MATCH";
+ }
+ else
+ {
+ die("Malformed 'ASCII' argument $pm in object $working_object{name}");
+ }
+ }
+ elsif ($input_line =~ /^\s*UTF-?8\s+/)
+ {
+ my $pm = "$POSTMATCH";
+ if ($pm =~ /^"[^"]+"/)
+ {
+ $working_object{uni} = "$MATCH";
+ }
+ else
+ {
+ die("Malformed 'UTF8' argument $pm in object $working_object{name}");
+ }
+ }
+ else
+ {
+ die("Malformed/unrecognized line $input_line in object $working_object{name}");
+ }
+}
+commit_object(\%working_object);
+print "\n";
+
+open(HEADERFILE, ">", "pobj_id.hh") or die "pobj_comp: could not open pobj_id.hh for write: $!";
+open(SOURCEFILE, ">", "permobj.cc") or die "pobj_comp: could not open permobj.cc for write: $!";
+print HEADERFILE "// pobj_id.hh\n// This file is autogenerated from $input_fname\n// and is subject to the same copyright licensing terms as that file.\n// Do not edit this file directly; edit $input_fname then use pobj_comp to\n// regenerate this file and permobj.cc\n#pragma once\nenum Pobj_id {\n";
+print SOURCEFILE "// permobj.cc\n// This file is autogenerated from $input_fname\n// and is subject to the same copyright licensing terms as that file.\n// Do not edit this file directly; edit $input_fname then use pobj_comp to\n// regenreate this file and pobj_id.hh\n#include \"victrix-abyssi.hh\"\nPermobj permobjs[NUM_OF_PERMOBJS] = {\n";
+my $phref;
+my $i;
+my $total_objs = 0;
+my @firsts;
+my $tagname;
+
+for ($i = 0; $i <= $#weapons; ++$i, ++$total_objs)
+{
+ $phref = $weapons[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_WEAPON ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_WEAPON, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_WEAPON ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#armour; ++$i, ++$total_objs)
+{
+ $phref = $armour[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_ARMOUR ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_ARMOUR, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_ARMOUR ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#food; ++$i, ++$total_objs)
+{
+ $phref = $food[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_FOOD ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_FOOD, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_FOOD ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#scrolls; ++$i, ++$total_objs)
+{
+ $phref = $scrolls[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_SCROLL ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_SCROLL, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_SCROLL ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#potions; ++$i, ++$total_objs)
+{
+ $phref = $potions[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_POTION ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_ARMOUR, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_POTION ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#rings; ++$i, ++$total_objs)
+{
+ $phref = $rings[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_RING ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_RING, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_RING ${tagname}\n";
+ undef $tagname;
+}
+
+for ($i = 0; $i <= $#carrion; ++$i, ++$total_objs)
+{
+ $phref = $carrion[$i];
+ $tagname = "PO_".macroify_objname($phref->{name});
+ if ($i == 0)
+ {
+ push @firsts, "#define PO_FIRST_CARRION ${tagname}\n";
+ }
+ if ($total_objs != 0)
+ {
+ print HEADERFILE ",\n";
+ }
+ print HEADERFILE " ${tagname}";
+ printf SOURCEFILE " { \"%s\", \"%s\", \"%s\", POCLASS_CARRION, %d, %s, %s, Gcol_%s, %d, %d, %d },\n", $phref->{name}, $phref->{plural}, $phref->{desc}, $phref->{rarity}, $phref->{ascii}, $phref->{uni}, $phref->{colour}, $phref->{power}, $phref->{power2}, $phref->{depth};
+}
+if (defined($tagname))
+{
+ push @firsts, "#define PO_LAST_CARRION ${tagname}\n";
+ undef $tagname;
+}
+
+print SOURCEFILE "};\n// permobj.cc\n";
+printf HEADERFILE "};\n".join('', @firsts)."\n#define NUM_OF_PERMOBJS %d\n\n// pobj_id.hh\n", $total_objs;
+
+close(SOURCEFILE);
+close(HEADERFILE);
+
+# vim:autoindent