pythianproject-cvsmail — receives automatic CVS updates

[Pythianproject-cvsmail] CVS: Prototypes/GLCanvas GLCanvasDemo.cfg,1.2,1.3 GLCanvasDemo.dof,1.2,1.3 MyDraw.pas,1.6,1.7 glCanvas.pas,1.6,1.7

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory slayer.i.sourceforge.net:/tmp/cvs-serv6993

Modified Files:
	GLCanvasDemo.cfg GLCanvasDemo.dof MyDraw.pas glCanvas.pas 
Log Message:
updated to have shapes code, thanks to kamil for that, also uses rearranged TTexture objects now instead of doing things directly -mike

Index: GLCanvasDemo.cfg
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/GLCanvasDemo.cfg,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** GLCanvasDemo.cfg	2000/11/26 20:30:04	1.2
--- GLCanvasDemo.cfg	2000/12/01 18:31:22	1.3
***************
*** 32,37 ****
  -$M16384,1048576
  -K$00400000
! -U"..\..\PythianProject\Source\Units\;..\..\PNG\"
! -O"..\..\PythianProject\Source\Units\;..\..\PNG\"
! -I"..\..\PythianProject\Source\Units\;..\..\PNG\"
! -R"..\..\PythianProject\Source\Units\;..\..\PNG\"
--- 32,37 ----
  -$M16384,1048576
  -K$00400000
! -U"..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\"
! -O"..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\"
! -I"..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\"
! -R"..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\"

Index: GLCanvasDemo.dof
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/GLCanvasDemo.dof,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** GLCanvasDemo.dof	2000/11/26 20:30:04	1.2
--- GLCanvasDemo.dof	2000/12/01 18:31:22	1.3
***************
*** 46,50 ****
  PackageDLLOutputDir=
  PackageDCPOutputDir=
! SearchPath=..\..\PythianProject\Source\Units\;..\..\PNG\
  Packages=VCL40;VCLX40;VCLDB40;VCLDBX40;VCLSMP40;QRPT40;TEEUI40;TEEDB40;TEE40;ibevnt40;nmfast40;Python_d4;PythonVCL_d4;NtfyIcon;glPanelPkg;INDY40
  Conditionals=
--- 46,50 ----
  PackageDLLOutputDir=
  PackageDCPOutputDir=
! SearchPath=..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\
  Packages=VCL40;VCLX40;VCLDB40;VCLDBX40;VCLSMP40;QRPT40;TEEUI40;TEEDB40;TEE40;ibevnt40;nmfast40;Python_d4;PythonVCL_d4;NtfyIcon;glPanelPkg;INDY40
  Conditionals=
***************
*** 84,87 ****
--- 84,88 ----
  
  [Excluded Packages]
+ E:\cvsroot\PythianRoot\PNG\PNGPackage.bpl=PNG Image reader
  $(DELPHI)\Components\Indy\dclIndy40.bpl=Internet Direct "Indy" for D4 Property and Component Editors
  
***************
*** 91,95 ****
  
  [HistoryLists\hlSearchPath]
! Count=2
! Item0=..\..\PythianProject\Source\Units\;..\..\PNG\
! Item1=..\..\PythianProject\Source\Units\
--- 92,97 ----
  
  [HistoryLists\hlSearchPath]
! Count=3
! Item0=..\..\PythianProject\Source\Units\;..\..\PythianProject\Source\PNG\
! Item1=..\..\PythianProject\Source\Units\;..\..\PNG\
! Item2=..\..\PythianProject\Source\Units\

Index: MyDraw.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/MyDraw.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** MyDraw.pas	2000/11/26 20:30:04	1.6
--- MyDraw.pas	2000/12/01 18:31:22	1.7
***************
*** 32,35 ****
--- 32,36 ----
    SampleText :TGLText;
    QuadTextSample :TGLText;
+   Text2 :TGLText;
  
  // You need to implement these three procedures
***************
*** 48,52 ****
--- 49,55 ----
    GLC := TGLCanvas.Create(Width,Height);
    InspectorGadget := TGLBitmap.Create(GLCANVAS_BMP_TEXTURED);
+   InspectorGadget.UseTransparency := true;
    InspectorGadget.LoadFromBitmap('rpg.png');
+ 
    SampleText := TGLText.Create('Hello World', 'Arial', GLCANVAS_TEXT_GLF, GLC_DEFAULT_FONT_DATA);
    SampleText.Precache := true;
***************
*** 87,90 ****
--- 90,95 ----
    SampleText.SetColor(clYellow);
    SampleText.Size := 10.0;
+ 
+   Text2 := TGLText.Create('Test2','Arial',GLCANVAS_TEXT_QUADTEXT,GLC_DEFAULT_FONT_DATA);
  end;
  
***************
*** 95,98 ****
--- 100,104 ----
    SampleText.Free;
    QuadTextSample.Free;
+   Text2.Free;
    GLC.Free;
  end;
***************
*** 113,116 ****
--- 119,125 ----
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
  
+   // now we switch off depth testing, this is to ensure that
+   // things are drawn in order
+   glDisable(GL_DEPTH_TEST);
  
    // this draws the GL bitmap object at these coordinates
***************
*** 120,129 ****
    GLC.DrawBitmap(20,80,InspectorGadget);
  
    // this draws the text objects
    GLC.DrawText(25,400,QuadTextSample);
!   GLC.DrawText(25,100,SampleText);
  
    // this draws a rectangle
!   //GLC.Rectangle(20,300,100,400);
  end;
  
--- 129,144 ----
    GLC.DrawBitmap(20,80,InspectorGadget);
  
+   GLC.DrawText(100,100,Text2);
    // this draws the text objects
    GLC.DrawText(25,400,QuadTextSample);
!   GLC.DrawText(25,100,SampleText); 
  
    // this draws a rectangle
!   GLC.CurrentRed := 1;
!   GLC.CurrentBlue := 1;
!   GLC.CurrentGreen := 1;
!   GLC.FillAlpha := 0.5;
!   GLC.Solid := true;
!   GLC.Rectangle(300,40,400,100);
  end;
  

Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** glCanvas.pas	2000/11/26 20:30:04	1.6
--- glCanvas.pas	2000/12/01 18:31:22	1.7
***************
*** 57,65 ****
        by this operation so if you use scissor rects independantly
        we need to fix this.
  }
  
  interface
  uses OpenGL, Windows, SysUtils, Graphics, glfD, Classes, QuadTextUnit,
!      Textures, FastDIB, FastFiles, PNGImage;
  
  const
--- 57,73 ----
        by this operation so if you use scissor rects independantly
        we need to fix this.
+ 
+     * WARNING: This may be just my dodgy drivers, but in windowed
+       mode 0,0 does not appear to be the top left of the screen
+       because of the borders. In fact, if you specify anything
+       less that 25 for the Y coord of a rectangle my machine locks
+       up, where 22 is the height of a titlebar. I have no idea why
+       this should be so, probably a bug in Microsofts code, but
+       you have been warned.
  }
  
  interface
  uses OpenGL, Windows, SysUtils, Graphics, glfD, Classes, QuadTextUnit,
!      Textures, FastDIB, FastFiles, PNGImage, Points;
  
  const
***************
*** 77,81 ****
    TTexBMPData = record
      DisplayList :integer;
!     TexIDs :array[1..GLC_MAXTEXIDS] of Cardinal;
      cellsWidth, cellsHeight :integer;
      Width,Height:integer;
--- 85,90 ----
    TTexBMPData = record
      DisplayList :integer;
!     //TexIDs :array[1..GLC_MAXTEXIDS] of Cardinal;
!     Textures :array[1..GLC_MAXTEXIDS] of TTexture;
      cellsWidth, cellsHeight :integer;
      Width,Height:integer;
***************
*** 148,152 ****
      constructor Create(aType:integer);
      destructor Destroy; override ;
-     // @@todo - alpha transparency support
      function BitmapToPixData(B :TFastDIB):pointer;
      function LoadFromBitmap(B:TFastDIB):integer; overload;
--- 157,160 ----
***************
*** 225,228 ****
--- 233,237 ----
      procedure SetColor(const Value: TColor);
    public
+     Solid :boolean;
      property Width:integer read FWidth;
      property Height:integer read FHeight;
***************
*** 255,264 ****
      // shape routines here - will standardise on the american spelling of colo(u)r
  
!     procedure Rectangle(Top,Left,Bottom,Right:integer); virtual ;
    end;
  
  function MakeTexturesFromBmp(var aBMP:TFastDIB; useTransparency:boolean; transparentColor:TFColor):TTexBMPData; // returns display list
  procedure DeleteTexBMP(bmp:TTexBMPData);
- procedure GenTexFromBMP(BMP:TFastDIB; tx:integer; useTransparency:boolean; transparentColor:TFColor);
  // ox = origin x (ie draws part of the bitmap)
  // oy = origin y
--- 264,272 ----
      // shape routines here - will standardise on the american spelling of colo(u)r
  
!     procedure Rectangle(Left, Top, Right, Bottom:integer); virtual ;
    end;
  
  function MakeTexturesFromBmp(var aBMP:TFastDIB; useTransparency:boolean; transparentColor:TFColor):TTexBMPData; // returns display list
  procedure DeleteTexBMP(bmp:TTexBMPData);
  // ox = origin x (ie draws part of the bitmap)
  // oy = origin y
***************
*** 490,496 ****
  end;
  
! procedure TGLCanvas.Rectangle(Top, Left, Bottom, Right: integer);
  begin
!   glColor4f(FFillR,FFillG,FFillB,FFillAlpha);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
--- 498,504 ----
  end;
  
! procedure TGLCanvas.Rectangle(Left, Top, Right, Bottom: integer);
  begin
! (*  glColor4f(FFillR,FFillG,FFillB,FFillAlpha);
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
***************
*** 507,510 ****
--- 515,539 ----
      glVertex2i(Right,Bottom);
      glVertex2i(Right,Top);
+   glEnd; *)
+ 
+   glDisable(GL_TEXTURE_2D);
+   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+   glColor4f(FFillR, FFillG, FFillB, FFillAlpha);
+   glMatrixMode(GL_MODELVIEW);
+   glLoadIdentity;
+ 
+   glScalef(2.0 / Width, 2.0 / Height, 1.0);
+   glTranslatef(-(Width/2),(Height/2),0);
+   //glScalef(1.0,-1.0,1.0);
+ 
+   if Solid then
+     glBegin(GL_TRIANGLE_FAN)
+   else
+     glBegin(GL_LINE_LOOP);
+ 
+     glVertex2i(Left, -Top);
+     glVertex2i(Left, -Bottom);
+     glVertex2i(Right, -Bottom);
+     glVertex2i(Right, -Top);
    glEnd;
  end;
***************
*** 539,542 ****
--- 568,572 ----
    if Precache then
      UpdateDisplayList;
+   SetColor(clWhite);
  end;
  
***************
*** 716,719 ****
--- 746,751 ----
    r:TRect;
    id:Cardinal;
+   t:TTexture;
+   ac:TByteColor;
  begin
    cellsX := (aBMP.Width div 256) + 1;
***************
*** 721,724 ****
--- 753,757 ----
  
    buffer := nil;
+   t := nil;
  
    Result.cellsWidth := cellsX;
***************
*** 727,731 ****
    result.Height := aBMP.Height;
    for x := 1 to GLC_MAXTEXIDS do
!     result.TexIDs[x] := 0;
    for y := 1 to cellsY do
    begin
--- 760,764 ----
    result.Height := aBMP.Height;
    for x := 1 to GLC_MAXTEXIDS do
!     result.Textures[x] := nil;
    for y := 1 to cellsY do
    begin
***************
*** 752,759 ****
        // todo
        // so go generate the texture from the fast DIB
!       glGenTextures(1,@id);
!       Result.TexIDS[x+((y-1)*result.cellsWidth)] := id;
!       GenTexFromBMP(buffer,id,useTransparency,transparentColor);
! 
      end;
    end;
--- 785,796 ----
        // todo
        // so go generate the texture from the fast DIB
!       t := TTexture.Create;
!       ac[0] := transparentColor.r;
!       ac[1] := transparentColor.g;
!       ac[2] := transparentColor.b;
!       t.Alphacolor := ac;
!       t.UseAlpha := useTransparency;
!       t.LoadFromBitmap(buffer);
!       Result.Textures[x+((y-1)*result.cellsWidth)] := t;
      end;
    end;
***************
*** 839,843 ****
  begin
    for a := 1 to bmp.cellsWidth*bmp.cellsHeight do
!     glDeleteTextures(1,@bmp.TexIDs[a]);
  end;
  
--- 876,880 ----
  begin
    for a := 1 to bmp.cellsWidth*bmp.cellsHeight do
!     bmp.Textures[a].Free;
  end;
  
***************
*** 848,852 ****
    tr,vr:TRect;
  begin
!   glEnable(GL_BLEND);   // @@todo - alpha blending of bmps
    // change texture co-ordinate system
    glMatrixMode(GL_TEXTURE);
--- 885,891 ----
    tr,vr:TRect;
  begin
!   glEnable(GL_TEXTURE_2d);
!   glEnable(GL_BLEND);
!   glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
    // change texture co-ordinate system
    glMatrixMode(GL_TEXTURE);
***************
*** 864,868 ****
      for x := 1 to cw do
      begin
!       glBindTexture(GL_TEXTURE_2D,bmp.TexIDs[x+((y-1)*bmp.cellsWidth)]);
  
        // how many pixels to subtract (ie end of grid)
--- 903,907 ----
      for x := 1 to cw do
      begin
!       glBindTexture(GL_TEXTURE_2D,bmp.Textures[x+((y-1)*bmp.cellsWidth)].TexID);
  
        // how many pixels to subtract (ie end of grid)

[Pythianproject-cvsmail] CVS: PythianProject/Source/Units XDOM.dcr,NONE,1.1 XDOM.pas,1.1,1.2

[Kamil K. <kkr...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv11804

Modified Files:
	XDOM.pas 
Added Files:
	XDOM.dcr 
Log Message:
new xdom 2.2.12 - kk

--- NEW FILE ---

Index: XDOM.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/Units/XDOM.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** XDOM.pas	2000/08/31 17:29:42	1.1
--- XDOM.pas	2000/11/30 20:26:30	1.2
***************
*** 1,6 ****
  unit XDOM;
  
! // XDOM 2.2.5
! // Extended Document Object Model 2.2.5
  // Delphi 3 Implementation
  //
--- 1,6 ----
  unit XDOM;
  
! // XDOM 2.2.12
[...10854 lines suppressed...]
+     then  Str:= concat(wideString(#$feff),Str);
+   Ptr:= Pointer(Str);
+   Size:= length(Str)*2;
+   oldRefDoc:= FReferenceDocument;
+   MStream:= TXmlMemoryStream.create;
+   try
+     MStream.SetPointer(Ptr,Size);
      try
!       ErrorHandler.clearErrorList;
!       docStreamToDom(MStream,'','',FReferenceDocument);
      except
!       if FReferenceDocument <> oldRefDoc
!         then DOMImpl.FreeDocument(FReferenceDocument);
        raise;
      end;
+     Result:= FReferenceDocument;
    finally
+     FReferenceDocument:= oldRefDoc;
      MStream.free;
    end; {try}

[Pythianproject-cvsmail] CVS: PythianProject/Source/PNG English.txt,NONE,1.1 PNGZLIB.pas,NONE,1.1 PngImage.pas,NONE,1.1 adler32.obj,NONE,1.1 deflate.obj,NONE,1.1 infblock.obj,NONE,1.1 infcodes.obj,NONE,1.1 inffast.obj,NONE,1.1 inflate.obj,NONE,1.1 inftrees.obj,NONE,1.1 infutil.obj,NONE,1.1 trees.obj,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/PNG
In directory slayer.i.sourceforge.net:/tmp/cvs-serv18637

Added Files:
	English.txt PNGZLIB.pas PngImage.pas adler32.obj deflate.obj 
	infblock.obj infcodes.obj inffast.obj inflate.obj inftrees.obj 
	infutil.obj trees.obj 
Log Message:
added only needed PNG sources -mike

--- NEW FILE ---
  PNG_ERROR_INVALID_HEADER = 'Invalid Portable Graphics Network image, it has' +
    ' an invalid file header.';
  PNG_ERROR_INVALID_CHUNK_INDEX = 'The chunk index especified is out of the ' +
    'range.';
  PNG_ERROR_INVALID_CHUNK_CLASS_INDEX = 'The chunk class index especified is ' +
    ' out of range.';
  PNG_ERROR_CHUNK_INVALID_CRC = 'Can''t read the PNG image, it has corrupted ' +
    'data. ';
  PNG_ERROR_IHDR_NOT_FIRST = 'This PNG image is invalid, the IHDR chunk is ' +
    'either not present or it isn''t the first chunk.';
  PNG_ERROR_NO_IDAT = 'The current image being loaded has no data and could ' +
    'not be loaded.';
  PNG_ERROR_INVALID_PLTE = 'The current image being loaded has an invalid ' +
    'palette!';
  PNG_ERROR_INVALID_COLOR_TYPE = 'Could not read the image because it has an ' +
    'unknown color type.';
  PNG_ERROR_INVALID_FILTER_TYPE = 'The image could not be loaded because it ' +
    'uses an unknown set of filter types.';
  PNG_ERROR_INVALID_INTERLACE = 'The image has an unknown interlace method.';
  PNG_ERROR_UNKOWN_CRITICAL_CHUNK = 'The currently being loaded image ' +
    'contains critical(s) chunk(s) not reconized by the decoder.';
  PNG_ERROR_NO_PALETTE = 'The current image requeries a palette but it is ' +
    'not avaliable.';
  PNG_INVALID_COLOR_TYPE = 'Can not get transparency information because ' +
    'the current image color type is not RGB (value 3)';
  CHUNK_NOT_CHILD = 'The especified chunk is not inside the chunk list ' +
    'containing the method being used. The funcion could not be completed.';
  TIME_CORRUPTED = 'Could not get informations on the tIME chunk because ' +
    'it is corrupted.';
  PNG_SHARE = 'What you are testing now uses TPNGImage, a Portable Graphics ' +
    'network format handler made by Guba (gu...@st...). It is actually ' +
    'not totally ready yet (07/01/2000), but its nice, isn''t it ?'#13#10 +
    #13#10 + 'Anyway, for more information about it send mails to:'#13#10 +
    'gu...@st...';
  PNG_SHARE_TITLE = 'TPNGImage beta test version (gu...@st...)';


--- NEW FILE ---
unit PNGZLIB;

interface

uses
  Sysutils, Classes;

const
  ZLIB_VERSION = '1.1.3';

type
  TZAlloc = function (opaque: Pointer; items, size: Integer): Pointer;
  TZFree  = procedure (opaque, block: Pointer);

  TZCompressionLevel = (zcNone, zcFastest, zcDefault, zcMax);

  {** TZStreamRec ***********************************************************}

  TZStreamRec = packed record
    next_in  : PChar;     // next input byte
    avail_in : Longint;   // number of bytes available at next_in
    total_in : Longint;   // total nb of input bytes read so far

    next_out : PChar;     // next output byte should be put here
    avail_out: Longint;   // remaining free space at next_out
    total_out: Longint;   // total nb of bytes output so far

    msg      : PChar;     // last error message, NULL if no error
    state    : Pointer;   // not visible by applications

    zalloc   : TZAlloc;   // used to allocate the internal state
    zfree    : TZFree;    // used to free the internal state
    opaque   : Pointer;   // private data object passed to zalloc and zfree

    data_type: Integer;   // best guess about the data type: ascii or binary
    adler    : Longint;   // adler32 value of the uncompressed data
    reserved : Longint;   // reserved for future use
  end;

  {** TCustomZStream ********************************************************}

  TCustomZStream = class(TStream)
  private
    FStream    : TStream;
    FStreamPos : Integer;
    FOnProgress: TNotifyEvent;

    FZStream   : TZStreamRec;
    FBuffer    : Array [Word] of Char;
  protected
    constructor Create(stream: TStream);

    procedure DoProgress; dynamic;

    property OnProgress: TNotifyEvent read FOnProgress write FOnProgress;
  end;

  {** TZCompressionStream ***************************************************}

  TZCompressionStream = class(TCustomZStream)
  private
    function GetCompressionRate: Single;
  public
    constructor Create(dest: TStream; compressionLevel: TZCompressionLevel = zcDefault);
    destructor  Destroy; override;

    function  Read(var buffer; count: Longint): Longint; override;
    function  Write(const buffer; count: Longint): Longint; override;
    function  Seek(offset: Longint; origin: Word): Longint; override;

    property CompressionRate: Single read GetCompressionRate;
    property OnProgress;
  end;

  {** TZDecompressionStream *************************************************}

  TZDecompressionStream = class(TCustomZStream)
  public
    constructor Create(source: TStream);
    destructor  Destroy; override;

    function  Read(var buffer; count: Longint): Longint; override;
    function  Write(const buffer; count: Longint): Longint; override;
    function  Seek(offset: Longint; origin: Word): Longint; override;

    property OnProgress;
  end;

{** zlib public routines ****************************************************}

{*****************************************************************************
*  ZCompress                                                                 *
*                                                                            *
*  pre-conditions                                                            *
*    inBuffer  = pointer to uncompressed data                                *
*    inSize    = size of inBuffer (bytes)                                    *
*    outBuffer = pointer (unallocated)                                       *
*    level     = compression level                                           *
*                                                                            *
*  post-conditions                                                           *
*    outBuffer = pointer to compressed data (allocated)                      *
*    outSize   = size of outBuffer (bytes)                                   *
*****************************************************************************}

procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
  out outBuffer: Pointer; out outSize: Integer;
  level: TZCompressionLevel = zcDefault);

{*****************************************************************************
*  ZDecompress                                                               *
*                                                                            *
*  pre-conditions                                                            *
*    inBuffer    = pointer to compressed data                                *
*    inSize      = size of inBuffer (bytes)                                  *
*    outBuffer   = pointer (unallocated)                                     *
*    outEstimate = estimated size of uncompressed data (bytes)               *
*                                                                            *
*  post-conditions                                                           *
*    outBuffer = pointer to decompressed data (allocated)                    *
*    outSize   = size of outBuffer (bytes)                                   *
*****************************************************************************}

procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
 out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer = 0);

{** string routines *********************************************************}

function ZCompressStr(const s: String; level: TZCompressionLevel = zcDefault): String;

function ZDecompressStr(const s: String): String;

type
  EZLibError = class(Exception);

  EZCompressionError = class(EZLibError);
  EZDecompressionError = class(EZLibError);

implementation

{** link zlib code **********************************************************}

{$L deflate.obj}
{$L inflate.obj}
{$L infblock.obj}
{$L inftrees.obj}
{$L infcodes.obj}
{$L infutil.obj}
{$L inffast.obj}
{$L trees.obj}
{$L adler32.obj}

{*****************************************************************************
*  note: do not reorder the above -- doing so will result in external        *
*  functions being undefined                                                 *
*****************************************************************************}

const
  {** flush constants *******************************************************}

  Z_NO_FLUSH      = 0;
  Z_PARTIAL_FLUSH = 1;
  Z_SYNC_FLUSH    = 2;
  Z_FULL_FLUSH    = 3;
  Z_FINISH        = 4;

  {** return codes **********************************************************}

  Z_OK            = 0;
  Z_STREAM_END    = 1;
  Z_NEED_DICT     = 2;
  Z_ERRNO         = (-1);
  Z_STREAM_ERROR  = (-2);
  Z_DATA_ERROR    = (-3);
  Z_MEM_ERROR     = (-4);
  Z_BUF_ERROR     = (-5);
  Z_VERSION_ERROR = (-6);

  {** compression levels ****************************************************}

  Z_NO_COMPRESSION       =   0;
  Z_BEST_SPEED           =   1;
  Z_BEST_COMPRESSION     =   9;
  Z_DEFAULT_COMPRESSION  = (-1);

  {** compression strategies ************************************************}

  Z_FILTERED            = 1;
  Z_HUFFMAN_ONLY        = 2;
  Z_DEFAULT_STRATEGY    = 0;

  {** data types ************************************************************}

  Z_BINARY   = 0;
  Z_ASCII    = 1;
  Z_UNKNOWN  = 2;

  {** compression methods ***************************************************}

  Z_DEFLATED = 8;

  {** return code messages **************************************************}

  _z_errmsg: array[0..9] of PChar = (
    'need dictionary',      // Z_NEED_DICT      (2)
    'stream end',           // Z_STREAM_END     (1)
    '',                     // Z_OK             (0)
    'file error',           // Z_ERRNO          (-1)
    'stream error',         // Z_STREAM_ERROR   (-2)
    'data error',           // Z_DATA_ERROR     (-3)
    'insufficient memory',  // Z_MEM_ERROR      (-4)
    'buffer error',         // Z_BUF_ERROR      (-5)
    'incompatible version', // Z_VERSION_ERROR  (-6)
    ''
  );

  ZLevels: array [TZCompressionLevel] of Shortint = (
    Z_NO_COMPRESSION,
    Z_BEST_SPEED,
    Z_DEFAULT_COMPRESSION,
    Z_BEST_COMPRESSION
  );

  SZInvalid = 'Invalid ZStream operation!';

{** deflate routines ********************************************************}

function deflateInit_(var strm: TZStreamRec; level: Integer; version: PChar;
  recsize: Integer): Integer; external;

function deflate(var strm: TZStreamRec; flush: Integer): Integer;
  external;

function deflateEnd(var strm: TZStreamRec): Integer; external;

{** inflate routines ********************************************************}

function inflateInit_(var strm: TZStreamRec; version: PChar;
  recsize: Integer): Integer; external;

function inflate(var strm: TZStreamRec; flush: Integer): Integer;
  external;

function inflateEnd(var strm: TZStreamRec): Integer; external;

function inflateReset(var strm: TZStreamRec): Integer; external;

{** zlib function implementations *******************************************}

function zcalloc(opaque: Pointer; items, size: Integer): Pointer;
begin
  GetMem(result,items * size);
end;

procedure zcfree(opaque, block: Pointer);
begin
  FreeMem(block);
end;

{** c function implementations **********************************************}

procedure _memset(p: Pointer; b: Byte; count: Integer); cdecl;
begin
  FillChar(p^,count,b);
end;

procedure _memcpy(dest, source: Pointer; count: Integer); cdecl;
begin
  Move(source^,dest^,count);
end;

{** custom zlib routines ****************************************************}

function DeflateInit(var stream: TZStreamRec; level: Integer): Integer;
begin
  result := DeflateInit_(stream,level,ZLIB_VERSION,SizeOf(TZStreamRec));
end;

// function DeflateInit2(var stream: TZStreamRec; level, method, windowBits,
//   memLevel, strategy: Integer): Integer;
// begin
//   result := DeflateInit2_(stream,level,method,windowBits,memLevel,
//     strategy,ZLIB_VERSION,SizeOf(TZStreamRec));
// end;

function InflateInit(var stream: TZStreamRec): Integer;
begin
  result := InflateInit_(stream,ZLIB_VERSION,SizeOf(TZStreamRec));
end;

// function InflateInit2(var stream: TZStreamRec; windowBits: Integer): Integer;
// begin
//   result := InflateInit2_(stream,windowBits,ZLIB_VERSION,SizeOf(TZStreamRec));
// end;

{****************************************************************************}

function ZCompressCheck(code: Integer): Integer;
begin
  result := code;

  if code < 0 then
  begin
    raise EZCompressionError.Create(_z_errmsg[2 - code]);
  end;
end;

function ZDecompressCheck(code: Integer): Integer;
begin
  Result := code;

  if code < 0 then
  begin
    raise EZDecompressionError.Create(_z_errmsg[2 - code]);
  end;
end;

procedure ZCompress(const inBuffer: Pointer; inSize: Integer;
  out outBuffer: Pointer; out outSize: Integer;
  level: TZCompressionLevel);
const
  delta = 256;
var
  zstream: TZStreamRec;
begin
  FillChar(zstream,SizeOf(TZStreamRec),0);

  outSize := ((inSize + (inSize div 10) + 12) + 255) and not 255;
  GetMem(outBuffer,outSize);

  try
    zstream.next_in := inBuffer;
    zstream.avail_in := inSize;
    zstream.next_out := outBuffer;
    zstream.avail_out := outSize;

    ZCompressCheck(DeflateInit(zstream,ZLevels[level]));

    try
      while ZCompressCheck(deflate(zstream,Z_FINISH)) <> Z_STREAM_END do
      begin
        Inc(outSize,delta);
        ReallocMem(outBuffer,outSize);

        zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
        zstream.avail_out := delta;
      end;
    finally
      ZCompressCheck(deflateEnd(zstream));
    end;

    ReallocMem(outBuffer,zstream.total_out);
    outSize := zstream.total_out;
  except
    FreeMem(outBuffer);
    raise;
  end;
end;

procedure ZDecompress(const inBuffer: Pointer; inSize: Integer;
  out outBuffer: Pointer; out outSize: Integer; outEstimate: Integer);
var
  zstream: TZStreamRec;
  delta  : Integer;
begin
  FillChar(zstream,SizeOf(TZStreamRec),0);

  delta := (inSize + 255) and not 255;

  if outEstimate = 0 then outSize := delta
  else outSize := outEstimate;

  GetMem(outBuffer,outSize);

  try
    zstream.next_in := inBuffer;
    zstream.avail_in := inSize;
    zstream.next_out := outBuffer;
    zstream.avail_out := outSize;

    ZDecompressCheck(InflateInit(zstream));

    try
      while ZDecompressCheck(inflate(zstream,Z_NO_FLUSH)) <> Z_STREAM_END do
      begin
        Inc(outSize,delta);
        ReallocMem(outBuffer,outSize);

        zstream.next_out := PChar(Integer(outBuffer) + zstream.total_out);
        zstream.avail_out := delta;
      end;
    finally
      ZDecompressCheck(inflateEnd(zstream));
    end;

    ReallocMem(outBuffer,zstream.total_out);
    outSize := zstream.total_out;
  except
    FreeMem(outBuffer);
    raise;
  end;
end;

function ZCompressStr(const s: String; level: TZCompressionLevel): String;
var
  buffer: Pointer;
  size  : Integer;
begin
  ZCompress(PChar(s),Length(s),buffer,size,level);

  SetLength(result,size);
  Move(buffer^,result[1],size);

  FreeMem(buffer);
end;

function ZDecompressStr(const s: String): String;
var
  buffer: Pointer;
  size  : Integer;
begin
  ZDecompress(PChar(s),Length(s),buffer,size);

  SetLength(result,size);
  Move(buffer^,result[1],size);

  FreeMem(buffer);
end;

{** TCustomZStream **********************************************************}

constructor TCustomZStream.Create(stream: TStream);
begin
  inherited Create;

  FStream := stream;
  FStreamPos := stream.Position;
end;

procedure TCustomZStream.DoProgress;
begin
  if Assigned(FOnProgress) then FOnProgress(Self);
end;

{** TZCompressionStream *****************************************************}

constructor TZCompressionStream.Create(dest: TStream;
  compressionLevel: TZCompressionLevel);
begin
  inherited Create(dest);

  FZStream.next_out := FBuffer;
  FZStream.avail_out := SizeOf(FBuffer);

  ZCompressCheck(DeflateInit(FZStream,ZLevels[compressionLevel]));
end;

destructor TZCompressionStream.Destroy;
begin
  FZStream.next_in := Nil;
  FZStream.avail_in := 0;

  try
    if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;

    while ZCompressCheck(deflate(FZStream,Z_FINISH)) <> Z_STREAM_END do
    begin
      FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);

      FZStream.next_out := FBuffer;
      FZStream.avail_out := SizeOf(FBuffer);
    end;

    if FZStream.avail_out < SizeOf(FBuffer) then
    begin
      FStream.WriteBuffer(FBuffer,SizeOf(FBuffer) - FZStream.avail_out);
    end;
  finally
    deflateEnd(FZStream);
  end;

  inherited Destroy;
end;

function TZCompressionStream.Read(var buffer; count: Longint): Longint;
begin
  raise EZCompressionError.Create(SZInvalid);
end;

function TZCompressionStream.Write(const buffer; count: Longint): Longint;
begin
  FZStream.next_in := @buffer;
  FZStream.avail_in := count;

  if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;

  while FZStream.avail_in > 0 do
  begin
    ZCompressCheck(deflate(FZStream,Z_NO_FLUSH));

    if FZStream.avail_out = 0 then
    begin
      FStream.WriteBuffer(FBuffer,SizeOf(FBuffer));

      FZStream.next_out := FBuffer;
      FZStream.avail_out := SizeOf(FBuffer);

      FStreamPos := FStream.Position;

      DoProgress;
    end;
  end;

  result := Count;
end;

function TZCompressionStream.Seek(offset: Longint; origin: Word): Longint;
begin
  if (offset = 0) and (origin = soFromCurrent) then
  begin
    result := FZStream.total_in;
  end
  else raise EZCompressionError.Create(SZInvalid);
end;

function TZCompressionStream.GetCompressionRate: Single;
begin
  if FZStream.total_in = 0 then result := 0
  else result := (1.0 - (FZStream.total_out / FZStream.total_in)) * 100.0;
end;

{** TZDecompressionStream ***************************************************}

constructor TZDecompressionStream.Create(source: TStream);
begin
  inherited Create(source);

  FZStream.next_in := FBuffer;
  FZStream.avail_in := 0;

  ZDecompressCheck(InflateInit(FZStream));
end;

destructor TZDecompressionStream.Destroy;
begin
  inflateEnd(FZStream);

  inherited Destroy;
end;

function TZDecompressionStream.Read(var buffer; count: Longint): Longint;
begin
  FZStream.next_out := @buffer;
  FZStream.avail_out := count;

  if FStream.Position <> FStreamPos then FStream.Position := FStreamPos;

  while FZStream.avail_out > 0 do
  begin
    if FZStream.avail_in = 0 then
    begin
      FZStream.avail_in := FStream.Read(FBuffer,SizeOf(FBuffer));

      if FZStream.avail_in = 0 then
      begin
        result := count - FZStream.avail_out;

        Exit;
      end;

      FZStream.next_in := FBuffer;
      FStreamPos := FStream.Position;

      DoProgress;
    end;

    ZDecompressCheck(inflate(FZStream,Z_NO_FLUSH));
  end;

  result := Count;
end;

function TZDecompressionStream.Write(const Buffer; Count: Longint): Longint;
begin
  raise EZDecompressionError.Create(SZInvalid);
end;

function TZDecompressionStream.Seek(Offset: Longint; Origin: Word): Longint;
var
  buf: Array [0..4095] of Char;
  i  : Integer;
