{
        This Code Was Created By Jan Koci 2001
        Visit My Site At koci.opengl.cz
}

unit BColl_f;


interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OpenGL, jpeg, Menus, StdCtrls, Math, K3dMath;


type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ClearFace(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;

  end;



    procedure InitScene;
    procedure InitWindow;
    procedure PixelFormat(DC : HDC);
    procedure InitArea;
    procedure InitLight;
    procedure DrawScene;
    procedure MoveObject;
    procedure InitTriangleTexture;
    procedure DrawTriangle;
    procedure CalcCollision(val: TGLInt);
    procedure SetFullScreen(SizeX,SizeY,Bits:longint);
    procedure RestoreMode;
    procedure ProcessKeyb;
    procedure InitTexture;
    procedure LoadTexture(Num:LongInt;FileName:string;Typ:word);
    procedure LoadPicture(FileName:String;var Pic:TPicture);
    procedure StoreTexture(Num:LongInt;Pic:TPicture);
    procedure SetTexture(Num:Longint;Typ:word);


//Textures
type TRGBByte=record
     r: TGLubyte;
     g: TGLubyte;
     b: TGLubyte;
end;
type TRGBAByte=record
     r: TGLubyte;
     g: TGLubyte;
     b: TGLubyte;
     a: TGLubyte;
end;

type TRGBColors=array[1..1024*1024] of TRGBByte;
     TRGBAColors=array[1..1024*1024] of TRGBAByte;

type TTexture=record
     ColorSystem:TGLEnum;
     FileName:String;
     rgbcolor:^TRGBColors;
     rgbacolor:^TRGBAColors;
     Width:Word;
     Height:Word;
     Mip:boolean;
end;




//Triangles

type TPoint2D=record
     x: TGLFloat;
     y: TGLFloat;
end;

var
  Point1, Point2, Point3: array [1..20] of  TPoint3D;
  Normal1, Normal2, Normal3: array [1..20] of TPoint3D;
  Coord1, Coord2, Coord3: array [1..20] of TPoint2D;


ViewAngle, NearClip, FarClip: TGLFloat;

//Line
Line1, Line2: TPoint3D;

//Collision
bCollided: array [1..20] of boolean;




//other
var
  Form1: TForm1;
  Handles : integer;
  ThreadID : LongWord;
  TextureBin:array[1..256] of word;
  TextureH:TTexture;
  Texture:array[1..256] of TTexture;
  UniPicture:TPicture;
  Angle, Tran: TPoint3D;
  KeybUp, KeybDown, KeybRight, KeybLeft, KeybHome, KeybEnd, KeybEsc, KeybMoveUp, KeybMoveDown, KeybSpace: boolean;
  RC : HGLRC;
  MoveSpeed: single=0.5;


const PFDError = 'Chyba poi nastavení PFD.';


implementation

uses Unit2;


{$R *.DFM}






function Thread(P : pointer) : integer;
var
  i: integer;
begin
  i := 1;
  repeat
    Form1.Repaint;
  until
    i = 2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  InitScene;
end;

procedure InitScene;
begin
  Tran.X := -30;
  Tran.Z := 6;
  Angle.Y := 280;
  ViewAngle := 30;
  NearClip := 0.1;
  FarClip := 100000;


  //Triangl 1
  Coord1[1].x := 0;
  Coord1[1].y := 0;
  Coord2[1].x := 3;
  Coord2[1].y := 0;
  Coord3[1].x := 0;
  Coord3[1].y := 1;
  Normal1[1].x := 0;
  Normal1[1].y := 0;
  Normal1[1].z := 1;
  Normal2[1].x := 0;
  Normal2[1].y := 0;
  Normal2[1].z := 1;
  Normal3[1].x := 0;
  Normal3[1].y := 0;
  Normal3[1].z := 1;
  Point1[1].x := -6;
  Point1[1].y := 6;
  Point1[1].z := 0;
  Point2[1].x := 36;
  Point2[1].y := 6;
  Point2[1].z := 0;
  Point3[1].x := -6;
  Point3[1].y := -6;
  Point3[1].z := 0;


  //Collision Line
  Line1.x := 0;
  Line1.y := 2;
  Line1.z := -2;

  Line2.x := 0;
  Line2.y := 2;
  Line2.z := 2;

  InitWindow;
  InitArea;
  Handles := BeginThread(nil, 0, Thread, nil, 0, ThreadID);
end;

procedure InitWindow;
begin
  PixelFormat(Form1.Canvas.Handle);
  RC := wglCreateContext(Form1.Canvas.Handle);
  wglMakeCurrent(Form1.Canvas.Handle,RC);
  glClearColor(0.0,0.0,0.0,0.0);
  glShadeModel(GL_SMOOTH);
  glEnable(GL_DEPTH_TEST);
  InitTriangleTexture;
  InitLight;
  wglMakeCurrent(0,0);
end;

procedure PixelFormat(DC : HDC);
var PFD : TPixelFormatDescriptor;
    nPixelFormat : integer;
begin
  FillChar(PFD,SizeOf(PFD),0);
  with PFD do
    begin
       nSize := SizeOf(TPixelFormatDescriptor);
       nVersion := 1;
       dwFlags := PFD_DRAW_TO_WINDOW or
                  PFD_SUPPORT_OPENGL or
                  PFD_DOUBLEBUFFER;
       iPixelType := PFD_TYPE_RGBA;
       cColorBits := 24;
       cDepthBits   := 32;
       iLayerType   := PFD_MAIN_PLANE;
    end;
  nPixelFormat := ChoosePixelFormat(DC,@PFD);
  Assert(nPixelFormat <> 0,PFDError);
  SetPixelFormat(DC,nPixelFormat,@PFD)
end;

procedure InitArea;
begin
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(ViewAngle,Form1.ClientWidth / Form1.ClientHeight,NearClip,FarClip);
  glViewport(0,0,Form1.ClientWidth,Form1.ClientHeight);
end;

procedure DrawScene;
begin
  wglMakeCurrent(Form1.Canvas.Handle,RC);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  MoveObject;
  DrawTriangle;
  glFlush;
  SwapBuffers(Form1.Canvas.Handle);
  wglMakeCurrent(0,0)
end;


procedure MoveObject;
begin
  ProcessKeyb;
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glRotatef(-Angle.x, 1, 0, 0);
  glRotatef(-Angle.y, 0, 1, 0);
  glRotatef(-Angle.z, 0, 0, 1);
  glTranslatef(-Tran.X,-Tran.Y,-Tran.Z);
end;

procedure InitLight;
const
  glfLightAmbient : Array[0..3] of TGLfloat = (0.7, 0.7, 0.7, 1.0);  //GL_AMBIENT = ambientní svitlo, svitlo které záoí i když jsou svitla vypnuta
  glfLightDiffuse : Array[0..3] of TGLfloat = (1.0, 1.0, 1.0, 1.0);  //GL_DIFFUSE = barva svitla, které zdroj vyzaouje do okolí
  glfLightSpecular: Array[0..3] of TGLfloat = (0.7, 0.7, 0.7, 1.0);  //GL_SPECULAR = zrcadlový odraz svitla
  glfLightShininess: TGLFloat = 127;                                 //GL_SHININESS = intenzita svitelného odlesku
  glflightPosition: Array[0..3] of TGLfloat = (0.0,0.0,1.0,1.0);   //GL_Position = pozice svitelného bodu v prostoru
  glfSpotDirection: Array[0..3] of TGLfloat = (0.0,0.0,-1.0,1.0);    // GL_SPOT_DIRECTION = zadání smiru svitelného kužele
  glfLightEmission: Array[0..3] of TGLfloat = (0.0,0.0,0.0,1.0);     // svitlo, které vyzaouje ureitý objekt, nepusobí jako zdroj svitla
  glfLinearAttenuation: TGLFloat = 0;                                // GL_LINEAR_ATTENUATION = lineární slábnutí intenzity svitla
  glfSpotExponent: TGLFloat = 1;                                     //GL_SPOT_EXPONENT = charakterizuje zpusob rozptylu svitla poi odrazu
  glfSpotCutoff:TGLFloat = 180;                                       //GL_SPOT_CUTOFF = úhel, nímž se kužel svitla rozevírá od své osy

begin
  glEnable(GL_DEPTH_TEST);

  glLightfv(GL_LIGHT0, GL_AMBIENT, @glfLightAmbient);
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @glfLightDiffuse);
  glLightfv(GL_LIGHT0, GL_SPECULAR, @glfLightSpecular);
  glLightfv(GL_LIGHT0, GL_SHININESS, @glfLightShininess);
  glLightfv(GL_LIGHT0, GL_POSITION,@glfLightPosition);
  glLightfv(GL_LIGHT0, GL_SPOT_DIRECTION, @glfSpotDirection);
  glLightfv(GL_LIGHT0, GL_EMISSION, @glfLightEmission);
  glLightfv(GL_LIGHT0, GL_LINEAR_ATTENUATION, @glfLinearAttenuation);
  glLightfv(GL_LIGHT0, GL_SPOT_EXPONENT, @glfSpotExponent);
  glLightfv(GL_LIGHT0, GL_SPOT_CUTOFF, @glfSpotCutoff);

  glEnable(GL_LIGHTING);
  glEnable(GL_LIGHT0);
