It is currently Tue Nov 12, 2019 10:06 am

All times are UTC + 1 hour

Post new topic Reply to topic  [ 5 posts ] 
Author Message
 Post subject: NeHe's Bitmap Font Tutorial (Lesson 13)
PostPosted: Tue Jan 09, 2007 9:19 am 

Joined: Fri Mar 05, 2004 2:55 am
Posts: 170
Location: UK
Code updated for 5.20+

This shows how to print bitmap fonts in OpenGL.
I added parameters to the BuildFont procedure:
font name, font height, bold, italic, symbol character set.

Last edited on 20 Feb 2007.

;NeHe's Bitmap Font Tutorial (Lesson 13)
;Credits: Nico Gruener, Dreglor, traumatic
;Author: hagibaba
;Date: 1 Jan 2007
;Note: up-to-date with PB v4.02 (Windows)

;Section for standard constants, structures, macros and declarations

CompilerIf #PB_Compiler_Unicode
  CompilerError "only works in ascii mode" 

XIncludeFile #PB_Compiler_Home+"Examples\Sources - Advanced\OpenGL Cube\OpenGL.pbi" ;include the gl.h constants

;wingdi.h constants
#ANTIALIASED_QUALITY=4 ;for CreateFont_()

;winuser.h constants

Procedure.w LoWord(value.l) ;windef.h macro
 ProcedureReturn (value & $FFFF)

Procedure.w HiWord(value.l) ;windef.h macro
 ProcedureReturn ((value >> 16) & $FFFF)

Import "glu32.lib"
 gluPerspective(fovy.d,aspect.d,zNear.d,zFar.d) ;sets up a perspective projection matrix

Import "opengl32.lib"
 glClearDepth(depth.d) ;specifies the clear value for the depth buffer

;Start of Lesson 13

Global hDC.l ;Private GDI Device Context
Global hRC.l ;Permanent Rendering Context
Global hWnd.l ;Holds Our Window Handle
Global hInstance.l ;Holds The Instance Of The Application

Global Dim keys.b(256) ;Array Used For The Keyboard Routine
Global active.b=#True ;Window Active Flag Set To TRUE By Default
Global fullscreen.b=#True ;Fullscreen Flag Set To Fullscreen Mode By Default

Global base.l ;Base Display List For The Font Set
Global cnt1.f ;1st Counter Used To Move Text & For Coloring
Global cnt2.f ;2nd Counter Used To Move Text & For Coloring

Global swidth.l ;screen width (Note: added code to print window size)
Global sheight.l ;screen height

Declare.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l) ;Declaration For WndProc