begin
  if (offset = 0) and (origin = soFromBeginning) then
  begin
    ZDecompressCheck(inflateReset(FZStream));

    FZStream.next_in := FBuffer;
    FZStream.avail_in := 0;

    FStream.Position := 0;
    FStreamPos := 0;
  end
  else if ((offset >= 0) and (origin = soFromCurrent)) or
          (((offset - FZStream.total_out) > 0) and (origin = soFromBeginning)) then
  begin
    if origin = soFromBeginning then Dec(offset,FZStream.total_out);

    if offset > 0 then
    begin
      for i := 1 to offset div SizeOf(buf) do ReadBuffer(buf,SizeOf(buf));
      ReadBuffer(buf,offset mod SizeOf(buf));
    end;
  end
  else raise EZDecompressionError.Create(SZInvalid);

  result := FZStream.total_out;
end;

end.

--- NEW FILE ---
{*******************************************************}
{                                                       }
{       Portable Network Graphics decoder               }
{       * decode & encode png files in delphi *         }
{                                                       }
{       EMAIL: gus...@uo...                   }
{                                                       }
{*******************************************************}

{ Delphi 3 compatibility and french translation by Paul TOTH <tot...@fr...>}

unit PNGImage;

{$R-}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
[...2457 lines suppressed...]
  RegisterNewChunkClass('IEND', TChunkIEND);
  RegisterNewChunkClass('IHDR', TChunkIHDR);
  RegisterNewChunkClass('gAMA', TChunkGAMA);
  RegisterNewChunkClass('IDAT', TChunkIDAT);
  RegisterNewChunkClass('PLTE', TChunkPLTE);
  RegisterNewChunkClass('tEXt', TChunkTEXT);
  RegisterNewChunkClass('tRNS', TChunkTRNS);
  RegisterNewChunkClass('tIME', TChunkTRNS);

  {Register the graphical class}
  TPicture.RegisterFileFormat('PNG', 'Portable Network Graphics', TPNGImage);

{When the compiled unit is being finalized}
finalization
  ChunkClasses.Free;

  {Unregister the graphical class}
  TPicture.UnregisterGraphicClass(TPNGImage);

end.

--- NEW FILE ---
€
¸

ûÚ3ɊNûÙ3ҊVûÚ3ɊN
ûÙ3ҊVûÚ3ɊNûكÆûƒèƒøbÿÿÿ…Àt3ҊÚFûHuô¹ñÿ
--- NEW FILE ---
€
@_tr_align
¸úÿÿÿéÌ

¸þÿÿÿé¾

ÇEô

¸þÿÿÿé=

¸üÿÿÿé

¸þÿÿÿé´
¸þÿÿÿé™
¸þÿÿÿéF
¸þÿ
¸üÿÿÿé2


ÿL$…/ÿÿÿ‹Pl‹Ï;Ñr‹Áë‹ÂƒÄ_^[АSVW‹ØUQ‹s$‹{4+{l+{d…ÿuƒ{d
‰$;4$w	f‹$f+Îë3Éf‰
Huá‹Æ‹ÐÒS8ƒê·
‰$;4$w	f‹$f+Îë3Éf‰
Huáþ‹+ƒ}

3Â#CL‰C@{l

3Â#CL‰C@‹K<·4A‹Cd#C,‹S8f‰4B‹K<‹C@f‹Sdf‰A…öt&‹Kd‹C$-

‰S@‹KP‹{dÓâ‹
¥ÂV
¦V
ç3VçJVçXV
3Â#CL‰C@‹K<·4A‹Cd#C,‹S8f‰4B‹K<‹C@f‹Sdf‰A‹KX‰Kp‹Ch‰C\ÇCX
ÿ‹“œ
¤ÏV
æ[VærVæ€V§1V
§ÔV

ÿ‹“œ

--- NEW FILE ---
€
‹Ö‹Cè
‹k0+l$Më‹k,+l$‹ƒø	‡4




ýÿÿƒ|$
‹k0+l$Më‹k,+l$…í…¥
‹k0+l$Më‹k,+l$‹D$;C,u)‹S0;S(t!‹K(‰L$‹D$;C0s
‹k0+l$Më‹k,+l$…íu8‹D$‰C ‰{‹T$‰V‹L$+
N‹D$‰‹Ã‹T$‰S4‹Ö‹$è
ƒÀ;C‡_ÿÿÿë‹SÿC‹•
ƒúuZƒø
sU‹S‹F(ÿV$Ç	
‹k0+l$Më‹k,+l$ƒ{
‹S0+T$Jë‹S,+T$‹C0;C4t8‹L$‰K ‰{‹D$‰F‹T$+
V‹Ö‹L$‰‹D$‰C4‹Ã‹$è

--- NEW FILE ---
€
‚’
éÿÿÿ‹L$ 3ҊQ‹L$ ‰Q‹T$ ‹J‹T$ ‰J‹L$ Ç


--- NEW FILE ---
€
ƒ}ì
ƒ^üÿÿ‹M‹A‹ËÁé+Eì;Áv‹ËÁéë‹È‹Á
Eì+ðÁà+؋E‰P ‹U‰Z‹E‹Uì‰P‹Æ‹M‹U+

B‹M‰1‹E‹Uè‰P43À_^[‹å]Â
--- NEW FILE ---
€
‹J3ґ‡Ñè
¸úÿÿÿéÓ
¸þÿÿÿéÅ
¸üÿÿÿé€
¸þÿÿÿé¦

3ҊыC‰PƒâƒútÇ

3ҊÑÁâ‹C‰PÇ
‹SŠÁ
B‹K‹A‰C0¸
T
æT
æT
æT
æT
æT
æ"T
æ\Tæ‰TæêTçôT
3ҊÑÁâ‹C‰PÇ

¸þÿÿÿé
--- NEW FILE ---
€
ƒEØ‹EØ3҉ƒEØ‹MØ3À‰
ƒEØ‹UØ3ɉ
ƒEØ‹EØ3҉ƒEØ‹MØ3À‰
ƒEØ‹UØ3ɉ
ƒEØ‹EØ3҉ƒEØ‹MØ3À‰
ƒEØ‹UØ3ɉ
ƒEØ‹EØ3҉ƒEØ‹MØ3À‰
ƒEØ‹UØ3ɉ
ƒEØ‹EØ3҉ƒEØ‹MØ3À‰
ƒEØ‹UØ3ɉ
‹Eü‰E؋Uø‰Uä‹M؋
ÿ„…tÿÿÿƒEØÿMäu닕tÿÿÿ;Uøu‹M3À‰
3ɋU3À‰
éá
•xÿÿÿ‰M܉UÀ‹MÀƒ9
@ƒEÀƒøvî‰Eà;EÜv‰EÜÇEä
‰MąÉ}
¸ýÿÿÿé<
¸ýÿÿÿé
¸üÿÿÿé•

¸üÿÿÿéý









--- NEW FILE ---
€

--- NEW FILE ---
€

@_tr_alignø
@_tr_tallyô


‹T$f‹:ƒÂfþAÿf‰;ƒ
ÿD$‹D$ë3ÀÿƒH
¹Š



‹$fÿ¸

‹$fÿ€¼

¹
¹Š









c







¹
fƒ¼‹v



‹Hÿ@‹P
Q·°
Q]Š‹°
ƒÀ
ÁèÁê;Âr	‹ÂëW‹ÂO;Árƒ}ü
fÿ„ˆŒ
f笡
$ÿ‹KÿC‹S
·×QYÁúˆ‹SÿC‹KRYˆ
‹Ïf÷Ñ·É‹CÿC‹SÁùˆë‹CÿC‹SŠˆF‹ÇƒÇÿ…Àuè_^[]Â































































[Pythianproject-cvsmail] CVS: PythianProject/Source/PNG - New directory

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/PNG
In directory slayer.i.sourceforge.net:/tmp/cvs-serv17748/PNG

Log Message:
Directory /cvsroot/pythianproject/PythianProject/Source/PNG added to the repository

[Pythianproject-cvsmail] CVS: PythianProject/Source/SectorEditor ViewerForm.pas,1.3,1.4 ViewerForm.dfm,1.3,1.4

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/SectorEditor
In directory slayer.i.sourceforge.net:/tmp/cvs-serv7526

Modified Files:
	ViewerForm.pas ViewerForm.dfm 
Log Message:
Some bug fixes and new features. Sector extrusion, merging vertices, etc.

Index: ViewerForm.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/ViewerForm.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** ViewerForm.pas	2000/08/31 17:29:42	1.3
--- ViewerForm.pas	2000/11/28 19:02:26	1.4
***************
*** 28,32 ****
      SplitVertical1: TMenuItem;
      N3: TMenuItem;
-     SelectOtherSide1: TMenuItem;
      CollapseVertices1: TMenuItem;
      ExpandVertex1: TMenuItem;
--- 28,31 ----
***************
*** 37,40 ****
--- 36,47 ----
      Zoom1: TMenuItem;
      Edit1: TMenuItem;
+     SelectPanelVertices1: TMenuItem;
+     N2: TMenuItem;
+     SelectEdgeVertices1: TMenuItem;
+     SelectSectorVertices1: TMenuItem;
+     ExtrudeSector1: TMenuItem;
+     LinkVertices1: TMenuItem;
+     UnlinkVertices1: TMenuItem;
+     DeleteSector1: TMenuItem;
      procedure GLPanel1GLDraw(Sender: TObject);
      procedure FormCreate(Sender: TObject);
***************
*** 46,50 ****
      procedure GLPanel1MouseUp(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
-     procedure SelectOtherSide1Click(Sender: TObject);
      procedure SplitHorizontal1Click(Sender: TObject);
      procedure SplitVertical1Click(Sender: TObject);
--- 53,56 ----
***************
*** 57,60 ****
--- 63,73 ----
      procedure popMainPopup(Sender: TObject);
      procedure ModeClick(Sender: TObject);
+     procedure SelectEdgeVertices1Click(Sender: TObject);
+     procedure SelectPanelVertices1Click(Sender: TObject);
+     procedure SelectSectorVertices1Click(Sender: TObject);
+     procedure ExtrudeSector1Click(Sender: TObject);
+     procedure LinkVertices1Click(Sender: TObject);
+     procedure UnlinkVertices1Click(Sender: TObject);
+     procedure DeleteSector1Click(Sender: TObject);
    private
      { Private declarations }
***************
*** 81,86 ****
      procedure SetMOPanel(const Value: TEditorPanel);
      function GetCurrentMode: TMouseMode;
-     function GetSector: TEditorSector;
-     procedure SetSector(const Value: TEditorSector);
      function GetModelAngle: TAngle3D;
  
--- 94,97 ----
***************
*** 88,91 ****
--- 99,105 ----
      procedure CollapseSelectedVertices;
      procedure ExpandSelectedVertices;
+     procedure LinkSelectedVertices;
+     procedure UnlinkSelectedVertices;
+     procedure ExtrudeSector(Panel: TEditorPanel; const Depth: Real);
      procedure UpdateStatusBar;
      function GetMOVertex: TEditorVertex;
***************
*** 102,105 ****
--- 116,123 ----
      function GetInSelection: Boolean;
      procedure SetInSelection(const Value: Boolean);
+     function GetSectorList: TEditorSectorList;
+     procedure SetSectorList(const Value: TEditorSectorList);
+     function GetMouseOverSector: TEditorSector;
+     procedure SetMouseOverSector(const Value: TEditorSector);
    public
      { Public declarations }
***************
*** 113,119 ****
  
      property MainFrm: TCustomForm read FMainFrm write FMainFrm;
!     property Sector: TEditorSector read GetSector write SetSector;
      property CurrentMode: TMouseMode read GetCurrentMode write SetCurrentMode;
      property SolidModel: Boolean read GetSolidModel;
      property MouseOverPanel: TEditorPanel read GetMOPanel write SetMOPanel;
      property MouseOverEdge: TEditorEdge read GetMOEdge write SetMOEdge;
--- 131,138 ----
  
      property MainFrm: TCustomForm read FMainFrm write FMainFrm;
!     property SectorList: TEditorSectorList read GetSectorList write SetSectorList;
      property CurrentMode: TMouseMode read GetCurrentMode write SetCurrentMode;
      property SolidModel: Boolean read GetSolidModel;
+     property MouseOverSector: TEditorSector read GetMouseOverSector write SetMouseOverSector;
      property MouseOverPanel: TEditorPanel read GetMOPanel write SetMOPanel;
      property MouseOverEdge: TEditorEdge read GetMOEdge write SetMOEdge;
***************
*** 279,284 ****
      RenderAxes;
  
!   if (Sector <> nil) then
!     Sector.Traverse(NullQuad);
  
    glPopMatrix;
--- 298,302 ----
      RenderAxes;
  
!   SectorList.Traverse(NullQuad);
  
    glPopMatrix;
***************
*** 365,370 ****
        if (FMouseMode = mmDraggingVertex) then
          begin
!           FVertexDragged := TRUE;
! 
            P := RotatePoint(MakePoint3D(FMousePos.x*(FPosition.z/300),-FMousePos.y*(FPosition.z/300),0),AddPoint(ModelAngle,FCameraAngle));
  
--- 383,387 ----
        if (FMouseMode = mmDraggingVertex) then
          begin
!           FVertexDragged := true;
            P := RotatePoint(MakePoint3D(FMousePos.x*(FPosition.z/300),-FMousePos.y*(FPosition.z/300),0),AddPoint(ModelAngle,FCameraAngle));
  
***************
*** 380,385 ****
              if (MouseOverEdge <> nil) then
              begin //Move edge
!               MouseOverEdge.Vertices[0].MoveVertex(P,False);
!               MouseOverEdge.Vertices[1].MoveVertex(P,False);
              end;
          end;
--- 397,402 ----
              if (MouseOverEdge <> nil) then
              begin //Move edge
!               MouseOverEdge.VerticesNil[0].MoveVertex(P,False);
!               MouseOverEdge.VerticesNil[1].MoveVertex(P,False);
              end;
          end;
***************
*** 388,391 ****
--- 405,409 ----
    else
      begin
+       MouseOverSector := nil;
        MouseOverPanel := nil;
        MouseOverEdge := nil;
***************
*** 394,399 ****
        if (CurrentMode = mmEdit) then
          UpdateSelection(x,y);
- 
-       UpdateStatusBar;
      end;
  end;
--- 412,415 ----
***************
*** 429,434 ****
        if (MouseOverEdge <> nil) and (MouseOverVertex = nil) then
        begin //Select edge's vertices
!         SelectVertex( MouseOverEdge.Vertices[0], not(ssCtrl in Shift) );
!         SelectVertex( MouseOverEdge.Vertices[1], FALSE );
        end;
      end;
--- 445,450 ----
        if (MouseOverEdge <> nil) and (MouseOverVertex = nil) then
        begin //Select edge's vertices
!         SelectVertex( MouseOverEdge.VerticesNil[0], not(ssCtrl in Shift) );
!         SelectVertex( MouseOverEdge.VerticesNil[1], FALSE );
        end;
      end;
***************
*** 448,456 ****
    Angle: TAngle3D;
  begin
!   if not(Assigned(Sector)) then
      exit;
  
- //  InSelection := true;
- 
    glGetIntegerv(GL_VIEWPORT, @ViewPort[0]);
  
--- 464,470 ----
    Angle: TAngle3D;
  begin
!   if (SectorList.Count = 0) then
      exit;
  
    glGetIntegerv(GL_VIEWPORT, @ViewPort[0]);
  
***************
*** 483,487 ****
    glRotatef(Angle.z,0,0,1);
  
!   Sector.Traverse(NullQuad);
  
    glPopMatrix;
--- 497,501 ----
    glRotatef(Angle.z,0,0,1);
  
!   SectorList.Traverse(NullQuad);
  
    glPopMatrix;
***************
*** 511,523 ****
          begin
            ClosestZ := dNear/$7fffffff;
-           MouseOverPanel := Sector.Panels[ Names[0] ];
            if (NameCnt > 1) then
            begin
!             MouseOverEdge := MouseOverPanel.Edges[ Names[1] ];
!             if (NameCnt = 3) then
!               MouseOverVertex := MouseOverEdge.Vertices[ Names[2] ];
            end;
- 
-           UpdateStatusBar;
          end;
          Inc(j,NameCnt+3);
--- 525,539 ----
          begin
            ClosestZ := dNear/$7fffffff;
            if (NameCnt > 1) then
            begin
!             MouseOverSector := TEditorSector(SectorList[ Names[0] ]);
!             MouseOverPanel := MouseOverSector.Panels[ Names[1] ];
!             if (NameCnt > 2) then
!             begin
!               MouseOverEdge := MouseOverPanel.Edges[ Names[2] ];
!               if (NameCnt > 3) then
!                 MouseOverVertex := MouseOverEdge.VerticesNil[ Names[3] ];
!             end;
            end;
          end;
          Inc(j,NameCnt+3);
***************
*** 525,564 ****
    end;
  
! //  InSelection := false;
  end;
  
- procedure TfrmViewer.SelectOtherSide1Click(Sender: TObject);
- var
-  i: Integer;
-  MOEdge: TEditorEdge;
-  MOPanel: TEditorPanel;
- begin
-   MOEdge := MouseOverEdge;
-   MOPanel := MouseOverPanel;
-   for i := 0 to MOEdge.NumParentPanels-1 do
-     if (MOEdge.ParentPanel[i] = MOPanel) then
-     begin
-       if (i = MOEdge.NumParentPanels-1) then
-         MouseOverPanel := MOEdge.ParentPanel[0]
-        else
-         MouseOverPanel := MOEdge.ParentPanel[i+1];
- 
-       DrawMOPanel := True;
-       RefreshAllViewers;
-       popMain.Popup(Mouse.CursorPos.x,Mouse.CursorPos.y);
-       DrawMOPanel := False;
- 
-       exit;
-     end;
- end;
- 
  procedure TfrmViewer.SplitHorizontal1Click(Sender: TObject);
  begin
!   Sector.SplitPanel(MouseOverPanel, True);
  end;
  
  procedure TfrmViewer.SplitVertical1Click(Sender: TObject);
  begin
!   Sector.SplitPanel(MouseOverPanel, False);
  end;
  
--- 541,555 ----
    end;
  
!   UpdateStatusBar;
  end;
  
  procedure TfrmViewer.SplitHorizontal1Click(Sender: TObject);
  begin
!   MouseOverSector.SplitPanel(MouseOverPanel, True);
  end;
  
  procedure TfrmViewer.SplitVertical1Click(Sender: TObject);
  begin
!   MouseOverSector.SplitPanel(MouseOverPanel, False);
  end;
  
***************
*** 592,605 ****
    CollapseVertices1.Visible := (MouseOverVertex <> nil);
    ExpandVertex1.Visible := CollapseVertices1.Visible;
!   CollapseVertices1.Enabled := (Sector.AreCollapsable(SelectedVertices));
    ExpandVertex1.Enabled := (SelectedVertices.Count > 0) and (SelectedVertices[0].NumCollapsedVertices > 0);
  
    SplitHorizontal1.Visible := (MouseOverVertex = nil) and (MouseOverPanel <> nil);
    SplitVertical1.Visible := SplitHorizontal1.Visible;
  
!   N3.Visible := (MouseOverVertex = nil) and (MouseOverEdge <> nil);
!   SelectOtherSide1.Visible :=  N3.Visible;
  
    Mode1.Items[ Ord(CurrentMode)-1 ].Checked := TRUE;
  end;
  
--- 583,606 ----
    CollapseVertices1.Visible := (MouseOverVertex <> nil);
    ExpandVertex1.Visible := CollapseVertices1.Visible;
!   LinkVertices1.Visible := CollapseVertices1.Visible;
!   UnlinkVertices1.Visible := CollapseVertices1.Visible;
!   CollapseVertices1.Enabled := MouseOverSector.AreCollapsable(SelectedVertices);
    ExpandVertex1.Enabled := (SelectedVertices.Count > 0) and (SelectedVertices[0].NumCollapsedVertices > 0);
+   LinkVertices1.Enabled := AreLinkable(SectorList,SelectedVertices);
+   UnlinkVertices1.Enabled := (SelectedVertices.Count > 0) and (SelectedVertices[0].NumLinkedVertices > 0);
+   DeleteSector1.Visible := (MouseOverSector <> nil);
  
    SplitHorizontal1.Visible := (MouseOverVertex = nil) and (MouseOverPanel <> nil);
    SplitVertical1.Visible := SplitHorizontal1.Visible;
  
!   N3.Visible := (MouseOverPanel <> nil);
!   ExtrudeSector1.Visible := N3.Visible;
  
    Mode1.Items[ Ord(CurrentMode)-1 ].Checked := TRUE;
+ 
+   SelectEdgeVertices1.Visible := (MouseOverEdge <> nil);
+   SelectPanelVertices1.Visible := (MouseOverPanel <> nil);
+   SelectSectorVertices1.Visible := (MouseOverSector <> nil);
+   N2.Visible := (MouseOverVertex = nil) and (MouseOverSector <> nil);
  end;
  
***************
*** 609,612 ****
--- 610,676 ----
  end;
  
+ procedure TfrmViewer.SelectEdgeVertices1Click(Sender: TObject);
+ begin
+   SelectVertex(MouseOverEdge.VerticesNil[0],true);
+   SelectVertex(MouseOverEdge.VerticesNil[1],false);
+ end;
+ 
+ procedure TfrmViewer.SelectPanelVertices1Click(Sender: TObject);
+ var
+   i: Integer;
+ begin
+   for i := 0 to MouseOverPanel.NumEdges-1 do
+     SelectVertex(MouseOverPanel.Edges[i].Vertices[0,MouseOverPanel], (i=0));
+ end;
+ 
+ procedure TfrmViewer.SelectSectorVertices1Click(Sender: TObject);
+ var
+   i,j: Integer;
+ begin
+   for i := 0 to MouseOverSector.NumPanels-1 do
+     for j := 0 to MouseOverSector.Panels[i].NumEdges-1 do
+       SelectVertex(MouseOverSector.Panels[i].Edges[j].Vertices[0,MouseOverSector.Panels[i]], (i+j=0));
+ end;
+ 
+ procedure TfrmViewer.ExtrudeSector1Click(Sender: TObject);
+ var
+   St: String;
+   Num: Real;
+   Code: Integer;
+   Quit: Boolean;
+ begin
+   Num := 0;
+   repeat
+     St := '1.0';
+     Quit := not(InputQuery('Extrude Sector','Depth of new sector:',St));
+     if not(Quit) then
+     begin
+       Val(St,Num,Code);
+       if (Code <> 0) then
+         MessageDLG('Invalid entry.',mtError,[mbOk],0);
+     end;
+   until Quit or (Code = 0);
+ 
+   if (St = 'Q') then
+     exit;
+ 
+   ExtrudeSector(MouseOverPanel,Num);
+ end;
+ 
+ procedure TfrmViewer.LinkVertices1Click(Sender: TObject);
+ begin
+   LinkSelectedVertices;
+ end;
+ 
+ procedure TfrmViewer.UnlinkVertices1Click(Sender: TObject);
+ begin
+   UnlinkSelectedVertices;
+ end;
+ 
+ procedure TfrmViewer.DeleteSector1Click(Sender: TObject);
+ begin
+   SectorList.Remove(MouseOverSector);
+ end;
+ 
  // TfrmMain Interface methods
  
***************
*** 631,644 ****
  end;
  
- function TfrmViewer.GetSector: TEditorSector;
- begin
-   Result := TfrmMain(FMainFrm).Sector;
- end;
- 
- procedure TfrmViewer.SetSector(const Value: TEditorSector);
- begin
-   TfrmMain(FMainFrm).Sector := Value;
- end;
- 
  procedure TfrmViewer.SelectVertex(Vertex: TEditorVertex; const ClearFirst: Boolean);
  begin
--- 695,698 ----
***************
*** 730,737 ****
  
  procedure TfrmViewer.SetInSelection(const Value: Boolean);
  begin
!   TFrmMain(FMainFrm).InSelection := Value;
  end;
  
  end.
-  
\ No newline at end of file
--- 784,825 ----
  
  procedure TfrmViewer.SetInSelection(const Value: Boolean);
+ begin
+   TfrmMain(FMainFrm).InSelection := Value;
+ end;
+ 
+ function TfrmViewer.GetSectorList: TEditorSectorList;
+ begin
+   Result := TfrmMain(FMainFrm).SectorList;
+ end;
+ 
+ procedure TfrmViewer.SetSectorList(const Value: TEditorSectorList);
+ begin
+   TfrmMain(FMainFrm).SectorList := Value;
+ end;
+ 
+ function TfrmViewer.GetMouseOverSector: TEditorSector;
+ begin
+   Result := TfrmMain(FMainFrm).MouseOverSector;
+ end;
+ 
+ procedure TfrmViewer.SetMouseOverSector(const Value: TEditorSector);
+ begin
+   TfrmMain(FMainFrm).MouseOverSector := Value;
+ end;
+ 
+ procedure TfrmViewer.LinkSelectedVertices;
+ begin
+   TfrmMain(FMainFrm).LinkSelectedVertices;
+ end;
+ 
+ procedure TfrmViewer.UnlinkSelectedVertices;
+ begin
+   TfrmMain(FMainFrm).UnlinkSelectedVertices;
+ end;
+ 
+ procedure TfrmViewer.ExtrudeSector(Panel: TEditorPanel; const Depth: Real);
  begin
!   TfrmMain(FMainFrm).ExtrudeSector(Panel,Depth);
  end;
  
  end.

Index: ViewerForm.dfm
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/ViewerForm.dfm,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
Binary files /tmp/cvshyPPoA and /tmp/cvsMgVSJ0 differ

[Pythianproject-cvsmail] CVS: PNG/PNG Test PNGTest.exe,1.1.1.1,NONE

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PNG/PNG Test
In directory slayer.i.sourceforge.net:/tmp/cvs-serv727

Removed Files:
	PNGTest.exe 
Log Message:
no message

***** Bogus filespec: Test
--- PNGTest.exe DELETED ---

[Pythianproject-cvsmail] CVS: PNG - Imported sources

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PNG
In directory slayer.i.sourceforge.net:/tmp/cvs-serv31182

Log Message:
PNG loading -mike

Status:

Vendor Tag:	avendor
Release Tags:	arelease
		
N PNG/Release.htm
N PNG/Portuguese.TXT
N PNG/deflate.obj
N PNG/English.txt
N PNG/infblock.obj
N PNG/infcodes.obj
N PNG/inffast.obj
N PNG/inflate.obj
N PNG/inftrees.obj
N PNG/infutil.obj
N PNG/PngImage.pas
N PNG/PNGZLIB.pas
N PNG/adler32.obj
N PNG/ZLIBSource.zip
N PNG/Help.htm
N PNG/pngsrc.upl
N PNG/trees.obj
N PNG/French.TXT
N PNG/PNGPackage.dof
N PNG/PNGPackage.dpk
N PNG/PNGPackage.cfg
N PNG/PNGPackage.res
N PNG/PNG Test/PNGMainForm.pas
N PNG/PNG Test/PNGMainForm.dfm
N PNG/PNG Test/PNGTest.dpr
N PNG/PNG Test/WIN95PIE.PAS
N PNG/PNG Test/PNGTest.res
N PNG/PNG Test/PNGTest.dof
N PNG/PNG Test/PNGTest.cfg
N PNG/PNG Test/PNGTest.dsk
N PNG/PNG Test/PNGTest.exe

No conflicts created by this import


***** Bogus filespec: -
***** Bogus filespec: Imported
***** Bogus filespec: sources

[Pythianproject-cvsmail] CVS: Prototypes/GLCanvas Arial Grid.bmp,NONE,1.1 CourierNew Grid.bmp,NONE,1.1 QuadTextUnit.pas,NONE,1.1 MyDraw.pas,1.4,1.5 glCanvas.pas,1.4,1.5

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory slayer.i.sourceforge.net:/tmp/cvs-serv15052

Modified Files:
	MyDraw.pas glCanvas.pas 
Added Files:
	Arial Grid.bmp CourierNew Grid.bmp QuadTextUnit.pas 
Log Message:
updated to use textured bitmaps -mike

***** Bogus filespec: Arial
***** Error reading new file: (2, 'No such file or directory')
***** Bogus filespec: CourierNew
***** Error reading new file: (2, 'No such file or directory')
--- NEW FILE ---
unit QuadTextUnit;

interface

{

  Textured Quads text system
  Michael Hearn

  (C) Pythian Project 2000


  Todo -
}

const
  NUMCHARS = 69;

type
  TQuadTextWidthsArray = array[1..NUMCHARS] of integer;

const
  TEX_CHARS:array[1..NUMCHARS] of char =
                                ('A','B','C','D','E','F','G','H','I','J','K','L',
                                 'M','N','O','P','Q','R','S','T','U','V','W','X',
                                 'Y','Z','a','b','c','d','e','f','g','h','i','j',
                                 'k','l','m','n','o','p','q','r','s','t','u','v',
                                 'w','x','y','z','1','2','3','4','5','6','7','8',
                                 '9','0','!','"','?','.','''','(',')');

  COURIERNEW_WIDTHS :TQuadTextWidthsArray = (
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10,  8,  8,  8,  8,  8,  8,  8,  8,  3,  3,
                                  8,  3, 12,  8,  8,  8,  8,  5,  8,  5,  8,  8,
                                  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                  8,  8,  4,  6,  7,  2,  2,  3,  3);
  ARIAL_WIDTHS :TQuadTextWidthsArray = (
                                 9,  10, 10, 10, 10,  9, 10, 10, 2,  9, 10,  9,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 16, 10,
                                 10, 10, 8,  8,  8,  8,  8,  5,  8,  8,  2,  3,
                                 8,  2,  12, 8,  8,  8,  8,  5,  8,  5,  8,  8,
                                 8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                 12, 8,  4,  6,  7,  2,  2,  3,  3);
type
  TQuadText = record
    TextureID :integer;
    GridSquareWidth,GridSquareHeight :integer; // size of grid square
    GridCells:integer; // how many cells in each direction
    GridCharSpacing:integer; // spacing between letters.
    SpaceWidth:integer; // size of a ' ' character.
    TexWidths :TQuadTextWidthsArray;
  end;


procedure qtStart;
procedure qtStop;
function qtDrawGridChar(QT:TQuadText; C:Char):integer; // returns index of char
function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
procedure qtDrawGridString(QT:TQuadText; s:String);

implementation
uses OpenGL, Graphics;

var
  dtStore :TGLBoolean;
  blStore :TGLBoolean;
  txStore :TGLBoolean;

function qtDrawGridChar(QT:TQuadText; C:Char):integer;
var
  AlphaOffset :integer;
  x,y:integer;
begin
  AlphaOffset := -1;
  for x := 1 to NUMCHARS do
    if TEX_CHARS[x] = C then AlphaOffset := x;

  result := AlphaOffset;
  if AlphaOffset <> -1 then
  begin
    // AlphaOffset contains the grid offset of the character now
    // in this test grid there are 12 per line
    Y := (AlphaOffset div QT.GridCells);
    if AlphaOffset mod QT.GridCells <> 0 then // need this in case letter is last on grid line
      inc(y);
    X := AlphaOffset - ((Y-1)*QT.GridCells);
    qtDrawGridSquare(QT,x,y);
  end;
end;


function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
var l,t:integer;
begin
  glBindTexture(GL_TEXTURE_2D, QT.TextureID);
  l := 256 - (QT.GridSquareWidth * (x-1));
  t := (Y - 1) * QT.GridSquareHeight;

  glBegin(GL_QUADS);
    glTexCoord2f(l,t);
    glVertex2f(0,0);
    glTexCoord2f(l,t+QT.GridSquareHeight);
    glVertex2f(0,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t+QT.GridSquareHeight);
    glVertex2f(QT.GridSquareWidth,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t);
    glVertex2f(QT.GridSquareWidth,0);
  glEnd;

  result := 0;
end;


procedure qtDrawGridString(QT:TQuadText; s:String);
var
  o,a:integer;
begin
  glMatrixMode(GL_TEXTURE); // modify texture matrix;
  glLoadIdentity;
  glScalef(1/256,1/256,1);

  glMatrixMode(GL_MODELVIEW);
  glPushMatrix;
  glPushMatrix;
  if length(s) = 1 then
  begin
    qtDrawGridChar(qt,s[1]);
  end else
  for a := 1 to Length(s) do
  begin
    if s[a] = #13 then
    begin
      glPopMatrix;
      glTranslatef(0,QT.GridSquareHeight,0); // translate down
      glPushMatrix;
    end else if s[a] <> #$A then begin
      o := qtDrawGridChar(QT,s[a]);
      if o <> -1 then
        glTranslatef(QT.TexWidths[o]+QT.GridCharSpacing,0,0)
      else // translate for space character
        glTranslatef(QT.SpaceWidth,0,0);
    end;
  end;
  glPopMatrix;
  glPopMatrix;
  glMatrixMode(GL_TEXTURE);
  glLoadIdentity;
  glMatrixMode(GL_MODELVIEW);
end;

procedure qtStart;
begin
  glGetBooleanv(GL_DEPTH_TEST,@dtstore);
  glDisable(GL_DEPTH_TEST);

  glGetBooleanv(GL_TEXTURE_2D,@txstore);
  glEnable(GL_TEXTURE_2D);

  glGetBooleanv(GL_BLEND,@blStore);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA,GL_ONE);
end;

procedure qtStop;
begin
  if dtstore <> 0 then glEnable(GL_DEPTH_TEST);
  if txStore = 0 then glDisable(GL_TEXTURE_2D);
  if blStore = 0 then glDisable(GL_BLEND);
end;


end.

Index: MyDraw.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/MyDraw.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** MyDraw.pas	2000/11/18 19:44:20	1.4
--- MyDraw.pas	2000/11/20 21:03:36	1.5
***************
*** 47,51 ****
    // creates a canvas object with the width and height of the window;
    GLC := TGLCanvas.Create(Width,Height);
!   InspectorGadget := TGLBitmap.Create;
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
    SampleText := TGLText.Create('Hello World', 'Arial', GLCANVAS_TEXT_GLF, GLC_DEFAULT_FONT_DATA);
--- 47,51 ----
    // creates a canvas object with the width and height of the window;
    GLC := TGLCanvas.Create(Width,Height);
!   InspectorGadget := TGLBitmap.Create(GLCANVAS_BMP_TEXTURED);
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
    SampleText := TGLText.Create('Hello World', 'Arial', GLCANVAS_TEXT_GLF, GLC_DEFAULT_FONT_DATA);
***************
*** 110,120 ****
    GLC.CanvasSetup;
  
!   glClearColor(0.0,0.0,0.0,1.0);
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
  
    // this draws the GL bitmap object at these coordinates
!   GLC.DrawBitmap(20,30,InspectorGadget);
  
!   // this draws the text object
    GLC.DrawText(25,400,QuadTextSample);
    GLC.DrawText(25,200,SampleText);
--- 110,123 ----
    GLC.CanvasSetup;
  
!   // next we clear the screen. if we don't do this the remains of the
!   // last frame will show through
!   glClearColor(0.2,0.2,0.6,1.0);
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
  
+ 
    // this draws the GL bitmap object at these coordinates
!   GLC.DrawBitmap(20,50,InspectorGadget);
  
!   // this draws the text objects
    GLC.DrawText(25,400,QuadTextSample);
    GLC.DrawText(25,200,SampleText);

Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** glCanvas.pas	2000/11/18 19:44:20	1.4
--- glCanvas.pas	2000/11/20 21:03:36	1.5
***************
*** 34,38 ****
  
    To do-
-     Fix text caching (display lists) - appears to have no effect on speed :(
      Add GLF bitmap fonts code - later
      Add shapes code
--- 34,37 ----
***************
*** 54,68 ****
  
  interface
! uses OpenGL, SysUtils, Graphics, glfD, Classes, QuadTextUnit, Textures;
  
  const
    GLCANVAS_TEXT_GLF = 1;
    GLCANVAS_TEXT_QUADTEXT = 2;
  
    GLC_MAXFONTS = 4;
  
  type
    EGLCanvasException = class(Exception) end;
  
    TGLCanvasFontData = record
      Name, FileName:string;
--- 53,77 ----
  
  interface
! uses OpenGL, Windows, SysUtils, Graphics, glfD, Classes, QuadTextUnit, Textures,
!      FastDIB, FastFiles;
  
  const
    GLCANVAS_TEXT_GLF = 1;
    GLCANVAS_TEXT_QUADTEXT = 2;
+   GLCANVAS_BMP_DIRECT = 1;
+   GLCANVAS_BMP_TEXTURED = 2;
  
    GLC_MAXFONTS = 4;
+   GLC_MAXTEXIDS = 256;
  
  type
    EGLCanvasException = class(Exception) end;
  
+   TTexBMPData = record
+     DisplayList :integer;
+     TexIDs :array[1..GLC_MAXTEXIDS] of Cardinal;
+     cellsWidth, cellsHeight :integer;
+   end;
+ 
    TGLCanvasFontData = record
      Name, FileName:string;
***************
*** 92,95 ****
--- 101,106 ----
                            );
  
+ 
+ 
  type
  
***************
*** 99,116 ****
  
  
!   // This class encapsulates pixel data that can be used with OpenGL
    TGLBitmap = class
    public
!     Filename :string; // set to the source file name if there was one
!     Bitmap :TBitmap; // the Delphi Graphic object that holds the bitmap
!     AlphaImage :TBitmap; // holds the optional alpha image
  
!     PixData :pointer;
!     Width,Height :integer;
  
!     constructor Create;
      destructor Destroy; override ;
      // @@todo - alpha transparency support
!     function LoadFromBitmap(B :TBitmap):integer; overload; // loads the GL bitmap from a precreated Bitmap object
      function LoadFromBitmap(filename :string):integer; overload; // loads the bitmap from a bmp file
    end;
--- 110,144 ----
  
  
!   // This class encapsulates pixel data that can be used with OpenGL,
!   // or a texture bitmap
    TGLBitmap = class
+   private
+     FFilename :string; // set to the source file name if there was one
+     FBitmap :TFastDIB;
+     FAlphaImage :TFastDIB; // holds the optional alpha image
+ 
+     FPixData :pointer;
+     FWidth,FHeight :integer;
+ 
+     FBmpType :integer;
+ 
+     FTexData :TTexBMPData;
    public
!     property Filename :string read FFilename;
!     property Bitmap :TFastDIB read FBitmap;
!     property AlphaImage :TFastDIB read FAlphaImage;
! 
!     property PixData :pointer read FPixData;
!     property Width :integer read FWidth;
!     property Height :integer read FHeight;
  
!     property BMPType :integer read FBmpType;
!     property TexData :TTexBMPData read FTexData;
  
!     constructor Create(aType:integer);
      destructor Destroy; override ;
      // @@todo - alpha transparency support
!     function BitmapToPixData(B :TFastDIB):pointer;
!     function LoadFromBitmap(B:TFastDIB):integer; overload;
      function LoadFromBitmap(filename :string):integer; overload; // loads the bitmap from a bmp file
    end;
***************
*** 204,228 ****
    end;
  
  implementation
  
  { TGLBitmap }
  
! constructor TGLBitmap.Create;
  begin
    inherited Create;
!   Filename := '';
!   Bitmap := nil;
!   AlphaImage := nil;
!   PixData := nil;
!   Width := -1; Height := -1;
  end;
  
! function TGLBitmap.LoadFromBitmap(B: TBitmap): integer;
! type
!   TColorQuad = array[0..3] of byte;
  var
    pd :PPixelData;
    x,y:integer;
!   c:TColor;
  
    function XYToOffset(ox,oy:integer):integer;
--- 232,260 ----
    end;
  
+ function MakeTexturesFromBmp(var aBMP:TFastDIB):TTexBMPData; // returns display list
+ procedure DeleteTexBMP(bmp:TTexBMPData);
+ procedure GenTexFromBMP(BMP:TFastDIB; tx:integer);
+ procedure DrawTexBMP(bmp:TTexBMPData);
+ 
  implementation
  
  { TGLBitmap }
  
! constructor TGLBitmap.Create(aType:integer);
  begin
    inherited Create;
!   FFilename := '';
!   FBitmap := nil;
!   FAlphaImage := nil;
!   FPixData := nil;
!   FWidth := -1; FHeight := -1;
!   FBMPType := aType;
  end;
  
! function TGLBitmap.BitmapToPixData(B: TFastDIB): pointer;
  var
    pd :PPixelData;
    x,y:integer;
!   c:TfColor;
  
    function XYToOffset(ox,oy:integer):integer;
***************
*** 244,251 ****
  begin
    // bitmap loader routine
!   Bitmap := b;
! 
!   Width := b.Width;
!   Height := b.Height;
    // allocate memory for it, assume RGB data (3 components)
    pd := AllocMem( (Width*Height)*3 );
--- 276,281 ----
  begin
    // bitmap loader routine
!   FWidth := b.Width;
!   FHeight := b.Height;
    // allocate memory for it, assume RGB data (3 components)
    pd := AllocMem( (Width*Height)*3 );
***************
*** 256,276 ****
      for x := 0 to Width-1 do
      begin
!       c := b.Canvas.Pixels[x,y];
!       pd^[ XYToOffset(x,y) + 0 ] := TColorQuad(c)[0];
!       pd^[ XYToOffset(x,y) + 1 ] := TColorQuad(c)[1];
!       pd^[ XYToOffset(x,y) + 2 ] := TColorQuad(c)[2];
      end;
    end;
  
!   b.Free;
!   PixData := pd;
!   Result := Width*Height;
  end;
  
  function TGLBitmap.LoadFromBitmap(filename: string): integer;
! var bmp:TBitmap;
  begin
!   bmp := TBitmap.Create;
!   bmp.LoadFromFile(filename);
    LoadFromBitmap(bmp);
    Result := 0;
--- 286,304 ----
      for x := 0 to Width-1 do
      begin
!       c := b.Pixels24[y,x];
!       pd^[ XYToOffset(x,y) + 0 ] := c.r;
!       pd^[ XYToOffset(x,y) + 1 ] := c.g;
!       pd^[ XYToOffset(x,y) + 2 ] := c.b;
      end;
    end;
  
!   result := pd;
  end;
  
  function TGLBitmap.LoadFromBitmap(filename: string): integer;
! var bmp:TFastDIB;
  begin
!   bmp := TFastDIB.Create;
!   LoadFromFile(bmp,filename);
    LoadFromBitmap(bmp);
    Result := 0;
***************
*** 279,286 ****
  destructor TGLBitmap.Destroy;
  begin
!   FreeMem(PixData);
    inherited;
  end;
  
  { TGLCanvas }
  
--- 307,327 ----
  destructor TGLBitmap.Destroy;
  begin
!   if FBMPType = GLCANVAS_BMP_DIRECT then
!     FreeMem(PixData)
!   else if FBMPType = GLCANVAS_BMP_TEXTURED then
!     DeleteTexBmp(FTexData);
    inherited;
  end;
  
+ function TGLBitmap.LoadFromBitmap(B: TFastDIB): integer;
+ begin
+   if FBmpType = GLCANVAS_BMP_DIRECT then
+     FPixData := BitmapToPixData(B)
+   else if FBMPType = GLCANVAS_BMP_TEXTURED then
+   begin
+     FTexData := MakeTexturesFromBmp(b);
+   end;
+ end;
+ 
  { TGLCanvas }
  
***************
*** 315,320 ****
    glPushAttrib(GL_DEPTH_TEST);
    glDisable(GL_DEPTH_TEST);
!   glRasterPos2i(X,Y+bmp.Height);
!   glDrawPixels(bmp.Width,bmp.Height,GL_RGB,GL_UNSIGNED_BYTE,bmp.PixData);
    glPopAttrib;
  end;
--- 356,378 ----
    glPushAttrib(GL_DEPTH_TEST);
    glDisable(GL_DEPTH_TEST);
! 
!   if bmp.BMPType = GLCANVAS_BMP_DIRECT then
!   begin
!     glRasterPos2i(X,Y+bmp.Height);
!     glDrawPixels(bmp.Width,bmp.Height,GL_RGB,GL_UNSIGNED_BYTE,bmp.PixData);
!   end else if bmp.BMPTYPE = GLCANVAS_BMP_TEXTURED then
!   begin
!     glLoadIdentity;
!     // change co-ordinate system  to 1:1 pixel mapping
!     glScalef(2.0 / Width, 2.0 / Height, 1.0);
!     glTranslatef(-(Width/2),0,0);
!     glTranslatef(X,-Y+bmp.Height,0);
!     glPushAttrib(GL_TEXTURE_2d);
!     glEnable(GL_TEXTURE_2d);
!     DrawTexBmp(bmp.TexData);
!     glPopAttrib;
!   end;
! 
! 
    glPopAttrib;
  end;
***************
*** 332,335 ****
--- 390,395 ----
    if text.TextType = GLCANVAS_TEXT_GLF then
    begin
+     glPushAttrib(GL_TEXTURE_2D);
+     glDisable(GL_TEXTURE_2d);
      glMatrixMode(GL_MODELVIEW);
      glLoadIdentity;
***************
*** 338,341 ****
--- 398,402 ----
      glTranslatef(-(Width / 2), (Height / 2), 0);
      glTranslatef(X,-Y,0);
+     glPopAttrib;
    end else if text.TextType = GLCANVAS_TEXT_QUADTEXT then
    begin
***************
*** 536,539 ****
--- 597,756 ----
    end;
  end;
+ 
+ // *********************** texture bitmaps **************************
+ 
+ function MakeTexturesFromBmp(var aBMP:TFastDIB):TTexBMPData; // returns display list
+ var
+   dl :integer;
+   cellsX,cellsY :byte; // number of cells in each direction
+   buffer:TFastDIB;
+   x,y:integer;
+   r:TRect;
+   id:Cardinal;
+ begin
+   cellsX := (aBMP.Width div 256) + 1;
+   cellsY := (aBMP.Height div 256) + 1;
+ 
+   buffer := nil;
+ 
+   Result.cellsWidth := cellsX;
+   Result.cellsHeight := cellsY;
+   for x := 1 to GLC_MAXTEXIDS do
+     result.TexIDs[x] := 0;
+   for y := 1 to cellsY do
+   begin
+     for x := 1 to cellsX do
+     begin
+       // clear temp buffer
+       if assigned(buffer) then buffer.Free;
+       buffer := TFastDIB.Create;
+ 
+       // work out rect we want to copy to a temporary buffer for
+       // texture generation
+       r.Left := (x-1)*256;
+       r.Top := (y-1)*256;
+       r.Right := r.Left+256; // now make sure they fit
+       if r.Right > aBMP.Width then r.Right := aBMP.Width;
+       r.Bottom := r.Top+256;
+       if r.Bottom > aBMP.Height then r.Bottom := aBMP.Height;
+       buffer.SetSize(256,256,24,0);
+ 
+       aBMP.DrawRect(buffer.hDC,0,0,r.Right-r.Left,r.Bottom-r.Top,r.Left,r.Top);
+       // now tmpBMP has the part of the picture to generate in it
+ 
+       // shrink textures here for maximum efficiency
+       // todo
+       // so go generate the texture from the fast DIB
+       glGenTextures(1,@id);
+       Result.TexIDS[x+((y-1)*result.cellsWidth)] := id;
+       GenTexFromBMP(buffer,id);
+ 
+     end;
+   end;
+ 
+   buffer.Free;
+ end;
+ 
+ procedure GenTexFromBMP(BMP:TFastDIB; tx:integer);
+ var
+   pd :PPixelData;
+   x,y:integer;
+   c:TFColor;
+   red,green,blue:byte;
+   pxWidth, pxHeight:integer;
+ 
+   function XYToOffset(ox,oy:integer):integer;
+   var pxoffset:integer;
+   begin
+     {
+        0 1 2 3 4 5 6 7 8 9      PxWidth=10
+      0 X X X X X X X X X X      PxHeight=3
+      1 X X X X X X X X X X
+      2 X X X X X X X X X X   }
+     pxoffset := 0;
+     oy := (PxHeight-1) - oy; // now y is OK
+     pxoffset := ox;
+     if oy > 0 then
+     begin
+       pxoffset := pxoffset + (oy*(PxWidth){-1}) {+ 1};
+     end;
+     pxoffset := pxoffset * 3; // move into position for RGB data
+     Result := pxoffset;
+   end;
+ 
+ begin
+   if bmp.Bpp <> 24 then raise Exception.Create('Don''t support non 24bit pixel formats! (image is '+IntToStr(bmp.bpp)+')');
+   pxWidth := bmp.Width;
+   pxHeight := bmp.Height;
+   // allocate memory for it, assume RGB data (3 components)
+   pd := AllocMem( (bmp.Width*bmp.Height)*3 );
+   // now for the inefficient bit - copying the data pixel by pixel
+   // from the Win32 GDI to our own data structure.
+   for y := 0 to pxHeight-1 do
+   begin
+     for x := 0 to pxWidth-1 do
+     begin
+       c := bmp.Pixels24[y,x];
+ 
+       pd^[ XYToOffset(x,y) + 0 ] := c.r;
+       pd^[ XYToOffset(x,y) + 1 ] := c.g;
+       pd^[ XYToOffset(x,y) + 2 ] := c.b;
+     end;
+   end;
+ 
+   // now we have pixel data generate the texture
+   glBindTexture(GL_TEXTURE_2D, tx);   // Start defining stored texture
+ 
+   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_BLEND);
+ 
+   glTexImage2D(GL_TEXTURE_2D,
+           0,
+           3,
+           pxWidth,
+           pxHeight,
+           0,
+           GL_RGB,
+           GL_UNSIGNED_BYTE,
+           pd);
+ end;
+ 
+ procedure DeleteTexBMP(bmp:TTexBMPData);
+ var a:integer;
+ begin
+   for a := 1 to bmp.cellsWidth*bmp.cellsHeight do
+     glDeleteTextures(1,@bmp.TexIDs[a]);
+ end;
+ 
+ procedure DrawTexBMP(bmp:TTexBMPData);
+ var y,x:integer;
+ begin
+   glColor3f(1.0,1.0,1.0);
+ 
+   glPushAttrib(GL_BLEND);
+   glDisable(GL_BLEND);
+   for y := 1 to bmp.cellsHeight do
+   begin
+     for x := 1 to bmp.cellsWidth do
+     begin
+       glBindTexture(GL_TEXTURE_2D,bmp.TexIDs[x+((y-1)*bmp.cellsWidth)]);
+       { the +1, -1 here is because there is a bug somewhere that mirrors
+         the last row to the first generating seams between the blocks }
+       glBegin(GL_QUADS);
+         glTexCoord2f(0,0); glVertex2f( 255*(x-1)-1 ,256*(y-1));
+         glTexCoord2f(1,0); glVertex2f( 255*x       ,256*(y-1));
+         glTexCoord2f(1,1); glVertex2f( 255*x       ,256*y+1);
+         glTexCoord2f(0,1); glVertex2f( 255*(x-1)-1 ,256*y+1);
+       glEnd;
+     end;
+   end;
+   glPopAttrib;
+ end;
+ 
  
  end.

[Pythianproject-cvsmail] CVS: Prototypes/GLBitmapDemo glBitmapDemo.cfg,NONE,1.1 frmMain.pas,1.1,1.2 gadgetcollage.bmp,1.1,1.2

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLBitmapDemo
In directory slayer.i.sourceforge.net:/tmp/cvs-serv13453

Modified Files:
	frmMain.pas gadgetcollage.bmp 
Added Files:
	glBitmapDemo.cfg 
Log Message:
updated to use textured bitmaps -mike

--- NEW FILE ---
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-U"..\..\PythianProject\Source\Units"
-O"..\..\PythianProject\Source\Units"
-I"..\..\PythianProject\Source\Units"
-R"..\..\PythianProject\Source\Units"

Index: frmMain.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLBitmapDemo/frmMain.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** frmMain.pas	2000/10/26 17:16:15	1.1
--- frmMain.pas	2000/11/20 20:53:51	1.2
***************
*** 9,14 ****
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   Menus, ExtCtrls, GLPanel, OpenGL, Textures, Trace;
  
  type
  
--- 9,17 ----
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   Menus, ExtCtrls, GLPanel, OpenGL, Textures, Trace, FastDIB, FastFiles;
  
+ const
+   MAXTEXIDS = 256;
+ 
  type
  
***************
*** 22,25 ****
--- 25,35 ----
    }
  
+   TTexBMPData = record
+     DisplayList :integer;
+     TexIDs :array[1..MAXTEXIDS] of Cardinal;
+     cellsWidth, cellsHeight :integer;
+   end;
+ 
+ 
    // we use this to store the pixel data from a bitmap
    TPixelData = TByteArray;
***************
*** 51,61 ****
--- 61,81 ----
      Px :PPixelData;
      PxWidth, PxHeight :integer;
+ 
+     FastBMP :TFastDIB;
+     td:TTexBMPData;
+ 
      procedure SetProjection(Sender: TObject);
      function BmpToPixelData(filename:string):PPixelData;
    end;
  
+ 
  var
    MainForm: TMainForm;
  
+ function MakeTexturesFromBmp(var aBMP:TFastDIB):TTexBMPData; // returns display list
+ procedure DeleteTexBMP(bmp:TTexBMPData);
+ procedure GenTexFromBMP(BMP:TFastDIB; tx:integer);
+ procedure DrawTexBMP(bmp:TTexBMPData);
+ 
  implementation
  
***************
*** 91,94 ****
--- 111,115 ----
  
  procedure TMainForm.GLPanelGLInit(Sender: TObject);
+ var otherbmp :TFastDIB;
  begin
    // Add GL init code here
***************
*** 112,115 ****
--- 133,145 ----
      end;
    end;
+ 
+   FastBMP := TFastDIB.Create;
+   LoadFromFile(FastBMP,'millennium_wallpaper.bmp');
+ 
+   otherBmp := TFastDIB.Create;
+   otherBMp.free;
+ 
+   td := MakeTexturesFromBMP(FastBMP);
+ 
    glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
  
***************
*** 132,141 ****
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  
!   // reset the matrix to it's identity (original, unmodified) matrix
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
  
  
    { ADD YOUR DRAWING CODE HERE }
--- 162,195 ----
    glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
  
!   // add bitmap code here
!   // px contains our data in RGB format 8bit per component, 24 bits pp
!   glRasterPos2d(-1,-1);
!   glClear(GL_DEPTH_BUFFER_BIT);
!   glDisable(GL_DEPTH_TEST);
! 
!   {if px <> nil then
!     glDrawPixels(pxWidth,pxHeight,GL_RGB,GL_UNSIGNED_BYTE,px);}
!   glEnable(GL_TEXTURE_2D);
!   glColor3f(1.0,1.0,1.0);
! 
    glMatrixMode(GL_PROJECTION);
    glLoadIdentity;
    glMatrixMode(GL_MODELVIEW);
    glLoadIdentity;
+   // change co-ordinate system  to 1:1 pixel mapping
+   glScalef(2.0 / Width, -2.0 / Height, 1.0);
+   glTranslatef(-(Width / 2), -(Height / 2), 0);
  
+   DrawTexBMP(td);
+ 
+   glEnable(GL_DEPTH_TEST);
+   glClear(GL_DEPTH_BUFFER_BIT);
+ 
+   glDisable(GL_TEXTURE_2D);
+   // reset the matrix to it's identity (original, unmodified) matrix
+   glMatrixMode(GL_PROJECTION);
+   glLoadIdentity;
+   glMatrixMode(GL_MODELVIEW);
+   glLoadIdentity;
  
    { ADD YOUR DRAWING CODE HERE }
***************
*** 202,214 ****
    glEnd;
  
!   // add bitmap code here
!   // px contains our data in RGB format 8bit per component, 24 bits pp
!   glLoadIdentity;
!   glRasterPos2d(-1,-1);
!   glClear(GL_DEPTH_BUFFER_BIT);
!   glDisable(GL_DEPTH_TEST);
!   if px <> nil then
!     glDrawPixels(pxWidth,pxHeight,GL_RGB,GL_UNSIGNED_BYTE,px);
!   glEnable(GL_DEPTH_TEST);
  end;
  
--- 256,260 ----
    glEnd;
  
! 
  end;
  
***************
*** 281,284 ****
--- 327,484 ----
    if assigned(px) then
      FreeMem(px);
+   FastBMP.Free;
+   DeleteTexBMP(td);
+ end;
+ 
+ function MakeTexturesFromBmp(var aBMP:TFastDIB):TTexBMPData; // returns display list
+ var
+   dl :integer;
+   cellsX,cellsY :byte; // number of cells in each direction
+   buffer:TFastDIB;
+   x,y:integer;
+   r:TRect;
+   id:Cardinal;
+ begin
+   cellsX := (aBMP.Width div 256) + 1;
+   cellsY := (aBMP.Height div 256) + 1;
+ 
+   buffer := nil;
+ 
+   Result.cellsWidth := cellsX;
+   Result.cellsHeight := cellsY;
+   for x := 1 to MAXTEXIDS do
+     result.TexIDs[x] := 0;
+   for y := 1 to cellsY do
+   begin
+     for x := 1 to cellsX do
+     begin
+       // clear temp buffer
+       if assigned(buffer) then buffer.Free;
+       buffer := TFastDIB.Create;
+ 
+       // work out rect we want to copy to a temporary buffer for
+       // texture generation
+       r.Left := (x-1)*256;
+       r.Top := (y-1)*256;
+       r.Right := r.Left+256; // now make sure they fit
+       if r.Right > aBMP.Width then r.Right := aBMP.Width;
+       r.Bottom := r.Top+256;
+       if r.Bottom > aBMP.Height then r.Bottom := aBMP.Height;
+       buffer.SetSize(256,256,24,0);
+ 
+       aBMP.DrawRect(buffer.hDC,0,0,r.Right-r.Left,r.Bottom-r.Top,r.Left,r.Top);
+       // now tmpBMP has the part of the picture to generate in it
+ 
+       // shrink textures here for maximum efficiency
+       // so go generate the texture from the fast DIB
+       glGenTextures(1,@id);
+       Result.TexIDS[x+((y-1)*result.cellsWidth)] := id;
+       GenTexFromBMP(buffer,id);
+ 
+     end;
+   end;
+ 
+   buffer.Free;
+ end;
+ 
+ procedure GenTexFromBMP(BMP:TFastDIB; tx:integer);
+ var
+   pd :PPixelData;
+   x,y:integer;
+   c:TFColor;
+   red,green,blue:byte;
+   pxWidth, pxHeight:integer;
+ 
+   function XYToOffset(ox,oy:integer):integer;
+   var pxoffset:integer;
+   begin
+     {
+        0 1 2 3 4 5 6 7 8 9      PxWidth=10
+      0 X X X X X X X X X X      PxHeight=3
+      1 X X X X X X X X X X
+      2 X X X X X X X X X X   }
+     pxoffset := 0;
+     oy := (PxHeight-1) - oy; // now y is OK
+     pxoffset := ox;
+     if oy > 0 then
+     begin
+       pxoffset := pxoffset + (oy*(PxWidth){-1}) {+ 1};
+     end;
+     pxoffset := pxoffset * 3; // move into position for RGB data
+     Result := pxoffset;
+   end;
+ 
+ begin
+   if bmp.Bpp <> 24 then raise Exception.Create('Don''t support non 24bit pixel formats! (image is '+IntToStr(bmp.bpp)+')');
+   pxWidth := bmp.Width;
+   pxHeight := bmp.Height;
+   // allocate memory for it, assume RGB data (3 components)
+   pd := AllocMem( (bmp.Width*bmp.Height)*3 );
+   // now for the inefficient bit - copying the data pixel by pixel
+   // from the Win32 GDI to our own data structure.
+   for y := 0 to pxHeight-1 do
+   begin
+     for x := 0 to pxWidth-1 do
+     begin
+       c := bmp.Pixels24[y,x];
+ 
+       pd^[ XYToOffset(x,y) + 0 ] := c.r;
+       pd^[ XYToOffset(x,y) + 1 ] := c.g;
+       pd^[ XYToOffset(x,y) + 2 ] := c.b;
+     end;
+   end;
+ 
+   // now we have pixel data generate the texture
+   glBindTexture(GL_TEXTURE_2D, tx);   // Start defining stored texture
+ 
+   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_BLEND);
+ 
+   glTexImage2D(GL_TEXTURE_2D,
+           0,
+           3,
+           pxWidth,
+           pxHeight,
+           0,
+           GL_RGB,
+           GL_UNSIGNED_BYTE,
+           pd);
+ end;
+ 
+ procedure DeleteTexBMP(bmp:TTexBMPData);
+ var a:integer;
+ begin
+   for a := 1 to bmp.cellsWidth*bmp.cellsHeight do
+     glDeleteTextures(1,@bmp.TexIDs[a]);
+ end;
+ 
+ procedure DrawTexBMP(bmp:TTexBMPData);
+ var y,x:integer;
+ begin
+   glColor3f(1.0,1.0,1.0);
+ 
+   glPushAttrib(GL_BLEND);
+   glDisable(GL_BLEND);
+   for y := 1 to bmp.cellsHeight do
+   begin
+     for x := 1 to bmp.cellsWidth do
+     begin
+       glBindTexture(GL_TEXTURE_2D,bmp.TexIDs[x+((y-1)*bmp.cellsWidth)]);
+       { the +1, -1 here is because there is a bug somewhere that mirrors
+         the last row to the first generating seams between the blocks }
+       glBegin(GL_QUADS);
+         glTexCoord2f(0,1); glVertex2f( 255*(x-1)-1 ,256*(y-1));
+         glTexCoord2f(1,1); glVertex2f( 255*x       ,256*(y-1));
+         glTexCoord2f(1,0); glVertex2f( 255*x       ,256*y+1);
+         glTexCoord2f(0,0); glVertex2f( 255*(x-1)-1 ,256*y+1);
+       glEnd;
+     end;
+   end;
+   glPopAttrib;
  end;
  

Index: gadgetcollage.bmp
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLBitmapDemo/gadgetcollage.bmp,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
Binary files /tmp/cvsdQOYRR and /tmp/cvs2GYUVR differ

[Pythianproject-cvsmail] CVS: PythianProject/Source/Units FastDIB.pas,NONE,1.1 FastFX.pas,NONE,1.1 FastFiles.pas,NONE,1.1 FastQuant.pas,NONE,1.1 FastSize.pas,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv13076

Added Files:
	FastDIB.pas FastFX.pas FastFiles.pas FastQuant.pas 
	FastSize.pas 
Log Message:
added fastLIB -mike

--- NEW FILE ---
unit FastDIB;       //  TFastDIB v2.5 updated: 9/6/99
                    //      by: Gordon Alex Cowie III
interface           //      www.jps.net/gfody
                    //
uses Windows;       //  TFastDIB wraps an upside down DIBSection and
                    //  gives you direct memory access to the pixels
{$IFDEF VER90}      //  via specially typed pointers, NOT procedures.
const hSection=nil; //  Pixels8, Pixels16, Pixels24, and Pixels32. You
type  Cint=Integer; //  must always pass the y-coordinate first! High
{$ELSE}             //  level functions Pixels[y,x] & PixelsB[y,x] are
{$IFDEF VER100}     //  provided as well. Please look over the interface
const hSection=0;   //  comments below.
type  Cint=Integer;
{$ELSE}
const hSection=0;
type  Cint=Cardinal;
{$ENDIF}
{$ENDIF}

type
  TFColor  = record b,g,r:Byte; end;
  TFColorA = record b,g,r,a:Byte; end;
  PFColor  =^TFColor;
  PFColorA =^TFColorA;
  TFColorTable = array[Byte]of TFColorA;
  PFColorTable =^TFColorTable;

  TLines    = array[Word]of Pointer;  PLines    =^TLines;
  TLine8    = array[Word]of Byte;     PLine8    =^TLine8;
  TLine16   = array[Word]of Word;     PLine16   =^TLine16;
  TLine24   = array[Word]of TFColor;  PLine24   =^TLine24;
  TLine32   = array[Word]of TFColorA; PLine32   =^TLine32;
  TPixels8  = array[Word]of PLine8;   PPixels8  =^TPixels8;
  TPixels16 = array[Word]of PLine16;  PPixels16 =^TPixels16;
  TPixels24 = array[Word]of PLine24;  PPixels24 =^TPixels24;
  TPixels32 = array[Word]of PLine32;  PPixels32 =^TPixels32;

  PBMInfo =^TBMInfo;
  TBMInfo = record
  bmiHeader: TBitmapInfoHeader;
  case Boolean of
    True:  (bmiColors:TFColorTable);
    False: (r,g,b:Longint);
  end;

TFastDIB = class
  hDC,                       // GDI surface of DIB
  BWidth,                    // width in bytes (word aligned)
  Height,                    // number of scanlines in DIB
  Gap,                       // distance between scanlines
  Mask,                      // specifies a mask for 16 & 32bit dibs ex: '565'
  Handle:     Integer;       // GDI handle of DIB
  Bits:       PLine8;        // address of DIB bits as an array of bytes
  Colors:     PFColorTable;  // address of DIB color table
  bmInfo:     TBMInfo;       // BitmapInfo structure
  Scanlines:  PLines;        // scanline offsets
  bshr,                      // these are the right and left shifts for
  gshr,gshl,                 // adjusting byte values to fit within your
  rshr,rshl:  Byte;          // mask for 16 & 32bit DIBs only
  Pixels8:    PPixels8;      // typed pointers to scanlines so that you can
  Pixels16:   PPixels16;     // access pixels[y,x] without function overhead
  Pixels24:   PPixels24;     // you must use 'Pixels8[y,x]' for 8bpp dibs
  Pixels32:   PPixels32;     // 'Pixels16[y,x]' for 16bpp dibs etc.
  constructor Create;
  destructor  Destroy; override;
  // bmInfo properties
  property    Compression:Cint read bmInfo.bmiHeader.biCompression write bmInfo.bmiHeader.biCompression;
  property    ClrUsed:CInt read bmInfo.bmiHeader.biClrUsed write bmInfo.bmiHeader.biClrUsed;
  property    BHeight:Longint read bmInfo.bmiHeader.biHeight write bmInfo.bmiHeader.biHeight;
  property    Width:Longint read bmInfo.bmiHeader.biWidth write bmInfo.bmiHeader.biWidth;
  property    Size:CInt read bmInfo.bmiHeader.biSizeImage write bmInfo.bmiHeader.biSizeImage;
  property    Bpp:Word read bmInfo.bmiHeader.biBitCount write bmInfo.bmiHeader.biBitCount;
  property    rMask:Longint read bmInfo.r write bmInfo.r;
  property    gMask:Longint read bmInfo.g write bmInfo.g;
  property    bMask:Longint read bmInfo.b write bmInfo.b;
  // procedural access to pixels for the lazies
  function    GetPixel(y,x:Integer):TFColor;
  function    GetPixelB(y,x:Integer):Byte;
  procedure   SetPixel(y,x:Integer;p:TFColor);
  procedure   SetPixelB(y,x:Integer;p:Byte);
  property    Pixels[y,x:Integer]:TFColor read GetPixel write SetPixel;
  property    PixelsB[y,x:Integer]:Byte read GetPixelB write SetPixelB;
  // initializers
  procedure   SetSize(fWidth,fHeight,fBpp,fMask:Integer);
  procedure   SetInterface(fBits:Pointer;fWidth,fHeight,fBpp,fMask:Integer);
  procedure   InitPixels(fBits:Pointer);
  procedure   LoadFromHandle(hBmp:Integer;fBpp:Byte;fMask:Integer);
  procedure   LoadFromFile(FileName:string;fBpp:Byte;fMask:Integer);
  procedure   LoadFromRes(Instance:Integer;ResID:string;fBpp:Byte;fMask:Integer);
  // GDI drawing methods
  procedure   Draw(fdc,x,y:Integer);
  procedure   Stretch(fdc,x,y,w,h:Integer);
  procedure   DrawRect(fdc,x,y,w,h,sx,sy:Integer);
  procedure   StretchRect(fdc,x,y,w,h,sx,sy,sw,sh:Integer);
  procedure   TileDraw(fdc,x,y,w,h:Integer);
  // other useful methods
  procedure   FillColors(i1,i2:Byte;c1,c2:TFColor);
  procedure   ShiftColors(Amount:Integer);
  function    MakePalette(Count:Byte):HPalette;
  function    CountColors:Longint;
  procedure   Flop;
end;

// some useful functions that should be macros but delphi doesn't
// support macros, so dont use these in really long loops without
// copying the code over or you'll really slow yourself down.

function Get16Mask:Integer;
function FRGB(r,g,b:Byte):TFColor;
function IntToColor(i:Integer):TFColor;
function IntToColorA(i:Integer):TFColorA;
function IntToByte(i:Integer):Byte;
function TrimInt(i,Min,Max:Integer):Integer;
function MaskToInt(r,g,b:DWord):Integer;

const // some colors
  tfBlack   : TFColor=(b:0;g:0;r:0);
  tfMaroon  : TFColor=(b:0;g:0;r:128);
  tfGreen   : TFColor=(b:0;g:128;r:0);
  tfOlive   : TFColor=(b:0;g:128;r:128);
  tfNavy    : TFColor=(b:128;g:0;r:0);
  tfPurple  : TFColor=(b:128;g:0;r:128);
  tfTeal    : TFColor=(b:128;g:128;r:0);
  tfGray    : TFColor=(b:128;g:128;r:128);
  tfSilver  : TFColor=(b:192;g:192;r:192);
  tfRed     : TFColor=(b:0;g:0;r:255);
  tfLime    : TFColor=(b:0;g:255;r:0);
  tfYellow  : TFColor=(b:0;g:255;r:255);
  tfBlue    : TFColor=(b:255;g:0;r:0);
  tfFuchsia : TFColor=(b:255;g:0;r:255);
  tfAqua    : TFColor=(b:255;g:255;r:0);
  tfLtGray  : TFColor=(b:192;g:192;r:192);
  tfDkGray  : TFColor=(b:128;g:128;r:128);
  tfWhite   : TFColor=(b:255;g:255;r:255);

implementation

constructor TFastDIB.Create;
begin
  inherited Create;
  FillChar(bmInfo,SizeOf(bmInfo),0);
  Colors:=@bmInfo.bmiColors;
  bmInfo.bmiHeader.biSize:=SizeOf(TBitmapInfoHeader);
  bmInfo.bmiHeader.biPlanes:=1;
  hDC:=0;   bshr:=0;   rshr:=0;    Handle:=0;
  Gap:=0;   gshr:=0;   rshl:=0;
  Mask:=0;  gshl:=0;   Height:=0;
end;

destructor TFastDIB.Destroy;
begin
  DeleteDC(hDC);
  DeleteObject(Handle);
  FreeMem(Scanlines);
  inherited Destroy;
end;

procedure TFastDIB.SetSize(fWidth,fHeight,fBpp,fMask:Integer);
begin
  if(fBpp<>Bpp)or(Width<>fWidth)or(Height<>fHeight)or(fMask<>Mask)then
  begin
    SetInterface(nil,fWidth,fHeight,fBpp,fMask);
    DeleteDC(hDC);
    DeleteObject(Handle);
    Handle:=CreateDIBSection(0,PBitmapInfo(@bmInfo)^,0,Pointer(Bits),hSection,0);
    hDC:=CreateCompatibleDC(0);
    SelectObject(hDC,Handle);
    InitPixels(Bits);
  end;
end;

procedure TFastDIB.SetInterface(fBits:Pointer;fWidth,fHeight,fBpp,fMask:Integer);
var
  sDC,
  i,x:  Integer;
  Base: Longint;
  n,b:  Byte;
begin
  if fBpp=0 then
  begin //default Bpp is current screen
    sDC:=GetDC(0);
    fBpp:=GetDeviceCaps(sDC,BITSPIXEL);
    ReleaseDC(0,sDC);
  end;
  if fMask=0 then
  begin //default Masks
    if fBpp=16 then fMask:=Get16Mask else
    if fBpp=32 then fMask:=888;
  end;
  Width:=fWidth; Height:=Abs(fHeight); BHeight:=-Height;
  Bpp:=fBpp; BWidth:=((Width*Bpp+31)and-32)shr 3;
  Size:=BWidth*Height; Mask:=fMask;
  if Bpp<8 then Gap:=BWidth-(Width div(8 div Bpp))else
  if Bpp>8 then Gap:=BWidth-(Width*(Bpp div 8))else Gap:=BWidth-Width;
  if(Bpp=16)or(Bpp=32)then
  begin
    Compression:=BI_BITFIELDS;
    if Bpp=16 then Base:=$FFFF else Base:=$FFFFFFFF;
    n:=0; b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    bMask:=Base shr(Bpp-n); bshr:=8-b; gshl:=b;
    b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    gMask:=Base shr(Bpp-n)and not bMask; rshl:=n; gshr:=8-b;
    b:=fMask mod 10; Inc(n,b); fMask:=fMask div 10;
    rMask:=Base shr(Bpp-n)and not(bMask or gMask); rshr:=8-b;
  end else Compression:=BI_RGB;
  if fBits<>nil then InitPixels(fBits);
end;

procedure TFastDIB.InitPixels(fBits:Pointer);
var
  x,i: Integer;
begin
  Bits:=fBits;
  ReallocMem(Scanlines,Height shl 2);
  x:=Integer(Bits);
  for i:=0 to Height-1 do
  begin
    Scanlines[i]:=Ptr(x);
    Inc(x,BWidth);
  end;
  Pixels8:=Pointer(Scanlines);
  Pixels16:=Pointer(Scanlines);
  Pixels24:=Pointer(Scanlines);
  Pixels32:=Pointer(Scanlines);
end;

procedure TFastDIB.SetPixel(y,x:Integer;p:TFColor); //inline
begin
  case Bpp of
    16: Pixels16[y,x]:=
          p.r shr rshr shl rshl or
          p.g shr gshr shl gshl or
          p.b shr bshr;
    24: Pixels24[y,x]:=p;
    32: PFColor(@Pixels32[y,x])^:=p;
  end;
end;

function TFastDIB.GetPixel(y,x:Integer):TFColor; //inline
var
  p:  Word;
  pd: DWord;
begin
  case Bpp of
    16: begin
          p:=Pixels16[y,x];
          Result.b:=p shl bshr;
          Result.g:=p shr gshl shl gshr;
          Result.r:=p shr rshl shl rshr;
        end;
    24: Result:=Pixels24[y,x];
    32: Result:=PFColor(@Pixels32[y,x])^;
  end;
end;

procedure TFastDIB.SetPixelB(y,x:Integer;p:Byte); //inline
var
  pb: PByte;
begin
  case Bpp of
    1: begin
         pb:=@Pixels8[y,x shr 3];
         pb^:=pb^ or p shl(7-(x mod 8));
       end;
    4: begin
         pb:=@Pixels8[y,x shr 1];
         if(x and 1)=0 then pb^:=pb^ or p shl 4
         else pb^:=pb^ or p;
       end;
    8: Pixels8[y,x]:=p;
  end;
end;

function TFastDIB.GetPixelB(y,x:Integer):Byte; //inline
var
  b: Byte;
begin
  case Bpp of
    1: begin
         b:=7-(x mod 8);
         Result:=Pixels8[y,x shr 3]and(1 shl b)shr b;
       end;
    4: if(x and 1)=0 then Result:=Pixels8[y,x shr 1]shr 4
       else Result:=Pixels8[y,x shr 1]and 15;
    8: Result:=Pixels8[y,x];
  end;
end;

procedure TFastDIB.LoadFromHandle(hBmp:Integer;fBpp:Byte;fMask:Integer);
var               // GetDIBits truncates 16bpp bitmaps to 15bpp (555)
  Bmp:   TBitmap; // when converting. To avoid this, specify a Bpp of
  memDC: Integer; // 24 or 32bpp and then use the 'Convert' function
begin             // in FastQuant.pas to convert it.
  GetObject(hBmp,SizeOf(Bmp),@Bmp);
  if fBpp=0 then SetSize(Bmp.bmWidth,Bmp.bmHeight,Bmp.bmBitsPixel,fMask)else
    SetSize(Bmp.bmWidth,Bmp.bmHeight,fBpp,fMask);
  memDC:=CreateCompatibleDC(0);
  SelectObject(memDC,hBmp);
  GetDIBits(memDC,hBmp,0,Height,Bits,PBitmapInfo(@bmInfo)^,0);
  DeleteDC(memDC);
end;

procedure TFastDIB.LoadFromFile(FileName:string;fBpp:Byte;fMask:Integer);
begin
  // I strongly recommend not using this function. Use the function
  // 'LoadBMPFile' in FastFiles.pas, its 50% faster and it supports
  // 16 & 32bpp bitmap files as this function doesn't.. also,
  // WindowsNT doesn't support LR_LOADFROMFILE
  LoadFromHandle(LoadImage(0,PChar(FileName),IMAGE_BITMAP,0,0,
      LR_LOADFROMFILE or LR_CREATEDIBSECTION),fBpp,fMask);
end;

procedure TFastDIB.LoadFromRes(Instance:Integer;ResID:string;fBpp:Byte;fMask:Integer);
begin
  LoadFromHandle(LoadImage(Instance,PChar(ResID),IMAGE_BITMAP,0,0,
      LR_LOADFROMFILE or LR_CREATEDIBSECTION),fBpp,fMask);
end;

procedure TFastDIB.Draw(fdc,x,y:Integer);
begin
  if(Bpp>8)and(hDC<>0)then
    BitBlt(fdc,x,y,Width,Height,hDC,0,0,SRCCOPY)else
    StretchDIBits(fdc,x,y,Width,Height,0,0,Width,Height,
      Bits,PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.Stretch(fdc,x,y,w,h:Integer);
begin
  SetStretchBltMode(fdc,STRETCH_DELETESCANS);
  if(Bpp>8)and(hDC<>0)then
    StretchBlt(fdc,x,y,w,h,hDC,0,0,Width,Height,SRCCOPY)else
    StretchDIBits(fdc,x,y,w,h,0,0,Width,Height,Bits,
      PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.DrawRect(fdc,x,y,w,h,sx,sy:Integer);
begin
  if(Bpp>8)and(hDC<>0)then
    BitBlt(fdc,x,y,w,h,hDC,sx,sy,SRCCOPY)else
  StretchDIBits(fdc,x,y,w,h,sx,sy,w,h,Bits,
    PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.StretchRect(fdc,x,y,w,h,sx,sy,sw,sh:Integer);
begin
  SetStretchBltMode(fdc,STRETCH_DELETESCANS);
  if(Bpp>8)and(hDC<>0)then
    StretchBlt(fdc,x,y,w,h,hDC,sx,sy,sw,sh,SRCCOPY)else
    StretchDIBits(fdc,x,y,w,h,sx,sy,sw,sh,Bits,
      PBitmapInfo(@bmInfo)^,0,SRCCOPY);
end;

procedure TFastDIB.TileDraw(fdc,x,y,w,h:Integer);
var
  wd,hd,
  hBmp,
  memDC: Integer;
begin
  if(Width=0)or(Height=0)then Exit;
  memDC:=CreateCompatibleDC(fdc);
  hBmp:=CreateCompatibleBitmap(fdc,w,h);
  SelectObject(memDC,hBmp);
  Draw(memDC,0,0); wd:=Width; hd:=Height;
  while wd<w do
  begin
    BitBlt(memDC,wd,0,wd*2,h,memDC,0,0,SRCCOPY);
    Inc(wd,wd);
  end;
  while hd<h do
  begin
    BitBlt(memDC,0,hd,w,hd*2,memDC,0,0,SRCCOPY);
    Inc(hd,hd);
  end;
  BitBlt(fdc,x,y,w,h,memDC,0,0,SRCCOPY);
  DeleteDC(memDC); DeleteObject(hBmp);
end;

function TFastDIB.CountColors:Longint;
type
  TLut1  = array[Byte,Byte,0..31]of Byte; PLut1  =^TLut1;
  TLut8  = array[Byte]of Word;            PLut8  =^TLut8;
  TLut16 = array[Word]of Word;            PLut16 =^TLut16;
var
  c:     Byte;
  i:     Longint;
  w,x,y: Integer;
  pc:    PFColor;
  pca:   PFColorA;
  pw,lk: PWord;
  pb:    PByte;
  Lut1:  PLut1;
  Lut8:  PLut8;
  Lut16: PLut16;
begin
  i:=0;
  case Bpp of
    1: i:=Integer(PDWord(@Colors[0])^<>PDWord(@Colors[1])^)*2;
    4: // counting up to 16
    begin
      New(Lut8); FillChar(Lut8^,512,255);
      pb:=Pointer(Bits); w:=(Width div 2)-1;
      for y:=0 to Height-1 do
      begin
        for x:=0 to w do
        begin
          lk:=@Lut8[pb^ shr 4];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          lk:=@Lut8[pb^ and 15]; if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pb);
        end;
        Inc(pb,Gap);
      end;
      Dispose(Lut8);
    end;
    8: // counting up to 256
    begin
      New(Lut8); FillChar(Lut8^,512,255);
      pb:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          lk:=@Lut8[pb^];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pb);
        end;
        Inc(pb,Gap);
      end;
      Dispose(Lut8);
    end;
    16: // counting up to 65536
    begin
      New(Lut16); FillChar(Lut16^,131072,255);
      pw:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          lk:=@Lut16[pw^];
          if lk^=$FFFF then begin Inc(i); lk^:=0; end;
          Inc(pw);
        end;
        pw:=Ptr(Integer(pw)+Gap);
      end;
      Dispose(Lut16);
    end;
    24: // counting up to 16777216
    begin
      New(Lut1); FillChar(Lut1^,$200000,0);
      pc:=Pointer(Bits);
      for y:=0 to Height-1 do
      begin
        for x:=0 to Width-1 do
        begin
          pb:=@Lut1[pc.r,pc.g,pc.b shr 3];
          c:=1 shl(pc.b and 7);
          if(c and pb^)=0 then begin Inc(i); pb^:=pb^ or c; end;
          Inc(pc);
        end;
        pc:=Ptr(Integer(pc)+Gap);
      end;
      Dispose(Lut1);
    end;
    32: // counting up to 16777216
    begin
      New(Lut1); FillChar(Lut1^,$200000,0);
      pca:=Pointer(Bits);
      for y:=0 to Height-1 do
      for x:=0 to Width-1 do
      begin
        pb:=@Lut1[pca.r,pca.g,pca.b shr 3];
        c:=1 shl(pca.b and 7);
        if(c and pb^)=0 then begin Inc(i); pb^:=pb^ or c; end;
        Inc(pca);
      end;
      Dispose(Lut1);
    end;
  end;
  Result:=i;
end;

procedure TFastDIB.ShiftColors(Amount:Integer);
var
  Buf: Pointer;
begin
  if Amount<0 then Amount:=256-(Abs(Amount) mod 256);
  if Amount>256 then Amount:=Amount mod 256; if Amount=0 then Exit;
  GetMem(Buf,Amount*4);
  Move(Ptr(Integer(Colors)+((256-Amount)*4))^,Buf^,Amount*4);
  Move(Colors^,Ptr(Integer(Colors)+(Amount*4))^,(256-Amount)*4);
  Move(Buf^,Colors^,Amount*4);
  FreeMem(Buf);
end;

procedure TFastDIB.FillColors(i1,i2:Byte;c1,c2:TFColor);
var
  ir,ig,ib,
  r,g,b:    Integer;
  pca:      PFColorA;
  i,x:      Byte;
begin
  x:=i2-i1;
  r:=c1.r shl 16; ir:=((c2.r-c1.r)shl 16)div x;
  g:=c1.g shl 16; ig:=((c2.g-c1.g)shl 16)div x;
  b:=c1.b shl 16; ib:=((c2.b-c1.b)shl 16)div x;
  pca:=@Colors[i1];
  for i:=0 to x do
  begin
    pca.r:=r shr 16; Inc(r,ir);
    pca.g:=g shr 16; Inc(g,ig);
    pca.b:=b shr 16; Inc(b,ib);
    Inc(pca);
  end;
end;

function TFastDIB.MakePalette(Count:Byte):HPalette;
type
  TLogPalette256 = record
    Ver,Count: Word;
    Entries:   array[Byte]of TPaletteEntry;
  end;
var
  Palette: TLogPalette256;
  Index:   Byte;
  PEntry:  PPaletteEntry;
  PColor:  PFColorA;
begin
  if Bpp>8 then
  begin
    if Count>(1 shl Bpp)-1 then Count:=(1 shl Bpp)-1 else
    if Count>235 then Count:=235; // max size of windows palette
    FillChar(Palette,SizeOf(Palette),0);
    Palette.Ver:=$300;
    Palette.Count:=Count+11;
    PEntry:=@Palette.Entries[10];
    PColor:=Pointer(Colors);
    for Index:=0 to Count do
    begin
      PEntry.peRed:=PColor.r;
      PEntry.peGreen:=PColor.g;
      PEntry.peBlue:=PColor.b;
      Inc(PEntry); Inc(PColor);
    end;
    Result:=CreatePalette(PLogPalette(@Palette)^);
  end;
end;

procedure TFastDIB.Flop;
var
  h,i:   Integer;
  p1,p2: Pointer;
  Buff:  PLine8;
begin
  GetMem(Buff,BWidth);
  h:=(Height-1)div 2;
  p1:=Bits; p2:=Scanlines[Height-1];
  for i:=0 to h do
  begin
    Move(p1^,Buff^,BWidth);
    Move(p2^,p1^,BWidth);
    Move(Buff^,p2^,BWidth);
    p1:=Ptr(Integer(p1)+BWidth);
    p2:=Ptr(Integer(p2)-BWidth);
  end;
  FreeMem(Buff);
end;

function Get16Mask:Integer; // returns 555 or 565 depending on the
var                         // current 16bit video mode via cheap
  sDC,bDC,hBM,c: Integer;   // trick, anyone got a better way?
begin
  sDC:=GetDC(0);
  bDC:=CreateCompatibleDC(sDC);
  hBM:=CreateCompatibleBitmap(sDC,1,1);
  SelectObject(bDC,hBM);
  SetPixel(bDC,0,0,RGB(0,100,0)); c:=GetPixel(bDC,0,0);
  DeleteDC(bDC); DeleteObject(hBM); ReleaseDC(0,sDC);
  if GetGValue(c)=100 then Result:=565 else Result:=555;
end;

function FRGBA(r,g,b,a:Byte):TFColorA;
begin
  Result.b:=b;
  Result.g:=g;
  Result.r:=r;
  Result.a:=a;
end;

function FRGB(r,g,b:Byte):TFColor;
begin
  Result.b:=b;
  Result.g:=g;
  Result.r:=r;
end;

function IntToColor(i:Integer):TFColor;
begin
  Result.b:=i shr 16;
  Result.g:=i shr 8;
  Result.r:=i;
end;

function IntToColorA(i:Integer):TFColorA;
begin
  Result.b:=i shr 16;
  Result.g:=i shr 8;
  Result.r:=i;
end;

function IntToByte(i:Integer):Byte;
begin
  if      i>255 then Result:=255
  else if i<0   then Result:=0
  else               Result:=i;
end;

function TrimInt(i,Min,Max:Integer):Integer;
begin
  if      i>Max then Result:=Max
  else if i<Min then Result:=Min
  else               Result:=i;
end;

function MaskToInt(r,g,b:DWord):Integer;
var
  ri,gi,bi: Integer;
begin
  ri:=0; gi:=0; bi:=0;
  if(r=0)or(g=0)or(b=0)then Exit;
  while (r and 1)=0 do r:=r shr 1;
  repeat
    Inc(ri);
    r:=r shr 1;
  until r=0;
  while (g and 1)=0 do g:=g shr 1;
  repeat
    Inc(gi);
    g:=g shr 1;
  until g=0;
  while (b and 1)=0 do b:=b shr 1;
  repeat
    Inc(bi);
    b:=b shr 1;
  until b=0;
  Result:=(ri*100)+(gi*10)+bi;
end;

end.

--- NEW FILE ---
unit FastFX;           // FastFX updated: 9/9/99
                       // by: gordy <gf...@jp...> www.jps.net/gfody
interface              //   Effects for TFastDIB. Please feel free to
                       //   contribute your filters/effects or optimizations!
uses Windows, FastDIB; //   huge thanks to Vit <vko...@in...> for his
                       //   kickass code & optimizations!
type
  TLut  = array[Byte]of Byte;    PLut  =^TLut;
  TWLut = array[Word]of Word;    PWLut =^TWLut;
  TSLut = array[Word]of Integer; PSLut =^TSLut;
  PSaturationLut =^TSaturationLut;
  TSaturationLut = record
    Grays: array[0..767]of Integer;
    Alpha: array[Byte]of Word;
  end;

function  ContrastLut(Amount:Integer):TLut;  //use luts(look up tables)with
function  LightnessLut(Amount:Integer):TLut; //applylut, you can apply many luts
function  AdditionLut(Amount:Integer):TLut;  //in one pass with MergeLuts
[...2348 lines suppressed...]
  end;
begin
  GetMem(sx,4*Dst.Width);
  GetMem(sy,4*Dst.Height);
  for lx:=0 to Dst.Width -1 do
    sx[lx]:=Round(Sin(lx/xDiv)*Ratio);
  for ly:=0 to Dst.Height-1 do
    sy[ly]:=Round(Sin(ly/yDiv)*Ratio);
  Max:=Integer(Src.Scanlines[Src.Height-1])+Src.BWidth;
  case Src.Bpp of
    8:  WaveWrap8;
    16: WaveWrap16;
    24: WaveWrap24;
    32: WaveWrap32;
  end;
  FreeMem(sx);
  FreeMem(sy);
end;

end.

--- NEW FILE ---
unit FastFiles;    // FastFiles updated: 9/6/99
                   // by: gordy <gf...@jp...> www.jps.net/gfody
interface          //   Functions for reading and writing different
                   //   graphic file formats to and from TFastDIB.
                   //   contributions are GREATLY appreciated!

uses Windows, Classes, FastDIB;

//low level
procedure DecodeRLE8(Bmp:TFastDIB;Data:Pointer);
procedure DecodeRLE4(Bmp:TFastDIB;Data:Pointer);
function  LoadBMPInfo(var Info:TBMInfo;Data:PLine8):Integer;
procedure LoadBMPData(Bmp:TFastDIB;Data:PLine8);
procedure LoadBMPStream(Bmp:TFastDIB;Stream:TStream);
procedure SaveBMPStream(Bmp:TFastDIB;Stream:TStream);
//high level
procedure LoadFromData(Bmp:TFastDIB;Data:Pointer);
procedure LoadFromStream(Bmp:TFastDIB;Stream:TStream);
procedure LoadFromFile(Bmp:TFastDIB;FileName:string);
procedure LoadFromRes(Bmp:TFastDIB;Instance:Integer;ResID:string);
procedure SaveToFile(Bmp:TFastDIB;FileName:string);

implementation

procedure DecodeRLE8(Bmp:TFastDIB;Data:Pointer);
var
  x,y,i: Integer;
  pb:    PByte;
begin
  pb:=Data; y:=0; x:=0;
  while y<Bmp.Height do
  begin
    if pb^=0 then
    begin
      Inc(pb);
      case pb^ of
        0:begin
            Inc(y);
            x:=0;
          end;
        1:Break;
        2:begin
            Inc(pb); Inc(x,pb^);
            Inc(pb); Inc(y,pb^);
          end;
        else
        begin
          i:=pb^; Inc(pb);
          Move(pb^,Bmp.Pixels8[y,x],i);
          Inc(pb,((i+1)and not 1)-1);
          Inc(x,i);
        end;
      end;
    end else
    begin
      i:=pb^; Inc(pb);
      FillChar(Bmp.Pixels8[y,x],i,pb^);
      Inc(x,i);
    end;
    Inc(pb);
  end;
end;

procedure DecodeRLE4(Bmp:TFastDIB;Data:Pointer);
var
  b1,b2,cb: Byte;
  x,y,i:    Integer;
  pb,pc:    PByte;
begin
  pb:=Data;
  cb:=pb^; x:=0; y:=0;
  while y<Bmp.Height do
  begin
    if cb=0 then
    begin
      Inc(pb); cb:=pb^;
      case cb of
        0:begin
            Inc(y);
            x:=0;
          end;
        1:Break;
        2:begin
            Inc(pb); Inc(x,pb^);
            Inc(pb); Inc(y,pb^);
          end;
        else
        begin
          for i:=1 to cb do
          begin
            pc:=@Bmp.Pixels8[y,x shr 1];
            if i and 1=1 then
            begin
              Inc(pb);
              b1:=pb^ shr 4;
              b2:=pb^ and $0F;
              if(x and 1)=0 then pc^:=pc^ or b1 shl 4
                else pc^:=pc^ or b1;
            end else
              if(x and 1)=0 then pc^:=pc^ or b2 shl 4
                else pc^:=pc^ or b2;
            Inc(x);
          end;
        end;
        if(cb shr 1)and 1=1 then Inc(pb);
      end;
    end else
    begin
      Inc(pb);
      b1:=pb^ shr 4;
      b2:=pb^ and $0F;
      for i:=1 to cb do
      begin
        pc:=@Bmp.Pixels8[y,x shr 1];
        if i and 1=1 then
          if(x and 1)=0 then pc^:=pc^ or b1 shl 4
            else pc^:=pc^ or b1
        else
          if(x and 1)=0 then pc^:=pc^ or b1 shl 4
            else pc^:=pc^ or b2;
        Inc(x);
      end;
    end;
    Inc(pb); cb:=pb^;
  end;
end;

function LoadBMPInfo(var Info:TBMInfo;Data:PLine8):Integer;
var
  i: Integer;
begin
  if Data[14]=12 then with PBitmapCoreHeader(@Data[14])^ do
  begin
    Info.bmiHeader.biWidth:=bcWidth;
    Info.bmiHeader.biHeight:=bcHeight;
    Info.bmiHeader.biBitCount:=bcBitCount;
    Info.bmiHeader.biCompression:=0;
    if bcBitCount<=8 then for i:=0 to(1 shl bcBitCount)-1 do
      Info.bmiColors[i]:=PFColorA(@Data[26+(i*3)])^;
  end else Info:=PBMInfo(@Data[14])^;
  Result:=PDWord(@Data[10])^;
end;

procedure LoadBMPData(Bmp:TFastDIB;Data:PLine8);
var
  Compress,Bits: Integer;
begin
  Bits:=LoadBMPInfo(Bmp.bmInfo,Data);
  Compress:=Bmp.Compression;
  with Bmp.bmInfo.bmiHeader do
  begin
    Bmp.SetSize(biWidth,biHeight,biBitCount,
      MaskToInt(Bmp.rMask,Bmp.gMask,Bmp.bMask));
    case Compress of
      0: Move(Data[Bits],Bmp.Bits^,Bmp.Size);
      1: DecodeRLE8(Bmp,@Data[Bits]);
      2: DecodeRLE4(Bmp,@Data[Bits]);
      3: Move(Data[Bits],Bmp.Bits^,Bmp.Size);
    end;
  end;
  Bmp.Flop;
end;

procedure LoadBMPStream(Bmp:TFastDIB;Stream:TStream);
var
  Bits,
  Compress: Integer;
  Buffer:   PLine8;
begin
  GetMem(Buffer,1078);
  if Stream.Size>=1078 then Stream.ReadBuffer(Buffer^,1078)else
    Stream.ReadBuffer(Buffer^,Stream.Size);
  Bits:=LoadBMPInfo(Bmp.bmInfo,Buffer);
  Compress:=Bmp.Compression;
  with Bmp.bmInfo.bmiHeader do
    Bmp.SetSize(biWidth,biHeight,biBitCount,
      MaskToInt(Bmp.rMask,Bmp.gMask,Bmp.bMask));
  Stream.Seek(Bits,soFromBeginning);
  if(Compress=1)or(Compress=2)then
  begin
    ReallocMem(Buffer,PDWord(@Buffer[2])^);
    Stream.ReadBuffer(Buffer^,Stream.Size-Stream.Position);
    if Compress=1 then DecodeRLE8(Bmp,Buffer) else DecodeRLE4(Bmp,Buffer);
  end else Stream.ReadBuffer(Bmp.Bits^,Bmp.Size);
  FreeMem(Buffer);
  Bmp.Flop;
end;

procedure SaveBMPStream(Bmp:TFastDIB;Stream:TStream);
var
  cSize,i: Integer;
  fHead:   TBitmapFileHeader;
  fCore:   TBitmapCoreHeader;
  Table:   array[Byte]of TFColor;
begin
  Bmp.Flop;
  if Bmp.ClrUsed<>0 then cSize:=(Bmp.ClrUsed*4) else
  if Bmp.Compression=BI_BITFIELDS then cSize:=12 else
  if Bmp.Bpp<=8 then cSize:=(1 shl Bmp.Bpp)*4 else cSize:=0;
  fHead.bfType:=$4D42;//"BM"
  if(Bmp.Compression=0)and(Bmp.ClrUsed=0)then
  begin
    cSize:=cSize div 4;
    for i:=0 to cSize-1 do
      Table[i]:=PFColor(@Bmp.Colors[i])^;
    cSize:=cSize*3;
    fHead.bfSize:=26+Bmp.Size+cSize;
    fHead.bfOffBits:=26+cSize;
    fCore.bcSize:=12;
    fCore.bcWidth:=Bmp.Width;
    fCore.bcHeight:=Bmp.Height;
    fCore.bcPlanes:=1;
    fCore.bcBitCount:=Bmp.Bpp;
    Stream.WriteBuffer(fHead,14);
    Stream.WriteBuffer(fCore,12);
    Stream.WriteBuffer(Table,cSize);
  end else
  begin
    fHead.bfSize:=54+Bmp.Size+cSize;
    fHead.bfOffBits:=54+cSize;
    Bmp.BHeight:=Abs(Bmp.BHeight);
    Stream.WriteBuffer(fHead,14);
    Stream.WriteBuffer(Bmp.bmInfo,40+cSize);
    Bmp.BHeight:=-Bmp.BHeight;
  end;
  Stream.Seek(fHead.bfOffBits,soFromBeginning);
  Stream.WriteBuffer(Bmp.Bits^,Bmp.Size);
  Bmp.Flop;
end;

{ ************************************************************************** }

procedure LoadFromData(Bmp:TFastDIB;Data:Pointer);
begin
  case PWord(Data)^ of
    $4D42: LoadBMPData(Bmp,Data);
    $8947:{LoadGIFData(Bmp,Data)};
    $D8FF:{LoadJPGData(Bmp,Data)};
  end;
end;

procedure LoadFromStream(Bmp:TFastDIB;Stream:TStream);
var
  Format: Word;
begin
  if Stream is TCustomMemoryStream then
    LoadFromData(Bmp,TCustomMemoryStream(Stream).Memory) else
  begin
    Stream.ReadBuffer(Format,2);
    Stream.Seek(-2,soFromCurrent);
    case Format of
      $4D42: LoadBMPStream(Bmp,Stream);
      $8947:{LoadGIFStream(Bmp,Stream)};
      $D8FF:{LoadJPGStream(Bmp,Stream)};
    end;
  end;
end;

procedure LoadFromFile(Bmp:TFastDIB;FileName:string);
var
  Stream: TFileStream;
begin
  Stream:=TFileStream.Create(FileName,0);//fmOpenRead
  LoadFromStream(Bmp,Stream);
  Stream.Free;
end;

procedure LoadFromRes(Bmp:TFastDIB;Instance:Integer;ResID:string);
begin
  LoadFromData(Bmp,
    LockResource(
    LoadResource(hInstance,
    FindResource(hInstance,PChar(ResID),RT_RCDATA))));
end;

procedure SaveToFile(Bmp:TFastDIB;FileName:string);
var
  Stream: TFileStream;
begin
//  Format:=Copy(FileName,Length(FileName)-2,4);
//  if Format='bmp' then
  Stream:=TFileStream.Create(FileName,$FFFF);//fmCreate
  SaveBMPStream(Bmp,Stream);
  Stream.Free;
end;

end.

--- NEW FILE ---
unit FastQuant;   //  FastQuant v1.0 (FastLIB)
                  //      -by: Gordon Alex Cowie III
interface         //      -updated: 7/7/99
                  //
uses FastDIB,     //    this unit contains methods for converting
     Windows;     //    TFastDIB to TFastDIB of different bpp
                  //    implementing FS dither and median cut color
                  //    quantization. Many Thanks to Vit Kovalcik!!
type
TConversionMode = (cmGDI,cmCut,cmDither,cmGray);

procedure Convert(Dst,Src:TFastDIB;cm:TConversionMode);
procedure ConvertB(Dst,Src:TFastDIB;Gray,Dither:Boolean;Colors:Byte);
procedure To1(Dib1,Dib:TFastDIB);
procedure To4(Dib4,Dib:TFastDIB);
procedure To8(Dib8,Dib:TFastDIB);
procedure To16(Dib16,Dib:TFastDIB);
procedure To24(Dib24,Dib:TFastDIB);
procedure To32(Dib32,Dib:TFastDIB);
[...2483 lines suppressed...]
      dib8.Colors[x2].b:=(Cubes[x2].z1+Cubes[x2].z2)shl 2;
    end;
    pb:=Pointer(dib8.Bits);
    pc:=Pointer(dib32.Bits);
    for x1:=0 to dib32.Height-1 do
    begin
      for y1:=0 to dib32.Width-1 do
      begin
        pb^:=Space[pc^.r shr 3,pc^.g shr 2,pc^.b shr 3];
        Inc(pb);
        Inc(pc);
      end;
      Inc(pb,dib8.Gap);
      pc:=Ptr(Integer(pc)+dib32.Gap);
    end;
  end;
  Dispose(Space);
end;

end.

--- NEW FILE ---
unit FastSize;         // FastSize updated: 8/19/99
                       // by: gordy <gf...@jp...> www.jps.net/gfody
interface              //   Functions for resampling one TFastDIB to
                       //   another TFastDIB of different size. These
uses Windows, FastDIB; //   functions assume that Src.Bpp = Dst.Bpp!

procedure Quick2x(Src,Dst:TFastDIB);//bpp > 4
procedure FastResize(Src,Dst:TFastDIB);//bpp > 4
procedure Bilinear(Src,Dst:TFastDIB);//8,24,32 only

implementation

procedure Quick2x(Src,Dst:TFastDIB);
  procedure Quick2x8;
  var
    x,y:   Integer;
    ps,pd: PByte;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      Inc(pd,Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      Inc(pd,Dst.BWidth+Dst.Gap);
      Inc(ps,Src.Gap);
    end;
  end;
  procedure Quick2x16;
  var
    x,y:   Integer;
    ps,pd: PWord;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
  procedure Quick2x24;
  var
    x,y:   Integer;
    ps,pd: PFColor;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
  procedure Quick2x32;
  var
    x,y:   Integer;
    ps,pd: PFColorA;
  begin
    ps:=Pointer(Src.Bits);
    pd:=Pointer(Dst.Bits);
    for y:=0 to Src.Height-1 do
    begin
      for x:=0 to Src.Width-1 do
      begin
        pd^:=ps^; Inc(pd);
        pd^:=ps^; Inc(pd);
        Inc(ps);
      end;
      pd:=Ptr(Integer(pd)+Dst.Gap);
      Move(Ptr(Integer(pd)-Dst.BWidth)^,pd^,Dst.BWidth);
      pd:=Ptr(Integer(pd)+Dst.BWidth+Dst.Gap);
      ps:=Ptr(Integer(ps)+Src.Gap);
    end;
  end;
begin
  Dst.SetSize(Src.Width*2,Src.Height*2,Src.Bpp,Src.Mask);
  case Src.Bpp of
    8:  Quick2x8;
    16: Quick2x16;
    24: Quick2x24;
    32: Quick2x32;
  end;
end;

procedure FastResize(Src,Dst:TFastDIB);
var xp,yp,sx,sy: Integer;
  procedure FastResize8;
  var
    pc:   PByte;
    x,y:  Integer;
    Line: PLine8;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      Inc(pc,Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize16;
  var
    pc:   PWord;
    x,y:  Integer;
    Line: PLine16;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      pc:=Ptr(Integer(pc)+Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize24;
  var
    pc:   PFColor;
    x,y:  Integer;
    Line: PLine24;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      pc:=Ptr(Integer(pc)+Dst.Gap);
      Inc(yp,sy);
    end;
  end;
  procedure FastResize32;
  var
    pc:   PFColorA;
    x,y:  Integer;
    Line: PLine32;
  begin
    yp:=0; pc:=Pointer(Dst.Bits);
    for y:=0 to Dst.Height-1 do
    begin
      Line:=Src.Scanlines[yp shr 16]; xp:=0;
      for x:=0 to Dst.Width-1 do
      begin
        pc^:=Line[xp shr 16];
        Inc(pc); Inc(xp,sx);
      end;
      Inc(yp,sy);
    end;
  end;
begin
  if(Dst.Width<>Src.Width)or(Dst.Height<>Src.Height)then
  begin
    sx:=(Src.Width shl 16)div Dst.Width;
    sy:=(Src.Height shl 16)div Dst.Height;
    case Src.Bpp of
      8:  FastResize8;
      16: FastResize16;
      24: FastResize24;
      32: FastResize32;
    end;
  end else if(Dst.Width=Src.Width)and(Dst.Height=Src.Height)then
    Move(Src.Bits^,Dst.Bits^,Src.Size);
end;

procedure Bilinear(Src,Dst:TFastDIB);
var
  xP,yP,yP2,xP2,t,z,
  z2,iz2,w1,w2,w3,w4: Integer;
  procedure Bilinear8;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PByte;
    Line1,Line2: PLine8;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc^:=(pc1^*w1+PByte(Integer(pc1)+1)^*w2+pc2^*w3+PByte(Integer(pc2)+1)^*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
  procedure Bilinear24;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PFColor;
    Line1,Line2: PLine24;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc.b:=(pc1.b*w1+PFColor(Integer(pc1)+3).b*w2+pc2.b*w3+PFColor(Integer(pc2)+3).b*w4)shr 15;
        pc.g:=(pc1.g*w1+PFColor(Integer(pc1)+3).g*w2+pc2.g*w3+PFColor(Integer(pc2)+3).g*w4)shr 15;
        pc.r:=(pc1.r*w1+PFColor(Integer(pc1)+3).r*w2+pc2.r*w3+PFColor(Integer(pc2)+3).r*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
  procedure Bilinear32;
  var
    x,y:         Integer;
    pc,pc1,pc2:  PFColorA;
    Line1,Line2: PLine32;
  begin
    for y:=0 to Dst.Height-1 do
    begin
      xP:=0; Line1:=Src.Scanlines[yP shr 15];
      if yP shr 16<Src.Height-1 then Line2:=Src.Scanlines[yP shr 15+1]else
        Line2:=Src.Scanlines[yP shr 15];
      pc:=Dst.Scanlines[y]; z2:=yP and $7FFF; iz2:=$8000-z2;
      for x:=0 to Dst.Width-1 do
      begin
        t:=xP shr 15; pc1:=@Line1[t]; pc2:=@Line2[t]; z:=xP and $7FFF;
        w2:=(z*iz2)shr 15; w1:=iz2-w2; w4:=(z*z2)shr 15; w3:=z2-w4;
        pc.b:=(pc1.b*w1+PFColorA(Integer(pc1)+4).b*w2+pc2.b*w3+PFColorA(Integer(pc2)+4).b*w4)shr 15;
        pc.g:=(pc1.g*w1+PFColorA(Integer(pc1)+4).g*w2+pc2.g*w3+PFColorA(Integer(pc2)+4).g*w4)shr 15;
        pc.r:=(pc1.r*w1+PFColorA(Integer(pc1)+4).r*w2+pc2.r*w3+PFColorA(Integer(pc2)+4).r*w4)shr 15;
        Inc(pc); Inc(xP,xP2);
      end;
      Inc(yP,yP2);
    end;
  end;
begin
  yP:=0;
  if Src.Width=1 then FastResize(Src,Dst)else
  if(Dst.Width<>Src.Width)or(Dst.Height<>Src.Height)then
  begin
    xP2:=((Src.Width-1)shl 15)div Dst.Width;
    yP2:=((Src.Height-1)shl 15)div Dst.Height;
    case Src.Bpp of
      8:  Bilinear8;
      24: Bilinear24;
      32: Bilinear32;
    end;
  end else if(Dst.Width=Src.Width)and(Dst.Height=Src.Height)then
    Move(Src.Bits^,Dst.Bits^,Src.Size);
end;

end.

[Pythianproject-cvsmail] CVS: PythianProject/Source/Units Textures.pas,1.7,1.8

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv12290

Modified Files:
	Textures.pas 
Log Message:
no message

Index: Textures.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/Units/Textures.pas,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -r1.7 -r1.8
*** Textures.pas	2000/11/18 19:48:32	1.7
--- Textures.pas	2000/11/20 20:38:57	1.8
***************
*** 185,189 ****
            FHeight,
            0,
!           GL_RGBA,
            GL_UNSIGNED_BYTE,
            FImage)
--- 185,189 ----
            FHeight,
            0,
!           GL_RGB,
            GL_UNSIGNED_BYTE,
            FImage)

[Pythianproject-cvsmail] CVS: PythianProject/Source/Units Glpanel.pas,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv6272

Added Files:
	Glpanel.pas 
Log Message:
no message

--- NEW FILE ---
/////////////////////////////////////////////////////////////////////////
// Industrial Software Solutions
// 4205 Hideaway
// Arlington, Texas 76017
// Mitchell E. James
// May 18, 1996
// mj...@cy...
// http://www.cyberhighway.net/~mjames/

// note: When running under the Delphi 2.0 debugger the Windows GL subsystem errors out randomly.
// note: The Windows GL subsystem seems to work fine running Delphi GL executables.
// note: I haven't been running with a palette. Not sure if that works.

unit GLPanel;

interface

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

  type
    TPFDPixelType = (GLp_TYPE_RGBA, GLp_TYPE_COLORINDEX);
    TPFDLayerType = (GLL_MAIN_PLANE, GLL_OVERLAY_PLANE, GLL_UNDERLAY_PLANE);
    // PIXELFORMATDESCRIPTOR flags
    TPFDFlag = (GLf_DOUBLEBUFFER, GLf_STEREO, GLf_DRAW_TO_WINDOW,
                GLf_DRAW_TO_BITMAP, GLf_SUPPORT_GDI, GLf_SUPPORT_OPENGL,
                GLf_GENERIC_FORMAT, GLf_NEED_PALETTE, GLf_NEED_SYSTEM_PALETTE,
                GLf_SWAP_EXCHANGE, GLf_SWAP_COPY);
    TPFDPixelTypes = set of TPFDPixelType;
    TPFDLayerTypes = set of TPFDLayerType;
    TPFDFlags      = set of TPFDFlag;

  TGLPanel = class(TCustomPanel)
  private
    DC: HDC;
    hrc: HGLRC;
    Palette: HPALETTE;
    FFirstTimeInFlag: Boolean;
    FPFDChanged: Boolean;
    FPixelType: TPFDPixelTypes;
    FLayerType: TPFDLayerTypes;
    FFlags: TPFDFlags;
    GPixelType: Word;
    GLayerType: Smallint;
    GFlags: Word;
    FColorBits: Cardinal;
    FDepthBits: Cardinal;
    FOnGLDraw: TNotifyEvent; // pointer to users routine of GL draw commands
    FOnGLInit: TNotifyEvent; // pointer to users routine for GL initialization
    FOnGLPrep: TNotifyEvent; // pointer to users routine for static setup
    procedure ResetFlags (Value: TPFDFlags);
    procedure ResetPixelType (Value: TPFDPixelTypes);
    procedure ResetLayerType (Value: TPFDLayerTypes);
    procedure SetDCPixelFormat;
    procedure NewPaint;
  protected
    procedure SetFlags (Value: TPFDFlags);
    procedure SetPixelType (Value: TPFDPixelTypes);
    procedure SetLayerType (Value: TPFDLayerTypes);
    procedure SetColorBits (Value: Cardinal);
    procedure SetDepthBits (Value: Cardinal);
    function GetFlags : TPFDFlags;
    function GetPixelType: TPFDPixelTypes;
    function GetLayerType: TPFDLayerTypes;
    function GetColorBits: Cardinal;
    function GetDepthBits: Cardinal;
    procedure Paint; override;
    procedure Resize; override;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GLReDraw;
    procedure NewGLPrep;
  published
    property Align;
    property Alignment;
//    property BevelInner;
//    property BevelOuter;
//    property BevelWidth;
//    property BorderWidth;
//    property BorderStyle;
    property DragCursor;
    property DragMode;
    property Enabled;
//    property Caption;
//    property Color;
    property GLColorBits: Cardinal read GetColorBits write SetColorBits
      default 24;
//    property Ctl3D;
    property GLDepthBits: Cardinal read GetDepthBits write SetDepthBits
      default 32;
    property GLFlags: TPFDFlags read Getflags write SetFlags
      default [GLf_DRAW_TO_WINDOW , GLf_SUPPORT_OPENGL];
//    property Font;
    property GLLayerType: TPFDLayerTypes read GetLayerType write SetLayerType
      default [GLL_MAIN_PLANE];
    property Locked;
//    property ParentColor;
//    property ParentCtl3D;
//    property ParentFont;
    property ParentShowHint;
    property GLPixelType: TPFDPixelTypes read GetPixelType write SetPixelType
      default [GLp_TYPE_RGBA];
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
    property OnGLDraw: TNotifyEvent read FOnGLDraw write FOnGLDraw;
    property OnGLInit: TNotifyEvent read FOnGLInit write FOnGLInit;
    property OnGLPrep: TNotifyEvent read FOnGLPrep write FOnGLPrep;

  end;

procedure Register;

implementation

procedure TGLPanel.Resize;
begin
  inherited Resize;
  if Assigned(OnResize) then OnResize(self);
end;
procedure TGLPanel.SetDCPixelFormat;
var
  hHeap: THandle;
  nColors, i: Integer;
  lpPalette: PLogPalette;
  byRedMask, byGreenMask, byBlueMask: Byte;
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;

begin
  FillChar(pfd, SizeOf(pfd), 0);

  with pfd do begin
    nSize     := sizeof(pfd);   // Size of this structure
    nVersion  := 1;             // Version number
    dwFlags   := GFlags;        // Flags
    iPixelType:= GPixelType;    // RGBA pixel values
    cColorBits:= FColorBits;    // 24-bit color
    cDepthBits:= FDepthBits;    // 32-bit depth buffer
    iLayerType:= GLayerType;    // Layer type
  end;

  nPixelFormat := ChoosePixelFormat(DC, @pfd);
  SetPixelFormat(DC, nPixelFormat, @pfd);

  DescribePixelFormat(DC, nPixelFormat, sizeof(TPixelFormatDescriptor), pfd);

  if ((pfd.dwFlags and PFD_NEED_PALETTE) <> 0) then begin
    nColors   := 1 shl pfd.cColorBits;
    hHeap     := GetProcessHeap;
    lpPalette := HeapAlloc(hHeap, 0, sizeof(TLogPalette) + (nColors * sizeof(TPaletteEntry)));

    lpPalette^.palVersion := $300;
    lpPalette^.palNumEntries := nColors;

    byRedMask   := (1 shl pfd.cRedBits) - 1;
    byGreenMask := (1 shl pfd.cGreenBits) - 1;
    byBlueMask  := (1 shl pfd.cBlueBits) - 1;

    for i := 0 to nColors - 1 do begin
      lpPalette^.palPalEntry[i].peRed   := (((i shr pfd.cRedShift)   and byRedMask)   * 255) DIV byRedMask;
      lpPalette^.palPalEntry[i].peGreen := (((i shr pfd.cGreenShift) and byGreenMask) * 255) DIV byGreenMask;
      lpPalette^.palPalEntry[i].peBlue  := (((i shr pfd.cBlueShift)  and byBlueMask)  * 255) DIV byBlueMask;
      lpPalette^.palPalEntry[i].peFlags := 0;
    end;

    Palette := CreatePalette(lpPalette^);
    HeapFree(hHeap, 0, lpPalette);

    if (Palette <> 0) then begin
      SelectPalette(DC, Palette, False);
      RealizePalette(DC);
    end;
  end;
end;

procedure TGLPanel.ResetFlags (Value: TPFDFlags);
begin
  GFlags := 0;
  if GLf_DOUBLEBUFFER in Value then GFlags := GFlags or PFD_DOUBLEBUFFER;
  if GLf_STEREO in Value then GFlags := GFlags or PFD_STEREO;
  if GLf_DRAW_TO_WINDOW in Value then GFlags := GFlags or PFD_DRAW_TO_WINDOW;
  if GLf_DRAW_TO_BITMAP in Value then GFlags := GFlags or PFD_DRAW_TO_BITMAP;
  if GLf_SUPPORT_GDI in Value then GFlags := GFlags or PFD_SUPPORT_GDI;
  if GLf_SUPPORT_OPENGL in Value then GFlags := GFlags or PFD_SUPPORT_OPENGL;
  if GLf_GENERIC_FORMAT in Value then GFlags := GFlags or PFD_GENERIC_FORMAT;
  if GLf_NEED_PALETTE in Value then GFlags := GFlags or PFD_NEED_PALETTE;
  if GLf_NEED_SYSTEM_PALETTE in Value then GFlags := GFlags or PFD_NEED_SYSTEM_PALETTE;
  if GLf_SWAP_EXCHANGE in Value then GFlags := GFlags or PFD_SWAP_EXCHANGE;
  if GLf_SWAP_COPY in Value then GFlags := GFlags or PFD_SWAP_COPY;
end;

procedure TGLPanel.ResetPixelType (Value: TPFDPixelTypes);
begin
  if GLp_TYPE_RGBA in Value then GPixelType := PFD_TYPE_RGBA;
  if GLp_TYPE_COLORINDEX in Value then GPixelType := PFD_TYPE_COLORINDEX;
end;

procedure TGLPanel.ResetLayerType (Value: TPFDLayerTypes);
begin
  if GLL_MAIN_PLANE in Value then GLayerType := PFD_MAIN_PLANE;
  if GLL_OVERLAY_PLANE in Value then GLayerType := PFD_OVERLAY_PLANE;
  if GLL_UNDERLAY_PLANE in Value then GLayerType := PFD_UNDERLAY_PLANE;
end;

procedure TGLPanel.SetFlags(Value: TPFDFlags);
begin
  if FFlags <> Value then
  begin
    FFlags := Value;
    if not (csDesigning in ComponentState) then
    begin
      ResetFlags (Value);
      FPFDChanged := True;
    end;
  end;
end;

procedure TGLPanel.SetPixelType (Value: TPFDPixelTypes);
begin
  if FPixelType <> Value then
  begin
    FPixelType := Value;
    if not (csDesigning in ComponentState) then
    begin
      ResetPixelType (Value);
      FPFDChanged := True;
    end;
  end;
end;

procedure TGLPanel.SetLayerType (Value: TPFDLayerTypes);
begin
  if FLayerType <> Value then
  begin
    FLayerType := Value;
    if not (csDesigning in ComponentState) then
    begin
      ResetLayerType (Value);
      FPFDChanged := True;
    end;
  end;
end;

procedure TGLPanel.SetColorBits (Value: Cardinal);
begin
  FColorBits := Value;
end;

procedure TGLPanel.SetDepthBits (Value: Cardinal);
begin
  FDepthBits := Value;
end;

function TGLPanel.GetFlags : TPFDFlags;
begin
  GetFlags := FFlags;
end;

function TGLPanel.GetPixelType: TPFDPixelTypes;
begin
  GetPixelType := FPixelType;
end;

function TGLPanel.GetLayerType: TPFDLayerTypes;
begin
  GetLayerType := FLayerType;
end;

function TGLPanel.GetColorBits: Cardinal;
begin
  GetColorBits := FColorBits;
end;

function TGLPanel.GetDepthBits: Cardinal;
begin
  GetDepthBits := FDepthBits;
end;

procedure TGLPanel.Paint;
begin
end;

procedure TGLPanel.NewGLPrep;
begin
  if Assigned(OnGLPrep) then OnGLPrep(self);
  if Assigned(OnResize) then OnResize(self);
end;

procedure TGLPanel.NewPaint;
var
  ps : TPaintStruct;
begin
  inherited;
  if not (csDesigning in ComponentState) then
  begin
    // Draw the scene.
    if FPFDChanged then SetDCPixelFormat;
      if FFirstTimeInFlag then
      begin
        FFirstTimeInFlag := False;
        // Create a rendering context.
        InitOpenGL;
        DC := GetDC(Handle);
        SetDCPixelFormat;
        hrc := wglCreateContext(DC);
        wglMakeCurrent(DC, hrc);
        if Assigned(OnGLInit) then OnGlInit(self);
        if Assigned(OnGLPrep) then OnGLPrep(self);
        if Assigned(OnResize) then OnResize(self);
      end;
    BeginPaint(Handle, ps);
    if Assigned(OnGLDraw) then OnGLDraw(self);
    if GLf_DOUBLEBUFFER in FFlags then SwapBuffers(DC);
    EndPaint(Handle, ps);
  end;
end;

constructor TGLPanel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPFDChanged := False;
  FPixelType := [GLp_TYPE_RGBA];
  FFlags := [GLf_DRAW_TO_WINDOW, GLf_SUPPORT_OPENGL, GLf_DOUBLEBUFFER];
  FLayerType := [GLL_MAIN_PLANE];
  FColorBits := 24;
  FDepthBits := 32;
  ResetFlags(FFlags);
  ResetPixelType(FPixelType);
  ResetLayerType(FLayerType);
  FFirstTimeInFlag := True;
end;

destructor TGLPanel.Destroy;
begin
  if not (csDesigning in ComponentState) then
  begin
    // Clean up and terminate.
    wglMakeCurrent(0, 0);
    wglDeleteContext(hrc);

    if (Palette <> 0) then
      DeleteObject(Palette);
  end;
  inherited;
end;

procedure TGLPanel.GLReDraw;
begin
  NewPaint;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TGLPanel]);
end;

end.

[Pythianproject-cvsmail] CVS: PythianProject/Source/Units Textures.pas,1.6,1.7

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/Units
In directory slayer.i.sourceforge.net:/tmp/cvs-serv2515

Modified Files:
	Textures.pas 
Log Message:
now supports bitmapped text!

Index: Textures.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/Units/Textures.pas,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -r1.6 -r1.7
*** Textures.pas	2000/10/26 17:09:06	1.6
--- Textures.pas	2000/11/18 19:48:32	1.7
***************
*** 76,79 ****
--- 76,80 ----
      property UseMipmaps: Boolean read FUseMipmaps write SetMipmap;
      property Width: Integer read FWidth;
+     property TexID: TGLuInt read FTexID;
    end;
  

[Pythianproject-cvsmail] CVS: Prototypes/GLCanvas MyDraw.pas,1.3,1.4 glCanvas.pas,1.3,1.4 glfD.pas,1.1,1.2

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory slayer.i.sourceforge.net:/tmp/cvs-serv2112

Modified Files:
	MyDraw.pas glCanvas.pas glfD.pas 
Log Message:
now supports bitmapped text!

Index: MyDraw.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/MyDraw.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** MyDraw.pas	2000/11/11 17:57:01	1.3
--- MyDraw.pas	2000/11/18 19:44:20	1.4
***************
*** 31,34 ****
--- 31,35 ----
    InspectorGadget :TGLBitmap;
    SampleText :TGLText;
+   QuadTextSample :TGLText;
  
  // You need to implement these three procedures
***************
*** 48,56 ****
    InspectorGadget := TGLBitmap.Create;
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
!   SampleText := TGLText.Create('Hello World', 'arial1.glf', GLCANVAS_TEXT_GLF);
  
    Sampletext.Lines.Add('Long live the Project');
!   SampleText.Lines.Add('These are lines of text drawn by GLF');
!   SampleText.Lines.Add('----------------------------');
    SampleText.Lines.Add('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
    SampleText.Lines.Add('1234567890');
--- 49,63 ----
    InspectorGadget := TGLBitmap.Create;
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
!   SampleText := TGLText.Create('Hello World', 'Arial', GLCANVAS_TEXT_GLF, GLC_DEFAULT_FONT_DATA);
!   SampleText.Precache := true;
  
    Sampletext.Lines.Add('Long live the Project');
!   SampleText.Lines.Add('These are lines of text drawn by the GLCanvas in GLF mode');
! 
!   QuadTextSample := TGLText.Create('This is a sample of QuadText drawing.','Arial',GLCANVAS_TEXT_QUADTEXT,GLC_DEFAULT_FONT_DATA);
!   QuadTextSample.Lines.Add('Compare to the GLF drawing and see which is better at small sizes.');
!   QuadTextSample.SetColor(clGreen);
! 
!   {SampleText.Lines.Add('----------------------------');
    SampleText.Lines.Add('ABCDEFGHIJKLMNOPQRSTUVWXYZ');
    SampleText.Lines.Add('1234567890');
***************
*** 76,80 ****
    SampleText.Lines.Add('i just want lots of text dwtasdgfdhfdhadfhfdafhfdh');
    SampleText.Lines.Add('ajjjjjjfdkajskdfjdkjalksertujireooeiaudklfakjgdkas');
!   SampleText.Lines.Add('kfldqpptioreptQUITRJAKSjkdlsakjdbtathylayklt=-29');
  
    SampleText.SetColor(clYellow);
--- 83,87 ----
    SampleText.Lines.Add('i just want lots of text dwtasdgfdhfdhadfhfdafhfdh');
    SampleText.Lines.Add('ajjjjjjfdkajskdfjdkjalksertujireooeiaudklfakjgdkas');
!   SampleText.Lines.Add('kfldqpptioreptQUITRJAKSjkdlsakjdbtathylayklt=-29');}
  
    SampleText.SetColor(clYellow);
***************
*** 87,90 ****
--- 94,98 ----
    InspectorGadget.Free;
    SampleText.Free;
+   QuadTextSample.Free;
    GLC.Free;
  end;
***************
*** 102,113 ****
    GLC.CanvasSetup;
  
!   glClearColor(0.2,0.2,1.0,1.0);
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
  
    // this draws the GL bitmap object at these coordinates
!   GLC.DrawBitmap(0,0,InspectorGadget);
  
    // this draws the text object
!   GLC.DrawText(1,1,SampleText);
  end;
  
--- 110,123 ----
    GLC.CanvasSetup;
  
!   glClearColor(0.0,0.0,0.0,1.0);
    glClear(GL_DEPTH_BUFFER_BIT or GL_COLOR_BUFFER_BIT);
  
    // this draws the GL bitmap object at these coordinates
!   GLC.DrawBitmap(20,30,InspectorGadget);
  
    // this draws the text object
!   GLC.DrawText(25,400,QuadTextSample);
!   GLC.DrawText(25,200,SampleText);
! 
  end;
  

Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** glCanvas.pas	2000/11/11 17:57:01	1.3
--- glCanvas.pas	2000/11/18 19:44:20	1.4
***************
*** 34,56 ****
  
    To do-
-     FIX WIERD BUG: if y is <= 10 when drawing text total freezeup occurs
      Fix text caching (display lists) - appears to have no effect on speed :(
!     Fix GL text color bug
!     Add GLF bitmap fonts code
!     Support textured fonts? (mike's code)
      Add shapes code
  
    Fixed:
!     Color bug all better
  }
  
  interface
! uses OpenGL, SysUtils, Graphics, glfD, Classes;
  
  const
    GLCANVAS_TEXT_GLF = 1;
  
  type
  
    // we use this to store the pixel data from a bitmap
    TPixelData = TByteArray;
--- 34,97 ----
  
    To do-
      Fix text caching (display lists) - appears to have no effect on speed :(
!     Add GLF bitmap fonts code - later
      Add shapes code
  
+     QuadText fonts - cell widths are specified in a different part of the
+                      program to the rest of the data. messy. fix it.
+ 
    Fixed:
!     Color bug all better (darryl)
! 
!   Notes:
!     To add a new QuadText font
! 
!     1) Create the bitmap grid
!     2) Add the widths array to the QuadTextUnit.pas file
!     3) Add definition data to the array below
!     4) Add a link in the MatchFontWidths function.
  }
  
  interface
! uses OpenGL, SysUtils, Graphics, glfD, Classes, QuadTextUnit, Textures;
  
  const
    GLCANVAS_TEXT_GLF = 1;
+   GLCANVAS_TEXT_QUADTEXT = 2;
  
+   GLC_MAXFONTS = 4;
+ 
  type
+   EGLCanvasException = class(Exception) end;
+ 
+   TGLCanvasFontData = record
+     Name, FileName:string;
+     FontType :integer;
+   end;
+ 
+   TArrayOfGLCanvasFontData = array[1..GLC_MAXFONTS] of TGLCanvasFontData;
  
+ const
+   GLC_DEFAULT_FONT_DATA :TArrayOfGLCanvasFontData = (
+                             (Name: 'Arial';
+                              FileName: 'arial1.glf';
+                              FontType: GLCANVAS_TEXT_GLF;
+                             ),
+                             (Name: 'Courier New';
+                              FileName: 'courier1.glf';
+                              FontType: GLCANVAS_TEXT_GLF;
+                             ),
+                             (Name: 'Courier New';
+                              FileName: 'CourierNew Grid.bmp';
+                              FontType: GLCANVAS_TEXT_QUADTEXT;
+                             ),
+                             (Name: 'Arial';
+                              FileName: 'Arial Grid.bmp';
+                              FontType: GLCANVAS_TEXT_QUADTEXT;
+                             )
+                           );
+ 
+ type
+ 
    // we use this to store the pixel data from a bitmap
    TPixelData = TByteArray;
***************
*** 75,81 ****
--- 116,126 ----
    end;
  
+ 
+ 
    TGLText = class
    private
      // wraps up the GLF library and possibly other text systems
+     FFonts :TArrayOfGLCanvasFontData;
+ 
      FLines :TStringList;
      FFontName :string;
***************
*** 85,88 ****
--- 130,136 ----
      FDisplayList :integer; // this is used to speed up text drawing
      FPrecache: boolean;
+ 
+     FTexture :TTexture; // stores the texture for QuadText
+ 
      function GetText: string;
      procedure SetFontName(const Value: string);
***************
*** 98,105 ****
--- 146,158 ----
      procedure UpdateDisplayList; virtual ;
      procedure DrawInternal; virtual;
+ 
+     function MatchFontName(name:string; tt:Integer):TGLCanvasFontData;
+     function MatchFontWidths(f:TGLCanvasFontData):TQuadTextWidthsArray;
+ 
    public
  
      TextType :integer; // GLF or something else?
      GLFFontHandle :integer; // glf font id
+     QT:TQuadText; //quadtext record for this text object
  
      // the fontname property holds a filename for GLF
***************
*** 119,123 ****
      property DisplayList :integer read FDisplayList;
  
!     constructor Create(aText, aFontName:string; aTextType:integer);
      destructor Destroy; override ;
      procedure Draw; virtual ;
--- 172,176 ----
      property DisplayList :integer read FDisplayList;
  
!     constructor Create(aText, aFontName:string; aPreferredTextType:integer; FontData:TArrayOfGLCanvasFontData);
      destructor Destroy; override ;
      procedure Draw; virtual ;
***************
*** 270,274 ****
  var t:TGLText;
  begin
!   t := TGLText.Create(str,FontName,aFontType);
    DrawText(X,Y,t);
    t.Free;
--- 323,327 ----
  var t:TGLText;
  begin
!   t := TGLText.Create(str,FontName,aFontType,GLC_DEFAULT_FONT_DATA);
    DrawText(X,Y,t);
    t.Free;
***************
*** 277,286 ****
  procedure TGLCanvas.DrawText(X, Y: Integer; text: TGLText);
  begin
!   glLoadIdentity;
!   // change co-ordinate system  to 1:1 pixel mapping
!   glScalef(2.0 / Width, 2.0 / Height, 1.0);
!   glTranslatef(-(Width / 2), (Height / 2), 0);
  
!   glTranslatef(X,-Y,0);
  
    text.Draw;
--- 330,351 ----
  procedure TGLCanvas.DrawText(X, Y: Integer; text: TGLText);
  begin
!   if text.TextType = GLCANVAS_TEXT_GLF then
!   begin
!     glMatrixMode(GL_MODELVIEW);
!     glLoadIdentity;
!     // change co-ordinate system  to 1:1 pixel mapping
!     glScalef(2.0 / Width, 2.0 / Height, 1.0);
!     glTranslatef(-(Width / 2), (Height / 2), 0);
!     glTranslatef(X,-Y,0);
!   end else if text.TextType = GLCANVAS_TEXT_QUADTEXT then
!   begin
!     glMatrixMode(GL_MODELVIEW);
!     glLoadIdentity;
!     // change co-ordinate system  to 1:1 pixel mapping
!     glScalef(2.0 / Width, -2.0 / Height, 1.0);
!     glTranslatef(-(Width / 2), -(Height / 2), 0);
  
!     glTranslatef(X,Y,0);
!   end;
  
    text.Draw;
***************
*** 289,302 ****
  { TGLText }
  
! constructor TGLText.Create(aText, aFontName: string; aTextType:integer);
  begin
    inherited Create;
!   FPrecache := true;
    FLines := TStringList.Create;
    FSize := 10.0;
    FLines.Text := aText;
    FDisplayList := -1;
!   TextType := aTextType;
    FFontName := aFontName;
    LoadFont;
    if Precache then
--- 354,369 ----
  { TGLText }
  
! constructor TGLText.Create(aText, aFontName: string; aPreferredTextType:integer; FontData:TArrayOfGLCanvasFontData);
  begin
    inherited Create;
!   FPrecache := false;
    FLines := TStringList.Create;
    FSize := 10.0;
    FLines.Text := aText;
    FDisplayList := -1;
!   TextType := aPreferredTextType;
    FFontName := aFontName;
+   FFonts := FontData;
+   FTexture := nil;
    LoadFont;
    if Precache then
***************
*** 336,342 ****
        glfDrawSolidStringF(GLFFontHandle,FLines[a]);
        glPopMatrix;
!       glTranslatef(0,maxy/2,0); // move down a line
      end;
      glPopMatrix;
    end; // add more text types here
  end;
--- 403,417 ----
        glfDrawSolidStringF(GLFFontHandle,FLines[a]);
        glPopMatrix;
!       glTranslatef(0,-2,0); // move down a line
      end;
      glPopMatrix;
+   end else if TextType = GLCANVAS_TEXT_QUADTEXT then
+   begin
+     glColor3f(FRed, FGreen, FBlue);
+     qtStart;
+       glPushMatrix;
+         qtDrawGridString(QT,FLines.Text);
+       glPopMatrix;
+     qtStop;
    end; // add more text types here
  end;
***************
*** 348,361 ****
  
  procedure TGLText.LoadFont;
  begin
    if TextType = GLCANVAS_TEXT_GLF then
    begin
!     if ExtractFileExt(FontName) = '.glf' then
      begin
!       GLFFontHandle := glfLoadFont(FontName);
        if GLFFontHandle = GLF_ERROR then raise Exception.Create('Could not load font');
!     end else if ExtractFileExt(FontName) = '.bmf' then
!       glfLoadBMFFont(FontName);
    end; // add more text types here
  end;
  
--- 423,475 ----
  
  procedure TGLText.LoadFont;
+ var f:TGLCanvasFontData;
  begin
+   f := MatchFontName(FontName,TextType);
    if TextType = GLCANVAS_TEXT_GLF then
    begin
!     if ExtractFileExt(f.FileName) = '.glf' then
      begin
!       GLFFontHandle := glfLoadFont(f.FileName);
        if GLFFontHandle = GLF_ERROR then raise Exception.Create('Could not load font');
!     end else if ExtractFileExt(f.FileName) = '.bmf' then
!       glfLoadBMFFont(f.FileName);
!   end else if TextType = GLCANVAS_TEXT_QUADTEXT then
!   begin
!     if assigned(FTexture) then FTexture.Free;
!     FTexture := TTexture.Create;
!     FTexture.LoadFromFile(f.FileName);
!     QT.TextureID := FTexture.TexID;
!     QT.GridSquareWidth := 20;
!     QT.GridSquareHeight := 20;
!     QT.GridCells := 12;
!     QT.GridCharSpacing := 2;
!     QT.SpaceWidth := 5;
!     QT.TexWidths := MatchFontWidths(f);
    end; // add more text types here
+ end;
+ 
+ function TGLText.MatchFontName(name: string; tt: Integer): TGLCanvasFontData;
+ var a:integer;
+ begin
+   // returns first match
+   for a := 1 to GLC_MAXFONTS do
+     if (UpperCase(FFonts[a].Name) = UpperCase(name)) and (FFonts[a].FontType = tt) then
+     begin
+       Result := FFonts[a];
+       exit;
+     end;
+   raise EGLCanvasException.Create('No match found for font "'+name+'"');
+ end;
+ 
+ function TGLText.MatchFontWidths(
+   f: TGLCanvasFontData): TQuadTextWidthsArray;
+ begin
+   // fudge, delphi won't let me specify this in the
+   // defaults array for some reason.
+ 
+   if UpperCase(f.Name) = 'ARIAL' then
+     result := ARIAL_WIDTHS
+   else if UpperCase(f.Name) = 'COURIER NEW' then
+     Result := COURIERNEW_WIDTHS;
  end;
  

Index: glfD.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glfD.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** glfD.pas	2000/11/11 17:13:12	1.1
--- glfD.pas	2000/11/18 19:44:20	1.2
***************
*** 6,15 ****
  ==============================================================================
  |  GLF Library
! |  Version 1.1 (Beta)
  | 
  |  Author: Roman Podobedov
  |  Email: ro...@ut...
  |  WEB: http://romka.demonews.com
! |  Date: 25 October 2000
  |  
  |  Copyright (C) 2000, Romka Graphics
--- 6,15 ----
  ==============================================================================
  |  GLF Library
! |  Version 1.11
  | 
  |  Author: Roman Podobedov
  |  Email: ro...@ut...
  |  WEB: http://romka.demonews.com
! |  Date: 12 November 2000
  |  
  |  Copyright (C) 2000, Romka Graphics
***************
*** 22,33 ****
  Translation to Delphi:
  - Kamil Krauspe (main guy)
! - Michael Hearn (minor changes), added console commands + console bug fixes
  - Darryl Long (teeny little changes)
! - Ilkka Tuomioja (updated to v1.1)
  
  For the Pythian Project
  }
  
- {.$DEFINE debugging}
  uses
    Windows, SysUtils, OpenGL;
--- 22,32 ----
  Translation to Delphi:
  - Kamil Krauspe (main guy)
! - Michael Hearn (minor changes), added some console commands + console bug fixes
  - Darryl Long (teeny little changes)
! - Ilkka Tuomioja (updated to v1.1beta and v1.11)
  
  For the Pythian Project
  }
  
  uses
    Windows, SysUtils, OpenGL;
***************
*** 114,118 ****
    procedure glfSetContourColor(r, g, b, a: Integer); //* Contour color */
  
!   //* Enable/Disable GLF features */
    procedure glfEnable(what: Integer); //* Enable GLF feature 'what' */
    procedure glfDisable(what: Integer); //* Disable GLF feature 'what' */
--- 113,117 ----
    procedure glfSetContourColor(r, g, b, a: Integer); //* Contour color */
  
!   //* Enable or Disable GLF features */
    procedure glfEnable(what: Integer); //* Enable GLF feature 'what' */
    procedure glfDisable(what: Integer); //* Disable GLF feature 'what' */
***************
*** 1104,1109 ****
  procedure glfPrint(const s: string; lenght: Integer);
  var
!   i,c{, e}: Integer;
!   str2:string;
  begin
    for i := 1 to lenght do
--- 1103,1108 ----
  procedure glfPrint(const s: string; lenght: Integer);
  var
!   i{,c, e}: Integer;
!   {str2:string;}
  begin
    for i := 1 to lenght do
***************
*** 1206,1217 ****
  {
     --------------------------------------------------------------------------------- 
!    ------------------------ Work with bitmapped fonts ------------------------------ 
!    --------------------------------------------------------------------------------- 
! }
! {
! 		!!!THIS PIECE OF CODE IS UNDER DEVELOPMENT!!!
! 			!!!NO COMMENTS AT THIS TIME!!!
  }
  
  procedure bwtorgba(b: PByteArray; l: PByteArray; n: Integer);
  var
--- 1205,1213 ----
  {
     --------------------------------------------------------------------------------- 
!    ------------------------ Work with bitmapped fonts ------------------------------
!    ---------------------------------------------------------------------------------
  }
  
+ //* Some color conversions */
  procedure bwtorgba(b: PByteArray; l: PByteArray; n: Integer);
  var
***************
*** 1298,1301 ****
--- 1294,1298 ----
  end;
  
+ //* Open RGB Image */
  function ImageOpen(f: Integer): PImageRec;
  var
***************
*** 1306,1312 ****
    x: Integer;
  begin
- 	{$IFDEF DEBUGGING}
-   	WriteLn('ImageOpen startpoint.');
-   {$ENDIF}
    Result := nil;
  
--- 1303,1306 ----
***************
*** 1317,1326 ****
    else
      swapFlag := 0;
-   {$IFDEF DEBUGGING}
-     if SwapFlag = 1 then
- 	  	WriteLn('Swapping bytes')
-     else
-     	WriteLn('No swapping reguired');
-   {$ENDIF}
  
    GetMem(image, sizeof(TImageRec));
--- 1311,1314 ----
***************
*** 1345,1362 ****
      exit;
    end;
- 	{$IFDEF DEBUGGING}
-   	WriteLn('iMagic: ' + IntToHex(image.imagic, 4));
-   	WriteLn('Type: ' + IntToHex(image.type_, 4));
-   	WriteLn('Dimensions: ' + IntToStr(image.dim));
-   	WriteLn('x-size: ' + IntToStr(image.xsize));
-   	WriteLn('y-size: ' + IntToStr(image.ysize));
-   	WriteLn('z-size: ' + IntToStr(image.zsize));
- 	{$ENDIF}
  
    if (image.type_ and $ff00) = $0100 then
    begin
- 	  {$IFDEF DEBUGGING}
-   		WriteLn('Packed');
- 	  {$ENDIF}
      x := image.ysize * image.zsize * SizeOf(Pointer);
    	GetMem(image.rowStart, x);
--- 1333,1339 ----
***************
*** 1365,1374 ****
      begin
        WriteLn('Out of memory, rows nil!');
- 		  {$IFDEF DEBUGGING}
-   			if image.rowStart = nil then
-         	WriteLn('rowStart = nil');
-         if image.rowSize = nil then
-           WriteLn('rowSize = nil');
- 		  {$ENDIF}
        exit;
      end;
--- 1342,1345 ----
***************
*** 1386,1402 ****
    	image.rowStart := nil;
      image.rowSize := nil;
- 	  {$IFDEF DEBUGGING}
-   		WriteLn('Not packed');
- 	  {$ENDIF}
    end;
    Result := image;
- 	{$IFDEF DEBUGGING}
-   	WriteLn('ImageOpen endpoint');
-   {$ENDIF}
  end;
  
  procedure ImageClose(image: PImageRec);
  begin
- //  FileClose(image.file_);
    FreeMem(image.tmp);
    FreeMem(image.tmpR);
--- 1357,1367 ----
    	image.rowStart := nil;
      image.rowSize := nil;
    end;
    Result := image;
  end;
  
+ //* Close Image and free data */
  procedure ImageClose(image: PImageRec);
  begin
    FreeMem(image.tmp);
    FreeMem(image.tmpR);
***************
*** 1406,1414 ****
    FreeMem(image.rowStart);
    FreeMem(image);
- 	{$IFDEF DEBUGGING}
-   	WriteLn('ImageClose');
-   {$ENDIF}
  end;
  
  procedure ImageGetRow(image: PImageRec; buf: PByteArray; y: Integer; z: Integer);
  var
--- 1371,1377 ----
    FreeMem(image.rowStart);
    FreeMem(image);
  end;
  
+ //* Pixels row decoding (if used RLE encoding) */
  procedure ImageGetRow(image: PImageRec; buf: PByteArray; y: Integer; z: Integer);
  var
***************
*** 1434,1440 ****
        if  count = 0 then
        begin
- 				{$IFDEF DEBUGGING}
-         	WriteLn('ImageGetRow: exit as count = 0');
- 				{$ENDIF}
          exit;
        end;
--- 1397,1400 ----
***************
*** 1465,1468 ****
--- 1425,1429 ----
  end;
  
+ //* Read SGI (RGB) Image from file */
  function read_texture(f: Integer; width: PInteger; height: PInteger; components: PInteger): Pointer;
  var
***************
*** 1472,1478 ****
    y: Integer;
  begin
- 	{$IFDEF DEBUGGING}
-   	WriteLn('Read_texture startpoint');
-   {$ENDIF}
    Result := nil;
    image := ImageOpen(f);
--- 1433,1436 ----
***************
*** 1493,1499 ****
    end;
    lptr := base;
- 	{$IFDEF DEBUGGING}
-   	WriteLn('Getting rows');
- 	{$ENDIF}
    for y:= 0 to image.ysize-1 do
    begin
--- 1451,1454 ----
***************
*** 1525,1531 ****
      end;
    end;
- 	{$IFDEF DEBUGGING}
-   	WriteLn('Getting rows done');
- 	{$ENDIF}
    ImageClose(image);
    FreeMem(rbuf);
--- 1480,1483 ----
***************
*** 1535,1543 ****
  
    result := base;
- 	{$IFDEF DEBUGGING}
-   	WriteLn('Read_texture endpoint');
-   {$ENDIF}
  end;
  
  function glfLoadBMFFont(const FName: string): Integer;
  var
--- 1487,1493 ----
  
    result := base;
  end;
  
+ //* Load BMF file format */
  function glfLoadBMFFont(const FName: string): Integer;
  var
***************
*** 1547,1564 ****
    i: Integer;
  begin
    f := FileOpen(FName, fmOpenRead);
  
    FileRead(f, Header, 3);
    Header[3] := #0;
    if strcomp(Header, 'BMF') <> 0 then
-   begin
-     result := -1;
      Exit;
-   end;
  
    FileRead(f, FontName, 96);
    FontName[96] := #0;
- //	WriteLn('Font name: ' + FontName);
  
    for i := 0  to 255 do
    begin
--- 1497,1517 ----
    i: Integer;
  begin
+   Result := -1;
+ 
    f := FileOpen(FName, fmOpenRead);
+   if (f < 0) then	//* Error opening file */
+   	Exit;
  
+ 	//* Get header */
    FileRead(f, Header, 3);
    Header[3] := #0;
    if strcomp(Header, 'BMF') <> 0 then
      Exit;
  
+ 	//* Get font name */
    FileRead(f, FontName, 96);
    FontName[96] := #0;
  
+ 	// Read all 256 symbols information */
    for i := 0  to 255 do
    begin
***************
*** 1568,1571 ****
--- 1521,1526 ----
      FileRead(f, Symbols[i].height, 4);
    end;
+ 
+ 	//* Read texture image from file and build texture */
    texture := read_texture(f, @twidth, @theight, @tcomp);
    glBindTexture(GL_TEXTURE_2D, bmf_texture);
***************
*** 1574,1577 ****
--- 1529,1533 ----
    glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, twidth, theight, 0, GL_RGBA, GL_UNSIGNED_BYTE, texture);
  
+ 	//* Linear filtering for better quality */
    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
***************
*** 1580,1583 ****
--- 1536,1540 ----
    FileClose(f);
  
+ 	//* Now build list for each symbol */
    list_base := glGenLists(256);
    for i := 0 to 255 do
***************
*** 1585,1589 ****
      glNewList(list_base+i, GL_COMPILE);
      glBegin(GL_QUADS);
!       glTexCoord2f(Symbols[i].x, Symbols[i].y); glVertex2f(0, 0);
        glTexCoord2f(Symbols[i].x + Symbols[i].width, Symbols[i].y);
        glVertex2f(Symbols[i].width, 0);
--- 1542,1547 ----
      glNewList(list_base+i, GL_COMPILE);
      glBegin(GL_QUADS);
!       glTexCoord2f(Symbols[i].x, Symbols[i].y);
!       glVertex2f(0, 0);
        glTexCoord2f(Symbols[i].x + Symbols[i].width, Symbols[i].y);
        glVertex2f(Symbols[i].width, 0);
***************
*** 1602,1607 ****
--- 1560,1567 ----
  end;
  
+ //* Start bitmap drawing function */
  procedure glfStartBitmapDrawing;
  begin
+ 	//* Enable 2D Texturing */
    glGetBooleanv(GL_TEXTURE_2D, @bmf_texturing);
    glEnable(GL_TEXTURE_2D);
***************
*** 1609,1618 ****
--- 1569,1581 ----
  end;
  
+ //* Stop bitmap drawing function */
  procedure glfStopBitmapDrawing;
  begin
+ 	//* Return previuos state of texturing */
    if bmf_texturing = GL_TRUE then glEnable(GL_TEXTURE_2D)
    else glDisable(GL_TEXTURE_2D);
  end;
  
+ //* Draw one bitmapped symbol */
  procedure glfDrawBSymbol(s: Char);
  begin
***************
*** 1620,1623 ****
--- 1583,1587 ----
  end;
  
+ //* Draw bitmapped string */
  procedure glfDrawBString(s: string);
  begin
***************
*** 1626,1635 ****
  end;
  
- initialization
- // init glf
- glfInit;
- glfSetAnchorPoint(GLF_LEFT_UP);
- 
- finalization
- glfClose;
  end.
--- 1590,1592 ----

[Pythianproject-cvsmail] CVS: Prototypes/TextureDemo Arial Grid.bmp,NONE,1.1 CourierNew Grid.bmp,NONE,1.1 QuadTextUnit.pas,NONE,1.1 frmGridGen.dfm,NONE,1.1 frmGridGen.pas,NONE,1.1 frmMain.dfm,NONE,1.1 frmMain.pas,NONE,1.1 texdemo.dpr,NONE,1.1

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/TextureDemo
In directory slayer.i.sourceforge.net:/tmp/cvs-serv10071/TextureDemo

Added Files:
	Arial Grid.bmp CourierNew Grid.bmp QuadTextUnit.pas 
	frmGridGen.dfm frmGridGen.pas frmMain.dfm frmMain.pas 
	texdemo.dpr 
Log Message:
no message

***** Bogus filespec: Arial
***** Error reading new file: (2, 'No such file or directory')
***** Bogus filespec: CourierNew
***** Error reading new file: (2, 'No such file or directory')
--- NEW FILE ---
unit QuadTextUnit;

interface

{

  Textured Quads text system
  Michael Hearn

  (C) Pythian Project 2000


  Todo -
}

const
  NUMCHARS = 69;

type
  TQuadTextWidthsArray = array[1..NUMCHARS] of integer;

const
  TEX_CHARS:array[1..NUMCHARS] of char =
                                ('A','B','C','D','E','F','G','H','I','J','K','L',
                                 'M','N','O','P','Q','R','S','T','U','V','W','X',
                                 'Y','Z','a','b','c','d','e','f','g','h','i','j',
                                 'k','l','m','n','o','p','q','r','s','t','u','v',
                                 'w','x','y','z','1','2','3','4','5','6','7','8',
                                 '9','0','!','"','?','.','''','(',')');

  COURIERNEW_WIDTHS :TQuadTextWidthsArray = (
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10,  8,  8,  8,  8,  8,  8,  8,  8,  3,  3,
                                  8,  3, 12,  8,  8,  8,  8,  5,  8,  5,  8,  8,
                                  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                  8,  8,  4,  6,  7,  2,  2,  3,  3);
  ARIAL_WIDTHS :TQuadTextWidthsArray = (
                                 9,  10, 10, 10, 10,  9, 10, 10, 2,  9, 10,  9,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 16, 10,
                                 10, 10, 8,  8,  8,  8,  8,  5,  8,  8,  2,  3,
                                 8,  2,  12, 8,  8,  8,  8,  5,  8,  5,  8,  8,
                                 8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                 12, 8,  4,  6,  7,  2,  2,  3,  3);
type
  TQuadText = record
    TextureID :integer;
    GridSquareWidth,GridSquareHeight :integer; // size of grid square
    GridCells:integer; // how many cells in each direction
    GridCharSpacing:integer; // spacing between letters.
    SpaceWidth:integer; // size of a ' ' character.
    TexWidths :TQuadTextWidthsArray;
  end;


procedure qtStart;
procedure qtStop;
function qtDrawGridChar(QT:TQuadText; C:Char):integer; // returns index of char
function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
procedure qtDrawGridString(QT:TQuadText; s:String);

implementation
uses OpenGL, Graphics;

var
  dtStore :TGLBoolean;

function qtDrawGridChar(QT:TQuadText; C:Char):integer;
var
  AlphaOffset :integer;
  x,y:integer;
begin
  AlphaOffset := -1;
  for x := 1 to NUMCHARS do
    if TEX_CHARS[x] = C then AlphaOffset := x;

  result := AlphaOffset;
  if AlphaOffset <> -1 then
  begin
    // AlphaOffset contains the grid offset of the character now
    // in this test grid there are 12 per line
    Y := (AlphaOffset div QT.GridCells);
    if AlphaOffset mod QT.GridCells <> 0 then // need this in case letter is last on grid line
      inc(y);
    X := AlphaOffset - ((Y-1)*QT.GridCells);
    qtDrawGridSquare(QT,x,y);
  end;
end;


function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
var l,t:integer;
    dt:TGLBoolean;
begin
  Result := -1;
  glBindTexture(GL_TEXTURE_2D, QT.TextureID);
  l := 256 - (QT.GridSquareWidth * (x-1));
  t := (Y - 1) * QT.GridSquareHeight;

  glBegin(GL_QUADS);
    glTexCoord2f(l,t);
    glVertex2f(0,0);
    glTexCoord2f(l,t+QT.GridSquareHeight);
    glVertex2f(0,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t+QT.GridSquareHeight);
    glVertex2f(QT.GridSquareWidth,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t);
    glVertex2f(QT.GridSquareWidth,0);
  glEnd;

  result := 0;
end;


procedure qtDrawGridString(QT:TQuadText; s:String);
var
  o,a:integer;
begin
  glPushMatrix;
  glPushMatrix;
  if length(s) = 1 then
  begin
    qtDrawGridChar(qt,s[1]);
  end else
  for a := 1 to Length(s) do
  begin
    if s[a] = #13 then
    begin
      glPopMatrix;
      glTranslatef(0,QT.GridSquareHeight,0); // translate down
      glPushMatrix;
    end else begin
      o := qtDrawGridChar(QT,s[a]);
      if o <> -1 then
        glTranslatef(QT.TexWidths[o]+QT.GridCharSpacing,0,0)
      else // translate for space character
        glTranslatef(QT.SpaceWidth,0,0);
    end;
  end;
  glPopMatrix;
  glPopMatrix;
end;

procedure qtStart;
begin
  glGetBooleanv(GL_DEPTH_TEST,@dtstore);
  glDisable(GL_DEPTH_TEST);
end;

procedure qtStop;
begin
  if dtstore <> 0 then glEnable(GL_DEPTH_TEST);
end;


end.

--- NEW FILE ---
ÿ

Font.ColorclWindowTextFont.Heightõ	Font.Name
MS Sans Serif
Font.Style
TextHeight
--- NEW FILE ---
unit frmGridGen;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, QuadTextUnit; 



type
  TGridGenForm = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function MakeGrid(f:TFont):TBitmap;
  end;

var
  GridGenForm: TGridGenForm;

implementation

{$R *.DFM}

procedure TGridGenForm.FormClick(Sender: TObject);
var b:TBitmap;
begin
  b := MakeGrid(Font);
  Canvas.Draw(0,0,b);
  b.free;
end;

function TGridGenForm.MakeGrid(f: TFont): TBitmap;
var
  gh,gw,cw,ch:integer; // graphics width (cell count), graphics height, cell width, cell height
  b:TBitmap;
  TxtMetrics :TEXTMETRIC;
  c,ttop,tleft:integer;
begin
  // grid creation logic
  b := TBitmap.Create;
  b.Canvas.Font := Font;
  b.Canvas.Font.Color := clBlack;
//  b.Canvas.Re
  b.Width := 256;
  b.Height := 256;
  ch := f.Height;
  if Integer(GetTextMetrics(b.Canvas.Handle,TxtMetrics)) = 0 then raise Exception.Create('GetTextMetrics() failed');
  cw := TxtMetrics.tmMaxCharWidth;

  gh := 12;  // number of rows
  gw := 12;  // number of cells each row
  cw := 20; ch := 20; //cell size

  for c := 0 to NUMCHARS-1 do
  begin
    // locate top left
    ttop := (c div gw)*ch;
    tleft := (c - ttop)*cw;
    b.Canvas.TextOut(tleft,ttop,TEX_CHARS[c+1]);
  end;

  Result := b;
end;

end.

--- NEW FILE ---
ÿ

Font.ColorclWindowTextFont.Heightõ	Font.Name
MS Sans Serif
Font.Style
TextHeight
Exit1Click
FrameTimerInterval
OnTimerFrameTimerTimerLeft„
--- NEW FILE ---
unit frmMain;

{ Basic 3D application
  (C) Michael Hearn 2000
  mh...@su... }



interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, GLPanel, OpenGL, Textures, Trace, QuadTextUnit;

type
  TMainForm = class(TForm)
    GLPanel: TGLPanel;
    MainMenu: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    FrameTimer: TTimer;
    procedure FrameTimerTimer(Sender: TObject);
    procedure GLPanelGLInit(Sender: TObject);
    procedure GLPanelResize(Sender: TObject);
    procedure GLPanelGLDraw(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }


    TestTex :TTexture;
    ArialTex :TTexture;

     // Animation trackers can go here
    animSquare: integer; // this var will be cycled through 1..360
                         // which states the angle of the square. By
                         // incrementing this every frame we can create
                         // a rotating square :)


    QT:TQuadText;
    Arial :TQuadText;

    txtfile :TStringList;
    counter1 :integer;

    txtList:integer;

    procedure SetProjection(Sender: TObject);

    procedure MakeList;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.FrameTimerTimer(Sender: TObject);
begin
  { Add code to advance animations etc. here }
  inc(animSquare);
  if animSquare >= 360 then animSquare := 0;

  // now redraw the screen
  GLPanel.GLReDraw;
end;

procedure TMainForm.SetProjection(Sender: TObject);
var
  gldAspect : TGLdouble;
begin
   // Redefine the viewing volume and viewport when the window size changes.
  gldAspect := GLPanel.Width / GLPanel.Height;

  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  gluPerspective(30.0,           // Field-of-view angle
                 gldAspect,      // Aspect ratio of viewing volume
                 1.0,            // Distance to near clipping plane
                 100.0);          // Distance to far clipping plane
  glViewport(0, 0, GLPanel.Width, GLPanel.Height);
  InvalidateRect(Handle, nil, False);
end;


procedure TMainForm.GLPanelGLInit(Sender: TObject);
var
  a:integer;
  glfloat :TGLFloat;
begin
  // Add GL init code here
  // Any enable/disable commands that affect the entire app should go here

  //
  // Enable depth testing and alpha blending
  //
  glEnable(GL_DEPTH_TEST);
  glEnable(GL_BLEND);
  glBlendFunc(GL_SRC_ALPHA,GL_ONE);
  // uncomment this line to enable alpha blending

  // set up Courier New
  TestTex := TTexture.Create;
  TestTex.UseAlpha := false;
  TestTex.UseMipmaps := false;
  TestTex.LoadFromFile('CourierNew Grid.bmp');

  QT.GridSquareWidth := 20;
  QT.GridSquareHeight := 20;
  QT.GridCharSpacing := 2;
  QT.GridCells := 12;
  QT.SpaceWidth := 5;
  QT.TextureID := TestTex.ID;
  // set widths
  QT.TexWidths := COURIERNEW_WIDTHS;

  // set up Arial
  ArialTex := TTexture.Create;
  ArialTex.LoadFromFile('Arial Grid.bmp');

  Arial.GridSquareWidth := 20;
  Arial.GridSquareHeight := 20;
  Arial.GridCharSpacing := 2;
  Arial.GridCells := 12;
  Arial.SpaceWidth := 5;
  Arial.TextureID := ArialTex.ID;
  Arial.TexWidths := ARIAL_WIDTHS;

  txtFile := TStringList.Create;
  txtFile.LoadFromFile('movies.txt');

  txtList := glGenLists(1);
  Counter1 := 0;
  MakeList;
end;

procedure TMainForm.GLPanelResize(Sender: TObject);
begin
  SetProjection(Sender); // this sets up the view
  // init any variables here
  animSquare := 0;
end;

procedure TMainForm.GLPanelGLDraw(Sender: TObject);
begin
  //
  // Clear the color and depth buffers.
  //
  glClearColor(0.0,0.0,0.0,1.0); // clear to black
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  // reset the matrix to it's identity (original, unmodified) matrix
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;


  { ADD YOUR DRAWING CODE HERE }

  // scale and rotate
  glScalef(0.5,0.5,0.5);
  glRotatef(animSquare,0.0,1.0,0.5);
  //
  // Draw the six faces of the cube.
  //
  glDisable(GL_BLEND);
  glColor4f(1.0,0.0,0.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(0.0, 0.0, 1.0);
    glVertex3f(1.0, 1.0, 1.0);
    glVertex3f(-1.0, 1.0, 1.0);
    glVertex3f(-1.0, -1.0, 1.0);
    glVertex3f(1.0, -1.0, 1.0);
  glEnd;

  glColor4f(0.0,1.0,0.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(0.0, 0.0, -1.0);
    glVertex3f(1.0, 1.0, -1.0);
    glVertex3f(1.0, -1.0, -1.0);
    glVertex3f(-1.0, -1.0, -1.0);
    glVertex3f(-1.0, 1.0, -1.0);
  glEnd;

  glColor4f(0.0,0.0,1.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(-1.0, 0.0, 0.0);
    glVertex3f(-1.0, 1.0, 1.0);
    glVertex3f(-1.0, 1.0, -1.0);
    glVertex3f(-1.0, -1.0, -1.0);
    glVertex3f(-1.0, -1.0, 1.0);
  glEnd;

  glColor4f(0.0,1.0,1.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(1.0, 0.0, 0.0);
    glVertex3f(1.0, 1.0, 1.0);
    glVertex3f(1.0, -1.0, 1.0);
    glVertex3f(1.0, -1.0, -1.0);
    glVertex3f(1.0, 1.0, -1.0);
  glEnd;

  glColor4f(1.0,1.0,0.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(0.0, 1.0, 0.0);
    glVertex3f(-1.0, 1.0, -1.0);
    glVertex3f(-1.0, 1.0, 1.0);
    glVertex3f(1.0, 1.0, 1.0);
    glVertex3f(1.0, 1.0, -1.0);
  glEnd;

  glColor4f(1.0,1.0,1.0,1.0);
  glBegin(GL_POLYGON);
    glNormal3f(0.0, -1.0, 0.0);
    glVertex3f(-1.0, -1.0, -1.0);
    glVertex3f(1.0, -1.0, -1.0);
    glVertex3f(1.0, -1.0, 1.0);
    glVertex3f(-1.0, -1.0, 1.0);
  glEnd;


  glLoadIdentity;

  glClear(GL_DEPTH_BUFFER_BIT);
  glEnable(GL_TEXTURE_2D);
  glEnable(GL_BLEND);

  // change co-ordinate system  to 1:1 pixel mapping
  glScalef(2.0 / GLPanel.Width, -2.0 / GLPanel.Height, 1.0);
  glTranslatef(-(GLPanel.Width / 2), -(GLPanel.Height / 2), 0);

  glMatrixMode(GL_TEXTURE);
  glLoadIdentity;
  glScalef(1/256,1/256,1);

  // left = 256 right = 0
  // top = 0 bottom = 256
  //
  // left = 256 - (20 * (x-1))

  glMatrixMode(GL_MODELVIEW);

  glEnable(GL_SCISSOR_TEST);

  inc(Counter1);
  if Counter1 >= 100 then
  begin
    MakeList;
    Counter1 := 0;
  end;
  glScissor(0,0,640,380);
  glPushMatrix;
  gltranslatef(0,animSquare-500,0);
  qtStart;
  glCallList(txtList);
  glPopMatrix;

  glDisable(GL_SCISSOR_TEST);
  glColor3f(1.0,0.0,0.0);
  qtDrawGridString(QT,'The quick brown (?) fox'#13'JUMPED "over" the lazy dog!?!');
  glTranslatef(300,0,0);
  glColor3f(0.2,0.2,1.0);
  qtDrawGridString(Arial,'THE QUICK BROWN FOX JUMPED'#13'OVER THE LAZY DOG.'#13' ()!'',"?');

  qtStop;
  glDisable(GL_TEXTURE_2D);

end;

procedure TMainForm.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.MakeList;
var
  x,y:integer;
  s:string;
begin
  glNewList(txtList,GL_COMPILE);
    for y := 1 to 800 div 20 do
    begin
      glPushMatrix;
      s := '';
      for x := 1 to 60 do
      begin
        s := s + Chr(Trunc(Random(52)+Ord('A')));
      end;
      qtDrawGridString(QT,s);
      glPopMatrix;
      glTranslatef(0,20,0);
    end;
  glEndList;
end;

end.

--- NEW FILE ---
program texdemo;

uses
  Forms,
  frmMain in 'frmMain.pas' {MainForm},
  frmGridGen in 'frmGridGen.pas' {GridGenForm},
  QuadTextUnit in 'QuadTextUnit.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.Title := 'Texure Demo app';
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TGridGenForm, GridGenForm);
  Application.Run;
end.

[Pythianproject-cvsmail] CVS: Prototypes/TextureDemo - New directory

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/TextureDemo
In directory slayer.i.sourceforge.net:/tmp/cvs-serv9599/TextureDemo

Log Message:
Directory /cvsroot/pythianproject/Prototypes/TextureDemo added to the repository

[Pythianproject-cvsmail] CVS: Prototypes/BasicGLapp Arial Grid.bmp,1.1,NONE CourierNew Grid.bmp,1.2,NONE QuadTextUnit.pas,1.1,NONE frmGridGen.dfm,1.1,NONE frmGridGen.pas,1.1,NONE frmMain.dfm,1.1,NONE frmMain.pas,1.5,NONE texdemo.cfg,1.1,NONE texdemo.dof,1.1,NONE texdemo.dpr,1.2,NONE

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/BasicGLapp
In directory slayer.i.sourceforge.net:/tmp/cvs-serv8166

Removed Files:
	Arial Grid.bmp CourierNew Grid.bmp QuadTextUnit.pas 
	frmGridGen.dfm frmGridGen.pas frmMain.dfm frmMain.pas 
	texdemo.cfg texdemo.dof texdemo.dpr 
Log Message:
no message

***** Bogus filespec: Arial
--- Grid.bmp DELETED ---

***** Bogus filespec: CourierNew
--- Grid.bmp DELETED ---

--- QuadTextUnit.pas DELETED ---

--- frmGridGen.dfm DELETED ---

--- frmGridGen.pas DELETED ---

--- frmMain.dfm DELETED ---

--- frmMain.pas DELETED ---

--- texdemo.cfg DELETED ---

--- texdemo.dof DELETED ---

--- texdemo.dpr DELETED ---

[Pythianproject-cvsmail] CVS: Prototypes/BasicGLapp Arial Grid.bmp,NONE,1.1 QuadTextUnit.pas,NONE,1.1 frmGridGen.dfm,NONE,1.1 frmGridGen.pas,NONE,1.1 CourierNew Grid.bmp,1.1,1.2 frmMain.pas,1.4,1.5 texdemo.dpr,1.1,1.2

[Michael H. <mh...@us...>]

Update of /cvsroot/pythianproject/Prototypes/BasicGLapp
In directory slayer.i.sourceforge.net:/tmp/cvs-serv30286

Modified Files:
	CourierNew Grid.bmp frmMain.pas texdemo.dpr 
Added Files:
	Arial Grid.bmp QuadTextUnit.pas frmGridGen.dfm frmGridGen.pas 
Log Message:
major update to the quadtext system

***** Bogus filespec: Arial
***** Error reading new file: (2, 'No such file or directory')
--- NEW FILE ---
unit QuadTextUnit;

interface

{

  Textured Quads text system
  Michael Hearn

  (C) Pythian Project 2000


  Todo -
}

const
  NUMCHARS = 69;

type
  TQuadTextWidthsArray = array[1..NUMCHARS] of integer;

const
  TEX_CHARS:array[1..NUMCHARS] of char =
                                ('A','B','C','D','E','F','G','H','I','J','K','L',
                                 'M','N','O','P','Q','R','S','T','U','V','W','X',
                                 'Y','Z','a','b','c','d','e','f','g','h','i','j',
                                 'k','l','m','n','o','p','q','r','s','t','u','v',
                                 'w','x','y','z','1','2','3','4','5','6','7','8',
                                 '9','0','!','"','?','.','''','(',')');

  COURIERNEW_WIDTHS :TQuadTextWidthsArray = (
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
                                 10, 10,  8,  8,  8,  8,  8,  8,  8,  8,  3,  3,
                                  8,  3, 12,  8,  8,  8,  8,  5,  8,  5,  8,  8,
                                  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                  8,  8,  4,  6,  7,  2,  2,  3,  3);
  ARIAL_WIDTHS :TQuadTextWidthsArray = (
                                 9,  10, 10, 10, 10,  9, 10, 10, 2,  9, 10,  9,
                                 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 16, 10,
                                 10, 10, 8,  8,  8,  8,  8,  5,  8,  8,  2,  3,
                                 8,  2,  12, 8,  8,  8,  8,  5,  8,  5,  8,  8,
                                 8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,  8,
                                 12, 8,  4,  6,  7,  2,  2,  3,  3);
type
  TQuadText = record
    TextureID :integer;
    GridSquareWidth,GridSquareHeight :integer; // size of grid square
    GridCells:integer; // how many cells in each direction
    GridCharSpacing:integer; // spacing between letters.
    SpaceWidth:integer; // size of a ' ' character.
    TexWidths :TQuadTextWidthsArray;
  end;


procedure qtStart;
procedure qtStop;
function qtDrawGridChar(QT:TQuadText; C:Char):integer; // returns index of char
function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
procedure qtDrawGridString(QT:TQuadText; s:String);

implementation
uses OpenGL, Graphics;

var
  dtStore :TGLBoolean;

function qtDrawGridChar(QT:TQuadText; C:Char):integer;
var
  AlphaOffset :integer;
  x,y:integer;
begin
  AlphaOffset := -1;
  for x := 1 to NUMCHARS do
    if TEX_CHARS[x] = C then AlphaOffset := x;

  result := AlphaOffset;
  if AlphaOffset <> -1 then
  begin
    // AlphaOffset contains the grid offset of the character now
    // in this test grid there are 12 per line
    Y := (AlphaOffset div QT.GridCells);
    if AlphaOffset mod QT.GridCells <> 0 then // need this in case letter is last on grid line
      inc(y);
    X := AlphaOffset - ((Y-1)*QT.GridCells);
    qtDrawGridSquare(QT,x,y);
  end;
end;


function qtDrawGridSquare(QT:TQuadText; X,Y:integer):integer;
var l,t:integer;
    dt:TGLBoolean;
begin
  Result := -1;
  glBindTexture(GL_TEXTURE_2D, QT.TextureID);
  l := 256 - (QT.GridSquareWidth * (x-1));
  t := (Y - 1) * QT.GridSquareHeight;

  glBegin(GL_QUADS);
    glTexCoord2f(l,t);
    glVertex2f(0,0);
    glTexCoord2f(l,t+QT.GridSquareHeight);
    glVertex2f(0,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t+QT.GridSquareHeight);
    glVertex2f(QT.GridSquareWidth,QT.GridSquareHeight);
    glTexCoord2f(l-QT.GridSquareWidth,t);
    glVertex2f(QT.GridSquareWidth,0);
  glEnd;

  result := 0;
end;


procedure qtDrawGridString(QT:TQuadText; s:String);
var
  o,a:integer;
begin
  glPushMatrix;
  glPushMatrix;
  if length(s) = 1 then
  begin
    qtDrawGridChar(qt,s[1]);
  end else
  for a := 1 to Length(s) do
  begin
    if s[a] = #13 then
    begin
      glPopMatrix;
      glTranslatef(0,QT.GridSquareHeight,0); // translate down
      glPushMatrix;
    end else begin
      o := qtDrawGridChar(QT,s[a]);
      if o <> -1 then
        glTranslatef(QT.TexWidths[o]+QT.GridCharSpacing,0,0)
      else // translate for space character
        glTranslatef(QT.SpaceWidth,0,0);
    end;
  end;
  glPopMatrix;
  glPopMatrix;
end;

procedure qtStart;
begin
  glGetBooleanv(GL_DEPTH_TEST,@dtstore);
  glDisable(GL_DEPTH_TEST);
end;

procedure qtStop;
begin
  if dtstore <> 0 then glEnable(GL_DEPTH_TEST);
end;


end.

--- NEW FILE ---
ÿ

Font.ColorclWindowTextFont.Heightõ	Font.Name
MS Sans Serif
Font.Style
TextHeight
--- NEW FILE ---
unit frmGridGen;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, QuadTextUnit; 



type
  TGridGenForm = class(TForm)
    procedure FormClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function MakeGrid(f:TFont):TBitmap;
  end;

var
  GridGenForm: TGridGenForm;

implementation

{$R *.DFM}

procedure TGridGenForm.FormClick(Sender: TObject);
var b:TBitmap;
begin
  b := MakeGrid(Font);
  Canvas.Draw(0,0,b);
  b.free;
end;

function TGridGenForm.MakeGrid(f: TFont): TBitmap;
var
  gh,gw,cw,ch:integer; // graphics width (cell count), graphics height, cell width, cell height
  b:TBitmap;
  TxtMetrics :TEXTMETRIC;
  c,ttop,tleft:integer;
begin
  // grid creation logic
  b := TBitmap.Create;
  b.Canvas.Font := Font;
  b.Canvas.Font.Color := clBlack;
//  b.Canvas.Re
  b.Width := 256;
  b.Height := 256;
  ch := f.Height;
  if Integer(GetTextMetrics(b.Canvas.Handle,TxtMetrics)) = 0 then raise Exception.Create('GetTextMetrics() failed');
  cw := TxtMetrics.tmMaxCharWidth;

  gh := 12;  // number of rows
  gw := 12;  // number of cells each row
  cw := 20; ch := 20; //cell size

  for c := 0 to NUMCHARS-1 do
  begin
    // locate top left
    ttop := (c div gw)*ch;
    tleft := (c - ttop)*cw;
    b.Canvas.TextOut(tleft,ttop,TEX_CHARS[c+1]);
  end;

  Result := b;
end;

end.

***** Bogus filespec: CourierNew

Index: frmMain.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/BasicGLapp/frmMain.pas,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** frmMain.pas	2000/10/26 17:08:15	1.4
--- frmMain.pas	2000/11/17 18:59:56	1.5
***************
*** 11,15 ****
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   Menus, ExtCtrls, GLPanel, OpenGL, Textures, Trace;
  
  type
--- 11,15 ----
  uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
!   Menus, ExtCtrls, GLPanel, OpenGL, Textures, Trace, QuadTextUnit;
  
  type
***************
*** 30,34 ****
      { Public declarations }
  
!     // Animation trackers can go here
      animSquare: integer; // this var will be cycled through 1..360
                           // which states the angle of the square. By
--- 30,38 ----
      { Public declarations }
  
! 
!     TestTex :TTexture;
!     ArialTex :TTexture;
! 
!      // Animation trackers can go here
      animSquare: integer; // this var will be cycled through 1..360
                           // which states the angle of the square. By
***************
*** 36,40 ****
--- 40,55 ----
                           // a rotating square :)
  
+ 
+     QT:TQuadText;
+     Arial :TQuadText;
+ 
+     txtfile :TStringList;
+     counter1 :integer;
+ 
+     txtList:integer;
+ 
      procedure SetProjection(Sender: TObject);
+ 
+     procedure MakeList;
    end;
  
***************
*** 75,78 ****
--- 90,96 ----
  
  procedure TMainForm.GLPanelGLInit(Sender: TObject);
+ var
+   a:integer;
+   glfloat :TGLFloat;
  begin
    // Add GL init code here
***************
*** 87,90 ****
--- 105,141 ----
    // uncomment this line to enable alpha blending
  
+   // set up Courier New
+   TestTex := TTexture.Create;
+   TestTex.UseAlpha := false;
+   TestTex.UseMipmaps := false;
+   TestTex.LoadFromFile('CourierNew Grid.bmp');
+ 
+   QT.GridSquareWidth := 20;
+   QT.GridSquareHeight := 20;
+   QT.GridCharSpacing := 2;
+   QT.GridCells := 12;
+   QT.SpaceWidth := 5;
+   QT.TextureID := TestTex.ID;
+   // set widths
+   QT.TexWidths := COURIERNEW_WIDTHS;
+ 
+   // set up Arial
+   ArialTex := TTexture.Create;
+   ArialTex.LoadFromFile('Arial Grid.bmp');
+ 
+   Arial.GridSquareWidth := 20;
+   Arial.GridSquareHeight := 20;
+   Arial.GridCharSpacing := 2;
+   Arial.GridCells := 12;
+   Arial.SpaceWidth := 5;
+   Arial.TextureID := ArialTex.ID;
+   Arial.TexWidths := ARIAL_WIDTHS;
+ 
+   txtFile := TStringList.Create;
+   txtFile.LoadFromFile('movies.txt');
+ 
+   txtList := glGenLists(1);
+   Counter1 := 0;
+   MakeList;
  end;
  
***************
*** 165,169 ****
    glEnd;
  
!   glColor4f(1.0,1.0,1.0,0.75);
    glBegin(GL_POLYGON);
      glNormal3f(0.0, -1.0, 0.0);
--- 216,220 ----
    glEnd;
  
!   glColor4f(1.0,1.0,1.0,1.0);
    glBegin(GL_POLYGON);
      glNormal3f(0.0, -1.0, 0.0);
***************
*** 173,176 ****
--- 224,275 ----
      glVertex3f(-1.0, -1.0, 1.0);
    glEnd;
+ 
+ 
+   glLoadIdentity;
+ 
+   glClear(GL_DEPTH_BUFFER_BIT);
+   glEnable(GL_TEXTURE_2D);
+   glEnable(GL_BLEND);
+ 
+   // change co-ordinate system  to 1:1 pixel mapping
+   glScalef(2.0 / GLPanel.Width, -2.0 / GLPanel.Height, 1.0);
+   glTranslatef(-(GLPanel.Width / 2), -(GLPanel.Height / 2), 0);
+ 
+   glMatrixMode(GL_TEXTURE);
+   glLoadIdentity;
+   glScalef(1/256,1/256,1);
+ 
+   // left = 256 right = 0
+   // top = 0 bottom = 256
+   //
+   // left = 256 - (20 * (x-1))
+ 
+   glMatrixMode(GL_MODELVIEW);
+ 
+   glEnable(GL_SCISSOR_TEST);
+ 
+   inc(Counter1);
+   if Counter1 >= 100 then
+   begin
+     MakeList;
+     Counter1 := 0;
+   end;
+   glScissor(0,0,640,380);
+   glPushMatrix;
+   gltranslatef(0,animSquare-500,0);
+   qtStart;
+   glCallList(txtList);
+   glPopMatrix;
+ 
+   glDisable(GL_SCISSOR_TEST);
+   glColor3f(1.0,0.0,0.0);
+   qtDrawGridString(QT,'The quick brown (?) fox'#13'JUMPED "over" the lazy dog!?!');
+   glTranslatef(300,0,0);
+   glColor3f(0.2,0.2,1.0);
+   qtDrawGridString(Arial,'THE QUICK BROWN FOX JUMPED'#13'OVER THE LAZY DOG.'#13' ()!'',"?');
+ 
+   qtStop;
+   glDisable(GL_TEXTURE_2D);
+ 
  end;
  
***************
*** 178,181 ****
--- 277,301 ----
  begin
    Close;
+ end;
+ 
+ procedure TMainForm.MakeList;
+ var
+   x,y:integer;
+   s:string;
+ begin
+   glNewList(txtList,GL_COMPILE);
+     for y := 1 to 800 div 20 do
+     begin
+       glPushMatrix;
+       s := '';
+       for x := 1 to 60 do
+       begin
+         s := s + Chr(Trunc(Random(52)+Ord('A')));
+       end;
+       qtDrawGridString(QT,s);
+       glPopMatrix;
+       glTranslatef(0,20,0);
+     end;
+   glEndList;
  end;
  

Index: texdemo.dpr
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/BasicGLapp/texdemo.dpr,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** texdemo.dpr	2000/10/23 20:55:11	1.1
--- texdemo.dpr	2000/11/17 18:59:56	1.2
***************
*** 3,7 ****
  uses
    Forms,
!   frmMain in 'frmMain.pas' {MainForm};
  
  {$R *.RES}
--- 3,9 ----
  uses
    Forms,
!   frmMain in 'frmMain.pas' {MainForm},
!   frmGridGen in 'frmGridGen.pas' {GridGenForm},
!   QuadTextUnit in 'QuadTextUnit.pas';
  
  {$R *.RES}
***************
*** 11,14 ****
--- 13,17 ----
    Application.Title := 'Texure Demo app';
    Application.CreateForm(TMainForm, MainForm);
+   Application.CreateForm(TGridGenForm, GridGenForm);
    Application.Run;
  end.

[Pythianproject-cvsmail] CVS: PythianProject/Source/SectorEditor NewSectors.pas,1.1,1.2 Main.pas,1.3,1.4 Main.dfm,1.2,1.3 EditorSectors.pas,1.2,1.3

[Brandon M. <the...@us...>]

Update of /cvsroot/pythianproject/PythianProject/Source/SectorEditor
In directory slayer.i.sourceforge.net:/tmp/cvs-serv19458

Modified Files:
	NewSectors.pas Main.pas Main.dfm EditorSectors.pas 
Log Message:
no message

Index: NewSectors.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/NewSectors.pas,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** NewSectors.pas	2000/08/24 00:35:23	1.1
--- NewSectors.pas	2000/11/14 10:46:43	1.2
***************
*** 3,7 ****
  interface
  
! uses BaseObjects, Quads, Heightmaps, Textures, Points;
  
  type
--- 3,7 ----
  interface
  
! uses Classes, BaseObjects, Quads, Heightmaps, Textures, Points, TaggedStreams;
  
  type
***************
*** 74,77 ****
--- 74,93 ----
    end;
  
+   TSectorList = class(TList)
+   private
+     function GetItems(Index: Integer): TSector;
+     procedure SetItems(Index: Integer; const Value: TSector);
+   public
+     procedure Traverse(ClippingQuad: TQuad); virtual;
+     procedure FreeSectors;
+ 
+     procedure SaveToFile(const FileName: String);
+     procedure SaveToStream(Stream: TTaggedStream); virtual;
+     procedure LoadFromFile(const FileName: String);
+     procedure LoadFromStream(Stream: TTaggedStream); virtual;
+ 
+     property Items[Index: Integer]: TSector read GetItems write SetItems; default;
+   end;
+ 
  implementation
  
***************
*** 253,256 ****
--- 269,334 ----
      FSectorPanels[i].TraverseAll(Self, FOnSectorTraversed);
    end;
+ end;
+ 
+ { TSectorList }
+ 
+ procedure TSectorList.FreeSectors;
+ var
+   i: Integer;
+ begin
+   for i := 0 to Count-1 do
+     Items[i].Free;
+ end;
+ 
+ function TSectorList.GetItems(Index: Integer): TSector;
+ begin
+   Result := TSector(inherited Items[Index]);
+ end;
+ 
+ procedure TSectorList.LoadFromFile(const FileName: String);
+ var
+   Stream: TTaggedFileStream;
+ begin
+   Stream := TTaggedFileStream.Create(FileName,fmOpenRead);
+   try
+     LoadFromStream(Stream);
+   finally
+     Stream.Free;
+   end;
+ end;
+ 
+ procedure TSectorList.LoadFromStream(Stream: TTaggedStream);
+ begin
+ 
+ end;
+ 
+ procedure TSectorList.SaveToFile(const FileName: String);
+ var
+   Stream:  TTaggedFileStream;
+ begin
+   Stream := TTaggedFileStream.Create(FileName, fmCreate);
+   try
+     SaveToStream(Stream);
+   finally
+     Stream.Free;
+   end;
+ end;
+ 
+ procedure TSectorList.SaveToStream(Stream: TTaggedStream);
+ begin
+ 
+ end;
+ 
+ procedure TSectorList.SetItems(Index: Integer; const Value: TSector);
+ begin
+   Items[Index] := Value;
+ end;
+ 
+ procedure TSectorList.Traverse(ClippingQuad: TQuad);
+ var
+   i: Integer;
+ begin
+   for i := 0 to Count-1 do
+     Items[i].Traverse(ClippingQuad);
  end;
  

Index: Main.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/Main.pas,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -r1.3 -r1.4
*** Main.pas	2000/08/29 01:21:00	1.3
--- Main.pas	2000/11/14 10:46:43	1.4
***************
*** 9,21 ****
    ViewerForm, SECommon, Quads;
  
- const
-   NumPanelColors = 8;
-   PanelColors : array [0..NumPanelColors-1] of TGLColor = (
-                                             (1.0,0.0,0.0,1.0), (0.0,1.0,0.0,1.0),
-                                             (0.0,0.0,1.0,1.0), (0.0,0.5,0.5,1.0),
-                                             (0.5,0.0,0.5,1.0), (0.5,0.5,0.0,1.0),
-                                             (0.3,0.3,0.4,1.0), (0.2,0.6,0.2,1.0)
-                                            );
- 
  type
    TfrmMain = class(TForm)
--- 9,12 ----
***************
*** 61,68 ****
      Scale1: TMenuItem;
      Edit1: TMenuItem;
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
!     procedure New1Click(Sender: TObject);
      procedure SaveAs1Click(Sender: TObject);
      procedure Open1Click(Sender: TObject);
--- 52,63 ----
      Scale1: TMenuItem;
      Edit1: TMenuItem;
+     tbLinkVert: TToolButton;
+     tbUnlinkVert: TToolButton;
+     Sector1: TMenuItem;
+     AddSector1: TMenuItem;
      procedure FormCreate(Sender: TObject);
      procedure FormShow(Sender: TObject);
      procedure FormDestroy(Sender: TObject);
!     procedure AddSector1Click(Sender: TObject);
      procedure SaveAs1Click(Sender: TObject);
      procedure Open1Click(Sender: TObject);
***************
*** 80,88 ****
      procedure tbSplitVertClick(Sender: TObject);
      procedure ModeClick(Sender: TObject);
    private
      { Private declarations }
      FSaved8087CW: Word;
      FCurrentMode: TMouseMode;
!     FSector: TEditorSector;
      FMouseOverPanel: TEditorPanel;
      FMouseOverEdge: TEditorEdge;
--- 75,87 ----
      procedure tbSplitVertClick(Sender: TObject);
      procedure ModeClick(Sender: TObject);
+     procedure tbLinkVertClick(Sender: TObject);
+     procedure tbUnlinkVertClick(Sender: TObject);
+     procedure New1Click(Sender: TObject);
    private
      { Private declarations }
      FSaved8087CW: Word;
      FCurrentMode: TMouseMode;
!     FSectorList: TEditorSectorList;
!     FMouseOverSector: TEditorSector;
      FMouseOverPanel: TEditorPanel;
      FMouseOverEdge: TEditorEdge;
***************
*** 101,104 ****
--- 100,105 ----
      function GetPanelState(Panel: TEditorPanel; State: TSEState) : Boolean;
      procedure SelectedListChanged(Ptr: Pointer; Action: TListNotification);
+     procedure ClearSectors;
+     function CreateSectorFromVerts(Vertices: TEditorVertexArray): TEditorSector;
    public
      { Public declarations }
***************
*** 108,116 ****
      procedure CollapseSelectedVertices;
      procedure ExpandSelectedVertices;
      procedure UpdateStatusBar;
-     procedure SetPanelColors;
  
      property CurrentMode: TMouseMode read FCurrentMode write SetCurrentMode;
!     property Sector: TEditorSector read FSector write FSector;
      property MouseOverPanel: TEditorPanel read FMouseOverPanel write FMouseOverPanel;
      property MouseOverEdge: TEditorEdge read FMouseOverEdge write FMouseOverEdge;
--- 109,120 ----
      procedure CollapseSelectedVertices;
      procedure ExpandSelectedVertices;
+     procedure LinkSelectedVertices;
+     procedure UnlinkSelectedVertices;
+     procedure ExtrudeSector(Panel: TEditorPanel; const Depth: Real);
      procedure UpdateStatusBar;
  
      property CurrentMode: TMouseMode read FCurrentMode write SetCurrentMode;
!     property SectorList: TEditorSectorList read FSectorList write FSectorList;
!     property MouseOverSector: TEditorSector read FMouseOverSector write FMouseOverSector;
      property MouseOverPanel: TEditorPanel read FMouseOverPanel write FMouseOverPanel;
      property MouseOverEdge: TEditorEdge read FMouseOverEdge write FMouseOverEdge;
***************
*** 148,152 ****
    Set8087CW($133f); { Disable all fpu exceptions }
  
!   FSector := nil;
    FIDCnt := 0;
  
--- 152,159 ----
    Set8087CW($133f); { Disable all fpu exceptions }
  
!   FSectorList := TEditorSectorList.Create;
!   FSectorList.VertexState := GetVertexState;
!   FSectorList.EdgeState := GetEdgeState;
!   FSectorList.PanelState := GetPanelState;
    FIDCnt := 0;
  
***************
*** 166,170 ****
    Set8087CW(FSaved8087CW);
  
!   FSector.Free;
  end;
  
--- 173,178 ----
    Set8087CW(FSaved8087CW);
  
!   ClearSectors;
!   FSectorList.Free;
  end;
  
***************
*** 198,201 ****
--- 206,212 ----
      FSelectedVertices.Clear;
  
+     if (Value = mmEdit) then
+       WireFrame1.Checked := true;
+ 
      //Update Appearance
      Toolbar1.Buttons[ Ord(Value)-1 ].Down := true;
***************
*** 204,215 ****
  end;
  
! procedure TfrmMain.New1Click(Sender: TObject);
  begin
    FFileName := '';
    FIDCnt := 0;
-   if Assigned(FSector) then
-     FSector.Free;
  
!   FSector := BuildBasicSector;
  end;
  
--- 215,227 ----
  end;
  
! procedure TfrmMain.AddSector1Click(Sender: TObject);
! var
!   Sector: TEditorSector;
  begin
    FFileName := '';
    FIDCnt := 0;
  
!   Sector := BuildBasicSector;
!   FSectorList.Add(Sector);
  end;
  
***************
*** 219,228 ****
  var
    i: Integer;
!   Panel: TSectorPanel;
!   Vertices: array of TEditorVertex;
!   Edges: array of TEditorEdge;
  begin
-   Result := TEditorSector.Create;
- 
    SetLength(Vertices, 8);
    for i := 0 to High(Vertices) do
--- 231,236 ----
  var
    i: Integer;
!   Vertices: TEditorVertexArray;
  begin
    SetLength(Vertices, 8);
    for i := 0 to High(Vertices) do
***************
*** 241,326 ****
    Vertices[6].Position := MakePoint3D(+HL, +HL, +HL);
    Vertices[7].Position := MakePoint3D(-HL, +HL, +HL);
- 
-   SetLength(Edges, 12);
-   for i := 0 to High(Edges) do
-   begin
-     Edges[i] := TEditorEdge.Create;
-     Edges[i].OnGetState := GetEdgeState;
-   end;
- 
-   Edges[0].Vertices[0] := Vertices[3];
-   Edges[0].Vertices[1] := Vertices[7];
-   Edges[1].Vertices[0] := Vertices[7];
-   Edges[1].Vertices[1] := Vertices[6];
-   Edges[2].Vertices[0] := Vertices[6];
-   Edges[2].Vertices[1] := Vertices[2];
-   Edges[3].Vertices[0] := Vertices[2];
-   Edges[3].Vertices[1] := Vertices[3];
- 
-   Edges[4].Vertices[0] := Vertices[0];
-   Edges[4].Vertices[1] := Vertices[4];
-   Edges[5].Vertices[0] := Vertices[4];
-   Edges[5].Vertices[1] := Vertices[5];
-   Edges[6].Vertices[0] := Vertices[5];
-   Edges[6].Vertices[1] := Vertices[1];
-   Edges[7].Vertices[0] := Vertices[1];
-   Edges[7].Vertices[1] := Vertices[0];
- 
-   Edges[8].Vertices[0] := Vertices[4];
-   Edges[8].Vertices[1] := Vertices[7];
-   Edges[9].Vertices[0] := Vertices[3];
-   Edges[9].Vertices[1] := Vertices[0];
-   Edges[10].Vertices[0] := Vertices[6];
-   Edges[10].Vertices[1] := Vertices[5];
-   Edges[11].Vertices[0] := Vertices[1];
-   Edges[11].Vertices[1] := Vertices[2];
- 
-   // Front face
-   Panel := Result.AddPanel;
-   TEditorPanel(Panel).OnGetState := GetPanelState;
-   TEditorPanel(Panel).Edges[0] := Edges[0];
-   TEditorPanel(Panel).Edges[1] := Edges[1];
-   TEditorPanel(Panel).Edges[2] := Edges[2];
-   TEditorPanel(Panel).Edges[3] := Edges[3];
- 
-   // Back face
-   Panel := Result.AddPanel;
-   TEditorPanel(Panel).OnGetState := GetPanelState;
-   TEditorPanel(Panel).Edges[0] := Edges[4];
-   TEditorPanel(Panel).Edges[1] := Edges[5];
-   TEditorPanel(Panel).Edges[2] := Edges[6];
-   TEditorPanel(Panel).Edges[3] := Edges[7];
- 
-   // Left face
-   Panel := Result.AddPanel;
-   TEditorPanel(Panel).OnGetState := GetPanelState;
-   TEditorPanel(Panel).Edges[0] := Edges[4];
-   TEditorPanel(Panel).Edges[1] := Edges[8];
-   TEditorPanel(Panel).Edges[2] := Edges[0];
-   TEditorPanel(Panel).Edges[3] := Edges[9];
  
!   // Right face
!   Panel := Result.AddPanel;
!   TEditorPanel(Panel).OnGetState := GetPanelState;
!   TEditorPanel(Panel).Edges[0] := Edges[2];
!   TEditorPanel(Panel).Edges[1] := Edges[10];
!   TEditorPanel(Panel).Edges[2] := Edges[6];
!   TEditorPanel(Panel).Edges[3] := Edges[11];
! 
!   // Top face
!   Panel := Result.AddPanel;
!   TEditorPanel(Panel).OnGetState := GetPanelState;
!   TEditorPanel(Panel).Edges[0] := Edges[8];
!   TEditorPanel(Panel).Edges[1] := Edges[5];
!   TEditorPanel(Panel).Edges[2] := Edges[10];
!   TEditorPanel(Panel).Edges[3] := Edges[1];
! 
!   // Bottom face
!   Panel := Result.AddPanel;
!   TEditorPanel(Panel).OnGetState := GetPanelState;
!   TEditorPanel(Panel).Edges[0] := Edges[9];
!   TEditorPanel(Panel).Edges[1] := Edges[7];
!   TEditorPanel(Panel).Edges[2] := Edges[11];
!   TEditorPanel(Panel).Edges[3] := Edges[3];
  end;
  
--- 249,254 ----
    Vertices[6].Position := MakePoint3D(+HL, +HL, +HL);
    Vertices[7].Position := MakePoint3D(-HL, +HL, +HL);
  
!   Result := CreateSectorFromVerts(Vertices);
  end;
  
***************
*** 333,336 ****
--- 261,265 ----
  procedure TfrmMain.SelectVertex(Vertex: TEditorVertex; const ClearFirst: Boolean);
  begin
+   Vertex := Vertex.GetSelectable;
    if (ClearFirst) then
    begin
***************
*** 340,344 ****
    else
     if (FSelectedVertices.IndexOf(Vertex) = -1) then
!      FSelectedVertices.Add(Vertex);
  end;
  
--- 269,273 ----
    else
     if (FSelectedVertices.IndexOf(Vertex) = -1) then
!      FSelectedVertices.Add( Vertex);
  end;
  
***************
*** 353,358 ****
  
        FFileName := FileName;
!       if (FSector <> nil) then
!         FSector.SaveToEditorFile(FFileName);
  
        sbMain.Panels[0].Text := 'Ready';
--- 282,287 ----
  
        FFileName := FileName;
!       if (FSectorList.Count > 0) then
!         FSectorList.SaveToFile(FFileName);
  
        sbMain.Panels[0].Text := 'Ready';
***************
*** 379,391 ****
      begin
        sbMain.Panels[0].Text := 'Loading...';
- 
-       FSector.Free;
-       FSector := TEditorSector.Create;
-       FSector.VertexState := GetVertexState;
-       FSector.EdgeState := GetEdgeState;
-       FSector.PanelState := GetPanelState;
- 
        FFileName := FileName;
!       FSector.LoadFromEditorFile(FFileName);
  
        sbMain.Panels[0].Text := 'Ready';
--- 308,315 ----
      begin
        sbMain.Panels[0].Text := 'Loading...';
        FFileName := FileName;
! 
!       FSectorList.FreeSectors;
!       FSectorList.LoadFromFile(FFileName);
  
        sbMain.Panels[0].Text := 'Ready';
***************
*** 407,411 ****
      sbMain.Panels[0].Text := 'Saving...';
  
!     FSector.SaveToEditorFile(FFileName);
  
      sbMain.Panels[0].Text := 'Ready';
--- 331,335 ----
      sbMain.Panels[0].Text := 'Saving...';
  
!     FSectorList.SaveToFile(FFileName);
  
      sbMain.Panels[0].Text := 'Ready';
***************
*** 445,449 ****
  
    if (SolidModel1.Checked) then
!     SetPanelColors;
  end;
  
--- 369,373 ----
  
    if (SolidModel1.Checked) then
!     FSectorList.SetSectorColors;
  end;
  
***************
*** 482,485 ****
--- 406,410 ----
      seSelected:    Result := False;
      seInSelection: Result := FInSelection;
+     seSolidModel:  Result := SolidModel1.Checked;
     else Result := False;
    end;
***************
*** 550,628 ****
  procedure TfrmMain.SelectedListChanged(Ptr: Pointer; Action: TListNotification);
  begin
!   tbJoinVert.Enabled := (FSelectedVertices.Count>1);
    tbSplitVert.Enabled := (FSelectedVertices.Count > 0) and (FSelectedVertices[0].NumCollapsedVertices > 0);
  
    UpdateStatusBar;
  end;
  
! procedure TfrmMain.SetPanelColors;
  var
    i: Integer;
  begin
!   if (FSector = nil) then
      exit;
  
!   for i := 0 to FSector.NumPanels-1 do
!     TEditorPanel(FSector.Panels[i]).SolidColor := PanelColors[ i mod NumPanelColors ]; 
  end;
- (*
- procedure TfrmMain.SetPanelColors;
- const
-   BlackColor : TGLColor = (0.0,0.0,0.0,1.0);
  
!   function ColorEqual(c1,c2: TGLColor): Boolean;
!   var
!     i: Integer;
!   begin
!     Result := true;
!     for i := 0 to 3 do
!       Result := Result and (c1[i] = c2[i]);
!   end;
  
!   procedure RemoveColor(Colors: TList; Color: TGLColor);
!   var
!     i: Integer;
!   begin
!     for i := 0 to Colors.Count-1 do
!       if (ColorEqual(Color, PanelColors[ Integer(Colors[i]) ])) then
!       begin
!         Colors.Delete(i);
!         exit;
!       end;
!   end;
  
  var
!   i,j: Integer;
!   Neighbors, AvailColors: TList;
  begin
!   Neighbors := TList.Create;
!   AvailColors := TList.Create;
!   try
!     for i := 0 to FSector.NumPanels-1 do
!       TEditorPanel(FSector.Panels[i]).SolidColor := BlackColor;
  
!     for i := 0 to FSector.NumPanels-1 do
!     begin
!       //TEditorPanel(FSector.Panels[i]).SolidColor := PanelColors[ i mod NumPanelColors ];
!       Neighbors.Clear;
!       AvailColors.Clear;
!       for j := 0 to NumPanelColors-1 do
!         AvailColors.Add(Pointer(j));
! 
!       FSector.GetNeighborPanels(FSector.Panels[i],Neighbors);
!       for j := 0 to Neighbors.Count-1 do
!         with TEditorPanel(Neighbors[j]) do
!           if not(ColorEqual(SolidColor,BlackColor)) then
!             RemoveColor(AvailColors, SolidColor);
  
!       j := Random(AvailColors.Count);
!       TEditorPanel(FSector.Panels[i]).SolidColor := PanelColors[ Integer(AvailColors[j]) ];
!     end;
  
!   finally
!     Neighbors.Free;
!     AvailColors.Free;
    end;
  end;
  *)
  end.
--- 475,686 ----
  procedure TfrmMain.SelectedListChanged(Ptr: Pointer; Action: TListNotification);
  begin
!   tbJoinVert.Enabled := (FSelectedVertices.Count > 1) and (MouseOverSector.AreCollapsable(SelectedVertices));
    tbSplitVert.Enabled := (FSelectedVertices.Count > 0) and (FSelectedVertices[0].NumCollapsedVertices > 0);
+   tbLinkVert.Enabled := (FSelectedVertices.Count > 1) and (AreLinkable(FSectorList,SelectedVertices));
+   tbUnlinkVert.Enabled := (FSelectedVertices.Count> 0) and (FSelectedVertices[0].NumLinkedVertices > 0);
  
    UpdateStatusBar;
  end;
  
! procedure TfrmMain.LinkSelectedVertices;
  var
    i: Integer;
  begin
!   if (FSelectedVertices.Count < 2) then
      exit;
  
!   for i := 1 to FSelectedVertices.Count-1 do
!     FSelectedVertices[0].AddLinkedVertex(FSelectedVertices[i]);
  end;
  
! procedure TfrmMain.UnlinkSelectedVertices;
! var
!   i: Integer;
! begin
!   for i := 0 to FSelectedVertices.Count-1 do
!     FSelectedVertices[i].Unlink;
! end;
  
! procedure TfrmMain.tbLinkVertClick(Sender: TObject);
! begin
!   LinkSelectedVertices;
! end;
! 
! procedure TfrmMain.tbUnlinkVertClick(Sender: TObject);
! begin
!   UnlinkSelectedVertices;
! end;
  
+ procedure TfrmMain.New1Click(Sender: TObject);
+ begin
+   ClearSectors;
+ end;
+ 
+ procedure TfrmMain.ClearSectors;
  var
!   i: Integer;
  begin
!   for i := 0 to FSectorList.Count-1 do
!     FSectorList[i].Free;
  
!   FSectorList.Clear;
! end;
  
! function TfrmMain.CreateSectorFromVerts(Vertices: TEditorVertexArray): TEditorSector;
! var
!   i: Integer;
!   Panel: TEditorPanel;
!   Edges: array of TEditorEdge;
! begin
!   Result := TEditorSector.Create;
  
!   SetLength(Edges, 12);
!   for i := 0 to High(Edges) do
!   begin
!     Edges[i] := TEditorEdge.Create;
!     Edges[i].OnGetState := GetEdgeState;
    end;
+ 
+   Edges[0].VerticesNil[0] := Vertices[3];
+   Edges[0].VerticesNil[1] := Vertices[7];
+   Edges[1].VerticesNil[0] := Vertices[7];
+   Edges[1].VerticesNil[1] := Vertices[6];
+   Edges[2].VerticesNil[0] := Vertices[6];
+   Edges[2].VerticesNil[1] := Vertices[2];
+   Edges[3].VerticesNil[0] := Vertices[2];
+   Edges[3].VerticesNil[1] := Vertices[3];
+ 
+   Edges[4].VerticesNil[0] := Vertices[0];
+   Edges[4].VerticesNil[1] := Vertices[4];
+   Edges[5].VerticesNil[0] := Vertices[4];
+   Edges[5].VerticesNil[1] := Vertices[5];
+   Edges[6].VerticesNil[0] := Vertices[5];
+   Edges[6].VerticesNil[1] := Vertices[1];
+   Edges[7].VerticesNil[0] := Vertices[1];
+   Edges[7].VerticesNil[1] := Vertices[0];
+ 
+   Edges[8].VerticesNil[0] := Vertices[4];
+   Edges[8].VerticesNil[1] := Vertices[7];
+   Edges[9].VerticesNil[0] := Vertices[3];
+   Edges[9].VerticesNil[1] := Vertices[0];
+   Edges[10].VerticesNil[0] := Vertices[6];
+   Edges[10].VerticesNil[1] := Vertices[5];
+   Edges[11].VerticesNil[0] := Vertices[1];
+   Edges[11].VerticesNil[1] := Vertices[2];
+ 
+   // Front face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[0];
+   Panel.Edges[1] := Edges[1];
+   Panel.Edges[2] := Edges[2];
+   Panel.Edges[3] := Edges[3];
+   Panel.EdgeOrients[0] := true;
+   Panel.EdgeOrients[1] := true;
+   Panel.EdgeOrients[2] := true;
+   Panel.EdgeOrients[3] := true;
+ 
+   // Back face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[4];
+   Panel.Edges[1] := Edges[5];
+   Panel.Edges[2] := Edges[6];
+   Panel.Edges[3] := Edges[7];
+   Panel.EdgeOrients[0] := true;
+   Panel.EdgeOrients[1] := true;
+   Panel.EdgeOrients[2] := true;
+   Panel.EdgeOrients[3] := true;
+ 
+   // Left face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[4];
+   Panel.Edges[1] := Edges[8];
+   Panel.Edges[2] := Edges[0];
+   Panel.Edges[3] := Edges[9];
+   Panel.EdgeOrients[0] := true;
+   Panel.EdgeOrients[1] := true;
+   Panel.EdgeOrients[2] := false;
+   Panel.EdgeOrients[3] := true;
+ 
+   // Right face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[2];
+   Panel.Edges[1] := Edges[10];
+   Panel.Edges[2] := Edges[6];
+   Panel.Edges[3] := Edges[11];
+   Panel.EdgeOrients[0] := false;
+   Panel.EdgeOrients[1] := true;
+   Panel.EdgeOrients[2] := true;
+   Panel.EdgeOrients[3] := true;
+ 
+   // Top face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[8];
+   Panel.Edges[1] := Edges[5];
+   Panel.Edges[2] := Edges[10];
+   Panel.Edges[3] := Edges[1];
+   Panel.EdgeOrients[0] := false;
+   Panel.EdgeOrients[1] := true;
+   Panel.EdgeOrients[2] := false;
+   Panel.EdgeOrients[3] := false;
+ 
+   // Bottom face
+   Panel := TEditorPanel(Result.AddPanel);
+   Panel.OnGetState := GetPanelState;
+   Panel.Edges[0] := Edges[9];
+   Panel.Edges[1] := Edges[7];
+   Panel.Edges[2] := Edges[11];
+   Panel.Edges[3] := Edges[3];
+   Panel.EdgeOrients[0] := true;
+   Panel.EdgeOrients[1] := false;
+   Panel.EdgeOrients[2] := true;
+   Panel.EdgeOrients[3] := true;
  end;
+ 
+ //Bottom and back panels extrude inversely...should be an elegant solution (since winding is established now)
+ procedure TfrmMain.ExtrudeSector(Panel: TEditorPanel; const Depth: Real);
+ var
+   i: Integer;
+   Vertices, PanelVerts: TEditorVertexArray;
+ begin
+   //Get ordered list of vertices (clockwise)
+   SetLength(PanelVerts,4);
+ (*
+   LastEdge := Panel.Edges[0];
+   PanelVerts[0] := LastEdge.Vertices[0];
+   for i := 1 to 3 do
+   begin
+     LastEdge := Panel.FindEdge(PanelVerts[i-1], LastEdge.GetOtherVertex(PanelVerts[i-1]));
+     PanelVerts[i] := LastEdge.GetOtherVertex(PanelVerts[i-1]);
+   end;
  *)
+   for i := 0 to 3 do
+     PanelVerts[i] := Panel.Edges[i].Vertices[0,Panel];
+ 
+   //Setup for sector creation
+   SetLength(Vertices, 8);
+   for i := 0 to 7 do
+   begin
+     Vertices[i] := TEditorVertex.Create;
+     Vertices[i].OnGetState := GetVertexState;
+   end;
+ 
+   //AddLinkedVertex assigns passed Vertex.Position to self.Position
+   PanelVerts[0].AddLinkedVertex( Vertices[0] );
+   PanelVerts[1].AddLinkedVertex( Vertices[4] );
+   PanelVerts[2].AddLinkedVertex( Vertices[5] );
+   PanelVerts[3].AddLinkedVertex( Vertices[1] );
+ 
+   Vertices[3].Position := AddPoint(Vertices[0].Position,ScalePoint(CrossProduct(Normalize(SubPoint(Vertices[4].Position,Vertices[0].Position)), Normalize(SubPoint(Vertices[1].Position,Vertices[0].Position))),-Depth));
+   Vertices[7].Position := AddPoint(Vertices[4].Position,ScalePoint(CrossProduct(Normalize(SubPoint(Vertices[5].Position,Vertices[4].Position)), Normalize(SubPoint(Vertices[0].Position,Vertices[4].Position))),-Depth));
+   Vertices[6].Position := AddPoint(Vertices[5].Position,ScalePoint(CrossProduct(Normalize(SubPoint(Vertices[1].Position,Vertices[5].Position)), Normalize(SubPoint(Vertices[4].Position,Vertices[5].Position))),-Depth));
+   Vertices[2].Position := AddPoint(Vertices[1].Position,ScalePoint(CrossProduct(Normalize(SubPoint(Vertices[0].Position,Vertices[1].Position)), Normalize(SubPoint(Vertices[5].Position,Vertices[1].Position))),-Depth));
+ 
+   FSectorList.Add( CreateSectorFromVerts(Vertices) );
+ end;
+ 
  end.

Index: Main.dfm
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/Main.dfm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
Binary files /tmp/cvsQhpsI0 and /tmp/cvskRlgaR differ

Index: EditorSectors.pas
===================================================================
RCS file: /cvsroot/pythianproject/PythianProject/Source/SectorEditor/EditorSectors.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** EditorSectors.pas	2000/08/28 20:38:32	1.2
--- EditorSectors.pas	2000/11/14 10:46:43	1.3
***************
*** 3,8 ****
  interface
  
! uses Classes, SysUtils, NewSectors, Points, Quads;
  
  type
    TEditorVertex = class;
--- 3,17 ----
  interface
  
! uses Classes, TaggedStreams, SysUtils, NewSectors, Points, Quads;
[...1550 lines suppressed...]
+ var
+   i: Integer;
+ begin
+   Randomize;
+   for i := 0 to Count-1 do
+     Items[i].SetPanelColors;
+ end;
+ 
+ procedure TEditorSectorList.Traverse(ClippingQuad: TQuad);
+ var
+   i: Integer;
+ begin
+   glPushName(0);
+ 
+   for i := 0 to Count-1 do
+   begin
+     glLoadName(i);
+     Items[i].Traverse(ClippingQuad);
    end;
  

[Pythianproject-cvsmail] CVS: Prototypes/GLCanvas StartUp.dfm,1.2,1.3 MyDraw.pas,1.2,1.3 glCanvas.pas,1.2,1.3

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLCanvas
In directory slayer.i.sourceforge.net:/tmp/cvs-serv31621

Modified Files:
	StartUp.dfm MyDraw.pas glCanvas.pas 
Log Message:
Color bug fixed - DL

Index: StartUp.dfm
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/StartUp.dfm,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
Binary files /tmp/cvsxf11i4 and /tmp/cvskIzhyY differ

Index: MyDraw.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/MyDraw.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** MyDraw.pas	2000/11/11 17:13:12	1.2
--- MyDraw.pas	2000/11/11 17:57:01	1.3
***************
*** 48,52 ****
    InspectorGadget := TGLBitmap.Create;
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
!   SampleText := TGLText.Create('Hello World','arial1.glf',GLCANVAS_TEXT_GLF);
    Sampletext.Lines.Add('Long live the Project');
    SampleText.Lines.Add('These are lines of text drawn by GLF');
--- 48,53 ----
    InspectorGadget := TGLBitmap.Create;
    InspectorGadget.LoadFromBitmap('gadgetcollage.bmp');
!   SampleText := TGLText.Create('Hello World', 'arial1.glf', GLCANVAS_TEXT_GLF);
! 
    Sampletext.Lines.Add('Long live the Project');
    SampleText.Lines.Add('These are lines of text drawn by GLF');
***************
*** 77,81 ****
    SampleText.Lines.Add('kfldqpptioreptQUITRJAKSjkdlsakjdbtathylayklt=-29');
  
!   SampleText.Color := clYellow;
    SampleText.Size := 10.0;
  end;
--- 78,82 ----
    SampleText.Lines.Add('kfldqpptioreptQUITRJAKSjkdlsakjdbtathylayklt=-29');
  
!   SampleText.SetColor(clYellow);
    SampleText.Size := 10.0;
  end;
***************
*** 108,112 ****
  
    // this draws the text object
!   GLC.DrawText(10,150,SampleText);
  end;
  
--- 109,113 ----
  
    // this draws the text object
!   GLC.DrawText(1,1,SampleText);
  end;
  

Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** glCanvas.pas	2000/11/11 17:13:12	1.2
--- glCanvas.pas	2000/11/11 17:57:01	1.3
***************
*** 31,34 ****
--- 31,35 ----
    Contributors -
      Michael Hearn (mh...@su...)
+     Darryl Long (d_...@sy...)
  
    To do-
***************
*** 39,42 ****
--- 40,46 ----
      Support textured fonts? (mike's code)
      Add shapes code
+ 
+   Fixed:
+     Color bug all better
  }
  
***************
*** 76,80 ****
      FLines :TStringList;
      FFontName :string;
!     FRed, FGreen, FBlue :byte;
      FSize :real;
  
--- 80,84 ----
      FLines :TStringList;
      FFontName :string;
!     FRed, FGreen, FBlue: Single;
      FSize :real;
  
***************
*** 86,93 ****
      procedure LoadFont; virtual ;
  
!     procedure SetBlue(const Value: byte);
!     procedure SetGreen(const Value: byte);
!     procedure SetRed(const Value: byte);
!     procedure SetColor(const Value: TColor);
      procedure SetSize(const Value: Real);
      procedure SetPrecache(const Value: boolean);
--- 90,96 ----
      procedure LoadFont; virtual ;
  
!     procedure SetBlue(const Value: Single);
!     procedure SetGreen(const Value: Single);
!     procedure SetRed(const Value: Single);
      procedure SetSize(const Value: Real);
      procedure SetPrecache(const Value: boolean);
***************
*** 106,114 ****
      property Text:string read GetText write SetText;
  
!     property Red :byte read FRed write SetRed;
!     property Green :byte read FGreen write SetGreen;
!     property Blue :byte read FBlue write SetBlue;
  
-     property Color :TColor write SetColor;
      property Size :Real read FSize write SetSize;
  
--- 109,116 ----
      property Text:string read GetText write SetText;
  
!     property Red: Single read FRed write SetRed;
!     property Green: Single read FGreen write SetGreen;
!     property Blue: Single read FBlue write SetBlue;
  
      property Size :Real read FSize write SetSize;
  
***************
*** 120,123 ****
--- 122,126 ----
      destructor Destroy; override ;
      procedure Draw; virtual ;
+     procedure SetColor(const Value: TColor);
    end;
  
***************
*** 324,329 ****
    if TextType = GLCANVAS_TEXT_GLF then
    begin
!     // @TODO - fix this
!     //glColor3b(Red,Green,Blue);
      glPushMatrix;
      glScalef(Size,Size,1);
--- 327,331 ----
    if TextType = GLCANVAS_TEXT_GLF then
    begin
!     glColor3f(FRed, FGreen, FBlue);
      glPushMatrix;
      glScalef(Size,Size,1);
***************
*** 358,362 ****
  end;
  
! procedure TGLText.SetBlue(const Value: byte);
  begin
    FBlue := Value;
--- 360,364 ----
  end;
  
! procedure TGLText.SetBlue(const Value: Single);
  begin
    FBlue := Value;
***************
*** 365,374 ****
  
  procedure TGLText.SetColor(const Value: TColor);
- type
-   TColorQuad = array[0..3] of byte;
  begin
!   FRed := TColorQuad(Value)[0];
!   FGreen := TColorQuad(Value)[1];
!   FBlue := TColorQuad(Value)[2];
    UpdateDisplayList;
  end;
--- 367,374 ----
  
  procedure TGLText.SetColor(const Value: TColor);
  begin
!   FRed := (Value and $0000FF);
!   FGreen := (Value and $00FF00) SHR 8;
!   FBlue := (Value and $FF0000) SHR 16;
    UpdateDisplayList;
  end;
***************
*** 381,385 ****
  end;
  
! procedure TGLText.SetGreen(const Value: byte);
  begin
    FGreen := Value;
--- 381,385 ----
  end;
  
! procedure TGLText.SetGreen(const Value: Single);
  begin
    FGreen := Value;
***************
*** 393,397 ****
  end;
  
! procedure TGLText.SetRed(const Value: byte);
  begin
    FRed := Value;
--- 393,397 ----
  end;
  
! procedure TGLText.SetRed(const Value: Single);
  begin
    FRed := Value;

[Pythianproject-cvsmail] CVS: Prototypes/GLForm Main.pas,NONE,1.1 Main.dfm,NONE,1.1 GLFormTest.res,NONE,1.1 GLFormTest.dpr,NONE,1.1 GLFormTest.dof,NONE,1.1 GLFormTest.cfg,NONE,1.1 GLForms.pas,NONE,1.1

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLForm
In directory slayer.i.sourceforge.net:/tmp/cvs-serv2645

Added Files:
	Main.pas Main.dfm GLFormTest.res GLFormTest.dpr GLFormTest.dof 
	GLFormTest.cfg GLForms.pas 
Log Message:
First try

--- NEW FILE ---
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Cameras, GLForms, OpenGL, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
    FCamera: TCamera;
    FDir: Single;
    FGLForm: TGLForm;
    FX: Single;
    procedure GLFormClose(Sender: TObject);
    procedure GLFormGLInit(Sender: TObject);
    procedure GLFormPaint(Sender: TObject);
    procedure MakeForm;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  MakeForm;
end;

procedure TForm1.GLFormClose(Sender: TObject);
begin
  FCamera.Free;

  FGLForm.Free;
  FGLForm := nil;

  Close;
end;

procedure TForm1.GLFormGLInit(Sender: TObject);
begin
  FCamera := TCamera.Create;
  FCamera.ViewWidth := FGLForm.Width;
  FCamera.ViewHeight := FGLForm.Height;

  FX := -10;
  FDir := 0.1;
end;

procedure TForm1.GLFormPaint(Sender: TObject);
const
  MaxDist = 7.5;
begin
  FCamera.Draw;

  glPushMatrix;

  glRotatef(90 * (FX - MaxDist) / MaxDist, 0, 0, 1);

  glBegin(GL_TRIANGLES);

  glColor3f(1, 0, 0);
  glVertex3f(-0.5, -0.5, FX);

  glColor3f(0, 1, 0);
  glVertex3f(0.5, -0.5, FX);

  glColor3f(0, 0, 1);
  glVertex3f(0.0, 0.5, FX);

  glEnd;

  glPopMatrix;

  if (FX < -10) or (FX > -10 + MaxDist) then
    FDir := -FDir;

  FX := FX + FDir;
end;

procedure TForm1.MakeForm;
begin
  if Assigned(FGLForm) then
    exit;

  FGLForm := TGLForm.Create;
  FGLForm.SetBounds(0, 0, 640, 480);
  FGLForm.Caption := 'Sample GLForm';
  FGLForm.OnClose := GLFormClose;
  FGLForm.OnOpenGLInit := GLFormGLInit;
  FGLForm.OnPaint := GLFormPaint;

  try
    FGLForm.Open;
  except
    exit;
  end;

  FGLForm.Run;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Hide;
  MakeForm;
  Timer1.Enabled := False;
end;

end.

--- NEW FILE ---
ÿ

Font.ColorclWindowTextFont.Heightõ	Font.Name
MS Sans Serif
Font.Style
TextHeight
--- NEW FILE ---

--- NEW FILE ---
program GLFormTest;

uses
  Forms,
  Main in 'Main.pas' {Form1},
  GLForms in 'GLForms.pas';

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

--- NEW FILE ---
[Compiler]
A=1
B=0
C=1
D=1
E=0
F=0
G=1
H=1
I=1
J=1
K=0
L=1
M=0
N=1
O=1
P=1
Q=0
R=0
S=0
T=0
U=0
V=1
W=0
X=1
Y=1
Z=1
ShowHints=1
ShowWarnings=1
UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

[Linker]
MapFile=0
OutputObjs=0
ConsoleApp=1
DebugInfo=0
RemoteSymbols=0
MinStackSize=16384
MaxStackSize=1048576
ImageBase=4194304
ExeDescription=

[Directories]
OutputDir=
UnitOutputDir=
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=
Packages=VCL50;VCLX50;VCLSMP50;QRPT50;VCLDB50;VCLBDE50;ibevnt50;VCLDBX50;TEEUI50;TEEDB50;TEE50;TEEQR50;VCLIB50;VCLIE50;INETDB50;INET50;NMFAST50;dclocx50;dclaxserver50
Conditionals=
DebugSourceDirs=
UsePackages=0

[Parameters]
RunParams=
HostApplication=

[Language]
ActiveLang=
ProjectLang=$00000409
RootDir=

[Version Info]
IncludeVerInfo=0
AutoIncBuild=0
MajorVer=1
MinorVer=0
Release=0
Build=0
Debug=0
PreRelease=0
Special=0
Private=0
DLL=0
Locale=1033
CodePage=1252

[Version Info Keys]
CompanyName=
FileDescription=
FileVersion=1.0.0.0
InternalName=
LegalCopyright=
LegalTrademarks=
OriginalFilename=
ProductName=
ProductVersion=1.0.0.0
Comments=

[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;

[HistoryLists\hlSearchPath]
Count=3
Item0=..\Units
Item1=$(DELPHI)\Projects\Pythian\GameProject\Units;$(DELPHI)\Projects\Pythian\GLPanel
Item2=$(DELPHI)\Projects\Pythian\GameProject\Units;$(DELPHI)\Projects\Pythian\GLPanel;$(DELPHI)\Projects\Pythian\GameProject\Picking

[HistoryLists\hlUnitOutputDirectory]
Count=1
Item0=..\..\Bin\dcu

[HistoryLists\hlOutputDirectorry]
Count=1
Item0=..\..\Bin

[HistoryLists\hlBPLOutput]
Count=1
Item0=$(DELPHI)\Projects\Bpl

--- NEW FILE ---
-$A+
-$B-
-$C+
-$D+
-$E-
-$F-
-$G+
-$H+
-$I+
-$J+
-$K-
-$L+
-$M-
-$N+
-$O+
-$P+
-$Q-
-$R-
-$S-
-$T-
-$U-
-$V+
-$W-
-$X+
-$YD
-$Z1
-cg
-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
-H+
-W+
-M
-$M16384,1048576
-K$00400000
-LE"c:\program files\borland\delphi5\Projects\Bpl"
-LN"c:\program files\borland\delphi5\Projects\Bpl"

--- NEW FILE ---
unit GLForms;

interface

uses
  Windows, Classes, Messages, OpenGL, SysUtils;

type
  TAutoClearFlag = (acColor, acDepth);
  TAutoClearFlags = set of TAutoClearFlag;

  TMouseButton = (mbLeft, mbRight, mbMiddle);
  TButtonState = (bsUp, bsDown);

  TKBModifier = (kbmAlt, kbmControl, kbmShift);
  TKBModifiers = set of TKBModifier;

  TKeyPressEvent = procedure(Sender: TObject; KeyCode, KeyData: LongInt;
    ButtonState: TButtonState; Modifiers: TKBModifiers) of object;

  TMouseButtonEvent = procedure(Sender: TObject; Button: TMouseButton;
    X, Y: Integer; ButtonState: TButtonState;
    Modifiers: TKBModifiers) of object;

  TMouseMoveEvent = procedure(Sender: TObject; X, Y: Integer;
    Modifiers: TKBModifiers) of object;

  TGLForm = class
  private
    FAutoClear: TAutoClearFlags;
    FCaption: string;
    FClosing: Boolean;
    FDC: hDC;
    FFullScreen: Boolean;
    FGLRC: hGLRC;
    FHandle: THandle;
    FHeight: Integer;
    FLeft: Integer;
    FOnClose: TNotifyEvent;
    FOnOpen: TNotifyEvent;
    FSavedCW: Word;
    FTop: Integer;
    FWidth: Integer;
    FWndClass: TWndClass;
    FWndClassName: string;
    FOnKeypress: TKeypressEvent;
    FOnMouseButton: TMouseButtonEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnOpenGLInit: TNotifyEvent;
    FOnPaint: TNotifyEvent;
    FOpening: Boolean;
    FRunExclusive: Boolean;
    procedure CloseMsg(Msg: UInt);
    function  CreateWin(WinStyle: Cardinal): Boolean;
    function  InitializeOpenGL: Boolean;
    procedure PaintCaption;
    procedure PaintMsg;
    function  RegisterWindowClass: Boolean;
    procedure SetCaption(const Value: string);
    procedure SetFullScreen(const Value: Boolean);
    procedure SetHeight(const Value: Integer);
    procedure SetLeft(const Value: Integer);
    procedure SetOnClose(const Value: TNotifyEvent);
    procedure SetOnOpen(const Value: TNotifyEvent);
    procedure SetTop(const Value: Integer);
    procedure SetWidth(const Value: Integer);
    procedure SetOnKeypress(const Value: TKeypressEvent);
    procedure SetOnMouseButton(const Value: TMouseButtonEvent);
    procedure SetOnMouseMove(const Value: TMouseMoveEvent);
    procedure SetOnOpenGLInit(const Value: TNotifyEvent);
    procedure SetAutoClear(const Value: TAutoClearFlags);
    procedure SetOnPaint(const Value: TNotifyEvent);
  protected
    procedure DoClose; virtual;
    procedure DoKeyPress(KeyCode, KeyData: LongInt;
      ButtonState: TButtonState; Modifiers: TKBModifiers); virtual;
    procedure DoMouseButton(Button: TMouseButton; X, Y: Integer;
      ButtonState: TButtonState; Modifiers: TKBModifiers); virtual;
    procedure DoMouseMove(X, Y: Integer; Modifiers: TKBModifiers); virtual;
    procedure DoOpen; virtual;
    procedure DoOpenGLInit; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Close;
    procedure Open;
    procedure Run;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
    procedure Update;

//    property Canvas: TGLCanvas;
    property Handle: THandle read FHandle;
  published
    property AutoClear: TAutoClearFlags read FAutoClear write SetAutoClear;
    property Caption: string read FCaption write SetCaption;
    property FullScreen: Boolean read FFullScreen write SetFullScreen;
    property Height: Integer read FHeight write SetHeight;
    property Left: Integer read FLeft write SetLeft;
    property Top: Integer read FTop write SetTop;
    property Width: Integer read FWidth write SetWidth;

    property OnClose: TNotifyEvent read FOnClose write SetOnClose;
    property OnKeypress: TKeypressEvent read FOnKeypress write SetOnKeypress;
    property OnMouseButton: TMouseButtonEvent read FOnMouseButton write SetOnMouseButton;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write SetOnMouseMove;
    property OnOpen: TNotifyEvent read FOnOpen write SetOnOpen;
    property OnOpenGLInit: TNotifyEvent read FOnOpenGLInit write SetOnOpenGLInit;
    property OnPaint: TNotifyEvent read FOnPaint write SetOnPaint;
  end;

implementation

var
  RegWindows: TList;

{ WinProc }

function FindWindow(hWindow: THandle): TGLForm;
var
  i: Integer;
begin
  i := 0;
  while (i < RegWindows.Count)
  and (TGLForm(RegWindows[i]).Handle <> hWindow) do
    inc(i);

  if (i < RegWindows.Count) then
    Result := TGLForm(RegWindows[i])
  else
    Result := nil;
end;

procedure CallMouseButtonProc(GLForm: TGLForm; Button: TMouseButton;
  KS: TButtonState; WParam: WPARAM; LParam: LPARAM);
var
  KBM: TKBModifiers;
begin
  KBM := [];

  if (MK_CONTROL and wParam <> 0) then
    KBM := KBM + [kbmControl];
  if (MK_SHIFT and wParam <> 0) then
    KBM := KBM + [kbmShift];

  GLForm.DoMouseButton(Button, Lo(lParam), Hi(lParam), KS, KBM);
end;

procedure CallMouseMoveProc(GLForm: TGLForm; wParam, lParam: LongInt);
var
  KBM: TKBModifiers;
begin
  KBM := [];

  if (MK_CONTROL and wParam <> 0) then
    KBM := KBM + [kbmControl];
  if (MK_SHIFT and wParam <> 0) then
    KBM := KBM + [kbmShift];

  GLForm.DoMouseMove(Lo(lParam), Hi(lParam), KBM);
end;

procedure CallKeyPressProc(GLForm: TGLForm; Msg: UINT; KeyCode, lParam: LongInt;
  ButtonState: TButtonState);
begin
  if ((Msg = WM_SYSKEYUP) or (Msg = WM_SYSKEYDOWN))
  and ((lParam and $10000000) > 0) then
    GLForm.DoKeyPress(KeyCode, lParam, ButtonState, [kbmAlt])
  else
    GLForm.DoKeyPress(KeyCode, lParam, ButtonState, []);
end;

function WinProc(hWindow : THandle; Msg : UINT; wParam : WPARAM;
  LParam : LPARAM): LResult; stdcall;
var
  GLForm: TGLForm;
begin
  Result := 0;

  GLForm := FindWindow(hWindow);

  if not Assigned(GLForm) then
  begin
    Result := DefWindowProc(hWindow, Msg, wParam, lParam);
    exit;
  end;

  case Msg of
    WM_CLOSE: GLForm.CloseMsg(WM_CLOSE);
    WM_DESTROY: GLForm.CloseMsg(WM_DESTROY);

    WM_MOUSEMOVE:   CallMouseMoveProc(GLForm, wParam, lParam);

    WM_LBUTTONDOWN: CallMouseButtonProc(GLForm, mbLeft, bsDown, wParam, lParam);
    WM_LBUTTONUP:   CallMouseButtonProc(GLForm, mbLeft, bsUp, wParam, lParam);
    WM_RBUTTONDOWN: CallMouseButtonProc(GLForm, mbRight, bsDown, wParam, lParam);
    WM_RBUTTONUP:   CallMouseButtonProc(GLForm, mbRight, bsUp, wParam, lParam);
    WM_MBUTTONDOWN: CallMouseButtonProc(GLForm, mbMiddle, bsDown, wParam, lParam);
    WM_MBUTTONUP:   CallMouseButtonProc(GLForm, mbMiddle, bsUp, wParam, lParam);

    WM_KEYDOWN:     CallKeyPressProc(GLForm, Msg, wParam, lParam, bsDown);
    WM_SYSKEYDOWN:  CallKeyPressProc(GLForm, Msg, wParam, lParam, bsDown);
    WM_KEYUP:       CallKeyPressProc(GLForm, Msg, wParam, lParam, bsUp);
    WM_SYSKEYUP:    CallKeyPressProc(GLForm, Msg, wParam, lParam, bsUp);

    WM_ERASEBKGND: ;
    WM_PAINT: GLForm.PaintMsg;

  else
    Result := DefWindowProc(hWindow, Msg, wParam, lParam);
  end;
end;

{ TGLForm }

procedure TGLForm.Close;
begin
  CloseWindow(FHandle);
end;

procedure TGLForm.CloseMsg(Msg: UInt);
begin
  case Msg of
    WM_CLOSE:
      begin
        DeactivateRenderingContext;
        DestroyRenderingContext(FGLRC);
        FClosing := True;
        DestroyWindow(FHandle);

        RegWindows.Remove(Self);
      end;
    WM_DESTROY:
      begin
        FClosing := True;
        DoClose;
      end;
  end;
end;

constructor TGLForm.Create;
begin
  inherited;

  FAutoClear := [acColor, acDepth];

  FGLRC := 0;

  FSavedCW := Default8087CW;
  Set8087CW($133F); { Disable all fpu exceptions }

  FWndClassName := 'Pythian_Project_OpenGLForm';
end;

function TGLForm.CreateWin(WinStyle: Cardinal): Boolean;
begin
  FHandle := CreateWindow(
             PChar(FWndClassName),
             PChar(FCaption),
             WinStyle,
             FLeft, FTop,
             FWidth, FHeight,
             0,
             0,
             hInstance,
             nil);

  Result := (FHandle <> 0);
end;

destructor TGLForm.Destroy;
begin
  inherited;

  Set8087CW(FSavedCW);

  inherited;
end;

procedure TGLForm.DoClose;
begin
  if Assigned(FOnClose) then
    FOnCLose(Self);
end;

procedure TGLForm.DoKeyPress(KeyCode, KeyData: Integer;
  ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
  if Assigned(FOnKeypress) then
    FOnKeyPress(Self, KeyCode, KeyData, ButtonState, Modifiers);
end;

procedure TGLForm.DoMouseButton(Button: TMouseButton; X, Y: Integer;
  ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
  if Assigned(FOnMouseButton) then
    FOnMouseButton(Self, Button, X, Y, ButtonState, Modifiers);
end;

procedure TGLForm.DoMouseMove(X, Y: Integer; Modifiers: TKBModifiers);
begin
  if Assigned(FOnMouseMove) then
    FOnMouseMove(Self, X, Y, Modifiers);
end;

procedure TGLForm.DoOpen;
begin
  if Assigned(FOnOpen) then
    FOnOpen(Self);
end;

procedure TGLForm.DoOpenGLInit;
begin
  if Assigned(FOnOpenGLInit) then
    FOnOpenGLInit(Self);
end;

function TGLForm.InitializeOpenGL: Boolean;
begin
  Result := False;

  FGLRC := CreateRenderingContext(FDC, [opDoubleBuffered], 32, 0, 0, 0, 0);

  if (FGLRC = 0) then
    exit;

  ActivateRenderingContext(FDC, FGLRC); // make context drawable

  glClearColor(0.0, 0.0, 0.0, 1.0); // background color of the context

  glDisable(GL_ALPHA_TEST);
  glDisable(GL_BLEND);
  glDisable(GL_CULL_FACE);
  glDisable(GL_DEPTH_TEST);
  glDisable(GL_DITHER);
  glDisable(GL_FOG);
  glDisable(GL_LIGHTING);
  glDisable(GL_LOGIC_OP);
  glDisable(GL_STENCIL_TEST);
  glDisable(GL_TEXTURE_1D);
  glDisable(GL_TEXTURE_2D);
  glPixelTransferi(GL_MAP_COLOR, GL_FALSE);
  glPixelTransferi(GL_RED_SCALE, 1);
  glPixelTransferi(GL_RED_BIAS, 0);
  glPixelTransferi(GL_GREEN_SCALE, 1);
  glPixelTransferi(GL_GREEN_BIAS, 0);
  glPixelTransferi(GL_BLUE_SCALE, 1);
  glPixelTransferi(GL_BLUE_BIAS, 0);
  glPixelTransferi(GL_ALPHA_SCALE, 1);
  glPixelTransferi(GL_ALPHA_BIAS, 0);

  Result := True;
end;

procedure TGLForm.Open;
var
  ErrorMsg: string;
  WinStyle: Cardinal;

  procedure DoError;
  begin
  end;

begin
  FOpening := True;

  RegWindows.Add(Self);

  if not RegisterWindowClass then
  begin
    ErrorMsg := 'Unable to register new window class';
    DoError;
    exit;
  end;

  if FFullscreen then
    WinStyle := ws_PopUpWindow + ws_Overlapped
  else
    WinStyle := ws_DlgFrame + ws_SysMenu;

  if not CreateWin(WinStyle) then
  begin
    WinStyle := GetLastError;
    ErrorMsg := 'Unable to create Window (' + IntToStr(WinStyle) + ')';
    DoError;
    exit;
  end;

  ShowWindow(FHandle, cmdShow);
  UpdateWindow(FHandle);

  DoOpen;

  FDC := GetDC(FHandle);
  if FDC = 0 then
  begin
    ErrorMsg := 'Unable to create new window device context';
    DoError;
    exit;
  end;

  if not InitializeOpenGL then
  begin
    ErrorMsg := 'Unable to initialize OpenGL device context.';
    DoError;
    exit;
  end;

  DoOpenGLInit;

  FOpening := False;
end;

procedure TGLForm.PaintCaption;
begin
  SetWindowText(FHandle, PChar(FCaption));
end;

procedure TGLForm.PaintMsg;
begin
  if not FRunExclusive and not FClosing and not FOpening then
    Update;
end;

function TGLForm.RegisterWindowClass: Boolean;
const
  TRANSP_COLOR = $00000;
begin
  with FWndClass do
  begin
    Style := CS_SAVEBITS;
    lpfnWndProc := @WinProc;
    cbWndExtra := 0;
    hInstance := hInstance;
    hIcon := LoadIcon(hInstance, 'MAINICON');
    hCursor := 0;
    hbrBackground := TRANSP_COLOR;
    lpszMenuName := nil;
    lpszClassName := PChar(FWndClassName);
  end;

  Result := (Windows.RegisterClass(FWndClass) <> 0);
end;

procedure TGLForm.Run;
var
  Msg: TMsg;
begin
  FRunExclusive := True;

  while not FClosing do
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end;

    Update;
  end;

  FRunExclusive := False;
end;

procedure TGLForm.SetAutoClear(const Value: TAutoClearFlags);
begin
  FAutoClear := Value;
end;

procedure TGLForm.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  if (ALeft <> FLeft) or (ATop <> FTop)
  or (AWidth <> FWidth) or (AHeight <> FHeight) then
  begin
    FLeft := ALeft;
    FTop := ATop;
    FWidth := AWidth;
    FHeight := AHeight;
    if (FHandle <> 0) then
      SetWindowPos(FHandle, 0, ALeft, ATop, AWidth, AHeight,
        SWP_NOZORDER + SWP_NOACTIVATE)
  end;
end;

procedure TGLForm.SetCaption(const Value: string);
begin
  FCaption := Value;
  PaintCaption;
end;

procedure TGLForm.SetFullScreen(const Value: Boolean);
begin
  FFullScreen := Value;
end;

procedure TGLForm.SetHeight(const Value: Integer);
begin
  SetBounds(FLeft, FTop, FWidth, Value);
end;

procedure TGLForm.SetLeft(const Value: Integer);
begin
  SetBounds(Value, FTop, FWidth, FHeight);
end;

procedure TGLForm.SetOnClose(const Value: TNotifyEvent);
begin
  FOnClose := Value;
end;

procedure TGLForm.SetOnKeypress(const Value: TKeypressEvent);
begin
  FOnKeypress := Value;
end;

procedure TGLForm.SetOnMouseButton(const Value: TMouseButtonEvent);
begin
  FOnMouseButton := Value;
end;

procedure TGLForm.SetOnMouseMove(const Value: TMouseMoveEvent);
begin
  FOnMouseMove := Value;
end;

procedure TGLForm.SetOnOpen(const Value: TNotifyEvent);
begin
  FOnOpen := Value;
end;

procedure TGLForm.SetOnOpenGLInit(const Value: TNotifyEvent);
begin
  FOnOpenGLInit := Value;
end;

procedure TGLForm.SetOnPaint(const Value: TNotifyEvent);
begin
  FOnPaint := Value;
end;

procedure TGLForm.SetTop(const Value: Integer);
begin
  SetBounds(FLeft, Value, FWidth, FHeight);
end;

procedure TGLForm.SetWidth(const Value: Integer);
begin
  SetBounds(FLeft, FTop, Value, FHeight);
end;

procedure TGLForm.Update;
begin
  if acDepth in FAutoClear then
    glClear(GL_DEPTH_BUFFER_BIT);

  if acColor in FAutoClear then
    glClear(GL_COLOR_BUFFER_BIT);

  if Assigned(FOnPaint) then
    FOnPaint(Self);

  SwapBuffers(FDC); // copy back buffer to front
end;

initialization
  RegWindows := TList.Create;
finalization
  RegWindows.Free;
end.

[Pythianproject-cvsmail] CVS: Prototypes/GLForm - New directory

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject/Prototypes/GLForm
In directory slayer.i.sourceforge.net:/tmp/cvs-serv30370/GLForm

Log Message:
Directory /cvsroot/pythianproject/Prototypes/GLForm added to the repository

[Pythianproject-cvsmail] CVS: pythiancvs/prototypes/GLForm - Imported sources

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject//pythiancvs/prototypes/GLForm
In directory slayer.i.sourceforge.net:/tmp/cvs-serv29959

Log Message:
no message

Status:

Vendor Tag:	avendor
Release Tags:	arelease
		
N pythiancvs/prototypes/GLForm/Main.dfm
N pythiancvs/prototypes/GLForm/GLFormTest.cfg
N pythiancvs/prototypes/GLForm/GLFormTest.dof
N pythiancvs/prototypes/GLForm/GLFormTest.dpr
N pythiancvs/prototypes/GLForm/GLFormTest.res
N pythiancvs/prototypes/GLForm/GLForms.pas
N pythiancvs/prototypes/GLForm/Main.pas
N pythiancvs/prototypes/GLForm/debug.txt

No conflicts created by this import


***** Bogus filespec: -
***** Bogus filespec: Imported
***** Bogus filespec: sources

[Pythianproject-cvsmail] CVS: GLForm - Imported sources

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject//GLForm
In directory slayer.i.sourceforge.net:/tmp/cvs-serv29866

Log Message:
no message

Status:

Vendor Tag:	avendor
Release Tags:	arelease
		
U GLForm/Main.dfm
U GLForm/GLFormTest.cfg
U GLForm/GLFormTest.dof
U GLForm/GLFormTest.dpr
U GLForm/GLFormTest.res
U GLForm/GLForms.pas
U GLForm/Main.pas
U GLForm/debug.txt

No conflicts created by this import


***** Bogus filespec: -
***** Bogus filespec: Imported
***** Bogus filespec: sources

[Pythianproject-cvsmail] CVS: Prototypes/AI-Demos/FieldData AIDemo.cfg,1.2,1.3 AIDemo.dof,1.2,1.3

[Darryl L. <py...@us...>]

Update of /cvsroot/pythianproject/Prototypes/AI-Demos/FieldData
In directory slayer.i.sourceforge.net:/tmp/cvs-serv29529/AI-Demos/FieldData

Modified Files:
	AIDemo.cfg AIDemo.dof 
Log Message:
no message

Index: AIDemo.cfg
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/AI-Demos/FieldData/AIDemo.cfg,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** AIDemo.cfg	2000/08/23 17:17:02	1.2
--- AIDemo.cfg	2000/11/06 22:03:13	1.3
***************
*** 32,34 ****
  -$M16384,1048576
  -K$00400000
! -LN"e:\program files\borland\delphi4\Lib"
--- 32,35 ----
  -$M16384,1048576
  -K$00400000
! -LE"c:\program files\borland\delphi5\Projects\Bpl"
! -LN"c:\program files\borland\delphi5\Projects\Bpl"

Index: AIDemo.dof
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/AI-Demos/FieldData/AIDemo.dof,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -r1.2 -r1.3
*** AIDemo.dof	2000/08/23 17:17:02	1.2
--- AIDemo.dof	2000/11/06 22:03:13	1.3
***************
*** 56,59 ****
--- 56,64 ----
  HostApplication=
  
+ [Language]
+ ActiveLang=
+ ProjectLang=$00000409
+ RootDir=
+ 
  [Version Info]
  IncludeVerInfo=0