#!/usr/bin/perl

use strict;
use warnings;
use Math::Trig;
use Image::Magick; # for heightmap processing
use MD3;
use Params;

sub Heightfield_Segmentize($$)
{
	my ($n0, $n) = @_;
	# map, so that:
	#   0 -> 0
	#   n-1 -> n0-1
	return (0) if $n == 1;
	my $f = ($n0 - 1) / ($n - 1);
	return map { int(0.5 + $_ * $f) } 0..($n - 1);
}

sub Heightfield_Generate(&$$)
{
	my ($sub, $w, $h) = @_;
	my @hf;
	for my $y(0..$h - 1)
	{
		my @row = ();
		for my $x(0..$w - 1)
		{
			push @row, [$sub->($x, $y)];
		}
		push @hf, \@row;
	}
	return
	{
		width => $w,
		height => $h,
		xcoords => [$w == 1 ? (0) : map { $_ / ($w-1) } 0..($w-1)],
		ycoords => [$h == 1 ? (0) : map { $_ / ($h-1) } 0..($h-1)],
		field => \@hf
	};
}

sub Heightfield_Ensure_Below($$$$)
{
	my ($x, $y, $forbid_start, $forbid_end) = @_;

	return 0 if @$x < 1;

	my $min = 0;

	if(!$forbid_start && !$forbid_end)
	{
		my $m = ($y->[-1] - $y->[0]) / ($x->[-1] - $x->[0]); # average slope
		my $t = $y->[0] - $m * $x->[0];
		for(1..(@$x-2))
		{
			my $estimated = $m * $x->[$_] + $t;
			my $real = $y->[$_];
			my $d = $real - $estimated;
			$min = $d if $d < $min;
		}
	}
	elsif(!$forbid_start)
	{
		# $min only applies to the START point...
		for(0..(@$x-2))
		{
			my $m = ($y->[$_] - $y->[-1]) / ($x->[$_] - $x->[-1]); # average slope
			my $t = $y->[$_] - $m * $x->[$_];
			my $estimated = $m * $x->[0] + $t;
			my $real = $y->[0];
			my $d = $estimated - $real;
			$min = $d if $d < $min;
		}
	}
	elsif(!$forbid_end)
	{
		# $min only applies to the END point...
		for(1..(@$x-1))
		{
			my $m = ($y->[$_] - $y->[0]) / ($x->[$_] - $x->[0]); # average slope
			my $t = $y->[$_] - $m * $x->[$_];
			my $estimated = $m * $x->[-1] + $t;
			my $real = $y->[-1];
			my $d = $estimated - $real;
			$min = $d if $d < $min;
		}
	}

	return $min;
}

### LODreduce test ### my $x = 0;
### LODreduce test ### my @x = sort map { rand() } 0..50;
### LODreduce test ### my @y = map { $x += rand() - 0.5 } @x;
### LODreduce test ### my @idx = (0, (grep { rand() < 0.2 } 1..(@x-2)), @x-1);
### LODreduce test ### my @lower = map { 0 } @idx;
### LODreduce test ### 
### LODreduce test ### {
### LODreduce test ### 	my @lx = @x[$idx[0]..$idx[1]];
### LODreduce test ### 	my @ly = @y[$idx[0]..$idx[1]];
### LODreduce test ### 	my $d = Heightfield_Ensure_Below(\@lx, \@ly, 1, 0);
### LODreduce test ### 	$lower[1] = MD3::min($lower[1], $d);
### LODreduce test ### }
### LODreduce test ### for(1..(@idx - 3))
### LODreduce test ### {
### LODreduce test ### 	my @lx = @x[$idx[$_]..$idx[$_+1]];
### LODreduce test ### 	my @ly = @y[$idx[$_]..$idx[$_+1]];
### LODreduce test ### 	my $d = Heightfield_Ensure_Below(\@lx, \@ly, 0, 0);
### LODreduce test ### 	$lower[$_] = MD3::min($lower[$_], $d);
### LODreduce test ### 	$lower[$_+1] = MD3::min($lower[$_+1], $d);
### LODreduce test ### }
### LODreduce test ### {
### LODreduce test ### 	my @lx = @x[$idx[-2]..$idx[-1]];
### LODreduce test ### 	my @ly = @y[$idx[-2]..$idx[-1]];
### LODreduce test ### 	my $d = Heightfield_Ensure_Below(\@lx, \@ly, 0, 1);
### LODreduce test ### 	$lower[-2] = MD3::min($lower[-2], $d);
### LODreduce test ### }
### LODreduce test ### 
### LODreduce test ### open my $fh, ">", "1.plot";
### LODreduce test ### for(0..@x-1)
### LODreduce test ### {
### LODreduce test ### 	print $fh "$x[$_] $y[$_]\n";
### LODreduce test ### }
### LODreduce test ### close $fh;
### LODreduce test ### open $fh, ">", "2.plot";
### LODreduce test ### for(0..@idx-1)
### LODreduce test ### {
### LODreduce test ### 	print $fh "$x[$idx[$_]] @{[$y[$idx[$_]] + $lower[$_]]}\n";
### LODreduce test ### }
### LODreduce test ### close $fh;
### LODreduce test ### 
### LODreduce test ### die 1;

