unit heights_map;

interface

uses SysUtils, constants, OpenGL, graphics, textures, records, variables;

type
  RHMPoint = record
    x, y, z : single;
    color, day_color, night_color : RColor;
    fog_a : single;
    renderable : boolean;
    texture : integer;
    modified : boolean;
    speed : single;
    id : integer;
  end;

  THeightsMap = class
    width, height : integer;
    sx, sy, sz : single;
    map : array[1..max_heights_map_width, 1..max_heights_map_height] of RHMPoint;
    texture : TTexture;
    schematic_colors : boolean;
  public
    function FindCellById(id : integer) : RPoint;
    procedure CreateVertex(i1, i2 : integer);
    procedure CreatePolygon(i1, i2, quarter : integer);
    procedure LoadFromTextFile(file_name : string);
    procedure LoadFromImageFile(file_name, colors_file_name, texture_file_name : string);
    procedure Rebuild;
    procedure Redraw;
    procedure CheckVisible(wx, wy, r : integer);
    procedure CopyVisible(hm : THeightsMap);
  end;

implementation

function THeightsMap.FindCellById(id : integer) : RPoint;
var
i1, i2 : integer;
begin
result.x := 0;
result.y := 0;
for i1 := 1 to width do
  for i2 := 1 to height do
    if map[i1, i2].id = id then
      begin result.x := i1; result.y := i2; exit; end;
end;  

procedure THeightsMap.CreateVertex(i1, i2 : integer);
begin
with map[i1, i2] do
  begin
    fog_a := sqr(fog_destination_density * (y - eye_pos_y) +
                 fog_height_density * abs(eye_pos_z - z));
    if color.a - fog_a > -1 then
      begin
        with color do glColor4f(r, g, b, a - fog_a);
        glVertex3f(x, y, z);
      end;
  end;
end;

procedure THeightsMap.CreatePolygon(i1, i2, quarter : integer);
begin
if (i1 < 2)or(i1 > width-1)or(i2 < 2)or(i2 > height-1) then exit;
if not map[i1, i2].renderable then exit;

//glLoadName(map[i1, i2].id);
triangles_rendered := triangles_rendered + 2;
case quarter of
1 : begin
      glBegin(GL_TRIANGLES);
      glTexCoord2f(1, 1); CreateVertex(i1 + 1, i2);
      glTexCoord2f(0, 1); CreateVertex(i1, i2);
      glTexCoord2f(0, 0); CreateVertex(i1, i2 + 1);
      glEnd;

      glBegin(GL_TRIANGLES);
      glTexCoord2f(1, 1); CreateVertex(i1 + 1, i2);
      glTexCoord2f(1, 0); CreateVertex(i1 + 1, i2 + 1);
      glTexCoord2f(0, 0); CreateVertex(i1, i2 + 1);
      glEnd;         
    end;
2 : begin
      glBegin(GL_TRIANGLES);
      glTexCoord2f(1, 1); CreateVertex(i1, i2);
      glTexCoord2f(0, 1); CreateVertex(i1 - 1, i2);
      glTexCoord2f(0, 0); CreateVertex(i1 - 1, i2 + 1);
      glEnd;

      glBegin(GL_TRIANGLES);
      glTexCoord2f(1, 1); CreateVertex(i1, i2);
      glTexCoord2f(1, 0); CreateVertex(i1, i2 + 1);
      glTexCoord2f(0, 0); CreateVertex(i1 - 1, i2 + 1);
      glEnd;
    end;
3 : begin
      glBegin(GL_TRIANGLES);
      glTexCoord2f(0, 0); CreateVertex(i1 - 1, i2);
      glTexCoord2f(1, 0); CreateVertex(i1, i2);
      glTexCoord2f(1, 1); CreateVertex(i1, i2 - 1);
      glEnd;

      glBegin(GL_TRIANGLES);
      glTexCoord2f(0, 0); CreateVertex(i1 - 1, i2);
      glTexCoord2f(0, 1); CreateVertex(i1 - 1, i2 - 1);
      glTexCoord2f(1, 1); CreateVertex(i1, i2 - 1);
      glEnd;
    end;
4 : begin
      glBegin(GL_TRIANGLES);
      glTexCoord2f(0, 0); CreateVertex(i1, i2);
      glTexCoord2f(0, 1); CreateVertex(i1, i2 - 1);
      glTexCoord2f(1, 1); CreateVertex(i1 + 1, i2 - 1);
      glEnd;

      glBegin(GL_TRIANGLES);
      glTexCoord2f(0, 0); CreateVertex(i1, i2);
      glTexCoord2f(1, 0); CreateVertex(i1 + 1, i2);
      glTexCoord2f(1, 1); CreateVertex(i1 + 1, i2 - 1);
      glEnd;
    end;
