/[symmetry-circle]/symmetry.pl
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /symmetry.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (hide annotations)
Sun Aug 26 09:20:07 2007 UTC (11 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 2512 byte(s)
cleanup
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    

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26