jjakkes-fernando-game/game.pl

#!/usr/bin/env perl
# This 'game.pl' is licensed under the GPL3 as seen in LICENSE.
# if LICENSE is not available, see < https://www.gnu.org/licenses/gpl-3.0.en.html >

use strict;
use warnings;
use 5.010;

# wants, desires:
# utf8 compatible -> would require an array of the map rather 
# than relying on curses knowledge of what is on the screen
# as utf8 'chars' are like 3+ bytes
# (which would make fixing the resize bug easier)

# uncomment below when 'game.pl' is default shell for a user.
#use POSIX qw(locale_h);
#use locale;
#setlocale(LC_CTYPE, "en_US.UTF-8"); # hope you have this generated :)

use Curses;
use TOML;
use File::Slurper qw(read_text write_text);
use Carp::Always;
use Smart::Comments;

my ($game_config, $game_items, $battlers, $err);

($game_config, $err) = from_toml(read_text('./game.pl.toml'));
if ($err) {
	die $err;
}
($game_items, $err) = from_toml(read_text('./assets/GAME_ITEMS.toml'));
if ($err) {
	die $err;
}
($battlers, $err) = from_toml(read_text('./assets/BATTLERS.toml'));
if ($err) {
	die $err;
}

initscr();
cbreak();
noecho();
keypad(stdscr, 1);
start_color();

my %colors;
# init color pairs
{
	my %term_colors = (
		black => COLOR_BLACK,
		blue  => COLOR_BLUE,
		cyan  => COLOR_CYAN,
		green => COLOR_GREEN,
		magenta => COLOR_MAGENTA,
		red   => COLOR_RED,
		white => COLOR_WHITE,
		yellow => COLOR_YELLOW
	);
	my $i = 1;
	for my $fore (sort keys %term_colors) {
		for my $back (sort keys %term_colors) {
			init_pair($i, $term_colors{$fore}, $term_colors{$back});
			$colors{$fore . '_' . $back} = $i;
			$i++;
		}
	}
}

attron( COLOR_PAIR( $colors{white_black} ) );

my $size_changed;
$SIG{'WINCH'} = sub { $size_changed = 1; };

my $max_y = 40; # Curses inits at top left, down is y+1, right is x+1 ( y,x NOT x,y )
my $max_x = 80;

my $grass    = ' '; # ????
my $empty    = '.'; # ????

my $player = $game_config->{newgame_player};
my $f_y = $game_config->{newgame_y};
my $f_x = $game_config->{newgame_x};
my $dialog_mode = 0;
my $menu_mode = 0;
my $battle_mode = 0;
my $hp = $game_config->{newgame_hp};
my $max_hp = $game_config->{newgame_max_hp};
my $atk = $game_config->{newgame_atk};
my $def = $game_config->{newgame_def};
my $lvl = $game_config->{newgame_lvl};
my $class = $game_config->{newgame_class};
my $hands = $game_config->{newgame_hands};
my $armor = $game_config->{newgame_armor};

my $curr_map = $game_config->{newgame_map};
my $scripts;
my %npcs; # coming in ( 25, 23, 'r', uid, OBJECT (in objects table), $movement_pattern, color ); actual hash uid -> %{ y, x, 'r', OBJECT, $movement_pattern, color }
my %npc_movements; # %{ 'bob1' => 0 } # 0 == array index and 'bob1' refers to $scripts->{npc_movements}->{bob1}
my %game_vars;
my @inventory = @{ $game_config->{newgame_inventory} };
my @status = ();
my %journal;
my %battle_sess;

sub draw_map {
	my $map = shift;
	$map = "$map.map";
	open my $fh, '<', './assets/'. $map 
		or endwin() and die "$map not accessible";
	move(0,0);
	while (<$fh>) {
		printw($_);
	}
	move($f_y, $f_x);
}

sub is_move_ok {
	my ($y, $x) = @_;
	move($y,$x);
	my $testchar = substr instring(), 0, 1;
	my %ok_movement = (
		$grass => 1,
		$empty => 1,
	);
	exists $ok_movement{$testchar} ? return 1 : return 0;
};

