[Pythianproject-cvsmail] CVS: Prototypes/GLCanvas QuadTextUnit.pas,1.5,1.6 glCanvas.pas,1.11,1.12

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

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

Modified Files:
	QuadTextUnit.pas glCanvas.pas 
Log Message:
small changes. altered GLCanvas to use better font registration system. 
fixed bug which caused multiple texture loading. small other changes.
rearranged VGL units -mike

Index: QuadTextUnit.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/QuadTextUnit.pas,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -r1.5 -r1.6
*** QuadTextUnit.pas	2000/12/11 19:15:11	1.5
--- QuadTextUnit.pas	2000/12/12 22:15:56	1.6
***************
*** 34,37 ****
--- 34,45 ----
                                   '¯');

+   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, 10, 10, 10, 10,

Index: glCanvas.pas
===================================================================
RCS file: /cvsroot/pythianproject/Prototypes/GLCanvas/glCanvas.pas,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** glCanvas.pas	2000/12/12 20:40:36	1.11
--- glCanvas.pas	2000/12/12 22:15:57	1.12
***************
*** 98,109 ****
    end;

!   TGLCanvasFontData = record
      Name, FileName:string;
      FontType :integer;
    end;

!   TArrayOfGLCanvasFontData = array[1..GLC_MAXFONTS] of TGLCanvasFontData;

! const
    GLC_DEFAULT_FONT_DATA :TArrayOfGLCanvasFontData = (
                              (Name: 'Arial';
--- 98,109 ----
    end;

! {  TGLCanvasFontData = record
      Name, FileName:string;
      FontType :integer;
    end;

!   TArrayOfGLCanvasFontData = array[1..GLC_MAXFONTS] of TGLCanvasFontData; }

! {const
    GLC_DEFAULT_FONT_DATA :TArrayOfGLCanvasFontData = (
                              (Name: 'Arial';
***************
*** 127,131 ****
                               FontType: GLCANVAS_TEXT_QUADTEXT;
                              )
!                           );

--- 127,131 ----
                               FontType: GLCANVAS_TEXT_QUADTEXT;
                              )
!                           );  }

***************
*** 188,196 ****
    end;

    TGLText = class
    private
      // wraps up the GLF library and possibly other text systems
-     FFonts :TArrayOfGLCanvasFontData;
- 
      FLines :TStringList;
      FFontName :string;
--- 188,202 ----
    end;

+   TGLTexturedFont = class
+     Name, FileName:string;
+     FontType :integer;
+     Widths:TQuadTextWidthsArray;
+     Texture:TTexture;
+     constructor Create(aName:string; aFileName:string; aWidths:TQuadTextWidthsArray);
+   end;
+ 
    TGLText = class
    private
      // wraps up the GLF library and possibly other text systems
      FLines :TStringList;
      FFontName :string;
***************
*** 217,224 ****
      procedure DrawInternal(line:integer); virtual;

!     function MatchFontName(name:string; tt:Integer):TGLCanvasFontData;
!     function MatchFontWidths(f:TGLCanvasFontData):TQuadTextWidthsArray;

-     procedure LinesOnChange(Sender:TObject);
      function GetWidth(index: integer): integer;
    public
--- 223,228 ----
      procedure DrawInternal(line:integer); virtual;

!     function MatchFontName(name:string; tt:Integer):TGLTexturedFont;

      function GetWidth(index: integer): integer;
    public
***************
*** 245,253 ****
      property DisplayList :integer read FDisplayList;

!     constructor Create(aText, aFontName:string; aPreferredTextType:integer; FontData:TArrayOfGLCanvasFontData); overload;
      constructor Create(aFontName:string); overload; // auto creates with no text, and quadtext selected
      destructor Destroy; override ;
      procedure Draw(Line:integer); virtual ;
      procedure SetColor(const Value: TColor);
    end;

--- 249,261 ----
      property DisplayList :integer read FDisplayList;

!     constructor Create(aText, aFontName:string; aPreferredTextType:integer); overload;
      constructor Create(aFontName:string); overload; // auto creates with no text, and quadtext selected
      destructor Destroy; override ;
      procedure Draw(Line:integer); virtual ;
      procedure SetColor(const Value: TColor);
+     procedure LinesOnChange(Sender:TObject); // be sure to call if you override this event handler
+ 
+     class procedure RegisterFont(name,filename:string;widths:TQuadTextWidthsArray); overload ;
+     class procedure RegisterFont(name,filename:string); overload ;
    end;

***************
*** 318,323 ****
--- 326,336 ----
  function FitRectToRect(src,dest:TRect):TRect;

+ 
+ 
  implementation

+ var
+   GLCanvasFonts :TList;
+ 
  function CompareRect(r1,r2:TRect):boolean;
  begin
