Unit Unit1;


{$MODE objfpc}{$H+}

Interface

Uses
  LCLType, // HBitmap type
  IntfGraphics, // TLazIntfImage type
  fpImage, // TFPColor type
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls,
  gl, glu,
  uosmesa,
  math;

Type

  { TForm1 }

  TForm1 = Class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    SaveDialog1: TSaveDialog;
    Procedure Button1Click(Sender: TObject);
    Procedure Button2Click(Sender: TObject);
    Procedure Button3Click(Sender: TObject);
    Procedure Button4Click(Sender: TObject);
    Procedure Button5Click(Sender: TObject);
    Procedure Button6Click(Sender: TObject);
    Procedure FormCloseQuery(Sender: TObject; Var CanClose: boolean);
    Procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
    Procedure Go2D;
    Procedure Exit2d;
  End;

  TGLVectorf4 = Array[0..3] Of glfloat;

Const
  Sim_Width = 400;
  Sim_Height = 400;

Var
  Form1: TForm1;
  ctx: OSMesaContext;
  Buffer: Array Of Array[0..3] Of byte; //TGLubyte;

Implementation

{ TForm1 }

Function OpenGLScreenshot: TBitmap;
Var
  dim: Array[0..3] Of Integer;
  c: Array Of Array[0..3] Of Byte;
  z, i, j: integer;
  TempIntfImg: TLazIntfImage;
  ImgHandle, ImgMaskHandle: HBitmap;
  CurColor: TFPColor;
Begin
  // Auslesen der Framebuffer Auflösung
  glGetIntegerv(GL_VIEWPORT, @dim[0]);
  // Erstellen des Bitmaps
  result := TBitmap.create;
  result.pixelformat := pf24bit;
  result.width := dim[2];
  result.height := dim[3];
  TempIntfImg := TLazIntfImage.Create(0, 0);
  TempIntfImg.LoadFromBitmap(result.Handle, result.MaskHandle);
  setlength(c, dim[2] * dim[3]);
  // Auslesen des Framebuffers in einen temporären Speicher
  glReadPixels(dim[0], dim[1], dim[2], dim[3], GL_RGBA, GL_UNSIGNED_BYTE, @c[0, 0]);
  // Umschreiben des Temporären Speichers in das TBitmap
  z := 0;
  For j := 0 To result.height - 1 Do
    For i := 0 To result.width - 1 Do Begin
      CurColor.red := c[z][0] * 256;
      CurColor.green := c[z][1] * 256;
      CurColor.blue := c[z][2] * 256;
      // c[z][3] wäre der Alphakanal, aber den Braucht man ja hier nicht ...
      TempIntfImg.Colors[i, result.height - 1 - j] := CurColor;
      inc(z);
    End;
  TempIntfImg.CreateBitmaps(ImgHandle, ImgMaskHandle, false);
  result.Handle := ImgHandle;
  result.MaskHandle := ImgMaskHandle;
  TempIntfImg.free;
End;


Procedure TForm1.Go2D;
Begin
  glMatrixMode(GL_PROJECTION);
  glPushMatrix(); // Store The Projection Matrix
  glLoadIdentity(); // Reset The Projection Matrix
  (*
  2D-Mode wie Windows, oben Links = (0,0)
  *)
  glOrtho(0, Sim_Width, Sim_Height, 0, -1, 1); // Set Up An Ortho Screen
  glMatrixMode(GL_MODELVIEW);
  glPushMatrix(); // Store old Modelview Matrix
  glLoadIdentity(); // Reset The Modelview Matrix
End;

Procedure TForm1.Exit2d;
Begin
  glMatrixMode(GL_MODELVIEW);
  glPopMatrix(); // Restore old Projection Matrix
  glMatrixMode(GL_PROJECTION);
  glPopMatrix(); // Restore old Projection Matrix
End;


Procedure TForm1.FormCloseQuery(Sender: TObject; Var CanClose: boolean);
Begin
  setlength(buffer, 0);
  OSMesaDestroyContext(ctx);
End;

