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