end;

procedure InitTriangleTexture;
var
  Path: string;
begin
  Path := ExtractFilePath(Application.ExeName);
  InitTexture;
  LoadTexture(1,Path + 'wall.jpg',gl_rgb8);
end;

procedure DrawTriangle;
var
  i: integer;
begin
  for i := 1 to 1 do begin
  CalcCollision(i);
  glPushMatrix;
  glDisable(GL_LIGHTING);
  glColor3f(1, 1, 1);
  glBindTexture(GL_TEXTURE_2D, TextureBin[i]);
  glEnable(GL_TEXTURE_2D);
  glBegin(GL_TRIANGLES);
    glTexCoord2f(Coord1[i].x,Coord1[i].y);
    glNormal3f(Normal1[i].x,Normal1[i].y,Normal1[i].z);
    glVertex3f(Point1[i].x,Point1[i].y,Point1[i].z);
    glTexCoord2f(Coord2[i].x,Coord2[i].y);
    glVertex3f(Point2[i].x,Point2[i].y,Point2[i].z);
    glTexCoord2f(Coord3[i].x,Coord3[i].y);
    glVertex3f(Point3[i].x,Point3[i].y,Point3[i].z);
  glEnd;
  glPopMatrix;
  end;
end;

procedure CalcCollision(val: TGLInt);
begin
  bCollided[val] := IntersectedPolygon(Point1[val], Point2[val], Point3[val] , Line1, Line2);

 // Below we draw the line that the polygon will be colliding with. (RED is collision)
 glPushMatrix;
 glDisable(GL_TEXTURE_2D);
 if  bCollided[1]  then begin           // If we collided, change the color of the line to illustrate this.
   glColor3f(1, 0, 0);			// Make the line RED if we collided with the triangle's plane
 end else begin
   glColor3f(1, 1, 0);                  // Make the line YELLOW if we didn't collide
 end;

 glBegin(GL_LINES);				        // This is our BEGIN to draw Line
   glVertex3f(Line1.x, Line1.y, Line1.z);
   glVertex3f(Line2.x, Line2.y, Line2.z);
 glEnd;
 glPopMatrix;
