1
###################################################
5
# From Graphics Gems IV.
7
# This is an example of the controller class:
8
# the routines set_wh and mouse_moved are the standard routines.
10
# This needs a faster implementation (?)
12
package PDL::Graphics::TriD::QuaterController;
13
use base qw(PDL::Graphics::TriD::ButtonControl);
14
use fields qw /Inv Quat/;
17
my($type,$win,$inv,$quat) = @_;
18
my $this = $type->SUPER::new($win);
22
$this->{Quat} = (defined($quat) ? $quat :
23
new PDL::Graphics::TriD::Quaternion(1,0,0,0));
24
$win->add_resizecommand(sub {$this->set_wh(@_)});
30
$x -= $this->{W}/2; $y -= $this->{H}/2;
31
$x /= $this->{SC}; $y /= $this->{SC};
33
return $this->normxy2qua($x,$y);
37
my($this,$x0,$y0,$x1,$y1) = @_;
39
# print "ARCBALL: $x0,$y0,$x1,$y1,$this->{W},$this->{H},$this->{SC}\n";
40
# Convert both to quaternions.
42
my ($qua0,$qua1) = ($this->xy2qua($x0,$y0),$this->xy2qua($x1,$y1));
44
# print "ARCBALLQ: ",(join ', ',@$qua0)," ",(join ', ',@$qua1),"\n";
46
my $arc = $qua1->multiply($qua0->invert());
48
# my $arc = $qua0->invert()->multiply($qua1);
51
$arc->invert_rotation_this();
53
$this->{Quat}->set($arc->multiply($this->{Quat}));
55
# print "ARCBALLQ: ",(join ', ',@$arc)," ",(join ', ',@{$this->{Quat}}),"\n";
56
# $this->{Quat}->set($this->{Quat}->multiply($arc));
57
1; # signals a refresh
63
package PDL::Graphics::TriD::ArcBall;
64
use base qw/PDL::Graphics::TriD::QuaterController/;
66
# x,y to unit quaternion on the sphere.
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);
75
# Tjl's version: a cone - more even change of
76
package PDL::Graphics::TriD::ArcCone;
78
use base qw/PDL::Graphics::TriD::QuaterController/;
80
# x,y to unit quaternion on the sphere.
83
my $dist = sqrt ($x ** 2 + $y ** 2);
84
if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0;}
86
my $qua = PDL::Graphics::TriD::Quaternion->new(0,$x,$y,$z);
87
$qua->normalize_this();
91
# Tjl's version2: a bowl -- angle is proportional to displacement.
92
package PDL::Graphics::TriD::ArcBowl;
94
use base qw/PDL::Graphics::TriD::QuaterController/;
96
# x,y to unit quaternion on the sphere.
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();