From: Michael H. <mh...@us...> - 2000-11-20 21:03:39
|
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. |