viewvc.cgi/symmetry-circle/symmetry.pl

#!/usr/bin/perl -w

# symmetry.pl
#
# 08/26/07 02:40:37 CEST Dobrica Pavlinusic <dpavlin@rot13.org>

use strict;

my $board = << '_BOARD_';
+-+-+-+-+-+-+-+-+
| |   |o| |     |
+ +   +-+ +-+   |
|o|   |  o  | o |
+ +   +-+ +-+   |
| |  o  | |     |
+-+-+   +-+-+-+-+
|   |   |o|     |
+-+ +   +-+-+ +-+
| |o|   |o|o|o|o|
+ + +-+-+-+-+ +-+
|o|   |   |     |
+ +-+-+-+-+-+-+-+
| |      o      |
+-+-+-+-+-+-+-+-+
|    o    |  o  |
+-+-+-+-+-+-+-+-+
_BOARD_

my @board = map { split(//) } split(/\n/, $board);

# line length
my $ll = 8 * 2 + 1;

sub draw {
        my @board = @_;
        my $o = 0;
        my $out;
        while ( $o < $#board ) {
                $out .= join('', @board[ $o .. $o + $ll - 1 ]) . "\n";
                $o += $ll;
        }
        return $out;
}

print $board, draw( @board );

my @step_name = ( qw/right down left up/ );
my @move_by = ( 1, $ll, -1, -$ll );
my $step = 0;   # right

# offset 0, top-left corner
my $pos = shift @ARGV || 0;

my @trace = ('x') x ( $#board + 1 );
sub trace {
        warn "trace $pos\n";
        $trace[ $pos ] = $board[ $pos ];
}

warn draw( @trace );
trace;

sub move {
        warn "move $step $step_name[$step]\n";
        $pos += $move_by[ $step ];
        trace;
        $pos += $move_by[ $step ];
        trace;
        warn draw( @trace );
}

sub follow {
        $step = shift;
        $step %= 4;
        warn "follow $step $step_name[$step]\n";
}

my $ok_path = qr/[\|\-]/;

sub can_turn {
        my $try_step = shift;
        die "no step?" unless defined $try_step;

        $try_step %= 4;

        my $turn_pos = $pos + $move_by[$try_step];

        my $old = $trace[ $turn_pos ];
        $trace[ $turn_pos ] = '?';
        warn "TEST\n",draw( @trace );
        $trace[ $turn_pos ] = $old;

        if ( $board[ $turn_pos ] =~ $ok_path ) {
                warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
                $step = $try_step;
                return 1;
        } else {
                warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
                return 0;
        }
}

while( 1 ) {

        my $next_pos = $pos + $move_by[ $step ];
        warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n";

        if ( $trace[ $next_pos ] ne 'x' ) {
                warn "position $next_pos re-visited, exiting\n";
                last;
        } elsif ( $board[ $next_pos ] =~ $ok_path ) {
                warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
                move;
                can_turn( $step + 1 );
        } else {
                warn "find line continuation from $step $step_name[$step]...\n";
                can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction";
        }
        warn draw( @trace );

}

warn "ended at $pos\n";

1	dpavlin	1	#!/usr/bin/perl -w
2
3			# symmetry.pl
4			#
5			# 08/26/07 02:40:37 CEST Dobrica Pavlinusic <dpavlin@rot13.org>
6
7			use strict;
8
9			my $board = << '_BOARD_';
10			+-+-+-+-+-+-+-+-+
11			\| \| \|o\| \| \|
12			+ + +-+ +-+ \|
13			\|o\| \| o \| o \|
14			+ + +-+ +-+ \|
15			\| \| o \| \| \|
16			+-+-+ +-+-+-+-+
17			\| \| \|o\| \|
18			+-+ + +-+-+ +-+
19			\| \|o\| \|o\|o\|o\|o\|
20			+ + +-+-+-+-+ +-+
21			\|o\| \| \| \|
22			+ +-+-+-+-+-+-+-+
23			\| \| o \|
24			+-+-+-+-+-+-+-+-+
25			\| o \| o \|
26			+-+-+-+-+-+-+-+-+
27			_BOARD_
28
29			my @board = map { split(//) } split(/\n/, $board);
30
31			# line length
32			my $ll = 8 * 2 + 1;
33
34			sub draw {
35			my @board = @_;
36			my $o = 0;
37			my $out;
38			while ( $o < $#board ) {
39			$out .= join('', @board[ $o .. $o + $ll - 1 ]) . "\n";
40			$o += $ll;
41			}
42			return $out;
43			}
44
45			print $board, draw( @board );
46
47			my @step_name = ( qw/right down left up/ );
48			my @move_by = ( 1, $ll, -1, -$ll );
49			my $step = 0; # right
50
51			# offset 0, top-left corner
52	dpavlin	2	my $pos = shift @ARGV \|\| 0;
53	dpavlin	1
54			my @trace = ('x') x ( $#board + 1 );
55			sub trace {
56			warn "trace $pos\n";
57			$trace[ $pos ] = $board[ $pos ];
58			}
59
60			warn draw( @trace );
61			trace;
62
63			sub move {
64			warn "move $step $step_name[$step]\n";
65			$pos += $move_by[ $step ];
66			trace;
67			$pos += $move_by[ $step ];
68			trace;
69			warn draw( @trace );
70			}
71
72			sub follow {
73			$step = shift;
74			$step %= 4;
75			warn "follow $step $step_name[$step]\n";
76			}
77
78			my $ok_path = qr/[\\|\-]/;
79
80			sub can_turn {
81	dpavlin	2	my $try_step = shift;
82			die "no step?" unless defined $try_step;
83	dpavlin	1
84	dpavlin	2	$try_step %= 4;
85	dpavlin	1
86	dpavlin	2	my $turn_pos = $pos + $move_by[$try_step];
87
88	dpavlin	1	my $old = $trace[ $turn_pos ];
89			$trace[ $turn_pos ] = '?';
90			warn "TEST\n",draw( @trace );
91			$trace[ $turn_pos ] = $old;
92
93			if ( $board[ $turn_pos ] =~ $ok_path ) {
94	dpavlin	2	warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
95			$step = $try_step;
96	dpavlin	1	return 1;
97			} else {
98	dpavlin	2	warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
99	dpavlin	1	return 0;
100			}
101			}
102
103			while( 1 ) {
104
105			my $next_pos = $pos + $move_by[ $step ];
106			warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n";
107
108			if ( $trace[ $next_pos ] ne 'x' ) {
109			warn "position $next_pos re-visited, exiting\n";
110			last;
111			} elsif ( $board[ $next_pos ] =~ $ok_path ) {
112			warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
113			move;
114	dpavlin	2	can_turn( $step + 1 );
115	dpavlin	1	} else {
116			warn "find line continuation from $step $step_name[$step]...\n";
117	dpavlin	2	can_turn( $step - 1 ) \|\| can_turn( $step + 1 ) \|\| die "can't find new direction";
118	dpavlin	1	}
119			warn draw( @trace );
120
121			}
122
123			warn "ended at $pos\n";
124