Explorar el Código

lpst.pl - can now filter moves by player

master
gashapwn hace 3 años
padre
commit
efb3e9ec1e
Se han modificado 2 ficheros con 70 adiciones y 85 borrados
  1. +2
    -1
      .gitignore
  2. +68
    -84
      lpst.pl

+ 2
- 1
.gitignore Ver fichero

@@ -1,3 +1,4 @@
*~ *~
p[0-9].pl p[0-9].pl
p[0-9][0-9].pl
p[0-9][0-9].pl
notes.txt

+ 68
- 84
lpst.pl Ver fichero

@@ -39,7 +39,6 @@ my $HL_1 = "|____ ";
my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US." "; my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US." ";


my $SUB_CHR = "_"; my $SUB_CHR = "_";
my $ALT_SUB_CHR = "=";


my $BLANK_CELL_CHR = $ALT_US; my $BLANK_CELL_CHR = $ALT_US;


@@ -342,23 +341,24 @@ my %board;
# Display pieces # Display pieces
#================================================== #==================================================


# I hate this function
sub f_1($$$){
sub get_pi_str($){
my $p = shift; my $p = shift;
my $c0 = shift;
my $hex = shift;
my $s0;
$p =~ s/($P1|$P2)$DIV//; $p =~ s/($P1|$P2)$DIV//;
$p .= "_" if length($p) < 2; $p .= "_" if length($p) < 2;
$s0 = $hex;
return $p;
}


$s0 =~ s/$SUB_CHR{1,2}/$p/;
sub sub_pi_str($$$){
my ($p, $c0, $hex) = (shift, shift, shift);
my $s0;


$p = get_pi_str($p);
$s0 = $hex;
unless($p eq "__"){ unless($p eq "__"){
substr($s0, 2,2) = $p; substr($s0, 2,2) = $p;
} }
if($c0 % 2 == 0){ if($c0 % 2 == 0){
$s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g; $s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g;
} }
@@ -423,7 +423,7 @@ sub disp_2($$){


$p = $board{$not}; $p = $board{$not};
return f_1($p, $c0, $hex);
return sub_pi_str($p, $c0, $hex);
# my ($r0, $c0) = (shift, shift); # my ($r0, $c0) = (shift, shift);
# return $HEX_2; # return $HEX_2;
} }
@@ -575,57 +575,19 @@ sub disp_board(){


# Caclulate movement # Caclulate movement
#================================================== #==================================================

# TODO: rename / rethink these 4 functions
sub gm1($){
my $not = shift;
my $pi;

$pi = cell_pi($not);

if($pi){
return gm2($pi);
}
return ();
}
sub gm2(){
my $pi = shift;
return grep {
$_ if ($_->{"type"} & $MOVE_ENUM) eq $MOVE_ENUM
} @{$MOVE{$pi}}
}

sub gb1($){
my $not = shift;
my $pi;

$pi = cell_pi($not);

if($pi){
return gb2($pi);
}
return ();
}
sub gb2($){
my $pi = shift;
return grep {
$_ if ($_->{"type"} & $BLOCK_ENUM) eq $BLOCK_ENUM
} @{$MOVE{$pi}}
}

sub not_split($$){
sub pi_split($$){
my ($not, $i0) = (shift, shift); my ($not, $i0) = (shift, shift);
return (split(/$DIV/, $board{$not}))[$i0]; return (split(/$DIV/, $board{$not}))[$i0];
} }


sub cell_pi($){ sub cell_pi($){
my $not = shift; my $not = shift;
return not_split($not, 1);
return pi_split($not, 1);
} }


sub cell_pl($){ sub cell_pl($){
my $not = shift; my $not = shift;
return not_split($not, 0);
return pi_split($not, 0);
} }


sub cell_index_rev($$){ sub cell_index_rev($$){
@@ -635,7 +597,6 @@ sub cell_index_rev($$){
sub cell_index($){ sub cell_index($){
my $chr1 = substr($_[0], 0,1); my $chr1 = substr($_[0], 0,1);
my $chr2 = substr($_[0], 1,length($_[0])-1); my $chr2 = substr($_[0], 1,length($_[0])-1);
# my ($chr1, $chr2) = (split(//, $_[0]));
return ($AXIS{$chr1}, $chr2); return ($AXIS{$chr1}, $chr2);
} }


@@ -652,18 +613,15 @@ sub apply_shift($$){
return cell_index_rev($r0, $c0); return cell_index_rev($r0, $c0);
} }


sub calc_move($$){
sub calc_new_cell($$){
my ($not, $mov) = (shift, shift); my ($not, $mov) = (shift, shift);
my $r0;
my $c0;
my ($c0, $r0) = cell_index($not);
my $x_shift; my $x_shift;
my $y_shift; my $y_shift;


my $n0; my $n0;
my $ni; my $ni;
($c0, $r0) = cell_index($not);


# get y_shift # get y_shift
$y_shift = $mov->[1]; $y_shift = $mov->[1];
@@ -672,51 +630,81 @@ sub calc_move($$){
$x_shift = $mov->[0]; $x_shift = $mov->[0];
# make x_shift adjustment # make x_shift adjustment

$ni = $y_shift != 0 ? ($y_shift / abs($y_shift)) : 1; $ni = $y_shift != 0 ? ($y_shift / abs($y_shift)) : 1;
# $ni *= -1;

# moving down: $ni == -1 want value of 0
# moving up: $ni == +1 want value of 1
$n0 = ($r0 + (($ni + 1)/2) ) % 2; $n0 = ($r0 + (($ni + 1)/2) ) % 2;
$x_shift += int(($y_shift + ($n0 * $ni)) / 2); $x_shift += int(($y_shift + ($n0 * $ni)) / 2);


return apply_shift($not, [$x_shift, $y_shift]); return apply_shift($not, [$x_shift, $y_shift]);
} }


sub get_mov($$){
my ($pi, $en) = (shift, shift);

my @mv1;

@mv1 = grep {
($_->{"type"} & $en) != 0
} @{$MOVE{$pi}};

return \@mv1;
}

sub find_all_mov($$){ sub find_all_mov($$){
my ($not, $en) = (shift, shift);
my $pi;
my @mv1;

$pi = cell_pi($not);
@mv1 = @{ get_mov($pi, $en) };

return grep { return grep {
$_ if $_->[0] ne $ERR_C_1;
$_ if $_->[0] ne $ERR_C_1
} map { } map {
[ [
calc_move($_[1], $_->{"mov"}),
calc_new_cell($not, $_->{"mov"}),
$_->{"type"} $_->{"type"}
] ]
} @{$_[0]};
} @mv1;
} }


sub shade_mvmt($$){
sub shade_pi_mvmt($$){
my ($not, $en) = (shift, shift); my ($not, $en) = (shift, shift);
my $c1; my $c1;
my @mv1; my @mv1;

$c1 = cell_pi($not);

@mv1 = grep {
($_->{"type"} & $en) eq $_->{"type"}
} @{$MOVE{$c1}};
@mv1 = find_all_mov(\@mv1, $not);
@mv1 = find_all_mov($not, $en);
for my $mv (@mv1){ for my $mv (@mv1){
shade_cell($mv->[0], $mv->[1]); shade_cell($mv->[0], $mv->[1]);
} }
} }


sub get_block_cell(){
sub shade_all_mvmt($){
my $pl;
my @pi1;
$pl = shift;

@pi1 = grep {
cell_pl($_) eq $pl
} keys(%board);

for my $el (@pi1){
shade_pi_mvmt($el, $MOVBLOCK_ENUM);
}
}

sub get_block_cell($){
my $pl;

$pl = shift;
return map { return map {
$_->[0] $_->[0]
} map { } map {
( find_all_mov([gb1($_)], $_) );
( find_all_mov($_, $BLOCK_ENUM) );
} grep {
cell_pl($_) eq $pl
} keys(%board); } keys(%board);
} }


@@ -740,21 +728,17 @@ binmode(STDOUT, ":utf8");


# my $m1 = "F7"; # my $m1 = "F7";
my $m1 = "C10"; my $m1 = "C10";
my $m2 = "C3";
my $m2 = "B3";
my $c1 = $MG_SY; my $c1 = $MG_SY;
my $c2 = $MG_A; my $c2 = $MG_A;


$board{$m1} = $P1.$DIV.$c1; $board{$m1} = $P1.$DIV.$c1;
$board{$m2} = $P1.$DIV.$c2;
$board{$m2} = $P2.$DIV.$c2;



for my $el (get_block_cell()){
for my $el (get_block_cell($P1)){
printf("%s\n", $el); printf("%s\n", $el);
} }


shade_mvmt($m1, $MOVBLOCK_ENUM);
shade_all_mvmt($P1);
disp_board(); disp_board();






Cargando…
Cancelar
Guardar