diff --git a/bin/init_lacuna.pl b/bin/init_lacuna.pl index 66d5dddd..e0861c85 100644 --- a/bin/init_lacuna.pl +++ b/bin/init_lacuna.pl @@ -27,6 +27,8 @@ sub create_aux_domains { } } +my $lacunans; + sub create_species { my $species = $db->domain('species'); say "Deleting existing species domain."; @@ -37,7 +39,7 @@ sub create_species { $species->insert({ name => 'Human', description => 'A race of average intellect, and weak constitution.', - habitable_orbits => 3, + habitable_orbits => [3], construction_affinity => 4, # cost of building new stuff deception_affinity => 4, # spying ability research_affinity => 4, # cost of upgrading @@ -50,11 +52,30 @@ sub create_species { trade_affinity => 4, # speed of cargoships, and amount of cargo hauled growth_affinity => 4, # price and speed of colony ships, and planetary command center start level }, id=>'human_species'); + say "Adding Lacunans."; + $lacunans = $species->insert({ + name => 'Lacunan', + description => 'The economic dieties that control the Lacuna Expanse.', + habitable_orbits => [1,2,3,4,5,6,7], + construction_affinity => 1, # cost of building new stuff + deception_affinity => 7, # spying ability + research_affinity => 1, # cost of upgrading + management_affinity => 4, # speed to build + farming_affinity => 1, # food + mining_affinity => 1, # minerals + science_affinity => 4, # energy, propultion, and other tech + environmental_affinity => 4, # waste and water + political_affinity => 7, # happiness + trade_affinity => 7, # speed of cargoships, and amount of cargo hauled + growth_affinity => 1, # price and speed of colony ships, and planetary command center start level + }, id=>'lacunan_species'); } +my $lacunans_have_been_placed = 0; + sub create_star_map { - my $start_x = my $start_y = my $start_z = -5; - my $end_x = my $end_y = my $end_z = 5; + my $start_x = my $start_y = my $start_z = -1; + my $end_x = my $end_y = my $end_z = 1; my $star_count = abs($end_x - $start_x) * abs($end_y - $start_y) * abs($end_z - $start_z); my @star_colors = (qw(magenta red green blue yellow white)); my %domains; @@ -117,7 +138,7 @@ sub add_bodies { Lacuna::DB::Body::Asteroid::A4 Lacuna::DB::Body::Asteroid::A5); say "\tAdding bodies."; for my $orbit (1..7) { - my $name = $star->name."-".$orbit; + my $name = $star->name." ".$orbit; if (randint(1,100) <= 10) { # 10% chance of no body in an orbit say "\tNo body at $name!"; } @@ -149,6 +170,11 @@ sub add_bodies { my $body = $domains->{body}->insert($params); my $now = DateTime->now; if ($body->isa('Lacuna::DB::Body::Planet') && !$body->isa('Lacuna::DB::Body::Planet::GasGiant')) { + if ($star->x >= 0 && $star->y >= 0 && $star->z >= 0 && !$lacunans_have_been_placed) { + #create_lacuna_corp($body, $domains); + $lacunans_have_been_placed = 1; + next; + } say "\t\tAdding features to body."; foreach my $x (-3, -1, 2, 4, 1) { my $chance = randint(1,100); @@ -192,6 +218,17 @@ sub add_bodies { } } +sub create_lacuna_corp { + my ($body, $domains) = @_; + say "\t\t\tMaking this the Lacunans home world."; + my $empire = Lacuna::DB::Empire->found( + $db, + $body, + $lacunans, + {username=>'Lacuna Expanse Corp', password=>rand(9999999)}, + 'lacuna_expanse_corp' + ); +} sub get_star_names { my $star_count = shift; diff --git a/lib/Lacuna/DB/Empire.pm b/lib/Lacuna/DB/Empire.pm index 930ba85e..0bd159d1 100644 --- a/lib/Lacuna/DB/Empire.pm +++ b/lib/Lacuna/DB/Empire.pm @@ -4,6 +4,8 @@ use Moose; extends 'SimpleDB::Class::Item'; use DateTime; use Lacuna::Util; +use Digest::SHA; +use Lacuna::DB::Building::PlanetaryCommand; __PACKAGE__->set_domain_name('empire'); __PACKAGE__->add_attributes( @@ -25,7 +27,7 @@ __PACKAGE__->add_attributes( essentia => { isa => 'Int', default=>0 }, points => { isa => 'Int', default=>0 }, rank => { isa => 'Int', default=>0 }, # just where it is stored, but will come out of date quickly - probed_stars => { isa => 'Str' }, + probed_stars => { isa => 'ArrayRefOfStr' }, university_level => { isa => 'Int', default=>0 }, ); @@ -139,5 +141,60 @@ sub start_session { return $session; } +sub is_password_valid { + my ($self, $password) = @_; + return ($self->password eq $self->encrypt_password($password)) ? 1 : 0; +} +sub encrypt_password { + my ($self, $password) = @_; + return Digest::SHA::sha256_base64($password); +} + + +sub found { + my ($class, $simpledb, $home_planet, $species, $account, $empire_id) = @_; + + my %options; + if ($empire_id) { + $options{id} = $empire_id; + } + my $self = $simpledb->domain('empire')->insert({ + name => $account->{name}, + date_created => DateTime->now, + password => $class->encrypt_password($account->{password}), + species_id => $species->id, + home_planet_id => $home_planet->id, + probed_stars => [$home_planet->star->id], + }, %options); + + # set home planet + $home_planet->empire_id($self->id); + $home_planet->last_tick(DateTime->now); + $home_planet->put; + + # add command building + my $command = Lacuna::DB::Building::PlanetaryCommand->new(simpledb => $simpledb)->update({ + x => 0, + y => 0, + class => 'Lacuna::DB::Building::PlanetaryCommand', + date_created => DateTime->now, + body_id => $home_planet->id, + empire_id => $self->id, + level => $species->growth_affinity - 1, + }); + $home_planet->build_building($command); + $command->finish_upgrade; + $home_planet = $command->body; # our current reference is out of date + + # add starting resources + $home_planet->add_algae(5000); + $home_planet->add_energy(5000); + $home_planet->add_water(5000); + $home_planet->add_ore(5000); + $home_planet->put; + + return $self; +} + no Moose; __PACKAGE__->meta->make_immutable; diff --git a/lib/Lacuna/DB/Species.pm b/lib/Lacuna/DB/Species.pm index 6d0ce172..e7b6818f 100644 --- a/lib/Lacuna/DB/Species.pm +++ b/lib/Lacuna/DB/Species.pm @@ -14,7 +14,7 @@ __PACKAGE__->add_attributes( }, name_cname => { isa => 'Str' }, description => { isa => 'Str' }, - habitable_orbits => { isa => 'Int' }, + habitable_orbits => { isa => 'ArrayRefOfInt' }, construction_affinity => { isa => 'Int' }, # cost of building new stuff deception_affinity => { isa => 'Int' }, # spying ability research_affinity => { isa => 'Int' }, # cost of upgrading diff --git a/lib/Lacuna/Empire.pm b/lib/Lacuna/Empire.pm index 1e1162bd..8962d64e 100644 --- a/lib/Lacuna/Empire.pm +++ b/lib/Lacuna/Empire.pm @@ -4,8 +4,8 @@ use Moose; extends 'JSON::RPC::Dispatcher::App'; use Lacuna::Util qw(cname); use Lacuna::Map; -use Digest::SHA; use Lacuna::Verify; +use Lacuna::DB::Empire; has simpledb => ( is => 'ro', @@ -35,7 +35,7 @@ sub login { my ($self, $name, $password) = @_; my $empire = $self->simpledb->domain('empire')->search(where=>{name_cname=>cname($name)})->next; if (defined $empire) { - if ($empire->password eq $self->encrypt_password($password)) { + if ($empire->is_password_valid($password)) { return { session_id => $empire->start_session->id, status => $empire->get_full_status }; } else { @@ -63,15 +63,12 @@ sub create { $account{species_id} ||= 'human_species'; my $db = $self->simpledb; my $species = $self->simpledb->domain('species')->find($account{species_id}); - if ($account{species_id} eq '' || !$species) { + if ($account{species_id} eq '' || !$species || $account{species_id} eq 'lacunan_species') { confess [1002, 'Invalid species.', $account{species_id}]; } else { my $map = Lacuna::Map->new(simpledb=>$db); my $orbits = $species->habitable_orbits; - unless (ref $orbits eq 'ARRAY') { - $orbits = [$orbits]; - } my $possible_planets = $db->domain('Lacuna::DB::Body::Planet')->search( where => { empire_id => 'None', @@ -90,41 +87,7 @@ sub create { confess [1002, 'Could not find a home planet.']; } - # create empire - my $empire = $db->domain('empire')->insert({ - name => $account{name}, - date_created => DateTime->now, - password => $self->encrypt_password($account{password}), - species_id => $species->id, - home_planet_id => $home_planet->id, - probed_stars => $home_planet->star->id, - }); - - # set home planet - $home_planet->empire_id($empire->id); - $home_planet->last_tick(DateTime->now); - $home_planet->put; - - # add command building - my $command = Lacuna::DB::Building::PlanetaryCommand->new(simpledb => $empire->simpledb)->update({ - x => 0, - y => 0, - class => 'Lacuna::DB::Building::PlanetaryCommand', - date_created => DateTime->now, - body_id => $home_planet->id, - empire_id => $empire->id, - level => $species->growth_affinity - 1, - }); - $home_planet->build_building($command); - $command->finish_upgrade; - $home_planet = $command->body; # our current reference is out of date - - # add starting resources - $home_planet->add_algae(5000); - $home_planet->add_energy(5000); - $home_planet->add_water(5000); - $home_planet->add_ore(5000); - $home_planet->put; + my $empire = Lacuna::DB::Empire->found($self->simpledb, $home_planet, $species, \%account); # return status my $status = $empire->get_full_status; @@ -133,11 +96,6 @@ sub create { } } -sub encrypt_password { - my ($self, $password) = @_; - return Digest::SHA::sha256_base64($password); -} - sub get_status { my ($self, $session_id) = @_; return $self->get_empire_by_session($session_id)->get_status; diff --git a/lib/Lacuna/Map.pm b/lib/Lacuna/Map.pm index fcff9422..8d57feea 100644 --- a/lib/Lacuna/Map.pm +++ b/lib/Lacuna/Map.pm @@ -142,7 +142,7 @@ sub get_star_system { orbit => $body->orbit, }; } - if ($member || in($star->id, $empire->probed_stars)) { + if ($member || $star->id ~~ $empire->probed_stars) { return { star => { color => $star->color, @@ -193,7 +193,7 @@ sub get_stars { my @out; while (my $star = $stars->next) { my $alignment = 'unprobed'; - if (in($star->id, $empire->probed_stars)) { + if ($star->id ~~ $empire->probed_stars) { $alignment = 'probed'; my $bodies = $star->bodies; while (my $body = $bodies->next) { diff --git a/lib/Lacuna/Util.pm b/lib/Lacuna/Util.pm index 269e9620..e5a1ed00 100644 --- a/lib/Lacuna/Util.pm +++ b/lib/Lacuna/Util.pm @@ -18,18 +18,6 @@ sub to_seconds { return DateTime::Format::Duration->new(pattern=>'%s')->format_duration($duration); } -sub in { - my $value = shift; - my @list; - if (ref @_ eq 'ARRAY') { - @list = @{$_[0]}; - } - else { - @list = @_; - } - return any { $_ eq $value } @list; -} - sub randint { my ($low, $high) = @_; $low = 0 unless defined $low; diff --git a/t/Empire.t b/t/Empire.t index f1445bd6..71b12443 100644 --- a/t/Empire.t +++ b/t/Empire.t @@ -79,13 +79,13 @@ sub post { }; my $ua = LWP::UserAgent->new; $ua->timeout(10); - #say "REQUEST: " .to_json($content); + say "REQUEST: " .to_json($content); my $response = $ua->post('http://localhost:5000/'.$url, Content_Type => 'application/json', Content => to_json($content), Accept => 'application/json', ); - #say "RESPONSE: ".$response->content; + say "RESPONSE: ".$response->content; return from_json($response->content); }