sub Heightfield_Reduce($$$)
{
	my ($field, $w, $h) = @_;
	my $w0 = $field->{width};
	my $h0 = $field->{height};
	$w = $w0 if $w > $w0;
	$h = $h0 if $h > $h0;
	my @wl = Heightfield_Segmentize $w0, $w; 
	my @hl = Heightfield_Segmentize $h0, $h; 
	my $newfield = Heightfield_Generate
	{
		my ($x, $y) = @_;
		@{$field->{field}->[$hl[$y]]->[$wl[$x]]};
	}
	$w, $h;
	$newfield->{xcoords} = [map { $field->{xcoords}->[$wl[$_]] } 0..($w-1)];
	$newfield->{ycoords} = [map { $field->{ycoords}->[$hl[$_]] } 0..($h-1)]; # these may be uneven!

	# fix the borders
	my @top = map { 0 } @wl;
	for my $x(0..($w - 2))
	{
		my @in_z = map { $field->{field}->[0]->[$_]->[0] } $wl[$x]..$wl[$x + 1];
		my @in_x = map { $field->{xcoords}->[$_] } $wl[$x]..$wl[$x + 1];
		my $d = Heightfield_Ensure_Below \@in_x, \@in_z, $x == 0, $x == $w-2;
		$top[$x] = $d if $top[$x] > $d and $x != 0;
		$top[$x+1] = $d if $top[$x+1] > $d and $x != $w-2;
	}

	my @bottom = map { 0 } @wl;
	for my $x(0..($w - 2))
	{
		my @in_z = map { $field->{field}->[-1]->[$_]->[0] } $wl[$x]..$wl[$x + 1];
		my @in_x = map { $field->{xcoords}->[$_] } $wl[$x]..$wl[$x + 1];
		my $d = Heightfield_Ensure_Below \@in_x, \@in_z, $x == 0, $x == $w-2;
		$bottom[$x] = $d if $bottom[$x] > $d and $x != 0;
		$bottom[$x+1] = $d if $bottom[$x+1] > $d and $x != $w-2;
	}

	my @left = map { 0 } @hl;
	for my $y(0..($h - 2))
	{
		my @in_z = map { $field->{field}->[$_]->[0]->[0] } $hl[$y]..$hl[$y + 1];
		my @in_y = map { $field->{ycoords}->[$_] } $hl[$y]..$hl[$y + 1];
		my $d = Heightfield_Ensure_Below \@in_y, \@in_z, $y == 0, $y == $h-2;
		$left[$y] = $d if $left[$y] > $d and $y != 0;
		$left[$y+1] = $d if $left[$y+1] > $d and $y != $h-2;
	}

	my @right = map { 0 } @hl;
	for my $y(0..($h - 2))
	{
		my @in_z = map { $field->{field}->[$_]->[-1]->[0] } $hl[$y]..$hl[$y + 1];
		my @in_y = map { $field->{ycoords}->[$_] } $hl[$y]..$hl[$y + 1];
		my $d = Heightfield_Ensure_Below \@in_y, \@in_z, $y == 0, $y == $h-2;
		$right[$y] = $d if $right[$y] > $d and $y != 0;
		$right[$y+1] = $d if $right[$y+1] > $d and $y != $h-2;
	}

	use Data::Dumper;
	die Dumper [\@top, \@left, \@right, \@bottom]
		if $top[0]
		or $top[-1]
		or $left[0]
		or $left[-1]
		or $right[0]
		or $right[-1]
		or $bottom[0]
		or $bottom[-1];

	# apply the changes
	$newfield->{field}->[0]->[0]->[0] += MD3::min($left[0], $top[0]);
	$newfield->{field}->[0]->[$_]->[0] += $top[$_] for 1..($w - 2);
	$newfield->{field}->[0]->[-1]->[0] += MD3::min($right[0], $top[-1]);
	$newfield->{field}->[$_]->[-1]->[0] += $right[$_] for 1..($h - 2);
	$newfield->{field}->[-1]->[-1]->[0] += MD3::min($right[-1], $bottom[-1]);
	$newfield->{field}->[-1]->[$_]->[0] += $bottom[$_] for 1..($w - 2);
	$newfield->{field}->[-1]->[0]->[0] += MD3::min($left[-1], $bottom[0]);
	$newfield->{field}->[$_]->[0]->[0] += $left[$_] for 1..($h - 2);

	return $newfield;
}