Procedure TForm1.Button1Click(Sender: TObject);
Const
  light_ambient: TGLVectorf4 = (0.0, 0.0, 0.0, 1.0);
  light_diffuse: TGLVectorf4 = (1.0, 1.0, 1.0, 1.0);
  light_specular: TGLVectorf4 = (1.0, 1.0, 1.0, 1.0);
  light_position: TGLVectorf4 = (1.0, 1.0, 1.0, 0.0);
  //  red_mat: TGLVectorf4 = (1.0, 0.2, 0.2, 1.0);
  green_mat: TGLVectorf4 = (0.2, 1.0, 0.2, 0.5);
  blue_mat: TGLVectorf4 = (0.2, 0.2, 1.0, 1.0);
  //  white_mat: TGLVectorf4 = (1.0, 1.0, 1.0, 1.0);
  //  purple_mat: TGLVectorf4 = (1.0, 0.2, 1.0, 1.0);
Var
  qobj: PGLUQuadricObj;
Begin
  qobj := gluNewQuadric();
  glLightfv(GL_LIGHT0, GL_AMBIENT, @light_ambient[0]);
  glLightfv(GL_LIGHT0, GL_DIFFUSE, @light_diffuse[0]);
  glLightfv(GL_LIGHT0, GL_SPECULAR, @light_specular[0]);
  glLightfv(GL_LIGHT0, GL_POSITION, @light_position[0]);
  glEnable(GL_LIGHTING);
  glEnable(GL_LIGHT0);
  glEnable(GL_DEPTH_TEST);

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  glOrtho(-2.5, 2.5, -2.5, 2.5, -10.0, 10.0);
  glMatrixMode(GL_MODELVIEW);
  glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT);

  glPushMatrix();
  glRotatef(20.0, 1.0, 0.0, 0.0);
  (* red square *)
  glPushMatrix();
  glTranslatef(0.0, -0.5, 0.0);
  glRotatef(90, 1, 0.5, 0);
  glScalef(3, 3, 3);
  glDisable(GL_LIGHTING);
  glColor4f(1, 0, 0, 0.5);
  glBegin(GL_POLYGON);
  glVertex2f(-1, -1);
  glVertex2f(1, -1);
  glVertex2f(1, 1);
  glVertex2f(-1, 1);
  glEnd();
  glEnable(GL_LIGHTING);
  glPopMatrix();

  glPushMatrix();
  glTranslatef(-0.75, -0.5, 0.0);
  glRotatef(270.0, 1.0, 0.0, 0.0);
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @green_mat);
  glColor4f(0, 1, 0, 0.5);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  gluCylinder(qobj, 1.0, 0.0, 2.0, 16, 1);
  glDisable(GL_BLEND);
  glPopMatrix();

  glPushMatrix();
  glTranslatef(0.75, 1.0, 1.0);
  glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT_AND_DIFFUSE, @blue_mat);
  gluSphere(qobj, 1.0, 20, 20);
  glPopMatrix();

  glPopMatrix();

  (* This is very important!!!
   * Make sure buffered commands are finished!!!
   *)
  glFinish();

  gluDeleteQuadric(qobj); // }
  {
  go2d;
  glclear(GL_COLOR_BUFFER_BIT);
  glcolor3f(1, 0, 0);
  glbegin(gl_quads);
  glvertex3f(10, 10, 0);
  glvertex3f(10 + 100, 10, 0);
  glvertex3f(10 + 100, 10 + 100, 0);
  glvertex3f(10, 10 + 100, 0);
  glend();
  glFinish();
  exit2d;
  //}
End;

Procedure TForm1.Button2Click(Sender: TObject);
Var
  b: TBitmap;
Begin
  If Savedialog1.execute Then Begin
    b := OpenGLScreenshot;
    b.SaveToFile(Savedialog1.FileName);
    b.free;
  End;
End;

Procedure TForm1.Button3Click(Sender: TObject);
//Const
//  t = 50;
//  l = 10;
Var
  i: Integer;
  //  z,  j: Integer;
Begin
  For i := 0 To High(Buffer) Do Begin
    If (buffer[i, 0] <> 0) Or
      (buffer[i, 1] <> 0) Or
      (buffer[i, 2] <> 0) Then Begin
      showmessage('Juhu');
      break;
    End;
  End;
  {  i := 0;
    j := -1;
    For z := 0 To High(buffer) Do Begin
      If (z Mod sim_width = 0) Then Begin
        inc(j);
        i := 0;
      End;
      //    canvas.Pixels[i + l, j + t] :=
      //      RGBToColor(
      //      buffer[z, 0] Shr 8
      //      ,
      //      buffer[z, 1] Shr 8
      //      ,
      //      buffer[z, 2] Shr 8
      //      );
      If (buffer[z, 0] <> 0) Or
        (buffer[z, 1] <> 0) Or
        (buffer[z, 2] <> 0) Then Begin
        showmessage('juhu');
      End;
      canvas.Pixels[i + l, j + t] :=
        RGBToColor(
        min(255, max(0, round(buffer[z, 0] * 255)))
        ,
        min(255, max(0, round(buffer[z, 1] * 255)))
        ,
        min(255, max(0, round(buffer[z, 2] * 255)))
        );
      inc(i);
    End;
}End;

Procedure TForm1.Button4Click(Sender: TObject);
Var
  b: Tbitmap;
Begin
  b := OpenGLScreenshot;
  canvas.draw(10, 50, b);
  b.free;
End;

Procedure TForm1.Button5Click(Sender: TObject);
Var
  j: PGLint;
  s: String;
Begin
  new(j);
  s := 'Aktuel Width : ';
  OSMesaGetIntegerv(OSMESA_WIDTH, j);
  s := s + inttostr(j^) + ', Aktual Height : ';
  OSMesaGetIntegerv(OSMESA_HEIGHT, j);
  s := s + inttostr(j^) + #13#10'Max Width : ';
  OSMesaGetIntegerv(OSMESA_MAX_WIDTH, j);
  s := s + inttostr(j^) + ', Max Height : ';
  OSMesaGetIntegerv(OSMESA_MAX_HEIGHT, j);
  s := s + inttostr(j^) + #13#10'Aktual Format : ';
  OSMesaGetIntegerv(OSMESA_FORMAT, j);
  s := s + inttostr(j^) + #13#10'Aktual Type : ';
  OSMesaGetIntegerv(OSMESA_TYPE, j);
  s := s + inttostr(j^) + #13#10'Bits per color Channel : (';
  glGetIntegerv(GL_RED_BITS, j);
  s := s + inttostr(j^) + ',';
  glGetIntegerv(GL_GREEN_BITS, j);
  s := s + inttostr(j^) + ',';
  glGetIntegerv(GL_BLUE_BITS, j);
  s := s + inttostr(j^) + ',';
  glGetIntegerv(GL_ALPHA_BITS, j);
  s := s + inttostr(j^) + ')'; //}
  showmessage(s);
  dispose(j);
End;

Procedure TForm1.Button6Click(Sender: TObject);
Begin
  close;
End;

Procedure TForm1.FormCreate(Sender: TObject);
Var
  s1, s2: String;
Begin
  s1 := IncludeTrailingPathDelimiter(ExtractFilePath(paramstr(0))) + 'libGL.so.1';
  //  s1 := '/usr/lib/libGL.so.1';
  s2 := IncludeTrailingPathDelimiter(ExtractFilePath(paramstr(0))) + 'libGLU.so.1';
  //  s2 := '/usr/lib/libGLU.so.1';
  If Not Fileexists(s1) Then Begin
    Showmessage('Error could not find "' + s1 + '"');
    halt;
  End;
  If Not Fileexists(s2) Then Begin
    Showmessage('Error could not find "' + s2 + '"');
    halt;
  End;
  LoadOpenGL(s1);
  LoadGLu(s2);
  s1 := IncludeTrailingPathDelimiter(ExtractFilePath(paramstr(0))) + 'libOSMesa.so';
  //  s1 := '/lib/libOSMesa32.so';
  //  s1 := '/lib/libOSMesa.so';
  If Not Fileexists(s1) Then Begin
    Showmessage('Error could not find "' + s1 + '"');
    halt;
  End;
  If Not InitOSMesa(s1) Then Begin
    Showmessage('Error could not init OSMesa');
    halt;
  End;
  ctx := OSMesaCreateContextExt(gl_RGBA, 16, 0, 0, Nil);
  If Not assigned(ctx) Then Begin
    showmessage('Error "OSMesaCreateContextExt" failed.');
    close;
  End;

  glClearColor(0.0, 0.0, 0.0, 0.0);
  (*  Der AusgabeBuffer *)
  setlength(Buffer, Sim_Height * Sim_width);
  If (OSMesaMakeCurrent(ctx, @buffer[0, 0], GL_UNSIGNED_BYTE, Sim_width, Sim_Height) = 0) Then Begin
    showmessage('Error "OSMesaMakeCurrent" failed.');
    close;
  End;
  //  If (OSMesaMakeCurrent(ctx, @buffer[0], GL_FLOAT, Sim_width, Sim_Height) = 0) Then Begin
  //    showmessage('Error "OSMesaMakeCurrent" failed.');
  //    close;
  //  End;
End;

Initialization
{$I unit1.lrs}

End.