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
|
package main;
use Vector2;
use Carp;
sub deep_copy {
my ($x) = @_;
my ($type) = ref $x;
if (not $type) {
return $x;
} elsif ($type eq "ARRAY") {
if (grep { /[^\d\.e+-]/i } @$x) {
return [ map { deep_copy($_) } @$x ];
} else {
return Vector2->new(@$x);
}
} elsif ($type eq "HASH") {
return { map { $_=>deep_copy($x->{$_}) } keys %$x };
} elsif (grep { $type eq $_ } qw(CODE) ){
# shallow copy
return $x;
} elsif (grep { $type eq $_ } qw(SCALAR REF GLOB LVALUE) ){
carp "don't know how to deep copy a $type. shallow copying\n";
return $x;
} else {
# Objects (blessed references): do shallow copy
# Also, Vector's are processed by this case, but it has a clone
# operator "=" which in fact performs deep copying.
return $x;
}
}
sub po2 {
my ($n) = @_;
my ($r) = 1;
while ($n > 0) { $r += $r; --$n; }
while ($n < 0) { $r /= 2; ++$n; }
return $r;
}
sub parent_class {
my ($CLASS) = @_;
my (@PAR) = eval "@" . $CLASS . "::ISA";
die "sorry, can't deal with multiple inheritance: \@${CLASS}::ISA=(@PAR)"
if $#PAR > 0;
return $PAR[0];
}
sub print_hash {
my ($h) = @_;
my ($k);
print "{";
foreach $k (keys %$h) {
print " $k:$h->{$k}";
}
print " }\n";
}
### these are used in Heap and BST
sub rc2xy {
my ($host, $VC, $r, $c) = @_;
# $VC is the class name of vertices in $host
my ($lv, $x, $size, $t);
$lv = $host->cget(-dispheight);
$x = ($c+0.5) * po2($lv-$r+1);
$x = Vector2->new( $x+0.5, $r+0.5 );
# $x->[1] += ($c % 2) ? -0.2 : 0.2 if ($r >= $lv);
$t = $host->cget(-node_opts);
$size = ( ref $t and $t->{-size} ) ? $t->{-size} : Configurable::cget($VC, -size);
return $x->pw_mul($size)->pw_mul($host->cget(-skip) + 1);
}
1;
|
