Deliantra-Client/DC/Texture.pm

=head1 NAME

DC::Texture - texture class for Deliantra-Client

=head1 SYNOPSIS

 use DC::Texture;

=head1 DESCRIPTION

=over 4

=cut

package DC::Texture;

use common::sense;

use List::Util qw(max min);
use DC::OpenGL;

my %TEXTURES;
my ($MAX_W, $MAX_H) = (4096, 4096); # maximum texture size attempted by this module

sub new {
   my ($class, %data) = @_;

   my $self = bless {
      internalformat => GL_RGBA,
      format         => GL_RGBA,
      type           => GL_UNSIGNED_BYTE,
      %data,
   }, $class;

   DC::weaken ($TEXTURES{$self+0} = $self);

   $self->upload
      unless delete $self->{delay};

   $self
}

sub new_from_image {
   my ($class, $image, %arg) = @_;

   Carp::confess "tried to create texture from undefined image"
      unless defined $image;

   $class->new (image => $image, internalformat => undef, %arg)
}

sub new_from_resource {
   my ($class, $path, %arg) = @_;

   $class->new (resource_path => $path, internalformat => undef, %arg)
}

#sub new_from_surface {
#   my ($class, $surface) = @_;
#
#   $surface->rgba;
#
#   $class->new (
#      data   => $surface->pixels,
#      w      => $surface->width,
#      h      => $surface->height,
#   )
#}

#sub new_from_layout {
#   my ($class, $layout, %arg) = @_;
#
#   my ($w, $h, $data, $format, $internalformat) = $layout->render;
#
#   $class->new (
#      w              => $w,
#      h              => $h,
#      data           => $data,
#      format         => $format,
#      internalformat => $format,
#      type           => GL_UNSIGNED_BYTE,
#      %arg,
#   )
#}

sub new_from_opengl {
   my ($class, $w, $h, $cb) = @_;

   $class->new (w => $w || 1, h => $h || 1, render_cb => $cb, nearest => 1)
}

sub loading_done($$) {
   my ($self, $data) = @_;

   delete $self->{loading};
   ++$self->{delete_image};
   $self->{image} = $data;
   $self->upload;
}

