<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">#####################
# Interface::Curses #
#####################

package Roguelike::Interface::Curses;

use strict;
use warnings;
use Roguelike::Game;
use Roguelike::Utility;

use Curses;

END {
  endwin();
}

sub create {
  my $class = shift;
  my $layout = shift;
  # Initialize Curses and color and stuff.
  initscr();
  noecho();
  curs_set(0);
  start_color();
  keypad(1);
  ungetch(".");
  getch();
  my @colors = (qw(BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE));
  my $cnt = 0;
  no strict "refs";
  foreach my $bg (@colors) {
    foreach my $fg (@colors) {
      my $fg_ = $fg;
      my $bg_ = $bg;
      $fg_ = "COLOR_$fg";
      $bg_ = "COLOR_$bg";
      init_pair(++$cnt, &amp;$fg_, &amp;$bg_);
    }
  }
  use strict "refs";
  getmaxyx(my $rows, my $cols);
  my $self = bless { MaxY =&gt; $rows, MaxX =&gt; $cols }, $class;
  # Create every window in the layout.
  while (my ($window, $info) = each %{$layout}) {
    $info-&gt;{Size}[0] =~ s#(\d+)%#$1 * $rows / 100#;
    $info-&gt;{Size}[1] =~ s#(\d+)%#$1 * $cols / 100#;
    $info-&gt;{At}[0] =~ s#(\d+)%#$1 * $rows / 100#;
    $info-&gt;{At}[1] =~ s#(\d+)%#$1 * $cols / 100#;
    my $sizeY = int eval($info-&gt;{Size}[0]);
    my $sizeX = int eval($info-&gt;{Size}[1]);
    my $posY = int eval($info-&gt;{At}[0]);
    my $posX = int eval($info-&gt;{At}[1]);
    my $win = newwin($sizeY, $sizeX, $posY, $posX);
    $win-&gt;box(0, 0) if $info-&gt;{Border};
    $win-&gt;refresh;
    $self-&gt;{$window} = $win;
    $self-&gt;{"${window}Y"} = $sizeY - 4;
    $self-&gt;{"${window}X"} = $sizeX - 6;
  }
  $self-&gt;{ConsoleY} = $rows - 4;
  $self-&gt;{ConsoleX} = $cols - 6;
  return $self;
}

sub trans_symbol {
  shift;
  my $symbol = shift;
  return Curses-&gt;can($symbol) if $symbol =~ m/^ACS_/;
  return $symbol;
}

sub trans_color {
  shift;
  my $fg = shift;
  my $bg = shift;
  $bg ||= "black";
  my %colors = (
    b =&gt; 5, # Blue
    r =&gt; 2, # Red
    g =&gt; 3, # Green
    a =&gt; 7, # Aqua/Cyan
    p =&gt; 6, # Purple/Magenta
    o =&gt; 4, # Orange
    y =&gt; 4, # Yellow
    k =&gt; 1, # Black
    e =&gt; 8, # Grey
    w =&gt; 8, # White
    # These should be self-explanatory, I hope.
    blue   =&gt; 5,
    red    =&gt; 2,
    green  =&gt; 3,
    aqua   =&gt; 7,
    cyan   =&gt; 7,
    purple =&gt; 6,
    orange =&gt; 4,
    yellow =&gt; 4,
    black  =&gt; 1,
    grey   =&gt; 8,
    gray   =&gt; 8,
    white  =&gt; 8
  );
  # Remember, no attributes with the background!
  # Foreground first.
  my $bright = 0;
  $bright = 1 if $fg =~ s/^\!//;
  my $color = $colors{lc $fg};
  # Now we determine whether we're bright or dim.
  # If our first letter is capitalized, we're bright.
  $bright = 1 if substr($fg, 0, 1) eq uc substr($fg, 0, 1);
  # But then we have all these special cases. Simplify input.
  $fg = lc $fg;
  $bright = 0 if $fg eq "o" or $fg eq "orange";
  $bright = 1 if $fg eq "y" or $fg eq "yellow";
  $bright = 0 if $fg eq "e" or $fg eq "grey" or $fg eq "gray";
  $bright = 1 if $fg eq "w" or $fg eq "white";
  my $attrib = $bright ? A_BOLD() : A_NORMAL();
  # Now factor in background.
  $bg = $colors{lc $bg};
  $color += 8 * ($bg - 1);
  return $attrib | COLOR_PAIR($color);
}

