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!

Code-Beispiel

Code-Beispiele » Grafik und Fonts

OpenGL/GLSL Radial Blur

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Mitgliedschildron 10.02.2011

Im folgenden Beispiel möchte ich zeigen, wie man einen Radial Blur Effekt erstellen kann. Dazu verwenden wir die OpenGL Shading Language. Sie ermöglicht uns, auf der Grafikkarte spezielle Grafikeffekte darzustellen.

Benötigt wird eine OpenGL 2.0 taugliche Grafikkarte. Wenn das folgende Programm nicht funktioniert, hilft möglicherweise ein Update des Grafiktreibers.

Das Demoprogramm besteht aus 3 Teilen:

Die unten folgende Textur heißt "Ziegelwand.png" und kann für ein richtiges Spiel durch eine Textur, die das Spielgeschehen abbildet, ersetzt werden (Stichwort: Render to Texture).

Ziegelwand
Vergrößern
Ziegelwand

Als erstes der Code der Hauptdatei:

'-----------------------------------------------------
'2011 by Schildron
'-----------------------------------------------------
'Ein großer Dank gilt:
' * http://wiki.delphigl.com/ für viel Hintergrundwissen und dem Aufbau des Radial Blur Shaders
' * http://www.freebasic.net/forum/ für Informationen, wie man GLSL mit FreeBASIC nutzt
'-----------------------------------------------------
Dim Shared As Integer Breite, Hohe
Dim As String Tastendruck

Breite = 800
Hohe = 600

#Include "fbgfx.bi"
#Include "fbpng.bi"
#Include Once "GL/gl.bi"
#Include Once "GL/glu.bi"
#Include "\gl\glext.bi"
'-------------------------
'Declarationen
'-------------------------
Declare Sub ScreenTexture()
Declare Function Init_Shader( File_Name As String, Shader_Type As Integer )As GlHandleARB
Declare Sub Gather_Extensions()

'shaders
Common Shared _shader100_                      As Integer
Common Shared glCreateShaderObjectARB          As PFNglCreateShaderObjectARBPROC
Common Shared glShaderSourceARB                As PFNglShaderSourceARBPROC
Common Shared glGetShaderSourceARB             As PFNglGetShaderSourceARBPROC
Common Shared glCompileShaderARB               As PFNglCompileShaderARBPROC
Common Shared glDeleteObjectARB                As PFNglDeleteObjectARBPROC
Common Shared glCreateProgramObjectARB         As PFNglCreateProgramObjectARBPROC
Common Shared glAttachObjectARB                As PFNglAttachObjectARBPROC
Common Shared glUseProgramObjectARB            As PFNglUseProgramObjectARBPROC
Common Shared glLinkProgramARB                 As PFNglLinkProgramARBPROC
Common Shared glValidateProgramARB             As PFNglValidateProgramARBPROC
Common Shared glGetObjectParameterivARB        As PFNglGetObjectParameterivARBPROC
Common Shared glGetInfoLogARB                  As PFNglGetInfoLogARBPROC
Common Shared glGetUniformLocationARB          As PFNglGetUniformLocationARBPROC
Common Shared glUniform1iARB                   As PFNglUniform1iARBPROC
Common Shared glUniform2ivARB                  As PFNglUniform2ivARBPROC
Common Shared glUniform1fARB                   As PFNglUniform1fARBPROC
Common Shared glUniform2fvARB                  As PFNglUniform2fvARBPROC
Common Shared glUniform3fvARB                  As PFNglUniform3fvARBPROC
'-------------------------
' das Fenster öffnen
'-------------------------
Screen 19, 32, , 2

Dim As GlHandleARB Vertex_Shader, Shader_Program
Dim As Gluint Shader_Compile_Success
Dim As GlHandleARB Fragment_Shader
Dim As GlInt TimerLoc
Dim As Integer use_shader = -1

Dim Shared As Single BlurPower = 0.08, BlurFactor = 12  ''Hier die wichtigsten Parameter für Blur einstellen
Dim As GlInt BlurPowerLoc, BlurFactorLoc, DisplayHoheLoc, DisplayBreiteLoc

Dim Shared As Integer errlog
errlog = FreeFile
'-------------------------
' Open-GL Init
'-------------------------
glViewport 0, 0, Breite, Hohe                  ' den Current Viewport auf eine Ausgangsposition setzen
glMatrixMode GL_PROJECTION                     ' Den Matrix-Modus Projection wählen
glLoadIdentity                                 ' Diesen Modus auf Anfangswerte setzen
gluPerspective 45.0, Breite/Hohe, 0.1, 100.0   ' Grundeinstellungen des Anezeigefensters festlegen
glMatrixMode GL_MODELVIEW                      ' Auf den Matrix-Modus Modelview schalten
glLoadIdentity                                 ' und auch diesen auf Anfangswerte setzen
glClearColor(0.9,0.9,0.9,0.0)                  ' Setze Farbe für löschen auf Mittelgrau
glClearDepth 1.0                               ' Depth-Buffer Löschen erlauben
glEnable GL_DEPTH_TEST                         ' den Tiefentest GL_DEPTH_TEST einschalten
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT  'Tiefen- und Farbpufferbits löschen

