lpst.pl - added horrible system for shading cells

This commit is contained in:
gashapwn 2021-04-04 14:23:13 +00:00
parent 00b7fc7b84
commit b2165befe6

101
lpst.pl
View File

@ -5,6 +5,11 @@ use strict;
use utf8;
my $XBOX_CHR = chr(0x2573);
my $SHADE_CHR = chr(0x2591);
my $ALT_US = chr(0x2017);
my $ALT_PIPE = chr(0x2016);
my $PAD_AXIS = " ";
my $PAD_EVEN = " ";
my $PAD_ODD = " ";
@ -13,16 +18,20 @@ my $HEX_1 = '-/--\-';
my $HEX_2 = '| __ |';
my $HEX_3 = '| |';
my $XBOX_CHR = chr(0x2573);
my $SHADE_CHR = chr(0x2591);
my $ALT_US = chr(0x2017);
my $ALT_PIPE = chr(0x2016);
my $HEX_S_1 = '-/--\-';
my $HEX_S_2 = sprintf("|%s==%s|", $SHADE_CHR, $SHADE_CHR);
my $HEX_S_3 = sprintf("|%s%s%s%s|", $SHADE_CHR, $SHADE_CHR, $SHADE_CHR, $SHADE_CHR);
# my $HEX_S_1 = '-/--\-';
# my $HEX_S_2 = '|'.$SHADE_CHR.'__'.$SHADE_CHR.'|';
# my $HEX_S_3 = '|'.$SHADE_CHR.$SHADE_CHR.$SHADE_CHR.$SHADE_CHR.'|';
my $HL_1 = "|_____";
my $HL_2 = $ALT_PIPE.$ALT_US.$ALT_US.$ALT_US.$ALT_US.$ALT_US;
my $SUB_CHR = "_";
my $ALT_SUB_CHR = $ALT_US;
my $ALT_SUB_CHR = "=";
my $BLANK_CELL_CHR = $ALT_US;
my $PREF_1 = substr($HEX_1, -2, 2);
my $PREF_2 = ' ';
@ -161,55 +170,114 @@ my %MOVE = (
# Special cells
my $EMPTY_CELL = "_";
# Shade enum
my $SHADED_ENUM = 1;
my $EMPTY_ENUM = 0;
my %SHADE = (
$SHADED_ENUM => [$HEX_S_1, $HEX_S_2, $HEX_S_3],
$EMPTY_ENUM => [$HEX_1, $HEX_2, $HEX_3]
);
my @sc0 = ();
my %board;
# Display pieces
#==================================================
sub f_1($$){
# I hate this function
sub f_1($$$){
my $p = shift;
my $c0 = shift;
my $hex = shift;
my $s0;
$p =~ s/($P1|$P2)$DIV//;
$p =~ s/$EMPTY_CELL//;
$p .= "__" if length($p) < 1;
$p .= "_" if length($p) < 2;
$s0 = $HEX_2;
$s0 = $hex;
$s0 =~ s/$SUB_CHR{1,2}/$p/;
if ($p eq "__"){
$s0 =~ s/$ALT_SUB_CHR{1,2}/$SHADE_CHR$SHADE_CHR/;
}else{
$p =~ s/_/$SHADE_CHR/;
$s0 =~ s/$ALT_SUB_CHR{1,2}/$p/;
}
if($c0 % 2 == 0){
$s0 =~ s/$SUB_CHR/$ALT_SUB_CHR/g;
$s0 =~ s/$SUB_CHR/$BLANK_CELL_CHR/g;
}
return $s0;
}
# Display shade
#==================================================
sub shade_cell($){
my $not = shift;
push(@sc0, $not) unless shade_t($not);
}
sub shade_t($){
my $not = shift;
return $SHADED_ENUM if grep /^$not$/, @sc0;
return $EMPTY_ENUM;
}
sub get_shade_chr($){
my $en = shift;
return $SHADE{$en};
}
sub shade_lookup($$){
my ($r0, $c0) = (shift, shift);
my $not;
$not = cell_index_rev($c0, $r0);
return get_shade_chr(shade_t($not));
}
# Display lines
#==================================================
sub disp_1($$){
my ($r0, $c0) = (shift, shift);
return $HEX_1;
my $hex;
$hex = shade_lookup($r0, $c0)->[0];
return $hex;
# return $HEX_1;
}
sub disp_2($$){
my ($r0, $c0) = (shift, shift);
my $p;
# Cell notation
my $not;
my $hex;
$hex = shade_lookup($r0, $c0)->[1];
$not = cell_index_rev($c0, $r0);
$p = $board{$not};
return f_1($p, $c0);
return f_1($p, $c0, $hex);
# my ($r0, $c0) = (shift, shift);
# return $HEX_2;
}
sub disp_3($$){
my ($r0, $c0) = (shift, shift);
return $HEX_3;
my $hex;
$hex = shade_lookup($r0, $c0)->[2];
return $hex;
}
sub disp_y_axis($$$$){
@ -360,6 +428,7 @@ sub disp_board(){
sub cell_index_rev($$){
return $AXIS_RV{$_[0]}.$_[1];
}
@ -430,9 +499,9 @@ my $m1 = "E6";
my $c1 = $MG_A;
$board{$m1} = $P1.$DIV.$c1;
# for my $mv (@{$MOVE{$c1}}){
# printf("%s\n", calc_move($m1, $mv));
# }
for my $mv (@{$MOVE{$c1}}){
printf("%s\n", calc_move($m1, $mv));
}
disp_board();