sub draw {
  my $self = shift;
  $self-&gt;{Display}-&gt;erase;  # /clear
  $self-&gt;{Display}-&gt;standend;
  $self-&gt;{Display}-&gt;box(0, 0) if $Game-&gt;{UI}{Layout}{Display}{Border};
  my $y = 0;
  foreach my $row (@_) {
    my $x = 1;
    foreach my $tile (@{ $row }) {
      $self-&gt;{Display}-&gt;addch(2 + $y, 2 + $x, $tile-&gt;{_DISPLAY_});
      $x++;
    }
    $y++;
  }
  $self-&gt;{Display}-&gt;refresh;
}

sub msgdraw {
  my $self = shift;
  $self-&gt;{MsgConsole}-&gt;erase;  # /clear
  $self-&gt;{MsgConsole}-&gt;standend;
  $self-&gt;{MsgConsole}-&gt;box(0, 0) if $Game-&gt;{UI}{Layout}{MsgConsole}{Border};
  my $y = 0;
  my $last = "";
  foreach my $line (@_) {
    $self-&gt;{MsgConsole}-&gt;standend;
    $self-&gt;{MsgConsole}-&gt;attron($self-&gt;trans_color($last)) if $last;
    my $x = 0;
    # Split by &lt;\w+&gt; and print the color codes in the right spots.
    foreach my $string (split(/(&lt;\w+&gt;)/, $line)) {
      if ($string =~ m/&lt;(\w+)&gt;/) {
        $self-&gt;{MsgConsole}-&gt;standend;
        $self-&gt;{MsgConsole}-&gt;attron($self-&gt;trans_color($1));
        $last = $1;
      } else {
        $self-&gt;{MsgConsole}-&gt;addstr($y, 2 + $x, $string);
        $x += length $string;
      }
    }
    $y++;
  }
  $self-&gt;{MsgConsole}-&gt;refresh;
}

sub prompt {
  $Game-&gt;{Input}{Queued} = [] unless $Game-&gt;{Input}{Queued};
  my $in;
  if (@{ $Game-&gt;{Input}{Queued} }) {
    $in = shift @{ $Game-&gt;{Input}{Queued} };
  } else {
    $in = getch;
  }
  push @{ $Game-&gt;{Input}{Used} }, $in;
  return $in;
}

sub display {
  my $self = shift;
  my $mode = shift; # 0=Init, 1=Display, 2=Close
  if ($mode == 0) {
    # Get ready to rumble
    $self-&gt;{Console}-&gt;erase;
    return 1;
  } elsif ($mode == 2) {
    # Get ready to... um... do the opposite of rumbling
    $Game-&gt;{UI}-&gt;msgrefresh(1);
    $Game-&gt;{UI}-&gt;statrefresh;
    return 1;
  }
  # Display some stuff
  $self-&gt;{Console}-&gt;erase;  # /cl
  $self-&gt;{Console}-&gt;standend;
  $self-&gt;{Console}-&gt;box(0, 0) if $Game-&gt;{UI}{Layout}{Console}{Border};;
  my $y = 0;
  foreach my $line (@_) {
    $self-&gt;{Console}-&gt;standend;
    next unless defined $line;
    my $x = 0;
    # Split by &lt;\w+&gt; and print the color codes in the right spots.
    foreach my $string (split(/(&lt;\w+&gt;)/, $line)) {
      if ($string =~ m/&lt;(\w+)&gt;/) {
        $self-&gt;{Console}-&gt;standend;
        $self-&gt;{Console}-&gt;attron($self-&gt;trans_color($1));
      } else {
        $self-&gt;{Console}-&gt;addstr(2 + $y, 3 + $x, $string);
        $x += length $string;
      }
    }
    $y++;
  }
  $self-&gt;{Console}-&gt;refresh;
}

