view release on metacpan or  search on metacpan

bin/frozen-bubble  view on Meta::CPAN

    };

    my %latestangle = ();  #- for smoothing, need to handle last angle only

    while (@$msg) {
        my $m = shift @$msg;
        my $player = $pdata{id2p}{$m->{id}};
        if (!$player) {
            printf "Network protocol error: player with id '%d' doesn't exist. You're not a regular Frozen-Bubble client, aren't you?\n", ord($m->{id});
            die 'quit';
        }
        if ($pdata{$player}{left}) {
            print STDERR "$pdata{$player}{nick}: you don't exist (anymore), go away!\n";
            next;
        }
        my ($command, $params) = $m->{msg} =~ /^(.)(.*)/;
        dbgnet("message received: from=$player message=$m->{msg}");
        if ($command eq 'l') {
            iter_players { #- need iter_players to get the small graphics change for free
                if ($::p eq $player) {
                    $pdata{$::p}{left} = 1;
                    $pdata{$::p}{still_game_messages} = 0;
                    lose($::p);
                }
            };
        } elsif ($command eq 'f') {
            $check_action_possible->($m, $player) or last;
            $actions{$player}{mp_fire} = 1;
            ($angle{$player}, $pdata{$player}{nextcolor}) = $params =~ /(.+):(.+)/;
        } elsif ($command eq 'r') {
            $actions{$player}{left} = 0;
            $actions{$player}{right} = 0;
            $actions{$player}{center} = 0;
            if ($params eq 'l') {
                $actions{$player}{left} = 1;
            } elsif ($params eq 'r') {
                $actions{$player}{right} = 1;
            } elsif ($params eq 'c') {
                $actions{$player}{center} = 1;
            }
        } elsif ($command eq 'a') {
            $latestangle{$player} = $params;
        } elsif ($command eq 's') {
            $check_action_possible->($m, $player) or last;
            #- we can't rely on locally animated launched bubble, to ensure game
            #- consistency we transmit stick positions
            $actions{$player}{mp_stick} = 1;
            ($pdata{$player}{stickcx}, $pdata{$player}{stickcy}, $pdata{$player}{stickcol}, my $newrootcols) = $params =~ /(.+):(.+):(.+):(.*)/;
            @{$pdata{$player}{nextcolors}} = split / /, $newrootcols;
        } elsif ($command eq 'g') {
            my ($destplayer, $numb) = $params =~ /(.+):(.+)/;
            iter_players {
                if ($pdata{$::p}{nick} eq $destplayer) {
                    update_malus(\&remove_image_from_background, $::p);
                    push @{$pdata{$::p}{malus}}, ($frame) x $numb;
                    update_malus(\&put_image_to_background, $::p);
                }
            };
        } elsif ($command eq 'm') {
            #- we may receive new malus bubbles after a distant player is dead already
            #- ignore them instead of wrongly overlaying frozen bubbles
            if ($pdata{$player}{state} eq 'ingame') {
                my ($num, $cx, $cy, $sticky) = $params =~ /(.+):(.+):(.+):(.+)/;
                my $b = create_bubble_given_img_num($num);
                $b->{cx} = $cx;
                $b->{cy} = $cy;
                $b->{'stick_y'} = $sticky;
                iter_players { #- need iter_players to get the small graphics change for free
                    if ($::p eq $player) {
                        calc_real_pos($b, $::p);
                        push @{$malus_bubble{$player}}, $b;
                        malus_change(-1, $player);
                    }
                };
            }
        } elsif ($command eq 'M') {
            my ($cx, $sticky) = $params =~ /(.+):(.+)/;
            #- if network cuts several malussticks in two parts, it's possible that
            #- one malusstick from the first part trigger a lose; at next game run,
            #- the player has lost and his malus bubbles were cleaned up, so malusstick
            #- is not possible, but this is no big deal
            if ($pdata{$player}{state} eq 'ingame') {
                foreach (@{$malus_bubble{$player}}) {
                    if ($_->{cx} == $cx && $_->{'stick_y'} == $sticky) {
                        $_->{mp_stick} = 1;
                        goto ok_malusstick;
                    }
                }
                die "could not find malus bubble to malusstick!\n";
              ok_malusstick:
            }
        } elsif ($command eq 'F') {
            #- this is coming too soon. it needs to be collected in the algo to restart a game.
            unshift @$msg, $m;
            last;
        } elsif ($command eq 't') {
            $pdata{current_chat_messages}{$player} = $params;
            $pdata{$player}{chat_msg_delay} = 500;
            play_sound('chatted');
            redraw_chat_message_if_needed($player);
            push @update_rects, $apprects{main};
        } elsif ($command eq 'A') {
            if ($params eq '') {
                @{$pdata{attackingme}} = difference2($pdata{attackingme}, [ $player ]);
            } else {
                if ($params eq $pdata{p1}{nick}) {
                    if (!member($player, @{$pdata{attackingme}})) {
                        push @{$pdata{attackingme}}, $player;
                    }
                } else {
                    @{$pdata{attackingme}} = difference2($pdata{attackingme}, [ $player ]);
                }
            }
            redraw_attackingme();
        } else {
            print STDERR "****** Unrecognized command: $m->{msg}\n";
        }
    }

    foreach my $player (keys %latestangle) {
        #- try to smoothen on network lag

bin/frozen-bubble  view on Meta::CPAN

                       });
                my $xb;
                my $yb;
                my $r;
                $set_next_position->();
              find_ok_position:
                while (1) {
                    $xb = $xc - $wb/2;
                    $yb = $yc - $hb/2;
                    #- check that background rectangle does not overlap any existing rectangle (spots or other labels)
                    $r = SDL::Rect->new($xb, $yb, $wb, $hb);
                    foreach my $rect (@rectangles) {
                        if ($rect->x >= $xb && $wb > $rect->x - $xb
                            || $xb >= $rect->x && $rect->w > $xb - $rect->x) {
                            #- x overlap
                            if ($rect->y >= $yb && $hb > $rect->y - $yb
                                || $yb >= $rect->y && $rect->h > $yb - $rect->y) {
                                $set_next_position->();
                                while ($xb < 20 || $xb + $wb > 620 || $yb < 20 || $yb + $hb > 320) {
                                    $set_next_position->();
                                    if ($index_positions > 100) {
                                        #- abandon, map is crowded
                                        return;
                                    }
                                }
                                if ($index_positions > 100) {
                                    #- abandon, map is crowded
                                    return;
                                }
                                next find_ok_position;
                            }
                        }
                    }
                    last;
                }
                #- draw a line between the spot and the center of the label
                Games::FrozenBubble::CStuff::draw_line($app, $xspot, $yspot, $xc, $yc, $label_line_color);
                #- draw the label background and the label in another pass to handle overwriting of labels over lines
                push @labels, { x => $xc - $sizing->[2]/2 - $sizing->[0], y => $yc - $sizing->[3]/2 - $sizing->[1], text => $text, backrect1 => $r,
                                backrect2 => SDL::Rect->new($xb + 1, $yb + 1, $wb - 2, $hb - 2) };
                push @rectangles, $r;
            }
        } \@wholist, \@free_geolocs;

        foreach (@labels) {
                SDL::Video::fill_rect($app, $_->{backrect1}, $label_outer_color);
                SDL::Video::fill_rect($app, $_->{backrect2}, $label_background_color);
            print_('netdialogs_servermsg', $app, $_->{x}, $_->{y}, $_->{text});
        }

        #- actions (chat, joins, create)
        my $y = $smg_starty;
        foreach my $action (@actions) {
            if ($action->{selected}) {
                put_image($imgbin{highlight_server}, 6, $y-1);
            }
            print_($action->{readonly} ? 'netdialogs_servermsg' : 'netdialogs', $app, $smg_startx, $y, $action->{name}, 520);
            $y += $smg_lineheight;
        }

        #- selfspot will need to properly erase selection overlay
        if ($mylatitude && !$private) {
            save_back_spot($mylatitude, $mylongitude, $imgbin{netspot_self}[0], \$back_selfspot);
            if ($index_selfspot >= 0) {
                print_spot($mylatitude, $mylongitude, 'free', $imgbin{netspot_self}[$index_selfspot], \$back_selfspot);
            }
        }

        #- chat entry
        erase_line($smg_starty_chat, $imgbin{back_netgame});
        if ($curaction->() && $curaction->()->{action} eq 'CHAT') {
            callback_entry('print', { xpos => $smg_startx, ypos => $smg_starty_chat, maxlen => 520, prefix => loc("Say: "), font => 'netdialogs' });
        }

        #- available players in server, or list of players in game
        erase_line($smg_starty_players, $imgbin{back_netgame});
        if ($ingame) {
            print_('netdialogs', $app, $smg_startx, $smg_starty_players, loc("Players in game: %s", $players_in_game), 520);
        } else {
            print_('netdialogs', $app, $smg_startx, $smg_starty_players, loc("Available Players: %s", i18n_number($free_players)), 520);
        }

        #- status messages
        smg_printstatus();
    };
    my $print_selfspot = sub {
        if ($mylatitude && !$private) {
            $index_selfspot >= 0 and print_spot($mylatitude, $mylongitude, 'free', $imgbin{netspot_self}[$index_selfspot], \$back_selfspot);
            $index_selfspot++;
            if ($index_selfspot == @{$imgbin{netspot_self}}) {
                my ($x, $y) = get_spot_location($mylatitude, $mylongitude);
                put_image($back_selfspot, $x - 10, $y - 10);
                $index_selfspot = -15;
            }
        }
    };

    my $myoldnick;
    my $list = sub {
        my ($firsttime) = @_;
        $state eq 'game_select' or return;
        my @games;
        my @old_wholist = @wholist;
        eval {
            ($free_players, undef, my $freenicks, undef, my $playing_geolocs, @games) = Games::FrozenBubble::Net::list();
            @wholist = ();
            @free_geolocs = ();
            @playing_geolocs = ();
            foreach (split ',', $freenicks) {
                my ($nick, undef, $latitude, $longitude) = $_ =~ /([^:]+)(:([^:]+):([^:]+))?/;
                push @wholist, $nick;
                if (defined($latitude) && $latitude =~ /^-?\d+\.?\d*$/ && $longitude =~ /^-?\d+\.?\d*$/) {
                    push @free_geolocs, [ $latitude, $longitude ];
                } else {
                    push @free_geolocs, [];
                }
            }
            foreach (split ',', $playing_geolocs) {
                my ($latitude, $longitude) = $_ =~ /([^:]+):([^:]+)/;
                $latitude =~ /^-?\d+\.?\d*$/ && $longitude =~ /^-?\d+\.?\d*$/ and push @playing_geolocs, [ $latitude, $longitude ];
            }