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
76
77
78
79
80
81
82
83
84
85
86
87
|
# SDL::OpenGL::Cube
#
# unit cube model
#
package SDL::OpenGL::Cube;
use SDL;
use SDL::OpenGL;
use SDL::OpenGL::Constants;
use vars qw/ @ISA /;
require SDL::OpenGL::Model;
@ISA = qw/ SDL::OpenGL::Model /;
my $vertex_array = pack "d24",
-0.5,-0.5,-0.5, 0.5,-0.5,-0.5, 0.5,0.5,-0.5, -0.5,0.5,-0.5, # back
-0.5,-0.5,0.5, 0.5,-0.5,0.5, 0.5,0.5,0.5, -0.5,0.5,0.5 ; # front
my $indicies = pack "C24",
4,5,6,7, # front
1,2,6,5, # right
0,1,5,4, # bottom
0,3,2,1, # back
0,4,7,3, # left
2,3,7,6; # top
sub new {
my $proto = shift;
my $class = ref($proto) || $proto;
my $self = {};
bless $self,$class;
$self;
}
sub draw {
my ($self) = @_;
$self->color();
glEnableClientState(GL_VERTEX_ARRAY());
glVertexPointer(3,GL_DOUBLE(),0,$vertex_array);
glDrawElements(GL_QUADS(), 24, GL_UNSIGNED_BYTE(), $indicies);
}
sub color {
my ($self,@colors) = @_;
if (@colors) {
$$self{colored} = 1;
die "SDL::OpenGL::Cube::color requires 24 floating point color values\n"
unless (scalar(@colors) == 24);
$$self{-colors} = pack "f24",@colors;
}
if ($$self{colored}) {
glEnableClientState(GL_COLOR_ARRAY);
glColorPointer(3,GL_FLOAT,0,$$self{-colors});
} else {
glDisableClientState(GL_COLOR_ARRAY);
}
}
1;
__END__;
=pod
=head1 NAME
SDL::OpenGL::Cube
=head1 DESCRIPTION
This module demonstrates how to create a simple cube model in OpenGL
It can be used for creating more elaborate models. This is not intended
to be production level code, but rather a starting point for future
development of useful base models.
=head1 AUTHOR
David J. Goehrig
=head1 SEE ALSO
L<perl> L<SDL::OpenGL>
=cut
|
