~ubuntu-branches/ubuntu/lucid/pdl/lucid

« back to all changes in this revision

Viewing changes to Graphics/TriD/TriD/ArcBall.pm

  • Committer: Bazaar Package Importer
  • Author(s): Ben Gertzfield
  • Date: 2002-04-08 18:47:16 UTC
  • Revision ID: james.westby@ubuntu.com-20020408184716-0hf64dc96kin3htp
Tags: upstream-2.3.2
ImportĀ upstreamĀ versionĀ 2.3.2

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
###################################################
 
2
#
 
3
#       ArcBall.pm
 
4
#
 
5
#       From Graphics Gems IV.
 
6
#
 
7
# This is an example of the controller class:
 
8
# the routines set_wh and mouse_moved are the standard routines.
 
9
#
 
10
# This needs a faster implementation (?)
 
11
 
 
12
package PDL::Graphics::TriD::QuaterController;
 
13
use base qw(PDL::Graphics::TriD::ButtonControl);
 
14
use fields qw /Inv Quat/;
 
15
 
 
16
sub new {
 
17
  my($type,$win,$inv,$quat) = @_;
 
18
  my $this = $type->SUPER::new($win);
 
19
  
 
20
 
 
21
  $this->{Inv} = $inv;
 
22
  $this->{Quat} = (defined($quat) ? $quat :
 
23
                        new PDL::Graphics::TriD::Quaternion(1,0,0,0));
 
24
  $win->add_resizecommand(sub {$this->set_wh(@_)});
 
25
  return $this;
 
26
}
 
27
 
 
28
sub xy2qua {
 
29
        my($this,$x,$y) = @_;
 
30
        $x -= $this->{W}/2; $y -= $this->{H}/2;
 
31
        $x /= $this->{SC}; $y /= $this->{SC};
 
32
        $y = -$y;
 
33
        return $this->normxy2qua($x,$y);
 
34
}
 
35
 
 
36
sub mouse_moved {
 
37
        my($this,$x0,$y0,$x1,$y1) = @_;
 
38
 
 
39
#       print "ARCBALL: $x0,$y0,$x1,$y1,$this->{W},$this->{H},$this->{SC}\n";
 
40
# Convert both to quaternions.
 
41
 
 
42
        my ($qua0,$qua1) = ($this->xy2qua($x0,$y0),$this->xy2qua($x1,$y1));
 
43
 
 
44
#       print "ARCBALLQ: ",(join ', ',@$qua0),"     ",(join ', ',@$qua1),"\n";
 
45
 
 
46
        my $arc = $qua1->multiply($qua0->invert());
 
47
 
 
48
#       my $arc = $qua0->invert()->multiply($qua1);
 
49
 
 
50
        if($this->{Inv}) {
 
51
                $arc->invert_rotation_this();
 
52
        }
 
53
        $this->{Quat}->set($arc->multiply($this->{Quat}));
 
54
 
 
55
        #       print "ARCBALLQ: ",(join ', ',@$arc),"     ",(join ', ',@{$this->{Quat}}),"\n";
 
56
        #       $this->{Quat}->set($this->{Quat}->multiply($arc));
 
57
        1;  # signals a refresh
 
58
}
 
59
 
 
60
#
 
61
# Original ArcBall
 
62
#
 
63
package PDL::Graphics::TriD::ArcBall;
 
64
use base qw/PDL::Graphics::TriD::QuaterController/;
 
65
 
 
66
# x,y to unit quaternion on the sphere.
 
67
sub normxy2qua {
 
68
        my($this,$x,$y) = @_;
 
69
        my $dist = sqrt ($x ** 2 + $y ** 2);
 
70
        if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
 
71
        my $z = sqrt(1-$dist**2);
 
72
        return PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
 
73
}
 
74
 
 
75
# Tjl's version: a cone - more even change of
 
76
package PDL::Graphics::TriD::ArcCone;
 
77
 
 
78
use base qw/PDL::Graphics::TriD::QuaterController/;
 
79
 
 
80
# x,y to unit quaternion on the sphere.
 
81
sub normxy2qua {
 
82
        my($this,$x,$y) = @_;
 
83
        my $dist = sqrt ($x ** 2 + $y ** 2);
 
84
        if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
 
85
        my $z = 1-$dist;
 
86
        my $qua = PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
 
87
        $qua->normalize_this();
 
88
        return $qua;
 
89
}
 
90
 
 
91
# Tjl's version2: a bowl -- angle is proportional to displacement.
 
92
package PDL::Graphics::TriD::ArcBowl;
 
93
 
 
94
use base qw/PDL::Graphics::TriD::QuaterController/;
 
95
 
 
96
# x,y to unit quaternion on the sphere.
 
97
sub normxy2qua {
 
98
        my($this,$x,$y) = @_;
 
99
        my $dist = sqrt ($x ** 2 + $y ** 2);
 
100
        if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
 
101
        my $z = cos($dist*3.142/2);
 
102
        my $qua = PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
 
103
        $qua->normalize_this();
 
104
        return $qua;
 
105
}
 
106
 
 
107
 
 
108
 
 
109
1;