unit Main;

interface

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

const
  FLightAmbient : Array[0..3] of GLfloat = (0.1, 0.1, 0.1, 1.0);
  FLightDiffuse : Array[0..3] of GLfloat = (0.6, 0.6, 0.6, 1.0);
  FLightSpecular: Array[0..3] of GLfloat = (0.1, 0.1, 0.1, 1.0);
  FMaterialColor: Array[0..3] of GLfloat = (1.2, 0.5, 0.2, 1.0);

type

  TShapeChoice = (scwSphere, scwCube, scwTorus, scwTeaPot, scwOcta,
               scwTetra, scwIsco, scwDodec, scwCone, scsSphere, scsCube,
                scsTorus, scsTeaPot, scsOcta, scsTetra, scsIsco, scsDodec,
                 scsCone, scNone);

  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    Clear1: TMenuItem;
    Reset1: TMenuItem;
    Axes1: TMenuItem;
    Cube1: TMenuItem;
    Rotate1: TMenuItem;
    Translate1: TMenuItem;
    Cone1: TMenuItem;
    Sphere1: TMenuItem;
    Primitives1: TMenuItem;
    Torus1: TMenuItem;
    TeaPot1: TMenuItem;
    X1: TMenuItem;
    Y1: TMenuItem;
    Z1: TMenuItem;
    X2: TMenuItem;
    Y2: TMenuItem;
    Z2: TMenuItem;
    Tetrahedron1: TMenuItem;
    Iscos1: TMenuItem;
    Octaheadron1: TMenuItem;
    Dodecahedron1: TMenuItem;
    WireFrame1: TMenuItem;
    Solid1: TMenuItem;
    Cone2: TMenuItem;
    Cube2: TMenuItem;
    Sphere2: TMenuItem;
    TeaPot2: TMenuItem;
    Torus2: TMenuItem;
    Tetrahedron2: TMenuItem;
    Icosahedron1: TMenuItem;
    Octaheadron2: TMenuItem;
    Dodecahedron2: TMenuItem;
    Timer1: TTimer;
    Auto1: TMenuItem;
    N1: TMenuItem;
    pnlCoords: TPanel;
    Show1: TMenuItem;
    RestrictX1: TMenuItem;
    RestrictY1: TMenuItem;
    RestrictZ1: TMenuItem;
    N2: TMenuItem;
    Transform1: TMenuItem;
    N3: TMenuItem;
    Mouse1: TMenuItem;
    procedure Clear1Click(Sender: TObject);
    procedure Reset1Click(Sender: TObject);
    procedure Axes1Click(Sender: TObject);
    procedure Cube1Click(Sender: TObject);
    procedure Rotate1Click(Sender: TObject);
    procedure Translate1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Cone(Sender: TObject);
    procedure Sphere1Click(Sender: TObject);
    procedure Torus1Click(Sender: TObject);
    procedure TeaPot1Click(Sender: TObject);
    procedure Y1Click(Sender: TObject);
    procedure X1Click(Sender: TObject);
    procedure Tetrahedron1Click(Sender: TObject);
    procedure Iscos1Click(Sender: TObject);
    procedure Octaheadron1Click(Sender: TObject);
    procedure Dodecahedron1Click(Sender: TObject);
    procedure Y2Click(Sender: TObject);
    procedure Z2Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Cone2Click(Sender: TObject);
    procedure Cube2Click(Sender: TObject);
    procedure Sphere2Click(Sender: TObject);
    procedure TeaPot2Click(Sender: TObject);
    procedure Torus2Click(Sender: TObject);
    procedure Tetrahedron2Click(Sender: TObject);
    procedure Icosahedron1Click(Sender: TObject);
    procedure Octaheadron2Click(Sender: TObject);
    procedure Dodecahedron2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Auto1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RestrictY1Click(Sender: TObject);
    procedure RestrictZ1Click(Sender: TObject);
    procedure RestrictX1Click(Sender: TObject);
  private
    { Private declarations }
    DC: HDC;
    RC: HGLRC;
    Xstart, Ystart: integer;
    Angle: glFloat;
    DragLock, xLock, yLock, zLock: boolean;
    Palette: HPALETTE;
    CurShape: TShapeChoice;
    procedure UpdateShape;
  protected
    procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure WMQueryNewPalette(var Msg: TWMQueryNewPalette); message WM_QUERYNEWPALETTE;
    procedure WMPaletteChanged(var Msg: TWMPaletteChanged); message WM_PALETTECHANGED;
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.UpdateShape;
begin
  if CurShape = scNone then Exit;
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  if Timer1.Enabled then glRotatef(Angle, 0.25, 0.25, 0.25);
  if CurShape = scwCube then begin
    glutWireCube(1.5);
  end
  else if CurShape = scwCone then begin
    glutWireCone(1.25, 2.5, 20, 20);
  end
  else if CurShape = scwSphere then begin
    glutWireSphere(1.5, 20, 20);
  end
  else if CurShape = scwTorus then begin
    glutWireTorus(0.75, 1.25, 20, 20);
  end
  else if CurShape = scwTeaPot then begin
    glutWireTeaPot(1.25);
  end
  else if CurShape = scwOcta then begin
    glutWireOctaheadron;
  end
  else if CurShape = scwTetra then begin
    glutWireTetrahedron;
  end
  else if CurShape = scwIsco then begin
    glutWireIcosahedron;
  end
  else if CurShape = scwDodec then begin
    glutWireDodecahedron;
  end
  else if CurShape = scsCube then begin
    glutSolidCube(1.5);
  end
  else if CurShape = scsCone then begin
    glutSolidCone(1.25, 2.5, 20, 20);
  end
  else if CurShape = scsSphere then begin
    glutSolidSphere(1.5, 20, 20);
  end
  else if CurShape = scsTorus then begin
    glutSolidTorus(0.75, 1.25, 20, 20);
  end
  else if CurShape = scsTeaPot then begin
    glutSolidTeaPot(1.25);
  end
  else if CurShape = scsOcta then begin
    glutSolidOctaheadron;
  end
  else if CurShape = scsTetra then begin
    glutSolidTetrahedron;
  end
  else if CurShape = scsIsco then begin
    glutSolidIcosahedron;
  end
  else if CurShape = scsDodec then begin
    glutSolidDodecahedron;
  end;
  SwapBuffers(DC);
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  inherited;
  Angle := 0; xStart := 0; yStart := 0;
  xLock := false;
  yLock := true;
  zLock := false;
  DragLock := false;
  Timer1.Enabled := false;
  DC := GetDC(Handle);
  PreparePixelFormat(DC, Palette);
  RC := wglCreateContext(DC);
  wglMakeCurrent(DC, RC);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glLightfv(GL_LIGHT0, GL_AMBIENT, @FLightAmbient);
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @FLightDiffuse);
  glLightfv(GL_LIGHT0, GL_SPECULAR,@FLightSpecular);
  //glEnable(GL_TEXTURE);
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @FMaterialColor);
  glEnable(GL_LIGHTING);
  glEnable(GL_LIGHT0);
  glOrtho(-2, 2, -2, 2, -2, 50);
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  glEnable(GL_DEPTH_TEST);
  //glEnable(GL_CULL_FACE);
  glEnable(GL_LINE_SMOOTH);
  glEnable(GL_NORMALIZE);
  glShadeModel(GL_SMOOTH);
  gluLookAt(2, 4, 6, 0, 0, 0, 0, 1, 0);
  //glPushMatrix;
  SwapBuffers(DC);
  CurShape := scwTorus;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
  wglMakeCurrent(0, 0);
  wglDeleteContext(RC);
  ReleaseDC(Handle, DC);
  if (Palette <> 0) then
    DeleteObject(Palette);