sub upload {
   my ($self, $cb) = @_;

   push @{ $self->{upload_done} }, $cb
      if $cb;

   return if $self->{loading};

   unless ($GL_VERSION) {
      $self->{want_upload} = -1;
      return;
   }

   unless ($self->{name}) {
      # $tw,$th texture
      # $rw,$rh rendered/used size
      # $dw,$dh $data

      my ($data, $dw, $dh);

      if (exists $self->{resource_path}) {
         open my $fh, "<:raw", DC::find_rcfile $self->{resource_path};
         local $/;
         delete $self->{internalformat};
         $self->{image} = <$fh>;
         $self->{delete_image} = 1;
      }

      if (defined $self->{data}) {
         $data = $self->{data};
         ($dw, $dh) = @$self{qw(w h)};

      } elsif ($self->{render_cb}) {
         ($dw, $dh) = @$self{qw(w h)};

      } elsif (defined $self->{image}) {
         ($self->{w}, $self->{h}, $data, my $internalformat, $self->{format}, $self->{type})
            = DC::load_image_inline $self->{image};
        
         $self->{internalformat} ||= $internalformat;
         ($dw, $dh) = @$self{qw(w h)};
         
         delete $self->{image} if delete $self->{delete_image};

      } elsif (defined $self->{tile}) {
         ++$self->{loading};
         return DC::DB::get tilecache => $self->{tile}, sub {
            $self->loading_done ($_[0]);
         };

      } elsif (defined $self->{path}) {
         ++$self->{loading};
         return DC::DB::read_file $self->{path}, sub {
            $self->loading_done ($_[0]);
         };

      } else {
         Carp::confess "tried to create texture that is not data, render or image";
      }

      my ($tw, $th) = ($dw, $dh);

      defined $data or $self->{render_cb} or die; # some sanity check

      $self->{minified} ||= [DC::average $dw, $dh, $data]
         if $self->{minify};

      # against rather broken cards we enforce a maximum texture size
      $tw = min $MAX_W, $tw;
      $th = min $MAX_H, $th;

      # if only pot-textures are allowed, pot'ify tw/th
      unless ($GL_NPOT) {
         $tw = DC::minpot $tw;
         $th = DC::minpot $th;
      }

      # now further decrease texture size until the
      # card does accept it
      while (!texture_valid_2d $self->{internalformat}, $tw, $th, $self->{format}, $self->{type}) {
         # quarter the texture size
         $tw >>= 1;
         $th >>= 1;
      }

      # decide the amount of space used in the texture
      my ($rw, $rh);
      my ($ox, $oy); # area shift to lessen effect of buggy opengl implementations (nvida, ati)
      my $render;

      if ($self->{render_cb}) {
         # use only part of the texture
         #$rw >>= 1 while $rw > $tw;
         #$rh >>= 1 while $rh > $th;
         $rw = min $dw, $tw;
         $rh = min $dh, $th;
         ++$render;
      } else {
         if ($self->{wrap} || $tw < $dw || $th < $dh) {
            # scale to the full texture size
            ($rw, $rh) = ($tw, $th);
            ++$render;
         } else {
            # pad
            pad $data, $dw, $dh, $tw, $th;
            ($rw, $rh) = ($dw, $dh);
            ($dw, $dh) = ($tw, $th);
         }
      }

      if ($render) {
         $ox = int .5 * ($::WIDTH  - $rw);
         $oy = int .5 * ($::HEIGHT - $rh);

         glViewport $ox, $oy, $tw, $th;
         #glScissor 0, 0, $tw, $th;
         #glEnable GL_SCISSOR_TEST;
         glMatrixMode GL_PROJECTION;
         glLoadIdentity;
         glOrtho 0, $tw, 0, $th, -10000, 10000;
         glMatrixMode GL_MODELVIEW;
         glLoadIdentity;

         if ($self->{render_cb}) {
            glScale $rw / $dw, $rh / $dh;
            $self->{render_cb}->($self, $rw, $rh);
         } else {
            glClearColor 0, 0, 0, 0;
            glClear GL_COLOR_BUFFER_BIT;
            glPixelZoom $tw / $dw, $th / $dh;
            glRasterPos 0, 0;
            glDrawPixels $dw, $dh,
                         $self->{format},
                         $self->{type},
                         $data;
            glPixelZoom 1, 1;
         }
      }

      if ((my $name = delete $self->{want_upload}) > 0) {
         $self->{name} = $name;
      }

      glBindTexture GL_TEXTURE_2D, $self->{name} ||= glGenTexture;

      if ($self->{wrap}) {
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
      } else {
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
      }

      if ($::FAST || $self->{nearest}) {
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;
      } elsif ($self->{mipmap} && $GL_VERSION >= 1.4) {
         glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
      } else {
         glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap};
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
         glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;
      }
      
      glGetError;

      if ($render) {
         glCopyTexImage2D GL_TEXTURE_2D, 0,
                      $self->{internalformat},
                      $ox, $oy,
                      $tw, $th,
                      0;
         gl_check "copying to texture %dx%d if=%x",
                  $tw, $th, $self->{internalformat};

         #glDisable GL_SCISSOR_TEST;
      } else {
         my $if = $self->{internalformat};

         if ($GL_COMPRESS && $::CFG->{texture_compression}) {
            if ($if == GL_RGB) {
               $if = GL_COMPRESSED_RGB_ARB;
            } elsif ($if == GL_RGBA) {
               $if = GL_COMPRESSED_RGBA_ARB;
            }
         }

         glTexImage2D GL_TEXTURE_2D, 0,
                      $if,
                      $dw, $dh,
                      0,
                      $self->{format},
                      $self->{type},
                      $data;
         gl_check "uploading texture %dx%d if=%x f=%x t=%x",
                  $tw, $th, $self->{internalformat},  $self->{format}, $self->{type};
      }

      $self->{s} = $rw / $tw;
      $self->{t} = $rh / $th;

      if ($self->{tile}) {
         $::MAP->set_texture ($self->{tile}, @$self{qw(name w h s t)}, @{$self->{minified}})
            if $::MAP;
         $::MAPWIDGET->update
            if $::MAPWIDGET;
      }
   }

   $_->($self)
      for @{ (delete $self->{upload_done}) || [] };
}

sub unload {
   my ($self) = @_;

   glDeleteTexture delete $self->{name}
      if $self->{name};
} 

sub DESTROY {
   my ($self) = @_;

   delete $TEXTURES{$self+0};

   $self->unload;
}

