view release on metacpan or  search on metacpan

ZIO_Curses.pm  view on Meta::CPAN

				  zfont
				 );

my $w_main;
my %COLORMAP = (black => COLOR_BLACK,
		red => COLOR_RED,
		green => COLOR_GREEN,
		yellow => COLOR_YELLOW,
		blue => COLOR_BLUE,
		magenta => COLOR_MAGENTA,
		cyan => COLOR_CYAN,
		white => COLOR_WHITE);
my $color_pair_counter = 0;
# HACKS

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

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

  # set up Curses:
  initscr() || die;
  $self->need_endwin(1);
#  printf STDERR "ew: %s %s\n", $self, $self->need_endwin();
  # isendwin() is not present in all Curses implementations (eg dec_osf)
  # ...actually it's more like Curses.pm doesn't autoconfigure correctly
  # under dec_osf  :(

  my $columns = $options{"columns"} || $Curses::COLS || die "need columns!";
  my $rows = $options{"rows"} || $Curses::LINES || die "need rows!";

  $self->rows($rows);
  $self->columns($columns);

  $w_main = newwin($rows, $columns, 0, 0);
  # create main window
  $w_main->keypad(1);

  $self->color_pairs({});
  $self->parse_color_options(\%options);
  $self->init_colors(\%options);
  
  $self->zfont(Games::Rezrov::ZConst::FONT_NORMAL);

  return $self;
}

sub groks_font_3 {
  return 1;
}

sub can_use_color {
  return has_colors() ? 1 : 0;
}

sub update {
  # force screen refresh
  $w_main->refresh();
}

sub set_version {
  # called by the game
  my ($self, $status_needed, $callback) = @_;
  Games::Rezrov::StoryFile::rows($self->rows);
  Games::Rezrov::StoryFile::columns($self->columns);
  $self->clear_screen();
  scrollok($w_main, 1);
  noecho();
  return 0;
}

sub set_background_color {
  if (has_colors() and
      $_[0]->fg() and $_[0]->bg()) {
    $_[0]->do_colors($_[0]->fg(), $_[0]->bg());
  }
}

sub clear_screen {
  $w_main->erase();
  # erase
}

sub get_position {
  # with no arguments, return absolute X and Y coordinates.
  # With an argument, return a sub that will restore the current cursor
  # position.
  my ($self, $sub) = @_;
  my ($x, $y);
  $w_main->getyx($y,$x);
#  carp "pos is $x, $y\n";
  if ($sub) {
    return sub { $w_main->move($y, $x); };
  } else {
    return ($x, $y);
  }
}

sub newline {
  # use autoscrolling
  $w_main->addstr("\n");
  # broken: what if not lower window??
  Games::Rezrov::StoryFile::register_newline();
  update() if Games::Rezrov::ZOptions::MAXIMUM_SCROLLING;
}

sub write_zchar {
  # write an unbuffered z-char to the screen
  if ($_[0]->zfont() == 3) {
    if ($_[1] == 32 || $_[1] == 37) {
      $w_main->addch(" ");
    } elsif ($_[1] == 35 || $_[1] == 50 || $_[1] == 52 || $_[1] == 67 || $_[1] == 69) {
      $w_main->addch("/");
    } elsif ($_[1] == 36 || $_[1] == 51 || $_[1] == 53 || $_[1] == 68 || $_[1] == 70) {
      $w_main->addch('\\');
    } elsif ($_[1] == 46) {