Procedure BuildFont(name.s,height.l,bold.l,italic.b,symbol.l) ;Build Our Bitmap Font

 Protected font.l ;Windows Font ID
 Protected oldfont.l ;Used For Good House Keeping
 If bold : bold=#FW_BOLD : Else : bold=#FW_NORMAL : EndIf ;font weight
 If symbol : symbol=#SYMBOL_CHARSET : Else : symbol=#ANSI_CHARSET : EndIf ;character set
 base=glGenLists_(96) ;Storage For 96 Characters
 ;CreateFont_(Height, Width, Angle Of Escapement, Orientation Angle, Weight, Italic, Underline, Strikeout, Character Set, Output Precision, Clipping Precision, Output Quality, Family And Pitch, Name)
 font=CreateFont_(-height,0,0,0,bold,italic,#False,#False,symbol,#OUT_TT_PRECIS,#CLIP_DEFAULT_PRECIS,#ANTIALIASED_QUALITY,#FF_DONTCARE | #DEFAULT_PITCH,name)
 oldfont=SelectObject_(hDC,font) ;Selects The Font We Want
 wglUseFontBitmaps_(hDC,32,96,base) ;Builds 96 Characters Starting At Character 32
 SelectObject_(hDC,oldfont) ;reselect the old font again
 DeleteObject_(font) ;Delete The Font

Procedure KillFont() ;Delete The Font List

 glDeleteLists_(base,96) ;Delete All 96 Characters

Procedure glPrint(text.s) ;Custom GL "Print" Routine

 If text="" ;If There's No Text
  ProcedureReturn #False ;Do Nothing
 glPushAttrib_(#GL_LIST_BIT) ;Pushes The Display List Bits
  glListBase_(base-32) ;Sets The Base Character to 32
  glCallLists_(Len(text),#GL_UNSIGNED_BYTE,text) ;Draws The Display List Text
 glPopAttrib_() ;Pops The Display List Bits

Procedure ReSizeGLScene(width.l,height.l) ;Resize And Initialize The GL Window

 If height=0 : height=1 : EndIf ;Prevent A Divide By Zero Error
 swidth=width ;set screen width and height globals
 glViewport_(0,0,width,height) ;Reset The Current Viewport
 glMatrixMode_(#GL_PROJECTION) ;Select The Projection Matrix
 glLoadIdentity_() ;Reset The Projection Matrix
 gluPerspective(45.0,Abs(width/height),0.1,100.0) ;Calculate The Aspect Ratio Of The Window
 glMatrixMode_(#GL_MODELVIEW) ;Select The Modelview Matrix
 glLoadIdentity_() ;Reset The Modelview Matrix

Procedure.l InitGL() ;All Setup For OpenGL Goes Here

 BuildFont("Courier New",24,1,0,0) ;Build The Font
 glShadeModel_(#GL_SMOOTH) ;Enable Smooth Shading
 glClearColor_(0.0,0.0,0.0,0.5) ;Black Background
 glClearDepth(1.0) ;Depth Buffer Setup
 glEnable_(#GL_DEPTH_TEST) ;Enables Depth Testing
 glDepthFunc_(#GL_LEQUAL) ;The Type Of Depth Testing To Do
 glHint_(#GL_PERSPECTIVE_CORRECTION_HINT,#GL_NICEST) ;Really Nice Perspective Calculations
 ProcedureReturn #True ;Initialization Went OK
Procedure.l DrawGLScene() ;Here's Where We Do All The Drawing

 glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT) ;Clear Screen And Depth Buffer
 glLoadIdentity_() ;Reset The View
 glTranslatef_(0.0,0.0,-1.0) ;Move One Unit Into The Screen
 ;Pulsing Colors Based On Text Position
 ;Position The Text On The Screen
 glPrint("Active OpenGL Text With NeHe - "+StrF(cnt1,2)) ;Print GL Text To The Screen
 glRasterPos2f_(-0.08+0.45*Sin(cnt2),-0.4) ;position text -0.53..0.37 across, 0.4 down
 glPrint(Str(swidth)+"x"+Str(sheight)) ;print window size at the bottom
 cnt1+0.051 ;Increase The 1st Counter
 cnt2+0.005 ;Increase The 2nd Counter
 ProcedureReturn #True ;Keep Going

Procedure KillGLWindow() ;Properly Kill The Window

 If fullscreen ;Are We In Fullscreen Mode?
  ChangeDisplaySettings_(#Null,0) ;If So Switch Back To The Desktop
  ShowCursor_(#True) ;Show Mouse Pointer
 If hRC ;Do We Have A Rendering Context?
  If wglMakeCurrent_(#Null,#Null)=0 ;Are We Able To Release The DC And RC Contexts?
   MessageBox_(#Null,"Release Of DC And RC Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
  If wglDeleteContext_(hRC)=0 ;Are We Able To Delete The RC?
   MessageBox_(#Null,"Release Rendering Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
  hRC=#Null ;Set RC To NULL
 If hDC And ReleaseDC_(hWnd,hDC)=0 ;Are We Able To Release The DC
  MessageBox_(#Null,"Release Device Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
  hDC=#Null ;Set DC To NULL
 If hWnd And DestroyWindow_(hWnd)=0 ;Are We Able To Destroy The Window?
   MessageBox_(#Null,"Could Not Release hWnd.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
   hWnd=#Null ;Set hWnd To NULL
 If UnregisterClass_("OpenGL",hInstance)=0 ;Are We Able To Unregister Class
  MessageBox_(#Null,"Could Not Unregister Class.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
  hInstance=#Null ;Set hInstance To NULL
 KillFont() ;Destroy The Font

;This Code Creates Our OpenGL Window. Parameters Are:
;title - Title To Appear At The Top Of The Window
;width - Width Of The GL Window Or Fullscreen Mode
;height - Height Of The GL Window Or Fullscreen Mode
;bits - Number Of Bits To Use For Color (8/16/24/32)
;fullscreenflag - Use Fullscreen Mode (TRUE) Or Windowed Mode (FALSE)

Procedure.b CreateGLWindow(title.s,width.l,height.l,bits.l,fullscreenflag.b)

 Protected PixelFormat.l ;Holds The Results After Searching For A Match
 Protected wc.WNDCLASS ;Windows Class Structure
 Protected dwExStyle.l ;Window Extended Style
 Protected dwStyle.l ;Window Style
 Protected WindowRect.RECT ;Grabs Rectangle Upper Left / Lower Right Values
 Protected wpos.POINT ;Window position
 WindowRect\left=0 ;Set Left Value To 0
 WindowRect\right=width ;Set Right Value To Requested Width
 WindowRect\top=0 ;Set Top Value To 0
 WindowRect\bottom=height ;Set Bottom Value To Requested Height
 fullscreen=fullscreenflag ;Set The Global Fullscreen Flag
 hInstance=GetModuleHandle_(#Null) ;Grab An Instance For Our Window
 wc\style=#CS_HREDRAW | #CS_VREDRAW | #CS_OWNDC ;Redraw On Size, And Own DC For Window
 wc\lpfnWndProc=@WndProc() ;WndProc Handles Messages
 wc\cbClsExtra=0 ;No Extra Window Data
 wc\cbWndExtra=0 ;No Extra Window Data
 wc\hInstance=hInstance ;Set The Instance
 wc\hIcon=LoadIcon_(#Null,#IDI_WINLOGO) ;Load The Default Icon
 wc\hCursor=LoadCursor_(#Null,#IDC_ARROW) ;Load The Arrow Pointer
 wc\hbrBackground=#Null ;No Background Required For GL
 wc\lpszMenuName=#Null ;We Don't Want A Menu
 wc\lpszClassName=@"OpenGL" ;Set The Class Name
 If RegisterClass_(wc)=0 ;Attempt To Register The Window Class
  MessageBox_(#Null,"Failed To Register The Window Class.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 If fullscreen ;Attempt Fullscreen Mode?
  Protected dmScreenSettings.DEVMODE ;Device Mode
  dmScreenSettings\dmSize=SizeOf(DEVMODE) ;Size Of The Devmode Structure
  dmScreenSettings\dmFields=#DM_BITSPERPEL | #DM_PELSWIDTH | #DM_PELSHEIGHT ;bit flags to specify the members of DEVMODE that were initialized
  dmScreenSettings\dmBitsPerPel=bits ;Selected Bits Per Pixel
  dmScreenSettings\dmPelsWidth=width ;Selected Screen Width in pixels
  dmScreenSettings\dmPelsHeight=height ;Selected Screen Height in pixels
  ;Try To Set Selected Mode And Get Results. Note: CDS_FULLSCREEN Gets Rid Of Start Bar
  If ChangeDisplaySettings_(dmScreenSettings,#CDS_FULLSCREEN)<>#DISP_CHANGE_SUCCESSFUL
   ;If The Mode Fails, Offer Two Options. Quit Or Use Windowed Mode
   If MessageBox_(#Null,"The Requested Fullscreen Mode Is Not Supported By"+Chr(10)+"Your Video Card. Use Windowed Mode Instead?","NeHe GL",#MB_YESNO | #MB_ICONEXCLAMATION)=#IDYES
    fullscreen=#False ;Windowed Mode Selected.  Fullscreen = FALSE
    ;Pop Up A Message Box Letting User Know The Program Is Closing
    MessageBox_(#Null,"Program Will Now Close.","ERROR",#MB_OK | #MB_ICONSTOP)
    ProcedureReturn #False
 If fullscreen ;Are We Still In Fullscreen Mode?
  dwExStyle=#WS_EX_APPWINDOW ;Window Extended Style
  dwStyle=#WS_POPUP ;Windows Style
  ShowCursor_(#False) ;Hide Mouse Pointer
  dwExStyle=#WS_EX_APPWINDOW | #WS_EX_WINDOWEDGE ;Window Extended Style
  dwStyle=#WS_OVERLAPPEDWINDOW ;Windows Style
 AdjustWindowRectEx_(WindowRect,dwStyle,#False,dwExStyle) ;Adjust Window To True Requested Size
 If fullscreen=0 ;if not fullscreen mode calculate screen centered window
 ;CreateWindowEx_(Extended Window Style, Class Name, Window Title, Window Style, Window X Position, Window Y Position, Width, Height, No Parent Window, No Menu, Instance, No Creation Data)
 hWnd=CreateWindowEx_(dwExStyle,"OpenGL",title,dwStyle | #WS_CLIPSIBLINGS | #WS_CLIPCHILDREN,wpos\x,wpos\y,WindowRect\right-WindowRect\left,WindowRect\bottom-WindowRect\top,#Null,#Null,hInstance,#Null)
 If hWnd=0
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Window Creation Error.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 Protected pfd.PIXELFORMATDESCRIPTOR ;pfd Tells Windows How We Want Things To Be
 pfd\nSize=SizeOf(PIXELFORMATDESCRIPTOR) ;Size Of This Structure
 pfd\nVersion=1 ;Version Number
 pfd\dwFlags=#PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER | #PFD_DRAW_TO_WINDOW ;Format Must Support Window, OpenGL, Double Buffering
 pfd\iPixelType=#PFD_TYPE_RGBA ;Request An RGBA Format
 pfd\cColorBits=bits ;Select Our Color Depth
 pfd\cRedBits=0 ;Color Bits Ignored
 pfd\cAlphaBits=0 ;No Alpha Buffer
 pfd\cAlphaShift=0 ;Shift Bit Ignored
 pfd\cAccumBits=0 ;No Accumulation Buffer
 pfd\cAccumRedBits=0 ;Accumulation Bits Ignored
 pfd\cDepthBits=16 ;16Bit Z-Buffer (Depth Buffer)
 pfd\cStencilBits=0 ;No Stencil Buffer
 pfd\cAuxBuffers=0 ;No Auxiliary Buffer
 pfd\iLayerType=#PFD_MAIN_PLANE ;Main Drawing Layer
 pfd\bReserved=0 ;Reserved
 pfd\dwLayerMask=0 ;Layer Masks Ignored
 If hDC=0 ;Did We Get A Device Context?
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Can't Create A GL Device Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 If PixelFormat=0 ;Did Windows Find A Matching Pixel Format?
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Can't Find A Suitable PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 If SetPixelFormat_(hDC,PixelFormat,pfd)=0 ;Are We Able To Set The Pixel Format?
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Can't Set The PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 If hRC=0 ;Are We Able To Get A Rendering Context?
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Can't Create A GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 If wglMakeCurrent_(hDC,hRC)=0 ;Try To Activate The Rendering Context
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Can't Activate The GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 ShowWindow_(hWnd,#SW_SHOW) ;Show The Window
 SetForegroundWindow_(hWnd) ;Slightly Higher Priority
 SetFocus_(hWnd) ;Sets Keyboard Focus To The Window
 ReSizeGLScene(width,height) ;Set Up Our Perspective GL Screen
 If InitGL()=0 ;Initialize Our Newly Created GL Window
  KillGLWindow() ;Reset The Display
  MessageBox_(#Null,"Initialization Failed.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
  ProcedureReturn #False
 ProcedureReturn #True ;Success

Procedure.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l)

 Select uMsg ;Check For Windows Messages
  Case #WM_ACTIVATE ;Watch For Window Activate Message
   If HiWord(wParam)=0 ;Check Minimization State
    active=#True ;Program Is Active
    active=#False ;Program Is No Longer Active
   ProcedureReturn 0 ;Return To The Message Loop
  Case #WM_SYSCOMMAND ;Intercept System Commands
   Select wParam ;Check System Calls
    Case #SC_SCREENSAVE ;Screensaver Trying To Start?
     ProcedureReturn 0 ;Prevent From Happening
    Case #SC_MONITORPOWER ;Monitor Trying To Enter Powersave?
     ProcedureReturn 0 ;Prevent From Happening
  Case #WM_CLOSE ;Did We Receive A Close Message?
   PostQuitMessage_(0) ;Send A Quit Message
   ProcedureReturn 0 ;Jump Back
  Case #WM_KEYDOWN ;Is A Key Being Held Down?
   keys(wParam)=#True ;If So, Mark It As TRUE
   ProcedureReturn 0 ;Jump Back
  Case #WM_KEYUP ;Has A Key Been Released?
   keys(wParam)=#False ;If So, Mark It As FALSE
   ProcedureReturn 0 ;Jump Back
  Case #WM_SIZE ;Resize The OpenGL Window
   ReSizeGLScene(LoWord(lParam),HiWord(lParam)) ;LoWord=Width, HiWord=Height
   ProcedureReturn 0 ;Jump Back
 ;Pass All Unhandled Messages To DefWindowProc
 ProcedureReturn DefWindowProc_(hWnd,uMsg,wParam,lParam)

Procedure.l WinMain() ;Main Program

 Protected msg.MSG ;Windows Message Structure
 Protected done.b ;Bool Variable To Exit Loop
 ;Ask The User Which Screen Mode They Prefer
 If MessageBox_(#Null,"Would You Like To Run In Fullscreen Mode?","Start FullScreen?",#MB_YESNO | #MB_ICONQUESTION)=#IDNO
  fullscreen=#False ;Windowed Mode
 If CreateGLWindow("Nehe's Bitmap Font Tutorial",640,480,16,fullscreen)=0 ;Create The Window
  ProcedureReturn 0 ;Quit If Window Was Not Created
 While done=#False ;Loop That Runs While done=FALSE
  If PeekMessage_(msg,#Null,0,0,#PM_REMOVE) ;Is There A Message Waiting?
   If msg\message=#WM_QUIT ;Have We Received A Quit Message?
    done=#True ;If So done=TRUE
   Else ;If Not, Deal With Window Messages
    TranslateMessage_(msg) ;Translate The Message
    DispatchMessage_(msg) ;Dispatch The Message
  Else ;If There Are No Messages
   ;Draw The Scene. Watch For ESC Key And Quit Messages From DrawGLScene()
   If (active And DrawGLScene()=0) Or keys(#VK_ESCAPE) ;Active? Was There A Quit Received?
    done=#True ;ESC or DrawGLScene Signalled A Quit
  Else ;Not Time To Quit, Update Screen
    SwapBuffers_(hDC) ;Swap Buffers (Double Buffering)
   If keys(#VK_F1) ;Is F1 Being Pressed?   
    keys(#VK_F1)=#False ;If So Make Key FALSE
    KillGLWindow() ;Kill Our Current Window
    fullscreen=~fullscreen & 1 ;Toggle Fullscreen / Windowed Mode
    ;Recreate Our OpenGL Window
    If CreateGLWindow("NeHe's Bitmap Font Tutorial",640,480,16,fullscreen)=0
     ProcedureReturn 0 ;Quit If Window Was Not Created
 KillGLWindow() ;Kill The Window
 End ;Exit The Program

WinMain() ;run the main program

Last edited by hagibaba on Sun Jul 01, 2007 11:13 pm, edited 13 times in total.

Reply with quote  
 Post subject:
PostPosted: Tue Jan 09, 2007 9:25 am 
User avatar

Joined: Wed Dec 22, 2004 4:12 pm
Posts: 2447
Location: Norway
It's very nice of you to share these! :wink:

I like logic, hence I dislike humans but love computers.

Reply with quote  
 Post subject:
PostPosted: Tue Jan 09, 2007 9:37 am 

Joined: Fri Mar 05, 2004 2:55 am
Posts: 170
Location: UK
Thanks, most of the credit is to NeHe and friends of course. It usually only takes me a few hours to translate them. Not sharing them would be odd.

Reply with quote  
 Post subject:
PostPosted: Tue Jan 09, 2007 10:32 am 
User avatar

Joined: Fri Apr 25, 2003 7:44 pm
Posts: 465
Location: end of www
Thanks a lot for sharing. I really appreciate that !!!

pe0ple ar3 str4nge!!!

Reply with quote  
 Post subject:
PostPosted: Thu Jan 11, 2007 1:25 am 

Joined: Fri Mar 05, 2004 2:55 am
Posts: 170
Location: UK
Thanks benny!

I have just updated this one. Still looks exactly the same, but now the underline parameter for BuildFont is changed to symbol. So you can load "wingdings" font now. I thought it was better than having the underline option. :)

Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 5 posts ] 

All times are UTC + 1 hour

Who is online

Users browsing this forum: No registered users and 19 guests

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye