view release on metacpan or  search on metacpan

ZDict.pm  view on Meta::CPAN

    my ($address, $word, $delta_mult, $delta, $next);
    my $behind = -1;
    my $ahead = $num_words;
    while (1) {
      $address = $dict_start + ($search_index * $entry_length);
      if (exists $by_address->{$address}) {
	# already know word for this address
#	print STDERR "address cache hit!\n";
	$word = $by_address->{$address};
      } else {
	# decode word at this address and cache
	$word = ${$ztext->decode_text($address)};
	$by_name->{$word} = $address;
	$by_address->{$address} = $word;
      }
#      print "Got $word at $search_index\n";
      if ($word eq $token) {
	# found the word we're looking for: done
	return $address;
      } else {
	# missed: search further
	if ($linear_search) {
	  $next = $search_index + 1;
	} else {
	  $delta_mult = $token cmp $word;
	  # determine direction we need to search
	  if ($delta_mult == -1) {
	    # ahead; need to search back
	    $delta = int(($search_index - $behind) / 2);
	    $ahead = $search_index;
	  } else {
	    # behind; need to search ahead
	    $delta = int(($ahead - $search_index) / 2);
	    $behind = $search_index;
	  }
	  $delta = 1 if $delta == 0;
	  $next = $search_index + ($delta * $delta_mult);
	}
	if ($next < 0 or $next >= $num_words) {
	  # out of range
	  return 0;
	} elsif ($next == $ahead or $next == $behind) {
	  # word does not exist between flanking words
	  return 0;
	} else {
	  $search_index = $next;
	}
      }
    }
  }
  die;
}

sub magic {
  #
  #  >read dusty book
  #  The first page of the book was the table of contents. Only two
  #  chapter names can be read: The Legend of the Unseen Terror and
  #  The Legend of the Great Implementers.
  #  
  #  >read legend of the implementers
  #  This legend, written in an ancient tongue, speaks of the
  #  creation of the world. A more absurd account can hardly be
  #  imagined. The universe, it seems, was created by "Implementers"
  #  who directed the running of great engines. These engines       
  #  produced this world and others, strange and wondrous, as a test
  #  or puzzle for others of their kind. It goes on to state that
  #  these beings stand ready to aid those entrapped within their
  #  creation. The great magician-philosopher Helfax notes that a
  #  creation of this kind is morally and logically indefensible and
  #  discards the theory as "colossal claptrap and kludgery."
  #
  
  my ($self, $token, $what) = @_;
  my $object_cache = $self->get_object_cache();

  my $player_object = Games::Rezrov::StoryFile::player_object();
  my $current_room = Games::Rezrov::StoryFile::current_room();

  if ($what) {
    if ($player_object and $what =~ /^(me|self)$/i) {
      # for the purposes of these commands, consider "me" and "self"
      # equivalent to the player object (whatever that's called)
      my $desc = $object_cache->print($player_object);
      $what = $$desc;
    } elsif ($current_room and $what =~ /^here$/) {
      # likewise consider "here" to be the current room
      my $desc = $object_cache->print($current_room);
      $what = $$desc;
    }
  }

  my $just_one_newline = 0;

  if (0 and $token eq "fbg") {
    # can we make arbitrary things glow with a faint blue glow?
    # (nope)
    my $zo = new Games::Rezrov::ZObject(160);
    # 160=mailbox
    my $zp = $zo->get_property(12);
    $self->write_text($zp->property_exists() ? "yes" : "no");
  } elsif (0 and $token eq "fbg2") {
    # do all objects with "blue glow" property behave the same?
    my $object_cache = $self->get_object_cache();
    for (my $i = 1; $i <= $object_cache->last_object(); $i++) {
      my $zo = new Games::Rezrov::ZObject($i);
      my $zp = $zo->get_property(12);
      if ($zp->property_exists()) {
	$zp->set_value(3);
	$self->write_text(${$zo->print()});
	$self->newline();
      }
    }
  } elsif ($token eq "rooms") {
    $self->dump_objects(2);
  } elsif ($token eq "items") {
    $self->dump_objects(3);
  } elsif ($token eq "#serials") {
    my $header = Games::Rezrov::StoryFile::header();
    $self->write_text(sprintf "Z-machine version %d, ",
		      Games::Rezrov::StoryFile::version());
    $self->write_text(sprintf "release %s, ", $header->release_number());