Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

GLUT-Bitmapfont

Uploader:MitgliedElor
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 ()