***************
*** 552,556 ****
  var t:TGLText;
  begin
!   t := TGLText.Create(str,FontName,aFontType,GLC_DEFAULT_FONT_DATA);
    DrawText(X,Y,t);
    t.Free;
--- 565,569 ----
  var t:TGLText;
  begin
!   t := TGLText.Create(str,FontName,aFontType);
    DrawText(X,Y,t);
    t.Free;
***************
*** 676,680 ****
  { TGLText }

! constructor TGLText.Create(aText, aFontName: string; aPreferredTextType:integer; FontData:TArrayOfGLCanvasFontData);
  begin
    inherited Create;
--- 689,693 ----
  { TGLText }

! constructor TGLText.Create(aText, aFontName: string; aPreferredTextType:integer);
  begin
    inherited Create;
***************
*** 687,691 ****
    TextType := aPreferredTextType;
    FFontName := aFontName;
-   FFonts := FontData;
    FTexture := nil;
    LoadFont;
--- 700,703 ----
***************
*** 697,701 ****
  constructor TGLText.Create(aFontName: string);
  begin
!   Create('',aFontName,GLCANVAS_TEXT_QUADTEXT,GLC_DEFAULT_FONT_DATA);
  end;

--- 709,713 ----
  constructor TGLText.Create(aFontName: string);
  begin
!   Create('',aFontName,GLCANVAS_TEXT_QUADTEXT);
  end;

***************
*** 766,770 ****

  procedure TGLText.LoadFont;
! var f:TGLCanvasFontData;
  begin
    f := MatchFontName(FontName,TextType);
--- 778,782 ----

  procedure TGLText.LoadFont;
! var f:TGLTexturedFont;
  begin
    f := MatchFontName(FontName,TextType);
***************
*** 780,785 ****
    begin
      if assigned(FTexture) then FTexture.Free;
!     FTexture := TTexture.Create;
!     FTexture.LoadFromFile(FontsDirectory + f.FileName);
      QT.TextureID := FTexture.TexID;
      QT.GridSquareWidth := 20;
--- 792,802 ----
    begin
      if assigned(FTexture) then FTexture.Free;
!     // if not already loaded
!     if not assigned(f.Texture) then
!     begin
!       FTexture := TTexture.Create;
!       FTexture.LoadFromFile(FontsDirectory + f.FileName);
!       f.Texture := FTexture;
!     end else FTexture := f.Texture;
      QT.TextureID := FTexture.TexID;
      QT.GridSquareWidth := 20;
***************
*** 788,803 ****
      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;
--- 805,820 ----
      QT.GridCharSpacing := 2;
      QT.SpaceWidth := 5;
!     QT.TexWidths := f.Widths;
    end; // add more text types here
  end;

! function TGLText.MatchFontName(name: string; tt: Integer): TGLTexturedFont;
  var a:integer;
  begin
    // returns first match
    for a := 1 to GLC_MAXFONTS do
!     if (UpperCase(TGLTexturedFont(GLCanvasFonts[a]).Name) = UpperCase(name)) and (TGLTexturedFont(GLCanvasFonts[a]).FontType = tt) then
      begin
!       Result := GLCanvasFonts[a];
        exit;
      end;
***************
*** 805,822 ****
  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
-   else if UpperCase(f.Name) = 'VINERHAND ITC' then
-     Result := VINERHAND_WIDTHS;
- end;
- 
  procedure TGLText.SetBlue(const Value: byte);
  begin
--- 822,825 ----
***************
*** 882,885 ****
--- 885,900 ----
  end;

+ class procedure TGLText.RegisterFont(name, filename: string;
+   widths: TQuadTextWidthsArray);
+ begin
+   GLCanvasFonts.Add(TGLTexturedFont.Create(name,filename,widths));
+ end;
+ 
+ class procedure TGLText.RegisterFont(name, filename: string);
+ begin
+   GLCanvasFonts.Add(TGLTexturedFont.Create(name,filename,NULL_WIDTHS));
+ end;
+ 
+ 
  // *********************** texture bitmaps **************************

***************
*** 1093,1098 ****
--- 1108,1138 ----
  end;

+ { TGLTexturedFont }
+ 
+ constructor TGLTexturedFont.Create(aName, aFileName: string; aWidths:TQuadTextWidthsArray);
+ begin
+   inherited Create;
+   Name := aName;
+   FileName := afileName;
+   Widths := aWidths;
+   Texture := nil;
+   if (ExtractFileExt(FileName) = '.glf') or (ExtractFileExt(FileName) = '.glf') then
+     FontType := GLCANVAS_TEXT_GLF else FontType := GLCANVAS_TEXT_QUADTEXT;
+ 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.bmp',VINERHAND_WIDTHS);
+ 
+ finalization
+ GLCanvasFonts.Free;

  end.