1package Games::FrozenBubble::Stuff;
2
3use Games::FrozenBubble::CStuff;
4use Games::FrozenBubble::Config;
5use Locale::Maketext::Simple;
6use File::ShareDir qw(dist_dir);
7
8Locale::Maketext::Simple->import(Path => "$FPATH/locale", Style => 'gettext', Export => 'gettext');
9###passing language to Locale::Maketext::Simple
10my ($lang) = split(':', $ENV{LANGUAGE} || $ENV{LANG});
11gettext_lang($lang);
12
13use vars qw(@ISA @EXPORT $FPATH $FLPATH $FBHOME $FBLEVELS $colourblind %POS_1P %POS_2P %POS_MP $BUBBLE_SIZE $ROW_SIZE
14            $PI);
15@ISA = qw(Exporter);
16@EXPORT = qw($FPATH $FLPATH $colourblind $FBHOME $FBLEVELS %POS_1P %POS_2P %POS_MP $BUBBLE_SIZE $ROW_SIZE
17             $PI cat_ member difference2 any every even odd sqr to_bool to_int if_ chomp_
18             fold_left output append_to_file min max backtrace basename cp_af all partition ssort
19             sum put_in_hash mapn mapn_ before_leaving fastuniq deep_copy stringchars loc dbgnet);
20
21%POS_1P = ( p1 => { left_limit => 190, right_limit => 446, top_limit => 44, 'initial_bubble_y' => 390,
22                    canon => { x => 268, 'y' => 356 },
23                    simpleshooter => { x => 317, 'y' => 405, diameter => 60 },
24                    pinguin => { x => 214, 'y' => 420 },
25                    next_bubble => { x => 112, 'y' => 440 },
26                    on_top_next_relpos => { x => -3, 'y' => -3 },
27                    hurry => { x => 10, 'y' => 265 },
28                    scores => { x => 74, 'y' => 103 },
29                    progress => { x => 447, 'y' => 28},
30                  },
31            centerpanel => { x => 149, 'y' => 190 },
32            pause_clip => { x => 263, 'y' => 212 },
33            compressor_xpos => 318,
34          );
35
36%POS_2P = ( p2 => { left_limit => 30, right_limit => 286, top_limit => 40, 'initial_bubble_y' => 390,
37                    canon => { x => 108, 'y' => 356 },
38                    simpleshooter => { x => 157, 'y' => 405, diameter => 60 },
39                    pinguin => { x => -35, 'y' => 420 },
40                    next_bubble => { x => 112, 'y' => 440 },
41                    on_top_next_relpos => { x => -4, 'y' => -3 },
42                    hurry => { x => 10, 'y' => 265 },
43                    malus => { x => 308, 'y' => 402 },
44                    scores => { x => 160, 'y' => 11 },
45                    chatting => { x => 70, 'y' => 465 },
46                    left => { x => 30, 'y' => 40 },
47                    progress => { x => 287, 'y' => 28 },
48                  },
49            p1 => { left_limit => 354, right_limit => 610, top_limit => 40, 'initial_bubble_y' => 390,
50                    canon => { x => 432, 'y' => 356 },
51                    simpleshooter => { x => 481, 'y' => 405, diameter => 60 },
52                    pinguin => { x => 210,  'y' => 420 },
53                    next_bubble => { x => 112, 'y' => 440 },
54                    on_top_next_relpos => { x => -4, 'y' => -3 },
55                    hurry => { x => 10, 'y' => 265 },
56                    malus => { x => 331, 'y' => 402 },
57                    scores => { x => 480, 'y' => 11 },
58                    chatting => { x => 390, 'y' => 442 },
59                    progress => { x => 345, 'y' => 28 },
60                  },
61            centerpanel => { x => 153, 'y' => 190 },
62          );
63$POS_2P{rp1} = $POS_2P{p2};  #- in net/lan 2p mode, use bigger graphics and positions
64
65%POS_MP = ( p1 => { left_limit => 190, right_limit => 446, top_limit => 44, 'initial_bubble_y' => 390,
66                    canon => { x => 268, 'y' => 356 },   #- (left_limit + right_limit) / 2 - 50  |  initial_bubble_y + 16 - 50  (50x50 is half dimensions of gfx/shoot/base)
67                    simpleshooter => { x => 317, 'y' => 405, diameter => 60 },
68                    pinguin => { x => 213, 'y' => 420 },
69                    next_bubble => { x => 112, 'y' => 440 },
70                    on_top_next_relpos => { x => -4, 'y' => -3 },
71                    hurry => { x => 10, 'y' => 265 },
72                    malus => { x => 169, 'y' => 464 },
73                    scores => { x => 320, 'y' => 12 },
74                    chatting => { x => 215, 'y' => 442 },
75                    attackme => { x => 185, 'y' => 448 },
76                    progress => { x => 447, 'y' => 28 },
77                  },
78            rp1 => { left_limit => 20, right_limit => 148, top_limit => 19, 'initial_bubble_y' => 192,
79                     canon => { x => 59, 'y' => 175 },
80                     simpleshooter => { x => 83, 'y' => 197, diameter => 30 },
81                     pinguin => { x => 94, 'y' => 211 },
82                     next_bubble => { x => 56, 'y' => 216 },
83                     on_top_next_relpos => { x => -2, 'y' => -2 },
84                     hurry => { x => 5, 'y' => 128 },
85                     malus => { x => 12, 'y' => 183 },
86                     scores => { x => 83, 'y' => 2 },
87                     chatting => { x => 5, 'y' => 230 },
88                     left => { x => 19, 'y' => 17 },
89                     attack => { x => 25, 'y' => 213 },
90                     progress => { x => 149, 'y' => 28 },
91                   },
92            rp2 => { left_limit => 492, right_limit => 620, top_limit => 19, 'initial_bubble_y' => 192,
93                     canon => { x => 531, 'y' => 175 },
94                     simpleshooter => { x => 555, 'y' => 197, diameter => 30 },
95                     pinguin => { x => 94, 'y' => 211 },
96                     next_bubble => { x => 56, 'y' => 216 },
97                     on_top_next_relpos => { x => -2, 'y' => -2 },
98                     hurry => { x => 5, 'y' => 128 },
99                     malus => { x => 628, 'y' => 183 },
100                     scores => { x => 553, 'y' => 2 },
101                     chatting => { x => 460, 'y' => 230 },
102                     left => { x => 491, 'y' => 17 },
103                     attack => { x => 496, 'y' => 214 },
104                     progress => { x => 483, 'y' => 28 },
105                   },
106            rp3 => { left_limit => 20, right_limit => 148, top_limit => 247, 'initial_bubble_y' => 420,
107                     canon => { x => 59, 'y' => 404 },
108                     simpleshooter => { x => 83, 'y' => 427, diameter => 30 },
109                     pinguin => { x => 94, 'y' => 439 },
110                     next_bubble => { x => 56, 'y' => 445 },
111                     on_top_next_relpos => { x => -2, 'y' => -2 },
112                     hurry => { x => 5, 'y' => 345 },
113                     malus => { x => 12, 'y' => 411 },
114                     scores => { x => 83, 'y' => 465 },
115                     chatting => { x => 5, 'y' => 460 },
116                     left => { x => 19, 'y' => 245 },
117                     attack => { x => 24, 'y' => 442 },
118                     progress => { x => 149, 'y' => 258 },
119                   },
120            rp4 => { left_limit => 492, right_limit => 620, top_limit => 247, 'initial_bubble_y' => 420,
121                     canon => { x => 531, 'y' => 404 },
122                     simpleshooter => { x => 555, 'y' => 427, diameter => 30 },
123                     pinguin => { x => 94, 'y' => 439 },
124                     next_bubble => { x => 56, 'y' => 445 },
125                     on_top_next_relpos => { x => -2, 'y' => -2 },
126                     hurry => { x => 5, 'y' => 345 },
127                     malus => { x => 628, 'y' => 411 },
128                     scores => { x => 553, 'y' => 465 },
129                     chatting => { x => 460, 'y' => 460 },
130                     left => { x => 491, 'y' => 245 },
131                     attack => { x => 496, 'y' => 442 },
132                     progress => { x => 483, 'y' => 258 },
133                   },
134            centerpanel => { x => 149, 'y' => 190 },
135          );
136
137$FBHOME   = "$ENV{HOME}/.frozen-bubble";
138$FBLEVELS = "$FBHOME/levels";
139migrate_resource_files();
140
141$BUBBLE_SIZE = 32;
142$ROW_SIZE = $BUBBLE_SIZE * 7/8;
143
144# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=--
145# This is extracted from MDK::Common, a helper library that
146# extends perl capabilities for very common use when programming
147# perl, especially with functional style programming (but what
148# other style one could decently adopt? ;p).
149#
150# This extract is provided here because only Mandrake distro
151# includes the whole MDK::Common, so you're not obliged to
152# install it.
153#
154# That said, if you're a perl programmer, I strongly advice you
155# to have a look at this library and use it, it would
156# dramatically increase the efficiency and readability of your
157# perl programs.
158#
159# Go to google and type in "perl-MDK-Common" if interested.
160#
161$PI = 3.1415926535897932384626433832795028841972;
162sub cat_ { local *F; open F, $_[0] or return; my @l = <F>; wantarray ? @l : join '', @l }
163sub member { my $e = shift; foreach (@_) { $e eq $_ and return 1 } 0 }
164sub difference2 { my %l; @l{@{$_[1]}} = (); grep { !exists $l{$_} } @{$_[0]} }
165sub any(&@) {
166    my $f = shift;
167    $f->($_) and return 1 foreach @_;
168    0;
169}
170sub every(&@) {
171    my $f = shift;
172    $f->($_) or return 0 foreach @_;
173    1;
174}
175sub even { $_[0] % 2 == 0 }
176sub odd  { $_[0] % 2 == 1 }
177sub sqr  { $_[0] * $_[0] }
178sub to_bool { $_[0] ? 1 : 0 }
179sub to_int { $_[0] =~ /(\d*)/; $1 }
180sub if_($@) {
181    my $b = shift;
182    $b or return ();
183    wantarray || @_ <= 1 or die("if_ called in scalar context with more than one argument " . join(":", caller()));
184    wantarray ? @_ : $_[0];
185}
186sub fold_left(&@) {
187    my ($f, $initial, @l) = @_;
188    local ($::a, $::b);
189    $::a = $initial;
190    foreach $::b (@l) { $::a = &$f() }
191    $::a
192}
193sub output {
194        my $f = shift;
195        local *F;
196        chmod(0666, $f) if -e $f;
197        open(F, ">$f") or die "output in file $f failed: $!\n";
198        print F foreach @_;
199        close(F);
200        chmod(0666, $f);
201}
202sub append_to_file {
203        my $f = shift;
204        local *F;
205        chmod(0666, $f) if -e $f;
206        open(F, ">>$f") or die "output in file $f failed: $!\n";
207        print F foreach @_;
208        close(F);
209        chmod(0666, $f);
210        1
211}
212sub min { my $n = shift; $_ < $n and $n = $_ foreach @_; $n }
213sub max { my $n = shift; $_ > $n and $n = $_ foreach @_; $n }
214sub backtrace {
215    my $s;
216    for (my $i = 1; caller($i); $i++) {
217        my ($package, $file, $line, $func) = caller($i);
218        $s .= "$func() called from $file:$line\n";
219    }
220    $s;
221}
222sub basename { local $_ = shift; s|/*\s*$||; s|.*/||; $_ }
223sub cp_af {
224    my $dest = pop @_;
225
226    @_ or return;
227    @_ == 1 || -d $dest or die "cp: copying multiple files, but last argument ($dest) is not a directory\n";
228
229    foreach my $src (@_) {
230        my $dest = $dest;
231        -d $dest and $dest .= '/' . basename($src);
232
233        unlink $dest;
234
235        if (-d $src) {
236            -d $dest or mkdir $dest, (stat($src))[2] or die "mkdir: can't create directory $dest: $!\n";
237            cp_af(glob_($src), $dest);
238        } elsif (-l $src) {
239            unless (symlink((readlink($src) || die "readlink failed: $!"), $dest)) {
240                warn "symlink: can't create symlink $dest: $!\n";
241            }
242        } else {
243            local *F; open F, $src or die "can't open $src for reading: $!\n";
244            local *G; open G, "> $dest";
245            local $_; while (<F>) { print G $_ }
246            chmod((stat($src))[2], $dest);
247        }
248    }
249    1;
250}
251sub all {
252    my $d = shift;
253
254    local *F;
255    opendir F, $d or return;
256    my @l = grep { $_ ne '.' && $_ ne '..' } readdir F;
257    closedir F;
258
259    @l;
260}
261sub partition(&@) {
262    my $f = shift;
263    my (@a, @b);
264    foreach (@_) {
265        $f->($_) ? push(@a, $_) : push(@b, $_);
266    }
267    \@a, \@b;
268}
269sub chomp_ { my @l = map { my $l = $_; chomp $l; $l } @_; wantarray() ? @l : $l[0] }
270sub ssort(&@) {
271    my $f = shift;
272    sort { local $_ = $a; my $fa = $f->($a); local $_ = $b; $fa <=> $f->($b) } @_;
273}
274sub sum { my $n = 0; $n += $_ foreach @_; $n }
275sub put_in_hash { my ($a, $b) = @_; while (my ($k, $v) = each %{$b || {}}) { $a->{$k} = $v } $a }
276sub smapn {
277    my $f = shift;
278    my $n = shift;
279    my @r;
280    for (my $i = 0; $i < $n; $i++) { push @r, &$f(map { $_->[$i] } @_) }
281    @r
282}
283sub mapn(&@) {
284    my $f = shift;
285    smapn($f, min(map { scalar @$_ } @_), @_);
286}
287sub mapn_(&@) {
288    my $f = shift;
289    smapn($f, max(map { scalar @$_ } @_), @_);
290}
291sub add_f4before_leaving {
292    my ($f, $b, $name) = @_;
293
294    $Games::FrozenBubble::Stuff::before_leaving::_list->{$b}{$name} = $f;
295    if (!$Games::FrozenBubble::Stuff::before_leaving::_added{$name}) {
296        $Games::FrozenBubble::Stuff::before_leaving::_added{$name} = 1;
297        no strict 'refs';
298        *{"Games::FrozenBubble::Stuff::before_leaving::$name"} = sub {
299            my $f = $Games::FrozenBubble::Stuff::before_leaving::_list->{$_[0]}{$name} or die '';
300            $name eq 'DESTROY' and delete $Games::FrozenBubble::Stuff::before_leaving::_list->{$_[0]};
301            &$f;
302        };
303    }
304}
305#- ! the functions are not called in the order wanted, in case of multiple before_leaving :(
306sub before_leaving(&) {
307    my ($f) = @_;
308    my $b = bless {}, 'Games::FrozenBubble::Stuff::before_leaving';
309    add_f4before_leaving($f, $b, 'DESTROY');
310    $b;
311}
312# -=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=---=-=--
313
314#- it doesn't keep ordering (but I don't care)
315sub fastuniq { my %l; @l{@_} = @_; values %l }
316
317sub deep_copy {
318    my ($scalar) = @_;
319    if (!ref($scalar)) {
320        $scalar;
321    } elsif (ref($scalar) eq "ARRAY") {
322        [ map deep_copy($_), @$scalar ];
323    } elsif (ref($scalar) eq "HASH") {
324        +{ map { $_ => deep_copy($scalar->{$_}) } keys %$scalar };
325    } else {
326        die "what type is $_?"
327    }
328}
329
330sub stringchars {
331    return split //, $_[0];
332}
333
334sub loc {
335    my ($fmt, @args) = @_;
336    return sprintf(gettext($fmt), @args);
337}
338
339sub dbgnet {
340    if (0) {
341        print "DBGNET: @_\n";
342    }
343}
344
345sub migrate_resource_files {
346    mkdir $FBHOME;
347    my %files = (
348        "$ENV{HOME}/.fbhighlevelshistory" => "highlevelshistory",
349        "$ENV{HOME}/.fb_records" => "records",
350        "$ENV{HOME}/.fblevels" => "levels",
351        "$ENV{HOME}/.fbhighscores" => "highscores",
352        "$ENV{HOME}/.fbhighscores-mptrain" => "highscores-mptrain",
353        "$ENV{HOME}/.fbrc" => "rc"
354    );
355    foreach my $file (keys %files) {
356        -r $file or next;
357        system "mv '$file' '$FBHOME/$files{$file}'";
358    }
359}
360
3611;
362
363__END__
364
365=encoding UTF-8
366
367=head1 Frozen-Bubble
368
369Copyright © 2000 - 2012 The Frozen-Bubble Team
370
371Originally sponsored by Mandriva <http://www.mandriva.com/>
372
373This program is free software; you can redistribute it and/or modify
374it under the terms of the GNU General Public License version 2, as
375published by the Free Software Foundation.
376
377This program is distributed in the hope that it will be useful,
378but WITHOUT ANY WARRANTY; without even the implied warranty of
379MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
380GNU General Public License for more details.
381
382You should have received a copy of the GNU General Public License
383along with this program; if not, write to the Free Software
384Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
385