unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ExtDlgs, ExtCtrls, StdCtrls;

type
  TMainFrm = class(TForm)
    MainMenu1: TMainMenu;
    Plik1: TMenuItem;
    Nowy1: TMenuItem;
    Otwrz1: TMenuItem;
    Zapisz1: TMenuItem;
    Zapiszjako1: TMenuItem;
    N1: TMenuItem;
    Zakocz1: TMenuItem;
    ImageOpen: TOpenPictureDialog;
    EnableGraphView: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    ZoomEdt: TEdit;
    Label2: TLabel;
    HeightEdt: TEdit;
    Obraz1: TMenuItem;
    Opcje1: TMenuItem;
    ScrollBox1: TScrollBox;
    ImageView: TImage;
    Kolorymapy1: TMenuItem;
    Widok3D1: TMenuItem;
    procedure Zakocz1Click(Sender: TObject);
    procedure Otwrz1Click(Sender: TObject);
    procedure Widokwykresowy1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure RefreshView;
    procedure ZoomEdtExit(Sender: TObject);
    procedure ZoomEdtKeyPress(Sender: TObject; var Key: Char);
    procedure ImageViewMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Opcje1Click(Sender: TObject);
    procedure ImageViewMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageViewMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EnableGraphViewClick(Sender: TObject);
    procedure Kolorymapy1Click(Sender: TObject);
    procedure Widok3D1Click(Sender: TObject);
    procedure LoadRelief(const filename:string);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


type
 TTerrainRelief=array of array of byte;
 TPointsArray=array of TPoint;
 TColorsArray=array of TColor;
 TTerrainColors=array[-255..255] of TColor;

procedure Gradient(const cl1, cl2:TColor; const len:word; var arr:TColorsArray);

var
  MainFrm: TMainFrm;
  Relief: TTerrainRelief;
  ReliefWidth, ReliefHeight: word;
  ViewScale:single=2;
  ReliefFactor, WaterLevel: single;
  ReliefFactorU :string;
  lx, ly:word;
  linesx, linesy:word;
  TerrainColors: TTerrainColors;

implementation

uses GraphForm, Math, OptionsForm, ColorsForm, View3DForm;

var timg:TBitmap;

function GetParam(n:string; default:string=''):string;
var i:integer;
begin
 Result := default;
 for i := 1 to ParamCount do begin
  if ParamStr(i)=n then begin
   Result := ParamStr(i+1);
   break;
  end;
 end;
end;

{$R *.dfm}

type TRGBValues=record
 //reserved1, blue, green, red: byte;
 red, green, blue, reserved:byte;
end;

function GetRedValue(c:TColor):byte;
begin
 Result := TRgbValues(ColorToRgb(c)).red;
end;

procedure LineToPoints(const StartP, EndP:TPoint; var arr:TPointsArray);
var DiffX, DiffY:integer; stos:single; i:word; ta:TPointsArray; znx, zny:Smallint;
begin
 DiffX := EndP.X-StartP.X;
 DiffY := EndP.Y-StartP.Y;
 if DiffX<0 then znx := -1 else znx := 1;
 if DiffY<0 then zny := -1 else zny := 1;
 i := 0;
 if abs(DiffX)>=abs(DiffY) then begin
  stos := abs(DiffY/DiffX);
  while i<=abs(DiffX) do begin
   SetLength(ta, Length(ta)+1);
   ta[Length(ta)-1] := Point(StartP.X+(i*znx), Round(StartP.Y+(i*stos*zny)));
   Inc(i);
  end;
 end else begin
  stos := abs(DiffX/DiffY);
  while i<=abs(DiffY) do begin
   SetLength(ta, Length(ta)+1);
   ta[Length(ta)-1] := Point(Round(StartP.X+(i*stos*znx)), StartP.Y+(i*zny));
   Inc(i);
  end;
 end;
 arr := ta;
end;


procedure Gradient(const cl1, cl2:TColor; const len:word; var arr:TColorsArray);
var dr, dg, db, i: integer; sr, sb, sg, rr, rg, rb:single; r1,r2,g1,g2,b1,b2:integer;
begin
 r1 := GetRValue(cl1);
 g1 := GetGValue(cl1);
 b1 := GetBValue(cl1);
 r2 := GetRValue(cl2);
 g2 := GetGValue(cl2);
 b2 := GetBValue(cl2);

 dr := r2-r1;
 dg := g2-g1;
 db := b2-b1;
 if dr<>0 then sr := dr/len else sr := 0;
 if dg<>0 then sg := dg/len else sg := 0;
 if db<>0 then sb := db/len else sb := 0;

 rr := r1;
 rg := g1;
 rb := b1;
 SetLength(arr, len);
 for i := 0 to len-1 do begin
  arr[i] := rgb(Round(rr), Round(rg), Round(rb));
  {if ((sr>0)and(rr<r2)) or ((sr<0)and(rr>r2)) then} rr := rr+sr;
  {if ((sg>0)and(rg<r2)) or ((sg<0)and(rg>g2)) then} rg := rg+sg;
  {if ((sb>0)and(rb<r2)) or ((sb<0)and(rb>b2)) then} rb := rb+sb;
 end;
