lpst.pl - added horrible system for shading cells

lpst.pl

@@ -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();