sub Heightfield_ToMD3($$$)
{
	my ($hf, $tex, $offset) = @_;

	my @tex = split / /, $tex;

	my $md3 = MD3->new();

	my $Z = 0;
	for(@tex)
	{
		my $md3surf = $md3->AddSurface($_);
		my @vertexes;
		for my $i(0..$hf->{height}-1)
		{
			for my $j(0..$hf->{width}-1)
			{
				my ($z, $x, $y, $nx, $ny, $nz, $s, $t) = @{$hf->{field}->[$i]->[$j]};
				$vertexes[$i][$j] = $md3->AddVertex($md3surf, $x, $y, $z + $Z, $nx, $ny, $nz, $s, $t);
			}
		}

		for my $i(0..$hf->{height}-2)
		{
			for my $j(0..$hf->{width}-2)
			{
				my $a = $vertexes[$i][$j];
				my $b = $vertexes[$i+1][$j];
				my $c = $vertexes[$i][$j+1];
				my $d = $vertexes[$i+1][$j+1];
				$md3->AddTriangle($md3surf, $a, $b, $c);
				$md3->AddTriangle($md3surf, $b, $d, $c);
			}
		}
		$Z += $offset;
	}

	return $md3;
}



sub Heightmap_Load($$$$$)
{
	my ($filename, $mapwidth, $mapheight, $extrusion, $offset) = @_;
	my $img = Image::Magick->new();
	my $err = $img->Read($filename);
	die "read $filename: $err"
		if $err;
	return
	{
		img => $img,
		width => $img->Get("width"),
		height => $img->Get("height"),
		mapwidth => $mapwidth,
		mapheight => $mapheight,
		extrusion => $extrusion,
		offset => $offset
	}
}

sub Heightmap_Segment($$$)
{
	my ($hm, $rows, $cols) = @_;
	my $w = $hm->{width};
	my $h = $hm->{height};
	$hm->{segwidth} = int(($hm->{width} + $rows - 2) / $rows);
	$hm->{segheight} = int(($hm->{height} + $cols - 2) / $cols);
}

sub Heightmap_GetCoord($$$)
{
	my ($hm, $x, $y) = @_;

	return ()
		if $x < 0
		or $y < 0
		or $x > $hm->{width} - 1
		or $y > $hm->{height} - 1;

	my $s = $x / ($hm->{width} - 1);
	my $t = $y / ($hm->{height} - 1);

	my @pixel = $hm->{img}->GetPixels(x => $x, y => $hm->{height} - 1 - $y, width => 1, height => 1);

	return
	(
		$s * $hm->{mapwidth},
		$t * $hm->{mapheight},
		$pixel[0] / 65535.0 * $hm->{extrusion} + $hm->{offset}
	);
}