end;

glEnd;
triangles_rendered := triangles_rendered + 2;
end;

procedure THeightsMap.LoadFromTextFile(file_name : string);
var
f : textfile;
s : string;
i1, i2 : integer;
begin
if not fileexists(file_name) then exit;
i1 := 0; i2 := 1;
assignfile(f, file_name);
reset(f);
readln(f, width);
readln(f, height);
readln(f, sx);
readln(f, sy);
readln(f, sz);
while not eof(f) do
  begin
    readln(f, s);
    i1 := i1 + 1;
    if i1 > width then begin i1 := 1; i2 := i2 + 1; end;
    if i1 < 1 then i1 := 1; if i2 < 1 then i2 := 1;
    if i1 > max_heights_map_width then i1 := max_heights_map_width;
    if i2 > max_heights_map_width then i2 := max_heights_map_width;
    with map[i1, i2] do
      begin
        x := i1*sx;
        y := i2*sy;
        z := strtofloat(s)*sz;
      end;
  end;
closefile(f);
end;

procedure THeightsMap.LoadFromImageFile(file_name, colors_file_name, texture_file_name : string);
var
b : tbitmap;
i1, i2, n, id : integer;
min_z, max_z, color_scale : single;
begin
min_z := 0;
max_z := 0;
id := 0;
b := tbitmap.create;
b.LoadFromFile(file_name);
width := b.width;
height := b.height;
if width < 1 then width := 1; if height < 1 then height := 1;
if width > max_heights_map_width then width := max_heights_map_width;
if height > max_heights_map_width then height := max_heights_map_width;
for i1 := 1 to width do
  for i2 := 1 to height do
    begin
      map[i1, i2].x := i1*sx;
      map[i1, i2].y := i2*sy;
      map[i1, i2].z := b.canvas.pixels[i1 - 1, height - i2 + 1]*sz;
      if map[i1, i2].z < min_z then min_z := map[i1, i2].z;
      if map[i1, i2].z > max_z then max_z := map[i1, i2].z;
      id := id + 1;
      map[i1, i2].id := id;
      map[i1, i2].renderable := true;
    end;

b.LoadFromFile(colors_file_name);
b.width := 1;
color_scale := b.height / (max_z - min_z);

for i1 := 1 to width do
  for i2 := 1 to height do
    with map[i1, i2] do
      begin
        n := trunc(map[i1, i2].z*color_scale);
        color.r := byte(b.canvas.pixels[0, b.height - n]) / 255;
        color.g := byte(b.canvas.pixels[0, b.height - n] shr 8) / 255;
        color.b := byte(b.canvas.pixels[0, b.height - n] shr 16) / 255;
        color.a := 1;
        day_color := color;
        night_color := color;
        with night_color do
          begin r := r - 0.2; g := g - 0.2; a := a - 0.1; end;
      end;

b.free;

Texture := TTexture.Create(texture_file_name);
end;

procedure THeightsMap.Rebuild;
var
i1, i2 : integer;
begin
for i1 := eye_map_x to eye_map_x + visible_radius_x do
  for i2 := eye_map_y - 1 to eye_map_y + visible_radius_y do
    CreatePolygon(i1, i2, 1);

for i1 := eye_map_x downto eye_map_x - visible_radius_x do
  for i2 := eye_map_y - 1 to eye_map_y + visible_radius_y do
    CreatePolygon(i1, i2, 2);

{for i1 := hm_map_x downto 3 do
  for i2 := hm_map_y downto 3 do
    CreatePolygon(i1, i2, 3);

for i1 := hm_map_x to width-2 do
  for i2 := hm_map_y downto 3 do
    CreatePolygon(i1, i2, 4);     }
end;

procedure THeightsMap.Redraw;
begin
Texture.Enable;
Rebuild;
end;

procedure THeightsMap.CheckVisible(wx, wy, r : integer);
var
i1, i2 : integer;
begin
for i1 := 1 to width do
  for i2 := 1 to height do
    if (i1 < wx + r)and(i1 > wx - r)and
       (i2 < wy + r)and(i2 > wy - 2) then  
         map[i1, i2].renderable := true
    else if (i2 mod 2 = 0) then map[i1, i2].renderable := false;
end;

procedure THeightsMap.CopyVisible(hm : THeightsMap);
var
i1, i2 : integer;
begin      
for i1 := 1 to width do
  for i2 := 1 to height do
    with map[i1, i2] do
      begin
        renderable := hm.map[i1, i2].renderable;
      end;
end;

end.
 