#!/usr/bin/perl -w

# This is the package Texture. It handles texture name->number conversion, and vice versa

# Annotations: see doc/notes.txt

# (c) Copyright by Tels 1999. All Rights Reserved. Do NOT distribute.
# Updates and support on bloodgate.com/thief
# Thanx to Doug Church at TLG

# [09/12/99] v0.0.1 - from scratch
# [09/18/99] v0.0.2 - some minor fixes
# [09/30/99] v0.0.3 - speedup, added numTextures, create("mapfile") works now
#                     loadMapping adds now texture numbers of additional mapping
#                     files correctly
# [10/23/99] v0.0.4 - can read texture map from VBR, asText
# 1999-11-12 v0.0.5 - support for texture hashes
# 1999-12-01 v0.0.6 - random textures revised
# 2000-02-28 v0.0.7 - better matching for texture names
# 2000-04-17 v0.0.8 - added: asHash

package Cowgen::Texture;
require Exporter;
@ISA     = qw(Exporter);
@EXPORT  = qw(
           floortile metal naturestone wood bricks earthsand createTexture
           randTexture
           );
@EXPORT_OK = qw( asHash );

use Cowgen::Dromed;

#doc: texture loadMapping 
#doc: textureName textureLName numTextures
#doc: asText create 
#doc: weightedList

my $VERSION = 0.08;

sub create 
  { 
  # create a texture mapping object
  my $c = shift; my $s = {}; bless $s, $c; $s->init( shift ); return $s; 
  }

sub init
  {
  my $s = shift; 
  $s->{textures} = {}; $s->{textnum} = {}; # empty hashs
  my $n = shift; $s->loadMapping ($n) if (defined $n);
  }

sub DESTROY
  {
  # no cleanup needed 
  # print "destroyed!\n";
  }

sub createTexture
  {
  # create a texture hash to pass it as texture value to bunch or other functions
  # This is needed if you dont want just to set the texture number, but the s,v,u,r 
  # values, too.
  # parameters: t (texture index), s (scale), r (rotation), u (shift u), v (shift v)
  my $txt = {};
  my ($t,$s,$r,$u,$v) = @_;
  $txt->{t} = $t || -1;
  $txt->{s} = $s || 16;
  # dont make keys with undefined values, skip them entirely
  $txt->{r} = $r if (defined $r);
  $txt->{u} = $u if (defined $u);
  $txt->{v} = $v if (defined $v);
  return $txt; # texture hash
  }

sub weightedList
  {
  # take the names (or a texture hash containing name, s, u,v,r etc if you need scaling)
  # and weight and for each existing texturename create an entry in the list, and then
  # return this as a ref to the list
  # parameters: ref_to_anon_hash (key = texture name; value = texture weight or ref to 
  # anon hash containing name; weight; s;u;v; and/or r)
  my $s = shift;
  my ($h) = @_;
  my ($n,$list,$hash,$txt);  
  $list = [];
  foreach (keys %$h)
    {
    $n = $s->texture ($_);
    next if (!defined $n) || ($n == -1);   
    $hash = {}; 
    $txt = $h->{$_}; 
    if (ref($txt) eq "HASH")
      { 
      $hash->{w} = $txt->{w} || 1; # weight
      $hash->{s} = $txt->{s} if (defined $txt->{s}); 
      $hash->{r} = $txt->{r} if (defined $txt->{r}); 
      $hash->{u} = $txt->{u} if (defined $txt->{u}); 
      $hash->{v} = $txt->{v} if (defined $txt->{v}); 
      } 
    else
      {
      $hash->{w} = $txt || 1; # weight
      }
    $hash->{t} = $n; 
    push (@$list, $hash);
    }
  $list; # list of textures
  }

sub randTexture
  {
  # from a prev. created list (see txtList()) select one by random honouring weights
  # and return either as number or texture hash (depending on what the lst entry was)
  my $list = shift;
  my $all = 0;
  my ($w,$r);
  # make sum of weights
  foreach (@$list)
    {
    $w = $_->{w} || 1;
    $all += $w;
    }
  $r = rand($all); # make random number
  $e = 0;
  foreach (@$list)
    {
    $w = $_->{w} || 1; $e += $w;
    return $_ if ($r < $e); 
    }
  $e = int(rand(scalar @$list+1));
  print "Oups, didnt find random value in range 0..$r, selecting $e as random index.\n";
  return @$list[$e]; # return random one if no ones did fit (shouldnt happen)
  }

sub randTextureOld
  {
  # usage: $number = randTexture (class); class = floortile(), bricks() etc
  my $self = shift;
  my $c = shift || 0;
  my $tlist = $self->{textures};
  my (@f,$t,@tx);
  foreach $t (keys %$tlist)
    {
    @f = split(';',$tlist->{$t}); 
    push (@tx,$f[0]) if ((defined $f[2]) && ($f[2] == $c));
    }
  my $count = scalar @tx;
  return -1 if ($count == 0);
  return $tx[int(rand($count))]; 
  }

sub texture
  {
  # usage: $number = texture ("name");
  my $self = shift;
  my $name = lc(shift); # lower case
  my $tlist = $self->{textures};
  my (@f,$t,$r);
  if (defined $tlist->{$name})
    {
    @f = split(';',$tlist->{$name}); return $f[0];
    }
  # not found, so try to match it by substrings
  # first look for complete texture names
  foreach $t (keys %$tlist)
    {
    $r = $t; $r =~ s/.*\///g; 
    # print "Looking at $r ($t) or $name\n";
    if ($r eq $name)
      { 
      @f = split(';',$tlist->{$t}); return $f[0] 
      }
    }
  # look now for any substring
  foreach $t (keys %$tlist)
    {
    @f = split(';',$tlist->{$t}); 
    if (($t =~ /$name/) || ($f[1] =~ /$name/))
      {
      return $f[0];
      }
    }
  return -1;
  }

sub textureName
  {
  # return name of texture
  my $self = shift;
  my $num = shift || 0;
  my (@f);
  @f = split(';',$self->{textnum}->{$num}) if (defined $self->{textnum}->{$num}); 
  return ($f[1] || -1); 
  }

sub textureLName
  {
  # return long name of texture
  my $self = shift;
  my $num = shift || 0;
  my (@f);
  @f = split(";",$self->{textnum}->{$num}) if (defined $self->{textnum}->{$num}); 
  return ($f[3] || -1); 
  }

sub loadMapping
  {
  # add/load a mapping from file or binary data (Vbr)
  my $self = shift;
  my $file = shift || "core.map";
  my $min = $self->numTextures();
  my ($n,@f); 
  if (ref ($file) ne "HASH")
    { 
    $file = "data/$file" if (-e "data/$file");
    open (TXTFILE, $file) || die ("Cant open $file: $!");
    while (<TXTFILE>)
      {
      next if /^#/;
      next if /^\s*$/;
      chomp;
      $_ =~ s/\s*;\s*/;/g; # remove some spaces around , 
      $_ =~ s/\"//g;       # remove "
      @f = split (";",$_);
      $f[0] = $f[0] + $min;
      $n = lc($f[2]); splice(@f,2,1); $f[1] = lc($f[1]);
      $self->{textures}->{$n} = join(";",@f); 
      push (@f,$n); $self->{textnum}->{$f[0]} = join(";",@f); 
      } 
    close(TXTFILE);
    }
  else
    {
    foreach (keys %$file)
      {
      @f = split (";",$file->{$_});
      $f[0] = $f[0] + $min;
      $n = lc($_); $n =~ s/.*\///g;
      splice(@f,1,0,$n);
      $self->{textures}->{lc($_)} = join(";",@f);  
      push (@f,lc($_)); $self->{textnum}->{$f[0]} = join(";",@f); 
      }
    }
  }

sub numTextures
  {
  # return number of textures
  my $self = shift; 
  return scalar keys %{$self->{textures}};
  }

sub wood { 0; }
sub naturestone { 1; }
sub floortile { 2; }
sub metal { 3; }
sub earthsand { 4; }
sub bricks { 5; }

sub asText
  {
  # create a text listing of the texture mapping and return it
  my $self = shift; my $text = "";
  $text .= "# Format: number,shortname,longname,type,family,unknownnumber\n";
  $text .= "# Note: type is not set for automatically generated maps,\n";
  $text .= "#       and family not used yet. unknownnumber is, well unknown (always 1?)\n\n";
  my $txlist = $self->{textures};
  foreach (sort keys %$txlist)
    {
    @f = split (";",$txlist->{$_});
    splice (@f,2,0,$_);
    # texture #1 seems not to be used when mis file is loaded into DromEd ???
    $text .= join (";",@f)."\n";
    }
  return $text;
  }

sub asHash 
  {
  # create a ref to an anonymous hash containing self
  $s = shift || return;
  my $hash = {};
  my $t = $s->{textnum};
  foreach (sort by_num keys %$t)
    {
    @f = split (";",$t->{$_}); next if ($f[0] == sky()); # exclude sky
    #print "$_ $f[0], $f[1], $f[2], $f[3], $f[4] $f[5]\n";
    $hash->{$_} = $f[5];
    }
  $hash;
  }

# used by asHash
sub by_num { $a <=> $b; }

1;

