##########################################################################
# This file is part of Vacuum Magic
# Modified by UPi: <upi at sourceforge.net>
# Contains code originally from:
# Games-OpenGL-Font-2D - load/render 2D fonts via OpenGL
# (C) by Tels <http://bloodgate.com/>
##########################################################################


package GlFont;


use strict;

use Exporter;
use SDL::OpenGL;
use SDL::Surface;
use vars qw/ @ISA $VERSION @EXPORT_OK $GlCallListsScalar $GlCallListsBase /;
@ISA = qw/Exporter/;


$VERSION = '0.07';

BEGIN {
unless (defined(&GL_COMPILE)) { eval 'sub GL_COMPILE { 0x1300 }'; die $@ if $@; }
}


##############################################################################

if (defined($SDL::OpenGL::{'glCallListsString'})) {
  $GlCallListsScalar = \&glCallListsString;
} elsif (defined($SDL::OpenGL::{'glCallListsScalar'})) {
  $GlCallListsScalar = \&glCallListsScalar;
}
if (&::IsMicrosoftWindows() || not defined($GlCallListsScalar)) {
  $GlCallListsScalar = sub {
    my $string = shift;
    my @a = map { ord($_) } split(//, $string);
    glCallLists( GL_INT, @a);
  };
}


##############################################################################
# methods

sub new {
  # create a new instance of a font
  my $class = shift;
  
  my $self = { };
  bless $self, $class;
  
  my $args = $_[0];
  $args = { @_ } unless ref $args eq 'HASH';

  $self->{args} = $args;
  $self->{file} = $args->{file} || '';
  $self->{keepSurface} = $args->{keepSurface} || 0;
  $self->{color} = $args->{color} || [ 1,1,1 ];
  $self->{alpha} = $args->{alpha} || 1;
  $self->{char_width} = int(abs($args->{char_width} || 16));
  $self->{char_height} = int(abs($args->{char_height} || 16));
  $self->{spacing_x} = int($args->{spacing_x} || $self->{char_width});
  $self->{spacing_y} = int($args->{spacing_y} || 0);
  $self->{transparent} = defined($args->{transparent}) ? $args->{transparent} : 1;
  $self->{width} = 640;
  $self->{height} = 480;
  $self->{zoom_x} = abs($args->{zoom_x} || 1);
  $self->{zoom_y} = abs($args->{zoom_y} || 1);
  $self->{chars} = int(abs($args->{chars} || (256-32)));
  $self->{chars_per_line} = int(abs($args->{chars_per_line} || 16));
  $self->{border_x} = int(abs($args->{border_x} || 0));
  $self->{border_y} = int(abs($args->{border_y} || 0));
  
  $self->_ReadFont();
  $self->_ReadDescription();
  
  $self->{pre_output} = 0;
  
  # Create the display lists
  $self->{base} = glGenLists( $self->{chars} ); &::CheckGLError();

  $self->_BuildFont();
  $self;
}

sub _ReadDescription {
  my $self = shift;
  my $desc;
  
  return unless -f "$self->{file}.txt";
  open DESC, "$self->{file}.txt"  or die $!;
  read DESC, $desc, 20000;
  close DESC;
  eval( "\$self->{desc} = [ $desc ];" );
  $self->{chars} = scalar @{$self->{desc}};
  $self->{spacing_x} = $self->{args}->{spacing_x} || 0;
  $self->{char_height} = $self->{desc}->[0]->[3];
}

sub _ReadFont {
  my $self = shift;

  $self->{texture} = new Texture($self->{file}, $self->{file}, 0, $self->{keepSurface});
  $self->{texture}->SetPermanent();
  $self->{texture_width} = $self->{texture}->{w};
  $self->{texture_height} = $self->{texture}->{h};
}

sub _BuildFont {
  my $self = shift;

  # select our font texture
  $self->{texture}->_Bind();

  my $cw = $self->{char_width};
  my $ch = $self->{char_height};
  my $w = int($cw * $self->{zoom_x});
  my $h = int($ch * $self->{zoom_y});
  my $bx = $self->{border_x};
  my $by = $self->{border_y};
  # calculate w/h of a char in 0..1 space
  my $cwi = ($cw+$bx)/$self->{texture_width};
  my $chi = ($ch+$by)/$self->{texture_height};
  $cw = $cw/$self->{texture_width};
  $ch = $ch/$self->{texture_height};
  # print "$self->{file}: $cw x $ch ($w x $h => ",$w+$bx," x ",$h+$by,") $self->{base} ($self->{texture_width} x $self->{texture_height})\n";
  my $cx = 0; my $cy = 0;
  my $c = 0;
  my $depth = 10.0;
  my $desc = $self->{desc};
  my $chardesc;
  my $translateX = $self->{spacing_x} * $self->{zoom_x};
  # loop through all characters
  for my $loop (1 .. $self->{chars}) {
  
    if ($desc) {
      $chardesc = $desc->[$loop - 1];
      ($cx, $cy, $cw, $ch) = @$chardesc;
      $w = int($cw * $self->{zoom_x});
      $h = int($ch * $self->{zoom_y});
      $translateX = int( ($cw + $self->{spacing_x}) * $self->{zoom_x} );
      $cx /= $self->{texture_width}; $cw /= $self->{texture_width};
      $cy /= $self->{texture_height}; $ch /= $self->{texture_height};
    }
    # start building a list
    glNewList( $self->{base} + $loop - 1, GL_COMPILE ); &::CheckGLError();
    glBegin( GL_QUADS );
      glTexCoord( $cx, $cy + $ch);       glVertex( 0, 0, $depth );
      glTexCoord( $cx + $cw, $cy + $ch); glVertex( $w, 0, $depth );
      glTexCoord( $cx + $cw, $cy);       glVertex( $w, $h, $depth );
      glTexCoord( $cx , $cy);            glVertex( 0, $h, $depth );
    glEnd();

    # move to next character
    glTranslate( $translateX, 
                 $self->{spacing_y} * $self->{zoom_y}, 0 );
    glEndList(); &::CheckGLError();
    
    # X and Y position of next char
    $cx += $cwi;
    if (++$c >= $self->{chars_per_line}) {
      $c = 0; $cx = 0; $cy += $chi;
    }
  }
}

sub TextWidth {
  my ($self, $string) = @_;
  my ($width, $desc, $i, $char);
  
  return 0  unless length($string);
  $desc = $self->{desc};
  unless ($desc) {
    $width = abs((length($string)-1) * $self->{spacing_x} * $self->{zoom_x});
    $width += $self->{char_width} * $self->{zoom_x};
    return $width;
  }
  $width = 0;
  for ($i = 0; $i < length($string); ++$i) {
    $char = substr($string, $i, 1);
    $width += $desc->[ord($char)-32]->[2] + $self->{spacing_x};
  }
  $width -= $self->{spacing_x};
  return $width;
}

sub RenderToSurface {
  my ($self, $x, $y, $string, $surface) = @_;
  my ($i, $c, $chardesc, $srcrect, $dstrect);
  
  die "RenderToSurface: Must set keepSurface"  unless $self->{keepSurface};
  $srcrect = new SDL::Rect;
  $dstrect = new SDL::Rect;
  $self->{texture}->{surface}->set_alpha(0, 255);
  for ($i = 0; $i < length($string); ++$i) {
    $c = substr($string, $i, 1);
    $chardesc = $self->{desc}->[ord($c)-32];
    $srcrect->x($chardesc->[0]);
    $srcrect->y($chardesc->[1]);
    $srcrect->width($chardesc->[2]);
    $srcrect->height($chardesc->[3]);
    $dstrect->x($x);
    $dstrect->y($y);
    $dstrect->width($chardesc->[2]);
    $dstrect->height($chardesc->[3]);
    $x += $chardesc->[2] + $self->{spacing_x};
    $self->{texture}->{surface}->blit($srcrect, $surface, $dstrect);
  }
}

sub pre_output {
  my $self = shift;

  warn ("pre_output() called twice") if $self->{pre_output} != 0;
  $self->{pre_output} = 1;

  # Select our texture
  $self->{texture}->_Bind();

  $self->{gl_flags} = [ 
    glIsEnabled(GL_DEPTH_TEST),
    glIsEnabled(GL_TEXTURE_2D),
    glIsEnabled(GL_CULL_FACE),
    ];
  # Disable/Enable flags
  glDisable( GL_DEPTH_TEST );
  glEnable( GL_TEXTURE_2D );
  glDisable( GL_CULL_FACE );
  glDepthMask(GL_FALSE);	# disable writing to depth buffer
  
  glEnable( GL_BLEND );
  # Select The Type Of Blending
  if ($self->{transparent}) {
    glBlendFunc(GL_SRC_ALPHA,GL_ONE);
  } else {
    glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
  }

  # Select The Modelview Matrix
  glMatrixMode( GL_MODELVIEW );
  glPushMatrix();
  glLoadIdentity();
}

sub output {
  my ($self,$x,$y,$string,$color,$alpha, $scale) = @_;

  Carp::confess "Undef string."  unless defined $string;
  return if $string eq '';

  $self->{texture}->_Bind();
  glLoadIdentity();
  glTranslate( $x, $y, 0 );
  glScale($scale, $scale, 1)  if defined $scale;

  # set color and alpha value
  $color = $self->{color}  unless defined $color;
  $alpha = $self->{alpha}  unless defined $alpha;
  if (defined $color) { # if not, caller wanted to set color by herself
    if (defined $alpha) {
      glColor (@$color,$alpha);
    } else {
      glColor (@$color,1);
    }
  }

  # Choose The Font Set (0 or 1) (-32 because our lists start at 0, and space
  # has an ASCII value of 32 and is the first existing character)
  glListBase( $self->{base} - 32 ); &::CheckGLError();

  $GlCallListsBase = $self->{base};
  # render the string to the screen
  $GlCallListsScalar->( $string );
}

sub post_output
  {
  my $self = shift;

  warn ("post_output() called before pre_output()")
    if $self->{pre_output} == 0;
  $self->{pre_output} = 0;

  # Reset the OpenGL stuff

  glMatrixMode( GL_MODELVIEW );
  glPopMatrix();

  my $flags = $self->{gl_flags};
# glEnable(GL_DEPTH_TEST)  if $flags->[0];
  glEnable(GL_TEXTURE_2D)  if $flags->[1];
  glEnable(GL_CULL_FACE)   if $flags->[2];
  glDepthMask(GL_TRUE);		# enable writing to depth buffer
  
  # Caller must re-enable or re-disable other flags if she wishes
  glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
  }

sub screen_width
  {
  my $self = shift;

  $self->{width} = shift if @_ > 0;
  $self->{width};
  }

sub screen_height
  {
  my $self = shift;

  $self->{height} = shift if @_ > 0;
  $self->{height};
  }

sub color
  {
  my $self = shift;

  if (@_ > 0)
    {
    if (ref($_[0]) eq 'ARRAY')
      {
      $self->{color} = shift;
      }
    else
      {
      $self->{color} = [ $_[0], $_[1], $_[2] ];
      }
    }
  $self->{color};
  }

sub transparent
  {
  my $self = shift;

  $self->{transparent} = shift if @_ > 0;
  $self->{transparent};
  }

sub alpha
  {
  my $self = shift;

  $self->{alpha} = shift if @_ > 0;
  $self->{alpha};
  }

sub spacing_x
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{spacing_x} = shift;
    $self->_BuildFont();
    }
  $self->{spacing_x};
  }