sub statdraw {
  my $self = shift;
  $self-&gt;{Status}-&gt;erase;  # /clear
  $self-&gt;{Status}-&gt;standend;
  $self-&gt;{Status}-&gt;box(0, 0) if $Game-&gt;{UI}{Layout}{Status}{Border};
  my $y = 0;
  my $inv = 0;
  foreach my $line (@_) {
    $line = "&lt;Blue&gt;&lt;Green&gt;[MORE]  Press ?" if $y == $self-&gt;{StatusY};
    $inv = 1 if $line eq "&lt;LINE&gt;";
    $self-&gt;{Status}-&gt;standend;
    my $x = 0;
    # Split by &lt;\w+&gt; and print the color codes in the right spots.
    foreach my $string (split(/(&lt;\w+&gt;)/, $line)) {
      if ($string =~ m/&lt;(\w+)&gt;/) {
        $self-&gt;{Status}-&gt;standend;
        $self-&gt;{Status}-&gt;attron($self-&gt;trans_color($1));
      } else {
        if ($inv and $line =~ m/^&lt;B/) {
          $self-&gt;{Status}-&gt;addstr(1 + $y, 1 + $x, $string);
        } else {
          $self-&gt;{Status}-&gt;addstr(1 + $y, 2 + $x, $string);
        }
        $x += length $string;
      }
    }
    last if $y == $self-&gt;{StatusY};
    $y++;
  }
  my $x = 0;
  my $line = "&lt;Blue&gt;Position:&lt;grey&gt; $Player-&gt;{Y}, $Player-&gt;{X} ($Player-&gt;{Z})";
  foreach my $string (split(/(&lt;\w+&gt;)/, $line)) {
    if ($string =~ m/&lt;(\w+)&gt;/) {
      $self-&gt;{Status}-&gt;standend;
      $self-&gt;{Status}-&gt;attron($self-&gt;trans_color($1));
    } else {
      $self-&gt;{Status}-&gt;addstr($self-&gt;{StatusY} + 2, 1 + $x, $string);
      $x += length $string;
    }
  }
  $self-&gt;{Status}-&gt;refresh;
}

sub msgbox {
  my $self = shift;
  my $mode = shift;
  return 1 if $mode == 0;
  if ($mode == 2) {
    # Unrumble, guys!
    $Game-&gt;{UI}-&gt;msgrefresh(1);
    $Game-&gt;{UI}-&gt;statrefresh;
    return 1;
  }
  # Mode 0 is useless... we have to erase every time anyway.
  # Get the Console going
  $self-&gt;{Console}-&gt;standend;
  $self-&gt;{Console}-&gt;erase;
  $self-&gt;{Console}-&gt;box(0, 0) if $Game-&gt;{UI}{Layout}{Console}{Border};;
  # Longest line? Align left.
  my $length = 0;
  foreach (@_) {
    my $testline = $_;
    $testline =~ s/&lt;\w+&gt;//g;
    $length = length $testline if length $testline &gt; $length;
  }
  my @lines = (" " x ($length + 2));
  foreach (@_) {
    my $line = $_;
    my $testline = $line;
    $testline =~ s/&lt;\w+&gt;//g;
    $line .= " " x ($length - length($testline));
    $line = " $line ";
    push @lines, $line;
  }
  push @lines, " " x ($length + 2);
  # Add space to ends of lines. PAD!
  my $y = ($self-&gt;{MaxY} - @_) / 2 - 1;
  my $last = "black";
  foreach my $line (@lines) {
    # Set background to white.
    $self-&gt;{Console}-&gt;attron($self-&gt;trans_color($last, "white"));
    my $x = ($self-&gt;{MaxX} - $length) / 2 - 2;
    # Split by &lt;\w+&gt; and print the color codes in the right spots.
    foreach my $string (split(/(&lt;\w+&gt;)/, $line)) {
      if ($string =~ m/&lt;(\w+)&gt;/) {
        $self-&gt;{Console}-&gt;standend;
        $self-&gt;{Console}-&gt;attron($self-&gt;trans_color($1, "white"));
        $last = $1;
      } else {
        $self-&gt;{Console}-&gt;addstr(1 + $y, 2 + $x, $string);
        $x += length $string;
      }
    }
    $y++;
  }
  $self-&gt;{Console}-&gt;refresh;
  while (1) {
    my $in = $self-&gt;prompt;
    return $in if $mode == 5;
    last if $in eq " ";
    $self-&gt;msgbox($mode, @_);
    last;
  }
  return 1;
}

sub cursor {
  my ($self, $y, $x, $color, $char) = @_;
  # Set y,x on Display to attrib and color.
  $self-&gt;{Display}-&gt;standend;
  $self-&gt;{Display}-&gt;move($y, $x);
  $self-&gt;{Display}-&gt;attron($color);
  $self-&gt;{Display}-&gt;echochar($char);
  return 1;
}

sub clearjunk {
  my $self = shift;
  # Screen junk... Bah humbug.
  $self-&gt;{Display}-&gt;clear;
  $self-&gt;{MsgConsole}-&gt;clear;
  $self-&gt;{Status}-&gt;clear;
}


42;
</pre></body></html>