end;


procedure TMainFrm.RefreshView;
var i,j:word; v:byte; c:TColor; tempimg:TBitmap;
 waterf:byte; //starttime:cardinal;
begin
// starttime := GetTickCount;
 tempimg := TBitmap.Create;
 tempimg.Width := ReliefWidth;
 tempimg.Height := ReliefHeight;
 ImageView.Picture.Bitmap.Width := Ceil(ReliefWidth*ViewScale);
 ImageView.Picture.Bitmap.Height := Ceil(ReliefHeight*ViewScale);
 waterf := Round(WaterLevel/ReliefFactor);
 for i := 0 to ReliefHeight-1 do for j := 0 to ReliefWidth-1 do begin
  v := Relief[i][j];
  if v<waterf then c := TerrainColors[v-waterf] else begin
{   notv := not v;}
//   c := rgb(notv, (notv div 3)shl 1, notv shr 2);
   c := TerrainColors[v];
  end;
  tempimg.Canvas.Pixels[j,i] := c;
 end;
 with ImageView.Picture do
  Bitmap.Canvas.CopyRect(Rect(0,0,Bitmap.Width,Bitmap.Height),
   tempimg.Canvas, Rect(0,0,ReliefWidth, ReliefHeight));

 if GetParam('/o')<>'' then begin
  tempimg.PixelFormat := pf24bit;
  tempimg.SaveToFile(GetParam('/o'));
 end;
 tempimg.free;
{ Gradient(rgb(20,20,30), rgb(0,0,255), 256, gd);
 for i := 0 to 199 do begin
  ImageView.Picture.Bitmap.Canvas.Pen.Color := gd[i];
  ImageView.Picture.Bitmap.Canvas.MoveTo(i,0);
  ImageView.Picture.Bitmap.Canvas.LineTo(i, 50);
 end;}
 //ShowMessage('Wygenerowano w '+IntToStr(GetTickCount-starttime)+'ms.');
end;

procedure TMainFrm.Zakocz1Click(Sender: TObject);
begin
 Application.Terminate;
end;

procedure TMainFrm.LoadRelief(const filename:string);
var i,j:word;
begin
 timg.LoadFromFile(FileName);
 ReliefHeight := timg.height;
 ReliefWidth := timg.Width;
 SetLength(Relief, ReliefHeight);
 for i := 0 to timg.Height-1 do begin
  SetLength(Relief[i], ReliefWidth);
  for j := 0 to timg.Width-1 do
   Relief[i][j] := not GetRedValue(timg.Canvas.Pixels[j,i]);
 end;
end;

procedure TMainFrm.Otwrz1Click(Sender: TObject);
var i,j:word;
begin
 if ImageOpen.Execute then begin
  LoadRelief(ImageOpen.FileName);
  RefreshView;
  View3dFrm.Render;
 end;
end;

procedure TMainFrm.Widokwykresowy1Click(Sender: TObject);
var linenum,i:word; v:byte;
begin
 RefreshView;
 GraphFrm.Show;
 GraphFrm.GraphImg.Picture.Bitmap.Width := 483;
 GraphFrm.GraphImg.Picture.Bitmap.Height := 256;
 linenum := StrToInt(InputBox('','Podaj liniê','100')) ;
 ImageView.Picture.Bitmap.Canvas.Pen.Color := clRed;
 ImageView.Picture.Bitmap.Canvas.MoveTo(0, linenum);
 ImageView.Picture.Bitmap.Canvas.LineTo(160, linenum);
 for i := 0 to 160 do begin
  v := Relief[linenum][i];
  GraphFrm.GraphImg.Picture.Bitmap.Canvas.LineTo(i*3, not v);
 // GraphFrm.GraphImg.Picture.Bitmap.Canvas.Pixels[i*2, v] := clBlack;
 end;
end;

procedure TMainFrm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 timg.Free;
end;

procedure LoadColors(fn:string);
var f:file of TTerrainColors;
begin
 AssignFile(f,fn);
 Reset(f);
 Read(f,TerrainColors);
 Close(f);
end;

procedure TMainFrm.FormCreate(Sender: TObject);
var i:byte; gc:TColorsArray;
begin
 timg := TBitmap.Create;
 ReliefFactor := 0.25;
 ReliefFactorU := '1,0';
 WaterLevel := 20;
 SetLength(Relief,0);
 Gradient(rgb(0,0,255), rgb(20,20,30), 256, gc);
 for i := 0 to 255 do TerrainColors[-i] := gc[i];
 SetLength(gc, 0);