sub get_scripts {
	my $file = shift;
	$file = "$file.toml";
	my $err;
	($scripts, $err) = from_toml(read_text('./assets/' . $file));
	if ($err) {
		endwin();
		die "Error parsing toml: $err";
	}
	create_npcs($scripts);
};

sub create_npcs {
	undef %npcs;
	undef %npc_movements;
	my $scripts = shift;
	             #   0   1    2   3    4          5          6
	             # ( 25, 23, 'r', uid, "mr. rat", $behavior, color );
	for my $npc (@{ $scripts->{npc} }) {
		#       key uid         0 y         1 x     2 char     3 object   4 behavior 5 color
		$npcs{ $npc->[3] } = [$npc->[0], $npc->[1], $npc->[2], $npc->[4], $npc->[5], $npc->[6]];
		# pain. this shit should've been oop'd away.
	};
};

sub draw_npcs {
	for my $npc (keys %npcs ) {
		move($npcs{$npc}->[0], $npcs{$npc}->[1]);
		if ($npcs{$npc}->[5] ) {
			attroff( COLOR_PAIR( $colors{white_black} ));
			attron( COLOR_PAIR(  $colors{ $npcs{$npc}->[5] } ));
			addstr($npcs{$npc}->[2]);
			attroff( COLOR_PAIR(  $colors{ $npcs{$npc}->[5] } ));
			attron( COLOR_PAIR( $colors{white_black} ));
		}
		else {
			addstr($npcs{$npc}->[2]);
		}
	}
	refresh();
};

# TODO BUGFIX where NPC/Player can collide with one another and 'stack'
# a fix would be to check each npc position after thier movement
# I don't feel like doing this rn.
sub engage_npcs {
	for my $npc (keys %npcs) {
		if($npcs{$npc}->[4]) {
			my $behavior = $npcs{$npc}->[4];
			if ($behavior eq 'random_movement') {
				random_movement_npc($npc);
			}
			elsif (exists $npc_movements{$behavior}) {
				custom_movement_npc($npc, $behavior);
			}
			elsif (not exists $npc_movements{$behavior}) {
				$npc_movements{$behavior} = 0;
				custom_movement_npc($npc, $behavior);
			}
		}
	}
	draw_npcs();
};

sub random_movement_npc {
	my $npc = shift;
	my $move = int rand 8;
	if ($move == 1) { # move up
		if (is_move_ok($npcs{$npc}->[0] - 1, $npcs{$npc}->[1])) {
			addch($npcs{$npc}->[0], $npcs{$npc}->[1], ' ');
			$npcs{$npc}->[0] -= 1
		}
	} elsif ($move == 2) { # move down
		if (is_move_ok($npcs{$npc}->[0] + 1, $npcs{$npc}->[1])) {
			addch($npcs{$npc}->[0], $npcs{$npc}->[1], ' ');
			$npcs{$npc}->[0] += 1
		}
	} elsif ($move == 3) { # move right
		if (is_move_ok($npcs{$npc}->[0], $npcs{$npc}->[1] + 1)) {
			addch($npcs{$npc}->[0], $npcs{$npc}->[1], ' ');
			$npcs{$npc}->[1] += 1
		}
	} elsif ($move == 4) { # move left
		if (is_move_ok($npcs{$npc}->[0], $npcs{$npc}->[1] - 1)) {
			addch($npcs{$npc}->[0], $npcs{$npc}->[1], ' ');
			$npcs{$npc}->[1] -= 1;
		}
	} 
	else { }; # don't move
}

