File: basic.pl

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 (75 lines) | stat: -rw-r--r-- 1,786 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
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;