// Gradient(rgb(250,200,50), rgb(60,30,30), 256, gc);
 Gradient(rgb(60,30,30), rgb(250,200,50), 256, gc);
 for i := 0 to 255 do TerrainColors[i] := gc[i];
 if GetParam('/i')<>'' then begin
  LoadRelief(GetParam('/i'));
  if GetParam('/c')<>'' then LoadColors(GetParam('/c'));
  RefreshView;
  Application.Terminate;
 end;
end;

procedure TMainFrm.ZoomEdtExit(Sender: TObject);
begin
 ViewScale := StrToFloatDef(ZoomEdt.Text, 2);
 RefreshView;
end;

procedure TMainFrm.ZoomEdtKeyPress(Sender: TObject; var Key: Char);
begin
 if Key=#13 then ZoomEdtExit(Sender);
end;

procedure TMainFrm.ImageViewMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var level:byte;
begin
 lx := Round(X/ViewScale);
 ly := Round(Y/ViewScale);
 if (lx>=ReliefWidth) or (ly>=ReliefHeight) then begin
  HeightEdt.Text := '---';
  lx := 0;
  ly := 0;
  exit;
 end;
 level := Relief[ly][lx];
 HeightEdt.Text := FloatToStrF((level*ReliefFactor)-WaterLevel, ffGeneral,4,4);
end;

procedure TMainFrm.Opcje1Click(Sender: TObject);
begin
 OptionsFrm.FactorEdt.Text := ReliefFactorU;
 OptionsFrm.WaterEdt.Text := FloatToStr(WaterLevel);
 if OptionsFrm.ShowModal=mrOk then begin
  ReliefFactorU := OptionsFrm.FactorEdt.Text;
  WaterLevel := StrToFloat(OptionsFrm.WaterEdt.Text);
  ReliefFactor := StrToFloat(ReliefFactorU)/4;
 end;
 RefreshView;
end;

procedure TMainFrm.ImageViewMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
 if EnableGraphView.Checked then begin
  linesx := lx;
  linesy := ly;
 end;
end;

procedure TMainFrm.ImageViewMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var vpoints:TPointsArray; i:word; v:byte; sx, sy:single; ap:TPointsArray;
begin
 if ((lx=linesx) and (ly=linesy)) or (not EnableGraphView.Checked) then exit;
 LineToPoints(Point(linesx, linesy), Point(lx, ly), vpoints);
 RefreshView;
 GraphFrm.Show;
 GraphFrm.GraphImg.Picture.Bitmap.Width := GraphFrm.GraphImg.Width;
 GraphFrm.GraphImg.Picture.Bitmap.Height := GraphFrm.GraphImg.Height;
 sx := GraphFrm.GraphImg.Width/Length(vpoints);
 sy := GraphFrm.GraphImg.Height/256;
// linenum := ly;
 with ImageView.Picture.Bitmap.Canvas do begin
  Brush.Color := clRed;
  for i := 0 to Length(vpoints)-1 do begin
   FrameRect(Rect(Round(vpoints[i].X*ViewScale), Round(vpoints[i].Y*ViewScale),
    Round((vpoints[i].X+1)*ViewScale), Round((vpoints[i].Y+1)*ViewScale)));
  end;
 end;
 with GraphFrm.GraphImg.Picture.Bitmap do begin
  Canvas.Brush.Color := clWhite;
  Canvas.FillRect(Canvas.ClipRect);
  Canvas.Brush.Color := RGB(0,0,255);
  Canvas.FillRect(Rect(0, Height-Round((WaterLevel/ReliefFactor)*sy), Width, Height));
  SetLength(ap, Length(vpoints)+4);
  ap[0] := Point(-1, Round((not (Relief[vpoints[0].Y][vpoints[0].X]))*sy));
  for i := 0 to Length(vpoints)-1 do begin
   v := Relief[vpoints[i].Y][vpoints[i].X];
 //  if v=0 then raise Exception.Create('v=0');
   ap[i+1] := Point(Round(i*sx), Round((not v)*sy));
  end;
  ap[Length(vpoints)+1] := Point(Width+1, Round((not v)*sy));
  ap[Length(vpoints)+2] := Point(Width, Height);
  ap[Length(vpoints)+3] := Point(-1, Height);
  Canvas.Brush.Color := rgb(200, 150, 10);
  Canvas.Polygon(ap);
 end;
end;

procedure TMainFrm.EnableGraphViewClick(Sender: TObject);
begin
 EnableGraphView.Checked := not EnableGraphView.Checked;
end;

procedure TMainFrm.Kolorymapy1Click(Sender: TObject);
begin
 ColorsFrm.Show;
end;

procedure TMainFrm.Widok3D1Click(Sender: TObject);
begin
 View3DFrm.Show;
end;

end.
