/[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

Contents of /symmetry.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4 - (show annotations)
Sun Aug 26 10:59:01 2007 UTC (16 years, 7 months ago) by dpavlin
File MIME type: text/plain
File size: 3548 byte(s)
- remember path traversed to create shape
- wait for key after each step if started with any argument
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 $debug = shift @ARGV || 0;
30
31 my @board = map { split(//) } split(/\n/, $board);
32 my @trace;
33
34 # line length
35 my $ll = 8 * 2 + 1;
36
37 my @step_name = ( qw/right down left up/ );
38 my @move_by = ( 1, $ll, -1, -$ll );
39 my $step = 0; # right
40
41 # offset 0, top-left corner
42 my $pos = 0;
43
44 # unknown trace position
45 my $unknown = ' ';
46
47 # path traversed
48 my @directions;
49
50 my @found;
51
52 sub draw {
53 my $o = 0;
54 my $out;
55 while ( $o < $#board ) {
56 $out .= join('', @board[ $o .. $o + $ll - 1 ]);
57 $out .= ' ';
58 $out .= join('', @trace[ $o .. $o + $ll - 1 ]);
59 $out .= "\n";
60 $o += $ll;
61 }
62 return $out;
63 }
64
65 sub trace {
66 warn "## trace $pos\n";
67 $trace[ $pos ] = $board[ $pos ];
68 }
69
70 sub move {
71 warn "move $step $step_name[$step]\n";
72 $pos += $move_by[ $step ];
73 trace;
74 $pos += $move_by[ $step ];
75 trace;
76 push @directions, $step;
77 }
78
79 sub follow {
80 $step = shift;
81 $step %= 4;
82 warn "follow $step $step_name[$step]\n";
83 }
84
85 my $ok_path = qr/[\|\-]/;
86
87 sub can_turn {
88 my $try_step = shift;
89 die "no step?" unless defined $try_step;
90
91 $try_step %= 4;
92
93 my $turn_pos = $pos + $move_by[$try_step];
94
95 my $old = $trace[ $turn_pos ];
96 $trace[ $turn_pos ] = '?';
97 warn "TEST\n",draw( @trace );
98 $trace[ $turn_pos ] = $old;
99
100 if ( $board[ $turn_pos ] =~ $ok_path ) {
101 warn "OK can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
102 $step = $try_step;
103 return 1;
104 } else {
105 warn "NOPE can_turn $try_step $step_name[$try_step] turn_pos = $turn_pos b($board[$turn_pos]) t($trace[$turn_pos])";
106 return 0;
107 }
108 }
109
110 sub show_directions {
111 return
112 join('',
113 map {
114 substr($step_name[$_],0,1)
115 } @directions
116 )
117 ;
118 }
119
120 sub shape {
121
122 my ($x,$y) = @_;
123
124 $pos = $y * $ll * 2 + $x * 2;
125
126 warn "<<< shape from $x,$y pos: $pos\n";
127 @trace = ($unknown) x ( $#board + 1 );
128 @directions = ();
129 trace;
130
131 my $len = 0;
132
133 while( 1 ) {
134
135 my $next_pos = $pos + $move_by[ $step ];
136 warn "# pos: $pos next_pos: $next_pos step: $step $step_name[$step] trace: ",show_directions,"\n";
137
138 if ( $trace[ $next_pos ] ne $unknown ) {
139 warn "position $next_pos re-visited, exiting\n";
140 last;
141 } elsif ( $board[ $next_pos ] =~ $ok_path ) {
142 warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
143 move;
144 $len++;
145 can_turn( $step + 1 );
146 } else {
147 warn "find line continuation from $step $step_name[$step]...\n";
148 can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction";
149 }
150 warn draw( @trace );
151
152 if ( $debug ) {
153 print "WAIT> press enter | ",show_directions; my $foo = <STDIN>;
154 }
155 }
156
157 push @found, { x => $x, y => $y, len => $len, directions => show_directions };
158
159 warn ">>> ended at $pos, line length: $len, directions traversed: ",show_directions,"\n";
160 print "WAIT> press enter"; my $foo = <STDIN>;
161
162 return $len;
163 }
164
165 my $shapes = '0,0 1,0 0,3';
166
167 foreach my $start ( split(/\s/,$shapes) ) {
168 my $len = shape( split(/,/,$start) );
169 warn "## $start has $len elements\n";
170 }
171
172 print ">>> RESULTS:\n";
173 foreach my $r ( @found ) {
174 printf "%2d,%-2d len: %-4d directions: %s\n", $r->{x}, $r->{y}, $r->{len}, $r->{directions};
175 }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26