unit View3DForm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OpenGL, {Glut,} AppEvnts, Math, Menus;

type
  TView3DFrm = class(TForm)
    MenuPopup: TPopupMenu;
    worzenieobrazu1: TMenuItem;
    MethodBars: TMenuItem;
    MethodTriangles: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure MethodBarsClick(Sender: TObject);
    procedure MethodTrianglesClick(Sender: TObject);
  private
    { Private declarations }
  public
   DC: HDC;
   RC: HGLRC;
   control: TWinControl;
   obj: GluQuadricObj;
   procedure InitOpengl(control: TWinControl);
   procedure SetupPixelFormat(DC: HDC);
   procedure Render;
   procedure ResizeControl;
  end;
  T4GlFloat=array[0..3] of glFloat;

var
  View3DFrm: TView3DFrm;
  i:single; ZScale, XYScale :single;
  CamX, CamY, CamZ: double;
  EyeX, EyeY, EyeZ: double;
  DirX, DirY, DirZ: double;
  CamAngle: double=0;
  ColobotStyle: bool=false;

implementation
{$R *.dfm}

uses MainForm;

function CGlColor(const red, green, blue:single; const alpha:single=1):T4GlFloat;
begin
 Result[0] := red;
 Result[1] := green;
 Result[2] := blue;
 Result[3] := alpha;
end;

procedure TView3DFrm.ResizeControl;
var
    width, height: Integer;
    aspect: GLdouble;
    const n = 100.0;
begin
 if Length(Relief)=0 then exit;
    width := GLsizei(control.ClientWidth);
    height:= GLsizei(control.ClientHeight);
    glViewport( 0, 0, width, height );
    aspect := width/height;
    glMatrixMode( GL_PROJECTION ); glLoadIdentity();

{    if RPersp.Checked then}
        gluPerspective( 60.0, aspect, 1.0, 10.0*n);
{    else
        if width <= height then
            glOrtho( -n, n, -n/aspect, n/aspect, -10.0*n, 10.0*n )
        else
            glOrtho( -n*aspect, n*aspect, -n, n, -10.0*n, 10.0*n);}

    glMatrixMode(GL_MODELVIEW); glLoadIdentity();
    Render;
end;

procedure TView3DFrm.SetupPixelFormat(DC: HDC);
const
   pfd: TPIXELFORMATDESCRIPTOR = (
        nSize: sizeof(TPIXELFORMATDESCRIPTOR); // rozmiar struktury
        nVersion: 1;		                   // wersja
        dwFlags: PFD_SUPPORT_OPENGL or  // umożliwia użycie funkcji OpenGL
                 PFD_DRAW_TO_WINDOW or  // rysowanie bezpośrednio na ekranie
                 PFD_DOUBLEBUFFER;		// udostępnienie podwójnego buforowania
        iPixelType: PFD_TYPE_RGBA;		// typ koloru RGBA
        cColorBits: 24;		            // kolor 24-bitowy
        cRedBits: 0; cRedShift: 0;      // nie używane
        cGreenBits: 0;  cGreenShift: 0;
        cBlueBits: 0; cBlueShift: 0;
        cAlphaBits: 0;  cAlphaShift: 0;
        cAccumBits: 0;
        cAccumRedBits: 0;
        cAccumGreenBits: 0;
        cAccumBlueBits: 0;
        cAccumAlphaBits: 0;
        cDepthBits: 32;                 // wielkość bufora
        cStencilBits: 0;		        // nie używane
        cAuxBuffers: 0;
        iLayerType: PFD_MAIN_PLANE;  	// główna powłoka
        bReserved: 0;
        dwLayerMask: 0;
        dwVisibleMask: 0;               // nie używane
        dwDamageMask: 0;
   );

var pixelFormatIndex:integer;
begin
    pixelFormatIndex := ChoosePixelFormat(DC, @pfd);
    SetPixelFormat(DC, pixelFormatIndex, @pfd);
end;

procedure TView3DFrm.InitOpengl(control: TWinControl);
begin
 DC := GetDC(control.Handle);
 SetupPixelFormat(DC);
 RC := wglCreateContext(DC);
 if not wglMakeCurrent(DC, RC) then
  MessageBox(0, 'Błąd inicjalizacji OpenGL :(', 'Widok 3D', MB_IconError);
end;