end;

procedure TMainForm.WMPaint(var Msg: TWMPaint);
var
  pStruct: TPaintStruct;
begin
  BeginPaint(Handle, pStruct);
  UpdateShape;
  EndPaint(Handle, pStruct);
end;

procedure TMainForm.WMQueryNewPalette(var Msg: TWMQueryNewPalette);
begin
  if (Palette <> 0) then begin
    Msg.Result := RealizePalette(DC);
    if (Msg.Result <> GDI_ERROR) then
      InvalidateRect(Handle, nil, False);
  end;
end;

procedure TMainForm.WMPaletteChanged(var Msg: TWMPaletteChanged);
begin
  if ((Palette <> 0) and (THandle(TMessage(Msg).wParam) <> Handle)) then begin
    if (RealizePalette(DC) <> GDI_ERROR) then
      UpdateColors(DC);
    Msg.Result := 0;
  end;
end;

procedure TMainForm.FormResize(Sender: TObject);
begin
  inherited;
  //invalidate;
  CenterMaximalViewport(ClientWidth - 1, ClientHeight - 1,
                         ClientWidth, ClientHeight);
  UpdateShape;
end;

procedure TMainForm.Clear1Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  SwapBuffers(DC);
end;

procedure TMainForm.Reset1Click(Sender: TObject);
begin
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  gluLookAt(2, 4, 6, 0, 0, 0, 0, 1, 0);
  UpdateShape;
end;

procedure TMainForm.Axes1Click(Sender: TObject);
begin
  //glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glBegin(GL_LINES);    { move to gl-util unit }
    glColor3f(10.0, 0.0, 0.0);
    glVertex3f(0.0, 0.0, 0.0);
    glVertex3f(10.0, 0.0, 0.0);
    glColor3f(0.0, 10.0, 0.0);
    glVertex3f(0.0, 0.0, 0.0);
    glVertex3f(0.0, 10.0, 0.0);
    glColor3f(0.0, 0.0, 10.0);
    glVertex3f(0.0, 0.0, 0.0);
    glVertex3f(0.0, 0.0, 10.0);
  glEnd;
  //glFlush;
  SwapBuffers(DC);
end;

{-------===========Primatives Menu(s)===========------}

procedure TMainForm.Cube1Click(Sender: TObject);
begin
  CurShape := scwCube;
  UpdateShape;
end;

procedure TMainForm.Cone(Sender: TObject);
begin
  CurShape := scwCone;
  UpdateShape;
end;

procedure TMainForm.Sphere1Click(Sender: TObject);
begin
  CurShape := scwSphere;
  UpdateShape;
end;

procedure TMainForm.Torus1Click(Sender: TObject);
begin
  CurShape := scwTorus;
  UpdateShape;
end;

procedure TMainForm.TeaPot1Click(Sender: TObject);
begin
  CurShape := scwTeaPot;
  UpdateShape;
end;

procedure TMainForm.Tetrahedron1Click(Sender: TObject);
begin
  CurShape := scwTetra;
  UpdateShape;
end;

procedure TMainForm.Iscos1Click(Sender: TObject);
begin
  CurShape := scwIsco;
  UpdateShape;
end;

procedure TMainForm.Octaheadron1Click(Sender: TObject);
begin
  CurShape := scwOcta;
  UpdateShape;
end;

procedure TMainForm.Dodecahedron1Click(Sender: TObject);
begin
  CurShape := scwDodec;
  UpdateShape;
end;

procedure TMainForm.Cone2Click(Sender: TObject);
begin
  CurShape := scsCone;
  UpdateShape;
end;

procedure TMainForm.Cube2Click(Sender: TObject);
begin
  CurShape := scsCube;
  UpdateShape;
end;

procedure TMainForm.Sphere2Click(Sender: TObject);
begin
  CurShape := scsSphere;
  UpdateShape;
end;

procedure TMainForm.TeaPot2Click(Sender: TObject);
begin
  CurShape := scsTeaPot;
  UpdateShape;
end;

procedure TMainForm.Torus2Click(Sender: TObject);
begin
  CurShape := scsTorus;
  UpdateShape;
end;

procedure TMainForm.Tetrahedron2Click(Sender: TObject);
begin
  CurShape := scsTetra;
  UpdateShape;
