[Pythianproject-cvsmail] CVS: PythianProject/Source/GLCanvas DemoGLCanvas.cfg,NONE,1.1 DemoGLCanvas.dof,NONE,1.1 DemoGLCanvas.dpr,NONE,1.1 DemoGLCanvas.res,NONE,1.1 GLCanvas.pas,NONE,1.1 Main.dfm,NONE,1.1 Main.pas,NONE,1.1 QuadTextUnit.pas,NONE,1.1 StartUp.pas,NONE,1.1 glcanvas.htm,NONE,1.1 glfD.pas,NONE,1.1

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

Update of /cvsroot/pythianproject/PythianProject/Source/GLCanvas
In directory usw-pr-cvs1:/tmp/cvs-serv23470/GLCanvas

Added Files:
	DemoGLCanvas.cfg DemoGLCanvas.dof DemoGLCanvas.dpr 
	DemoGLCanvas.res GLCanvas.pas Main.dfm Main.pas 
	QuadTextUnit.pas StartUp.pas glcanvas.htm glfD.pas 
Log Message:
Adding conversation stuff -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
-E..\..\Bin
-N..\..\Bin\dcu
-LNe:\program files\borland\delphi4\Lib
-U..\Units;..\Textures
-O..\Units;..\Textures
-I..\Units;..\Textures
-R..\Units;..\Textures

--- 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=E:\cvs\pythianproject\PythianProject\Bin\
UnitOutputDir=..\..\Bin\dcu
PackageDLLOutputDir=
PackageDCPOutputDir=
SearchPath=..\Units;..\Textures
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=