'---------------------------
'HAUPTTEIL
'---------------------------
Dim Shared As Integer Ptr LoadRenderTextur
LoadRenderTextur = ImageCreate(Breite, Hohe, 0, 32)

Dim Shared As UInteger RenderTextur
glGenTextures 1, @RenderTextur
glBindTexture GL_TEXTURE_2D, RenderTextur
glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, Breite, Hohe, 0, GL_RGBA, GL_UNSIGNED_BYTE, LoadRenderTextur'+Len(FB.IMAGE)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR

Dim Shared As UInteger BackgroundTextur
glGenTextures 1, @BackgroundTextur
glBindTexture GL_TEXTURE_2D, BackgroundTextur
glTexImage2D GL_TEXTURE_2D, 0, GL_RGB, 800, 600, 0, GL_RGBA, GL_UNSIGNED_BYTE, png_load("Ziegelwand.png",PNG_TARGET_OPENGL)'+Len(FB.IMAGE)
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR
glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR

Open Cons For Output As #errlog

Gather_Extensions()

If _shader100_ <> 0 Then

    Fragment_Shader = Init_Shader( "Shaders/RadialBlur.shader", GL_FRAGMENT_SHADER_ARB )
    Shader_Program = GlCreateProgramObjectARB()
    glAttachObjectARB( Shader_Program, Fragment_Shader )
    glLinkProgramARB( Shader_Program )

    GlValidateProgramARB( Shader_Program )
    glGetObjectParameterivARB( Shader_Program, GL_OBJECT_VALIDATE_STATUS_ARB, @Shader_Compile_Success )

    If Shader_Compile_Success = 0 Then
        Print #errlog, "Fehler beim GLSL kompilieren!"
        Sleep 1000, 1
        Close #errlog
        ImageDestroy LoadRenderTextur
        End
    End If

    'This gets the memory location of variable("name"), so that we can send data to the gpu at the correct address.
    BlurPowerLoc  = glGetUniformLocationARB( Shader_Program, StrPtr("BlurPower") )
    BlurFactorLoc  = glGetUniformLocationARB( Shader_Program, StrPtr("BlurFactor") )
    DisplayBreiteLoc  = glGetUniformLocationARB( Shader_Program, StrPtr("Breite") )
    DisplayHoheLoc  = glGetUniformLocationARB( Shader_Program, StrPtr("Hohe") )

    Print #errlog, "Variablen wurden dem Shader uebergeben!"
Else
    Print #errlog, "OpenGL Shader Language wird von Ihrer Grafikkarte nicht unterstutzt!"
    Print #errlog, "Diese Demo wird nicht funktionieren wie erwartet!"
End If

'-------------------------
'in den GlOrtho Modus schalten
'-------------------------
glMatrixMode(GL_PROJECTION)
glLoadIdentity()
glOrtho(0, breite, 0, hohe, -256, 256)

Do Until Tastendruck = Chr(27)
    '---------------------------
    'ProgrammSchleife
    '---------------------------

    glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT

    Tastendruck = Inkey

    glPushMatrix

    ScreenTexture()

    If _shader100_ Then
        If use_shader Then
            glUseProgramObjectARB( Shader_Program )
            'Dem Shader die externen Variablen einpflanzen
            glUniform1fARB( BlurPowerLoc, BlurPower )
            glUniform1fARB( BlurFactorLoc, BlurFactor )
            glUniform1iARB( DisplayBreiteLoc, Breite )
            glUniform1iARB( DisplayHoheLoc, Hohe )
        Else
            glUseProgramObjectARB( 0 )
        End If
    End If

    glPopMatrix

    GlFlush
    Flip
    '---------------------------
    'Ende der Schleife
    '---------------------------
Loop

ImageDestroy LoadRenderTextur

End

Sub ScreenTexture()
    '---------------------------
    'Eine Textur auf das Gesamte Fenster legen
    '---------------------------
    glEnable GL_TEXTURE_2D
    glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
    glBindTexture GL_TEXTURE_2D, BackgroundTextur

    glBegin GL_QUADS
    glTexCoord2d 0,1 : glVertex3f  0,      hohe, -6.0
    glTexCoord2d 1,1 : glVertex3f  breite, hohe, -6.0
    glTexCoord2d 1,0 : glVertex3f  breite, 0,    -6.0
    glTexCoord2d 0,0 : glVertex3f  0,      0,    -6.0
    glEnd

    glDisable GL_TEXTURE_2D

End Sub

