ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cf.schmorp.de/maps/perl/rent.ext
Revision: 1.11
Committed: Fri Dec 15 19:11:46 2006 UTC (17 years, 7 months ago) by root
Branch: MAIN
CVS Tags: HEAD
Changes since 1.10: +0 -0 lines
State: FILE REMOVED
Log Message:
move .ext to server

File Contents

# Content
1 #! perl
2
3 use List::Util;
4
5 my %apartment = (
6 "/scorn/apartment/apartments" => [ 1, "scorn", "skorn"],
7 "/santo_dominion/sdomino_appartment" => [ 10, "santo dominion", "domino"],
8 "/darcap/darcap/apartment" => [ 30, "darcap", "thecap"],
9 "/navar_city/apartments/apartment" => [ 250, "navar", "navar"],
10 "/azumauindo/ranbounagisatoshi/apartments/sapartment" => [ 100, "乱暴渚都市", "benjo"],
11 "/azumauindo/suno-yamatoshi/apartments/lapartment1" => [ 1000, "スノー大和島根", "sama"],
12 "/pup_land/nurnberg/apartment/main" => [ 300, "nürnberg", "sauerkraut"],
13 "/pup_land/lone_town/apartment/groundfloor" => [50000, "lone town", "looney"],
14 "/brest/apartments/brest_town_house" => [30000, "brest", "brecht"],
15 );
16
17 sub teleport {
18 my ($pl, $map, $x, $y) = @_;
19
20 my $portal = cf::object::new "exit";
21
22 $portal->slaying ($map);
23 $portal->stats->hp ($x);
24 $portal->stats->sp ($y);
25 $portal->apply ($pl->ob);
26 $portal->destroy;
27 }
28
29 # we have to special case some special cases :)
30 sub 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/%;
40 }
41
42 sub update_balance {
43 my ($pl) = @_;
44
45 my $NOW = time;
46
47 # 1 silver per day per level per apartment of kingdom tax
48 my $offline = (List::Util::min 30, ($NOW - $pl->{rent}{last_offline_check}) / 86400)
49 * (cf::exp_to_level $pl->ob->stats->exp)
50 * scalar keys %{ $pl->{rent}{apartment} };
51
52 # once per hour per map rented
53 my $online = ($NOW - $pl->{rent}{last_online_check}) / 3600
54 * List::Util::sum map $apartment{$_}[0], keys %{ $pl->{rent}{apartment} };
55
56 $pl->{rent}{last_offline_check} = $NOW;
57 $pl->{rent}{last_online_check} = $NOW;
58
59 $pl->{rent}{balance} += $offline + $online;
60 }
61
62 sub pay_balance {
63 my ($pl) = @_;
64
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
86 sub check_balance {
87 my ($pl) = @_;
88
89 pay_balance $pl if $pl->{rent}{balance} > 0;
90
91 $pl->{rent}{balance} <= 0
92 }
93
94 sub find_apartment {
95 my ($pl, $name) = @_;
96
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
101 }
102
103 cf::register_script_function "rent::overview" => sub {
104 my ($pl, $types) = @_;
105
106 while (my ($k, $v) = each %apartment) {
107 my $type = exists $pl->{rent}{apartment}{$k} ? 1 : 2;
108
109 $pl->ob->reply (undef, "model \"$v->[2]\", situated in $v->[1] ("
110 . (cf::cost_string_from_value $v->[0]) . "/hr)")
111 if $type & $types;
112 }
113 };
114
115 cf::register_script_function "rent::status" => sub {
116 my ($pl, $types) = @_;
117
118 if ($pl->{rent}{balance} <= 0) {
119 $pl->ob->reply (undef, "You have no debts to pay.");
120 } else {
121 $pl->ob->reply (undef, "You owe us " . (cf::cost_string_from_value $pl->{rent}{balance}) . ".");
122 }
123 };
124
125 cf::register_script_function "rent::rent" => sub {
126 my ($pl, $apartment) = @_;
127
128 $apartment = find_apartment $pl, $apartment
129 or return;
130
131 update_balance $pl;
132
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!");
138 };
139
140 cf::register_script_function "rent::stop" => sub {
141 my ($pl, $apartment) = @_;
142
143 $apartment = find_apartment $pl, $apartment
144 or return;
145
146 update_balance $pl;
147
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.");
151 };
152
153 cf::attach_to_players prio => 100,
154 on_login => sub {
155 my ($pl) = @_;
156
157 $pl->{rent}{last_offline_check} ||= time;
158
159 if ($pl->{rent}{last_online_check}) {
160 $pl->{rent}{last_online_check} = time
161 - List::Util::min 3600,
162 $pl->ob->get_ob_key_value ("schmorplog_last_save") - $pl->{rent}{last_online_check};
163 } else {
164 $pl->{rent}{last_online_check} = time;
165 }
166
167 update_balance $pl;
168 };
169
170 cf::register_map_attachment rent =>
171 on_enter => sub {
172 my ($map, $pl, $x, $y) = @_;
173
174 # can freely enter homes of other people
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;
201 },
202 ;
203
204 Event->timer (after => 60, interval => 3600, data => cf::WF_AUTOCANCEL, cb => sub {
205 pay_balance $_ for cf::player::list;
206 });
207