Thread Gamelogik in Perl (7 answers)
Opened by TheDude at 2009-07-25 18:06

Gast TheDude
 2009-07-26 04:31
#123564 #123564
Ok vielen Dank erstmal.. Das hat mir den noetigen Geistesblitz verschafft..

Hier mal mein aktueller Code fall es jemanden interessiert.. Wen da irgendwas zu umstaendlich oder stark optimierbar ist nur raus damit..
Was ich aber anders gemacht hab ist das ich nur in zwei Richtungen scanne.. Wenn ich oben links anfang bis nach unten rechts geh hab ich ja automatisch alle.. Sonst haet ich sogar welche doppelt..

Code (perl): (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84

use strict;
use warnings;

my @Feld = ([ 3, 6, 4, 3, 7, 3, 3, 6 ],
            [ 6, 5, 8, 7, 6, 8, 2, 8 ],
            [ 5, 5, 7, 4, 5, 2, 7, 7 ],
            [ 6, 3, 4, 1, 6, 8, 8, 3 ],
            [ 1, 5, 7, 7, 5, 1, 7, 4 ],
            [ 7, 2, 8, 5, 2, 3, 3, 2 ],
            [ 2, 2, 4, 8, 1, 1, 8, 3 ],
            [ 2, 5, 3, 1, 7, 5, 7, 8 ]);

my @Possible;
my @TestFeld;

for my $y (0..7)
{
        for my $x (0..7)
        {
                if ($x != 7) {
                        my $qualityR = TestMove(\@Feld, $x, $y, 'right');
                        if ($qualityR > 0) {
                                push(@Possible, [$x, $y, $x+1, $y, $qualityR])
                        }
                }
                if ($y != 7) {
                        my $qualityD = TestMove(\@Feld, $x, $y, 'down');
                        if ($qualityD > 0) {
                                push(@Possible, [$x, $y, $x, $y+1, $qualityD])
                        }
                }
        }
}

foreach my $Move (@Possible) {
        print "Swap $$Move[0]/$$Move[1] with $$Move[2]/$$Move[3] for $$Move[4] Points\n";
}


sub TestMove
{
        if ($_[3] eq 'right') {
                @TestFeld = @{$_[0]};
                my $ToSwap = ${$TestFeld[$_[2]]}[$_[1]];
                ${$TestFeld[$_[2]]}[$_[1]] = ${$TestFeld[$_[2]]}[$_[1]+1];
                ${$TestFeld[$_[2]]}[$_[1]+1] = $ToSwap;
                my $quality = GetQuality(\@TestFeld);
                return $quality;
        } elsif ($_[3] eq 'down') {
                @TestFeld = @{$_[0]};
                my $ToSwap = ${$TestFeld[$_[2]]}[$_[1]];
                ${$TestFeld[$_[2]]}[$_[1]] = ${$TestFeld[$_[2]+1]}[$_[1]];
                ${$TestFeld[$_[2]+1]}[$_[1]] = $ToSwap;
                my $quality = GetQuality(\@TestFeld);
                return $quality;
        }
}

sub GetQuality
{
        my $ref = $_[0];
        my $quality = 0;
        for my $x (0..7)
        {
                my $string = join("", @{@$ref[$x]});
                while ($string =~ m/1{3,5}|2{3,5}|3{3,5}|4{3,5}|5{3,5}|6{3,5}|7{3,5}|8{3,5}/g) {
                        $quality += length($&);
                }
                undef $string;
        }
        for my $y (0..7)
        {
                my $string = "";
                for my $z (0..7)
                {
                        $string = $string . ${@$ref[$z]}[$y];
                }
                while ($string =~ m/1{3,5}|2{3,5}|3{3,5}|4{3,5}|5{3,5}|6{3,5}|7{3,5}|8{3,5}/g) {
                        $quality += length($&);
                }
                undef $string;
        }
        return $quality;
}

View full thread Gamelogik in Perl