Games-Rezrov

 view release on metacpan or  search on metacpan

ZIO_Termcap.pm  view on Meta::CPAN

  attr_off();

  if (0) {
    # boolean testing code
    my @booleans = ("5i","am","bs","bw","da","db","eo","es","gn","hc","HC","hs","hz","in","km","mi","ms","NP","NR","nx","os","ul","xb","xn","xo","xs","xt");
    foreach my $b (@booleans) {
      my $v = $terminal->Tputs($b, 0);
      printf "%s: '%s'\n", $b, defined $v ? "defined" : "undef";
    }
    die;
  }

  #
  #  find backspace sequence
  #
  my $backspace;
  if (defined $terminal->Tputs(BACKSPACE_BOOLEAN, 0)) {
    # boolean -- only defined, not an actual value  :/
    # if set, ctrl-H performs backspace
    $backspace = pack "c", MANUAL_BACKSPACE;
  } else {
    my $alt = $terminal->Tputs(BACKSPACE_ALTERNATE, 0);
    # "Backspace, if not ^H"
    if ($alt) {
      $backspace = $alt;
    } else {
      print STDERR "WARNING: can't get backspace sequence!\n";
      $backspace = pack "c", MANUAL_BACKSPACE;
      # shouldn't happen
    }
  }
  $self->backspace_sequence($backspace);

  if ($options{"columns"} and $options{"rows"}) {
    $columns = $options{"columns"};
    $rows = $options{"rows"};
  } else {
    ($columns, $rows) = get_size();
    if ($columns and $rows) {
      if ($options{"flaky"} and Games::Rezrov::GetKey::can_read_single()) {
	$self->read_own_lines(1);
      } else {
	$rows-- if $self->scrolling_style() == SCROLL_STYLE_DEL;
	# hack: steal the last line on the display.
	# a newline on the last line causes the window to scroll
	# automatically, adding an unrequested newline and erasing
	# the status line.  Fixable without "cs"?
      }
    } else {
      print "I couldn't guess the number of rows and columns in your display,\n";
      print "so you must use -rows and -columns to specify them manually.\n";
      exit;
    }
  }

  $self->set_upper_lines(0);

  return $self;
}

sub update {
  # force screen refresh
  $|=1;
  print "";
  $|=0;
}

sub set_version {
  # called by the game
  my ($self, $status_needed, $callback) = @_;
#  $HAVE_STATUS_LINE = $status_needed;
  $self->set_upper_lines();
  # hack
  Games::Rezrov::StoryFile::rows($rows);
  Games::Rezrov::StoryFile::columns($columns);
  return 0;
}

sub write_string {
  my ($self, $string, $x, $y) = @_;
  $self->absolute_move($x, $y) if defined($x) and defined($y);
#  printf STDERR "ws: %s at (%d,%d)\n", $string, $abs_x, $abs_y;
  print $string;
  $abs_x += length($string);
}

sub newline {
  if (++$abs_y >= $rows) {
    # scroll needed
    if ($_[0]->scrolling_style() == SCROLL_STYLE_CS) {
      $_[0]->absolute_move(0, $rows);
      # saw a ref somewhere that said cursor had to be in
      # the lower left corner for scroll cmd to work
#      print $terminal->Tputs(SCROLL_ONE_LINE);
      do_term(SCROLL_ONE_LINE);
      $abs_y = $rows;
    } else {
      #    print STDERR "scrolling!\n";
      my $restore = $_[0]->get_position(1);
      $_[0]->absolute_move(0, $UPPER_LINES);
      do_term(DELETE_LINE);
      # scroll the lower window by deleting the first line
      # FIX ME: ONLY IN LOWER WINDOW
      #    &$restore();
      $abs_y = $rows - 1;
    }
  }
  $_[0]->absolute_move(0, $abs_y);

  Games::Rezrov::StoryFile::register_newline();
}

sub write_zchar {
  print chr($_[1]);
  $abs_x++;
}

sub absolute_move {
  # col, row
  my $self = shift;
  ($abs_x, $abs_y) = @_;



( run in 1.544 second using v1.01-cache-2.11-cpan-99c4e6809bf )