# 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 " \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;