sub Heightmap_GetCoordNormal($$$)
{
	my ($hm, $x, $y) = @_;
	my @this = Heightmap_GetCoord($hm, $x, $y);
	my @up = Heightmap_GetCoord($hm, $x, $y+1);
	my @down = Heightmap_GetCoord($hm, $x, $y-1);
	my @left = Heightmap_GetCoord($hm, $x-1, $y);
	my @right = Heightmap_GetCoord($hm, $x+1, $y);

	@up = @this if @up == 0;
	@down = @this if @down == 0;
	@left = @this if @left == 0;
	@right = @this if @right == 0;

	my @gradient =
	(
		($right[2] - $left[2]) / ($right[0] - $left[0]), # diff by x
		($up[2] - $down[2]) / ($up[1] - $down[1]), # diff by y
		1
	);

	my $len = sqrt($gradient[0]*$gradient[0] + $gradient[1]*$gradient[1] + $gradient[2]*$gradient[2]);

	my @norm = 
	(
		-$gradient[0] / $len,
		-$gradient[1] / $len,
		+$gradient[2] / $len
	);

### 	# ATTEMPT: instead use the triangle normal...
### 	@norm =
### 	(
### 		($up[1] - $this[1]) * ($left[2] - $this[2]) - ($up[2] - $this[2]) * ($left[1] - $this[1]),
### 		($up[2] - $this[2]) * ($left[0] - $this[0]) - ($up[0] - $this[0]) * ($left[2] - $this[2]),
### 		($up[0] - $this[0]) * ($left[1] - $this[1]) - ($up[1] - $this[1]) * ($left[0] - $this[0])
### 	);
### 	my $len = sqrt($norm[0]*$norm[0] + $norm[1]*$norm[1] + $norm[2]*$norm[2]) || 1;
### 	@norm = 
### 	(
### 		$norm[0] / $len,
### 		$norm[1] / $len,
### 		$norm[2] / $len
### 	);
### #	printf "%.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f --> %.3f,%.3f,%.3f\n", @up, @down, @left, @right, @norm;
### #	printf "%.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f --> %.3f,%.3f,%.3f\n", @up, @down, @left, TriangleNorm @up, @down, @left;
### #	printf "%.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f --> %.3f,%.3f,%.3f\n", @down, @left, @right, TriangleNorm @down, @left, @right;
### #	printf "%.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f --> %.3f,%.3f,%.3f\n", @left, @right, @up, TriangleNorm @left, @right, @up;
### #	printf "%.1f,%.1f,%.1f / %.1f,%.1f,%.1f / %.1f,%.1f,%.1f --> %.3f,%.3f,%.3f\n", @right, @up, @down, TriangleNorm @right, @up, @down;
	
	return @this, @norm;
}

sub Heightfield_Generate(&$$);
sub Heightmap_MakeSegmentField($$$)
{
	my ($hm, $segx, $segy) = @_;

	my $xmin = $hm->{segwidth} * $segx;
	my $xmax = MD3::min($hm->{width} - 2, $hm->{segwidth} * ($segx + 1) - 1) + 1;
	my $ymin = $hm->{segheight} * $segy;
	my $ymax = MD3::min($hm->{height} - 2, $hm->{segheight} * ($segy + 1) - 1) + 1;

	my $hf = Heightfield_Generate
	{
		my ($x, $y) = @_;
		my @xyznorm = Heightmap_GetCoordNormal($hm, $x + $xmin, $y + $ymin);
		my $s = ($x + $xmin) / ($hm->{width} - 1);
		my $t = ($y + $ymin) / ($hm->{height} - 1);
		$xyznorm[2], $xyznorm[0], $xyznorm[1], @xyznorm[3..5], $s, $t; # storing z first for the interpolation
	}
	($xmax - $xmin + 1), ($ymax - $ymin + 1);

	$hf->{xcoords} = [map { $hf->{field}->[0]->[$_]->[1] } 0..($hf->{width}-1)];
	$hf->{ycoords} = [map { $hf->{field}->[$_]->[0]->[2] } 0..($hf->{height}-1)];

	$hf;
}