end;





procedure SetFullScreen(SizeX,SizeY,Bits:longint);
var dmScreenSettings: DEVMODE;
begin
  ZeroMemory( @dmScreenSettings, sizeof( DEVMODE ) );
  dmScreenSettings.dmSize := sizeof( DEVMODE );
  dmScreenSettings.dmPelsWidth  := SizeX; // Width
  dmScreenSettings.dmPelsHeight := SizeY; // Height
  dmScreenSettings.dmFields     := DM_PELSWIDTH or DM_PELSHEIGHT; // Color Depth
  dmScreenSettings.dmBitsPerPel := Bits;
  ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN); // Switch To Fullscreen Mode

  Form1.WindowState := wsMaximized;
end;

procedure RestoreMode;
begin
  ChangeDisplaySettings(DEVMODE(nil^), 0);
end;

procedure InitTexture;
var a:word;
    f:TGluint;
begin
     UniPicture:=TPicture.Create;
     for a:=1 to 256 do begin
         glGenTextures(1, @f);TextureBin[a]:=f;
     end;
     for a:=1 to 256 do begin
         with texture[a] do begin
            rgbacolor:=nil;
            rgbcolor:=nil;
            ColorSystem:=Gl_RGB;
            glBindTexture(GL_TEXTURE_2D,TextureBin[a]);
            glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_S,gl_repeat);
            glTexParameterf(GL_Texture_2D,GL_Texture_Wrap_T,gl_repeat);
            glTexParameterf(GL_Texture_2D,GL_Texture_Mag_Filter,GL_Linear);
            glTexParameterf(GL_Texture_2D,GL_Texture_Min_Filter,GL_Linear);
            glTexEnvf(GL_Texture_Env, GL_Texture_Env_Mode, GL_MODULATE);
         end;
     end;
