MG: splitted gtkglarea demo in example and component

git-svn-id: trunk@1611 -
2025-09-30 00:31:20 +02:00 · 2002-04-15 13:12:34 +00:00 · 2002-04-15 13:12:34 +00:00 · 625ac9a73c
commit 625ac9a73c
parent 55dd8f21ab
12 changed files with 843 additions and 496 deletions
--- a/.gitattributes
+++ b/.gitattributes
@ -28,13 +28,7 @@ components/codetools/resourcecodetool.pas svneol=native#text/pascal
 components/codetools/sourcechanger.pas svneol=native#text/pascal
 components/codetools/sourcelog.pas svneol=native#text/pascal
 components/codetools/stdcodetools.pas svneol=native#text/pascal
-components/gtk/gtkglarea/data/particle.bmp -text svneol=native#image/bmp
-components/gtk/gtkglarea/data/texture1.bmp -text svneol=native#image/bmp
-components/gtk/gtkglarea/data/texture2.bmp -text svneol=native#image/bmp
-components/gtk/gtkglarea/data/texture3.bmp -text svneol=native#image/bmp
-components/gtk/gtkglarea/exampleform.pp svneol=native#text/pascal
 components/gtk/gtkglarea/gtkglarea.pp svneol=native#text/pascal
-components/gtk/gtkglarea/gtkglarea_demo.pp svneol=native#text/pascal
 components/gtk/gtkglarea/gtkglarea_int.pp svneol=native#text/pascal
 components/gtk/gtkglarea/nvgl.pp svneol=native#text/pascal
 components/synedit/allunits.pp svneol=native#text/pascal
@ -99,6 +93,13 @@ examples/comdialogs.pp svneol=native#text/pascal
 examples/dlgform.pp svneol=native#text/pascal
 examples/edittest.pp svneol=native#text/pascal
 examples/groupbox.pp svneol=native#text/pascal
+examples/gtkglarea/data/particle.bmp -text svneol=unset#image/bmp
+examples/gtkglarea/data/texture1.bmp -text svneol=unset#image/bmp
+examples/gtkglarea/data/texture2.bmp -text svneol=unset#image/bmp
+examples/gtkglarea/data/texture3.bmp -text svneol=unset#image/bmp
+examples/gtkglarea/exampleform.pp svneol=native#text/pascal
+examples/gtkglarea/gtkglarea_demo.lpi svneol=native#text/plain
+examples/gtkglarea/gtkglarea_demo.pp svneol=native#text/pascal
 examples/hello.pp svneol=native#text/pascal
 examples/helloform.pp svneol=native#text/pascal
 examples/listboxtest.pp svneol=native#text/pascal
--- a/components/gtk/gtkglarea/Makefile
+++ b/components/gtk/gtkglarea/Makefile
--- a/components/gtk/gtkglarea/Makefile.fpc
+++ b/components/gtk/gtkglarea/Makefile.fpc
@ -4,15 +4,16 @@
 #

 [package]
-#name=lazarus-gtkglarea
-name=lazarus
+name=lazarus-gtkglarea
 version=0.8a

 [target]
-units=gtkglarea_int nvgl gtkglarea exampleform gtkglarea_demo
-   
+units=gtkglarea
+implicitunits=gtkglarea_int nvgl gtkglarea
+

 [default]
+
            
 [compiler]
 options=-gl -k-lGL
@ -22,7 +23,6 @@ unitdir=. ../../../lcl/units ../../../lcl/units/gtk
 packages=rtl fcl gtk opengl

 [clean]
-files=gtkglarea_demo

 [install]

@ -32,14 +32,6 @@ zipname=lazarus.gtkglarea.$(ZIPSUFFIX)
 [rules]
 .PHONY: cleartarget all makefile makefiles

-cleartarget:
-        -$(DEL) gtkglarea_demo
-
-all: cleartarget gtkglarea_demo$(PPUEXT)
-
-makefile: Makefile.fpc
-        -$(FPCMAKE) -w
-       
-makefiles: makefile
+all: cleartarget

 # end.
