| FreeWRL documentation | Contained in the FreeWRL distribution. |
VRML::Viewer -- navigation modes of FreeWRL
(used internally by FreeWRL)
This module implements the various navigation modes for the FreeWRL VRML browser (see VRML::Browser, freewrl). freewrl explains how to use the navigation modes.
Tuomas J. Lukka, with help from John Breen.
| FreeWRL documentation | Contained in the FreeWRL distribution. |
# Copyright (C) 1998 Tuomas J. Lukka # Portions Copyright (C) 1998 John Breen # DISTRIBUTED WITH NO WARRANTY, EXPRESS OR IMPLIED. # See the GNU Library General Public License (file COPYING in the distribution) # for conditions of use and redistribution. use strict qw/vars/; # # The different viewers for VRML::Browser. # # All viewers are given the current viewpoint node # and their own internal coordinate system (position+rotation) # from that. # # XXX Examine doesn't handle animated viewpoints at all! # The following is POD documentation for the freewrl command. # It will be automatically installed in a manual page upon make install. # See the perlpod manpage for the I<>, C<> &c explanation
package VRML::Viewer; require 'VRML/Quaternion.pm'; # Default gaze: -z, pos: z sub new { my($type,$old) = @_; my $this = bless { # For our viewpoint Pos => [0,0,10], Dist => 10, Quat => new VRML::Quaternion(1,0,0,0), # The viewpoint node at the time of the binding -- we have # to counteract it. # AntiPos is the real position, AntiQuat is inverted ;) AntiPos => [0,0,0], AntiQuat => new VRML::Quaternion(1,0,0,0), Navi => undef, }, $type; if($old) { $this->{Pos} = $old->{Pos}; $this->{Quat} = $old->{Quat}; $this->{Dist} = $old->{Dist}; $this->{AntiPos} = $old->{AntiPos}; $this->{AntiQuat} = $old->{AntiQuat}; $this->{Navi} = $old->{Navi}; } else { $this->{Navi} = VRML::Scene->new_node("NavigationInfo", VRML::Nodes->{NavigationInfo}{Defaults}); } $this->resolve_pos(); return $this; } sub use_keys { 0 } sub handle_tick { } sub bind_viewpoint { my($this,$node,$bind_info) = @_; if(defined $bind_info) { $this->{Pos} = $bind_info->[0]; $this->{Quat} = $bind_info->[1]; } else { $this->{Pos} = [@{$node->{Fields}{position}}]; $this->{Quat} = VRML::Quaternion->new_vrmlrot( @{$node->{Fields}{orientation}}); } $this->{AntiPos} = [@{$node->{Fields}{position}}]; $this->{AntiQuat} = VRML::Quaternion->new_vrmlrot( @{$node->{Fields}{orientation}})->invert; $this->resolve_pos(); } sub resolve_pos { } # hook to modify Pos & Quat, e.g. for Examine # Just restore these later... sub unbind_viewpoint { my($this,$node) = @_; return [$this->{Pos},$this->{Quat}]; } sub bind_navi_info { my($this,$node) = @_; $this->{Navi} = $node; } sub togl { my($this) = @_; $this->{Quat}->togl(); VRML::OpenGL::glTranslatef(map {-$_} @{$this->{Pos}}); VRML::OpenGL::glTranslatef(@{$this->{AntiPos}}); $this->{AntiQuat}->togl(); } package VRML::Viewer::None; @VRML::Viewer::None::ISA=VRML::Viewer; sub new { my($type, $loc, $ori) = @_; my $this = VRML::Viewer->new(); $this->{Pos} = $loc; $this->{Quat} = new_vrmlrot VRML::Quaternion(@$ori); return $this; } package VRML::Viewer::Walk; @VRML::Viewer::Walk::ISA=VRML::Viewer; sub handle { #my($this, $mev, $but, $mx, $my) = @_; ## print "VEIEVENT\n"; #if($mev eq "PRESS" and $but == 1) { # $this->{SY} = $my; # $this->{SX} = $mx; #} elsif($mev eq "DRAG" and $but == 1) { # my $yd = ($my - $this->{SY}); # my $xd = ($mx - $this->{SX}); # my $nv = $this->{Quat}->invert->rotate([0,0,0.15*$yd]); # for(0..2) {$this->{Pos}[$_] += $nv->[$_]} # my $nq = new VRML::Quaternion(1-0.2*$xd,0,0.2*$xd,0); # $nq->normalize_this; # $this->{Quat} = $nq->multiply($this->{Quat}); # print "WVIEW: (",(join ',',@{$this->{Quat}}),") (", # (join ',',@{$this->{Pos}}),") (", # (join ',',@{$nv}),") \n"; #} my($this, $mev, $but, $mx, $my) = @_; # print "VEIEVENT\n"; if($mev eq "PRESS" and $but == 1) { $this->{SY} = $my; $this->{SX} = $mx; } elsif($mev eq "PRESS" and $but == 3) { $this->{SY} = $my; $this->{SX} = $mx; } elsif($mev eq "DRAG" and $but == 1) { $this->{ZD} = ($my - $this->{SY}) * $this->{Navi}{Fields}{speed}; $this->{RD} = ($mx - $this->{SX}) * 0.1; } elsif($mev eq "DRAG" and $but == 3) { $this->{XD} = ($mx - $this->{SX}) * $this->{Navi}{Fields}{speed}; $this->{YD} = -($my - $this->{SY}) * $this->{Navi}{Fields}{speed}; } elsif ($mev eq "RELEASE") { if ($but == 1) { $this->{ZD} = 0; $this->{RD} = 0; } elsif ($but == 3) { $this->{XD} = 0; $this->{YD} = 0; } } } sub handle_tick { my($this, $time) = @_; # print "handle_tick: time=$time rd=$this->{RD} yd=$this->{YD} zd=$this->{ZD}\n"; my $nv = $this->{Quat}->invert->rotate([0.15*$this->{XD},0.15*$this->{YD},0.15*$this->{ZD}]); for(0..2) {$this->{Pos}[$_] += $nv->[$_]} my $nq = new VRML::Quaternion(1-0.2*$this->{RD},0,0.2*$this->{RD},0); $nq->normalize_this; $this->{Quat} = $nq->multiply($this->{Quat}); } # # The old routine # sub handle { # my($this, $mev, $but, $mx, $my) = @_; # # print "VEIEVENT\n"; # if($mev eq "PRESS" and $but == 1) { # $this->{SY} = $my; # $this->{SX} = $mx; # } elsif($mev eq "DRAG" and $but == 1) { # my $yd = ($my - $this->{SY}); # my $xd = ($mx - $this->{SX}); # my $nv = $this->{Quat}->invert->rotate([0,0,0.15*$yd]); # for(0..2) {$this->{Pos}[$_] += $nv->[$_]} # my $nq = new VRML::Quaternion(1-0.2*$xd,0,0.2*$xd,0); # $nq->normalize_this; # $this->{Quat} = $nq->multiply($this->{Quat}); # print "WVIEW: (",(join ',',@{$this->{Quat}}),") (", # (join ',',@{$this->{Pos}}),") (", # (join ',',@{$nv}),") \n"; # } # } sub ignore_vpcoords { return 0; } package VRML::Viewer::Fly; # Modeled after Descent(tm) ;) @VRML::Viewer::Fly::ISA=VRML::Viewer; # # Members: # Velocity - current velocity as 3-vector # # Do nothing for the mouse sub use_keys { 1 } sub handle { } sub handle_key { my($this,$time,$key) = @_; $key = lc $key; $this->{Down}{$key} = 1; } sub handle_keyrelease { my($this,$time,$key) = @_; # print "KEYREL!\n"; $key = lc $key; $this->{WasDown}{$key} += $this->{Down}{$key}; delete $this->{Down}{$key}; } { my @aadd; my @radd; my %actions = ( a => sub {$aadd[2] -= $_[0]}, z => sub {$aadd[2] += $_[0]}, j => sub {$aadd[0] -= $_[0]}, l => sub {$aadd[0] += $_[0]}, p => sub {$aadd[1] += $_[0]}, ';' => sub {$aadd[1] -= $_[0]}, 8 => sub {$radd[0] += $_[0]}, k => sub {$radd[0] -= $_[0]}, u => sub {$radd[1] -= $_[0]}, o => sub {$radd[1] += $_[0]}, 7 => sub {$radd[2] -= $_[0]}, 9 => sub {$radd[2] += $_[0]}, ); my $lasttime = -1; sub handle_tick { my($this, $time) = @_; if(!defined $this->{Velocity}) {$this->{Velocity} = [0,0,0]} if(!defined $this->{AVelocity}) {$this->{AVelocity} = [0,0,0]} if($lasttime == -1) {$lasttime = $time;} # First, get all the keypresses since the last time my %ps; for(keys %{$this->{Down}}) { $ps{$_} += $this->{Down}{$_}; } for(keys %{$this->{WasDown}}) { $ps{$_} += delete $this->{WasDown}{$_}; } undef @aadd; undef @radd; for(keys %ps) { if(exists $actions{$_}) { $actions{$_}->($ps{$_}?1:0); # print "Act: '$_', $ps{$_}\n"; } } my $v = $this->{Velocity}; my $ind = 0; my $dt = $time-$lasttime; for(@$v) {$_ *= 0.06 ** ($dt); $_ += $dt * $aadd[$ind++] * 14.5; if(abs($_) > 9.0) {$_ /= abs($_)/9.0} } my $nv = $this->{Quat}->invert->rotate( [map {$_ * $dt} @{$this->{Velocity}}] ); for(0..2) {$this->{Pos}[$_] += $nv->[$_]} my $av = $this->{AVelocity}; $ind = 0; my $sq; for(@$av) {$_ *= 0.04 ** ($dt); $_ += $dt * $radd[$ind++] * 0.1; if(abs($_) > 0.8) {$_ /= abs($_)/0.8;} $sq += $_*$_; } my $nq = new VRML::Quaternion(1,@$av); $nq->normalize_this; $this->{Quat} = $nq->multiply($this->{Quat}); # print "HANDLE_TICK($dt): @aadd | @{$this->{Velocity}} | @$nv\n"; $lasttime = $time; } } package VRML::Viewer::Examine; @VRML::Viewer::Examine::ISA=VRML::Viewer; # Semantics: given a viewpoint and orientation, # we take the center to revolve around to be the closest point to origin # on the z axis. sub resolve_pos { my($this) = @_; my $z = $this->{Quat}->invert->rotate([0,0,1]); # my $l = 0; for(0..2) {$l += $this->{Pos}[$_]**2} $l = sqrt($l); my $d = 0; for(0..2) {$d += $this->{Pos}[$_] * $z->[$_]} $this->{Origin} = [ map {$this->{Pos}[$_] - $d * $z->[$_]} 0..2 ]; $this->{Dist} = $d; } # Mev: PRESS, DRAG sub handle { my($this, $mev, $but, $mx, $my) = @_; # print "HANDLE $mev $but $mx $my\n"; if($mev eq "PRESS" and $but == 1) { # print 'PRESS\n'; $this->{SQuat} = $this->xy2qua($mx,$my); $this->{OQuat} = $this->{Quat}; } elsif($mev eq "DRAG" and $but == 1) { my $q = $this->xy2qua($mx,$my); my $arc = $q->multiply($this->{SQuat}->invert()); # print "Arc: ",(join ' ',@$arc),"\n"; $this->{Quat} = $arc->multiply($this->{OQuat}); # print "Quat:\t\t\t\t ",(join ' ',@{$this->{Quat}}),"\n"; # $this->{Quat} = $this->{OQuat}->multiply($arc); # print "DRAG1: (", # (join ',',@{$this->{SQuat}}), ") (", # (join ',',@{$this->{OQuat}}), ")\n (", # (join ',',@$q), ")\n (", # (join ',',@$arc), ") (", # (join ',',@{$this->{Quat}}), ")\n", } elsif($mev eq "PRESS" and $but == 3) { $this->{SY} = $my; $this->{ODist} = $this->{Dist}; } elsif($mev eq "DRAG" and $but == 3) { $this->{Dist} = $this->{ODist} * exp($this->{SY} - $my); } $this->{Pos} = $this->{Quat}->invert->rotate([0,0,$this->{Dist}]); for(0..2) {$this->{Pos}[$_] += $this->{Origin}[$_]} # print "POS: ",(join ' ',@{$this->{Pos}}),"\n"; # print "QUASQ: ",$this->{Quat}->abssq,"\n"; # print "VIEW: (",(join ',',@{$this->{Quat}}),") (", # (join ',',@{$this->{Pos}}),")\n"; } sub change_viewpoint { my($this, $jump, $push, $ovp, $nvp) = @_; if($push == 1) { # Pushing the ovp under - must store stuff... $ovp->{Priv}{viewercoords} = [ $this->{Dist}, $this->{Quat} ]; } elsif($push == -1 && $jump && $nvp->{Priv}{viewercoords}) { ($this->{Dist}, $this->{Quat}) = @{$nvp->{Priv}{viewercoords}}; } if($push == -1) { delete $ovp->{Priv}{viewercoords}; } if(!$jump) {return} my $f = $nvp->getfields(); my $p = $f->{position}; my $o = $f->{orientation}; my $os = sin($o->[3]); my $oc = cos($o->[3]); $this->{Dist} = sqrt($p->[0]**2 + $p->[1]**2 + $p->[2]**2); $this->{Quat} = new VRML::Quaternion( $oc, map {$os * $_} @{$o}[0..2]); } # Whether to ignore the internal VP coords aside from jumps? sub ignore_vpcoords { return 1; } # ArcCone from TriD sub xy2qua { my($this, $x, $y) = @_; # print "XY2QUA: $x $y\n"; $x -= 0.5; $y -= 0.5; $x *= 2; $y *= 2; $y = -$y; my $dist = sqrt($x**2 + $y**2); # print "DXY: $x $y $dist\n"; if($dist > 1.0) {$x /= $dist; $y /= $dist; $dist = 1.0} my $z = 1-$dist; # print "Z: $z\n"; my $qua = VRML::Quaternion->new(0,$x,$y,$z); # print "XY2QUA: $x $y ",(join ',',@$qua),"\n"; $qua->normalize_this(); # print "XY2QUA: $x $y ",(join ',',@$qua),"\n"; return $qua; } 1;