end;

procedure LoadTexture(Num:LongInt;FileName:string;Typ:word);
begin
  if (Typ=gl_rgba2) or (Typ=gl_rgba4) or (Typ=gl_rgba8) or (Typ=gl_rgba16) then texture[num].colorsystem:=gl_rgba else texture[num].colorsystem:=gl_rgb;
    LoadPicture(FileName,UniPicture);
    texture[num].filename:=ExtractFileName(FileName);
    StoreTexture(Num,UniPicture);
    SetTexture(Num,Typ);
end;

procedure LoadPicture(FileName:String;var Pic:TPicture);
var Y:TPicture;
    temp:boolean;
    searchrec:tsearchrec;
begin
  filename:=uppercase(filename);
  if findfirst(filename,$3f,searchrec)<>0 then begin
     MessageDlg('Picture '+filename+' not found !!!', mtError, [mbOK], 0);
     halt;
  end;
  if ExtractFileExt(FileName)='.JPG' then begin
     Y:=TPicture.Create;
     Y.LoadFromFile(FileName);
     temp:=y.Graphic is TJPEGImage;
     if temp then begin
        Pic.Bitmap.Width:=y.Graphic.Width;
        Pic.Bitmap.Height:=y.Graphic.Height;
        Pic.Bitmap.Canvas.draw(0,0,Y.Graphic);
     end;
     Y.Free;
  end;
  if ExtractFileExt(FileName)='.BMP' then begin
     Pic.LoadFromFile(FileName);
  end;
end;

procedure StoreTexture(Num:LongInt;Pic:TPicture);
var bih : TBitmapInfoHeader;
    bi : TBitmapInfo;
    poz,poz2:longint;
    i,j : longint;
begin
  with Texture[Num] do begin
      Width:=Pic.Bitmap.Width;Height:=Pic.Bitmap.Height;
      TextureH.rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte));
  end;
  with bih do begin
      biSize:=SizeOf(bih);
      biWidth:=Pic.width;biHeight:=Pic.height;
      biPlanes:=1;biBitCount:=24;biCompression:=BI_RGB;
      biSizeImage:=Pic.width;
      biXPelsPerMeter:=0;biYPelsPerMeter:=0;biClrImportant:=0;
      biClrUsed := 0;
  end;
  bi.bmiHeader := bih;
  GetDIBits(Pic.Bitmap.Canvas.Handle,Pic.Bitmap.Handle,0,Pic.width,textureH.rgbcolor,bi,dib_rgb_colors);
  with Texture[Num] do begin
    if ColorSystem=GL_RGB then begin
       rgbcolor:=AllocMem(Width*Height*sizeof(TRGBByte));
       for i := 0 to Pic.height-1 do begin
         for j := 1 to Pic.width do begin
           poz:=j+i*texture[num].width;
           poz2:=j+((pic.height-1)-i)*texture[num].width;
           with texture[num].rgbcolor^[poz2] do begin
             r:=textureH.rgbcolor^[poz].b;
             g:=textureH.rgbcolor^[poz].g;
             b:=textureH.rgbcolor^[poz].r;
           end;
         end;
       end;
    end else begin
       rgbacolor:=AllocMem(Width*Height*sizeof(TRGBAByte));
       for i := 0 to Pic.height-1 do begin
         for j := 1 to Pic.width do begin
           poz:=j+i*texture[num].width;
           poz2:=j+((pic.height-1)-i)*texture[num].width;
           with texture[num].rgbacolor^[poz2] do begin
             r:=textureH.rgbcolor^[poz].b;
             g:=textureH.rgbcolor^[poz].g;
             b:=textureH.rgbcolor^[poz].r;
             if r+g+b=0 then a:=0 else a:=255;
           end;
         end;
       end;
    end;
  end;
  FreeMem(TextureH.rgbcolor);
end;

