1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
# Author: Chao-Kuei Hung
# For more info, including license, please see doc/index.html
package Board;
# Rectangular board of grids
use strict;
use Carp;
use vars qw(@ISA);
@ISA = qw(Collection);
use Collection;
use Vertex;
sub new {
my ($class, %opts) = @_;
$class = ref($class) if ref($class);
my ($self) = $class->SUPER::new(%opts);
my ($i, $j);
%opts = %{ $self->cget(-node_opts) };
# as always, the host should take care of prepending %opts with -node_opts
for ($i=0; $i<$self->cget(-height); ++$i) {
for ($j=0; $j<$self->cget(-width); ++$j) {
$self->{"#grid"}[$i][$j] = Vertex->new($self,
$self->rc2xy($i, $j), %opts);
}
}
return $self;
}
sub rc2xy {
my ($self, $r, $c) = @_;
my ($t, $size);
$t = $self->cget(-node_opts);
$size = ( ref $t and $t->{-size} ) ? $t->{-size} : Configurable::cget("Vertex", -size);
return Vector2->new($c+0.6, $r+0.6)->pw_mul($size)->pw_mul($self->cget(-skip) + 1);
}
sub cell {
my ($self, $i, $j) = @_;
return $self->{"#grid"}[$i][$j];
}
#sub v_configure {
# my ($self, $k, %opts) = @_;
##print " <H::v_c ", ref $opts{-content}, "/$opts{-content}>\n";
# $self->{"#vertex_reservoir"}[$k]->configure(%opts);
# return if ($k <= 1);
# delete @opts{ qw(-shape -size -text -display -content) };
# $self->{"#edge_reservoir"}[$k]->configure(%opts);
#}
#
## content of $k-th vertex
#sub vc {
# my ($self, $k) = @_;
# return $self->{"#vertex_reservoir"}[$k]->cget(-content);
#}
$::Config->{Board} = {
-skip => Vector2->new(0, 0),
-node_opts => {
-shape => "rectangle",
}
};
if ($0 =~ /Board.pm$/) {
# being tested as a stand-alone program, so run test code.
require "utilalgo";
my ($mw, $ctrl, $can);
$mw = MainWindow->new(-title=>"main_test");
$can->{main} = gen_can($mw, undef, -elevation=>1, -maxlevel=>3);
$ctrl = gen_ctrl($mw, $can);
{ package main; require "dp/lcs"; }
::lcs("AGCTATACGATGACT", "GTCAGTATAGTCATATG", $can->{main});
# $can->{main}->set_mark(1);
$ctrl->configure(-recorder=>0);
# If the canvas refuses to show any change, remember to verify that:
# - set_mark() was called at least once
# - -recorder is set to zero before entering MainLoop
# Failing to do either of the above will result in a mysterious bug
# that takes days to figure out !@#$%
Tk::MainLoop();
}
1;
|