Function Init_Shader( File_Name As String, Shader_Type As Integer )As GlHandleARB
    '---------------------------
    'Den Shader-Programmcode aus der externen Datei laden
    '---------------------------
    Dim As Integer i
    Dim As Integer Line_Cnt
    Dim As String Shader_Text, tString
    Dim As Gluint Shader_Compile_Success
    Dim As GlHandleARB Shader
    Dim As UInteger FileNum = FreeFile

    Open File_Name For Binary As #FileNum
    Do While Not EOF(FileNum)
        Line Input #FileNum, tString
        Shader_Text += tString + Chr( 13, 10 )
    Loop
    Close #FileNum

    Dim As GLcharARB Ptr table(0) => { StrPtr( Shader_Text ) }
    Shader = glCreateShaderObjectARB( Shader_Type )
    glShaderSourceARB( Shader, 1, @table(0), 0 )
    glCompileShaderARB( Shader )

    glGetObjectParameterivARB( Shader, GL_OBJECT_COMPILE_STATUS_ARB, @Shader_Compile_Success )
    If Shader_Compile_Success = 0 Then
        Dim As Gluint infologsize
        glGetObjectParameterivARB( Shader, GL_OBJECT_INFO_LOG_LENGTH_ARB, @infoLogSize)
        Dim As GlByte infolog(InfoLogSize)
        glGetInfoLogARB( Shader, InfoLogSize, 0, @infoLog(0))
        tString=""
        For i = 0 To InfoLogSize-1
            tString+=Chr(InfoLog(i))
        Next
        Print #errlog, "Shader Fehlermeldungen:"
        Print #errlog, tString
        Return 0
    Else
        Return Shader
    End If
End Function


Sub Gather_Extensions()

    Dim extensions As String
    ScreenControl FB.GET_GL_EXTENSIONS, extensions

    If (InStr(extensions, "GL_ARB_shading_language_100") <> 0) Then
        Print #errlog, "GL_ARB_shading_language_100 wird unterstutzt!"
        _shader100_ = 1
        glCreateShaderObjectARB     = ScreenGLProc("glCreateShaderObjectARB")
        glShaderSourceARB           = ScreenGLProc("glShaderSourceARB")
        glGetShaderSourceARB        = ScreenGLProc("glGetShaderSourceARB")
        glCompileShaderARB          = ScreenGLProc("glCompileShaderARB")
        glDeleteObjectARB           = ScreenGLProc("glDeleteObjectARB")
        glCreateProgramObjectARB    = ScreenGLProc("glCreateProgramObjectARB")
        glAttachObjectARB           = ScreenGLProc("glAttachObjectARB")
        glUseProgramObjectARB       = ScreenGLProc("glUseProgramObjectARB")
        glLinkProgramARB            = ScreenGLProc("glLinkProgramARB")
        glValidateProgramARB        = ScreenGLProc("glValidateProgramARB")
        glGetInfoLogARB             = ScreenGLProc("glGetInfoLogARB")
        glGetObjectParameterivARB   = ScreenGLProc("glGetObjectParameterivARB")
        glGetUniformLocationARB     = ScreenGLProc("glGetUniformLocationARB")
        glUniform1iARB              = ScreenGLProc("glUniform1iARB")
        glUniform2ivARB             = ScreenGLProc("glUniform2ivARB")
        glUniform1fARB              = ScreenGLProc("glUniform1fARB")
        glUniform2fvARB             = ScreenGLProc("glUniform2fvARB")
        glUniform3fvARB             = ScreenGLProc("glUniform3fvARB")
    Else
        Print #errlog, "GL_ARB_shading_language_100 wird NICHT unterstutzt!"
    End If

    Print #errlog, " "
End Sub

Der nächste Codeteil ist für den eigentlichen Shader zuständig. Er muss im Unterordner shaders mit dem Namen "RadialBlur.shader" abgespeichert werden:

// RadialBlur - Shader

uniform float BlurPower;
uniform float BlurFactor;

uniform int Breite;
uniform int Hohe;

uniform sampler2D BackgroundTextur;   // scene texture
vec2 radial_size = vec2(1/Breite,1/Hohe);    // texel size
 
float radial_blur = BlurPower;   // blur factor
uniform float radial_bright = 1; // bright factor
 
uniform vec2 radial_origin = vec2(0.5,0.5);  // blur origin

void main(void)
{
  vec2 TexCoord = vec2(gl_TexCoord[0]);
 
  vec4 SumColor = vec4(0.0, 0.0, 0.0, 0.0);
  TexCoord += radial_size * 0.5 - radial_origin;
 
  for (int i = 0; i < BlurFactor; i++)
  {
    float scale = 1.0 - radial_blur * (float(i) / (BlurFactor - 1));
    SumColor += texture2D(BackgroundTextur, TexCoord * scale + radial_origin);
  }
 
  gl_FragColor = SumColor / (BlurFactor - 1) * radial_bright;
}

Wenn alles richtig funktioniert, sollte die Ziegelwand von der Mitte aus nach außen verwischt werden.


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 08.02.2011 von Mitgliedschildron angelegt.
  • Die aktuellste Version wurde am 10.02.2011 von AdministratorSebastian gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen