#!/usr/bin/perl -w

# $Id: u6edit,v 1.127 2003/02/13 05:34:31 jim Exp $

use strict;
require 5.006_001;
use Gtk;

use Data::Dumper;
use FindBin;
use lib "$FindBin::Bin/lib";

use U6C;
use U6::Obj  qw(@objblk map_type_to_tile STATUS_UNKNOWN objects_at add_object_at remove_object_at);
use U6::Book qw(@books);
use U6::Tile qw(@masktypes @tileindx @maptiles %anim @tileflag update_animated_tiles tile_size);
use U6::Look qw(get_obj_name);
use U6::Map  qw(@map @chunks world_to_chunk chunk_to_world maptile_at);
use U6::Pal;
use U6::Util;

use U6::BookEdit;
use U6::MapEdit;
use U6::TileEdit;

init Gtk;
set_locale Gtk;
init Gtk::Gdk::Rgb;

my $false = 0;
my $true = 1;

my $drawing_area;
my $map_frozen = 0;

# Load palette data
my  $pal  = new U6::Pal;
our $cmap = new Gtk::Gdk::Rgb::Cmap($pal->pal);

U6::Tile::init();				# Load all tile data (hybrid tiles ignored)
U6::Map::init();				# Load map data
U6::Book::init();				# Load books
U6::Look::init();				# Load object descriptions
U6::Obj::init();				# Load objects

print "tiles: ", scalar @maptiles, "\n";
print "animated tiles: ", $anim{numtiles}, "\n";
print "books: ", scalar @books, "\n";
print "chunks: ", scalar @chunks, "\n";
print "superchunks: ", scalar @map, "\n";
print "tileflags: ", scalar @tileflag, "\n";

# Book editor
# my $bookedit = create U6::BookEdit;

# Replace animated tiles with animation frame #0.
my $game_timer = 0;
update_animated_tiles($game_timer);

# Important: mapedit must reside after U6::Book::init, because
# it creates a book editor which relies on @books being defined
# at that point.
my $mapedit = create U6::MapEdit(512, 384);
$mapedit->show();

Gtk->main;
exit( 0 );

### Subroutines

my $drawable;
my $gc;

# This stuff actually needs to be in U6::MapEdit, but I'm tired.
sub draw_map_viewport {
	return 1 if $map_frozen;
	$drawing_area = $mapedit->drawing_area();
	my $buffer = $mapedit->{buffer};
    my $bgcolor = Gtk::Gdk::Color->parse_color( 'black' );
    $bgcolor = $drawing_area->window->get_colormap()->color_alloc( $bgcolor );
    $drawing_area->window->set_background( $bgcolor );

	$drawable = $drawing_area->window;
	$gc = $drawing_area->style->white_gc;

	my ($xs, $ys) = (0,0);  # starting coordinates
	my ($scxs, $scys, $cxs, $cys, $txs, $tys) = world_to_chunk($mapedit->coords);

	my ($x, $y) = ($xs, $ys);
	my ($scx, $scy, $cx, $cy, $tx, $ty) = ($scxs, $scys, $cxs, $cys, $txs, $tys);
	my ($schunk, $chunk, $tile);

	my $width  = $drawing_area->allocation->[2];
	my $height = $drawing_area->allocation->[3];

	# Add an extra tile into the buffer if we're not on a tile boundary
	my $stride = $width & ~15;
	$stride += 16 if $width & 0x0f;  

	my %schunk_seen;

	while ($y < $height) {
		while ($x < $stride) {
			$schunk = $scx + $scy * 8;   # 8x8 superchunks / map
			$schunk_seen{$schunk}++;   # record unique superchunks on this screen for objblk display: kludgey

			$chunk = $map[$schunk][$cx + $cy * 16];     # 16x16 chunks / schunk
			$tile = $chunks[$chunk][$tx + $ty * 8];  # 8x8 tiles / chunk
			U6C::copy_tile_into_buffer8($$buffer, $maptiles[$tile], $x, $y, $stride);

			# Next column
			$x += 16; # tile width
			$tx++;
			$tx = 0, $cx++ if $tx >= 8;
			$cx = 0, $scx++ if $cx >= 16;
			$scx = 0 if $scx >= 8;
		}
		# Reset x values
		($x, $tx, $cx, $scx) = ($xs, $txs, $cxs, $scxs);  # Next row
		$y += 16;
		$ty++;
		$ty = 0, $cy++ if $ty >= 8;
		$cy = 0, $scy++ if $cy >= 16;
		$scy = 0 if $scy >= 8;
	}

	if ($mapedit->objects_are_active()) {

	# draw objects in range
	# get world coordinates of upper left tile in window
	my ($wx, $wy) = $mapedit->coords;

#	print "wcx $wx $wy\n";

	my $objs = 0;
	my $objs_drawn = 0;
	for my $blk (keys %schunk_seen) {
		# Draw all objects corresponding to superchunks we've seen while drawing
		# the viewport.  Kludgey, but effective.
	for (@{ $objblk[$blk] }) {
#		next if is_unknown(%$_);  # wow, this -destroys- idle time!
		# FIXME This is manually inlined to save >30% CPU time.
		next if $_->{status} & STATUS_UNKNOWN;

		next if $_->{x} < $wx;      # discard tiles with too low coords
		next if $_->{y} < $wy;      # of course this won't wrap around correctly 
		$x = 16 * ($_->{x} - $wx);  # offset onto screen
		$y = 16 * ($_->{y} - $wy);
		# Here we assume all tiles are transparent.  
		next if $x >= $stride + 16;
		next if $y >= $height + 16;
#		$objs++;
#		next if $x >= $width;
#		next if $y >= $height;
#		$objs_drawn++;
		# This call appears to take an extremely long time.  So we bail out above,
		# negating the right-clipping compensation for large object below.
		# This is because the width/height check saves checking several hundred objects.
		# The interim solution is to allow an extra tile on the right for the initial
		# boundary check---removing most objects off screen---then do the actual checks below.
		# The extra tile still costs quite a bit, so there is huge room for optimization (somewhere).
#		$tile = map_type_to_tile($_->{type});
		$tile = $_->{tile};
		U6C::copy_transp_tile_into_buffer8($$buffer, $maptiles[$tile], 
		                                   $x, $y, $stride, 0xff) if $x < $stride and $y < $height;

		# Handle objects composed of more than one tile.  Not really a good way
		# to do this.
		my $size = tile_size($tile);   # returns size as 2-bit value
		if ($size & 0x02) {
			# Width 2: draw (lower) left tile
			$tile--;
			U6C::copy_transp_tile_into_buffer8($$buffer, $maptiles[$tile], 
		                                       $x - 16, $y, $stride, 0xff) 
											   if $x - 16 < $stride and $y < $height and $x - 16 >= 0;
		}
		if ($size & 0x01) {
			# Height 2: draw upper right tile
			$tile--;
			U6C::copy_transp_tile_into_buffer8($$buffer, $maptiles[$tile], 
		                                       $x, $y - 16, $stride, 0xff) 
											   if $x < $stride and $y - 16 < $height and $y - 16 >= 0;
			if ($size & 0x02) {
				# Width 2: draw upper left tile
				$tile--;
				U6C::copy_transp_tile_into_buffer8($$buffer, $maptiles[$tile], 
		                                       $x - 16, $y - 16, $stride, 0xff) 
											   if $x - 16 < $stride and $y - 16 < $height and $x - 16 >= 0 and $y - 16 >= 0;
											                                  
			}
		}

	}
	}
	}

#	print "objs: $objs seen $objs_drawn drawn\n";

#	substr($buffer, 0, 1) = " ";
#
	draw_buffer();

	return $true unless $mapedit->grid_is_active();

	# Draw gridlines corresponding to chunks
	my $sx = -($txs * TILE_HEIGHT);
	while ($sx < $width) {
		$drawing_area->window->draw_line($gc, $sx, 0, $sx, $height);
		$sx += TILE_HEIGHT * 8;
	}
	my $sy = -($tys * TILE_WIDTH);
	while ($sy < $width) {
		$drawing_area->window->draw_line($gc, 0, $sy, $width, $sy);
		$sy += TILE_WIDTH * 8;
	}

    return $true;
}

sub draw_buffer {
	my $drawable = $drawing_area->window;
	my $gc = $drawing_area->style->white_gc;
	my $width  = $drawing_area->allocation->[2];
	my $height  = $drawing_area->allocation->[3];
	my $stride = $width & ~15;  
	my $buffer = $mapedit->{buffer};
	$stride += 16 if $width & 15; # Add an extra tile if we're not on a tile boundary
	$drawable->draw_indexed_image($gc, 0, 0, $width, $height, 'none', $$buffer, $stride, $cmap);
}

sub map_buttonpress {
	my ($w, $s, $e) = @_;
	my ($x, $y) = ($e->{x}, $e->{y});
	my ($click_wx, $click_wy) = $mapedit->screen_to_world($x, $y);
	our ($click_wx_last, $click_wy_last) = ($click_wx, $click_wy);

	my @coords = world_to_chunk($click_wx, $click_wy);
	my $tile   = maptile_at($click_wx, $click_wy);
	return 1 unless $e->{button} == 1;  # Only respond to first button.
	printf "world (%03x, %03x) window [$x, $y] chunk [@coords]\n", $click_wx, $click_wy;
	my $name = get_obj_name($tile);
	my $parsed_name = $name;
	my $article = U6::Tile::article($tile);
	$parsed_name = "$article " . $parsed_name if $article;
	printf "   maptile: %04x %s -> %s\n", $tile, $name, $parsed_name;
	if ($mapedit->objects_are_active()) {
		my (undef, undef, @objs) = objects_at($click_wx, $click_wy);
		output_objects(0, @objs);
		$mapedit->{stackedit}->build($click_wx, $click_wy, \@objs);
		$mapedit->{stackedit}->show();
	}
	# -Must- return 1 or 0 here.
	return 1;
}

sub get_parsed_name {
	my $obj = shift;
	my $name = get_obj_name($obj->{tile});
	my $article = U6::Tile::article($obj->{tile});
	my $qty = $obj->{quantity};
	# Hack: treat as a quantity 0 (singular) object if the name
	# cannot be transformed into the plural.  Takes care of
	# quantity on chests, doors, etc., since I can't distinguish this otherwise.
	$qty = 0 if $name !~ /\\/;
	if ($qty == 0 || $qty == 1) {
		# Singular object.
		$name =~ s:\\[A-Za-z]*::;   # Remove plural modifier, e.g. \ves
		$name =~ s:/::;             # Remove singular prefix /
		$article = $qty if $qty == 1;
		substr($name, 0, 0) = "$article " if $article;
		return $name;
	}
	$name =~ s:/[A-Za-z]*::;   # Remove singular modifier, e.g. /f
	$name =~ s:\\::;           # Remove plural prefix \
	substr($name, 0, 0) = "$qty ";
	return $name;
}

# Warning: this code mixes generic, recursive object traversal with 
# specific actions to perform on those objects.  One way to address this
# would be to pass in a callback sub to be executed for each object.
sub output_objects {
	my $depth = shift;
	for (@_) {
		my $tile = map_type_to_tile($_->{type});
		my $name = get_obj_name($tile);
		my $pre = "   " x $depth;
		my $article = U6::Tile::article($tile);
		printf "$pre" . "   object:  %04x %s -> %s\n", $tile, get_obj_name($tile), get_parsed_name($_);

		# I can't identify books by tile number yet. 
		if ($name =~ /^book|scroll|picture$/) {
			my $book = $_->{quality} - 1;
			# Erroneous books >= 128 are probably not caught properly.
			print "$pre" . "      book contents: ";
			print $book >= 0 ? $books[$_->{quality} - 1] : "(none)";
			print "\n";
			# Set book editor to this book.  Negative books are 
			# flagged as invalid/empty.
#			$bookedit->book($book);
		}
		my $contains = $_->{contains};
		if (defined $contains) {
			output_objects($depth + 1, @$contains);
		}
	}
}

# Note: we can receive a release outside the window (drag from inside to outside
# to test).
sub map_buttonrelease {
	my ($w, $s, $e) = @_;
	my ($x, $y) = ($e->{x}, $e->{y});
	my ($click_wx, $click_wy) = $mapedit->screen_to_world($x, $y);
	our ($click_wx_last, $click_wy_last);  # Variables set in map_buttonpress
	if(not defined $click_wx_last or not defined $click_wy_last) {
		# Ignore button releases without previous press.
		# warn("warning: ignored button release without corresponding press\n");
		return 1;
	}
#	printf "world (%03x, %03x) release\n", $click_wx, $click_wy;
	if ($e->{button} == 1) {
		# Left click
		# You can check $e->{state} for modifiers: 0x01 shift, 0x04 ctrl, 0x08 alt
		# It's GTK_CONTROL_MASK in C, but it doesn't seem to be present in Perl.
		print "control held\n" if $e->{state} & GDK_CONTROL_MASK;
		if ($click_wx_last != $click_wx || $click_wy_last != $click_wy) {
			# A drag occurred.
			printf "drag to (%03x, %03x) from (%03x, %03x)\n", $click_wx, $click_wy, $click_wx_last, $click_wy_last;
			my $obj;
			if ($mapedit->objects_are_active()) {
				if ($e->{state} & GDK_CONTROL_MASK) {
					# Control-drag to copy.
					my (undef, undef, @objs) = objects_at($click_wx_last, $click_wy_last);
					$obj = U6::Obj::clone($objs[-1]);
				} else {
					$obj = remove_object_at($click_wx_last, $click_wy_last)
				}
			}
			if($obj) {
				# Move (or copy) the dragged object.  Rebuild the Stack.
				add_object_at($click_wx, $click_wy, $obj);
				print "- moved ", get_obj_name($obj->{tile}), "\n";
				my (undef, undef, @objs) = objects_at($click_wx, $click_wy);
				$mapedit->{stackedit}->build($click_wx, $click_wy, \@objs);
			} else {
				# No object is there, so copy the maptile (assuming terrain editing is enabled).
				# We might want to select the tile in TileEdit.
				if ($mapedit->{terrain_toggle}->active()) {
					my $tile = maptile_at($click_wx_last, $click_wy_last);
					maptile_at($click_wx, $click_wy) = $tile;
				}
			}
		}
		undef $click_wx_last;
		undef $click_wy_last;
	} elsif ($e->{button} == 3) {
#		add_object_at($click_wx, $click_wy, 
#		   { x => $click_wx, y => $click_wy, status => 0x00, type => 0x0001, 
#		     quantity => 0, quality => 0 });
		my $tile = $mapedit->{tileedit}->selected;
		# Manually restrict tile to be less than 256 (256-511 are animated
		# source tiles [check this]), 512- are objects.
		maptile_at($click_wx, $click_wy) = $tile if $tile < 256;
	} elsif ($e->{button} == 2) {
		my $obj = remove_object_at($click_wx, $click_wy);
		print "- removed ", get_obj_name($obj->{tile}), "\n" if $obj;
	}
	draw_map_viewport() unless $mapedit->animation_is_active();
	return 1;
}

sub update_palettes {
	my $timer = shift;
	$pal->rotate_palette(8, 0xE0, 0xE8);
	# 8 entry palettes rotate twice as fast as 4 entry
 	$pal->rotate_palette(4, 0xF0, 0xF4, 0xF8) unless $timer & 1; 
	$cmap->free();
	$cmap = new Gtk::Gdk::Rgb::Cmap($pal->pal);
}

# The tile / palette updates don't take much time; it's the viewport drawing that detracts
# from the scrolling time, because scrolling cannot execute while this is in progress
# (there's only one thread).  Also note, timer functions are called manually by GTK,
# it's not a true alarm.
# The current solution is to update the viewport exclusively from here whenever
# animation is enabled.  This is much faster, but causes somewhat chunky scrolling 
# speed.
sub update_game_timer {
	$game_timer++;
	update_animated_tiles($game_timer);
	# I don't actually know how palette cycling correlates with animated tile updates.
	update_palettes($game_timer);
	# FIXME We should actually check if screen updates are taking too long, and
	# if so, skip this one.
	draw_map_viewport();
}