sub custom_movement_npc {
	my ($npc, $behavior) = @_;
	my %movement_cmds = (
		l => sub { my $npc = shift; return $npc->[0], $npc->[1] - 1; },
		r => sub { my $npc = shift; return $npc->[0], $npc->[1] + 1; },
		u => sub { my $npc = shift; return $npc->[0] - 1, $npc->[1]; },
		d => sub { my $npc = shift; return $npc->[0] + 1, $npc->[1]; },
		w => sub { return -1, -1; },
	);

	# enjoy, future me. :^)
	# ... okok just remember:
	# %npcs, %npc_movements, and $scripts are global. $scripts is the TOML file
	# $behavior is a key for a value (char array) that $scripts->{npc_movements} has
	# %npc_movements: %{ $behavior => 0, ... } where 0 is array index
	# %movement_cmds: keys are chars that the array can return; values are code blocks
	my ($y, $x) = $movement_cmds{ 
				$scripts->{npc_movements}->{$behavior}->[ $npc_movements{$behavior} ] 
			}( $npcs{$npc} );
	
	if ($y == -1 and $x == -1) {
		my $new_index = ($npc_movements{$behavior} + 1) % scalar @{ $scripts->{npc_movements}->{$behavior} };
		$npc_movements{$behavior} = $new_index;
		return;
	}

	if (is_move_ok($y, $x)) {
		addch($npcs{$npc}->[0], $npcs{$npc}->[1], ' '); # put whitespace on char
		($npcs{$npc}->[0], $npcs{$npc}->[1]) = ($y, $x); # new coords, so it can be drawn
		my $new_index = ($npc_movements{$behavior} + 1) % scalar @{ $scripts->{npc_movements}->{$behavior} };
		$npc_movements{$behavior} = $new_index;
	}
}

sub run_map_script {
	## no critic (eval)
	if ($scripts->{map_script}) {
		eval $scripts->{map_script};
		if ($@) {
			endwin();
			die $@;
		}
	}
};

sub interact {
	# I'll just use 'dumb' logic here.
	
	my ($y, $x) = @_;
	# get list of interactables
	my $object;
	for my $interact_list ( @{ $scripts->{interact} } ) {
		if ($interact_list->[0] == $y and $interact_list->[1] == $x + 1) { # to the right
			$object = $interact_list->[2];
			goto INTERACT_GOTO;
		} elsif ($interact_list->[0] == $y and $interact_list->[1] == $x - 1) { # to the left
			$object = $interact_list->[2];
			goto INTERACT_GOTO;
		} elsif (($interact_list->[0] == $y + 1) and $interact_list->[1] == $x) { # to the down
			$object = $interact_list->[2];
			goto INTERACT_GOTO;
		} elsif (($interact_list->[0] == $y - 1) and $interact_list->[1] == $x) { # to the up
			$object = $interact_list->[2];
			goto INTERACT_GOTO;
		} elsif ($interact_list->[0] == $y and $interact_list->[1] == $x) { # right on top of it (which is a bug but w/e)
			$object = $interact_list->[2];
			goto INTERACT_GOTO;
		}
	}
	# check each and all npcs
	for my $npc (keys %npcs) {
		if ($npcs{$npc}->[0] == $y and $npcs{$npc}->[1] == $x + 1) { # to the right
			$object = $npcs{$npc}->[3];
			goto INTERACT_GOTO;
		} elsif ($npcs{$npc}->[0] == $y and $npcs{$npc}->[1] == $x - 1) { # to the left
			$object = $npcs{$npc}->[3];
			goto INTERACT_GOTO;
		} elsif (($npcs{$npc}->[0] == $y + 1) and $npcs{$npc}->[1] == $x) { # to the down
			$object = $npcs{$npc}->[3];
			goto INTERACT_GOTO;
		} elsif (($npcs{$npc}->[0] == $y - 1) and $npcs{$npc}->[1] == $x) { # to the up
			$object = $npcs{$npc}->[3];
			goto INTERACT_GOTO;
		} elsif ($npcs{$npc}->[0] == $y and $npcs{$npc}->[1] == $x) { # right on top of it (which is a bug but w/e)
			$object = $npcs{$npc}->[3];
			goto INTERACT_GOTO;
		}
	}

	INTERACT_GOTO:
	if ($object) {
		# hopefully no one wrote anything naughty here
		## no critic (eval)
		eval $scripts->{objects}->{$object};
		if ($@) {
			endwin();
			die $@;
		}
		refresh();
	}
}

sub dialog {
	my ($name, $dialog, $redraw) = @_;
	defined $redraw or $redraw = 1; # redraw by default.
	$dialog_mode = 1;
	dialog_box();
	dialog_wrap($name, $dialog);

	#move($f_y, $f_x);
	while () {
		my $input = getchar();
		if ($input eq ' ' or $input eq KEY_ENTER) {
			if ($redraw) {
				endwin();
				draw_map($curr_map);
				draw_npcs();
				addch($f_y, $f_x, $player);
				move($f_y, $f_x);
				refresh();
				$dialog_mode = 0;
				last;
			}
			else {
				# note that this doesn't toggle $dialog_mode
				# inventory_item_menu() handles this ok
				last;
			}
		}
	}
};

sub dialog_box {
	my ($name) = @_;
	hline(30, 14, ACS_HLINE, 50);
	for (31..34) {
		hline($_, 14, ' ', 50);
	}
	hline(35, 14, ACS_HLINE, 50);
	vline(30,14, ACS_VLINE, 6);
	vline(30,64, ACS_VLINE, 6);
	addch(30,14, ACS_ULCORNER); # top left
	addch(30,64, ACS_URCORNER); # top right
	addch(35,14, ACS_LLCORNER); # bottom left
	addch(35,64, ACS_LRCORNER); # bottom right
	move(35,40);
	printw("SPACE TO CONTINUE");
}

sub dialog_wrap {
	my ($name, $dialog) = @_;
	move(31,15);
	printw($name);
	# 31 -> 34 on y axis (so 3 lines of dialog)
	# 14 -> 64 on x axis (but really 15 to 63 so about 48 chars per line)
	my @lines = split "\n", $dialog;
	my $y = 32;
	for (@lines) {
		move($y, 15);
		printw($_);
		$y++;
	}
}

sub teleport {
	my ($map, $y, $x) = @_;
	$curr_map = $map;
	endwin();
	get_scripts($map);
	draw_map($map);
	run_map_script();
	draw_npcs();
	$f_y = $y;
	$f_x = $x;
	move($f_x, $f_x);
	refresh();
}

sub game_loop {
	my ($new_game) = @_;
	get_scripts($curr_map) if $new_game;
	draw_map($curr_map);
	draw_npcs();
	run_map_script();

	# main gameplay loop
	my $input;
	while () {
		if ($size_changed) {
			endwin();
			refresh();
			draw_map($curr_map);
		}

		if ($dialog_mode) {
		}
		if ($menu_mode) {
			$input = getchar();
			if ($input eq 's') {
				my $save = {
					hp => $hp,
					max_hp => $max_hp,
					atk => $atk,
					def => $def,
					lvl => $lvl,
					class => $class,
					f_y => $f_y,
					f_x => $f_x,
					hands => $hands,
					armor => $armor,
					inventory => \@inventory,
					status => \@status,
					curr_map => $curr_map,
					scripts => $scripts, # this will be awkward I suspect
				};
				%journal and $save->{journal} = \%journal;
				%game_vars and $save->{game_vars} = \%game_vars;
				%npc_movements and $save->{npc_movements} = \%npc_movements;
				%npcs and $save->{npcs} = \%npcs;

				write_text($game_config->{save_file}, to_toml($save));
				move(1,1);
				printw("saved");
			} elsif ($input eq 'i') {
				inventory_menu();
			} elsif ($input eq 'j') {
				journal_menu();
			} elsif ($input eq '~') {
				# quit game
				endwin();
				exit 0;
			} elsif ($input eq 'q') {
				$menu_mode = 0;
				draw_map($curr_map);
				draw_npcs();
			}
			next;
		}

		move($f_y, $f_x);
		addstr($player);
		move($f_y, $f_x);
		refresh();
		$input = getchar();
		if ($input eq 'w' or $input eq KEY_UP) {
			if ($f_y > 0 and is_move_ok($f_y-1, $f_x)) {
				addch($f_y, $f_x, $empty);
				$f_y = $f_y - 1;
			}
		} elsif ($input eq 's' or $input eq KEY_DOWN) {
			if ($f_y < $max_y - 1 and is_move_ok($f_y+1, $f_x)) {
				addch($f_y, $f_x, $empty);
				$f_y = $f_y + 1;
			}
		} elsif ($input eq 'a' or $input eq KEY_LEFT) {
			if ($f_x > 0 and is_move_ok($f_y, $f_x-1)) {
				addch($f_y, $f_x, $empty);
				$f_x = $f_x - 1;
			}
		} elsif ($input eq 'd' or $input eq KEY_RIGHT) {
			if ($f_x < $max_x - 1 and is_move_ok($f_y, $f_x+1)) {
				addch($f_y, $f_x, $empty);
				$f_x = $f_x + 1;
			}
		} elsif ($input eq ' ' or $input eq KEY_ENTER) {
			interact($f_y, $f_x);
			next;
		} elsif ($input eq 'm') {
			$menu_mode = 1;
			start_menu();
			next;
		}
		else { };
		engage_npcs();
		move($f_y, $f_x);
	}
}

# TODO
# curses website advises against this sort of thing but I don't feel like I
# have enough time to learn the proper way with windows and such
sub menu_box {
	my ($starty, $startx, $endy, $endx) = (0,0,39,80); # roughly the size of the game

	hline($starty, $startx, ACS_HLINE, $endx);
	for ($starty+1..$endy) {
		hline($_, $startx+1, ' ', $endx-1);
	}
	hline($endy, $startx, ACS_HLINE, $endx);
	vline($starty,$startx, ACS_VLINE, $endy);
	vline($starty,$endx, ACS_VLINE, $endy);
	addch($starty,$startx, ACS_ULCORNER); # top left
	addch($starty,$endx, ACS_URCORNER); # top right
	addch($endy,$startx, ACS_LLCORNER); # bottom left
	addch($endy,$endx, ACS_LRCORNER); # bottom right
}

sub start_menu {
	menu_box();
	my $r = 2; # row
	my $lc = 6; # left column
	my $rc = 50; # right column
	move(++$r, $lc);
	printw("Game Menu");
	move(++$r, $lc);
	printw("(s)ave");
	move(++$r, $lc);
	printw("(i)nventory");
	move(++$r, $lc);
	printw("(j)ournal");
	move(++$r, $lc);
	printw("~ to quit game");
	move(++$r, $lc);
	printw("q to leave menu");

	$r = 2;
	move(++$r, $rc);
	printw("Fernando");
	move(++$r, $rc);
	printw("~~,=,^>  $hp/$max_hp");
	move(++$r, $rc);
	printw("class: $class");
	move(++$r, $rc);
	printw("atk ($hands) $atk");
	move(++$r, $rc);
	printw("def ($armor) $def");
	move(++$r, $rc);
	if (scalar @status == 0) {
		printw("Statuses: none");
	} else {
		printw("Statuses: ");
		for my $status (@status) {
			printw($status);
		}
	}
}

sub journal_menu {
	while () {
		menu_box();
		my $r = 2; # row
		move(1,1);
		printw("Journal: q -> back, number -> more details"); # atm this means no more than 10 quests
		my $i = 0;
		for my $entry (sort keys %journal) {
			move(++$r,6);
			printw("$i> $journal{$entry}->[0]: $journal{$entry}->[2]");
			$i++;
		}

		my $input = getchar();
		if ($input eq 'q') {
			start_menu();
			last;
		}
		else {
			#            single digit
			if ($input =~ m/^\d$/ and $input <= (scalar keys %journal) - 1 ) {
				my @ids = sort keys %journal;
				journal_entry_menu( $ids[$input] );
			}
			else {
				next;
			}
		}
	}
}

sub journal_entry_menu {
	my $id = shift;
	menu_box();
	my $r = 2; # row
	move(1, 1);
	printw("q -> back");
	move(++$r, 1);
	printw("$journal{$id}->[0]: $journal{$id}->[2] (given at $journal{$id}->[1])");
	$r++;
	for my $line (split "\n", $journal{$id}->[3]) {
		move(++$r, 1);
		printw($line);
	}

	while () {
		my $je_input = getchar();
		if ($je_input eq 'q') {
			last;
		}
	}

}

sub quest {
	my ($quest_giver, $where_given, $title, $description, $id) = @_;
	$journal{$id} = [$quest_giver, $where_given, $title, $description];
}

sub quest_desc_add {
	my ($desc, $id) = @_;
	$journal{$id}->[3] .= "\n$desc";
}

