ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/rent.ext
Revision: 1.31
Committed: Sat May 8 21:26:21 2010 UTC (14 years ago) by root
Branch: MAIN
CVS Tags: rel-3_1, rel-3_0, HEAD
Changes since 1.30: +1 -0 lines
Log Message:
initial wassar check-in

File Contents

# User Rev Content
1 root 1.1 #! perl
2    
3     use List::Util;
4    
5 root 1.20 our %apartment = (
6 root 1.1 "/scorn/apartment/apartments" => [ 1, "scorn", "skorn"],
7     "/santo_dominion/sdomino_appartment" => [ 10, "santo dominion", "domino"],
8     "/darcap/darcap/apartment" => [ 30, "darcap", "thecap"],
9 elmex 1.26 "/gotischerbereich/steinwandstadt/sapartment1" => [ 100, "steinwandstadt", "konkret"],
10 root 1.31 "/wassar/apartment/apartment" => [ 150, "wassar", "tauch"],
11 root 1.1 "/navar_city/apartments/apartment" => [ 250, "navar", "navar"],
12 elmex 1.26 "/celvear_port/tower2/tower2" => [ 300, "celvear port", "kevlar"],
13 root 1.1 "/azumauindo/ranbounagisatoshi/apartments/sapartment" => [ 100, "乱暴渚都市", "benjo"],
14     "/azumauindo/suno-yamatoshi/apartments/lapartment1" => [ 1000, "スノー大和島根", "sama"],
15 elmex 1.30 "/mlab/mountpermapartment" => [ 400, "st. bartholomew", "barth"],
16 elmex 1.28 "/valleynoy/jewelertown/jeweler_inn_upper" => [ 500, "jeweler town", "jewelor"],
17 elmex 1.30 "/heaven/apartment" => [ 1500, "heaven town", "heaven"],
18 root 1.1 "/pup_land/nurnberg/apartment/main" => [ 300, "nürnberg", "sauerkraut"],
19 root 1.16 "/lostwages/petapartment" => [ 5000, "lostwages", "losvegas"],
20 root 1.21 "/gotischerbereich/towerapartment/tower1" => [10000, "gotisch", "retreat"],
21 root 1.27 "/lake_country/Butakis/apartment" => [25000, "castle butakis", "expandor"],
22 root 1.18 "/brest/apartments/brest_town_house" => [30000, "brest", "brecht"],
23 root 1.1 "/pup_land/lone_town/apartment/groundfloor" => [50000, "lone town", "looney"],
24     );
25    
26     # we have to special case some special cases :)
27     sub reject_entry {
28     my ($pl) = @_;
29    
30 root 1.7 my $prev_pos = $pl->ob->{_prev_pos};
31 root 1.8 $pl->ob->goto ($prev_pos ? @$prev_pos : ("/world/world_105_115", 2, 34));
32 root 1.7
33 root 1.1 cf::override;
34     }
35    
36     sub update_balance {
37     my ($pl) = @_;
38    
39     my $NOW = time;
40    
41     # 1 silver per day per level per apartment of kingdom tax
42     my $offline = (List::Util::min 30, ($NOW - $pl->{rent}{last_offline_check}) / 86400)
43     * (cf::exp_to_level $pl->ob->stats->exp)
44     * scalar keys %{ $pl->{rent}{apartment} };
45    
46     # once per hour per map rented
47     my $online = ($NOW - $pl->{rent}{last_online_check}) / 3600
48     * List::Util::sum map $apartment{$_}[0], keys %{ $pl->{rent}{apartment} };
49    
50     $pl->{rent}{last_offline_check} = $NOW;
51     $pl->{rent}{last_online_check} = $NOW;
52    
53     $pl->{rent}{balance} += $offline + $online;
54     }
55    
56     sub pay_balance {
57     my ($pl) = @_;
58    
59 root 1.11 cf::cede_to_tick;
60    
61 root 1.1 update_balance $pl;
62    
63     return unless $pl->{rent}{balance} > 0;
64    
65     my $deduct = cf::ceil $pl->{rent}{balance};
66    
67     my $deduct_string = cf::cost_string_from_value $deduct;
68    
69     if ($deduct <= $pl->ob->{bank_balance}) {
70     cf::db_put rent => balance => $deduct + cf::db_get rent => "balance";
71     $pl->ob->{bank_balance} -= $deduct;
72     $pl->{rent}{balance} -= $deduct;
73 root 1.10 $pl->ob->reply (undef, "Something whispers into your ear: "
74 root 1.9 . "Your highness, we deducted your apartment rent ($deduct_string) from your bank account.");
75 root 1.1 } else {
76 root 1.10 $pl->ob->reply (undef, "Something whispers into your ear: "
77 root 1.9 . "Your highness, we want to deduct the apartment rent ($deduct_string), but the bank informed us that they cannot perform the transaction. "
78 root 1.1 . "Please even out your balance so we can deduct the fees, otherwise we will be forced to shut down your access to the apartment.");
79     }
80     }
81    
82     sub check_balance {
83     my ($pl) = @_;
84    
85     pay_balance $pl if $pl->{rent}{balance} > 0;
86    
87     $pl->{rent}{balance} <= 0
88     }
89    
90     sub find_apartment {
91     my ($pl, $name) = @_;
92    
93     my $apartment = (grep $apartment{$_}[2] eq $name, keys %apartment)[0]
94     or $pl->ob->reply (undef, "Sorry, but we do not offer model '$name' for rent.");
95    
96     $apartment
97     }
98    
99     cf::register_script_function "rent::overview" => sub {
100     my ($pl, $types) = @_;
101    
102     while (my ($k, $v) = each %apartment) {
103     my $type = exists $pl->{rent}{apartment}{$k} ? 1 : 2;
104    
105 root 1.17 $pl->ob->reply (undef, "model \"$v->[2]\", located in $v->[1] ("
106 root 1.10 . (cf::cost_string_from_value $v->[0]) . "/hr)\n")
107 root 1.1 if $type & $types;
108     }
109     };
110    
111     cf::register_script_function "rent::status" => sub {
112     my ($pl, $types) = @_;
113    
114     if ($pl->{rent}{balance} <= 0) {
115     $pl->ob->reply (undef, "You have no debts to pay.");
116     } else {
117     $pl->ob->reply (undef, "You owe us " . (cf::cost_string_from_value $pl->{rent}{balance}) . ".");
118     }
119     };
120    
121     cf::register_script_function "rent::rent" => sub {
122     my ($pl, $apartment) = @_;
123    
124     $apartment = find_apartment $pl, $apartment
125     or return;
126    
127     update_balance $pl;
128    
129     $pl->{rent}{apartment}{$apartment} = undef;
130    
131 root 1.9 $pl->ob->reply (undef, "Wonderful decision, your highness! "
132 root 1.1 . "We told the proprietor in $apartment{$apartment}[1] to expect you and let you in. "
133     . "We are sure you will be satisfied!");
134     };
135    
136     cf::register_script_function "rent::stop" => sub {
137     my ($pl, $apartment) = @_;
138    
139     $apartment = find_apartment $pl, $apartment
140     or return;
141    
142     update_balance $pl;
143    
144     delete $pl->{rent}{apartment}{$apartment};
145    
146     $pl->ob->reply (undef, "I am sorry to hear that, we will immediately stop charging you for your apartment, of course.");
147     };
148    
149 root 1.2 cf::player->attach (
150     prio => 100,
151 root 1.1 on_login => sub {
152     my ($pl) = @_;
153    
154     $pl->{rent}{last_offline_check} ||= time;
155    
156     if ($pl->{rent}{last_online_check}) {
157     $pl->{rent}{last_online_check} = time
158     - List::Util::min 3600,
159 root 1.13 $pl->ob->kv_get ("schmorplog_last_save") - $pl->{rent}{last_online_check};
160 root 1.1 } else {
161     $pl->{rent}{last_online_check} = time;
162     }
163    
164     update_balance $pl;
165 root 1.2 },
166     );
167 root 1.1
168 root 1.2 cf::map::attachment rent =>
169 root 1.1 on_enter => sub {
170     my ($map, $pl, $x, $y) = @_;
171    
172 root 1.25 return if $pl->ob->flag (cf::FLAG_WIZ);
173    
174 root 1.7 my $pfx = sprintf "~%s/", $pl->ob->name;
175 root 1.1
176 root 1.7 # only do something if entering ones own apartment
177     if ($pfx eq substr $map->path, 0, length $pfx) {
178     for my $path (keys %{ $pl->{rent}{apartment} }) {
179     $path = sprintf "~%s%s", $pl->ob->name, $path;
180    
181     if ($map->path eq $path) {
182     if (check_balance $pl) {
183 root 1.9 $pl->ob->reply (undef, "Welcome to your apartment, your highness!");
184 root 1.7 } else {
185 root 1.29 $pl->failmsg ("We are sorry, your highness, you have to pay your rent first.");
186 root 1.7 reject_entry $pl;
187     }
188 root 1.1
189 root 1.7 return;
190 root 1.1 }
191 root 1.7 }
192 root 1.1
193 root 1.29 $pl->failmsg ("Your highness, you have to rent this apartment in The Apartment Shop in Scorn or other apartment shops first!");
194 root 1.7 reject_entry $pl;
195 root 1.1 }
196     },
197     ;
198    
199 root 1.12 our $RENT_TIMER = cf::periodic 3600, Coro::unblock_sub {
200     pay_balance $_ for cf::player::list;
201     };
202 root 1.1