/[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 1 - (hide annotations)
Sun Aug 26 02:53:41 2007 UTC (11 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 2583 byte(s)
initial tracing of shapes

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

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26