sub main_menu {
	# should contain basic instructions
	# 	eg. arrow keys to move, space to interact, m for in game menu 
	# if saved game detected: {
	# 	(l)oad
	# }
	# (n)ew
	# load should read in a TOML file and replace the current global values
	## no critic (io layer)
	open my $fh, '<:utf8','./assets/main_menu' 
		or endwin() and die "$!";
	move(0,0);
	while (<$fh>) {
		printw($_);
	}
	close $fh;
	my $script = from_toml(read_text('./assets/main_menu.toml'));
	## no critic (eval)
	eval $script->{do_this};
	if ($@) {
		endwin();
		die $@;
	}
	while () {
		my $input = getchar();
		if ($input eq 'n') {
			game_loop(1);
			last;
		} elsif ($input eq 'l') {
			my $save = from_toml(read_text($game_config->{save_file}));
			$f_y = $save->{f_y};
			$f_x = $save->{f_x};
			$hp = $save->{hp};
			$max_hp = $save->{max_hp};
			$lvl = $save->{lvl};
			$atk = $save->{atk};
			$def = $save->{def};
			$class = $save->{class};
			$hands = $save->{hands};
			$armor = $save->{armor};
			$curr_map = $save->{curr_map};
			$scripts = $save->{scripts};
			%npcs = %{ $save->{npcs} } if $save->{npcs};
			%npc_movements = %{ $save->{npc_movements} } if $save->{npc_movements};
			%game_vars = %{ $save->{game_vars} } if $save->{game_vars};
			%journal = %{ $save->{journal} } if $save->{journal};
			@inventory = @{ $save->{inventory} };
			$curr_map = $save->{curr_map};
			undef $save;
			game_loop();
			last;
		}
		elsif ($input eq 'b') {
			$hands = qq(Cool Sword);
			$atk = 15;
			item('hp potion');
			battle('King J.J. Akke');
		}
	}
}

sub inventory_menu {
	while() {
		menu_box();
		my $r = 2;
		move(1,1);
		printw("Inventory: q -> back, numb -> more details"); # atm this means no more than 10 items
		my $i = 0;
		for my $item (@inventory) {
			move(++$r, 6);
			printw("$i> $item");
			$i++;
		}

		my $input = getchar();
		if ($input eq 'q') {
			start_menu();
			last;
		}
		else {
			if ($input =~ m/^\d$/ and $input <= (scalar @inventory) - 1 ) {
				inventory_item_menu( $inventory[$input] );
			}
			else {
				next;
			}
		}
	}
}

sub inventory_item_menu {
	my ($id) = @_;
	menu_box();
	my $r = 2; #row
	move(1,1);
	printw('Inventory Item: q -> back, e -> equip/use ');
	if ($hands eq $id or $armor eq $id) {
		printw("(equiped)");
	}

	my ($type, $desc, $behavior) = @{ $game_items->{$id} };
	move(++$r, 2);
	printw("$id: $type ");
	if ($type eq 'hands') {
		printw("atk $behavior");
	} elsif ($type eq 'armor') {
		printw("def $behavior");
	} elsif ($type eq 'potion') {
		printw("(consumable)");
	} elsif ($type eq 'key item') {
		printw("(key item -> cannot be used)");
	}
	for my $line ( split "\n", $desc ) {
		move(++$r, 2);
		printw($line);
	}
	
	while () {
		my $input = getchar();
		if ($input eq 'q') {
			last;
		}
		elsif ($input eq 'e') {
			if ($type eq 'hands') {
				$hands = $id;
				$atk = $behavior;
				# not happy with this below but it'll do for now
				move(1,1);
				printw('Inventory Item: q -> back, e -> equip (equiped)');
			} elsif ($type eq 'armor') {
				$armor = $id;
				$def = $behavior;
				move(1,1);
				printw('Inventory Item: q -> back, e -> equip (equiped)');
			} elsif ($type eq 'potion') {
				## no critic (eval)
				eval $behavior;
				if ($@) {
					endwin();
					die $@;
				}
				if ($dialog_mode) {
					$dialog_mode = 0;
					last;
				}
			} elsif ($type eq 'key item') {
				; # nothing
			}
		}
	}
}

