File: Board.pm

package info (click to toggle)
algotutor 0.8.6-4
  • links: PTS, VCS
  • area: main
  • in suites: bookworm, bullseye, sid
  • size: 576 kB
  • sloc: perl: 2,563; makefile: 41; php: 24; sh: 1
file content (90 lines) | stat: -rw-r--r-- 2,337 bytes parent folder | download | duplicates (2)
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;