unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OmegaTimer, OmegaFont, OmegaInput, OmegaImageList, OmegaScreen,
  OmegaSprite, ExtCtrls, OmegaSurface, OmegaPrimitives;

type
  PPunkt=^TPunkt;
  TPunkt=class
    fOmegaPrimitives:TOmegaPrimitives;
    fOmegaScreen:TOmegaScreen;
    fX,             //współrzędna X
    fY     :single; //współrzędna Y
    fZ     :integer;//współrzędna Z
    fH     :single;//poziom wysokości
    fRed,
    fGreen,
    fBlue  :integer;
  protected
    property X:single  read fX write fX;
    property Y:single  read fY write fY;
    property Z:integer read fZ write fZ;
    property H:single read fH write fH;
    property Red   :integer read fRed   write fRed;
    property Green :integer read fGreen write fGreen;
    property Blue  :integer read fBlue  write fBlue;
  public
    procedure Draw(const Xk,Yk,XKPion,YKPion:single);
    constructor Create(const AX,AY:single;const AZ:integer;
                       const AR,AG,AB:integer;
                       const AOmegaScreen:TOmegaScreen);
  end;


  TForm1 = class(TForm)
    OmegaScreen1: TOmegaScreen;
    OmegaImageList1: TOmegaImageList;
    OmegaInput1: TOmegaInput;
    OmegaFont1: TOmegaFont;
    OmegaTimer1: TOmegaTimer;
    OmegaSprite1: TOmegaSprite;
    procedure OmegaTimer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
                          Shift: TShiftState);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

procedure TworzPunkty(const RogX,RogY:integer);//tworzy punkty siatki mapy
procedure PokazPunkty;//pokazuje punkty siatki mapy




var

  idAktywny:integer=-1;
  Form1: TForm1;

  Lista:TList;
  fPunkty:boolean=true;
  fLinie :boolean=true;
const

  RozmiarKfla:TPoint=(x:64;y:48);
  SiatkaMapy :TPoint=(x:14;y:14);
  pedzel0:array[0..11,0..1]of integer=((0,0),(1,0),(1,1),(0,1),
                                        (0,-1),(1,-1),(2,0),(2,1),(1,2),(0,2),(-1,1),(-1,0));

implementation

{$R *.DFM}
procedure szczyt(const n:integer;const h:single);
var
 wiersz,kol,i,j:integer;
begin
 if n=0 then exit;
 wiersz:=n div SiatkaMapy.x;
 kol:=n-wiersz*siatkaMapy.x;
 for i:=0 to high(pedzel0) do
     if kol+pedzel0[i,0]<SiatkaMapy.x then
     begin
       j:=kol+pedzel0[i,0]+(wiersz+pedzel0[i,1])*siatkaMapy.x;
       if (j>-1)and(j<Lista.Count)then
       begin
         if i<4 then PPunkt(Lista.items[j])^.fh:=PPunkt(Lista.items[j])^.fh+h
         else PPunkt(Lista.items[j])^.fh:=PPunkt(Lista.items[j])^.fh+h/2;
       end;
     end;
end;

procedure TPunkt.Draw(const Xk,Yk,XKPion,YKPion:single);
begin
 //rysuj linie
 if fLinie then begin
    //poziomy
    fOmegaPrimitives.Line(fx,fy+fh,xk,yk,OmegaColor(125,125,125));
    //piony
    fOmegaPrimitives.Line(fx,fy+fh,xkPion,ykpion,OmegaColor(125,125,125));
 end;
 //rysuj punkty
 if fPunkty then
 fOmegaScreen.SetPixel(Round(fX),Round(fY+fh),fRed,fGreen,fBlue,0);

end;
constructor TPunkt.Create(const AX,AY:single;const AZ:integer;
                          const AR,AG,AB:integer;
                          const AOmegaScreen:TOmegaScreen);
begin
  fX:=AX;
  fY:=AY;
  fZ:=AZ;
  fH:=0;
  fRed  :=AR;
  fGreen:=AG;
  fBlue :=AB;
  fOmegaScreen:=AOmegaScreen;
  fOmegaPrimitives:=TOmegaPrimitives.Create(AOmegaScreen);
  fOmegaPrimitives.OmegaScreen:=AOmegaScreen;

