#!/usr/bin/perl
use warnings;
use strict;
=head1 NAME
world.pl - This program is a functional rewrite of the program
"World Builder", by Stephen Kimmel, published in Creative Computing
in June 1983.
=head1 SYNOPSIS
world.pl [options]
Options:
--help brief help message
--man full documentation
--heat used to assign human max temp. (default 120 F).
=head1 VERSION
author David Myers
date 09/18/2008
modified 09/23/2008 (version B)
=head1 COPYRIGHT
The original code on which this program is based is Copyrighted
(C) 1983 by Stephen Kimmel. Anything else is Copyrighted (C) 2008
by David W. Myers. All rights are reserved. David Myers's code is
licensed using the Artistic license, version 2.0. A copy of the
Artistic license can be found here:
http://www.opensource.org/licenses/artistic-license-2.0.php
=head1 DESCRIPTION
world.pl - This program is a functional rewrite of the program
"World Builder", by Stephen Kimmel, published in Creative Computing
in June 1983. The reasons for the rewrite are twofold. The first is
because I had no choice; the code just made me do it. The second is
that over 25 years of time, the code is getting lost. Both copies
I could find of the original Basic suffered from scanning artifacts
and simple programming errors that rendered the programs less than
suitable for ordinary use.
Some features have been added. We have expanded the explanations of
human habitability. We allow people to see a list of stellar types
and the masses and colors associated with them. The menus should
be responsive to the commands 'known' (for known stars), 'new'
(for new stars), 'list' (to list known stars), 'classes' (to list
stellar types), 'quit' and 'bye', and at least one version of help
(requiring perldoc be installed). Partial matches are allowed on
menu items, and on the known star names (e.g. typing 'rig' will
match Rigel).
Some stars have been added. Among them are 51 Procyon, which has
a Jupiter sized giant planet orbiting at 0.052 astronomical units
from the star.
Stephen Kimmels original article (less any program listings) can be
found here:
http://www.atarimagazines.com/creative/v9n6/262_World_Builder_a_modest_p.php
=head1 CREDITS
I've spent my share of time at the Perl Monks site, and both ysth
and kyle there contributed code that I used (or abused) in this
project.
=cut
use Getopt::Long;
use Pod::Usage;
my $help = 0;
my $man = 0;
my $human_upper_limit = 120;
GetOptions(
'help|?' => \$help,
man => \$man,
"heat=i" => \$human_upper_limit,
) or pod2usage(2);
pod2usage( -exitval => 0, -verbose => 1 ) if $help;
pod2usage( -exitval => 0, -verbose => 2 ) if $man;
my @type_list = qw( O B A F G K M );
my %spectral_type;
my %known_stars;
my %ss;
my %planet;
my @moons;
my @solar_system;
my $state;
my $dispatch = {
LOAD => \&load_data,
MAIN => \&main_menu,
LIST => \&list_stars,
KNOWN => \&known_calc,
NEW => \&new_calc,
STARDAT => \&stellar_data,
PLANET => \&planet_calc,
MOON => \&moon_calc,
PLACON => \&planet_conclusion,
LIFE => \&life_calc,
SOLAR => \&solar_calc,
CLASSES => \&show_spectral_type,
HELP => \&show_help,
"QUIT" => sub { exit 0; },
};
$state = "LOAD";
my $data = "";
while ( $state ne "QUIT" ) {
if ( exists $dispatch->{$state} ) {
$state = $dispatch->{$state}->($data);
}
else {
print "State = \'$state\' and not found in dispatch table.\n";
exit 1;
}
}
exit 0;
sub load_data {
my $data = shift;
my $mode = "spectral";
while (<DATA>) {
chomp;
my @fields = split /\,/, $_;
if ( $_ =~ /SOL_LIKE_STARS/ ) {
$mode = "sol_like";
next;
}
if ( $_ =~ /FAMOUS_STAR/ ) {
$mode = "famous";
next;
}
if ( $mode eq "spectral" ) {
while (@fields) {
my $type = shift @fields;
my $mass = shift @fields;
my $color = shift @fields;
$spectral_type{$type}{mass} = $mass;
$spectral_type{$type}{color} = $color;
}
}
if ( $mode eq "sol_like" ) {
while (@fields) {
my $name = shift @fields;
my $type = shift @fields;
my $mass = shift @fields;
$known_stars{$name}{type} = $type;
$known_stars{$name}{mass} = $mass;
$known_stars{$name}{luminosity} = $mass**3.5;
}
}
if ( $mode eq "famous" ) {
while (@fields) {
my $name = shift @fields;
my $type = shift @fields;
my $luminosity = shift @fields;
$known_stars{$name}{type} = $type;
$known_stars{$name}{mass} = $luminosity**0.285714;
$known_stars{$name}{luminosity} = $luminosity;
}
}
}
return "MAIN";
}
sub main_menu {
my $data = shift;
my %choices = (
1 => "KNOWN",
2 => "NEW",
3 => "LIST",
4 => "QUIT",
'1' => "KNOWN",
'2' => "NEW",
'3' => "LIST",
'4' => "QUIT",
'classes' => "CLASSES",
'known' => "KNOWN",
'new' => "NEW",
'list' => "LIST",
'help' => "HELP",
'?' => "HELP",
'quit' => "QUIT",
'bye' => "QUIT",
);
my $a = 0;
my $done = 0;
my @choices = sort keys %choices;
do {
clear_screen();
print "WORLD BUILDER\n";
print "Enter the number for the option you want\n";
print "\n1....Use a known star\n";
print "2....Use a star not on list\n";
print "3....List known stars\n";
print "4....Quit\n\n";
print "YOUR CHOICE: ";
$a = <STDIN>;
chomp $a;
$a = lc($a);
$a = partial_match( $a, \@choices );
$done = 1 if ( exists $choices{$a} );
} until ($done);
return $choices{$a};
}
sub list_stars {
my $data = shift;
my @list;
for ( sort keys %known_stars ) {
push @list, $_;
}
clear_screen();
print "I know the following stars: \n";
my $max = scalar @list / 3;
for ( my $i = 0 ; $i < $max ; $i++ ) {
my $second = $i + $max;
my $third = $i + 2 * $max;
printf "%-20s %-20s %-20s\n", $list[$i], $list[$second], $list[$third];
}
return "KNOWN";
}
sub known_calc {
%ss = ();
my $star = shift;
unless ( exists $known_stars{$star} ) {
print "\nWhich star should I use: ";
$star = <STDIN>;
chomp($star);
$star = uc($star);
if ( $star eq "NONE" or $star !~ /\w+/ ) {
return "MAIN";
}
my @known_stars = keys %known_stars;
$star = partial_match( $star, \@known_stars );
unless ( exists $known_stars{$star} ) {
print "I don't know that star.\n";
sleep 1;
return "MAIN";
}
}
$ss{name} = $star;
$ss{type} = $known_stars{$star}{type};
if ( length( $ss{type} ) < 2 ) {
$ss{type_right} = 0.0;
}
else {
$ss{type_right} = substr( $ss{type}, -1 ) / 10.0;
}
$ss{type_left} = substr( $ss{type}, 0, 1 );
$ss{mass} = $known_stars{$star}{mass};
$ss{luminosity} = $known_stars{$star}{luminosity};
my $mass = $known_stars{$star}{mass};
my $lum = $known_stars{$star}{luminosity};
$ss{lifetime} = ( $mass**-2.5 ) * 10.0;
$ss{percentage} = ( 1.25 - $lum**0.285714 ) / $mass / 4.999762E-03;
if ( $ss{percentage} < 0.0 ) {
$ss{percentage} = 5.0;
}
$ss{fraction} = $ss{percentage} / 100.0;
if ( $ss{fraction} * $ss{lifetime} > 10.0 ) {
$ss{percentage} = 1000.0 / $ss{lifetime};
}
return "STARDAT";
}
sub new_calc {
my $data = shift;
%ss = ();
print "\nWHAT IS THE STAR'S NAME ";
my $name = <STDIN>;
chomp($name);
$ss{name} = $name;
print "WHAT IS THE STAR\'S SPECTRAL CLASS? ";
my $type = <STDIN>;
chomp($type);
$ss{type} = $type;
chomp($type);
if ( $type =~ /\w+/ ) {
split_type( \%ss );
unless ( exists $spectral_type{ $ss{type_left} } ) {
print "I don\'t know that class.\n";
sleep 1;
return "NEW";
}
my $delta_mass =
$spectral_type{ $ss{type_left} }{mass} -
$spectral_type{ next_type($type) }{mass};
$ss{mass} =
$spectral_type{ $ss{type_left} }{mass} -
( $ss{type_right} * $delta_mass );
}
else {
$ss{type} = undef;
print "WHAT IS THE ABSOLUTE MAGNITUDE (SUN=4.85) ";
my $mag = <STDIN>;
chomp($mag);
my $lum = exp( 4.4228 - 0.9195 * $mag );
$ss{luminosity} = $lum;
my $mass = $lum**0.285714;
$ss{mass} = $mass;
my $oldmass = 100000;
my $oldtype = "Z";
for (@type_list) {
my $currmass = $spectral_type{$_}{mass};
if ( $spectral_type{$_}{mass} < $mass ) {
$ss{type_left} = $oldtype;
$ss{type_right} =
int( 10 * ( $mass - $oldmass ) / ( $currmass - $oldmass ) ) /
10.0;
$ss{type} = get_type( \%ss );
last;
}
$oldmass = $spectral_type{$_}{mass};
$oldtype = $_;
}
}
$ss{lifetime} = ( $ss{mass}**-2.5 ) * 10.0;
my $slife;
my $bill;
if ( $ss{lifetime} < 1.0 ) {
$slife = pclean( 1000.0 * $ss{lifetime} );
$bill = 'million';
}
else {
$slife = pclean( $ss{lifetime} );
$bill = 'billion';
}
my $done;
my $percent = 1;
do {
$done = 1;
print "$name has an expected life of $slife $bill years.\n";
print "What percent (1-100) of this lifetime has already passed? ";
$percent = <STDIN>;
chomp($percent);
if ( $percent / 100.0 * $ss{lifetime} > 12.0 ) {
$done = 0;
print "The Big Bang occured 12 billion years ago.\n";
print "Is this what you want [yes/no] : ";
my $answer = <STDIN>;
$done = 1 if yesno($answer);
}
} until ($done);
$ss{percentage} = $percent;
$ss{mass} = $ss{mass} * ( 1.25 - 4.999762E-03 * $percent );
$ss{luminosity} = $ss{mass}**3.5;
return "STARDAT";
}
sub stellar_data {
my $stuff = shift;
my $temp = 6000 * $ss{mass}**0.35;
my $dia = $ss{mass}**0.3333;
$ss{temperature} = $temp;
$ss{diameter} = $dia;
$ss{fraction} = $ss{percentage} / 100.0;
my $byo = $ss{lifetime} * $ss{fraction};
my $color = $spectral_type{ $ss{type_left} }{color};
my $nextcolor = $spectral_type{ next_type( $ss{type_left} ) }{color};
clear_screen();
print "STELLAR DATA\n\n";
print "The selected star ", $ss{name}, " is a ", get_type( \%ss ), " star ";
if ( $ss{type_left} eq "M" or $ss{type_right} < 0.25 ) {
print " and is $color in color.\n";
}
elsif ( $ss{type_right} > 0.75 ) {
print " and is $nextcolor in color.\n";
}
else {
print " and is between $color and $nextcolor in color.\n";
}
my $name = $ss{name};
my $pmass = pclean( $ss{mass} );
my $plum = pclean( $ss{luminosity} );
print "$name has a mass of ", $pmass, " times that of the Sun.\n";
print "It is ", $plum, " times as bright as the Sun.\n";
my $bill = "billion";
my $plife = pclean( $ss{lifetime} );
if ( $ss{lifetime} < 0.1 ) {
$bill = "million";
$byo *= 1000;
$plife = pclean( 1000 * $ss{lifetime} );
}
print "The star has an expected lifespan of ", $plife;
print " $bill years,\n";
my $pper = pclean( $ss{percentage}, 1 );
print "of which it has lived ", $pper, "% or ";
$byo = pclean($byo);
print "$byo $bill years.\n";
if ( $ss{percentage} > 95.0 ) {
print "The star is in its death throes.\n";
}
my $ptemp = pclean( $temp, 1 );
print "It has a surface temperature of $ptemp degrees Kelvin";
if ( $ss{type_left} eq "O"
or ( ( $ss{type_left} eq "B" ) and ( $ss{type_right} < 0.5 ) )
or $ss{type_left} eq "M" )
{
print " and is believed to have no planets.\n";
}
else {
print " and may have planets.\n";
}
print "This star will die as a ";
if ( $ss{mass} < 1.5 ) {
print "white dwarf.\n";
}
elsif ( $ss{mass} < 4.0 ) {
print "neutron star.\n";
}
elsif ( $ss{mass} < 10.0 ) {
print "neutron star.\n";
}
else {
print "black hole after going super nova.\n";
}
print "Another star? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
if ( yesno($answer) ) {
return "MAIN";
}
return "PLANET";
}
sub planet_calc {
my %alternate_path = (
"mass" => 1,
"radius" => 1,
"orbit" => 1,
);
my @alts = keys %alternate_path;
clear_screen();
print "THE MAIN PLANET OF INTEREST\n\n";
print "Enter \'mass\' at the next prompt ";
print "to use alternate entry method.\n\n";
print "The Earth has an average surface temperature of 60 degrees.\n";
print "What surface temperature would you like? ";
my $temp = <STDIN>;
chomp($temp);
lc($temp);
$temp = partial_match( $temp, \@alts );
unless ( exists $alternate_path{$temp} ) {
$temp += 460.0;
$planet{temp} = $temp;
my $gravity;
do {
print "Desired surface gravity (Earth = 1): ";
$gravity = <STDIN>;
chomp($gravity);
if ( $gravity <= 0.0 ) {
print "This planet must have some gravity.\n";
}
} until ( $gravity > 0 );
$planet{gravity} = $gravity;
$planet{orbital_radius} = sqrt( $ss{luminosity} / ( $temp / 520 )**4 );
if ( $planet{orbital_radius} < $ss{mass} / 5.0 ) {
print "This planet is too close to the star to be stable.\n";
sleep 2;
return "PLANET";
}
$planet{orbital_period} =
sqrt( $planet{orbital_radius}**3 / $ss{mass} );
$planet{radiation_max} = 0.00012 * $ss{temperature};
$planet{radiation_min} =
6.452001E-02 * exp( 0.0005 * $ss{temperature} );
$ss{apparent_size} = $ss{diameter} / $planet{orbital_radius};
print "How big should the planet be relative to the Earth? ";
my $dia = <STDIN>;
chomp($dia);
$planet{diameter} = $dia;
my $mass = $gravity * $dia**2;
$planet{mass} = $mass;
}
else {
print "\nHow massive is this planet? ";
my $mass = <STDIN>;
chomp($mass);
print "What is the orbital radius of this planet? (EARTH = 1) ";
my $radius = <STDIN>;
chomp($radius);
$planet{orbital_radius} = $radius;
if ( $planet{orbital_radius} < $ss{mass} / 5.0 ) {
print "This planet is too close to the star to be stable.\n";
sleep 2;
return "PLANET";
}
my $temp = 520.0 * ( $ss{luminosity} / $radius**2 )**0.25;
$planet{temp} = $temp;
$planet{orbital_period} =
sqrt( $planet{orbital_radius}**3 / $ss{mass} );
$planet{radiation_max} = 0.00012 * $ss{temperature};
$planet{radiation_min} =
6.452001E-02 * exp( 0.0005 * $ss{temperature} );
$ss{apparent_size} = $ss{diameter} / $planet{orbital_radius};
print "How big should the planet be relative to the Earth? ";
my $dia = <STDIN>;
chomp($dia);
$planet{diameter} = $dia;
my $gravity = $mass / $dia**2;
$planet{mass} = $mass;
$planet{gravity} = $gravity;
}
if ( $planet{mass} < 0.055 ) {
print "The planet won\'t retain an oxygen atmosphere.";
}
if ( $planet{mass} > 17.6 ) {
print "The planet won\'t lose its hydrogen atmosphere.";
}
print "The Earth\'s orbit has an eccentricity of 0.01672\n";
my $ecc;
do {
print "What is the orbital eccentricity (< 1)? ";
$ecc = <STDIN>;
chomp($ecc);
} until ( $ecc >= 0.0 and $ecc < 1.0 );
$planet{eccentricity} = $ecc;
$planet{closest_approach} = ( 1.0 - $ecc ) * $planet{orbital_radius};
$planet{farthest_approach} = ( 1.0 + $ecc ) * $planet{orbital_radius};
my $tilt;
do {
print "How does the axis tilt (Earth = 23.5 degrees) ";
$tilt = <STDIN>;
chomp($tilt);
} until ( $tilt >= 0.0 and $tilt <= 90.0 );
$planet{tilt} = $tilt;
return "MOON";
}
sub moon_calc {
@moons = ();
print "How many moons does the planet have? ";
$planet{moon_count} = <STDIN>;
chomp( $planet{moon_count} );
if ( $planet{moon_count} > 10 ) {
print "For convenience we'll limit this to 10.\n";
$planet{moon_count} = 10;
}
my $inner_period = 1000;
my $hr_calc = 0;
my $max_radius = 56 * $planet{gravity};
my $min_radius = 3 * $planet{gravity};
my $inner_radius = $max_radius;
for ( 1 .. $planet{moon_count} ) {
print "Mass of Moon #$_ (Our Moon = 1) ";
my $moon_mass = <STDIN>;
chomp($moon_mass);
my $moon_orbit;
do {
print "Orbit (Our Moon = 30) ";
$moon_orbit = <STDIN>;
chomp($moon_orbit);
if ( $moon_orbit < $min_radius ) {
print "The moon is too close and will break up.\n";
}
if ( $moon_orbit > $max_radius ) {
print "The moon is too far and will drift away.\n";
}
} until ( $moon_orbit >= $min_radius and $moon_orbit <= $max_radius );
my $moon_period = sqrt( $moon_orbit**3 / $planet{mass} ) * 4;
if ( $moon_orbit < $inner_radius ) {
$inner_period = $moon_period;
$inner_radius = $moon_orbit;
}
$hr_calc += $moon_mass * 0.01235 / ( $moon_orbit**3 );
push @moons, [ $moon_orbit, $moon_mass, $moon_period ];
}
my $hr_calc_21 = 0.8499847 * $planet{diameter}**4 / $planet{mass};
my $hr_calc_22 =
$ss{mass} * 333484.0 / ( 11750 * $planet{orbital_radius} )**3;
my $hr_calc_2 = $hr_calc_21 * ( $hr_calc_22 + $hr_calc );
$planet{day} = 1759260.0 * $hr_calc_2 * 14.0 + 10;
$planet{day} = $inner_period if ( $planet{day} > $inner_period );
$planet{year} = 8766 / $planet{day} * $planet{orbital_period};
$planet{daily_high} =
( 1 + 0.025 * $planet{day} / 24 ) * $planet{temp} - 460;
$planet{daily_low} =
( 1 - 0.025 * $planet{day} / 24 ) * $planet{temp} - 460;
$planet{daily_low} = -460 if ( $planet{daily_low} < -460 );
my $ecc_fac = ( 1 + $planet{eccentricity} )**2;
$planet{summer_high} = $planet{daily_high} + 1.9 * $planet{tilt} * $ecc_fac;
$planet{winter_low} = $planet{daily_low} - 1.9 * $planet{tilt} / $ecc_fac;
$planet{winter_low} = -460 if ( $planet{winter_low} < -460 );
clear_screen();
my $day = pclean( $planet{day} );
my $year = pclean( $planet{year} );
print "This planet\'s day should be about $day hours long.\n";
print "That makes its year $year planetary days long.\n";
print "The planet\'s axis tilts ", $planet{tilt}, " degrees.\n";
my $hi = pclean( $planet{daily_high} );
my $lo = pclean( $planet{daily_low} );
my $summer_high = pclean( $planet{summer_high} );
my $winter_low = pclean( $planet{winter_low} );
print "Today\'s expected high temperature should be $hi degrees F.\n";
print "Today\'s expected low is $lo degrees F.\n";
print "This summer we expect it to get up to $summer_high degrees F.\n";
print "This winter it should drop down to $winter_low degrees F.\n";
if ( $summer_high < 32 or $winter_low > 175 ) {
print "There are times when no liquid water exists.\n";
}
if ( $planet{moon_count} > 0 ) {
print "\nYOUR SELECTED SET OF MOONS\n";
printf "%-20s %-20s %-20s\n", "ORBIT", "MASS", "PERIOD";
for ( sort { $a->[0] <=> $b->[0] } @moons ) {
my $period = $_->[2] / $planet{day};
printf "%-20.3f %-20.3f %-20.3f days\n", $_->[0], $_->[1], $period;
}
}
print "Want a different set of moons? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
$state = "PLACON";
$state = "MOON" if yesno($answer);
return $state;
}
sub planet_conclusion {
clear_screen();
print "PLANETARY DATA\n";
my $ptemp = pclean( $planet{temp} - 460 );
print "Our principal planet of interest has\nan average surface ";
print "temperature of $ptemp degrees F.\nThis requires an orbit ";
my $porbit = pclean( $planet{orbital_radius} );
print "of $porbit astronomical units (", $porbit * 93, " million miles)\n";
my $close = pclean( $planet{closest_approach} );
my $far = pclean( $planet{farthest_approach} );
print "Closest approach = $close AU; Greatest distance = $far AU.\n";
my $year = pclean( $planet{orbital_period} );
print "This means that is has a year that is $year years long.\n";
my $size = pclean( $ss{apparent_size} );
print "The star appears ";
if ( $size > 0.98 and $size < 1.02 ) {
print "about the same size as our Sun.\n";
}
else {
print "much " if ( $size > 1.5 or $size < 0.75 );
$size > 1.0 ? print "larger " : print "smaller ";
print "than our Sun.\n";
}
if ( $planet{gravity} > 0.95 and $planet{gravity} < 1.05 ) {
print "Gravity is essentially the same as Earth\'s.\n";
}
elsif ( $planet{gravity} > 1.0 ) {
print "Since our planet has a gravity greater than Earth\'s ";
print "we expect a thicker atmosphere. There is greater ";
print "tectonic action and much greater resisting forces. ";
print "Earthquakes should be more frequent and more severe.\n";
}
else {
print "Since our planet has a gravity less than Earth\'s ";
print "we expect a thinner atmosphere. There is less tectonic ";
print "and less resisting forces. Earthquakes, if any, would be ";
print "less severe.\n";
}
my $pgrav = pclean( $planet{gravity} );
print "A gravity of $pgrav means that if you weigh 200 pounds on ";
print "Earth you would weigh ", $pgrav * 200, " pounds on our planet.\n";
print "\nWould you like a new planet? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
$state = "LIFE";
$state = "PLANET" if yesno($answer);
return $state;
}
sub life_calc {
clear_screen();
print "LIFE???\n\n";
my $badmass = ( $planet{mass} < 0.055 or $planet{mass} > 17.6 );
my $maxrad = $planet{orbital_radius} < $planet{radiation_max};
my $minrad = $planet{orbital_radius} > $planet{radiation_min};
my $nowater = ( $planet{summer_high} < 32 or $planet{winter_low} > 175 );
my $stellar_age = $ss{lifetime} * $ss{fraction};
my $tooyoung = ( $stellar_age < 1.5 );
my $dying = ( $ss{percentage} > 95 );
if ( $badmass or $maxrad or $minrad or $nowater or $tooyoung or $dying ) {
print "Because ";
print "of the bad atmosphere, " if $badmass;
print "of the level of radiation, " if $maxrad;
print "of the lack of radiation, " if $minrad;
print "liquid water never occurs, " if $nowater;
print "the planet is too young to have evolved life, " if $tooyoung;
print "the star is in its death throes, " if $dying;
print "there appears to be no life on this planet.\n";
}
else {
my $temp = $planet{temp} - 460;
if ( $stellar_age < 4.4 * $planet{gravity} ) {
print "There may be some ";
if ( $stellar_age < 2 * $planet{gravity} ) {
print "bacteria and blue green algae.\n";
}
elsif ( $stellar_age < 3 * $planet{gravity} ) {
print "single cell life with nucleus.\n";
}
elsif ( $stellar_age < 4 * $planet{gravity} ) {
print "simple multicelled life.\n";
}
else {
print "water vertebrates and land plants.\n";
}
}
else {
print "There may be some major land animals ";
print "and perhaps intelligence.\n";
if ( $planet{gravity} > 1.05 ) {
print "Higher gravity means a thicker atmosphere which ";
print "support large birds. It also means that short falls ";
print "could be fatal so reaction times should be very short.";
print " All life forms will be shorter and stockier ";
print "than on Earth. ";
print "There are no two legged animals. "
if ( $planet{gravity} > 1.199969 );
print
"The thick atmosphere improves sound transmission so the ";
print "animals may rely more on hearing.\n";
}
elsif ( $planet{gravity} < 0.95 ) {
print "Lower gravity means thinner atmosphere. Birds, if any, ";
print
"will have larger wings. All life forms should be taller ";
print "and more slender than on Earth. ";
print "There are probably many two legged animals. ";
print
"The thin atmosphere hurts sound transmission so animals ";
print
"will either have large ears or none. Lungs will be much ";
print "larger. ";
print "Some form of radiation protection will be necessary."
if ( $temp > 75 );
print "\n";
}
if ( $ss{apparent_size} < 0.75 ) {
print "Because of the small sun, we expect animals ";
print "to have large eyes or rely on other senses.\n";
}
elsif ( $ss{apparent_size} > 1.5 ) {
print "Because of the large sun, unless the atmosphere ";
print "is obscured, we expect reliance on sight using ";
print "relatively small eyes.\n";
}
my $delta_temp = $planet{daily_high} - $planet{daily_low};
if ( $delta_temp > 50 ) {
print "Extreme temperature variations favor underground ";
print "or underwater life forms.\n";
}
}
my $toocold = $temp < 32;
my $toowarm = $temp > 86;
my $maxgrav = $planet{gravity} > 1.5;
my $mingrav = $planet{gravity} < 0.68;
my $minmass = $planet{mass} < 0.4;
my $maxmass = $planet{mass} > 2.35;
my $maxday = $planet{day} > 96;
my $hotsummer = $planet{summer_high} > $human_upper_limit;
my $coldwinter = $planet{winter_low} < -60;
my $hotday = $planet{daily_high} > $human_upper_limit;
my $coldday = $planet{daily_low} < -10;
$planet{habitable} = 1;
if ( $toocold
or $toowarm
or $maxgrav
or $mingrav
or $minmass
or $maxmass
or $maxday
or $hotsummer
or $coldwinter
or $hotday
or $coldday )
{
$planet{habitable} = 0;
print "Because ";
print "the planet is too cold, " if $toocold;
print "the planet is too warm, " if $toowarm;
print "the planet has too much gravity, " if $maxgrav;
print "the planet has too little gravity, " if $mingrav;
print "the planet is too small, " if $minmass;
print "the planet is too large, " if $maxmass;
print "the day is too long, " if $maxday;
print "the summer is too hot, " if $hotsummer;
print "the winter is too cold, " if $coldwinter;
print "the day gets too hot, " if $hotday;
print "the night gets too cold, " if $coldday;
print "this planet wouldn't be ";
print "considered habitable by man.\n";
}
else {
print "This planet might be ";
print "considered habitable by man.\n";
}
}
print "\nWould you like a new planet? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
$state = "SOLAR";
$state = "PLANET" if yesno($answer);
return $state;
}
sub solar_calc {
@solar_system = ();
clear_screen();
print "OTHER PLANETS\n\n";
print "How many planets would you like : ";
my $planet_count = <STDIN>;
chomp($planet_count);
if ( $planet_count > 15 ) {
print "For convenience we'll limit this to 15.\n";
$planet_count = 15;
}
if ( $planet_count > 0 ) {
my $max_mass =
1179 / sqrt( $ss{mass} ) -
$planet{mass} * sqrt( $planet{orbital_radius} );
push @solar_system, [ $planet{orbital_radius}, $planet{mass} ];
clear_screen();
print "Our solar system is laid out like this:\n\n";
printf "%-20s %-20s %-20s\n", "PLANET", "MASS", "DISTANCE FROM SUN";
printf "%-20s %-20.3f %-20.3f\n", "MERCURY", 0.055, 0.387;
printf "%-20s %-20.3f %-20.3f\n", "VENUS", 0.815, 0.723;
printf "%-20s %-20.3f %-20.3f\n", "EARTH", 1.0, 1.0;
printf "%-20s %-20.3f %-20.3f\n", "MARS", 0.108, 1.534;
printf "%-20s %-20.3f %-20.3f\n", "JUPITER", 317.9, 5.203;
printf "%-20s %-20.3f %-20.3f\n", "SATURN", 95.2, 9.539;
printf "%-20s %-20.3f %-20.3f\n", "URANUS", 14.6, 19.18;
printf "%-20s %-20.3f %-20.3f\n", "NEPTUNE", 17.2, 30.06;
printf "%-20s %-20.3f %-20.3f\n", "PLUTO", 0.100, 39.44;
if ( $planet_count > 1 ) {
my $pmass;
my $dist;
my $too_close = $ss{mass} / 25;
my $too_far = 56 * $ss{mass};
for ( 2 .. $planet_count ) {
my $okay = 1;
do {
$okay = 1;
print "Mass for planet # $_ of $planet_count : ";
$pmass = <STDIN>;
chomp($pmass);
if ( $pmass > 1000.0 ) {
print "A body this large would become a star.\n";
$okay = 0;
}
if ($okay) {
print "Distance from star : ";
$dist = <STDIN>;
chomp($dist);
if ( $dist < $too_close ) {
print "The planet is too close to the Sun\n";
$okay = 0;
}
if ( $dist > $too_far ) {
print "The planet is too far from the Sun\n";
$okay = 0;
}
}
if ($okay) {
for (@solar_system) {
if ( $dist > 0.9 * $_->[0]
and $dist < 1.1 * $_->[0] )
{
$okay = 0;
print "This planet is too close to other ";
print "planets to have a stable orbit.\n";
last;
}
}
}
if ($okay) {
my $mass_check = $pmass * sqrt($dist);
if ( $mass_check > $max_mass ) {
print
"this planet has too much mass for this system.\n";
$okay = 0;
}
else {
$max_mass -= $mass_check;
}
}
} until ($okay);
push @solar_system, [ $dist, $pmass ];
}
}
my $count = 0;
printf "%-20s %-20s %-20s\n", "PLANET", "MASS", "ORBIT";
for ( sort { $a->[0] <=> $b->[0] } @solar_system ) {
$count++;
my $radius = sprintf "%-20.3f", $_->[0];
$radius =~ s/\s+//g;
$radius .= ' LIFE?'
if ( $_->[0] > $planet{radiation_max}
and $_->[0] < $planet{radiation_min}
and $_->[1] > 0.055
and $_->[1] < 17.6 );
printf "%-20d %-20.3f %-20s\n", $count, $_->[1], $radius;
}
print "\nWould you like another solar system? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
if ( yesno($answer) ) {
$state = "SOLAR";
return $state;
}
}
print "\nWould you like to try again? [yes|no] ";
my $answer = <STDIN>;
chomp($answer);
$state = "QUIT";
$state = "MAIN" if yesno($answer);
return $state;
}
sub show_spectral_type {
clear_screen();
print "SPECTRAL TYPES:\n\n";
printf "%-20s %-20s %-20s\n\n", "TYPE", "MASS", "COLOR";
for (@type_list) {
printf "%-20s %-20.3f %-20s\n", $_, $spectral_type{$_}{mass},
$spectral_type{$_}{color};
}
print "\n\nPress enter to continue : ";
my $answer = <STDIN>;
return "MAIN";
}
sub show_help {
my $script = $0;
system("perldoc $script");
return "MAIN";
}
sub yesno {
my $answer = shift;
$answer = lc($answer);
return 1 if ( $answer =~ /^y/ );
return 0;
}
sub pclean {
my $num = shift;
my $digits = shift || 3;
my $format = "%20." . $digits . "f";
$num = sprintf $format, $num;
$num =~ s/\s+//g;
return $num;
}
sub next_type {
my $type = shift;
$type = uc($type);
$type = substr( $type, 0, 1 )
if ( length($type) > 1 );
return "D" if ( $type eq "M" );
my @temp = @type_list;
while (@temp) {
my $list = shift @temp;
last if ( $type eq $list );
}
return shift @temp;
}
sub last_type {
my $type = shift;
$type = uc($type);
$type = substr( $type, 0, 1 )
if ( length($type) > 1 );
my @temp = @type_list;
my $oldtype = "Z";
while (@temp) {
my $list = shift @temp;
last if ( $type eq $list );
$oldtype = $list;
}
return $oldtype;
}
sub get_type {
my $hashref = shift;
return $hashref->{type} if ( defined $hashref->{type} );
my $string = sprintf "%s%d", $hashref->{type_left},
int( 0.5 + 10.0 * $hashref->{type_right} );
return $string;
}
sub split_type {
my $hashref = shift;
return unless ( exists $hashref->{type} );
my $type = $hashref->{type};
$hashref->{type_left} = substr( $hashref->{type}, 0, 1 );
if ( length( $hashref->{type} ) < 2 ) {
$hashref->{type_right} = 0.0;
}
else {
$hashref->{type_right} = ( substr( $hashref->{type}, -1 ) / 10.0 );
}
}
sub partial_match {
my $string = shift;
my $aref = shift;
my @temp = ();
for ( @{$aref} ) {
my $len = length($string);
if ( $string eq substr( $_, 0, $len ) ) {
push @temp, $_;
}
}
return $temp[0] if ( scalar @temp == 1 );
return $string;
}
sub clear_screen {
system( $^O =~ /Win32/ ? "cls" : "clear" );
}