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 )