support binary-star; WiP

#8
shlomif · Jan 12, 2024 · 883d31e · 883d31e
1 parent 0fc6a4b
commit 883d31e
Show file tree

Hide file tree

Showing 2 changed files with 34 additions and 5 deletions.
diff --git a/...litaire/Games-Solitaire-BlackHole-Solver/lib/Games/Solitaire/BlackHole/Solver/App/Base.pm b/...litaire/Games-Solitaire-BlackHole-Solver/lib/Games/Solitaire/BlackHole/Solver/App/Base.pm
@@ -1,6 +1,7 @@
 package Games::Solitaire::BlackHole::Solver::App::Base;
 
 use Moo;
+use utf8;
 use Getopt::Long     qw/ GetOptions /;
 use Pod::Usage       qw/ pod2usage /;
 use Math::Random::MT ();
@@ -16,6 +17,7 @@ has [
     '_board_cards',
     '_board_lines',
     '_board_values',
+    '_display_boards',
     '_init_foundation',
     '_init_queue',
     '_init_tasks_configs',
@@ -109,7 +111,31 @@ sub _trace_solution
 LOOP:
     while ( ( $prev_state, $col_idx ) = @{ $self->_positions->{$state} } )
     {
+        my $outboard = sub {
+            if ( not $self->_display_boards )
+            {
+                return;
+            }
+            my $ret = '';
+            while ( my ( $i, $col ) = each( @{ $self->_board_cards } ) )
+            {
+                my $prevlen = vec( $prev_state, $offset + $i, 4 );
+                my $iscurr  = ( $col_idx == $i );
+                my @c       = @$col[ 0 .. $prevlen - 1 ];
+                if ($iscurr)
+                {
+                    foreach my $x ( $c[-1] )
+                    {
+                        $x = "[ $x → ]";
+                    }
+                }
+                $ret .= join( " ", ":", @c ) . "\n";
+            }
+            push @moves, $ret;
+            return;
+        };
         last LOOP if not defined $prev_state;
+        $outboard->();
         push @moves,
             (
             ( $col_idx == @{ $self->_board_cards } )
@@ -249,7 +275,8 @@ sub _process_cmd_line
     my ( $self, $args ) = @_;
 
     $self->_should_show_maximal_num_played_cards(0);
-    my $quiet = '';
+    my $display_boards = '';
+    my $quiet          = '';
     my $output_fn;
     my ( $help, $man, $version );
     my @tasks;
@@ -264,9 +291,10 @@ sub _process_cmd_line
     };
     $push_task->();
     GetOptions(
-        "o|output=s" => \$output_fn,
-        "quiet!"     => \$quiet,
-        "next-task"  => sub {
+        "display-boards!" => \$display_boards,
+        "o|output=s"      => \$output_fn,
+        "quiet!"          => \$quiet,
+        "next-task"       => sub {
             $push_task->();
             return;
         },
@@ -332,6 +360,7 @@ sub _process_cmd_line
         exit(0);
     }
 
+    $self->_display_boards($display_boards);
     $self->_quiet($quiet);
     my $output_handle;
 

diff --git a/black-hole-solitaire/scripts/binary_star-pat-perl-range-solve.bash b/black-hole-solitaire/scripts/binary_star-pat-perl-range-solve.bash
@@ -1,7 +1,7 @@
 mkdir -p boards
 ~/progs/freecell/git/fc-solve/fc-solve/source/board_gen/gen-multiple-pysol-layouts --dir boards/ --game binary_star --prefix binary_star --suffix .board seq 1 10000
 (
-  perl_cmd_line="perl -Ilib bin/black-hole-solve --num-foundations 2"
+  perl_cmd_line="perl -Ilib bin/black-hole-solve --num-foundations 2 --display-boards"
   c_cmd_line="./black-hole-solve --game binary_star --display-boards"
   cmd="$c_cmd_line"
   cmd="$perl_cmd_line"