Addeda bunch of small fixes

pinebook
silverwizard 5 years ago
parent 67bab9ba74
commit 526c6ddea6
  1. 35
      Cyberpunk.pl

@ -7,12 +7,13 @@ use constant depth => 10;
$ARGV[0] =~ s/ /_/g;
$ARGV[1] =~ s/ /_/g;
our @SEXES = ("Male", "Female", "Nonbinary", "Cyborg");
mkdir $ARGV[0], 0755 unless -d $ARGV[0];
foreach my $item ("Male", "Female", "Nonbinary", "Cyborg"){
foreach my $item (@SEXES){
mkdir $ARGV[0] . "/" . $item unless -d $ARGV[0] . "/" . $item;
}
generate($ARGV[0], $ARGV[1], 1);
generate($ARGV[0], $ARGV[1], 1,@SEXES);
sub generate {
my $CHAR;
@ -27,10 +28,10 @@ sub generate {
my $MA = roll(8,3);
my $EMP = roll(8,3);
my $BT = roll(8,3);
my $GENDER = table("Male", "Male", "Female", "Male", "Female", "Female", "Male", "Female", "Nonbinary", "Cyborg", "Gender");
my $GENDER = $_[3][roll(scalar @_[3]-1,0)];
my $SEX = table($GENDER, $GENDER, $GENDER, "Male", "Male", "Female", "Male", "Female", "Female", "Male", "Female", "Nonbinary", "Cyborg", "Sex");
my @ORIENTATION;
foreach my $item ("Male", "Female", "Nonbinary", "Cyborg"){
foreach my $item (@SEXES){
if(roll(2,1)>1){
push(@ORIENTATION, $item);
}
@ -70,8 +71,10 @@ sub generate {
}else{
printf $CHAR " twin";
}
my $ch = name($_[0],$_[1],0,0);
printf $CHAR " sibling, named " . $ch . " who ";
#my $ch = name($_[0],$_[1],0,0);
my $ch = name($_[0],$_[1],$_[2],@SEXES,0);
#printf $CHAR " sibling, named " . $ch . " who ";
printf $CHAR " sibling, named [" . $ch . "](" . $ch . ".html) who ";
$var = roll(10,1);
if(($var == 1)||($var == 2)){
printf $CHAR "dislikes you\n\n";
@ -152,7 +155,7 @@ sub generate {
last SWITCH;
};
$var == 6 && do {
printf $CHAR "Lover, friend, or relative killed. You lost someone you really cared about (named " . name($_[0],$_[1],$_[2],0) . ") ";
printf $CHAR "Lover, friend, or relative killed. You lost someone you really cared about (named " . name($_[0],$_[1],$_[2],@SEXES,0) . ") ";
my $how = roll(10,1);
if($how <= 5){
printf $CHAR "They died accidentally.\n\n";
@ -229,11 +232,11 @@ sub generate {
}elsif($var <= 6){
$var = roll(10,1);
if($var <= 5){
my $ch = name($_[0],$_[1],$_[2]);
my $ch = name($_[0],$_[1],$_[2],@SEXES);
printf $CHAR "You made a friend named [" . $ch . "](" . $ch . ".html).\n\n";
printf $CHAR table("They are like a big brother/sister to you.", "They are like a kid sister/brother to you.", "They are like a teacher or mentor.", "They are like a partner or co-worker.", "They're an old lover.", "They're an old enemy.", "They are like a foster parent to you.", "They're a relative.", "You've reconnected with an old childhood friend.", "You met through a common interest.", "Your relationship");
}else{
my $ch = name($_[0],$_[1],$_[2]);
my $ch = name($_[0],$_[1],$_[2],@SEXES);
printf $CHAR "You made an enemy named [" . $ch . "](" . $ch . ".html).\n\n";
printf $CHAR table("Ex friend.", "Ex lover.", "Relative.", "Childhood enemy.", "Person working for you.", "Person you work for.", "Partner or co-worker.", "Booster gang member.", "Corporate Exec.", "Government official.", "Who are they");
my $why = roll(10,1);
@ -293,7 +296,7 @@ sub generate {
}
}
}elsif($var <= 8){
my $ch = name($_[0],$_[1],$_[2]);
my $ch = name($_[0],$_[1],$_[2],@ORIENTATION);
printf $CHAR "You had a romance! With someone named [" . $ch . "](" . $ch . ".html).\n\n";
printf $CHAR romance();
}elsif($var <=10){
@ -311,7 +314,7 @@ sub generate {
printf $CHAR "MA: " . $MA . "\n";
printf $CHAR "EMP: " . $EMP . "\n";
printf $CHAR "BT: " . $BT . "\n\n";
printf $CHAR $GENDER;
printf $CHAR "Gender: " . $GENDER . "\n";
printf $CHAR $SEX;
printf $CHAR "Orientation: ";
foreach my $item (@ORIENTATION) {
@ -329,12 +332,12 @@ sub name{
my $name;
my $flip;
my $named = 0;
if(scalar @_ > 3){
$flip = $_[3];
if(scalar @_ > 4){
$flip = $_[4];
}else{
$flip = roll(10,1);
$flip = roll(depth*2,1);
}
if($flip >= 3 || $_[2] < depth){
if($flip <= $_[2] || $_[2] > depth){
$name = File::Random::random_file(-dir=>"$ARGV[0]");
$name =~ s/.md$//g;
if($name ne $_[1]){
@ -346,7 +349,7 @@ sub name{
$name =~ s/ /_/g;
chomp($name);
if($_[2] < depth){
generate($_[0], $name, $_[2]+1);
generate($_[0], $name, $_[2]+1,@SEXES);
}
}
return $name;

Loading…
Cancel
Save