sub spacing_y
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{spacing_y} = shift;
    $self->_BuildFont();
    }
  $self->{spacing_y};
  }

sub spacing
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{spacing_x} = shift;
    $self->{spacing_y} = shift;
    $self->_BuildFont();
    }
  ($self->{spacing_x}, $self->{spacing_y});
  }

sub border_x
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{border_x} = iint(abs(shift));
    $self->_BuildFont();
    }
  $self->{border_x};
  }

sub border_y
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{border_y} = iint(abs(shift));
    $self->_BuildFont();
    }
  $self->{border_y};
  }

sub zoom
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{zoom_x} = shift;
    $self->{zoom_y} = shift;
    $self->_BuildFont();
    }
  ($self->{zoom_x}, $self->{zoom_y});
  }

sub copy
  {
  my $self = shift;

  my $class = ref($self);
  my $new = {};
  foreach my $k (keys %$self)
    {
    $new->{$k} = $self->{$k};
    }
  $new->{base} = glGenLists ( $self->{chars} );	# get the new font some lists
  bless $new, $class;
  $new->_BuildFont();
  $new;
  }

sub align_x
  {
  my $self = shift;

  $self->{align_x} = shift if @_ > 0;
  $self->{align_x};
  }

sub align_y
  {
  my $self = shift;

  $self->{align_y} = shift if @_ > 0;
  $self->{align_y};
  }

sub align
  {
  my $self = shift;

  if (@_ > 0)
    {
    $self->{align_x} = shift;
    $self->{align_y} = shift;
    }
  ($self->{align_x}, $self->{align_y});
  }

sub char_height
  {
  my $self = shift;

  $self->{char_height} * $self->{zoom_y};
  }

sub char_width
  {
  my $self = shift;

  $self->{char_width} * $self->{zoom_x};
  }

sub DESTROY
  {
  my $self = shift;

  # free the texture lists
  glDeleteLists( $self->{base}, $self->{chars} ) if defined $self->{base};
  }

1;

__END__