end;
procedure TworzPunkty(const RogX,RogY:integer);
var
 w,k:integer;
 APunkt:PPunkt;
begin
 for w:=0 to SiatkaMapy.y-1 do
  for k:=0 to SiatkaMapy.x-1 do begin
      New(APunkt);
      APunkt^:=TPunkt.Create(RogX+k*RozmiarKfla.x,RogY+w*RozmiarKfla.y,0,0,255,0,Form1.OmegaScreen1);
      Lista.Add(APunkt);
  end;
end;

procedure PokazPunkty;
var
  i:integer;
  xk,yk,XKPion,YKPion:single;
begin
  for i:=1 to Lista.Count-1 do
  begin
    if i mod SiatkaMapy.x<>0 then begin
    xk:=PPunkt(Lista.Items[i-1])^.x;
    yk:=PPunkt(Lista.Items[i-1])^.y+PPunkt(Lista.Items[i-1])^.fh;
    end else begin
        xk:=PPunkt(Lista.Items[i])^.x;
        yk:=PPunkt(Lista.Items[i])^.y+PPunkt(Lista.Items[i])^.fh;
    end;
    if i> SiatkaMapy.x then begin
     xkpion:=PPunkt(Lista.Items[i-SiatkaMapy.x])^.x;
     ykpion:=PPunkt(Lista.Items[i-SiatkaMapy.x])^.y+PPunkt(Lista.Items[i-SiatkaMapy.x])^.fh;
    end else begin
     xkpion:=PPunkt(Lista.Items[i mod SiatkaMapy.x])^.x;
     ykpion:=PPunkt(Lista.Items[i mod SiatkaMapy.x])^.y+PPunkt(Lista.Items[i mod SiatkaMapy.x])^.fh;
    end;
    PPunkt(Lista.Items[i])^.Draw(xk,yk,XKPion,YKPion);
  end;
end;

procedure TForm1.OmegaTimer1Timer(Sender: TObject);
var
 i:integer;
begin
 OmegaInput1.Update;
 if not omegascreen1.CanDraw then exit;

 OmegaScreen1.ClearScreen(0,0,128,0);
 OmegaScreen1.BeginRender;

 PokazPunkty;

 OmegaFont1.Print(0,0,'FPS: '+IntToStr(OmegaTimer1.FPS));
 OmegaFont1.Print(0,20,'LKM- podnieś teren');
 OmegaFont1.Print(0,40,'PKM- obniż teren');

 OmegaScreen1.EndRender;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Lista:=TList.Create;
  TworzPunkty(0,0);


  OmegaScreen1.Init;
  OmegaScreen1.SetHWnd(self.handle);
  OmegaFont1.Init;
  OmegaFont1.CreateFont('Arial',10,[]);
  OmegaFont1.Color:=OmegaColor(255,255,255);

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  OmegaTimer1.Enabled:=false;
  OmegaSprite1.Dead;
  OmegaScreen1.FreeOnRelease;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
 OmegaTimer1.Enabled:=true;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  //ESC
  if key=27 then close;
  //spacja
  if key=32 then fLinie:=not fLinie;
  //klawisz P
  if key=80 then fPunkty:=not fPunkty;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i:integer;
begin
  for i:=0 to Lista.Count-1 do Dispose(PPunkt(Lista.Items[i]));
  Lista.Free;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if idAktywny>-1 then
  //Anuluj aktywny punkt
  //ustaw stare
  with PPunkt(Lista.Items[idAktywny])^ do begin
       Red:=0;
       Green:=255;
       Blue:=0;
  end;
  //Wyznacz nowy aktywny punkt
  idAktywny:=x div RozmiarKfla.x+ (y div RozmiarKfla.y)*SiatkaMapy.x;
  //ustaw nowe
  with PPunkt(Lista.Items[idAktywny])^ do begin
       Red:=255;
       Green:=0;
       Blue:=0;
  end;
  //szczyty i doliny
  if Button=mbLeft  then szczyt(idAktywny,-8);
  if Button=mbRight then szczyt(idAktywny, 8);

end;
end.
