um, here's the part where I feel stupid... there already *is* a VRML module for perl! :) This is why we check cpan first!! I'm going to check it out today and see what it does and if anything I'm doing can be added. <sound of hand slapping forehead
Last updated: Fri May 11 10:41:47 EDT 2001
This code is continually evolving. I will be updating it as I update my own source, and I hope to have community involvement in it. This module provides (almost) an OO Interface for the VRML language.
links of interest to those wanting to experiment with VRML:
feel free to add links, just /msg me.
So, without further ado:
package VRML;
use strict;
use warnings;
# NOTES: I tend to use 2-space tabs and vim. you emacs guys can easily
# accomodate to that. in vim the command is:
# :set tabstop=2
# :set autoindent
# homogenous code is good mmmkay
# a hash containing arrayrefs with colors in the VRML notation
# which is slightly different than the HTML notation.
# possibly include a function to convert HTML color notation
# (0F0F0F) to VRML notation (0 1 0).
our %colors =
( RED => [1, 0, 0],
GREEN => [0, 1, 0],
BLUE => [0, 0, 1],
WHITE => [1, 1, 1],
BLACK => [0, 0, 0],
);
# TODO: This needs work. I want to keep this small, but at present
# if a user enters "false" it returns "TRUE". So something similarly
# simply, perhaps a regex...
# return ($_[0] && $_[0] !~ m[false]i) ? "TRUE" : "FALSE"
sub etf {
return $_[0] ? "TRUE" : "FALSE";
}
# The VRML::Object packages are complex OO style perl objects.
# they return an object with the data necessary to create an
# object from the VRML OO interface. They do not currently render
# anything.
# TODO: change_location
# TODO: render (print?)
# TODO: add_to_group
# TODO: add is_sphere, is_box, et cetera
# TODO: add a VRML::Group package.
# TODO: add a VRML::Properties package.
# the sphere package
package VRML::Sphere;
# object constructor
sub new {
my $self = shift;
bless {
{ radius => $radius,
properties => $properties
}, $self
}
# the box (cuboid) package
package VRML::Box;
# object constructor
sub new {
my $self = shift;
my ( $depth, $width, $height,
$properties
)
= (@_);
bless {
{ depth => $depth,
width => $width,
height => $height,
properties => $properties,
}, $self
}
}
package VRML::Cylinder;
# object constructor
sub new {
my $self = shift;
my ( $height, $radius, $bottom,
$side, $top, $properties
)
= (@_);
bless {
{ height => $height,
radius => $radius,
bottom => $bottom,
side => $side,
top => $top,
properties => $properties,
}, $self
}
}
package VRML::Cone;
# object constructor
sub new {
my $self = shift;
my ( $height, $bottom_radius, $side,
$bottom, $properties
)
= (@_);
bless {
{ height => $height,
side => $side,
bottom => $bottom,
properties => $properties,
bottom_radius => $bottom_radius,
}, $self
}
}
package VRML::Properties;
# proper names for our properties
our %prop_hash =
( emissive => "emissiveColor",
diffuse => "diffuseColor",
shininess => "shininess",
specular => "specularColor",
transp => "transparency",
);
# XXX: this has not been tested.
sub simple_properties {
my $self = shift;
my %attribs = %{ shift() };
my %mad_props; # i just couldnt resist.
# we convert the easy names "emissive" to the proper VRML names
# here so that we dont have to trust the user with not making typos
# and things of that nature (essentially emissive => emissiveColor )
+.
foreach my $attribute (keys %attribs) {
my $translate = $prop_hash{$attribute};
$mad_props{$translate} = $attribs{$attribute};
}
bless { %mad_props }, $self;
}
# The VRML::Simple package simply returns text in a scalar
# that can then be printed out to a .wrl file easily. It does not
# currently allow for translations (movement) or textures or any
# of that. probably the user would be better off using the full
# OO Interface due to the complexity of the VRML syntax.
# XXX: it is currently included as a precursor to the OO interface
# and, while ready for 'production' use, bound to change.
package VRML::Simple;
sub primitive_sphere {
my ($radius, $properties) = (@_);
return << "EOR";
Shape {
$properties
geometry Sphere {
radius $radius
}
}
EOR
}
sub primitive_box {
my ($depth, $width, $height, $properties) = (@_);
return << "EOR";
Shape {
$properties
geometry Box {
size $depth $width $height
}
}
EOR
}
sub primitive_cone {
my ($bottom_radius, $height, $side, $bottom, $properties) = (@_);
$side = etf( $side );
$bottom = etf( $side );
return << "EOR";
Shape {
$properties
geometry Cone {
bottomRadius $bottom_radius
height $height
side $side
bottom $bottom
}
}
EOR
}
sub primitive_cylinder {
my ($height, $radius, $bottom, $side, $top, $properties) = (@_);
$$bottom = etf( $bottom );
$side = etf( $side );
$top = etf( $top );
return << "EOR";
Shape {
$properties
geometry Cylinder {
height $height
radius $radius
bottom $bottom
side $side
top $top
}
}
EOR
}
sub simple_properties {
my %properties = %{ shift() };
my ($emissive, $diffuse, $shininess, $specular, $transp);
foreach my $property (keys %properties) {
if ($property eq "emissive") {
$emissive = "emissiveColor @{$properties{ $property }} ";
}
elsif ($property eq "diffuse") {
$diffuse = "diffuseColor @{$properties{ $property }} ";
}
elsif ($property eq "shininess") {
$shininess = "shininess @{$properties{ $property }} ";
}
elsif ($property eq "specular") {
$specular = "specularColor @{$properties{ $property }} ";
}
elsif ($property eq "transparency") {
$transp = "transparency @{$properties{ $property }} ";
}
}
return <<"EOR";
appearance Appearance {
material Material {
$emissive
$diffuse
$shininess
$specular
$transp
}
}
EOR
}
sub directional_light {
my ($amb_intensity, $color_r, $direction_r, $intensity, $on) = (@_);
my @color = @{ $color_r };
my @direction = @{ $direction_r };
$on = etf( $on );
return <<"EOR";
DirectionalLight {
ambientIntensity $amb_intensity
color @color
direction @direction
intensity $intensity
on $on
}
EOR
}
sub point_light {
my ( $amb_intensity, $color_r, $intensity,
$location_r, $on, $radius
)
= (@_);
my @color = @{ $color_r };
my @location = @{ $location_r };
$on = etf( $on );
return <<"EOR";
PointLight {
ambientIntensity $amb_intensity
color @color
intensity $intensity
location @location
on $on
radius $radius
}
EOR
}
sub spot_light {
my ( $amb_intensity, $beam_width, $color_r,
$cutoff, $direction_r, $intensity,
$location_r, $on, $radius
)
= (@_);
my @color = @{ $color_r };
my @location = @{ $location_r };
my @direction = @{ $direction_r };
$on = etf( $on );
return <<"EOR";
SpotLight {
ambientIntensity $amb_intensity
beamWidth $beam_width
color @color
cutOffAngle $cutoff
direction @direction
intensity $intensity
location @location
on $on
radius $radius
}
EOR
}
=cut
=pod
=head1 SYNOPSIS
VRML - Object Oriented Interface to the Virtual Reality Modelling La
+nguage
Provides an object-oriented interface to the Virtual Reality
Modelling Language in a manner consistent with the CGI module
(which renders HTML).
Both a simple (non-object) and a complex (object) interface are
provided so small and large tasks alike can be completed and undertake
+n
easily.
use VRML::Simple;
print start_vrml, primitive_box( $depth, $width, $height, [ $propert
+ies ] );
my $sphere = VRML::Sphere -> new( $radius, [ $properties ] );
Note that the [ $properties ] is not a list reference but instead an o
+ptional
parameter to the constructor.
=end
=head1
