view release on metacpan or  search on metacpan

ZIO_Win32.pm  view on Meta::CPAN

	$options{fg} = "gray" if $options{fg} eq "white";
	# since INTENSITY mode has no effect "white",
	# use gray instead.  Feh.
	# How to get *true* bold here???
    } else {
	$options{fg} = "gray" unless $options{fg};
	$options{bg} = "blue" unless $options{bg};
	$options{sfg} = "black" unless $options{sfg};
	$options{sbg} = "cyan" unless $options{sbg};
    }

    $self->parse_color_options(\%options);

    foreach ("bg", "fg", "sfg", "sbg") {
      next unless exists $options{$_};
      my $c = $self->$_() || next;
      die sprintf "Unknown color \"%s\"; available colors: %s\n", $c, join(", ", sort keys %FOREGROUND)
	  unless exists $FOREGROUND{$c};
    }
    
    # set up i/o
    $IN = new Win32::Console(STD_INPUT_HANDLE);
    $OUT = new Win32::Console(STD_OUTPUT_HANDLE);

    @ORIG_SIZE = $OUT->Size();
    # save original buffer geometry to restore on exit

    my ($top_row, $bottom_row, $left_col, $right_col);
    ($columns, $left_col, $top_row, $right_col, $bottom_row) = ($OUT->Info())[0,5,6,7,8];
#    die $bottom_row;
    my $visible_rows = ($bottom_row - $top_row) + 1;
    my $visible_columns = ($right_col - $left_col) + 1;

    $OUT->Size($visible_columns, $visible_rows);
    # 11/2004: set the screen buffer to be the same size as the visible area
    # of the window.  Has the effect of removing any scrollbars, etc.
    #
    # Under XP the default number of rows in the buffer is generally
    # larger than the number of visible rows (under Windows 98
    # the two were generally the same).  So without this change we'd be 
    # drawing the status window and/or upper window lines somewhere
    # way up in the buffer, which won't be visible...this is because
    # the Cursor() method moves within the *buffer* rather than the
    # visible area.
    #
    # It's probably possible to finesse this module to only draw to
    # the visible area while leaving the buffers and scrollbars
    # alone, but for now I Don't Care.
    
    my @size = $OUT->Size();
    $columns = $options{"columns"} || $size[0] || die "need columns!";
    $rows = $options{"rows"} || $size[1] || die "need rows!";

    $OUT->Size($columns, $rows);
    # resize again (possible user override limiting rows/cols)

    $upper_lines = 0;
    return $self;
}

sub update {
  $OUT->Flush();
}

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

sub absolute_move {
  # move to X, Y
  $OUT->Cursor($_[1], $_[2]);
}

sub write_string {
  my ($self, $string, $x, $y) = @_;
  $self->absolute_move($x, $y) if defined($x) and defined($y);
#  $OUT->Attr($current_attr);
  $OUT->Attr($self->get_attr());
  $OUT->Write($string);
}

sub newline {
  # newline/scroll
  my ($x, $y) = $OUT->Cursor();
  if (++$y >= $rows) {
      # scroll needed
      my $last_line = $rows - 1;
      $y = $last_line;
      my $top = $upper_lines;
    #	$OUT->Write(sprintf "before: at %d,%d, top=%d last=%d\n", $x, $y, $top, $last_line);
#    log_it(sprintf "before: at %d,%d, top=%d last=%d\n", $x, $y, $top, $last_line);
    #	sleep(1);
      $OUT->Scroll(0, $top + 1, $columns - 1, $last_line,
		   0, $top, Games::Rezrov::ZConst::ASCII_SPACE, $_[0]->get_attr(0),
		   0, $top, $columns - 1, $last_line);
      # ugh: we have to specify the clipping region, or else
      # Win32::Console barfs about uninitialized variables (with -w)
  }
  Games::Rezrov::StoryFile::register_newline();
  $_[0]->absolute_move(0, $y);
}

sub write_zchar {
#    log_it("wzchar: " . chr($_[1]));
  $OUT->Attr($_[0]->get_attr());
  $OUT->Write(chr($_[1]));
}

sub status_hook {
  my ($self, $type) = @_;
  # 0 = before
  # 1 = after
  if ($type == 0) {
    # before printing status line
    $OUT->Cursor(0,0);
    $in_status = 1;
    $OUT->FillAttr($self->get_attr(), $columns, 0, 0);