view release on metacpan or  search on metacpan

ZIO_dumb.pm  view on Meta::CPAN

sub new {
  my ($type, %options) = @_;
  my $self = new Games::Rezrov::ZIO_Generic(%options);
  bless $self, $type;

  $self->zio_options(\%options);
  $self->readline_init();

  $self->io_setup();
  
  $columns = $options{columns} if $options{columns};
  $rows = $options{rows} if $options{rows};
  ($columns, $rows) = get_size() unless $columns and $rows;
  # don't attempt to detect terminal size if manually set;
  # ("make test" crashes in Term::ReadKey if not run on a tty!)
  
  unless ($columns and $rows) {
    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;
  }
  return $self;
}

sub io_setup {
  my ($self) = @_;

  if (find_module('Term::ReadKey')) {
    require Term::ReadKey;
    import Term::ReadKey;
    $have_term_readkey = 1;
#    ReadMode(3);
    # disable echoing
#    ReadLine(-1);
    # make sure we don't buffer any (invisible) characters
  }

  $clear_prog = find_prog("clear");
}

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

sub clear_to_eol {
#  print STDERR "clear to eol; at $abs_x\n";
  my $diff = $columns - $abs_x;
  if ($diff > 0) {
    print " " x $diff;
    # erase
    print pack("c", 0x08) x $diff;
    # restore cursor
  }
}

sub update {
}

sub find_prog {
  # don't look
  foreach ("/bin/", "/usr/bin/") {
    my $fn = $_ . $_[0];
    return $fn if -x $fn;
  }
  return undef;
}

sub can_split {
  # true or false: can this zio split the screen?
  return 0;
}

sub set_version {
  my ($self, $status_needed, $callback) = @_;
  Games::Rezrov::StoryFile::rows($rows);
  Games::Rezrov::StoryFile::columns($columns);
#  print STDERR "$columns\n";
  $self->clear_screen();
  return 0;
}

sub absolute_move {
  my ($nx, $ny) = @_[1,2];
#  printf STDERR "move X to $nx from $abs_x\n";
  if (0 and $nx < $abs_x) {
    # DISABLED
    # "this sidewalk's for regular walkin', not fancy walkin'..."
    my $diff = $abs_x - $nx;
#    printf STDERR "going back %d\n", $abs_x - $nx;
    print pack("c", 0x08) x $diff;
    # go back
    print " " x $diff;
    # erase
    print pack("c", 0x08) x $diff;
    # go back again
  }
  $abs_x = $nx;
  $abs_y = $ny;
}

sub newline {
  # check to see if we need to pause
  print "\n";
#  cluck "nl\n";
  $abs_x = 0;
  Games::Rezrov::StoryFile::register_newline();
}

sub write_zchar {
  if ($_[0]->current_window() == Games::Rezrov::ZConst::LOWER_WIN) {
    print chr($_[1]);
#    printf STDERR "wc: %s\n", chr($_[1]);
    $abs_x++;
  } else {
#    printf STDERR "ignoring char: %s\n", chr($_[1]);
  }