/[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 3 - (hide annotations)
Sun Aug 26 10:26:13 2007 UTC (11 years, 11 months ago) by dpavlin
File MIME type: text/plain
File size: 2957 byte(s)
- show board and trace side-by-side
- wait on enter after each step (interactive, wow!)
- shape tracing function extracted
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 dpavlin 3 my @trace;
31 dpavlin 1
32     # line length
33     my $ll = 8 * 2 + 1;
34    
35 dpavlin 3 my @step_name = ( qw/right down left up/ );
36     my @move_by = ( 1, $ll, -1, -$ll );
37     my $step = 0; # right
38    
39     # offset 0, top-left corner
40     my $pos = 0;
41    
42     # unknown trace position
43     my $unknown = ' ';
44    
45 dpavlin 1 sub draw {
46     my $o = 0;
47     my $out;
48     while ( $o < $#board ) {
49 dpavlin 3 $out .= join('', @board[ $o .. $o + $ll - 1 ]);
50     $out .= ' ';
51     $out .= join('', @trace[ $o .. $o + $ll - 1 ]);
52     $out .= "\n";
53 dpavlin 1 $o += $ll;
54     }
55     return $out;
56     }
57    
58     sub trace {
59 dpavlin 3 warn "## trace $pos\n";
60 dpavlin 1 $trace[ $pos ] = $board[ $pos ];
61     }
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 dpavlin 3 sub shape {
104 dpavlin 1
105 dpavlin 3 my ($x,$y) = @_;
106 dpavlin 1
107 dpavlin 3 $pos = $y * $ll * 2 + $x * 2;
108    
109     warn "<<< shape from $x,$y pos: $pos\n";
110     @trace = ($unknown) x ( $#board + 1 );
111     trace;
112    
113     my $len = 0;
114    
115     while( 1 ) {
116    
117     my $next_pos = $pos + $move_by[ $step ];
118     warn "in loop - pos = $pos next_pos = $next_pos step = $step $step_name[$step]\n";
119    
120     if ( $trace[ $next_pos ] ne $unknown ) {
121     warn "position $next_pos re-visited, exiting\n";
122     last;
123     } elsif ( $board[ $next_pos ] =~ $ok_path ) {
124     warn "OK next_pos = $next_pos b($board[$next_pos]) t($trace[$next_pos])\n";
125     move;
126     $len++;
127     can_turn( $step + 1 );
128     } else {
129     warn "find line continuation from $step $step_name[$step]...\n";
130     can_turn( $step - 1 ) || can_turn( $step + 1 ) || die "can't find new direction";
131     }
132     warn draw( @trace );
133    
134     print "WAIT> press enter"; my $foo = <STDIN>;
135 dpavlin 1 }
136    
137 dpavlin 3 warn ">>> ended at $pos, line length: $len\n";
138     return $len;
139 dpavlin 1 }
140    
141 dpavlin 3 my $shapes = '0,0 1,0';
142 dpavlin 1
143 dpavlin 3 foreach my $start ( split(/\s/,$shapes) ) {
144     my $len = shape( split(/,/,$start) );
145     warn "## $start has $len elements\n";
146     }

Properties

Name Value
svn:executable

  ViewVC Help
Powered by ViewVC 1.1.26