--- a/components/gtk/gtkglarea/data/texture1.bmp
+++ b/components/gtk/gtkglarea/data/texture1.bmp
--- a/components/gtk/gtkglarea/data/texture2.bmp
+++ b/components/gtk/gtkglarea/data/texture2.bmp
--- a/components/gtk/gtkglarea/data/particle.bmp
+++ b/components/gtk/gtkglarea/data/particle.bmp
--- a/examples/gtkglarea/data/texture1.bmp
+++ b/examples/gtkglarea/data/texture1.bmp
--- a/examples/gtkglarea/data/texture2.bmp
+++ b/examples/gtkglarea/data/texture2.bmp
--- a/components/gtk/gtkglarea/data/texture3.bmp
+++ b/components/gtk/gtkglarea/data/texture3.bmp
--- a/components/gtk/gtkglarea/exampleform.pp
+++ b/components/gtk/gtkglarea/exampleform.pp
@ -28,8 +28,8 @@ unit ExampleForm;
 interface

 uses
-  Classes, SysUtils, GTKGlArea, gtkglarea_int, Forms, LResources, Buttons, StdCtrls,
-  gtk, glib, NVGL, linux;
+  Classes, SysUtils, GTKGlArea, gtkglarea_int, Forms, LResources, Buttons,
+  StdCtrls, gtk, glib, NVGL, Linux;

 type
  TglTexture = class
@ -62,7 +62,7 @@ type
    procedure GTKGLAreaControl1Paint(Sender: TObject);
    procedure GTKGLAreaControl1Resize(Sender: TObject);
  public
-    constructor Create(AOwner: TComponent); override;
+    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
  private
    AreaInitialized: boolean;
@ -106,7 +106,7 @@ var direction: boolean;
 implementation


-{function LoadFileToMemStream(const Filename: string): TMemoryStream;
+function LoadFileToMemStream(const Filename: string): TMemoryStream;
 var FileStream: TFileStream;
 begin
  Result:=TMemoryStream.Create;
@ -121,10 +121,11 @@ begin
  except
    Result.Free;
    Result:=nil;
-  end;  
+    raise Exception.Create('File not found: '+Filename);
+  end;
 end;

-function LoadglTexImage2DFromBitmapFile(const Filename:string; 
+function LoadglTexImage2DFromBitmapFile(Filename:string;
  var Image:TglTexture): boolean;
 type
  TBITMAPFILEHEADER = packed record
@ -163,153 +164,6 @@ type

  PBITMAPINFO = ^BITMAPINFO;

-  //TBitsObj = array[1..1] of byte;
-  //PBitsObj = ^TBitsObj;
-
-  TRawImage = packed record
-     p:array[0..0] of byte;
-   end;
-  PRawImage = ^TRawImage;
-
-const
-  BI_RGB = 0;
-
-var
-  MemStream: TMemoryStream;
-  BmpHead: TBitmapFileHeader;
-  BmpInfo:PBitmapInfo;
-  ImgSize:longint;
-  InfoSize, PixelCount, i:integer;
-  BitsPerPixel:integer;
-  AnRGBQuad: RGBQUAD;
-begin
-  Result:=false;
-  MemStream:=LoadFileToMemStream(Filename);
-  if MemStream=nil then begin
-    writeln('Unable to load "',Filename,'"');
-    exit;
-  end;
-  try
-    if (MemStream.Read(BmpHead, sizeof(BmpHead))<sizeof(BmpHead))
-    or (BmpHead.bfType <> $4D42) then begin
-      writeln('Invalid windows bitmap (header)');
-      exit;
-    end;
-    InfoSize:=BmpHead.bfOffBits-SizeOf(BmpHead);
-    GetMem(BmpInfo,InfoSize);
-    try
-      if MemStream.Read(BmpInfo^,InfoSize)<>InfoSize then begin
-        writeln('Invalid windows bitmap (info)');
-        exit;
-      end;
-      if BmpInfo^.bmiHeader.biSize<>sizeof(BitmapInfoHeader) then begin
-        writeln('OS2 bitmaps are not supported yet');
-        exit;
-      end;
-      if BmpInfo^.bmiHeader.biCompression<>bi_RGB then begin
-        writeln('RLE compression is not supported yet');
-        exit;
-      end;
-      BitsPerPixel:=BmpInfo^.bmiHeader.biBitCount;
-      if BitsPerPixel<>24 then begin
-        writeln('Only truecolor bitmaps supported yet');
-        exit;
-      end;
-      ImgSize:=BmpInfo^.bmiHeader.biSizeImage;
-      if MemStream.Size-MemStream.Position<ImgSize then begin
-        writeln('Invalid windows bitmap (bits)');
-        exit;
-      end;
-      Image.Width:=BmpInfo^.bmiHeader.biWidth;
-      Image.Height:=BmpInfo^.bmiHeader.biHeight;
-      PixelCount:=Image.Width*Image.Height;
-      GetMem(Image.Data,PixelCount * 3);
-      try
-        try
-          for i:=0 to PixelCount-1 do begin
-            MemStream.Read(AnRGBQuad,sizeOf(RGBQuad));}
-            {$IFOPT R+}{$DEFINE RangeCheckOn}{$R-}{$ENDIF}
-            {with PRawImage(Image.Data)^ do begin
-              p[i*3+0]:=AnRGBQuad.rgbRed;
-              p[i*3+1]:=AnRGBQuad.rgbGreen;
-              p[i*3+2]:=AnRGBQuad.rgbBlue;
-            end;}
-            {$IFDEF RangeCheckOn}{$R+}{$ENDIF}
-          {end;
-        except
-          writeln('Error converting bitmap');
-          exit;
-        end;
-      finally
-        FreeMem(Image.Data);
-        Image.Data:=nil;
-      end;
-    finally
-      FreeMem(BmpInfo);
-    end;
-    Result:=true;
-  finally
-    MemStream.Free;
-  end;
-  Result:=true;
-end;
-}
-function LoadFileToMemStream(Filename: string): TMemoryStream;
-var FileStream: TFileStream;
-begin
-  Result:=TMemoryStream.Create;
-  try
-    FileStream:=TFileStream.Create(Filename, fmOpenRead);
-    try
-      Result.CopyFrom(FileStream,FileStream.Size);
-      Result.Position:=0;
-    finally
-      FileStream.Free;
-    end;
-  except
-    Result.Free;
-    Result:=nil;
-  end;
-end;
-
-function LoadglTexImage2DFromBitmapFile(Filename:string; var Image:TglTexture): boolean;
-type
-  TBITMAPFILEHEADER = packed record
-    bfType: Word;
-    bfSize: DWORD;
-    bfReserved1: Word;
-    bfReserved2: Word;
-    bfOffBits: DWORD;
-  end;
-
-  BITMAPINFOHEADER = packed record
-          biSize : DWORD;
-          biWidth : Longint;
-          biHeight : Longint;
-          biPlanes : WORD;
-          biBitCount : WORD;
-          biCompression : DWORD;
-          biSizeImage : DWORD;
-          biXPelsPerMeter : Longint;
-          biYPelsPerMeter : Longint;
-          biClrUsed : DWORD;
-          biClrImportant : DWORD;
-       end;
-
-  RGBQUAD = packed record
-          rgbBlue : BYTE;
-          rgbGreen : BYTE;
-          rgbRed : BYTE;
-       //   rgbReserved : BYTE;
-       end;
-
-  BITMAPINFO = packed record
-          bmiHeader : BITMAPINFOHEADER;
-          bmiColors : array[0..0] of RGBQUAD;
-       end;
-
-  PBITMAPINFO = ^BITMAPINFO;
-
  TRawImage = packed record
     p:array[0..0] of byte;
   end;
@ -392,9 +246,9 @@ end;



-constructor TExampleForm.Create(AOwner: TComponent);
+constructor TExampleForm.Create(TheOwner: TComponent);
 begin
-  inherited Create(AOwner);
+  inherited Create(TheOwner);
  if LazarusResources.Find(ClassName)=nil then begin
    SetBounds((Screen.Width-800) div 2,(Screen.Height-600) div 2,800,600);
    Caption:='LCL Example for the gtkglarea component';
@ -490,7 +344,7 @@ begin
    
    // resize the components first, since the gtkglarea needs some time to setup
    FormResize(Self);
-    AreaInitialized:=false;
+
    GTKGLAreaControl1:=TGTKGLAreaControl.Create(Self);
    with GTKGLAreaControl1 do begin
      Name:='GTKGLAreaControl1';
@ -501,7 +355,6 @@ begin
      Visible:=true;
    end;

-    
  end;
  // now resize
  FormResize(Self);
@ -552,7 +405,10 @@ procedure TParticleEngine.RespawnParticle(i: integer);
 begin
  if (xspawn>2) and (direction=true) then direction:=false;
  if (xspawn<-2) and (direction=false) then direction:=true;
-  if direction then xspawn:=xspawn+0.0002*(timer/10) else xspawn:=xspawn-0.0002*(timer/10);
+  if direction then
+    xspawn:=xspawn+0.0002*(timer/10)
+  else
+    xspawn:=xspawn-0.0002*(timer/10);
  Particle[i].x:=xspawn;
  Particle[i].y:=-0.5;
  Particle[i].z:=0;
@ -894,10 +750,11 @@ begin
      glLoadIdentity ();               { define the projection }
      glFrustum (-1.0, 1.0, -1.0, 1.0, 1.5, 20.0); { transformation } 
      glMatrixMode (GL_MODELVIEW);  { back to modelview matrix }
-      glViewport (0, 0, GTKGLAreaControl1.Width, GTKGLAreaControl1.Height);      { define the viewport }
+      glViewport (0, 0, GTKGLAreaControl1.Width, GTKGLAreaControl1.Height);
+                                    { define the viewport }
      AreaInitialized:=true;
    end;
-    
+
    GetTime(hour, minutes, secs, msecs, usecs);
    timer:=msecs-mmsecs;
    if timer<0 then timer:=1000+timer;
@ -966,10 +823,9 @@ end;

 procedure TExampleForm.GTKGLAreaControl1Resize(Sender: TObject);
 begin
-  if (AreaInitialized) and (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.widget)) then
-    {glViewport(0, 0, PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.width,
-      PGtkWidget(GTKGLAreaControl1.Widget)^.allocation.height);}
-    glViewport (0, 0, GTKGLAreaControl1.Width, GTKGLAreaControl1.Height);  
+  if (AreaInitialized)
+  and (gint(True) = gtk_gl_area_make_current(GTKGLAreaControl1.widget)) then
+    glViewport (0, 0, GTKGLAreaControl1.Width, GTKGLAreaControl1.Height);
 end;


--- a/examples/gtkglarea/gtkglarea_demo.lpi
+++ b/examples/gtkglarea/gtkglarea_demo.lpi
@ -0,0 +1,167 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <General>
+      <ProjectType Value="Program"/>
+      <Flags>
+        <SaveClosedFiles Value="True"/>
+        <SaveOnlyProjectUnits Value="True"/>
+      </Flags>
+      <MainUnit Value="0"/>
+      <ActiveEditorIndexAtStart Value="0"/>
+      <IconPath Value=""/>
+      <TargetFileExt Value=""/>
+      <Title Value="gtkglarea_demo"/>
+      <OutputDirectory Value="."/>
+      <UnitOutputDirectory Value="."/>
+      <SrcPath Value="$(LazarusDir)/lcl;$(LazarusDir)/lcl/interfaces/gtk"/>
+    </General>
+    <Bookmarks Count="0"/>
+    <JumpHistory Count="2" HistoryIndex="1">
+      <Position1>
+        <Filename Value="gtkglarea_demo.pp"/>
+        <Caret Line="27" Column="34" TopLine="1"/>
+      </Position1>
+      <Position2>
+        <Filename Value="exampleform.pp"/>
+        <Caret Line="15" Column="10" TopLine="1"/>
+      </Position2>
+    </JumpHistory>
+    <Units Count="2">
+      <Unit0>
+        <CursorPos X="1" Y="20"/>
+        <EditorIndex Value="0"/>
+        <Filename Value="gtkglarea_demo.pp"/>
+        <FormName Value=""/>
+        <HasResources Value="False"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ReadOnly Value="False"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <TopLine Value="1"/>
+        <UnitName Value="GTKGLArea_Demo"/>
+        <BreakPoints Count="0"/>
+      </Unit0>
+      <Unit1>
+        <CursorPos X="1" Y="1"/>
+        <EditorIndex Value="1"/>
+        <Filename Value="exampleform.pp"/>
+        <FormName Value=""/>
+        <HasResources Value="False"/>
+        <IsPartOfProject Value="True"/>
+        <Loaded Value="True"/>
+        <ReadOnly Value="False"/>
+        <SyntaxHighlighter Value="FreePascal"/>
+        <TopLine Value="1"/>
+        <UnitName Value="ExampleForm"/>
+        <BreakPoints Count="0"/>
+      </Unit1>
+    </Units>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <HostApplicationFilename Value=""/>
+        <CommandLineParams Value=""/>
+        <LaunchingApplication Use="False" PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e bash -i -c '$(TargetCmdLine)'"/>
+        <WorkingDirectory Value=""/>
+        <Display Value=":0"/>
+      </local>
+      <environment>
+        <UserOverrides Count="0"/>
+        <IncludeSystemVariables Value="False"/>
+      </environment>
+    </RunParams>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Target>
+      <Filename Value=""/>
+    </Target>
+    <Parsing>
+      <Style Value="1"/>
+      <SymantecChecking>
+        <D2Extensions Value="True"/>
+        <CStyleOperator Value="True"/>
+        <IncludeAssertionCode Value="False"/>
+        <AllowLabel Value="True"/>
+        <CPPInline Value="True"/>
+        <CStyleMacros Value="False"/>
+        <TPCompatible Value="False"/>
+        <InitConstructor Value="False"/>
+        <StaticKeyword Value="False"/>
+        <DelphiCompat Value="False"/>
+        <UseAnsiStrings Value="False"/>
+        <GPCCompat Value="False"/>
+      </SymantecChecking>
+    </Parsing>
+    <CodeGeneration>
+      <UnitStyle Value="1"/>
+      <Checks>
+        <IOChecks Value="False"/>
+        <RangeChecks Value="False"/>
+        <OverflowChecks Value="False"/>
+        <StackChecks Value="False"/>
+      </Checks>
+      <HeapSize Value="8000000"/>
+      <Generate Value="1"/>
+      <TargetProcessor Value="1"/>
+      <Optimizations>
+        <VariablesInRegisters Value="False"/>
+        <UncertainOptimizations Value="False"/>
+        <OptimizationLevel Value="1"/>
+      </Optimizations>
+      <LinkStyle Value="1"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <GenerateDebugInfo Value="False"/>
+        <GenerateDebugDBX Value="False"/>
+        <UseLineInfoUnit Value="True"/>
+        <UseHeaptrc Value="False"/>
+        <GenGProfCode Value="False"/>
+        <StripSymbols Value="False"/>
+      </Debugging>
+      <Options>
+        <PassLinkerOptions Value="False"/>
+        <LinkerOptions Value=""/>
+      </Options>
+    </Linking>
+    <Other>
+      <Verbosity>
+        <ShowErrors Value="True"/>
+        <ShowWarn Value="True"/>
+        <ShowNotes Value="True"/>
+        <ShowHints Value="True"/>
+        <ShowGenInfo Value="True"/>
+        <ShoLineNum Value="False"/>
+        <ShowAll Value="False"/>
+        <ShowAllProcsOnError Value="False"/>
+        <ShowDebugInfo Value="False"/>
+        <ShowUsedFiles Value="False"/>
+        <ShowTriedFiles Value="False"/>
+        <ShowDefMacros Value="False"/>
+        <ShowCompProc Value="False"/>
+        <ShowCond Value="False"/>
+        <ShowNothing Value="False"/>
+        <ShowHintsForUnusedProjectUnits Value="False"/>
+      </Verbosity>
+      <WriteFPCLogo Value="True"/>
+      <ConfigFile>
+        <DontUseConfigFile Value="False"/>
+        <AdditionalConfigFile Value="False"/>
+        <ConfigFilePath Value="./fpc.cfg"/>
+        <StopAfterErrCount Value="1"/>
+      </ConfigFile>
+    </Other>
+    <SearchPaths>
+      <IncludeFiles Value=""/>
+      <Libraries Value=""/>
+      <OtherUnitFiles Value="$(LazarusDir)/lcl/units;$(LazarusDir)/lcl/units/gtk;$(LazarusDir)/components/gtk/gtkglarea"/>
+      <CompilerPath Value="$(CompPath)"/>
+      <UnitOutputDirectory Value=""/>
+      <LCLWidgetType Value="gtk"/>
+    </SearchPaths>
+  </CompilerOptions>
+  <ProjectSpecificCodeToolsDefines>
+    <Count Value="0"/>
+  </ProjectSpecificCodeToolsDefines>
+</CONFIG>
--- a/components/gtk/gtkglarea/gtkglarea_demo.pp
+++ b/components/gtk/gtkglarea/gtkglarea_demo.pp
@ -19,7 +19,7 @@
 ***************************************************************************

 }
-program gtkglarea_demo;
+program GTKGLArea_Demo;

 {$MODE objfpc}{$H+}