fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
GLUT-Bitmapfont

Uploader:	Elor
Datum/Zeit:	30.01.2016 11:44:40
/' program: bitmapfonts.bas '/

#lang "fb"



#include "GL/freeglut.bi"

Dim Shared _

  OldTime As Integer, _

  FPSTime As Integer, _

  FPSCount As Integer



Function GetTotalTime () As Single

  Function= glutGet (GLUT_ELAPSED_TIME)/ 1000

End Function



Function GetDeltaTime () As Single

Dim NewTime As Integer



  NewTime= glutGet (GLUT_ELAPSED_TIME)

  Function= (NewTime- OldTime)/ 1000

  OldTime= NewTime

End Function



Sub FrameRendered (ByVal Count As Integer= 1)

  FPSCount= FPSCount+ Count

End Sub



Function GetFPS () As Single

Dim NewTime As Integer



  NewTime= glutGet (GLUT_ELAPSED_TIME)

  Function= FPSCount/ ((NewTime- FPSTime)/ 1000)



  FPSTIME= NewTime

  FPSCount= 0

End Function



'' -------------------------------------------------------------------

Function glGetViewPortWidth () As Integer

Dim Rect(0 To 3) As GLInt



  glGetIntegerv (GL_VIEWPORT, @Rect(0))

  Function= Rect(2)- Rect(0)

End Function



Function glGetViewPortHeight () As Integer

Dim Rect(0 To 3) As GLInt



  glGetIntegerv (GL_VIEWPORT, @Rect(0))

  Function= Rect(3)- Rect(1)

End Function



Sub glEnter2D ()

  glMatrixMode (GL_PROJECTION)

  glPushMatrix ()

  glLoadIdentity ()

  gluOrtho2D (0, glGetViewPortWidth (), 0, glGetViewPortHeight ())



  glMatrixMode (GL_MODELVIEW)

  glPushMatrix ()

  glLoadIdentity ()



  glDisable (GL_DEPTH_TEST)

End Sub



Sub glLeave2D ()

  glMatrixMode (GL_PROJECTION)

  glPopMatrix ()

  glMatrixMode (GL_MODELVIEW)

  glPopMatrix ()



  glEnable (GL_DEPTH_TEST)

End Sub



Sub glWrite (ByVal X As GLfloat, ByVal Y As GLfloat, _

             ByVal Font As Any Ptr, ByVal Text As String)

  glRasterPos2f (X, Y)



  For I As Integer= 1 To Len (Text)

    glutBitmapCharacter (Font, CLng (Text[I- 1]))

  Next I



End Sub



Const _

  AppWidth = 640, _

  AppHeight = 480, _

  LazText = "Lazarus Project :: Write once compile everywhere!"



Dim Shared FPS As Single = 0



Sub InitializeGL ()

  glClearColor (0.18, 0.20, 0.66, 0)

  glEnable (GL_DEPTH_TEST)

End Sub



Sub DrawGLScene cDecl ()

  glClear (GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT)



  glLoadIdentity ()

  glTranslatef (0, 0, -5)

  glRotatef (GetTotalTime ()* 10, 0, 0.5, 0.5)



  glColor3f (1, 0, 0)

  glutSolidCube (2)



  glEnter2D ()



  glColor3f (0.2, 0.8 + 0.2* Sin (GetTotalTime ()* 5), 0)

  glWrite (20, glGetViewportHeight ()- 20, GLUT_BITMAP_8_BY_13, "OpenGL Tutorial :: Bitmap Fonts :: "+ Str (CLng (FPS))+ " FPS")



  glColor3f (1, 1, 1)

  glWrite (50, glGetViewportHeight ()- 60, GLUT_BITMAP_9_BY_15, "GLUT_BITMAP_9_BY_15")

  glWrite (50, glGetViewportHeight ()- 90, GLUT_BITMAP_8_BY_13, "GLUT_BITMAP_8_BY_13")

  glWrite (50, glGetViewportHeight ()- 120, GLUT_BITMAP_TIMES_ROMAN_10, "GLUT_BITMAP_TIMES_ROMAN_10")

  glWrite (50, glGetViewportHeight ()- 150, GLUT_BITMAP_TIMES_ROMAN_24, "GLUT_BITMAP_TIMES_ROMAN_24")

  glWrite (50, glGetViewportHeight ()- 180, GLUT_BITMAP_HELVETICA_10, "GLUT_BITMAP_HELVETICA_10")

  glWrite (50, glGetViewportHeight ()- 210, GLUT_BITMAP_HELVETICA_12, "GLUT_BITMAP_HELVETICA_12")

  glWrite (50, glGetViewportHeight ()- 240, GLUT_BITMAP_HELVETICA_18, "GLUT_BITMAP_HELVETICA_18")



  glColor3f (0.5, 0.5, 1)

  glWrite (glGetViewportWidth ()- glutBitmapLength (GLUT_BITMAP_9_BY_15, @LazText)- 5, _

    10, GLUT_BITMAP_9_BY_15, LazText)



  glLeave2D ()



  glutSwapBuffers ()



  FrameRendered ()

End Sub



Sub ReSizeGLScene cDecl (ByVal Wwidth As Long, ByVal Wheight As Long)

  If(Wheight = 0) Then Wheight= 1



  glViewport (0, 0, Wwidth, Wheight)

  glMatrixMode (GL_PROJECTION)

  glLoadIdentity ()

  gluPerspective (45, Wwidth/ Wheight, 0.1, 1000)



  glMatrixMode (GL_MODELVIEW)

  glLoadIdentity ()

End Sub



Sub GLKeyboard cDecl (ByVal Key As uByte, ByVal X As Long, ByVal Y As Long)

  If(Key = 27) Then

    End (0)

  End If

End Sub



Sub GLFPSTimer cDecl (ByVal Value As Long)

  FPS= GetFPS

  glutTimerFunc (1000, @GLFPSTimer, 0)

End Sub



Sub glutInitBASIC (ByVal ParseCmdLine As Boolean)

Dim CmdCount As Long= 0

Dim Cmd(0) As ZString Ptr



  If ParseCmdLine Then

    While(Command(CmdCount) <> "")

      CmdCount= CmdCount+ 1

    Wend

    CmdCount= CmdCount- 1

  End If



  If(CmdCount > 0) Then

    For I As Integer= 0 To CmdCount

      Cmd(I)= Callocate (Len (Command (I))+ 1)

      *Cmd(I)= Command (I)

    Next I

  Else

    Cmd(0) =Callocate (1)

  End If



  glutInit (@CmdCount, @Cmd(0))

End Sub



Dim As Integer ScreenWidth, ScreenHeight



  glutInitBASIC (True)

  glutInitDisplayMode (GLUT_DOUBLE Or GLUT_RGB Or GLUT_DEPTH)

  glutInitWindowSize (AppWidth, AppHeight)

  ScreenWidth= glutGet (GLUT_SCREEN_WIDTH)

  ScreenHeight= glutGet (GLUT_SCREEN_HEIGHT)

  glutInitWindowPosition ((ScreenWidth- AppWidth)\ 2, _

                          (ScreenHeight- AppHeight)\ 2)

  glutCreateWindow ("OpenGL Tutorial :: Bitmap Fonts")



  InitializeGL ()



  glutDisplayFunc (@DrawGLScene)

  glutReshapeFunc (@ReSizeGLScene)

  glutKeyboardFunc (@GLKeyboard)

  glutIdleFunc (@DrawGLScene)

  glutTimerFunc (1000, @GLFPSTimer, 0)



  glutMainLoop ()