procedure TView3DFrm.ApplicationEvents1Idle(Sender: TObject;
  var Done: Boolean);
begin
 if Visible then begin
  Render;
  Done := false;
 end;
end;

procedure TView3DFrm.FormCreate(Sender: TObject);
begin
 Caption := 'Trwa inicjowanie biblioteki OpenGL...';
 Show;
 Application.ProcessMessages;
 control := View3DFrm;
 InitOpengl(control);
 GlEnable(GL_DEPTH_TEST);
 glEnable(GL_LIGHT0);
 glEnable(GL_LIGHTING);
 glEnable(GL_TEXTURE_2D);
{ if not GlutInit(MS_LIB) then
  MessageBox(0,'Nie można zainicjować biblioteki 3D','Widok 3D',MB_ICONERROR);
 obj := gluNewQuadric;    }

 ZScale := 0.025;
 XYScale := 0.496;
 CamX := 100;
 CamY := 100;
 CamZ := 200;
 EyeX := 100;
 EyeY := 100;
 EyeZ := 10;
 Hide;
 Caption := 'Widok 3D';
end;


procedure TView3DFrm.Render;
var i,j:word; waterf:byte; c:TColor;
var LightPos, v:T4GlFloat; g:byte; f:GLfloat;
begin
 if Length(Relief)<1 then exit;
 LightPos[0] := 0;
 LightPos[1] := 0;
 LightPos[2] := 300;
 LightPos[3] := 1;
 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
 glEnable(GL_COLOR_MATERIAL);
 glEnable(GL_SHADE_MODEL);
 glShadeModel(GL_SMOOTH);
 glColorMaterial(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE);
 glPushMatrix;
 glLightfv(GL_LIGHT0, GL_POSITION, @LightPos);
 v := CGlColor(0.5, 0.5, 0.5);
 glLightfv(GL_LIGHT0, GL_AMBIENT, @v);
 v := CGlColor(0.8, 0.8, 0.8);
 glLightfv(GL_LIGHT0, GL_DIFFUSE, @v);
 v := CGlColor(1, 1, 1);
 glLightfv(GL_LIGHT0, GL_SPECULAR, @v);
 gluLookAt(CamX, -CamY, CamZ, EyeX*XYScale,-EyeY*XYScale,EyeZ*ZScale, 0,0,1);

 waterf := Round(WaterLevel/ReliefFactor);
 if MethodBars.Checked then begin
  glBegin(GL_QUADS);
  for i := 0 to ReliefHeight-1 do
   for j := 0 to ReliefWidth-1 do begin
   g := Relief[i][j];
   if g<waterf then c := TerrainColors[g-waterf] else c := TerrainColors[g];
   glColor4f(GetRValue(c)/255, GetGValue(c)/255, GetBValue(c)/255, 1);
   glVertex3f(j*XYScale, -i*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, g*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, g*ZScale);

   glVertex3f(j*XYScale, -i*XYScale, 0);
   glVertex3f(j*XYScale, -i*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, 0);

   glVertex3f(j*XYScale, -i*XYScale, 0);
   glVertex3f(j*XYScale, -i*XYScale, g*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, g*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, 0);

   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, 0);
   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, g*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, g*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, 0);

   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, 0);
   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, g*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, 0);
  end;
  glEnd;
 end else begin
  glBegin(GL_TRIANGLES);
  //glBegin(GL_QUADS);
  for i := 1 to ReliefHeight-2 do for j := 1 to ReliefWidth-2 do begin
   g := Relief[i][j];
   if g<waterf then c := TerrainColors[g-waterf] else c := TerrainColors[g];
   glColor4f(GetRValue(c)/255, GetGValue(c)/255, GetBValue(c)/255, 1);
   glVertex3f((j+1)*XYScale, -i*XYScale, Relief[i][j+1]*ZScale);
   glVertex3f(j*XYScale, -i*XYScale, Relief[i][j]*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, Relief[i+1][j]*ZScale);

   glVertex3f((j+1)*XYScale, -i*XYScale, Relief[i][j+1]*ZScale);
   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, Relief[i+1][j+1]*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, Relief[i+1][j]*ZScale);
   {glVertex3f(j*XYScale, -i*XYScale, Relief[i][j]*ZScale);
   glVertex3f((j+1)*XYScale, -i*XYScale, Relief[i][j+1]*ZScale);
   glVertex3f((j+1)*XYScale, -(i+1)*XYScale, Relief[i+1][j+1]*ZScale);
   glVertex3f(j*XYScale, -(i+1)*XYScale, Relief[i][j]*ZScale);}
  end;
  glEnd;
 end;
{
 glDisable(GL_TEXTURE_2D);
 glShadeModel(GL_FLAT);
 glEnable(GL_BLEND); // włącz łączenie kolorów
 glDepthFunc(GL_EQUAL);
 glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 f := (WaterLevel/ReliefFactor)*ZScale;
 glBegin(GL_QUADS);
 glColor4f(0,0.1,0.8,0.5);
 glVertex3f(0,0, f);
 glVertex3f(0, -ReliefHeight*XYScale, f);
 glVertex3f(ReliefWidth*XYScale, -ReliefHeight*XYScale, f);
 glVertex3f(ReliefWidth*XYScale, 0, f);
 glDisable(GL_BLEND);
 glEnable(GL_TEXTURE_2D);
 glShadeModel(GL_SMOOTH);
 glEnd;}
 glPopMatrix;
 glFlush;
 SwapBuffers(wglGetCurrentDC);
