unit Emit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OpenGL, Menus;

type
  TLightDesc=packed record
    red,
    green,
    blue,
    alpha: glFloat;
  end; 
  TLightPlace=packed record
    x,
    y,
    z,
    w: glFloat;
  end;
  TPosition=packed record
    x,
    y,
    z: glFloat;
  end;
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    GLContext: HGLRC;
    glDC: HDC;
    errorCode: GLenum;
    before,
    openGLReady: boolean;
    oldw,
    oldh: integer;
    angle,
    xvalue,
    yvalue,   
    zvalue: glFloat;
    xl,yl,zl,xrl,yrl,zrl,anglel,cutoff,
    x1,y1,z1,x2,y2,z2,xr1,yr1,zr1,
    xr2,yr2,zr2,angle1,angle2,sign: glFloat;
    CubeColor,
    SpotColor,
    DiffDef,
    AmbientDef,
    emit,
    black: TLightDesc;
    LightPlace: TLightPlace;
    SpotDirect: TPosition;
    procedure ExceptionGL(Sender:TObject;E:Exception);
    procedure Cube(matColor:TLightDesc);
    procedure Axes;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
var
  pfd: TPixelFormatDescriptor;
  FormatIndex: integer;
begin
  Application.OnException := ExceptionGL;
  fillchar(pfd,SizeOf(pfd),0);
  with pfd do
  begin
    nSize      := SizeOf(pfd);
    nVersion   := 1; {The current version of the desccriptor is 1}
    dwFlags    := PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 24; {support 24-bit color}
    cDepthBits := 32; {depth of z-axis}
    iLayerType := PFD_MAIN_PLANE;
  end; {with}
  glDC := getDC(handle);
  FormatIndex := ChoosePixelFormat(glDC,@pfd);
  if FormatIndex=0 then
    raise Exception.Create('ChoosePixelFormat failed '+
      IntToStr(GetLastError)); 

  if not SetPixelFormat(glDC,FormatIndex,@pfd) then
    raise Exception.Create('SetPixelFormat failed '+
      IntToStr(GetLastError));

  GLContext := wglCreateContext(glDC);
  if GLContext=0 then
    raise Exception.Create('wglCreateContext failed '+
      IntToStr(GetLastError));

  if not wglMakeCurrent(glDC,GLContext) then
    raise Exception.Create('wglMakeCurrent failed '+
      IntToStr(GetLastError));
  
  OpenGLReady := true;
  oldw := ClientWidth;
  oldh := ClientHeight;
  glMatrixMode(GL_PROJECTION);
  glFrustum(-1.0,1.0,-1.0,1.0,2.0,37.0);   
  glEnable(GL_DEPTH_TEST);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;

  glEnable(GL_CULL_FACE);
  glCullFace(GL_BACK);
  sign := 0.1;
  glEnable(GL_LIGHTING);
  with AmbientDef do
  begin
    red := 0.3;
    green := 0.3;
    blue := 0.3;
    alpha := 1.0;
  end;
  with DiffDef do
  begin
    red := 1.0;
    green := 1.0;
    blue := 1.0;
    alpha := 1.0;
  end;
  with CubeColor do
  begin
    red := 0.5;
    green := 0.0;
    blue := 0.8;
    alpha := 1.0;
  end;
  with SpotColor do
  begin
    red := 0.0;
    green := 0.5;
    blue := 0.5;
    alpha := 1.0;
  end;
  SpotDirect.z := -1.0;
  LightPlace.w := 1.0;
  glLightfv(GL_LIGHT0,GL_AMBIENT,@AmbientDef);
  glLightfv(GL_LIGHT0,GL_DIFFUSE,@DiffDef);
  cutoff := 55.0;
  glLightf(GL_LIGHT0,GL_SPOT_CUTOFF,cutoff);
  glEnable(GL_LIGHT0);
  z2 := -2.7;
  x2 := -0.7;
  y2 := 0.7;
  zl := -6.7;
  xl := -1.8;
  yl := -2.1;
  with emit do
  begin
    red := 0.6;
    green := 1.0;
    blue := 1.0;
    alpha := 1.0;
  end;
end; {FormCreate}