sub item {
	my $item = shift;
	exists $game_items->{$item}
		and push (@inventory, $item)
		or dialog('system', "Sorry player, this item\n`$item'\ndoesn't exist in the game system.");
}

sub item_remove {
	my $item = shift;
	exists $game_items->{$item}
		or dialog('system', "Sorry player, this item \n`$item`\n cannot be remove as it doesn't exist in game system.") 
		and return;

	my $i = 0;
	for my $test (@inventory) {
		if ($test eq $item) {
			splice @inventory, $i, 1;
		}
		$i++;
	}
}

sub item_has {
	my $item = shift;
	my $i = 0;
	for my $test (@inventory) {
		if ($test eq $item) {
			return 1;	
		}
		$i++;
	}
	return 0;
}


sub status_add {
	my $status = shift;
	push @status, $status;
}

sub battle {
	my $battler = shift;
	exists $battlers->{$battler}
		or return;
	undef %battle_sess;
	$battle_sess{hp} = $battlers->{$battler}{hp};
	$battle_sess{battler} = $battler;
	$battle_sess{atk} = $battlers->{$battler}{atk};
	$battle_sess{hands} = $battlers->{$battler}{hands};
	$battle_sess{def} = $battlers->{$battler}{def};
	$battle_sess{armor} = $battlers->{$battler}{armor};
	$battle_sess{art} = $battlers->{$battler}{art};
	$battle_mode = 1;
	while () {
		battle_screen_update();
		if ($hp < 0) {
			dialog('', qq(You died.\nGame over.));
			refresh();
			sleep 5;
			endwin();
			exit;
		}
		elsif ($battle_sess{hp} <= 0) {
			last;
		}

		my $input = getchar();
		if ($input eq 'a') {
			my $f_dmg = $atk - $battle_sess{def};
			my $b_dmg = $battle_sess{atk} - $def;
			$battle_sess{hp} -= $f_dmg;
			$hp -= $b_dmg;
			$battle_sess{last_event} = "Fernando dealt $f_dmg damage.  $battler dealt $b_dmg.";
		}
		elsif ($input eq 'h') {
			if (item_has('hp potion')) {
				$hp = $max_hp;
				my $b_dmg = $battle_sess{atk} - $def;
				$hp -= $b_dmg;
				$battle_sess{last_event} = "Fernando healed up!.  $battler dealt $b_dmg.";
				item_remove('hp potion');
			}
			else {
				$battle_sess{last_event} = "No hp potions left.";
			}
		}
	}
	draw_map($curr_map);
	draw_npcs();
	return 1;
}

sub battle_screen_update {
	menu_box();
	my $r = 2; #row
	my $lc = 6; # left column
	my $rc = 46; # right column
	move(++$r,$lc);
	printw("Fernando");
	move(++$r,$lc);
	printw('~~,=,^>');
	move(++$r,$lc);
	printw("hp: $hp");
	move(++$r,$lc);
	printw("atk: $hands ($atk)");
	move(++$r,$lc);
	printw("def: $armor ($def)");

	$r = 2;
	move(++$r,$rc);
	printw($battle_sess{battler});
	move(++$r,$rc);
	printw($battle_sess{art});
	move(++$r,$rc);
	printw("hp: $battle_sess{hp}");
	move(++$r,$rc);
	printw("atk: $battle_sess{hands} ($battle_sess{atk})");
	move(++$r,$rc);
	printw("def: $battle_sess{armor} ($battle_sess{def})");

	$r = 10;
	move(++$r,$lc);
	printw("a -> attack, h -> use potion");
	move(++$r,$lc);
	move(++$r,$lc);
	printw($battle_sess{last_event}) if $battle_sess{last_event};
}

sub goodend {
	my ($lines) = @_;
	menu_box();
	my $r = 2; #row
	my $lc = 2; #left column
	for my $line (split "\n", $lines) {
		move(++$r,$lc);
		printw($line);
	}
	while () {
		my $input = getchar();
		if ($input == ' ') {
			endwin();
			exit;
		}
	}
}

main_menu();

endwin();