Back in the day, I took a writing course in a special fine arts program. The advise that the professional writer gave us aspiring novelists and poets was to put an ad in the paper when you move to a new place. “Writer; new to the area… seeks support.” Something like that. His point was that we weren’t going to get any better without having some good feedback from our fellow craftsmen. We need to form little groups where we share what we’re working on– not just for tips about style and technique, but also just to get the encouragement we need to persevere. (Also, he told us to watch out for the pompous guys in the turtle necks with pipes: these guys are expert at looking like “writers” without actually ever writing anything!)
Fast forward to today. I’m a professional “programmer”… but most of my colleagues have no interest in sharing code and discussing it. (At the last place I worked, the other guys would roll their eyes at any request I would make for design meetings or brief “show and tell” type exchanges.) Maybe it’s different in your area of expertise, but the general attitude appears to be that folks want to just be left alone to do things their own way. In some cases, I doubt that we even a common framework or language from which to discuss good design principles…. (I’m sure Alan Kay has noticed something like this and maybe even cited it as evidence that we’re still in the dark ages of programming….)
Similarly, I remember an art teacher I had. I asked him how to get good at drawing. He said everyone has a million bad drawings in them and that the sooner you get those out of the way, the more likely you are to get good. Learning a new programming language is like that, except… I guess it’s more like you have to get 100 bad short programs out of the way… and then you have to get at least 10 medium sized programs out of the way.
So here I am learning Perl in general and Moose in particular. Definitely “new to the area” in that department! Also, I have below my second “bad” medium sized program for this platform. There are a lot of directions I can go with this stuff, but I’d like to tune things up some more before I get too deep into anything else. Please feel free to jump in with your comments if you’re into it. Here are a few random notes:
* Installing Moose on cygwin didn’t work for me. I tried a few different ways, but always got hung up on the dependencies.
* Installing Moose on Windows was pretty painless. Whatever the package manager was that I used, it worked great.
* The default shell for Emacs on Windows is pretty retarded. The whole concept of STDIN seems gone there…. Argh….
* You can’t seem to cut and paste text from a standard Windows console window. Argh.
* In the code below, I haven’t completely refactored the Parser to be completely “Moose-ish”. I did factor out a Table object, though.
* There are a few instances of cut & paste code repetition below.
* The program attempts to implement a strict by-the-book character generation sequence for Classic Traveller. I used the revised rules from The Traveller Book. (All classic Traveller materials are available on CD-Rom from FFE. Mongoose has recently released a new version of the game. e23 and Comstar both have pdf products available. I’m partial to the original stuff, myself.) There are other character generation programs floating around, but I’m not sure how well they tend to follow the rules as written.
* The current design is mostly data-driven. Someone that knows Traveller should be able to customize the program to some extent without knowing Perl. I would like to extend the capabilities of the configuration language so that ordinary joes can hack things into whatever houserules they’ve cooked up. My concept for this would be something halfway between 8-bit BASIC and a spreadsheet… but slightly OOPish, maybe. Maybe I should write a compiler to convert the script file into standard Perl? I dunno…. We’ll see where this goes….
* After cleaning up the program as it stands, I should be in a position to code up other chargen schemes (as my spare time allows)… and I should have an opportunity to use more of Moose’s features then. Going forward (assuming I go forward) I would want to strike some sort of balance between improving the generic parser tool and adding more scope and comprehensiveness to the generator. I wouldn’t want to have a perfect parser that isn’t implementing anything… and I wouldn’t want my code to turn to sludge and then collapse under the weight of its own scope, either. At some point, I do want the hypothetical “power user” to be able to make this work however they want, though.
#!/usr/bin/perl
package Routines;
# get random number from 0 to n-1 using rand function
sub get_rand { int (rand $_[0]); }
sub d_six { return get_rand(6) + 1; }
sub two_d_six { return d_six() + d_six(); }
# TODO: This routine should omit I and O results to be real 'Traveller extended-hex' values
sub tr_hex {
my $num = shift;
return 0 if $num <= 0;
return $num if $num <= 9;
die "$num is greater than 36-- too big for 'hex' conversion" if $num > 36;
return chr($num + 64 - 9);
}
###################################################################################################
package Callback;
use Moose;
sub process {
print "Hello World!\n";
}
sub choose {
my ($self, $text) = @_;
my @options = split /;/, $text;
#print "the text is $text\n";
my $i = 0;
print "\n";
foreach(@options){
$i++;
print "$i: $_\n";
}
my $answer;
until ($answer) {
print ">> ";
chomp(my $line = <STDIN>);
if ($line =~ /^\d+$/) {
$answer = $options[$line - 1];
} else {
foreach(@options){
if(/^$line/i){
$answer = $_;
last;
}
}
}
}
return $answer;
}
###################################################################################################
package Table;
use Moose;
my $show_debug2 = 0;
has Name => (is => 'rw', isa => 'Str', default => 'Bob');
has 'Rows' => (isa => 'HashRef', is => 'rw', default => sub { my %hash; return \%hash; } );
has 'Columns' => (isa => 'ArrayRef[Str]', is => 'rw', default => sub { my @a; return \@a; } );
has 'ColumnRegexes' => (isa => 'ArrayRef[Str]', is => 'rw', default => sub { my @a; return \@a; } );
sub initialize {
my ($self, $table, $text) = @_;
$self->Name($table);
my ($columns, $column_regexes) = parse_column_header($text);
$self->Columns($columns);
$self->ColumnRegexes($column_regexes);
my %rows;
$self->Rows(\%rows);
}
sub load_line {
my ($self, $text) = @_;
my ($rowkey, $row) = parse_row_detail($self->Name(), $text, $self->Columns());
$self->Rows->{$rowkey} = $row;
}
sub cell {
my ($self, $row, $column) = @_;
return $self->Rows->{$row}->{$column};
}
### pass a comma delimited header line from a table definition
### and get two array references describing the table structure
sub parse_column_header {
my ($line) = @_;
my @fields = split /,/, $line;
my $column_number = 0;
my @columns;
my @regexes;
print "reading columns to table: $line\n" if $show_debug2;
foreach(@fields){
my $field = $_;
$field =~ s/^\s+|\s+$//g; # trim field
if($field =~ /^([^\/]*)\/([^\/]*)\//){
$field = $1;
$regexes[$column_number] = $2;
}
$columns[$column_number] = $field;
$column_number++;
}
return (\@columns, \@regexes);
}
### pass a table name and a comma delimited header line from a table definition
### and also pass a reference to an array of column names...
### and get the row's key and a hash of detail data
sub parse_row_detail {
my ($table, $line, $columns) = @_;
my @fields = split /,/, $line;
print "reading rows to table $table: $line\n" if $show_debug2;
my %row;
my $column_number = 0;
my $rowkey;
my $didit;
foreach(@fields){
my $field = $_;
$field =~ s/^\s+|\s+$//g; # trim field
# Need to allow some keys to be '0'!
if ($didit){
$row{$columns->[$column_number]} = $field;
} else {
$rowkey = $field;
}
$column_number++;
$didit = 1;
}
return ($rowkey, \%row);
}
sub show_keys {
my ($self) = @_;
my $key;
my $table = $self->Name();
my $rs = $self->Rows();
foreach $key (sort keys %{$rs}){
print "$table row : $key\n";
}
my $cs = $self->Columns();
foreach (@{$cs}){
print "$table column : $_\n";
}
}
###################################################################################################
package Parser;
use Moose;
has 'Tables' => (isa => 'HashRef[Table]', is => 'rw', default => sub { my %hash; return \%hash; } );
has ReadAsTable => (isa => 'HashRef[Table]', is => 'rw', default => sub { my %hash; return \%hash; } );
my $read_type = 0;
my $current_table = "None";
my %widgets;
my $current_widget = "None";
my $widget_parser_sub = \&reading_widget_fields;
my $show_debug = 0;
my $lame_hack;
sub lameness {
my $self = shift;
$lame_hack = $self;
}
sub cell {
my ($self, $table, $key, $column) = @_;
return $self->Tables->{$table}->cell($key, $column);
}
sub show_keys {
my ($self, $table) = @_;
if ($table){
$self->Tables()->{$table}->show_keys();
} else {
foreach my $key (sort keys %{$self->Tables()}){
print "Table: $key\n";
}
}
}
### why can't I call my properties without $self?
sub reading_table_header {
my ($line) = @_;
my $T = new Table();
$T->initialize($current_table, $line);
$lame_hack->Tables()->{$current_table} = $T;
$read_type = 2;
}
sub reading_table_detail {
my ($line) = @_;
my $T = $lame_hack->Tables()->{$current_table};
$T->load_line($line);
}
my %dispatch_data = (
'^Table ([A-Za-z]+):' => {
code => sub { $current_table = $1; $read_type = 1 },
debug => sub { print "(reading table $1)\n" },
},
'^\#(.*)' => {
code => {},
debug => sub { print "found a comment: $1\n" },
},
'^[\w]*$' => {
code => sub { $read_type = 0 },
debug => sub { print "(Whitespace line)\n" },
},
'^ReadCell "([^"]+)" As "([^"]+)"' => {
code => sub { $lame_hack->ReadAsTable->{$1} = $2; },
debug => sub { print "(Whitespace line)\n" },
},
);
# build the dispatch table-- but only for regex's with code or debug routines
### (thanks to draegtun again)
my $dispatch_table = {};
while ( my ( $regex, $dispatch ) = each %dispatch_data ) {
$dispatch_table->{ $regex } = sub {
$dispatch->{ code }->() if exists $dispatch->{ code };
$dispatch->{ debug }->() if $show_debug;
} if exists $dispatch->{ code } or ($show_debug and exists $dispatch->{ debug });
}
my $alternate_dispatch_table =
{ 1 => \&reading_table_header,
2 => \&reading_table_detail,
};
sub parse {
my $self = shift;
my ($file) = @_;
#print "You are trying to open $file.\n";
open SCRIPT, "< $file";
while (<SCRIPT>) {
my $line = $_;
my $success = 0;
my $key;
foreach $key (sort keys %{$dispatch_table}) {
if ($line =~ /$key/){
$dispatch_table->{$key}->();
$success = 1;
last;
}
}
if ($success == 0 and $read_type > 0) {
chomp($line);
my $altcode = $alternate_dispatch_table->{$read_type};
$altcode->($line);
}
}
close SCRIPT;
}
###################################################################################################
package Character;
use Moose;
#use Parser;
has 'Callback' => (isa => 'Callback', is => 'rw', default => sub { Callback->new(); } );
has 'Environment' => (isa => 'Parser', is => 'rw', default => sub { my $P = Parser->new();
$P->lameness();
$P->parse('BookOne.dat');
return $P;} );
has 'AttributeNames' => (isa => 'ArrayRef[Str]', is => 'rw');
has 'AttributeValues' => (isa => 'ArrayRef[Int]', is => 'rw', default => sub { my @a; return \@a; });
has 'Commissioned' => (isa => 'Bool', is => 'rw');
has 'Terms' => (isa => 'Int', is => 'rw');
has 'Rank' => (isa => 'Int', is => 'rw');
has 'Cash' => (isa => 'Int', is => 'rw');
has 'UnspentBenefits' => (isa => 'Int', is => 'rw');
has 'CashRollsTaken' => (isa => 'Int', is => 'rw');
has 'Alive' => (isa => 'Bool', is => 'rw');
has 'Skills' => (isa => 'HashRef[Int]', is => 'rw');
has 'Benefits' => (isa => 'HashRef[Int]', is => 'rw');
has 'ServiceName' => (isa => 'Str', is => 'rw');
has 'Service' => (isa => 'Int', is => 'rw');
has 'Drafted' => (isa => 'Bool', is => 'rw');
has 'Reenlisted' => (isa => 'Bool', is => 'rw');
has 'SkillsToPick' => (isa => 'Int', is => 'rw');
has 'BenefitsToPick' => (isa => 'Int', is => 'rw');
sub set_attributes {
my $self = shift;
for(0..5){
$self->AttributeValues->[$_] = Routines::two_d_six();
}
}
sub initialize {
my $self = shift;
my @Attributes = qw/Strength Dexterity Endurance Intelligence Education Social/;
$self->AttributeNames(\@Attributes);
$self->Commissioned(0);
$self->Terms(0);
$self->Rank(0);
$self->Cash(0);
$self->UnspentBenefits(0);
$self->CashRollsTaken(0);
$self->Alive(1);
$self->ServiceName("");
$self->Service(0);
$self->Drafted(0);
my %skills;
my %benefits;
$self->Skills(\%skills);
$self->Benefits(\%benefits);
set_attributes($self);
}
sub display {
my $self = shift;
my $rankname = '';
$rankname = $self->cell('Titles', $self->{Rank}, $self->{Service}) if $self->{Rank};
my $age = 18 + $self->{Terms} * 4;
$age += 2 unless $self->{Alive};
my $t = "Terms";
$t = "Term" if $self->{Terms} == 1;
print "$self->{ServiceName} $rankname ($self->{Terms} $t)\t\t";
for(0..5){
print Routines::tr_hex($self->AttributeValues->[$_]);
}
print " Age: $age Cash: $self->{Cash}";
print " (DECEASED)" unless $self->Alive;
print "\n";
$self->display_skills();
$self->display_benefits();
}
sub display_attributes {
my ($self, $message) = @_;
for(0..5){
print Routines::tr_hex($self->AttributeValues->[$_]);
}
$message = '' unless defined($message);
print "$message\n";
}
sub enlist {
my ($self) = @_;
my $choice = $self->Callback->choose("Navy;Marines;Army;Scouts;Merchants;Other");
my $num = $self->cell('Services', $choice, 'ServiceNum');
print "You are attempting to enter service #$num $choice.\n";
my $target = $self->cell('PriorService', 'Enlistment', $num);
print "Your base enlistment target is $target.\n";
unless ($self->cell('PriorService', 'EOneVal', $num) eq '-'){
my $attone = $self->cell('PriorService', 'EOneAtt', $num);
my $valone = $self->cell('PriorService', 'EOneVal', $num);
my $atttwo = $self->cell('PriorService', 'ETwoAtt', $num);
my $valtwo = $self->cell('PriorService', 'ETwoVal', $num);
if ($self->attribute($attone) >= $valone){
print "Enlistment DM of +1 due to $attone.\n";
$target--;
}
if ($self->attribute($atttwo) >= $valtwo){
print "Enlistment DM of +2 due to $atttwo.\n";
$target -= 2;
}
print "Your net Enlistment Target is $target.\n"
}
my $roll = $self->get_two_d_six();
if ($roll >= $target){
print "You're in!!\n";
$self->Drafted(0);
$self->Service($num);
$self->ServiceName($choice);
} else {
print "You failed to enlist into the $choice.\n";
$self->Drafted(1);
$roll = Routines::d_six();
my $draft = $self->cell('PriorService', 'ServiceName', $roll);
$self->Service($roll);
$self->ServiceName($draft);
print "You have been drafted into $draft.\n";
}
$self->check_rank_skills();
}
sub get_d_six(){
my $roll = Routines::d_six();
print "You rolled a $roll.\n";
return $roll;
}
sub get_two_d_six(){
my $roll = Routines::two_d_six();
print "You rolled a $roll.\n";
return $roll;
}
sub check_rank_skills {
my ($self) = @_;
if ($self->Rank() < 7) {
my $skill = $self->cell("RankAndServiceSkills", $self->{Rank}, $self->{Service});
unless ($skill eq '-'){
print "You gain a rank/service skill level in $skill.\n";
if ($skill eq 'Social'){
$self->AttributeValues->[5] += 1; #TODO: add attributes to raise routine
} else {
$self->raise($skill);
}
} else {
print "No rank/service skill for you this time...\n";
}
}
}
sub survival {
my ($self) = @_;
my $target = $self->cell("PriorService", "Survival", $self->{Service});
unless ($target eq '-'){
print "Your base survival target is $target.\n";
my $att = $self->cell("PriorService", "STwoAtt", $self->{Service});
my $val = $self->cell("PriorService", "STwoVal", $self->{Service}); if ($self->attribute($att) >= $val){
$target -= 2;
print "Survival DM of +2 due to $att.\n";
print "Your net survival target is $target.\n";
}
$self->check_survival($target);
}
}
sub check_survival {
my ($self, $target) = @_;
my $roll = $self->get_two_d_six();
if ($roll >= $target){
print "You survived!\n";
$self->Alive(1);
} else {
print "You have died!\n";
$self->Alive(0);
}
}
sub commission {
my $self = shift;
my $target = $self->cell("PriorService", "Commission", $self->{Service});
unless ($target eq '-'){
print "Your base commission target is $target.\n";
my $att = $self->cell("PriorService", "COneAtt", $self->{Service});
my $val = $self->cell("PriorService", "COneVal", $self->{Service});
if ($self->attribute($att) >= $val){
$target--;
print "Commission DM of +1 due $att.\n";
print "Your net commission target is $target.\n";
}
my $roll = $self->get_two_d_six();
if ($roll >= $target){
print "You gained a commission!\n";
$self->Commissioned(1);
$self->{'SkillsToPick'}++;
$self->{'Rank'}++;
$self->check_rank_skills();
} else {
print "You did not get a commission.\n";
$self->Commissioned(0); # Just to be sure
}
}
}
sub promotion {
my $self = shift;
my $target = $self->cell("PriorService", "Promotion", $self->{Service});
unless ($target eq '-'){
print "Your base promotion target is $target.\n";
my $att = $self->cell("PriorService", "POneAtt", $self->{Service});
my $val = $self->cell("PriorService", "POneVal", $self->{Service});
if ($self->attribute($att) >= $val){
$target--;
print "Promotion DM of +1 due $att.\n";
print "Your net commission target is $target.\n";
}
my $roll = $self->get_two_d_six();
if ($roll >= $target){
print "You gained a promotion!\n";
$self->{'SkillsToPick'}++;
$self->{'Rank'}++;
$self->check_rank_skills();
} else {
print "You did not gain a promotion.\n";
}
}
}
sub reenlist {
my $self = shift;
my $target = $self->cell("PriorService", "Reenlist", $self->{Service});
my $try;
if ($self->Terms() >= 7){
print "After your seventh term, you must roll an exact 12 to reenlist.\n";
$try = 'Muster Out';
} else {
print "Your reenlistment target is $target.\n";
$try = $self->Callback->choose("Reenlist;Muster Out");
}
my $roll = $self->get_two_d_six();
if ($try eq 'Reenlist'){
if ($roll >= $target){
print "You successfully reenlisted!\n";
$self->Reenlisted(1);
} else {
print "You have been forced to muster out.\n";
$self->Reenlisted(0);
}
} else {
# Even if you want to muster out, you're back in on a 12.
if ($roll == 12){
print "You have been forced to reenlist!!\n";
$self->Reenlisted(1);
} else {
print "You have mustered out.\n";
$self->Reenlisted(0);
}
}
}
sub skills {
my $self = shift;
my $table;
if ($self->attribute("Education") >= 8){
$table = $self->Callback->choose("PersonalDevelopmentSkills;ServiceSkills;AdvancedSkills;HighlyAdvancedSkills");
} else {
$table = $self->Callback->choose("PersonalDevelopmentSkills;ServiceSkills;AdvancedSkills");
}
my $roll = $self->get_d_six();
my $skill = $self->cell($table, $roll, $self->{Service});
$self->raise($skill);
$self->{'SkillsToPick'}--;
$self->skills() if $self->SkillsToPick() > 0;
}
sub raise {
my ($self, $thing) = @_;
if (defined($self->attribute($thing))){
my $value = $self->attribute($thing);
$value++;
$self->attribute($thing, $value);
$self->display_attributes(" ($thing raised)");
} else {
$self->Skills->{$thing}++;
$self->display_skills($thing);
}
}
sub display_skills {
my ($self, $skill) = @_;
$skill = 'Nothing' unless $skill; # silly hack
my $comma;
my $star = '';
foreach my $key (sort keys %{$self->Skills}){
my $value = $self->Skills->{$key};
my $star = '*' if $key eq $skill;
print ", " if $comma;
print $star if $star; # can't print this in concatenation for some reason (?)
print "$key";
print $star if $star;
print "-$value";
$comma = 1;
$star = '';
}
print "\n";
}
sub display_benefits {
my ($self, $benefit) = @_;
$benefit = 'Nothing' unless $benefit; # silly hack
my $comma;
my $star = '';
foreach my $key (sort keys %{$self->Benefits}){
my $value = $self->Benefits->{$key};
my $star = '*' if $key eq $benefit;
print ", " if $comma;
print "$value " if $value > 1;
print $star if $star; # can't print this in concatenation for some reason (?)
print "$key";
print $star if $star;
$comma = 1;
$star = '';
}
print "\n";
}
# TODO: Can't set attribute to zero. (Doesn't matter technically, though!)
sub attribute {
my ($self, $att, $val) = @_;
for(0..5){
my $num = $_;
if ($self->AttributeNames->[$num] =~ /^$att/i){
my $silly = $self->AttributeValues->[$num];
$self->AttributeValues->[$num] = $val if $val;
return $self->AttributeValues->[$num];
}
}
#returns undef if attribute not found.
return undef();
}
sub process {
my ($self) = @_;
$self->Callback->process();
}
# The Environment should take care of this...
# But the Environment doesn't know about the CallBack object...
sub cell {
my $self = shift;
my $value = $self->Environment->cell(@_);
#Check ReadAsTable for any required translation/interpretation
$value = $self->Environment->ReadAsTable()->{$value} if $self->Environment->ReadAsTable()->{$value};
#Check Callback to resolve any required user input if we have semi-colons...
if ($value =~ /;/){
$value = $self->Callback->choose($value);
}
return $value;
}
sub generate {
my $self = shift;
$self->initialize();
$self->display_attributes();
$self->enlist();
$self->mainloop();
my $terms = $self->Terms();
print "You completed $terms terms.\n";
if ($self->Alive()){
$self->BenefitsToPick($self->Terms());
$self->{BenefitsToPick}++ if $self->Rank() >= 1;
$self->{BenefitsToPick}++ if $self->Rank() >= 3;
$self->{BenefitsToPick}++ if $self->Rank() >= 5;
print "You get $self->{BenefitsToPick} at rank $self->{Rank}.\n";
$self->benefits() if $self->BenefitsToPick() > 0;
} else {
print "You are dead.\n";
}
print "\nFinal Results:\n";
$self->display();
}
sub mainloop {
my $self = shift;
print "\n";
$self->survival();
if ($self->Alive()){
$self->{Terms}++;
if ($self->Terms() == 1){
$self->SkillsToPick(2);
} else {
$self->SkillsToPick($self->cell('PriorService', 'Skills', $self->{Service}));
}
# only check for commission if it hasn't been received
unless ($self->Commissioned()){
if ($self->Drafted() and $self->Terms() == 1){
print "No commission possible on first term if drafted.\n";
} else {
$self->commission();
}
}
$self->promotion() if $self->Commissioned();
print "You get to roll for $self->{SkillsToPick} skills this term.\n";
$self->skills();
$self->aging if $self->Terms() >= 4;
if ($self->Alive()){
$self->reenlist();
$self->mainloop if ($self->Reenlisted());
}
}
}
sub benefits {
my $self = shift;
my $choice;
if ($self->{CashRollsTaken} < 3){ # Up to three rolls
$choice = $self->Callback->choose("Benefits;Cash");
} else {
$choice = "Benefits";
}
if ($choice eq "Cash"){
my $roll = $self->get_d_six();
my $bonus = $self->cell("CashTable", $roll, $self->{Service});
print "You gained $bonus cash.\n";
$self->{Cash} += $bonus;
$self->{CashRollsTaken}++;
} else {
my $dm = 0;
if ($self->{Rank} >= 5){
$dm++ if $self->Callback->choose("Add One to Roll;Standard Die Roll") eq 'Add One to Roll';
}
my $roll = $self->get_d_six() + $dm;
my $benefit = $self->cell("BenefitsTable", $roll, $self->{Service});
my $amount = 1;
if ($benefit =~ /\+(\d)(\w+)/){
$benefit = $2;
$amount = +2;
}
if (defined($self->attribute($benefit))){
my $value = $self->attribute($benefit);
$value += $amount;
print "Your $benefit was raised by $amount.\n";
$self->attribute($benefit, $value);
} elsif ($benefit eq 'Blade' or $benefit eq 'Gun') {
print "You receive a weapon benefit!\n";
my $choice = $self->Callback->choose($self->Environment->ReadAsTable->{"$benefit Cbt"});
if ($self->Benefits->{$choice}) {
print "You're raising $choice skill by one level.\n";
$self->raise($choice);
} else {
$self->Benefits->{$choice}++;
}
} else {
print "You gained a $benefit.\n";
$self->Benefits->{$benefit}++;
}
}
$self->{BenefitsToPick}--;
$self->benefits() if $self->BenefitsToPick() > 0;
}
sub aging {
my $self = shift;
my $column = 4;
$column = 8 if $self->Terms() >= 8;
$column = 12 if $self->Terms() >= 12;
print "Checking for aging effects...\n";
my $roll = $self->get_two_d_six();
if ($roll < $self->cell('AgingTable', 'StrenSave', $column)){
my $loss = $self->cell('AgingTable', 'StrenPenalty', $column);
print "Stength dropped by $loss.\n";
$self->AttributeValues->[0] += $loss; #TODO: add attributes to raise routine
if ($self->AttributeValues->[0] <= 0){
$roll = $self->get_two_d_six();
if ($roll >= 8){
print "You survived your aging crisis.\n";
$self->AttributeValues->[0] = 1;
} else {
$self->Alive(0);
}
}
}
$roll = $self->get_two_d_six();
if ($roll < $self->cell('AgingTable', 'DextSave', $column)){
my $loss = $self->cell('AgingTable', 'DextPenalty', $column);
print "Dexterity dropped by $loss.\n";
$self->AttributeValues->[1] += $loss; #TODO: add attributes to raise routine
if ($self->AttributeValues->[1] <= 0){
$roll = $self->get_two_d_six();
if ($roll >= 8){
print "You survived your aging crisis.\n";
$self->AttributeValues->[1] = 1;
} else {
$self->Alive(0);
}
}
}
$roll = $self->get_two_d_six();
if ($roll < $self->cell('AgingTable', 'EndurSave', $column)){
my $loss = $self->cell('AgingTable', 'EndurPenalty', $column);
print "Endurance dropped by $loss.\n";
$self->AttributeValues->[2] += $loss; #TODO: add attributes to raise routine
if ($self->AttributeValues->[2] <= 0){
$roll = $self->get_two_d_six();
if ($roll >= 8){
print "You survived your aging crisis.\n";
$self->AttributeValues->[2] = 1;
} else {
$self->Alive(0);
}
}
}
$self->display();
}
###################################################################################################
package TestMe;
use strict;
use warnings;
my $C = new Character::();
$C->generate();
print "--------------------------------------------------------------------------------";
my $line = <STDIN>;
This is the data file for the program. Save it as “BookOne.dat”:
ReadCell "Blade Cbt" As "Dagger;Blade;Foil;Sword;Cutlass;Broadsword;Bayonet;Spear;Halberd;Pike;Cudgal"
ReadCell "Gun Cbt" As "Body Pistol;Auto Pistol;Revolver;Carbine;Rifle;Auto Rifle;Shotgun;SMG;Laser Carbine;Laser Rifle"
ReadCell "Vehicle" As "Grav Vehicle;Tracked Vehicle;Wheeled Vehicle;Prop-driven Fixed Wing;Jet-driven Fixed Wing;Jet-driven Fixed Wing;Helicopter;Large Watercraft;Small Watercraft;Hovercraft;Submersible"
Table Services:
ServiceName, ServiceNum
Navy, 1
Marines, 2
Army, 3
Scouts, 4
Merchants, 5
Other, 6
Table PriorService:
Property, 1, 2, 3, 4, 5, 6
ServiceName, Navy, Marines, Army, Scouts, Merchants, Other
Enlistment, 8, 9, 5, 7, 7, 3
EOneAtt, Intel, Intel, Dext, Intel, Stren, -
EOneVal, 8, 8, 6, 6, 7, -
ETwoAtt, Educ, Stren, Endur, Stren, Intel, -
ETwoVal, 9, 8, 5, 8, 6, -
Survival, 5, 6, 5, 7, 5, 5
STwoAtt, Intel, Endur, Educ, Endur, Intel, Intel
STwoVal, 7, 8, 6, 9, 7, 9
Commission, 10, 9, 5, -, 4, -
COneAtt, Social, Educ, Endur, -, Intel, -
COneVal, 9, 7, 7, -, 6, -
Promotion, 8, 9, 6, -, 10, -
POneAtt, Educ, Social, Educ, -, Intel, -
POneVal, 8, 8, 7, -, 9, -
Reenlist, 6, 6, 7, 3, 4, 5
Skills, 1, 1, 1, 2, 1, 1
Table Titles:
Rank, 1, 2, 3, 4, 5, 6
1, Ensign, Lieutenant, Lieutenant, -, 4th Officer, -
2, Lieutenant, Captain, Captain, -, 3rd Officer, -
3, Lt Cmdr, Force Cmdr, Major, -, 2nd Officer, -
4, Commander, Lt Colonel, Lt Colonel, -, 1st Officer, -
5, Captain, Colonel, Colonel, -, Captain, -
6, Admiral, Brigadier, General, -, Captain, -
Table BenefitsTable:
Roll, 1, 2, 3, 4, 5, 6
1, Low Psg, Low Psg, Low Psg, Low Psg, Low Psg, Low Psg
2, +1Intel, +2Intel, +1Intel, +2Intel, +1Intel, +1Intel
3, +2Educ, +1Educ, +2Educ, +2Educ, +1Educ, +1Educ
4, Blade, Blade, Gun, Blade, Gun, Gun
5, Travellers, Travellers, High Psg, Gun, Blade, High Psg
6, High Psg, High Psg, Mid Psg, Scout Ship, Low Psg, -
7, +2Social, +2Social, +1Social, -, Free Trader, -
Table CashTable:
Roll, 1, 2, 3, 4, 5, 6
1, 1000, 2000, 2000, 20000, 1000, 1000
2, 5000, 5000, 5000, 20000, 5000, 5000
3, 5000, 5000, 10000, 30000, 10000, 10000
4, 10000, 10000, 10000, 30000, 20000, 10000
5, 20000, 20000, 10000, 50000, 20000, 10000
6, 50000, 30000, 20000, 50000, 40000, 50000
7, 50000, 40000, 30000, 50000, 40000, 100000
Table RankAndServiceSkills:
Rank, 1, 2, 3, 4, 5, 6
0, -, Cutlass, Rifle, Pilot, -, -
1, -, Revolver, SMG, -, -, -
2, -, -, -, -, -, -
3, -, -, -, -, -, -
4, -, -, -, -, -, -
5, Social, -, -, -, Pilot, -
6, Social, -, -, -, -, -
Table PersonalDevelopmentSkills:
Roll, 1, 2, 3, 4, 5, 6
1, Stren, Stren, Stren, Stren, Stren, Stren
2, Dext, Dext, Dext, Dext, Dext, Dext
3, Endur, Endur, Endur, Endur, Endur, Endur
4, Intel, Gambling, Gambling, Intel, Stren, Blade Cbt
5, Educ, Brawling, Educ, Educ, Blade Cbt, Brawling
6, Social, Blade Cbt, Brawling, Gun Cbt, Bribery, Social
Table ServiceSkills:
Roll, 1, 2, 3, 4, 5, 6
1, Ships Boat, ATV, ATV, Air/Raft, Vehicle, Vehicle
2, Vacc Suit, Vacc Suit, Air/Raft, Vacc Suit, Vacc Suit, Gambling
3, Fwd Obsvr, Blade Cbt, Gun Cbt, Mechanical, Jack-o-T, Brawling
4, Gunnery, Gun Cbt, Fwd Obsvr, Navigation, Steward, Bribery
5, Blade Cbt, Blade Cbt, Blade Cbt, Electronics, Electronics, Blade Cbt
6, Gun Cbt, Gun Cbt, Gun Cbt, Jack-o-T, Gun Cbt, Gun Cbt
Table AdvancedSkills:
Roll, 1, 2, 3, 4, 5, 6
1, Vacc Suit, Vehicle, Vehicle, Vehicle, Streetwise, Streetwise
2, Mechanical, Mechanical, Mechanical, Mechanical, Mechanical, Mechanical
3, Electronics, Electronics, Electronics, Electronics, Electronics, Electronics
4, Engineering, Tactics, Tactics, Jack-o-T, Navigation, Gambling
5, Gunnery, Blade Cbt, Blade Cbt, Gunnery, Gunnery, Brawling
6, Jack-o-T, Gun Cbt, Gun Cbt, Medical, Medical, Forgery
Table HighlyAdvancedSkills:
Roll, 1, 2, 3, 4, 5, 6
1, Medical, Medical, Medical, Medical, Medical, Medical
2, Navigation, Tactics, Tactics, Navigation, Navigation, Forgery
3, Engineering, Tactics, Tactics, Engineering, Engineering, Electronics
4, Computer, Computer, Computer, Computer, Computer, Computer
5, Pilot, Leader, Leader, Pilot, Pilot, Streetwise
6, Admin, Admin, Admin, Jack-o-T, Admin, Jack-o-T
Table AgingTable:
Attribute, 4, 8, 12
StrenPenalty, -1, -1, -2
StrenSave, 8, 9, 9
DextPenalty, -1, -1, -2
DextSave, 7, 8, 9
EndurPenalty, -1, -1, -2
EndurSave, 8, 9, 9
IntelPenalty, 0, 0, -1
IntelSave, 2, 2, 9