procedure TForm1.FormDestroy(Sender: TObject);
begin
  OpenGLReady := false;
  wglMakeCurrent(glDC,0);
  wglDeleteContext(GLContext);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  if not openGLReady then
    exit;

  {green background}
  glClearColor(0.6,0.8,0.8,0.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glPushMatrix;
  if before then
    glRotatef(angle1,xr1,yr1,zr1);
  glTranslatef(x1,y1,z1);
  if not before then
    glRotatef(angle1,xr1,yr1,zr1);
  Cube(CubeColor);
  glPopMatrix;

  glPushMatrix;
  if before then
    glRotatef(angle2,xr2,yr2,zr2);
  glTranslatef(x2,y2,z2);
  if not before then
    glRotatef(angle2,xr2,yr2,zr2);
  Cube(CubeColor);
  glPopMatrix;

  glPushMatrix;
  glScalef(0.33,0.33,0.33);
  if before then
    glRotatef(anglel,xrl,yrl,zrl);
  glTranslatef(xl,yl,zl);
  if not before then
    glRotatef(anglel,xrl,yrl,zrl);
  glLightfv(GL_LIGHT0,GL_POSITION,@LightPlace);
  glLightfv(GL_LIGHT0,GL_SPOT_DIRECTION,@SpotDirect);
  Cube(SpotColor);
  glPopMatrix;

  glFlush;

  errorCode := glGetError;
  if errorCode<>GL_NO_ERROR then
    raise Exception.Create('Error in Paint'#13+
      gluErrorString(errorCode));
end; {FormPaint}

procedure TForm1.Cube(matColor:TLightDesc);
begin
  glMaterialfv(GL_FRONT,GL_AMBIENT,@matColor);
  glMaterialfv(GL_FRONT,GL_DIFFUSE,@matColor);
  glBegin(GL_POLYGON); {near face}
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(+0.4,-0.4,+0.4);
    glVertex3f(+0.4,+0.4,+0.4);
    glVertex3f(-0.4,+0.4,+0.4);
  glEnd;

  glBegin(GL_POLYGON); {right face}
    glVertex3f(+0.4,-0.4,+0.4);
    glVertex3f(+0.4,-0.4,-0.4);
    glVertex3f(+0.4,+0.4,-0.4);
    glVertex3f(+0.4,+0.4,+0.4);
  glEnd;

  glBegin(GL_POLYGON); {left face}
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(-0.4,+0.4,+0.4);
    glVertex3f(-0.4,+0.4,-0.4);
  glEnd;

  if matColor.red=0.0 then
    glMaterialfv(GL_FRONT,GL_EMISSION,@emit);
  glBegin(GL_POLYGON); {back face}
    glVertex3f(+0.4,-0.4,-0.4);
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(-0.4,+0.4,-0.4);
    glVertex3f(+0.4,+0.4,-0.4);
  glEnd;
  glMaterialfv(GL_FRONT,GL_EMISSION,@black);

  glBegin(GL_POLYGON); {bottom face}
    glVertex3f(-0.4,-0.4,+0.4);
    glVertex3f(-0.4,-0.4,-0.4);
    glVertex3f(+0.4,-0.4,-0.4);
    glVertex3f(+0.4,-0.4,+0.4);
  glEnd;

  glBegin(GL_POLYGON); {top face}
    glVertex3f(-0.4,+0.4,+0.4);
    glVertex3f(+0.4,+0.4,+0.4);
    glVertex3f(+0.4,+0.4,-0.4);
    glVertex3f(-0.4,+0.4,-0.4);
  glEnd;
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  if not openGLReady then
    exit;
  glViewPort(0,0,ClientWidth,ClientHeight);

  errorCode := glGetError;
  if errorCode<>GL_NO_ERROR then
    raise Exception.Create('FormResize:'+gluErrorString(errorCode));
  if (ClientWidth<=oldw) and (ClientHeight<=oldh) then
    FormPaint(Sender);
  oldh := ClientHeight;
  oldw := ClientWidth;
end;

procedure TForm1.ExceptionGL(Sender:TObject;E:Exception);
begin
  ShowMessage(E.Message);
  repeat
    errorCode := glGetError;
    if errorCode<>GL_NO_ERROR then
      showMessage(gluErrorString(errorCode));
  until errorCode=GL_NO_ERROR;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
var
  ok: boolean;
begin
  ok := true;
  case Key of
    '+': sign := 0.1;
    '-': sign := -0.1;
    'X': x1 := x1+sign;
    'x': x2 := x2+sign;
    'Y': y1 := y1+sign;
    'y': y2 := y2+sign;
    'Z': z1 := z1+sign;
    'z': z2 := z2+sign;
    'a': angle2 := angle2+10.0*sign;
    'r': xr2 := xr2+sign;
    's': yr2 := yr2+sign;
    't': zr2 := zr2+sign;
    'A': angle1 := angle1+10.0*sign;
    'R': xr1 := xr1+sign;
    'S': yr1 := yr1+sign;
    'T': zr1 := zr1+sign;
    'B': before := true;
    'b': before := false;
    'l': xl := xl+3.0*sign;
    'm': yl := yl+3.0*sign;
    'n': zl := zl+3.0*sign;
    'k': anglel := anglel+30.0*sign;
    'o': xrl := xrl+3.0*sign;
    'p': yrl := yrl+3.0*sign;
    'q': zrl := zrl+3.0*sign;
    else
      ok := false;
  end; {case}
  if ok then
    Invalidate;
end;

procedure TForm1.Axes;
begin
  glLineWidth(3.0);
  glBegin(GL_LINES);
    glColor3f(0.0,0.0,0.0);

    glVertex3f(+0.0,+0.0,+0.4);
    glVertex3f(+0.0,+0.0,-0.4);

    glVertex3f(+0.4,+0.0,+0.0);
    glVertex3f(-0.4,+0.0,+0.0);

    glVertex3f(+0.0,+0.4,+0.0);
    glVertex3f(+0.0,-0.4,+0.0);
  glEnd;

  glLineWidth(1.0);
  glBegin(GL_LINES);
    glColor3f(1.0,1.0,0.0);
    glVertex3f(0.0,0.0,0.0);
    glVertex3f(xr1,yr1,zr1);

    glColor3f(0.0,1.0,1.0); 
    glVertex3f(0.0,0.0,0.0);
    glVertex3f(xr2,yr2,zr2);
  glEnd;
end;

end.
