package Games::Rezrov::ZProperty;
# object properties

use strict;

use constant FIRST_PROPERTY => -1;
# used to find the first property in the object

use Games::Rezrov::Inliner;
use Games::Rezrov::InlinedPrivateMethod;

my $code = new Games::Rezrov::InlinedPrivateMethod("-manual" => 1,
						   "-names" =>
						   [ qw (
							 _property_exists
							 _property_number
							 _property_len
							 _property_offset
							 _size_byte
							 _pointer
							 _pre_v4
							 _zobj
							 _search_id
							)
						   ],
						  );
Games::Rezrov::Inliner::inline($code);

#print $$code; die;

eval $$code; die $@ if $@;

1;

__DATA__

sub property_exists {
  # public, read-only
  return $_[0]->_property_exists();
}

sub property_number {
  # public, read-only
  return $_[0]->_property_number();
}

sub get_value {
  # return this value for this property
  if ($_[0]->_property_exists()) {
    # this object provides this property
    my $len = $_[0]->_property_len();
    my $v;
    if ($len == 2) {
      $v = GET_WORD_AT($_[0]->_property_offset());
    } elsif ($len == 1) {
      $v = GET_BYTE_AT($_[0]->_property_offset());
    } else {
      die "get_value() called on long property";
    }

    if (Games::Rezrov::ZOptions::SNOOP_PROPERTIES()) {
      printf STDERR "[get property %s of %s (%s) = %s (size=%d)\n",
	$_[0]->property_number(),
	  $_[0]->_zobj()->object_id(),
	    ${$_[0]->_zobj()->print()},
	      $v,
		$len;
  }

    return $v;
  } else {
    # object does not provide this property: get default value
    return $_[0]->get_default_value();
  }
}

sub next {
  # search for a specific property, or move to the next one
  my ($self, $search_id) = @_;
  die("attempt to read past end of property list")
    if ($self->_size_byte() == 0);
  my $pointer = $self->_pointer();

  my $property_number;
  my $exists = 0;
  my $size_byte;
  my $property_len;
  my $last_id;
  my $property_offset = 0;
  my $pre_v4 = $self->_pre_v4();
  while (1) {
#    print STDERR "search\n";
    $size_byte = GET_BYTE_AT($pointer);
    if ($size_byte == 0) {
      $property_number = 0;
      last;
    } else {
      my $size_bytes = 1;
      if ($pre_v4) {
	# spec 12.4.1:
	$property_number = $size_byte & 0x1f;
	# property number is in bottom 5 bytes
	$property_len = ($size_byte >> 5) + 1;
	# 12.4.1: shifted value is # of bytes minus 1
      } else {
	# spec 12.4.2:
	$property_number = $size_byte & 0x3f;
	# property number in bottom 6 bits
	if (($size_byte & 0x80) > 0) {
	  # top bit is set, there is a second size byte
	  $property_len = GET_BYTE_AT($pointer + 1) & 0x3f;
	  # length in bottom 6 bits
	  $size_bytes = 2;
	  if ($property_len == 0) {
	    # 12.4.2.1.1
#	    print STDERR "wacky inform compiler size; test this!";
	    $property_len = 64;
	  }
	} else {
	  # 14.2.2.2
	  $property_len = ($size_byte & 0x40) > 0 ? 2 : 1;
	}
      }
      $property_offset = $pointer + $size_bytes;
      $pointer += $size_bytes + $property_len;
    }

    if (!(defined $search_id) or $search_id == FIRST_PROPERTY) {
      # move to next/first property
      $exists = 1;
      last;
    } else {
      if ($last_id and $property_number > $last_id) {
	# 12.4: properties are stored in descending numerical order
	# this means we are past the end
	# ...need example case here!
	last;
      } elsif ($search_id > $property_number) {
	# went past where it would have been had it existed
	last;
      } else {
	$last_id = $property_number;
	if ($property_number == $search_id) {
	  #      print STDERR "got it\n";
	  $exists = 1;
	  last;
	  # 12.4.1
	}
      }
    }
  }
  $self->_property_exists($exists);
#  print STDERR "exists: $exists\n";
  $self->_property_len($property_len);
  $self->_property_number($property_number);
  $self->_size_byte($size_byte);
  $self->_property_offset($property_offset);
  $self->_pointer($pointer);
}

sub get_default_value {
  # get the default value for this property ID
  # spec 12.2
  my $offset = Games::Rezrov::StoryFile::header()->object_table_address() +
    (($_[0]->_search_id() - 1) * 2);
  # FIX ME
  return(GET_WORD_AT($offset));
}

sub new {
  my ($type, $search_id, $zobj, $psi) = @_;

#  printf STDERR "new zprop %s for obj %s\n", $search_id, $zobj->object_id();

  my $self = [];
  bless $self, $type;

  $self->_zobj($zobj);
  $self->_pre_v4(Games::Rezrov::StoryFile::version() <= 3);
  $self->_search_id($search_id);

  $self->_size_byte(-1);
  $self->_pointer($psi);
  $self->_property_offset(-1);
  $self->next($search_id);
  return $self;
}

sub set_value {
  # set this property to specified value
  my ($self, $value) = @_;
  if ($self->_property_exists()) {
#    print STDERR "set_value to $value\n";
    my $len = $self->_property_len();
    my $offset = $self->_property_offset();
    if (Games::Rezrov::ZOptions::SNOOP_PROPERTIES()) {
      Games::Rezrov::StoryFile::write_text(sprintf("[set property %d of %s (%s) = %d]",
					   $self->_property_number(),
					   $self->_zobj()->object_id(),
					   ${$self->_zobj()->print()},
                                           $value), 1);
    }
    if ($len == 1) {
      Games::Rezrov::StoryFile::set_byte_at($offset, $value);
    } elsif ($len == 2) {
      Games::Rezrov::StoryFile::set_word_at($offset, $value);
    } else {
      die("set_value called on long property");
    }
  } else {
    die("attempt to set nonexistent property") unless $Games::Rezrov::IGNORE_PROPERTY_ERRORS;
    # cheating
  }
}

sub get_data_address {
  return $_[0]->_property_offset();
}

sub get_next {
  # return a new ZProperty object representing the property 
  # after this one.  total hack!
  my $self = shift;
  my $next = [];
  bless $next, ref $self;
  @{$next} = @{$self};
  # make a copy of of $self
  $next->next();
  # make new property point to the next one in the list
  return $next;
}

1;