[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=

[Excluded Packages]
E:\cvs\pythianproject\Prototypes\AI\Flocking\Flocking.bpl=RiverSoftAVG Flocking Components

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

[HistoryLists\hlSearchPath]
Count=6
Item0=..\Units;..\Textures
Item1=..\Units
Item2=..\..\PythianProject\Source\Units
Item3=..\..\PythianProject\Units\
Item4=$(DELPHI)\Projects\Pythian\GameProject\Units;$(DELPHI)\Projects\Pythian\GLPanel
Item5=$(DELPHI)\Projects\Pythian\GameProject\Units;$(DELPHI)\Projects\Pythian\GLPanel;$(DELPHI)\Projects\Pythian\GameProject\Picking

[HistoryLists\hlUnitOutputDirectory]
Count=2
Item0=..\..\Bin\dcu
Item1=C:\PythianCVS\pythianproject\PythianProject\Bin\dcu

[HistoryLists\hlOutputDirectorry]
Count=3
Item0=E:\cvs\pythianproject\PythianProject\Bin\
Item1=..\..\Bin
Item2=E:\cvs\pythianproject\PythianProject\Bin

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

--- NEW FILE ---
program DemoGLCanvas;

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

{$R *.RES}

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

--- NEW FILE ---

--- NEW FILE ---
unit glCanvas;

{*******************************************************}
{                                                       }
{       GLCanvas                                        }
{                                                       }
{       Copyright (c) 2000-  The Pythian Project        }
{                                                       }
{*******************************************************}

// This program is free software; you can redistribute it and/or modify it    //
// under the terms of the GNU General Public License as published by the      //
// Free Software Foundation; either version 2 of the License, or (at your     //
// option) any later version. This program is distributed in the hope that    //
// it will be useful, but WITHOUT ANY WARRANTY; without even the implied      //
// warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  //
// GNU General Public License for more details.                               //
//                                                                            //
// You should have received a copy of the GNU General Public License          //
[...1246 lines suppressed...]
end;

initialization
  FontsDirectory := ''; // is appended to font file name

  // create list
  GLCanvasFonts := TList.Create;

  TGLText.RegisterFont('Arial','arial1.glf');
  TGLText.RegisterFont('Courier New','courier1.glf');
  TGLText.RegisterFont('Arial','Arial Grid.bmp',ARIAL_WIDTHS);
  TGLText.RegisterFont('Courier New','CourierNew Grid.bmp',COURIERNEW_WIDTHS);
  TGLText.RegisterFont('VinerHand ITC','VinerHand ITC Grid antialiased.bmp',VINERHAND_WIDTHS);
  TGLText.RegisterFont('Tolkien','tolkien.bmp',TOLKIEN_WIDTHS);
  TGLText.RegisterFont('Arial8','Arial 8.bmp',ARIAL8_WIDTHS);

finalization
  TGLText.FreeRegisteredFonts;
  GLCanvasFonts.Free;
end.

--- NEW FILE ---
ÿ

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

interface

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

const
  datadir = 'data\gui\';

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    FGLForm: TGLForm;
    GLC :TGLCanvas;
    Scene :TGLBitmap;
    WelcomeText :TGLtext;
    VectorText :TGLText;

    TextScroll :integer;
    TextMovement:integer;
    procedure GLFormClose(Sender: TObject);
    procedure GLFormGLInit(Sender: TObject);
    procedure GLFormPaint(Sender: TObject);
    procedure GLKeypress(Sender: TObject; KeyCode, KeyData: Integer;  ButtonState: TButtonState; Modifiers: TKBModifiers);
    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
  Scene.Free;
  WelcomeText.Free;
  VectorText.Free;
  GLC.Free;
  GLC := nil;

  FGLForm.Free;
  FGLForm := nil;

  LogClose;

  Close;
end;

procedure TForm1.GLFormGLInit(Sender: TObject);
begin
  LogOpen('GLCanvasLog.txt');
  FontsDirectory := DataDir;
  GLC := TGLCanvas.Create(FGLForm.Width-6,FGLForm.Height-25); // must take into account window borders
  Scene := TGLBitmap.Create(GLCANVAS_BMP_TEXTURED);
  Scene.UseTransparency := true;
  Scene.LoadFromBitmap(datadir+'scene.png');

  WelcomeText := TGLText.Create('','Arial',GLCANVAS_TEXT_QUADTEXT);
  WelcomeText.Precache := true;
  WelcomeText.Lines.LoadFromFile(datadir+'data.txt');

  VectorText := TGLText.Create('GLCanvas Demo','Arial',GLCANVAS_TEXT_GLF);
  VectorText.SetColor(clBlack);
  VectorText.Size := 30;

  TextScroll := 0;
  TextMovement := 2;
end;

procedure TForm1.GLKeypress(Sender: TObject; KeyCode, KeyData: Integer;
  ButtonState: TButtonState; Modifiers: TKBModifiers);
begin
{  if keycode = vk_escape then DestroyWindow(FGLForm.Handle)
  else }begin
    case keycode of
      VK_UP: begin
              TextScroll := TextScroll - TextMovement;
              if TextScroll < 0 then TextScroll := 0;
            end;
      VK_DOWN: begin
                TextScroll := TextScroll + TextMovement;
                if TextScroll < 0 then TextScroll := 0;
              end;  
    end;
  end;
end;

procedure TForm1.GLFormPaint(Sender: TObject);
begin
  // Let's look at how we use the canvas shall we?
  // just follow me :)

  // ok, we start by calling InitMatrix which just resets the
  // co-ordinate system to its initial values. should be called
  // before using the canvas.
  GLC.InitMatrix;

  // next we clear the screen. if we don't do this the remains of the
  // last frame will show through
  glClearColor(0.0,0.0,0.0,1.0);
  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
  // draw the pretty scene here
  GLC.ImageAlpha := 1.0;
  GLC.DrawBitmap(0,0,Scene);

  // this draws a rectangle
  GLC.CurrentColor := clBlue;
  GLC.FillAlpha := 0.3; // we want 30% opacity
  GLC.Solid := true; // we want it solid
  GLC.Rectangle(330,220,600,440); // now draw it here!
  // now draw its border
  GLC.Solid := false;
  GLC.FillAlpha := 1.0;
  GLC.Rectangle(330,220,600,435);

  GLC.SetClipping(330,220,600,435); // set the clipping rect to the blue box
  GLC.DrawText(335,225-TextScroll,WelcomeText);
  GLC.CancelClipping;

  // now draw the logo text
  glColor3f(1.0,1.0,1.0);
  GLC.DrawText(200,70,VectorText);
end;

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

  FGLForm := TGLForm.Create;
  FGLForm.SetBounds(0, 0, 640, 480);
  GetDeviceModes;
  FGLForm.DeviceMode := FindMode(640,480,16);
  FGLForm.Caption := 'GLCanvas demonstration';
  FGLForm.OnClose := GLFormClose;
  FGLForm.OnOpenGLInit := GLFormGLInit;
  FGLForm.OnKeyPress := GLKeypress;
  FGLForm.OnPaint := GLFormPaint;

  try
    FGLForm.Open;
  except
    exit;
  end;

  FGLForm.Run;
end;

end.

--- NEW FILE ---
unit QuadTextUnit;

interface

{

  Textured Quads text system
  Michael Hearn

  (C) Pythian Project 2000



  Changed -
    5th December 2000: changed blending algorithm selected to fix bug.
}

const
  NUMCHARS = 85;

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','!','"','?','.','''','(',')',',','£','$',
                                 '&','=','+','-','<','>',':',';','/','\','#','@',
                                 '¯');

  NULL_WIDTHS :TQuadTextWidthsArray =
                                 ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, {32}
                                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
                                   0, 0, 0, 0, 0);

  COURIERNEW_WIDTHS :TQuadTextWidthsArray = (
                                 10, 10, 10, 10, 10, 10, 10, 10,  8, 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,  3,  6,  6,
                                  6,  8,  7,  7,  8,  8,  2,  3,  6,  6,  8,  7,
                                  20);
  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,
                                 8,  8,  4,  6,  7,  2,  2,  3,  3,  2, 13, 14,
                                 12, 5,  7,  2,  8,  8,  2,  2,  4,  4, 12, 15,
                                 15);

  ARIAL8_WIDTHS :TQuadTextWidthsArray = (
                                   7, 6, 6, 6, 5, 5, 7, 6, 1, 4, 6, 5,
                                   7, 6, 7, 4, 6, 6, 6, 7, 8, 8, 10,6,
                                   8, 6, 5, 5, 5, 5, 5, 4, 5, 5, 1, 2,
                                   4, 1, 7, 5, 5, 5, 5, 3, 5, 3, 5, 5,
                                   9, 5, 5, 5, 3, 5, 5, 5, 5, 5, 5, 5,
                                   5, 5, 1, 3, 5, 1, 2, 3, 3, 1, 5, 5,
                                   6, 5, 5, 3, 5, 5, 1, 1, 3, 3, 5, 10,
                                   15);


  VINERHAND_WIDTHS :TQuadTextWidthsArray = (
                                 14, 11, 12, 12, 10, 10,  8, 13,  7,  8, 14, 11,
                                 14, 14,  8, 10, 14, 11, 10, 8, 10, 10, 16, 10,
                                 10, 10,  8,  8,  7,  8,  6,  5,  8,  8,  2,  3,
                                 8,  2,  12,  8,  7,  8,  8,  5,  8,  5,  8,  8,
                                 8,  8,   8,  8,  6,  8,  8,  8,  8,  8,  8,  8,
                                 8,  8,   4,  6,  7,  2,  2,  3,  3,  2, 13, 14,
                                 12, 5,   7,  2,  8,  8,  2,  2,  4,  4, 12, 15,
                                 15);
  TOLKIEN_WIDTHS: TQuadTextWidthsArray = (
                                 14, 12, 15, 17, 16, 10, 16, 15, 6,  4, 15, 11,
                                 21, 14, 17, 15, 17, 12, 12, 17,14, 16, 21, 14,
                                 13, 16, 10, 10, 9,  10, 9,  8,  10, 9,  4,  4,
                                 10, 7,  12, 10, 9,  10, 10, 9,  8,  9, 10,  9,
                                 14, 11, 10, 10, 4,  11, 11, 11, 10, 11,11, 11,
                                 11, 11, 5,  3,  9,  2,  2,  5,  5,  2, 13, 13,
                                 12, 5,  7,  2,  8,  8,  2,  2,  12, 12,18, 15,
                                 15);
  QT_UNDERLINE_CHARACTER = '|';
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(QT: TQuadText);
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);
function qtGetStringWidth(QT:TQuadText; s:string):integer; // in pixels
function qtGetHeight(QT:TQuadText):integer;

implementation
uses OpenGL, Graphics;

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

function qtGetHeight(QT:TQuadText):integer;
begin
  result := qt.GridSquareHeight;
end;

function qtGetStringWidth(QT:TQuadText; s:string):integer; // in pixels
var total,offset,i,j:integer;
begin
  total := 0;
  for i := 1 to Length(s) do
  begin
    offset := -1;
    for j := 1 to NUMCHARS do
      if TEX_CHARS[j] = s[i] then
        offset := j;
    if offset <> -1 then
      total := total + QT.TexWidths[offset] + QT.GridCharSpacing
    else total := total + QT.SpaceWidth;
  end;
  result := total;
end;

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
    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
  l := (x-1) * QT.GridSquareWidth;//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);
    glTexCoord2f(l+QT.GridSquareWidth,t+QT.GridSquareHeight);
    glVertex2f(QT.GridSquareWidth,QT.GridSquareHeight);

//    glTexCoord2f(l-QT.GridSquareWidth,t);
    glTexCoord2f(l+QT.GridSquareWidth,t);
    glVertex2f(QT.GridSquareWidth,0);
  glEnd;

  result := 0;
end;


procedure qtDrawGridString(QT:TQuadText; s:String);
var
  o,a:integer;
  underline:boolean;
begin
  // @@todo - don't draw when clipped
  glMatrixMode(GL_TEXTURE); // modify texture matrix;
  glPushMatrix;
  glLoadIdentity;
  glScalef(1/256,1/256,1);

  glMatrixMode(GL_MODELVIEW);