$DC::OpenGL::INIT_HOOK{"DC::Texture"} = sub {
   for my $tex (values %TEXTURES) {
      if (my $name = $tex->{want_upload}) {
         $tex->upload;

         if ($tex->{loading} && $name > 0) {
            # if loading is delayed we still have to allocate the texture name
            glBindTexture GL_TEXTURE_2D, $name;
            glTexImage2D GL_TEXTURE_2D, 0, GL_ALPHA, 0, 0, 0, GL_ALPHA, GL_UNSIGNED_BYTE;
         }
      }
   }
};

$DC::OpenGL::SHUTDOWN_HOOK{"DC::Texture"} = sub {
   for (values %TEXTURES) {
      next unless $_->{name};
      $_->{want_upload} = $_->{name};
      $_->unload;
   }
};

1;

=back

=head1 AUTHOR

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/

=cut

Revision:	1.39
Committed:	Wed Jan 18 00:51:23 2012 UTC (12 years, 4 months ago) by root
Branch:	MAIN
CVS Tags:	HEAD
Changes since 1.38:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3	root	1.39	DC::Texture - texture class for Deliantra-Client
4	root	1.1
5			=head1 SYNOPSIS
6
7	root	1.31	use DC::Texture;
8	root	1.1
9			=head1 DESCRIPTION
10
11			=over 4
12
13			=cut
14
15	root	1.31	package DC::Texture;
16	root	1.1
17	root	1.38	use common::sense;
18	root	1.1
19	root	1.14	use List::Util qw(max min);
20	root	1.31	use DC::OpenGL;
21	root	1.1
22			my %TEXTURES;
23	root	1.14	my ($MAX_W, $MAX_H) = (4096, 4096); # maximum texture size attempted by this module
24	root	1.1
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	root	1.31	DC::weaken ($TEXTURES{$self+0} = $self);
36	root	1.1
37	root	1.25	$self->upload
38			unless delete $self->{delay};
39	root	1.1
40			$self
41			}
42
43			sub new_from_image {
44			my ($class, $image, %arg) = @_;
45
46	root	1.24	Carp::confess "tried to create texture from undefined image"
47			unless defined $image;
48
49	root	1.7	$class->new (image => $image, internalformat => undef, %arg)
50	root	1.1	}
51
52	root	1.35	sub new_from_resource {
53	root	1.1	my ($class, $path, %arg) = @_;
54
55	root	1.35	$class->new (resource_path => $path, internalformat => undef, %arg)
56	root	1.1	}
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	root	1.10	#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	root	1.1
86			sub new_from_opengl {
87			my ($class, $w, $h, $cb) = @_;
88
89	root	1.12	$class->new (w => $w \|\| 1, h => $h \|\| 1, render_cb => $cb, nearest => 1)
90	root	1.1	}
91
92	root	1.25	sub loading_done($$) {
93			my ($self, $data) = @_;
94
95			delete $self->{loading};
96			++$self->{delete_image};
97			$self->{image} = $data;
98			$self->upload;
99			}
100
101	root	1.1	sub upload {
102	root	1.25	my ($self, $cb) = @_;
103
104			push @{ $self->{upload_done} }, $cb
105			if $cb;
106
107			return if $self->{loading};
108
109			unless ($GL_VERSION) {
110	root	1.29	$self->{want_upload} = -1;
111	root	1.25	return;
112			}
113	root	1.1
114	root	1.25	unless ($self->{name}) {
115			# $tw,$th texture
116			# $rw,$rh rendered/used size
117			# $dw,$dh $data
118
119			my ($data, $dw, $dh);
120
121	root	1.35	if (exists $self->{resource_path}) {
122			open my $fh, "<:raw", DC::find_rcfile $self->{resource_path};
123			local $/;
124	root	1.36	delete $self->{internalformat};
125	root	1.35	$self->{image} = <$fh>;
126			$self->{delete_image} = 1;
127			}
128
129	root	1.27	if (defined $self->{data}) {
130	root	1.25	$data = $self->{data};
131			($dw, $dh) = @$self{qw(w h)};
132
133	root	1.27	} elsif ($self->{render_cb}) {
134	root	1.25	($dw, $dh) = @$self{qw(w h)};
135
136	root	1.27	} elsif (defined $self->{image}) {
137	root	1.25	($self->{w}, $self->{h}, $data, my $internalformat, $self->{format}, $self->{type})
138	root	1.31	= DC::load_image_inline $self->{image};
139	root	1.34
140	root	1.25	$self->{internalformat} \|\|= $internalformat;
141			($dw, $dh) = @$self{qw(w h)};
142
143			delete $self->{image} if delete $self->{delete_image};
144
145	root	1.27	} elsif (defined $self->{tile}) {
146	root	1.25	++$self->{loading};
147	root	1.31	return DC::DB::get tilecache => $self->{tile}, sub {
148	root	1.25	$self->loading_done ($_[0]);
149			};
150
151	root	1.27	} elsif (defined $self->{path}) {
152	root	1.25	++$self->{loading};
153	root	1.31	return DC::DB::read_file $self->{path}, sub {
154	root	1.25	$self->loading_done ($_[0]);
155			};
156	root	1.1
157	root	1.25	} else {
158			Carp::confess "tried to create texture that is not data, render or image";
159			}
160	root	1.16
161	root	1.25	my ($tw, $th) = ($dw, $dh);
162	root	1.1
163	root	1.25	defined $data or $self->{render_cb} or die; # some sanity check
164	root	1.1
165	root	1.31	$self->{minified} \|\|= [DC::average $dw, $dh, $data]
166	root	1.25	if $self->{minify};
167	root	1.1
168	root	1.25	# against rather broken cards we enforce a maximum texture size
169	root	1.28	$tw = min $MAX_W, $tw;
170			$th = min $MAX_H, $th;
171	root	1.7
172	root	1.25	# if only pot-textures are allowed, pot'ify tw/th
173	root	1.28	unless ($GL_NPOT) {
174	root	1.31	$tw = DC::minpot $tw;
175			$th = DC::minpot $th;
176	root	1.25	}
177	root	1.1
178	root	1.25	# now further decrease texture size until the
179			# card does accept it
180			while (!texture_valid_2d $self->{internalformat}, $tw, $th, $self->{format}, $self->{type}) {
181			# quarter the texture size
182			$tw >>= 1;
183			$th >>= 1;
184			}
185	root	1.16
186	root	1.25	# decide the amount of space used in the texture
187			my ($rw, $rh);
188	root	1.37	my ($ox, $oy); # area shift to lessen effect of buggy opengl implementations (nvida, ati)
189	root	1.25	my $render;
190	root	1.1
191	root	1.25	if ($self->{render_cb}) {
192			# use only part of the texture
193			#$rw >>= 1 while $rw > $tw;
194			#$rh >>= 1 while $rh > $th;
195			$rw = min $dw, $tw;
196			$rh = min $dh, $th;
197			++$render;
198			} else {
199			if ($self->{wrap} \|\| $tw < $dw \|\| $th < $dh) {
200			# scale to the full texture size
201			($rw, $rh) = ($tw, $th);
202			++$render;
203			} else {
204			# pad
205			pad $data, $dw, $dh, $tw, $th;
206			($rw, $rh) = ($dw, $dh);
207			($dw, $dh) = ($tw, $th);
208			}
209			}
210	root	1.1
211	root	1.25	if ($render) {
212			$ox = int .5 * ($::WIDTH - $rw);
213			$oy = int .5 * ($::HEIGHT - $rh);
214
215			glViewport $ox, $oy, $tw, $th;
216			#glScissor 0, 0, $tw, $th;
217			#glEnable GL_SCISSOR_TEST;
218			glMatrixMode GL_PROJECTION;
219			glLoadIdentity;
220			glOrtho 0, $tw, 0, $th, -10000, 10000;
221			glMatrixMode GL_MODELVIEW;
222			glLoadIdentity;
223
224			if ($self->{render_cb}) {
225			glScale $rw / $dw, $rh / $dh;
226			$self->{render_cb}->($self, $rw, $rh);
227			} else {
228			glClearColor 0, 0, 0, 0;
229			glClear GL_COLOR_BUFFER_BIT;
230			glPixelZoom $tw / $dw, $th / $dh;
231			glRasterPos 0, 0;
232			glDrawPixels $dw, $dh,
233			$self->{format},
234			$self->{type},
235			$data;
236			glPixelZoom 1, 1;
237			}
238			}
239	root	1.16
240	root	1.29	if ((my $name = delete $self->{want_upload}) > 0) {
241			$self->{name} = $name;
242			}
243
244	root	1.25	glBindTexture GL_TEXTURE_2D, $self->{name} \|\|= glGenTexture;
245	root	1.14
246	root	1.25	if ($self->{wrap}) {
247			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT;
248			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT;
249			} else {
250			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
251			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, $GL_VERSION >= 1.2 ? GL_CLAMP_TO_EDGE : GL_CLAMP;
252			}
253	root	1.14
254	root	1.25	if ($::FAST \|\| $self->{nearest}) {
255			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST;
256			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST;
257			} elsif ($self->{mipmap} && $GL_VERSION >= 1.4) {
258			glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, 1;
259			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
260			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR;
261	root	1.16	} else {
262	root	1.25	glTexParameter GL_TEXTURE_2D, GL_GENERATE_MIPMAP, $self->{mipmap};
263			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR;
264			glTexParameter GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR;
265	root	1.16	}
266	root	1.25
267			glGetError;
268	root	1.16
269	root	1.25	if ($render) {
270			glCopyTexImage2D GL_TEXTURE_2D, 0,
271			$self->{internalformat},
272			$ox, $oy,
273			$tw, $th,
274			0;
275			gl_check "copying to texture %dx%d if=%x",
276			$tw, $th, $self->{internalformat};
277	root	1.1
278	root	1.25	#glDisable GL_SCISSOR_TEST;
279	root	1.14	} else {
280	root	1.26	my $if = $self->{internalformat};
281
282			if ($GL_COMPRESS && $::CFG->{texture_compression}) {
283			if ($if == GL_RGB) {
284			$if = GL_COMPRESSED_RGB_ARB;
285			} elsif ($if == GL_RGBA) {
286			$if = GL_COMPRESSED_RGBA_ARB;
287			}
288			}
289
290	root	1.25	glTexImage2D GL_TEXTURE_2D, 0,
291	root	1.26	$if,
292	root	1.25	$dw, $dh,
293			0,
294	root	1.14	$self->{format},
295			$self->{type},
296			$data;
297	root	1.25	gl_check "uploading texture %dx%d if=%x f=%x t=%x",
298			$tw, $th, $self->{internalformat}, $self->{format}, $self->{type};
299	root	1.14	}
300	root	1.1
301	root	1.25	$self->{s} = $rw / $tw;
302			$self->{t} = $rh / $th;
303	root	1.27
304			if ($self->{tile}) {
305			$::MAP->set_texture ($self->{tile}, @$self{qw(name w h s t)}, @{$self->{minified}})
306			if $::MAP;
307			$::MAPWIDGET->update
308			if $::MAPWIDGET;
309			}
310	root	1.1	}
311
312	root	1.25	$_->($self)
313			for @{ (delete $self->{upload_done}) \|\| [] };
314	root	1.1	}
315
316	root	1.25	sub unload {
317	root	1.8	my ($self) = @_;
318
319	root	1.25	glDeleteTexture delete $self->{name}
320	root	1.8	if $self->{name};
321			}
322
323	root	1.1	sub DESTROY {
324			my ($self) = @_;
325
326			delete $TEXTURES{$self+0};
327
328	root	1.25	$self->unload;
329	root	1.1	}
330
331	root	1.31	$DC::OpenGL::INIT_HOOK{"DC::Texture"} = sub {
332	root	1.32	for my $tex (values %TEXTURES) {
333			if (my $name = $tex->{want_upload}) {
334			$tex->upload;
335
336			if ($tex->{loading} && $name > 0) {
337			# if loading is delayed we still have to allocate the texture name
338			glBindTexture GL_TEXTURE_2D, $name;
339			glTexImage2D GL_TEXTURE_2D, 0, GL_ALPHA, 0, 0, 0, GL_ALPHA, GL_UNSIGNED_BYTE;
340			}
341			}
342	root	1.25	}
343	root	1.1	};
344
345	root	1.31	$DC::OpenGL::SHUTDOWN_HOOK{"DC::Texture"} = sub {
346	root	1.25	for (values %TEXTURES) {
347			next unless $_->{name};
348	root	1.29	$_->{want_upload} = $_->{name};
349	root	1.25	$_->unload;
350			}
351	root	1.8	};
352
353	root	1.1	1;
354
355			=back
356
357			=head1 AUTHOR
358
359			Marc Lehmann <schmorp@schmorp.de>
360			http://home.schmorp.de/
361
362			=cut
363