ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/Deliantra-Client/DC/Texture.pm
Revision: 1.6
Committed: Wed Jun 14 18:59:31 2006 UTC (18 years ago) by root
Branch: MAIN
Changes since 1.5: +0 -9 lines
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.1 =head1 NAME
2    
3     CFClient::Texture - tetxure class for CFClient
4    
5     =head1 SYNOPSIS
6    
7     use CFClient::Texture;
8    
9     =head1 DESCRIPTION
10    
11     =over 4
12    
13     =cut
14    
15     package CFClient::Texture;
16    
17     use strict;
18    
19     use Scalar::Util;
20    
21     use CFClient::OpenGL;
22    
23     my %TEXTURES;
24    
25     sub new {
26     my ($class, %data) = @_;
27    
28     my $self = bless {
29     internalformat => GL_RGBA,
30     format => GL_RGBA,
31     type => GL_UNSIGNED_BYTE,
32     %data,
33     }, $class;
34    
35     Scalar::Util::weaken ($TEXTURES{$self+0} = $self);
36    
37     $self->upload;
38    
39     $self
40     }
41    
42     sub new_from_image {
43     my ($class, $image, %arg) = @_;
44    
45     $class->new (image => $image, %arg)
46     }
47    
48     sub new_from_file {
49     my ($class, $path, %arg) = @_;
50    
51     open my $fh, "<:raw", $path
52     or die "$path: $!";
53    
54     local $/;
55     $class->new_from_image (<$fh>, %arg)
56     }
57    
58     #sub new_from_surface {
59     # my ($class, $surface) = @_;
60     #
61     # $surface->rgba;
62     #
63     # $class->new (
64     # data => $surface->pixels,
65     # w => $surface->width,
66     # h => $surface->height,
67     # )
68     #}
69    
70     sub new_from_layout {
71     my ($class, $layout, %arg) = @_;
72    
73     my ($w, $h, $data, $format, $internalformat) = $layout->render;
74    
75     $class->new (
76     w => $w,
77     h => $h,
78     data => $data,
79     format => $format,
80     internalformat => $format,
81     type => GL_UNSIGNED_BYTE,
82     %arg,
83     )
84     }
85    
86     sub new_from_opengl {
87     my ($class, $w, $h, $cb) = @_;
88    
89     $class->new (w => $w || 1, h => $h || 1, render_cb => $cb)
90     }
91    
92     sub upload {
93     my ($self) = @_;
94    
95     return unless $GL_VERSION;
96    
97     my $data;
98    
99     if (exists $self->{data}) {
100     $data = $self->{data};
101    
102     } elsif (exists $self->{render_cb}) {
103     glViewport 0, 0, $self->{w}, $self->{h};
104     glMatrixMode GL_PROJECTION;
105     glLoadIdentity;
106     glOrtho 0, $self->{w}, 0, $self->{h}, -10000, 10000;
107     glMatrixMode GL_MODELVIEW;
108     glLoadIdentity;
109     $self->{render_cb}->($self, $self->{w}, $self->{h});
110    
111     } else {
112     ($self->{w}, $self->{h}, $data, $self->{internalformat}, $self->{format}, $self->{type})
113     = CFClient::load_image_inline $self->{image};
114     }
115    
116     my ($tw, $th) = @$self{qw(w h)};
117    
118 root 1.3 $self->{minified} ||= [CFClient::average $tw, $th, $data]
119 root 1.1 if $self->{minify};
120    
121 root 1.5 pad2pot $data, $tw, $th unless $GL_NPOT;
122 root 1.1
123     $self->{s} = $self->{w} / $tw;
124     $self->{t} = $self->{h} / $th;
125    
126     $self->{name} ||= glGenTexture;
127    
128     glBindTexture GL_TEXTURE_2D, $self->{name};
129    
130 root 1.2 if ($self->{wrap}) {
131     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
132     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
133     } else {
134     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
135     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
136     }
137 root 1.1
138     if ($::FAST) {
139     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST;
140     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;
141     } elsif ($self->{mipmap} && $GL_VERSION >= 1.4) {
142     glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1;
143     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
144     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
145     } else {
146     glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap};
147     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
148     glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;
149     }
150    
151     glGetError;
152    
153     if (defined $data) {
154     glTexImage2D GL_TEXTURE_2D, 0,
155     $self->{internalformat},
156     $tw, $th,
157     0,
158     $self->{format},
159     $self->{type},
160     $data;
161     gl_check "uploading texture %dx%d if=%x f=%x t=%x",
162     $tw, $th, $self->{internalformat}, $self->{format}, $self->{type};
163     } else {
164     glCopyTexImage2D GL_TEXTURE_2D, 0,
165     $self->{internalformat},
166     0, 0,
167     $tw, $th,
168     0;
169     gl_check "copying to texture %dx%d if=%x",
170     $tw, $th, $self->{internalformat};
171     }
172     }
173    
174     sub DESTROY {
175     my ($self) = @_;
176    
177     delete $TEXTURES{$self+0};
178    
179     glDeleteTexture delete $self->{name}
180     if $self->{name};
181     }
182    
183     $CFClient::OpenGL::INIT_HOOK{"CFClient::Texture"} = sub {
184     $_->upload
185     for values %TEXTURES;
186     };
187    
188     1;
189    
190     =back
191    
192     =head1 AUTHOR
193    
194     Marc Lehmann <schmorp@schmorp.de>
195     http://home.schmorp.de/
196    
197     =cut
198