end;

procedure TMainForm.Icosahedron1Click(Sender: TObject);
begin
  CurShape := scsIsco;
  UpdateShape;
end;

procedure TMainForm.Octaheadron2Click(Sender: TObject);
begin
  CurShape := scsOcta;
  UpdateShape;
end;

procedure TMainForm.Dodecahedron2Click(Sender: TObject);
begin
  CurShape := scsDodec;
  UpdateShape;
end;

{----------------======================--------------------}


{--------==========Transformation Menu(s)==========---------}

procedure TMainForm.Rotate1Click(Sender: TObject);
begin
  //glClear(GL_COLOR_BUFFER_BIT);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glRotatef(25, 0.0, 0.0, 1.0);
  //SwapBuffers(DC);
  //glFlush;
  UpdateShape;
end;

procedure TMainForm.Translate1Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glTranslatef(0.5, 0.0, 0.0);
  //glFlush;
  UpdateShape;
end;

procedure TMainForm.Y1Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glRotatef(25, 0.0, 1.0, 0.0);
  //glFlush;
  UpdateShape;
end;

procedure TMainForm.X1Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glRotatef(25, 1.0, 0.0, 0.0);
  //glFlush;
  UpdateShape;
end;

procedure TMainForm.Y2Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glTranslatef(0.0, 0.5, 0.0);
  //glFlush;
  UpdateShape;
end;

procedure TMainForm.Z2Click(Sender: TObject);
begin
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  glTranslatef(0.0, 0.0, 0.5);
  //glFlush;
  UpdateShape;
end;

{--------------==========================-------------------}


procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  Angle := 10.25;
  //Angle := Angle + 0.05;
  //if (Angle >= 90.0) then
  //  Angle := 0.0;
  InvalidateRect(Handle, nil, False);
end;

procedure TMainForm.Auto1Click(Sender: TObject);
begin
  if Timer1.Enabled then begin
    Timer1.Enabled := false;
    (Sender as TMenuItem).Checked := false;
  end
  else begin
    Timer1.Enabled := true;
    (Sender as TMenuItem).Checked := true;
  end;
end;

procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  xStart := X;
  yStart := Y;
  DragLock := true;
  Screen.Cursor := crSizeNS;
end;

procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Screen.Cursor := crDefault;
  DragLock := false;
end;

procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  //pnlCoords.Caption := '{' + IntToStr(X) + ', ' + IntToStr(Y) + '}';
  if DragLock then begin
    Angle := 10.25;  //Angle + 0.05;
    {if (Angle >= 90.0) then
      Angle := 0.0; }
    if yLock then
      if Y > yStart then glRotatef(Angle, 0.0, -1.0, 0.0)
      else glRotatef(Angle, 0.0, 1.0, 0.0);
    if xLock then
      if Y > YStart then glRotatef(Angle, -1.0, 0.0, 0.0)
      else glRotatef(Angle, 1.0, 0.0, 0.0);
    if zLock then
      if  Y > yStart then glRotatef(Angle, 0.0, 0.0, -1.0)
      else glRotatef(Angle, 0.0, 0.0, 1.0);
    InvalidateRect(Handle, nil, False);
    yStart := Y;
    xStart := X;
  end;
end;

procedure TMainForm.RestrictY1Click(Sender: TObject);
begin
  yLock := true;
  xLock := false;
  zLock := false;
  RestrictY1.Checked := true;
  RestrictX1.Checked := false;
  RestrictZ1.Checked := false;
end;

procedure TMainForm.RestrictZ1Click(Sender: TObject);
begin
  yLock := false;
  xLock := false;
  zLock := true;
  RestrictY1.Checked := false;
  RestrictX1.Checked := false;
  RestrictZ1.Checked := true;
end;

procedure TMainForm.RestrictX1Click(Sender: TObject);
begin
  yLock := false;
  xLock := true;
  zLock := false;
  RestrictY1.Checked := false;
  RestrictX1.Checked := true;
  RestrictZ1.Checked := false;
end;

end.
