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

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