procedure SetTexture(Num:Longint;Typ:word);
begin
  with Texture[Num] do begin
    Mip:=false;
    glBindTexture(GL_TEXTURE_2D,TextureBin[num]);
    if ColorSystem=GL_RGB then begin
       glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGB,GL_Unsigned_byte,rgbcolor);
    end else begin
       glTexImage2d(GL_Texture_2D,0,TYP,width,height,0,GL_RGBA,GL_Unsigned_byte,rgbacolor);
    end;
  end;
end;

procedure TForm1.ClearFace(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  wglDeleteContext(RC);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawScene;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  wglMakeCurrent(Canvas.Handle,RC);
  InitArea;
  DrawScene;
  wglMakeCurrent(0,0);
end;


procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_UP: begin  //Forward
       KeybUp := True;
    end;
  end;
  case Key of
    VK_DOWN: begin //Backward
      KeybDown := True;
    end;
  end;
  case Key of
    VK_RIGHT: begin //Rotate right
      KeybRight := True;
    end;
  end;
  case Key of
    VK_LEFT: begin //Rotate left
      KeybLeft := True;
    end;
  end;
  case Key of
    VK_Home: begin //Look up
      KeybHome := True;
    end;
  end;
  case Key of
    VK_END: begin //Look down
      KeybEnd := True;
    end;
  end;
  case Key of
    27: begin //Q - Quit
      Application.Terminate;
      RestoreMode;
    end;
  end;
  case Key of
    VK_Return: begin //Full Screen
      SetFullScreen(640,480,16);
    end;
  end;
  case Key of
    VK_Prior: begin //move up
      KeybMoveUp := True;
    end;
  end;
  case Key of
    VK_Next: begin //move down
      KeybMoveDown := True;
    end;
  end;
  case Key of
    VK_Space: begin //move down
      KeybSpace := True;
    end;
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  case Key of
    VK_UP: begin  //Forward
       KeybUp := False;
    end;
  end;
  case Key of
    VK_DOWN: begin //Backward
      KeybDown := False;
    end;
  end;
  case Key of
    VK_RIGHT: begin //Rotate right
      KeybRight := False;
    end;
  end;
  case Key of
    VK_LEFT: begin //Rotate left
      KeybLeft := False;
    end;
  end;
  case Key of
    VK_Home: begin //Look up
      KeybHome := False;
    end;
  end;
  case Key of
    VK_END: begin //Look down
      KeybEnd := False;
    end;
  end;
  case Key of
    VK_Prior: begin //move up
      KeybMoveUp := False;
    end;
  end;
  case Key of
    VK_Next: begin //move down
      KeybMoveDown := False;
    end;
  end;
  case Key of
    VK_Space: begin //move down
      KeybSpace := False;
    end;
  end;
end;

procedure ProcessKeyb;
begin
  if KeybUp then begin
    Tran.Z := Tran.Z - ((cos(Angle.Y * (Pi/180))) *  MoveSpeed);
    Tran.X := Tran.X - ((sin(Angle.Y * (Pi/180))) *  MoveSpeed);
  end;
  if KeybDown then begin
      Tran.Z := Tran.Z + ((cos(Angle.Y * (Pi/180))) *  MoveSpeed);
      Tran.X := Tran.X + ((sin(Angle.Y * (Pi/180))) *  MoveSpeed);
  end;
  if KeybRight then begin
    if KeybSpace then begin
      Tran.Z := Tran.Z - ((cos((Angle.Y - 90) * (Pi/180))) *  MoveSpeed);
      Tran.X := Tran.X - ((sin((Angle.Y - 90) * (Pi/180))) *  MoveSpeed);
    end else begin
      Angle.Y := Angle.Y - 3;
    end;
  end;
  if KeybLeft then begin
    if KeybSpace then begin
      Tran.Z := Tran.Z + ((cos((Angle.Y - 90) * (Pi/180))) *  MoveSpeed);
      Tran.X := Tran.X + ((sin((Angle.Y - 90) * (Pi/180))) *  MoveSpeed);
    end else begin
      Angle.Y := Angle.Y + 3;
    end;
  end;
  if KeybHome then begin
    Angle.X := Angle.X + MoveSpeed;
  end;
  if KeybEnd then begin
    Angle.X := Angle.X - MoveSpeed;
  end;
  if KeybMoveUp then begin
    Tran.Y := Tran.Y + MoveSpeed;
  end;
  if KeybMoveDown then begin
    Tran.Y := Tran.Y - MoveSpeed;
  end;
end;

end.