sub BrushRectangle($@@)
{
	my ($shader, $x0, $y0, $z0, $x1, $y1, $z1) = @_;
	return <<EOF;
{
brushDef
{
( $x1 $y1 $z1 ) ( $x1 $y0 $z1 ) ( $x0 $y1 $z1 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
( $x1 $y1 $z1 ) ( $x0 $y1 $z1 ) ( $x1 $y1 $z0 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
( $x1 $y1 $z1 ) ( $x1 $y1 $z0 ) ( $x1 $y0 $z1 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
( $x0 $y0 $z0 ) ( $x1 $y0 $z0 ) ( $x0 $y1 $z0 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
( $x0 $y0 $z0 ) ( $x0 $y0 $z1 ) ( $x1 $y0 $z0 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
( $x0 $y0 $z0 ) ( $x0 $y1 $z0 ) ( $x0 $y0 $z1 ) ( ( 0.03125 0 -0 ) ( -0 0.03125 0 ) ) $shader 0 0 0
}
}
EOF
}

sub BrushBox($@@$)
{
	my ($shader, $x0, $y0, $z0, $x1, $y1, $z1, $d) = @_;
	my $s = "";
	$s .= BrushRectangle $shader => ($x0 - $d, $y0, $z0) => ($x0, $y1, $z1);
	$s .= BrushRectangle $shader => ($x1, $y0, $z0) => ($x1 + $d, $y1, $z1);
	$s .= BrushRectangle $shader => ($x0, $y0 - $d, $z0) => ($x1, $y0, $z1);
	$s .= BrushRectangle $shader => ($x0, $y1, $z0) => ($x1, $y1 + $d, $z1);
	$s .= BrushRectangle $shader => ($x0, $y0, $z0 - $d) => ($x1, $y1, $z0);
	$s .= BrushRectangle $shader => ($x0, $y0, $z1) => ($x1, $y1, $z1 + $d);
	return $s;
}

my %params = Params::get(qw/-i -o -t -T -s -d -x -X -y -Y -z -Z -h -H -m -n -l -L -c/);

print <<EOF;
{
"classname" "worldspawn"
EOF

{
	# the box of sky around it
	print BrushBox $params{-s}, @params{qw/-x -y -z/}, @params{qw/-X -Y -Z/}, $params{-d};
}

print <<EOF;
}
EOF

my $hm = Heightmap_Load $params{-i}, $params{-X} - $params{-x}, $params{-Y} - $params{-y}, $params{-H} - $params{-h}, $params{-h};
my $n = $params{-n};
my $m = $params{-m};
my $mprefix = $params{-o};
Heightmap_Segment $hm, $n, $n;
print STDERR "Building heightfield files...\n";
for my $x(0..$m-1)
{
	for my $y(0..$n-1)
	{
		printf STDERR "At %f%%\n", ($x * $n + $y) / ($m * $n) * 100;
		my ($lod0) = Heightmap_MakeSegmentField $hm, $x, $y;
		my ($lod1) = Heightfield_Reduce $lod0, int($lod0->{width} / $params{-l} + 0.5), int($lod0->{height} / $params{-l} + 0.5);
		my ($lod2) = Heightfield_Reduce $lod1, int($lod1->{width} / $params{-L} + 0.5), int($lod1->{height} / $params{-L} + 0.5);
		my ($lodC) = Heightfield_Reduce $lod0, int($lod0->{width} / $params{-c} + 0.5), int($lod0->{height} / $params{-c} + 0.5);

		my $md3_clip = Heightfield_ToMD3 $lodC, "textures/common/caulk", 0;
		my $md3_lod0 = Heightfield_ToMD3 $lod0, $params{-t}, $params{-T};
		my $md3_lod1 = Heightfield_ToMD3 $lod1, $params{-t}, $params{-T};
		my $md3_lod2 = Heightfield_ToMD3 $lod2, $params{-t}, $params{-T};

		my (@offset) = $md3_clip->ModelOffset();
		$md3_clip->ApplyInverseOffset(@offset);
		$md3_lod0->ApplyInverseOffset(@offset);
		$md3_lod1->ApplyInverseOffset(@offset);
		$md3_lod2->ApplyInverseOffset(@offset);

		my $scaleC = $md3_clip->ModelScale();
		my $scale0 = $md3_lod0->ModelScale();
		my $scale1 = $md3_lod1->ModelScale();
		my $scale2 = $md3_lod2->ModelScale();
		my $scale = MD3::max(MD3::max(MD3::max($scaleC, $scale0), $scale1), $scale2);
		$md3_clip->ApplyInverseScale($scale);
		$md3_lod0->ApplyInverseScale($scale);
		$md3_lod1->ApplyInverseScale($scale);
		$md3_lod2->ApplyInverseScale($scale);

		open my $fh, ">", "$mprefix$x\_$y\_clip.md3";
		print $fh $md3_clip->Write();
		close $fh;
		open $fh, ">", "$mprefix$x\_$y\_lod0.md3";
		print $fh $md3_lod0->Write();
		close $fh;
		open $fh, ">", "$mprefix$x\_$y\_lod1.md3";
		print $fh $md3_lod1->Write();
		close $fh;
		open $fh, ">", "$mprefix$x\_$y\_lod2.md3";
		print $fh $md3_lod2->Write();
		close $fh;

		print <<EOF;
// collision model
{
"classname" "misc_model"
"origin" "@offset"
"modelscale" "$scale"
"model" "$mprefix$x\_$y\_clip.md3"
"spawnflags" "2"
}
// visible model
{
"classname" "misc_gamemodel"
"origin" "@offset"
"modelscale" "$scale"
"model" "$mprefix$x\_$y\_lod0.md3"
"lodmodel1" "$mprefix$x\_$y\_lod1.md3"
"lodmodel2" "$mprefix$x\_$y\_lod2.md3"
}

EOF
	}
}
