ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/maps/perl/rent.ext
(Generate patch)

Comparing deliantra/maps/perl/rent.ext (file contents):
Revision 1.1 by root, Mon Sep 18 00:40:30 2006 UTC vs.
Revision 1.9 by root, Tue Dec 12 16:59:34 2006 UTC

… …
2 2
3use List::Util; 3use List::Util;
4 4
5my %apartment = ( 5my %apartment = (
6 "/scorn/apartment/apartments" => [ 1, "scorn", "skorn"], 6 "/scorn/apartment/apartments" => [ 1, "scorn", "skorn"],
7 "/santo/dominion/sdomino/appartment" => [ 10, "santo dominion", "domino"], 7 "/santo_dominion/sdomino_appartment" => [ 10, "santo dominion", "domino"],
8 "/darcap/darcap/apartment" => [ 30, "darcap", "thecap"], 8 "/darcap/darcap/apartment" => [ 30, "darcap", "thecap"],
9 "/navar_city/apartments/apartment" => [ 250, "navar", "navar"], 9 "/navar_city/apartments/apartment" => [ 250, "navar", "navar"],
10 "/azumauindo/ranbounagisatoshi/apartments/sapartment" => [ 100, "乱暴渚都市", "benjo"], 10 "/azumauindo/ranbounagisatoshi/apartments/sapartment" => [ 100, "乱暴渚都市", "benjo"],
11 "/azumauindo/suno-yamatoshi/apartments/lapartment1" => [ 1000, "スノー大和島根", "sama"], 11 "/azumauindo/suno-yamatoshi/apartments/lapartment1" => [ 1000, "スノー大和島根", "sama"],
12 "/pup_land/nurnberg/apartment/main" => [ 300, "nürnberg", "sauerkraut"], 12 "/pup_land/nurnberg/apartment/main" => [ 300, "nürnberg", "sauerkraut"],
13 "/pup_land/lone_town/apartment/groundfloor" => [50000, "lone town", "looney"], 13 "/pup_land/lone_town/apartment/groundfloor" => [50000, "lone town", "looney"],
14 "/brest/apartments/brest/town/house" => [30000, "brest", "brecht"], 14 "/brest/apartments/brest_town_house" => [30000, "brest", "brecht"],
15); 15);
16 16
17sub teleport { 17sub teleport {
18 my ($pl, $map, $x, $y) = @_; 18 my ($pl, $map, $x, $y) = @_;
19 19
… …
21 21
22 $portal->slaying ($map); 22 $portal->slaying ($map);
23 $portal->stats->hp ($x); 23 $portal->stats->hp ($x);
24 $portal->stats->sp ($y); 24 $portal->stats->sp ($y);
25 $portal->apply ($pl->ob); 25 $portal->apply ($pl->ob);
26 $portal->free; 26 $portal->destroy;
27}
28
29# we have to special case some special cases :)
30sub reject_entry {
31 my ($pl) = @_;
32
33 cf::override;
34
35 teleport $pl, "/world/world_105_115", 2, 34
36 unless
37 $pl->ob->map
38 && $pl->ob->map->path !~ /nimbus/
39 && $pl->ob->map->path !~ m%/var/crossfire/players/%;
27} 40}
28 41
29sub update_balance { 42sub update_balance {
30 my ($pl) = @_; 43 my ($pl) = @_;
31 44
… …
35 my $offline = (List::Util::min 30, ($NOW - $pl->{rent}{last_offline_check}) / 86400) 48 my $offline = (List::Util::min 30, ($NOW - $pl->{rent}{last_offline_check}) / 86400)
36 * (cf::exp_to_level $pl->ob->stats->exp) 49 * (cf::exp_to_level $pl->ob->stats->exp)
37 * scalar keys %{ $pl->{rent}{apartment} }; 50 * scalar keys %{ $pl->{rent}{apartment} };
38 51
39 # once per hour per map rented 52 # once per hour per map rented
40 my $online = ($NOW - $pl->{rent}{last_offline_check}) / 3600 53 my $online = ($NOW - $pl->{rent}{last_online_check}) / 3600
41 * List::Util::sum map $apartment{$_}[0], keys %{ $pl->{rent}{apartment} }; 54 * List::Util::sum map $apartment{$_}[0], keys %{ $pl->{rent}{apartment} };
42 55
43 #TODO: add to {balance} 56 $pl->{rent}{last_offline_check} = $NOW;
44 warn "off $offline on $online\n";#d# 57 $pl->{rent}{last_online_check} = $NOW;
58
59 $pl->{rent}{balance} += $offline + $online;
45} 60}
46 61
47sub pay_balance { 62sub pay_balance {
48 my ($pl) = @_; 63 my ($pl) = @_;
49 64
50 #TODO: rob the bank if balance > 0 65 update_balance $pl;
66
67 return unless $pl->{rent}{balance} > 0;
68
69 my $deduct = cf::ceil $pl->{rent}{balance};
70
71 my $deduct_string = cf::cost_string_from_value $deduct;
72
73 if ($deduct <= $pl->ob->{bank_balance}) {
74 cf::db_put rent => balance => $deduct + cf::db_get rent => "balance";
75 $pl->ob->{bank_balance} -= $deduct;
76 $pl->{rent}{balance} -= $deduct;
77 $pl->ob->reply (undef, "Something whispers into your ear:\n"
78 . "Sir, we deducted your apartment rent ($deduct_string) from your bank account.");
79 } else {
80 $pl->ob->reply (undef, "Something whispers into your ear:\n"
81 . "Sir, we want to deduct the apartment rent ($deduct_string), but the bank informed us that they cannot perform the transaction. "
82 . "Please even out your balance so we can deduct the fees, otherwise we will be forced to shut down your access to the apartment.");
83 }
84}
85
86sub check_balance {
87 my ($pl) = @_;
88
89 pay_balance $pl if $pl->{rent}{balance} > 0;
90
91 $pl->{rent}{balance} <= 0
51} 92}
52 93
53sub find_apartment { 94sub find_apartment {
54 my ($pl, $name) = @_; 95 my ($pl, $name) = @_;
55 96
56 #TODO: find apartment or reply with error 97 my $apartment = (grep $apartment{$_}[2] eq $name, keys %apartment)[0]
98 or $pl->ob->reply (undef, "Sorry, but we do not offer model '$name' for rent.");
99
100 $apartment
57} 101}
58 102
59cf::register_script_function "rent::overview" => sub { 103cf::register_script_function "rent::overview" => sub {
60 my ($pl, $types) = @_; 104 my ($pl, $types) = @_;
61 105
… …
79}; 123};
80 124
81cf::register_script_function "rent::rent" => sub { 125cf::register_script_function "rent::rent" => sub {
82 my ($pl, $apartment) = @_; 126 my ($pl, $apartment) = @_;
83 127
84 $apartment = find_apartment $apartment 128 $apartment = find_apartment $pl, $apartment
85 or return; 129 or return;
86 130
87 update_balance $pl; 131 update_balance $pl;
88 132
89 $pl->{rent}{apartment}{$apartment} = undef; 133 $pl->{rent}{apartment}{$apartment} = undef;
134
135 $pl->ob->reply (undef, "Wonderful decision, sir! "
136 . "We told the proprietor in $apartment{$apartment}[1] to expect you and let you in. "
137 . "We are sure you will be satisfied!");
90}; 138};
91 139
92cf::register_script_function "rent::stop" => sub { 140cf::register_script_function "rent::stop" => sub {
93 my ($pl, $apartment) = @_; 141 my ($pl, $apartment) = @_;
94 142
95 $apartment = find_apartment $apartment 143 $apartment = find_apartment $pl, $apartment
96 or return; 144 or return;
97 145
98 update_balance $pl; 146 update_balance $pl;
99 147
100 delete $pl->{rent}{apartment}{$apartment}; 148 delete $pl->{rent}{apartment}{$apartment};
149
150 $pl->ob->reply (undef, "I am sorry to hear that, we will immediately stop charging you for your apartment, of course.");
101}; 151};
102 152
103cf::attach_to_players prio => 100, 153cf::attach_to_players prio => 100,
104 on_login => sub { 154 on_login => sub {
105 return;
106 my ($pl) = @_; 155 my ($pl) = @_;
107
108 use Data::Dumper;
109 warn Dumper $pl;
110 156
111 $pl->{rent}{last_offline_check} ||= time; 157 $pl->{rent}{last_offline_check} ||= time;
112 158
113 if ($pl->{rent}{last_online_check}) { 159 if ($pl->{rent}{last_online_check}) {
114 $pl->{rent}{last_online_check} = time 160 $pl->{rent}{last_online_check} = time
… …
121 update_balance $pl; 167 update_balance $pl;
122 }; 168 };
123 169
124cf::register_map_attachment rent => 170cf::register_map_attachment rent =>
125 on_enter => sub { 171 on_enter => sub {
126 return;
127 my ($map, $pl, $x, $y) = @_; 172 my ($map, $pl, $x, $y) = @_;
128 173
129# teleport $pl, "/world/world_105_115", 2, 34; 174 # can freely enter homes of other people
130# cf::override; 175 {
176 my $path = sprintf "%s/%s/%s/",
177 cf::localdir, cf::playerdir, $pl->ob->name;
178
179 return if $path ne substr $map->path, 0, length $path;
180 }
181
182 for my $path (keys %{ $pl->{rent}{apartment} }) {
183 $path =~ y/\//_/;
184 $path = sprintf "%s/%s/%s/%s",
185 cf::localdir, cf::playerdir, $pl->ob->name, $path;
186
187 if ($map->path eq $path) {
188 if (check_balance $pl) {
189 $pl->ob->reply (undef, "Welcome to your apartment, sir!");
190 } else {
191 $pl->ob->reply (undef, "We are sorry, sir, you have to pay your rent first.");
192 reject_entry $pl;
193 }
194
195 return;
196 }
197 }
198
199 $pl->ob->reply (undef, "Sir, you have to rent this apartment in The Apartment Shop in Scorn first!");
200 reject_entry $pl;
131 }; 201 },
202;
132 203
204Event->timer (after => 60, interval => 3600, cb => sub {
205 pay_balance $_ for cf::player::list;
206});
207

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines