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