#!/usr/bin/perl -w
package MudConvert::WileyMUD::Input;
use strict;
use English;
use Data::Dumper;
use MudConvert::Utils qw( float vnum_index_file report_error );
use MudConvert::WileyMUD::Constants qw( $sector_types $rev_sector_types
$room_flags $rev_room_flags
$zone_commands
$exit_directions $rev_exit_directions
$zone_reset_flags $rev_zone_reset_flags
$door_states $equip_positions
$exit_types $exit_flags
$shop_sell_item_count $shop_buy_item_count $shop_message_count
$shop_attitudes $rev_shop_attitudes
$shop_immortal_flags $rev_shop_immortal_flags
$shop_message_names
);
use MudConvert::API qw( exit_flag_list );
use base 'Exporter';
our @EXPORT_OK = qw( load_game load_zones load_rooms load_mobs load_objects load_shops );
sub load_game {
my $cfg = shift;
my $input_data = {};
$input_data->{'Zones'} = load_zones($cfg);
$input_data->{'Rooms'} = load_rooms($cfg);
$input_data->{'Mobs'} = load_mobs($cfg);
$input_data->{'Objects'} = load_objects($cfg);
$input_data->{'Shops'} = load_shops($cfg);
return $input_data;
}
sub load_zones {
my $cfg = shift;
my $zone_file = $cfg->{'source-dir'}.'/tinyworld.zon';
my $zone_data = vnum_index_file($cfg, $zone_file);
print "Parsing Zone file..." if !$cfg->{'quiet'};
open FP, $zone_file;
foreach my $vnum (keys %{ $zone_data }) {
seek FP, $zone_data->{$vnum}->{'BytePos'}, 0;
my @line_set = ();
my $line = $zone_data->{$vnum}->{'Line'};
while(<FP>) {
chomp;
push @line_set, $_;
last if $_ =~ /^S$/;
if( $_ =~ /^#\d+/ and $line != $zone_data->{$vnum}->{'Line'} ) {
report_error($zone_data, $vnum, $_, pos($_), "WARNING", "Invalid ZONE data");
last;
}
$line++;
}
$zone_data->{$vnum}->{'file_section'} = join("\n", @line_set);
}
close FP;
# Done reading the section in, now let's pick at it!
foreach my $vnum (sort { $a <=> $b } keys %{ $zone_data }) {
$zone_data->{$vnum}->{'Source'} = 'WileyMUD';
$zone_data->{$vnum}->{'Resets'} = [];
my @line_set = split /\n/, $zone_data->{$vnum}->{'file_section'};
# Already have vnum, so skip line 0.
for( my $i = 1; $i < scalar(@line_set); $i++ ) {
if( $i == 0 ) { # VNUM line, skip since we already have it.
next;
} elsif( $i == 1 ) { # Name line.
$line_set[$i] =~ /(^.*)~$/;
$zone_data->{$vnum}->{'Name'} = $1;
if( !(defined $zone_data->{$vnum}->{'Name'}) ) {
report_error($zone_data, $vnum, $line_set[$i], pos($line_set[$i]), "FATAL", "Missing ZONE NAME");
last;
}
} elsif( $i == 2 ) { # Flag line.
$line_set[$i] =~ /^\s*(\d+)\s+(\d+)\s+(\d+)\s*$/;
( $zone_data->{$vnum}->{'Top'},
$zone_data->{$vnum}->{'Time'},
$zone_data->{$vnum}->{'Mode'} ) = ( $1, $2, $zone_reset_flags->{$3} );
if( !(defined $zone_data->{$vnum}->{'Top'}) or
!(defined $zone_data->{$vnum}->{'Time'}) or
!(defined $zone_data->{$vnum}->{'Mode'})
) {
report_error($zone_data, $vnum, $line_set[$i], pos($line_set[$i]), "FATAL", "Invalid ZONE FLAGS");
print STDERR "Skipping zone $vnum!\n";
last;
}
} else { # Reset lines.
my $reset = {};
$line_set[$i] =~ /^\s*(\w)/;
my $cmd = $1;
$reset->{'Command'} = $cmd;
$reset->{'Number'} = $i - 2;
if( !(defined $cmd) ) {
# Regex failure... not the right format line at all!
report_error($zone_data, $vnum, $line_set[$i], pos($line_set[$i]), "FATAL", "Missing ZONE COMMAND");
printf STDERR "Skipping zone %d reset %d.\n", $vnum, $reset->{'Number'};
next;
} elsif (!(defined $zone_commands->{$cmd}) or !(defined $zone_commands->{$cmd}->{'Name'}) ) {
# We have a command, but it isn't a valid one...
report_error($zone_data, $vnum, $line_set[$i], pos($line_set[$i]), "FATAL", "Unrecognized ZONE COMMAND");
printf STDERR "Skipping zone %d reset %d.\n", $vnum, $reset->{'Number'};
next;
} elsif( $zone_commands->{$cmd}->{'Name'} eq 'END' ) {
# End of the show, nothing more to see here.
last;
} else {
# A live one! Catch him quick!
$reset->{'Name'} = $zone_commands->{$cmd}->{'Name'};
my $found_error = 0;
my $argcnt = scalar(@{ $zone_commands->{$cmd}->{'Args'} });
my $tmp = $line_set[$i];
$reset->{'Args'} = [];
$tmp =~ s/^\s*\w//; # Strip the leading command so we can...
for( my $j = 0; ($j < $argcnt) and ($tmp =~ /\s+(\d+)/g); $j++ ) {
# Loop through the integers automagically.
$reset->{$zone_commands->{$cmd}->{'Args'}->[$j]} = $1;
push @{ $reset->{'Args'} }, $1;
if( !(defined $reset->{$zone_commands->{$cmd}->{'Args'}->[$j]}) ) {
report_error($zone_data, $vnum, $line_set[$i], pos($line_set[$i]), "FATAL", "Invalid ZONE COMMAND ARGUMENTS");
printf STDERR "Skipping zone %d reset %d.\n", $vnum, $reset->{'Number'};
$found_error = 1;
}
}
next if $found_error;
$reset->{'Comment'} = $1 if($tmp =~ /.*?\*\s*(.*?)\s*$/g);
}
# If we get here, it means we read in a valid format zone command.
# Now we need to convert data to a more portable format...
if( $reset->{'Name'} eq 'DOOR' ) {
$reset->{'EXIT_DIR'} = $exit_directions->{$reset->{'EXIT_DIR'}};
$reset->{'DOOR_STATE'} = $door_states->{$reset->{'DOOR_STATE'}};
} elsif( $reset->{'Name'} eq 'EQUIP' ) {
$reset->{'EQUIP_POS'} = $equip_positions->{$reset->{'EQUIP_POS'}};
}
push @{ $zone_data->{$vnum}->{'Resets'} }, $reset;
}
}
}
printf("done\nLoaded %d zones.\n", scalar(keys %{ $zone_data })) if !$cfg->{'quiet'};
return $zone_data;
}
sub parse_room {
my $cfg = shift;
my $room_data = shift;
my $vnum = shift;
my ( $t1, $t2, $t3, $t4, $t5, $t6, $t7, $t8, $t9 ) = ( undef, undef, undef, undef, undef, undef, undef, undef, undef );
my ($Name, $Description, $Zone, $Flags, $Sector) = (undef, [], undef, undef, undef);
my ($TeleportTime, $TeleportTo, $TeleportLook, $TeleportSector) = (undef, undef, undef, undef);
my ($RiverSpeed, $RiverDirection) = (undef, undef);
my ($SoundOne, $SoundTwo) = ([], []);
my ($Exits, $ExtraDesc) = ({}, {});
my $room = $room_data->{$vnum}->{'file_section'};
# $room =~
# /^\#(?:[\d-]+)\s*\n # VNum
# ([^~]*)~\n # Room Name
# ([^~]*)~\n # Description
# \s*([\d-]+)\s+([\d-]+)\s+([\d-]+) # Zone, Flags, Sector
# (?:\s+([\d-]+))?(?:\s+([\d-]+))? # Teleport or River
# (?:\s+([\d-]+))?(?:\s+([\d-]+))?\s*\n
# /cgmsx;
#
# ( $Name, $t2,
# $Zone, $Flags, $Sector,
# $t6, $t7, $t8, $t9,
# ) = ( $1, $2, $3, $4, $5, $6, $7, $8, $9 );
# Just eat the VNUM, we already have it...
if( !($room =~ /^\#(?:[\d-]+)\s*\n/cgmsx) ) { # VNum
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Missing ROOM VNUM");
print STDERR "Skipping room $vnum!\n";
return 0;
}
if( !($room =~ /\G([^~]*)~\n/cgmsx) ) { # Room Name
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Missing ROOM NAME");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$Name = $1;
}
if( !($room =~ /\G([^~]*)~\n/cgmsx) ) { # Description
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Missing ROOM DESCRIPTION");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
push @{ $Description }, (split /\n/, $1);
}
if( !($room =~ /\G\s*([\d-]+)/cgmsx) ) { # Zone
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM ZONE NUMBER");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$Zone = $1;
if( $Zone != int($vnum / 100) ) {
report_error($room_data, $vnum, $room, pos($room), "WARNING", "ROOM ZONE NUMBER mismatch");
}
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Flags
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM FLAGS");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$Flags = $1;
if( $Flags & int($rev_room_flags->{'ROOM_DEATH'}) ) {
report_error($room_data, $vnum, $room, pos($room), "WARNING", "DEATH ROOM detected");
}
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Sector
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM SECTOR");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$Sector = $sector_types->{$1};
if( !(defined $Sector) ) {
report_error($room_data, $vnum, $room, pos($room), "WARNING", "Unknown ROOM SECTOR TYPE", 1);
print STDERR "Setting to ".$sector_types->{0}.".\n";
$Sector = $sector_types->{0};
}
if( $Sector eq 'SECT_TELEPORT' ) {
# Fine, teleport we must... but where?
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Teleport Time
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM TELEPORT TIME value");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$TeleportTime = $1;
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Teleport To
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM TELEPORT DESTINATION");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$TeleportTo = $1;
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Teleport Look
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM TELEPORT LOOK flag");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$TeleportLook = $1;
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # Teleport Sector
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM TELEPORT SECTOR value");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$TeleportSector = $sector_types->{$1};
}
if( !(defined $TeleportSector) ) {
report_error($room_data, $vnum, $room, pos($room), "WARNING", "Unknown ROOM TELEPORT SECTOR TYPE", 1);
print STDERR "Setting to ".$sector_types->{0}.".\n";
$TeleportSector = $sector_types->{0};
}
#$room_data->{$vnum}->{'Sector'} = $rev_sector_types->{'SECT_FIELD'};
} elsif( $Sector eq 'SECT_WATER_NOSWIM' ) {
# Shallow Water (in Wiley) means river... which has to flow somewhere
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # River Speed
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM RIVER SPEED value");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$RiverSpeed = $1;
}
if( !($room =~ /\G\s+([\d-]+)/cgmsx) ) { # River Direction
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM RIVER DIRECTION");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
$RiverDirection = $1;
}
}
# Read the trailing newline, regardless of sector type, to advance the pointer
$room =~ /\G\s*\n/cgmsx;
}
if( $Flags & int($rev_room_flags->{'ROOM_SOUND'}) ) {
$room =~ /\G([^~]*)~\n([^~]*)~\n/cgmsx; # Two room sound lines
( $t1, $t2 ) = ( $1, $2 );
if( !(defined $t1) or !(defined $t2) ) {
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid ROOM SOUND DATA");
print STDERR "Skipping room $vnum!\n";
return 0;
} else {
if( $t1 !~ /^D\d+\s*\n/ and $t1 !~ /^E\s*\n/ and $t1 !~ /^S\s*\n/ ) {
push @{ $SoundOne }, (split /\n/, $t1);
push @{ $SoundTwo }, (split /\n/, $t2);
} else { # We found doors or extras or the end instead of sounds!
report_error($room_data, $vnum, $room, pos($room), "WARNING", "Missing ROOM SOUNDS");
print STDERR "Setting SOUND bit to NULL for room $vnum!\n";
$Flags ^= int($rev_room_flags->{'ROOM_SOUND'});
}
}
}
#print STDERR "DEBUG: room == $room\n";
my $j = 0;
while(
$room =~
/\GD(\d+)\s*\n # Exit number
([^~]*)~\n # Exit description
([^~]*)~\n # Exit keywords
\s*([\d-]+)\s+([\d-]+)\s+([\d-]+)\s*\n # Type, Key Number, Target Room
/cgmsx
) {
($t1,$t2,$t3,$t4,$t5,$t6) = ($1,$2,$3,$4,$5,$6);
if( !(defined $t1) or !(defined $t2) or !(defined $t3) ) {
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid EXIT DATA");
print STDERR "Skipping room $vnum!\n";
return 0;
}
$Exits->{$exit_directions->{$t1}} = {
'Number' => $j,
'Direction' => $exit_directions->{$t1},
'Description' => $t2,
'Keywords' => $t3,
'ExitFlags' => exit_flag_list($exit_types->{$t4}),
'KeyNumber' => $t5,
'DestinationVNum' => $t6,
};
$j++;
}
$j = 0;
while(
$room =~
/\GE\s*\n # Extra description!
([^~]*)~\n # Keyword list
([^~]*)~\n # Description
/cgmsx
) {
($t1, $t2) = ($1, $2);
if( !(defined $t1) or !(defined $t2) ) {
report_error($room_data, $vnum, $room, pos($room), "FATAL", "Invalid EXTRA DESCRIPTION DATA");
print STDERR "Skipping room $vnum!\n";
return 0;
}
$ExtraDesc->{$t1} = {
'Number' => $j,
'Keywords' => $t1,
'Description' => $t2,
};
$j++;
}
# At this point we should be done... sanity checking should give us a lone S.
#if( $room !~ /S\s*\n/ ) {
# printf STDERR "Terminating S tag not found for file %s, room %d, below line %d\n",
# $room_data->{$vnum}->{'Filename'},
# $vnum,
# $room_data->{$vnum}->{'Line'};
#}
$room_data->{$vnum}->{'Source'} = 'WileyMUD';
$room_data->{$vnum}->{'Name'} = $Name;
$room_data->{$vnum}->{'Description'} = $Description;
$room_data->{$vnum}->{'Zone'} = $Zone;
$room_data->{$vnum}->{'Flags'} = [];
#$room_data->{$vnum}->{'Flags'}->{'Value'} = $Flags;
for (my $i = 0; $i < 32; $i++) {
push @{ $room_data->{$vnum}->{'Flags'} }, $room_flags->{1 << $i}
if $Flags & (1 << $i);
}
$room_data->{$vnum}->{'Sector'} = $Sector;
if( $Sector eq 'SECT_TELEPORT' ) {
$room_data->{$vnum}->{'TeleportTime'} = $TeleportTime;
$room_data->{$vnum}->{'TeleportTo'} = $TeleportTo;
$room_data->{$vnum}->{'TeleportLook'} = $TeleportLook;
$room_data->{$vnum}->{'TeleportSector'} = $TeleportSector;
} elsif( $Sector eq 'SECT_WATER_NOSWIM' ) {
$room_data->{$vnum}->{'RiverSpeed'} = $RiverSpeed;
$room_data->{$vnum}->{'RiverDirection'} = $exit_directions->{$RiverDirection};
}
if( $Flags & int($rev_room_flags->{'ROOM_SOUND'}) ) {
$room_data->{$vnum}->{'SoundOne'} = $SoundOne;
$room_data->{$vnum}->{'SoundTwo'} = $SoundTwo;
}
if( scalar(keys %{ $Exits }) > 0 ) {
$room_data->{$vnum}->{'Exits'} = $Exits
} else {
report_error($room_data, $vnum, $room, pos($room), "WARNING", "NO EXITS FOUND");
}
if( scalar(keys %{ $ExtraDesc }) > 0 ) {
$room_data->{$vnum}->{'ExtraDesc'} = $ExtraDesc
} else {
#report_error($room_data, $vnum, $room, pos($room), "WARNING: NO EXTRA DESCRIPTIONS FOUND");
}
return 1;
}
sub load_rooms {
my $cfg = shift;
my $world_file = $cfg->{'source-dir'}.'/tinyworld.wld';
my $room_data = vnum_index_file($cfg, $world_file);
print "Parsing World file..." if !$cfg->{'quiet'};
open FP, $world_file;
foreach my $vnum (sort { $a <=> $b } keys %{ $room_data }) {
seek FP, $room_data->{$vnum}->{'BytePos'}, 0;
my @line_set = ();
my $line = $room_data->{$vnum}->{'Line'};
while(<FP>) {
chomp;
push @line_set, $_;
last if $_ =~ /^S$/;
if( $_ =~ /^#\d+/ and $line != $room_data->{$vnum}->{'Line'} ) {
print STDERR "*** Invalid Room data at line $line!\n";
print STDERR " Attempting to continue...\n";
last;
}
$line++;
}
$room_data->{$vnum}->{'file_section'} = join("\n", @line_set);
}
close FP;
my $room_count = 0;
foreach my $vnum (sort { $a <=> $b } keys %{ $room_data }) {
if( !parse_room($cfg, $room_data, $vnum) ) {
delete $room_data->{$vnum};
print STDERR "FATAL: Skipping ROOM $vnum!\n";
} else {
$room_count++;
}
}
print "done\nLoaded $room_count rooms.\n" if !$cfg->{'quiet'};
return $room_data;
}
sub parse_mob {
my $cfg = shift;
my $mob_data = shift;
my $vnum = shift;
return 0;
}
sub load_mobs {
my $cfg = shift;
my $mob_file = $cfg->{'source-dir'}.'/tinyworld.mob';
my $mob_data = vnum_index_file($cfg, $mob_file);
print "Parsing Mob file..." if !$cfg->{'quiet'};
open FP, $mob_file;
foreach my $vnum (sort { $a <=> $b } keys %{ $mob_data }) {
seek FP, $mob_data->{$vnum}->{'BytePos'}, 0;
my @line_set = ();
my $line = $mob_data->{$vnum}->{'Line'};
while(<FP>) {
chomp;
push @line_set, $_;
last if $_ =~ /^S$/;
if( $_ =~ /^#\d+/ and $line != $mob_data->{$vnum}->{'Line'} ) {
print STDERR "*** Invalid Mob data at line $line!\n";
print STDERR " Attempting to continue...\n";
last;
}
$line++;
}
$mob_data->{$vnum}->{'file_section'} = join("\n", @line_set);
}
close FP;
my $mob_count = 0;
foreach my $vnum (sort { $a <=> $b } keys %{ $mob_data }) {
if( !parse_mob($cfg, $mob_data, $vnum) ) {
delete $mob_data->{$vnum};
print STDERR "FATAL: Skipping MOB $vnum!\n";
} else {
$mob_count++;
}
}
print "done\nLoaded $mob_count mobs.\n" if !$cfg->{'quiet'};
return undef;
}
sub parse_obj {
my $cfg = shift;
my $obj_data = shift;
my $vnum = shift;
return 0;
}
sub load_objects {
my $cfg = shift;
my $obj_file = $cfg->{'source-dir'}.'/tinyworld.obj';
my $obj_data = vnum_index_file($cfg, $obj_file);
print "Parsing World file..." if !$cfg->{'quiet'};
open FP, $obj_file;
foreach my $vnum (sort { $a <=> $b } keys %{ $obj_data }) {
seek FP, $obj_data->{$vnum}->{'BytePos'}, 0;
my @line_set = ();
my $line = $obj_data->{$vnum}->{'Line'};
while(<FP>) {
chomp;
push @line_set, $_;
last if $_ =~ /^S$/;
if( $_ =~ /^#\d+/ and $line != $obj_data->{$vnum}->{'Line'} ) {
print STDERR "*** Invalid Object data at line $line!\n";
print STDERR " Attempting to continue...\n";
last;
}
$line++;
}
$obj_data->{$vnum}->{'file_section'} = join("\n", @line_set);
}
close FP;
my $obj_count = 0;
foreach my $vnum (sort { $a <=> $b } keys %{ $obj_data }) {
if( !parse_obj($cfg, $obj_data, $vnum) ) {
delete $obj_data->{$vnum};
print STDERR "FATAL: Skipping OBJECT $vnum!\n";
} else {
$obj_count++;
}
}
print "done\nLoaded $obj_count objects.\n" if !$cfg->{'quiet'};
return undef;
}
sub parse_shop {
my $cfg = shift;
my $shop_data = shift;
my $vnum = shift;
my ($SellItems, $SellProfit, $BuyProfit, $BuyItems) = ([], undef, undef, []);
my ($Messages, $Attitude, $Immortal, $ShopkeeperVNum) = ({}, undef, undef, undef);
my ($UnusedFlag, $RoomVNum, $OpenHour1, $CloseHour1, $OpenHour2, $CloseHour2) = (undef,undef,undef,undef,undef,undef);
my $shop = $shop_data->{$vnum}->{'file_section'};
# Just eat the VNUM, we already have it...
if( !($shop =~ /^\#(?:[\d-]+)\s*\~?\s*\n/cgmsx) ) { # VNum
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Missing SHOP VNUM");
return 0;
}
for( my $i = 1; $i <= $shop_sell_item_count; $i++) {
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Goods for sale
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP SELL ITEM $i");
return 0;
} else {
push @{ $SellItems }, $1;
}
}
if( !($shop =~ /\G\s*([\d\.-]+)\s*\n/cgmsx) ) { # Sell Profit
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP SELL PROFIT");
return 0;
} else {
$SellProfit = $1;
}
if( !($shop =~ /\G\s*([\d\.-]+)\s*\n/cgmsx) ) { # Buy Profit
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP BUY PROFIT");
return 0;
} else {
$BuyProfit = $1;
}
for( my $i = 1; $i <= $shop_buy_item_count; $i++) {
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Goods we purchase
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP BUY ITEM $i");
return 0;
} else {
push @{ $BuyItems }, $1;
}
}
for( my $i = 1; $i <= $shop_message_count; $i++) {
if( !($shop =~ /\G([^~]*)~\n/cgmsx) ) { # Obnoxious messages
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP MESSAGE $i");
return 0;
} else {
$Messages->{$shop_message_names->[$i-1]} = $1;
}
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Attitude
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP ATTITUDE ");
return 0;
} else {
$Attitude = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Immortal Flag
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP IMMORTAL FLAG ");
return 0;
} else {
$Immortal = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Shopkeeper VNum
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP SHOPKEEPER VNUM");
return 0;
} else {
$ShopkeeperVNum = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Unused Flag
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP UNUSED FLAG");
return 0;
} else {
$UnusedFlag = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Room VNum
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP ROOM VNUM");
return 0;
} else {
$RoomVNum = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Open Hour
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP OPEN HOUR");
return 0;
} else {
$OpenHour1 = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Close Hour
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP CLOSE HOUR");
return 0;
} else {
$CloseHour1 = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*\n/cgmsx) ) { # Open Hour 2
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP OPEN HOUR 2");
return 0;
} else {
$OpenHour2 = $1;
}
if( !($shop =~ /\G\s*([\d-]+)\s*/cgmsx) ) { # Close Hour 2
report_error($shop_data, $vnum, $shop, pos($shop), "FATAL", "Invalid SHOP CLOSE HOUR 2");
return 0;
} else {
$CloseHour2 = $1;
}
$shop_data->{$vnum}->{'Source'} = 'WileyMUD';
$shop_data->{$vnum}->{'Name'} = "Ye Olde Shoppe $vnum"; # Wiley shops don't have names
$shop_data->{$vnum}->{'Description'} = "You see a shop full of stuff."; # No descriptions either
$shop_data->{$vnum}->{'Zone'} = int($RoomVNum / 100); # Shops don't have zones, but their rooms do!
$shop_data->{$vnum}->{'SellItems'} = $SellItems;
$shop_data->{$vnum}->{'BuyItems'} = $BuyItems;
$shop_data->{$vnum}->{'SellProfit'} = float($SellProfit);
$shop_data->{$vnum}->{'BuyProfit'} = float($BuyProfit);
$shop_data->{$vnum}->{'Messages'} = $Messages;
$shop_data->{$vnum}->{'Attitude'} = $shop_attitudes->{$Attitude};
$shop_data->{$vnum}->{'Immortal'} = $shop_immortal_flags->{$Immortal};
$shop_data->{$vnum}->{'RoomVNum'} = $RoomVNum;
$shop_data->{$vnum}->{'Hours'} = { 'Open' => [ $OpenHour1, $OpenHour2 ],
'Close' => [ $CloseHour1, $CloseHour2 ], };
return 1;
}
sub load_shops {
my $cfg = shift;
my $shop_file = $cfg->{'source-dir'}.'/tinyworld.shp';
my $shop_data = vnum_index_file($cfg, $shop_file);
print "Parsing Shop file..." if !$cfg->{'quiet'};
open FP, $shop_file;
foreach my $vnum (keys %{ $shop_data }) {
seek FP, $shop_data->{$vnum}->{'BytePos'}, 0;
my @line_set = ();
my $line = $shop_data->{$vnum}->{'Line'};
while(<FP>) {
chomp;
push @line_set, $_;
if( $_ =~ /^\$\~/ or ($_ =~ /^#\d+/ and $line != $shop_data->{$vnum}->{'Line'}) ) {
pop @line_set; # no record end marker, so toss the extra
last;
}
$line++;
}
$shop_data->{$vnum}->{'file_section'} = join("\n", @line_set);
}
close FP;
# Done reading the section in, now let's pick at it!
my $shop_count = 0;
foreach my $vnum (sort { $a <=> $b } keys %{ $shop_data }) {
if( !parse_shop($cfg, $shop_data, $vnum) ) {
delete $shop_data->{$vnum};
print STDERR "FATAL: Skipping SHOP $vnum!\n";
} else {
$shop_count++;
}
}
print "done\nLoaded $shop_count shops.\n" if !$cfg->{'quiet'};
return $shop_data;
}
1;