end;

procedure TView3DFrm.FormResize(Sender: TObject);
begin
 ResizeControl;
end;

procedure PosAfter(const x,y, dist, angle:double; out ox, oy:double);
var angrad:double;
begin
 //angrad := DegToRad(angle);
 //ox := (y*sin(angrad)+x*cos(angrad))+dist;
 //oy := (y*cos(angrad)-x*sin(angrad))+dist;
 ox := cos(angle)*dist+x;
 oy := sin(angle)*dist+y;

end;

procedure TView3DFrm.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var tcamx, tcamy:double; ang:double;
begin
 if Key=VK_RETURN then ColobotStyle := not ColobotStyle;
 if not ColobotStyle then begin
  if Key=VK_LEFT then CamX := CamX-2;
  if Key=VK_RIGHT then CamX := CamX+2;
  if Key=VK_UP then CamY := CamY-2;
  if Key=VK_DOWN then CamY := CamY+2;
  if Key=VK_PRIOR then CamZ := CamZ+5;  // PgDown
  if Key=VK_NEXT then CamZ := CamZ-5;   // PgUp
  if Key=VK_NUMPAD4 then EyeX := EyeX-1;
  if Key=VK_NUMPAD6 then EyeX := EyeX+1;
  if Key=VK_NUMPAD2 then EyeY := EyeY+1;
  if Key=VK_NUMPAD8 then EyeY := EyeY-1;
  if EyeX<0 then EyeX := 0;
  if EyeX>=ReliefWidth then EyeX := ReliefWidth-1;
  if EyeY<0 then EyeY := 0;
  if EyeY>=ReliefHeight then EyeY := ReliefHeight-1;
  if Key=VK_ADD then XYScale := XYScale+0.02;
  if Key=VK_SUBTRACT then XYScale := XYScale-0.02;
  if Key=VK_MULTIPLY then ZScale := ZScale+0.02;
  if Key=VK_DIVIDE then ZScale := ZScale-0.02;
  EyeZ := Relief[Floor(EyeY)][Floor(EyeX)];
 end else begin
  //ang := DegToRad(CamAngle);
  Ang := CamAngle;
  if Key=VK_LEFT then CamAngle := CamAngle+0.12;
  if Key=VK_RIGHT then CamAngle := CamAngle-0.12;
  EyeX := CamX+cos(ang);
  EyeY := CamY+sin(ang);
  if Key=VK_UP then begin
   CamX := CamX+cos(ang);
   CamY := CamY+sin(ang);
  end;
  if Key=VK_DOWN then begin
   CamX := CamX-cos(ang);
   CamY := CamY-sin(ang);
  end;
  EyeZ := CamZ;
 end;
 Render;
end;

procedure TView3DFrm.FormShow(Sender: TObject);
begin
 OnResize(Sender);
 Render;
end;

procedure TView3DFrm.FormPaint(Sender: TObject);
begin
 Render;
end;

procedure TView3DFrm.MethodBarsClick(Sender: TObject);
begin
 MethodBars.Checked := true;
end;

procedure TView3DFrm.MethodTrianglesClick(Sender: TObject);
begin
 MethodTriangles.Checked := true;
end;

end.