//  glPushMatrix;
//  glPushMatrix;
  underline := false;
  if length(s) = 1 then
  begin
    qtDrawGridChar(qt,s[1]);
  end else
  begin
    a := 1;
    while a <= Length(s) do
    begin
      if s[a] = #13 then
      begin
        glPopMatrix;
        glTranslatef(0,QT.GridSquareHeight,0); // translate down
        glPushMatrix;
      end else if s[a] = QT_UNDERLINE_CHARACTER then
        underline := not underline
      else if s[a] <> #$A then begin
        o := qtDrawGridChar(QT,s[a]);
        if o <> -1 then
        begin
          if underline then
          begin
            glDisable(GL_TEXTURE_2D);
            glBegin(GL_LINES);
              glVertex2i(0,QT.GridSquareHeight);
              glVertex2i(QT.TexWidths[o]+QT.GridCharSpacing,QT.GridSquareHeight);
            glEnd;
            glEnable(GL_TEXTURE_2D);
          end;
          glTranslatef(QT.TexWidths[o]+QT.GridCharSpacing,0,0)
        end else // translate for space character
        begin
          if underline then
          begin
            glDisable(GL_TEXTURE_2D);
            glBegin(GL_LINES);
              glVertex2i(0,QT.GridSquareHeight);
              glVertex2i(QT.SpaceWidth,QT.GridSquareHeight);
            glEnd;
            glEnable(GL_TEXTURE_2D);
          end;
          glTranslatef(QT.SpaceWidth,0,0);
        end;
      end;
      inc(a);
    end;
  end;
//  glPopMatrix;
//  glPopMatrix;
  glMatrixMode(GL_TEXTURE);
  glPopMatrix;
  glMatrixMode(GL_MODELVIEW);
end;

procedure qtStart(QT: TQuadText);
begin
  glBindTexture(GL_TEXTURE_2D, QT.TextureID);
  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_ONE,GL_ONE);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
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.

--- NEW FILE ---
{*******************************************************}
{                                                       }
{       GLCanvas Demo program                           }
{                                                       }
{       Copyright (c) 1999 The Pythian Project          }
{                                                       }
{*******************************************************}

// This program is free software; you can redistribute it and/or modify it    //
// under the terms of the GNU General Public License as published by the      //
// Free Software Foundation; either version 2 of the License, or (at your     //
// option) any later version. This program is distributed in the hope that    //
// it will be useful, but WITHOUT ANY WARRANTY; without even the implied      //
// warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the  //
// GNU General Public License for more details.                               //
//                                                                            //
// You should have received a copy of the GNU General Public License          //
// along with this program; if not, write to the Free Software Foundation,    //
// Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.            //

unit StartUp;

// This unit contains all the code necessary for the user to set up the       //
// application for their hardware.  In will also create an EngWindow, which   //
// is where the OpenGL renderer will occur.                                   //

// You should not need to make any changes to this unit, except you may want  //
// to change the version string.                                              //

// New in v1.02
// -INI file uses W, H and BPP instead of ModeIndex.
// -If user exits, configuration was saved without
//  getting the values from form... Fixed.

interface

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

const
  VersionString = 'v0.01';  // This is the version string for your application
type
  TfrmStartup = class(TForm)
    cbFullScreen: TCheckBox;
    cbResolution: TComboBox;
    Label1: TLabel;
    lbDrivers: TListBox;
    Label2: TLabel;
    btBrowse: TButton;
    btStart: TButton;
    btClose: TButton;
    OpenDialog1: TOpenDialog;
    procedure btStartClick(Sender: TObject);
    procedure btCloseClick(Sender: TObject);
    procedure btBrowseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
    FDeviceMode: Integer;
    FDriver: string;
    FFullScreen: Boolean;
    function ChangeExt(const FileName, NewExt: string): string;
    procedure GetSettings;
  public
    { Public declarations }
  end;

var
  frmStartup: TfrmStartup;

implementation

uses ClipBrd, DeviceMode, EngWindow, EngMain, INIFiles, OpenGL;

{$R *.DFM}

procedure TfrmStartup.btBrowseClick(Sender: TObject);
begin
  with OpenDialog1 do
  begin
    if Execute then
      lbDrivers.ItemIndex := lbDrivers.Items.Add(FileName);
  end;
end;

procedure TfrmStartup.btCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmStartup.btStartClick(Sender: TObject);
var
  Ok: Boolean;
  SetModeResult: Integer;
  Msg: string;
begin
  // Take the settings from the Form controls and store them in vars
  GetSettings;
  // Hide this Form
  Hide;
  Ok := True;
  if FFullScreen then
  begin
    // Set the Device Mode
    SetModeResult := SetMode(FDeviceMode);
    if (SetModeResult <> 0) then
    begin
      case SetModeResult of
        $01: Msg := 'Change Restart';
        $02: Msg := 'Bad Flags';
        $03: Msg := 'Failed';
        $04: Msg := 'Bad Mode';
      else
        Msg := 'Unknown Error';
      end;
      // Report the error
      Msg := 'Fullscreen mode error: '+Msg;
      ShowMessage(Msg);
      Ok := False;
    end;
  end;
  if Ok then
  begin
    // Load the specified OpenGL Driver
    Ok := InitOpenGLFromLibrary(FDriver,'glu32.dll');
    if Ok then
    begin
      EngMain.Width := DeviceModes[FDeviceMode].Width;
      EngMain.Height := DeviceModes[FDeviceMode].Height;

      if not InitEngine(FFullScreen,'Sample') then
        ShowMessage('Error: '+ErrorMsg);
    end
    else begin
      Msg := 'Could not initialize OpenGL driver: '+FDriver;
      ShowMessage(Msg);
    end;
    if FFullScreen then
    begin
      // Reset the Device Mode
      SetModeResult := ResetMode;
      if (SetModeResult <> 0) then
      begin
        case SetModeResult of
          $01: Msg := 'Change Restart';
          $02: Msg := 'Bad Flags';
          $03: Msg := 'Failed';
          $04: Msg := 'Bad Mode';
        else
          Msg := 'Unknown Error';
        end;
        Msg := 'Fullscreen mode error: '+Msg;
        ShowMessage(Msg);
      end;
    end;
  end;
  Close;
end;

function TfrmStartup.ChangeExt(const FileName, NewExt: string): string;
var
  Path,s: string;
begin
  Path := ExtractFilePath(FileName);
  s := ExtractFileName(FileName);
  s := copy(s,1,Pos('.',s)-1);
  if (length(NewExt) > 0) and (NewExt[1] <> '.') then
    s := s + '.';
  Result := Path + s + NewExt;
end;

procedure TfrmStartup.FormCreate(Sender: TObject);
var
  i: Integer;
  INIFile: TINIFile;
  T: TStringList;
  s: string;
  Buf: PChar;
  DMW, DMH, DMBPP: Integer;
begin
  Getmem(Buf, 64);
  GetSystemDirectory(Buf, 64);
  s := StrPas(Buf);
  FreeMem(Buf);

  lbDrivers.Items.Add(s+'\OpenGL32.DLL');
  lbDrivers.Items.Add(s+'\OpenGL.DLL');

  for i := 0 to MaxDeviceModes-1 do
    with DeviceModes[i] do
    begin
      cbResolution.Items.Add(Format('%d x %d x %d',[Width,Height,BitsPerPixel]));
    end;

  INIFile := TINIFile.Create(ChangeExt(Application.EXEName,'ini'));
  with INIFile do
    try
      T := TStringList.Create;
      try
        ReadSectionValues('Drivers',T);
        for i := 0 to T.Count-1 do
          lbDrivers.Items.Add(copy(T[i],Pos('=',T[i])+1,length(T[i])));
      finally
        T.Free;
      end;
      lbDrivers.ItemIndex := ReadInteger('Setup','DriverIndex',0);
      cbFullScreen.Checked := ReadBool('Setup','FullScreen',False);
      //cbResolution.ItemIndex := ReadInteger('Setup','DeviceModeIndex',M640x480x32);
      DMW := ReadInteger('Setup','DeviceModeWidth', 640);
      DMH := ReadInteger('Setup','DeviceModeHeight', 480);
      DMBPP := ReadInteger('Setup','DeviceModeBitsPerPixel', 32);
      cbResolution.ItemIndex := FindMode(DMW, DMH, DMBPP);
    finally
      Free;
    end;
end;

procedure TfrmStartup.FormDestroy(Sender: TObject);
var
  i: Integer;
  INIFile: TINIFile;
begin
  GetSettings;
  INIFile := TINIFile.Create(ChangeExt(Application.EXEName,'ini'));
  with INIFile do
    try
      for i := 2 to lbDrivers.Items.Count-1 do
        WriteString('Drivers',IntToStr(i),lbDrivers.Items[i]);
      WriteInteger('Setup','DriverIndex',lbDrivers.ItemIndex);
      WriteBool('Setup','FullScreen',cbFullScreen.Checked);
//      WriteInteger('Setup','DeviceModeIndex',FDeviceMode);
      WriteInteger('Setup','DeviceModeWidth',DeviceModes[FDeviceMode].Width);
      WriteInteger('Setup','DeviceModeHeight',DeviceModes[FDeviceMode].Height);
      WriteInteger('Setup','DeviceModeBitsPerPixel',DeviceModes[FDeviceMode].BitsPerPixel);
    finally
      Free;
    end;
end;

procedure TfrmStartup.GetSettings;
begin
  if cbResolution.ItemIndex < 0 then
    FDeviceMode := FindMode(640, 480, 24) //M640x480x24
  else
    FDeviceMode := cbResolution.ItemIndex;

  FFullScreen := cbFullScreen.Checked;

  if (lbDrivers.ItemIndex < 0) then
    FDriver := 'opengl32.dll'
  else
    FDriver := lbDrivers.Items[lbDrivers.ItemIndex];
end;

end.

--- NEW FILE ---
<html>
<head>
  <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"><meta name="GENERATOR" content="Microsoft FrontPage 4.0"><meta name="ProgId" content="FrontPage.Editor.Document">
  <title>GLCanvas Documentation</title>
</head>
<body>
<div align="Left">
<h4>GLCanvas v1.0 Documentation</h4>
<hr align="Left" width="100%" size="2"><a href="mailto:mh...@su...">Michael





 Hearn</a><br>
<a href="mailto:d_...@sy...">Darryl Long</a><br>
<a href="mailto:kr...@gm...">Kamil Krauspe</a><br>
<br>
<hr align="Left" width="100%" size="2"><br>
Change Log:<br>
<br>
- 14th December 2000: Changed to reflect new font registration system<br>
- 4th December 2000: Add info about InitMatrix (doh!)<br>
<hr align="Left" width="100%" size="2"><br>
This file describes the GLCanvas objects suite and how to use it to make





 drawing 2D graphics onto an OpenGL canvas much easier than it would otherwise





 be. The algorithms used in the canvas have been designed for speed and ease





 of use, not necessarily simplicity. This is why some operations with it





 may seem a strange way of doing things. Anyway, let's go.<br>
<br>
<u>What it can do</u><br>
<ul>
  <li>Images (fast)</li>
  <li>Bitmapped text (fast)</li>
  <li>Vector text (via the GLF lib)</li>
  <li>PNG image support</li>
  <li>Clipping</li>
  <li>Rectangle drawing<br>
  </li>
</ul>
All this is done using simple commands like Rectangle(), DrawBitmap() and





 DrawText().<br>
<br>
<u>Drawing Images</u><br>
<br>
Images in OpenGL are not directly supported unless you use the glDrawPixels()
     command which directly copies pixel data from system memory to the pixel
     buffer. This would be ideal but unfortunately this is a <b>very</b> 
 slow operation, and I mean slow. Drawing a 640x480 image in this way on
 my machine takes almost half a second :(<br>
Nevertheless, the Canvas supports this method for when performance is not





 the be all and end all for your app.<br>
<br>
However, there is a better, although significantly more complex way of doing





 things that results in much better framerates (ie. about 120fps on my machine





 for a 640x480 image :) This system breaks the image you want to draw into





 multiple textures and then uses polygons to display them. Because these





 images are hardware accellerated things move along much better. Why multiple





 textures? Well, most hardware cards have a limit of 256x256 pixels for textures





 due to the internals of their engines. So the canvas breaks an image into





 multiple textures when the image is loaded.<br>
<br>
So how do you use this then? Well, all bitmaps in the GLCanvas are represented





 by objects, in this case the TGLBitmap class is used. To use a bitmap it





 must be loaded into one of these objects, which can then be passed to the





 DrawBitmap() method of the GLCanvas. Here's an example:<br>
<br>
<code>GLC: TGLCanvas;</code><br>
<code>Picture :TGLBitmap;</code><br>
<br>
<code>begin</code><br>
<code>  GLC := TGLCanvas.Create;<br>
<br>
  GLC.InitMatrix;</code><br>
<br>
<code>  Picture := TGLBitmap.Create;</code><br>
<code>  Picture.LoadFromFile("logo.png");</code><br>
<br>
<code>  GLC.DrawBitmap(50,50,Picture);</code><br>
<code>end;</code><br>
<br>
Note that before any GLCanvas methods can be called you must call InitMatrix,

 this initializes the co-ordinate systems. This example would display "logo.png"at

 location 50,50 from the top left  of the window. As you can see, there is

 nothing to it. However, we can do  more than this! The GLBitmap class supports

 transparency using a transparent  colour: if we set the transparent colour

 to black then any black pixels  in the picture will be see-through, meaning

 you can draw non-rectangular  bitmaps. This is done by setting the <code>UseTransparency</code>property 

 to true and setting the TransparentColor property to the colour you want 

 (it defaults to black). Because the GLCanvas is based partly on the FastDIB 

 library you must specify the colour as RGB data, not a Delphi colour constant. 

 Although in some places you can use constants like clBlack or clAqua in 

 this instance that's not allowed. You create a colour for this property 

 using the FRGB function:<br>
<br>
<code>Picture := TGLBitmap.Create;<br>
Picture.UseTransparency := true;<br>
Picture.TransparentColor := FRGB(0,0,255);    // blue is our transparent



 colour<br>
Picture.LoadFromFile("logo.png");</code><br>
<br>
Notice that you <i>must</i>set the transparency properties before loading



 the file. If you want you can use direct drawing by using a different constructor:<br>
<br>
<code>Picture := TGLBitmap.Create(GLCANVAS_BMP_DIRECT);</code><br>
<br>
However, this isn't really supported very well - for instance transparency



 doesn't work with this method. Also, it's slow so it's best to avoid this.<br>
<br>
<u>Drawing Text</u><br>
<br>
Again, OpenGL has no direct support for drawing text. There are many, many
    different ways of drawing text (for more information on this subject
 check out NeHe's excellent <a href="http://nehe.gamedev.net/opengl/">tutorial pages</a>) and
 the Canvas offers you two which should combine the best of both worlds -
 bitmapped    text which looks nice at small sizes, and vector text which
 can be resized    to any area needed without losing resolution. Vector fonts
 are drawn using    the <a href="http://romka.demonews.com">GLF library </a>written by Romka,
 who is a seriously    cool guy. You can get more fonts from his website.<br>
<br>
Bitmapped fonts are drawn using my own system that uses a 256x256 bitmap



 with letters arranged in a grid formation. Textured polygons are drawn that



 use this and this means <i>fast fast fast!</i><br>
<br>
This also means that fonts are very easy to make, although it does take some



 time. You can use the included "20x20grid.bmp" file to help you create new



 fonts. To use the text facility you can use the TGLText object. The reason



 that text is represented by objects too is for performance reasons, when



 you use an object something called pre-caching becomes available which stores



 the commands for drawing the text in the hardware accellerator itself, meaning



 - yep, you've guessed it, faster execution! Of course, if this isn't important



 to you it's possible to use the DrawString() command for simplicity but



 it's really designed to use an object. Here's a simple example of it:<br>
<br>
<code>var<br>
  Text1 :TGLText;<br>
  GLC :TGLCanvas;<br>
<br>
begin<br>
  Text1 := TGLText.Create("Arial");<br>
  Text1.SetColor(clYellow);<br>
  Text1.Text := "Hello World";<br>
<br>
  GLC.DrawText(30,30,Text1);<br>
end;</code><br>
<br>
As you can see, this is quite easy, but you can do more :) Text objects can



 have multiple lines (accessed through the Lines property), and of course



 this can be used to load text files. The demo program shows this in action.



 This uses textured quads to draw bitmapped text. To use the GLF vector based



 text:<br>
<br>
<code>var Text2: TGLText;<br>
<br>
begin<br>
  Text2 := TGLText.Create("Hello World","Arial",GLCANVAS_TEXT_GLF);<br>
  // here we have used the other overloaded constructor to select GLF text.



 you can ignore<br>
  // the last parameter, it selects a font data array, the default one will



 do for now.<br>
  Text2.Size := 20;<br>
  GLC.DrawText(30,30,Text2);<br>
end;</code><br>
<br>
If you want to change the directory fonts are loaded from (the default is 
 for the current directory) you can set the FontsDirectory variable in the 
 unit. This is a string that is appended to the start of the font filenames 
 before they are loaded, and therefore they <b>must</b>have a / at the end. 
 For instance:<br>
<br>
<code>FontsDirectory := "..\Data\Fonts\"      // is OK<br>
FontsDirectory := "..\Data\Fonts"  // is not!</code><br>
<br>
How you add new fonts depends on the system you use. If you're drawing vector
 text you can simply download more GLF fonts from Romkas website but I'm
 not sure how you can make your own. Then you register the font as shown
 below. For bitmap text it's more complex    (i'm afraid the canvas only
 comes with Arial and Courier New) but everything can be done using Paint
 Shop Pro or a similar program.<br>
<br>
To create a new bitmapped font:<br>
<ol>
  <li>Create a new 256x256 bitmap with a black background</li>
  <li>Paste the "20x20 Grid.bmp" file over the top. This will show you where



 to place characters. If you want you can place the grid over the fonts that



 come with the canvas to see how it's done.</li>
  <li>For each character place the letter (in white) in each square aligned



 to the left of each grid square.</li>
  <li>Once this is done for every character (well, every character that is



 in the font set, you can see them in the other font grids) save it and change



 the GLCanvas.pas file in the following way:</li>
  <li>You also need to add a widths array to the QuadTextUnit.pas file. This



 array specifies the width of each character and is how the system support



 variable width fonts. See the code for examples of how to do this.</li>
  <li>Then you add an entry to the initialization section of the GLCanvas
 unit like this:<br>
    <br>
   TGLText.RegisterFont('Arial','Arial Grid.bmp',ARIAL_WIDTHS);<br>
    <br>
where you specify the widths array you created above.<br>
  </li>
  <li>That's it! I know it's long winded, some time I may automate it but



 for now that's the way to do it. If you want to add some sort of exotic



 character not already in the font set add it to the array and set the rest



 of the widths in the other arrays to 0.</li>
</ol>
<br>
<u>Drawing shapes</u><br>
<br>
You can draw rectangles using the Rectangle() method. This takes 4 coordinates,



 X1, X2, Y1 and Y2. It draws a rectangle based on the:<br>
<br>
<i>CurrentColor</i><br>
<i>Solid</i><br>
and <i>FillAlpha</i><br>
<br>
properties. If solid is true then the rectangle will be filled with the colour



 and at the opacity specified with FillAlpha. If solid is false then the



 outline is all that is drawn.<br>
<br>
<hr align="Left" width="100%" size="2"><br>
Phew! Hopefully that clears up how to use the object. I hope you like it!<br>
<br>
This object was designed and built for the <a href="http://www.pythianproject.org/">Pythian Project</a><br>
</div>
</body>
</html>

--- NEW FILE ---
unit glfd;

interface

{
==============================================================================
|  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
|  This library is freely distributable without any license or permissions
|  for non-commercial usage. You can use this library in any non-commercial
|  program. In each program, where You use this library You should keep 
|  this header (author name and coordinates)!
[...1553 lines suppressed...]
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
  glCallList(list_base + Integer(s));
end;

//* Draw bitmapped string */
procedure glfDrawBString(s: string);
begin
  glListBase(list_base);
  glCallLists(strlen(PChar(s)), GL_UNSIGNED_BYTE, PChar(s));
end;

end.