PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

GLip - OpenGL Image Render

https://www.purebasic.fr/english/viewtopic.php?t=82997

Page 1 of 1

GLip - OpenGL Image Render

Posted: Sat Dec 02, 2023 9:58 pm
by pjay
GLip is a small module that can assist with displaying PB images (much like the ImageGadget) but is faster in situations where you need to scale the image. i.e. to compensate for DPI awareness or show fullscreen.

Code: Select all

; Purebasic module: GLip v1.01 (Simplification extract of GLipX module) - Phil James 2023.  Tested on Windows 11 x64 only.
; Filename: GLip module.pbi

; Purpose: Enhance performance of displaying a PB image when needing to scale for Gadget size, DPI awareness or full-screen rendering.
;        - Fast alternative to Imagegadget.

; Basic usage:
;    GLIP::Set(#GL_GadgetID, #PB_Image [, Optional: FillMode, Scalemode, BackgroundColour])
;      RGBA value of background - Default: RGBA(0,0,0,255)
;      ScaleMode: #PB_Image_Raw or #PB_Image_Smooth (default)
;      FillMode: see #Glip_Fillmode enumerates - defaults to #Glip_FillMode_Stretch.

; Supplemental:
;   GLIP::Set_Array(#GL_GadgetID, *Array_Ptr, w, h, bpp [, Optional: Scalemode, BackgroundColour, FillMode])
;     draws directly from an array

; Update v1.01 - reduced arguments & brought forward FillMode argument

DeclareModule GLIP
  Enumeration Glip_Fillmode
    #Glip_FillMode_Centre ; centres the image, will crop or create borders if image dimensions != gadget dimensions.
    #Glip_FillMode_Fill   ; Shrinks or enlarges image to fit on shortest edge, crops if image dimensions != gadget dimensions.
    #Glip_FillMode_Fit    ; Shrinks or enlarges image to fit on longest edge, creates border if image dimensions != gadget dimensions.
    #Glip_FillMode_Stretch; Shrinks or enlarges image to fit gadget dimensions, loses aspect ratio if image dimensions != gadget dimensions.
  EndEnumeration
  
  Declare Set(Gadget.i, Image.i, FillMode = #Glip_FillMode_Stretch, ScaleMode = #PB_Image_Smooth, BGCol = -16777216) ;/ set a PB image to a gl gadget
  Declare Set_Array(Gadget.i, *Im, w, h, bpp, FillMode = #Glip_FillMode_Stretch, ScaleMode = #PB_Image_Smooth, BGCol = -16777216) ;/ sets an image array to a gl Gadget
  Macro gImageGadget(Gad,x,y,w,h,img)
    OpenGLGadget(Gad,x,y,w,h,#PB_OpenGL_Keyboard|#PB_OpenGL_NoAccumulationBuffer|#PB_OpenGL_NoDepthBuffer|#PB_OpenGL_NoStencilBuffer|#PB_OpenGL_NoFlipSynchronization)
    GLIP::Set(Gad,Img)
  EndMacro
EndDeclareModule
Module GLIP
  Procedure _Common_Init(ScaleMode.i)
    Protected TextureID0.i
    glEnable_(#GL_TEXTURE_2D)
    glGenTextures_(1, @TextureID0);
    glBindTexture_(#GL_TEXTURE_2D, TextureID0);
    If ScaleMode = #PB_Image_Raw
      glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_NEAREST) : glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_NEAREST); 
    Else
      glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR) : glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR); 
    EndIf
    ProcedureReturn TextureID0
  EndProcedure
  Procedure _Common_Render(Gadget, TextureID0, W, H, FillMode, BGCol, FlipY = #True)
    Structure Pointf : x.f : y.f : EndStructure
    Static Dim Vc.Pointf(3) : Static Dim Tc.Pointf(3) : Protected AdjX.f, AdjY.f, MyLoop
    
    VC(0)\x = -W/2 : VC(0)\y = -H/2 : VC(1)\x = W/2 : VC(1)\y = -H/2 : VC(2)\x = W/2 : VC(2)\y = H/2 : VC(3)\x = -W/2 : VC(3)\y = H/2
    If FlipY = #True
      TC(0)\x = 0 : TC(0)\y = 1 : TC(1)\x = 1 : TC(1)\y = 1 : TC(2)\x = 1 : TC(2)\y = 0 : TC(3)\x = 0 : TC(3)\y = 0      
    Else
      TC(0)\x = 0 : TC(0)\y = 0 : TC(1)\x = 1 : TC(1)\y = 0 : TC(2)\x = 1 : TC(2)\y = 1 : TC(3)\x = 0 : TC(3)\y = 1      
    EndIf
    
    glClearColor_(Red(BGCol)/255.0,Green(BGCol)/255.0,Blue(BGCol)/255.0,Alpha(BGCol)/255.0)
    glClear_(#GL_COLOR_BUFFER_BIT)
    glDisable_(#GL_DEPTH_TEST) : glEnable_(#GL_CULL_FACE) : glCullFace_(#GL_FRONT)    
    
    AdjX = W / GadgetWidth(Gadget) : AdjY = H / GadgetHeight(Gadget) ; centered
    Select FillMode
      Case #Glip_FillMode_Centre ; centres image to gadget, value set as default
      Case #Glip_FillMode_Fill   ; 1 axis cropped if AR different than gadgets
        If GadgetWidth(Gadget) / W > GadgetHeight(Gadget) / H
          AdjX * (GadgetWidth(Gadget) / W) : AdjY * (GadgetWidth(Gadget) / W)
        Else
          AdjX * (GadgetHeight(Gadget) / H) : AdjY * (GadgetHeight(Gadget) / H)
        EndIf
      Case #Glip_FillMode_Fit ; maintains AR, borders present if AR different than gadgets
        If AdjX < AdjY
          AdjX * (GadgetHeight(Gadget) / H) : AdjY * (GadgetHeight(Gadget) / H)          
        Else
          AdjX * (GadgetWidth(Gadget) / W) : AdjY * (GadgetWidth(Gadget) / W)      
        EndIf
      Default ; Case #Glip_FillMode_Stretch
        AdjX = 1.0 : AdJy = 1.0
    EndSelect
    glMatrixMode_(#GL_PROJECTION) : glLoadIdentity_() : glOrtho_(-W/2,W/2,H/2,-H/2,-1,1)
    
    glBegin_(#GL_QUADS) 
    For MyLoop = 0 To 3 : glTexCoord2f_(TC(Myloop)\x,TC(Myloop)\y) : glVertex2f_(VC(MyLoop)\x * AdjX, VC(MyLoop)\y * AdjY) : Next
    glEnd_()
    
    glDeleteTextures_(1,@TextureID0)
    SetGadgetAttribute(Gadget,#PB_OpenGL_FlipBuffers,#True)
  EndProcedure
  Procedure Set(Gadget.i, Image.i, FillMode = #Glip_FillMode_Stretch, ScaleMode = #PB_Image_Smooth, BGCol = -16777216)
    Protected TextureID0.i, W, H
    If IsGadget(Gadget) And IsImage(Image)
      If GadgetType(Gadget) = #PB_GadgetType_OpenGL
        SetGadgetAttribute(Gadget,#PB_OpenGL_SetContext,#True)
        TextureID0 = _Common_Init(ScaleMode)
        StartDrawing(ImageOutput(Image))
        W = OutputWidth() : H = OutputHeight()
        glPixelStorei_(#GL_PACK_ROW_LENGTH,DrawingBufferPitch())
        If OutputDepth() = 24
          glTexImage2D_(#GL_TEXTURE_2D, 0,  #GL_RGB, W, H, 0, #GL_BGR_EXT, #GL_UNSIGNED_BYTE, DrawingBuffer());  
        Else
          glTexImage2D_(#GL_TEXTURE_2D, 0,  #GL_RGBA, W, H, 0, #GL_BGRA_EXT, #GL_UNSIGNED_BYTE, DrawingBuffer());  
        EndIf
        _Common_Render(Gadget, TextureID0, W, H, FillMode, BGCol)
        StopDrawing()
      EndIf
    EndIf
  EndProcedure
  Procedure Set_Array(Gadget.i, *Array_Ptr, w, h, bpp, FillMode = #Glip_FillMode_Stretch, ScaleMode = #PB_Image_Smooth, BGCol = -16777216) ;/ for 8 bit or 32 bit array data.
    Protected Format = #GL_BGR_EXT, Type = #GL_RGB, TextureID0.i
    If bpp = 8 : Format = #GL_RED : Type = #GL_LUMINANCE : ElseIf bpp = 32 : Format = #GL_BGRA_EXT : Type = #GL_RGBA : EndIf
    If IsGadget(Gadget)
      If GadgetType(Gadget) = #PB_GadgetType_OpenGL
        SetGadgetAttribute(Gadget,#PB_OpenGL_SetContext,#True)
        TextureID0 = _Common_Init(ScaleMode)
        glTexImage2D_(#GL_TEXTURE_2D, 0, Type, W, H, 0, Format, #GL_UNSIGNED_BYTE, *Array_Ptr); 
        _Common_Render(Gadget, TextureID0, W, H, FillMode, BGCol, #False)
      EndIf
    EndIf
  EndProcedure
EndModule

CompilerIf #PB_Compiler_IsMainFile ; small demo app to demonstrate timing differences between PB image scaling performance and GLIP
  
  Enumeration ;/ windows / image / gadget
    #MyWindow_Main
    
    #MyImage_Main = 0
    #MyImage_Resized
    
    #MyGad_Method_Combobox = 0
    #MyGad_Method_Combobox_text
    
    #MyGad_Scale_Combobox
    #MyGad_Bit_Combobox
    
    #MyGad_Canvas
    #MyGad_GLIP
    #MyGad_Text
  EndEnumeration
  
  #Mode_Fast = #PB_OpenGL_NoAccumulationBuffer|#PB_OpenGL_NoStencilBuffer|#PB_OpenGL_NoDepthBuffer|#PB_OpenGL_NoFlipSynchronization
  #Mode_Smooth = #PB_OpenGL_NoAccumulationBuffer|#PB_OpenGL_NoStencilBuffer|#PB_OpenGL_NoDepthBuffer|#PB_OpenGL_FlipSynchronization
  
  #UseMode = #Mode_Fast
  ;#UseMode = #Mode_Smooth ; #Mode_Smooth may add vsync delay to the rendering time (depending on system configuration) 
  
  Global Event.i, Frame, Time, AvgTime.f, Width = 640, Height = 180, Col, txt.s
  ;Global Event.i, Frame, Time, AvgTime.f, Width = 1920, Height = 1080, Col, txt.s
  OpenWindow(#MyWindow_Main,0,0,width,height,"glIp Demo: Phil James 2023",#PB_Window_SystemMenu|#PB_Window_BorderLess|#PB_Window_Maximize|#PB_Window_MaximizeGadget)
  
  CreateImage(#MyImage_Main,Width,Height,32)
  AddWindowTimer(#MyWindow_Main,1,1000)
  LoadFont(0,"Impact",16) : SetGadgetFont(#PB_Default,FontID(0))
  
  TextGadget(#MyGad_Method_Combobox_Text,2,4,210,30,"Presentation Method:")
  ComboBoxGadget(#MyGad_Method_Combobox,212,0,100,32)
  AddGadgetItem(#MyGad_Method_Combobox,-1,"Canvas")
  AddGadgetItem(#MyGad_Method_Combobox,-1,"GLIp")
  SetGadgetState(#MyGad_Method_Combobox,0)
  
  ComboBoxGadget(#MyGad_Scale_Combobox,WindowWidth(#MyWindow_Main)-160,0,154,32)
  AddGadgetItem(#MyGad_Scale_Combobox,-1,"Scale: Centre")
  AddGadgetItem(#MyGad_Scale_Combobox,-1,"Scale: Fill")
  AddGadgetItem(#MyGad_Scale_Combobox,-1,"Scale: Fit")
  AddGadgetItem(#MyGad_Scale_Combobox,-1,"Scale: Stretch")
  SetGadgetState(#MyGad_Scale_Combobox,3) : HideGadget(#MyGad_Scale_Combobox,1)
  
  ComboBoxGadget(#MyGad_Bit_Combobox,320,0,54,32)
  AddGadgetItem(#MyGad_Bit_Combobox,-1,"24")
  AddGadgetItem(#MyGad_Bit_Combobox,-1,"32")
  SetGadgetState(#MyGad_Bit_Combobox,1)
  
  TextGadget(#MyGad_Text,380,4,800,26,"")
  CanvasGadget(#MyGad_Canvas,0,32,WindowWidth(#MyWindow_Main),WindowHeight(#MyWindow_Main)-32)
  
  OpenGLGadget(#MyGad_GLIP,0,32,WindowWidth(#MyWindow_Main),WindowHeight(#MyWindow_Main)-32,#UseMode)
  txt = "bit - Time To display image (" + Str(Width) + "x" + Str(Height) + " @ "+Str(GadgetWidth(#MyGad_GLIP) * DesktopResolutionX())+"x"+Str(GadgetHeight(#MyGad_GLIP) * DesktopResolutionY())+"): " 
  
  HideGadget(#MyGad_GLIP,1)
  
  Procedure Render()
    Static Rotation.f
    Frame + 1 ;/ increment frame number for timing average
    Rotation + 0.025
    StartVectorDrawing(ImageVectorOutput(#MyImage_Main))
    VectorSourceColor(RGBA(150,140,130,255)) : FillVectorOutput()
    Col = 127.0 + Sin(ElapsedMilliseconds() / 1000.0) * 127
    VectorSourceColor(RGBA(Col,190,160,255))
    AddPathCircle((Width * 0.5) + (Width * 0.3) * Cos(Rotation),(height * 0.5) + (height * 0.3) * Sin(Rotation),height * 0.1) : FillPath()
    
    VectorSourceColor(RGBA(250,50,50,255)) ;/ outer red box to check that scaling is working correctly
    AddPathBox(0,0,VectorOutputWidth(),VectorOutputHeight()) : StrokePath(5)
    
    StopVectorDrawing()
    time = ElapsedMilliseconds()
    Select GetGadgetState(#MyGad_Method_Combobox)
      Case 0 ;/ canvas render
        StartDrawing(CanvasOutput(#MyGad_Canvas))
        DrawImage(ImageID(#MyImage_Main),0,0,OutputWidth(), OutputHeight())
        StopDrawing()
      Case 1 ;/ GLIP
        GLIP::Set(#MyGad_GLIP,#MyImage_Main,GetGadgetState(#MyGad_Scale_Combobox),#PB_Image_Smooth, RGBA(0,30,40,255))
    EndSelect
    AvgTime + (ElapsedMilliseconds() - Time)
  EndProcedure
  
  Repeat
    Repeat
      Event = WindowEvent()
      Select Event
        Case #PB_Event_CloseWindow : End
        Case #PB_Event_Timer
          If Frame > 0
            SetGadgetText(#MyGad_Text,Txt + StrF(Avgtime / Frame,2) + "ms - (Theoretical FPS: "+StrF(1000/(Avgtime / Frame),1)+")")
          EndIf
        Case #PB_Event_Gadget
          Select EventGadget()
            Case #MyGad_Bit_Combobox
              Frame = 0 : Avgtime = 0 ;/ reset timing information
              If GetGadgetState(#MyGad_Bit_Combobox) = 0
                CreateImage(#MyImage_Main,Width,Height,24)
              Else
                CreateImage(#MyImage_Main,Width,Height,32)
              EndIf
            Case #MyGad_Method_Combobox 
              If EventType() = #PB_EventType_Change
                Frame = 0 : Avgtime = 0 ; reset timing information
                Select GetGadgetState(#MyGad_Method_Combobox)
                  Case 0 : HideGadget(#MyGad_GLIP,1)   : HideGadget(#MyGad_Canvas,0) : HideGadget(#MyGad_Scale_Combobox,1)
                  Case 1 : HideGadget(#MyGad_Canvas,1) : HideGadget(#MyGad_GLIP,0)   : HideGadget(#MyGad_Scale_Combobox,0)
                EndSelect
              EndIf
          EndSelect
      EndSelect
    Until Event = 0
    Render()
  ForEver
CompilerEndIf

A small demonstration of using the Set_Array() function:

Code: Select all

; CPU Shader - Blurred Lines.pb -  Converted from: https://www.shadertoy.com/view/DtXfDr (Supah) - Phil James 10/2023
; Uses threads so recommend enabling threadsafe compiler option.
EnableExplicit

XIncludeFile "..\Includes\GLip module.pbi"

Enumeration ;/ window
  #Window_Main
EndEnumeration
Enumeration ;/ gadgets
  #Gad_GL
EndEnumeration

Structure RGBf : R.f : G.f : B.f : EndStructure
Structure Pointf : X.f : Y.f : EndStructure
Structure Threads_Structure : ThreadID.i : Y_Start.l : Y_End.l : Timef.f : EndStructure

ExamineDesktops()
Global Downscale.f = 16, MinScale.f = 1, MaxScale.f = 8, DynamicScale = #True
Global OnFrame, Exit, Time.f, TimeF.f = 3, SizeX = DesktopWidth(0) / Downscale, SizeY = SizeX / 2

Global Dim ImageArray_Main.l(SizeY-1,SizeX-1), Event, ThreadCount = CountCPUs(#PB_System_ProcessCPUs)
Global Dim Render_ThreadControl.Threads_Structure(ThreadCount)

Macro SmoothstepM(t) : t * t * (3.0 - 2.0 * t) : EndMacro
Macro ClampM(value, min, max) : If value < min : value = min : ElseIf value > max : value = max : EndIf : EndMacro

Procedure Render_Thread(*Thread.Threads_Structure)
  Protected X, Y, high.f, low.f, Time.f = *Thread\Timef, i.f, u.pointf, a.pointf, t.f, ss1.f, ss2.f, ss3.f, ss4.f, o.RGBf, w.f, v.f
  For Y = *Thread\Y_Start To *Thread\y_end
    U\y = (y - 0.5 * SizeY) / SizeY : A\y = Abs(U\y);
    For X = 0 To SizeX-1
      U\x = (x - 0.5 * SizeX) / SizeY : A\x = Abs(U\x) : ClampM(a\x,0.0,1.0)
      O\r = 0 : O\g = 0 : o\b = 0 : t = 0
      ss2 = 1.0 - SmoothstepM(a\x)
      If a\x < 0.3 : ss3 = 1.0 - SmoothstepM(0.3) : Else : ss3 = 1.0 - SmoothstepM(a\x) : EndIf
      ClampM(a\x,0.2,0.9) : ss1 = SmoothstepM(a\x)
      Low = 0.06 * ss1    
      While t <= 1 : t + 0.2
        w.f = Abs(U\y + 0.2 * ss2 * Sin(Time * (1.0 + t) + U\x * (8.0+t))) - 0.003
        v = (w - low) / -Low : ClampM(v,0.0,1.0) : ss4 = ss3 * SmoothStepM(v)
        O\r + ss4 * ( 0.2 + (t*0.8)) : O\g + ss4 * ( 0.2 + (t*0.5)) : O\b + ss4 * ( 0.2 + (t*0.2))
      Wend
      ClampM(o\r,0,1) : ClampM(o\g,0,1) : ClampM(o\b,0,1)
      ImageArray_Main(Y,x) = RGB(o\b * 255.0,o\g * 255.0, o\r * 255.0)
    Next
  Next
EndProcedure
Procedure Render_Main()
  Protected MyLoop, StrideY.i = Round(SizeY / ThreadCount,#PB_Round_Up), Y = 0 : Static BadFrame
  TimeF  + 0.01
  For MyLoop = 1 To ThreadCount
    Render_ThreadControl(Myloop)\Y_Start = Y : Y + StrideY
    Render_ThreadControl(Myloop)\Y_End = Y - 1
    If Render_ThreadControl(Myloop)\Y_End > SizeY-1 : Render_ThreadControl(Myloop)\Y_End = SizeY-1 : EndIf    
    Render_ThreadControl(MyLoop)\Timef = TimeF
    Render_ThreadControl(MyLoop)\ThreadID = CreateThread(@Render_Thread(),@Render_ThreadControl(Myloop)) 
  Next
  Time = ElapsedMilliseconds()
  For MyLoop = 1 To ThreadCount : WaitThread(Render_ThreadControl(MyLoop)\ThreadID) : Next
  Time = ElapsedMilliseconds() - Time : If Time < 0.1 : time = 0.1 : EndIf
  OnFrame + 1
  
  GLIP::Set_Array(#Gad_GL,@ImageArray_Main(),SizeX,SizeY,32)
  
  If Onframe > 1 And DynamicScale
    If Time > 12 : BadFrame + 1 : ElseIf Time < 7 : BadFrame - 1 : EndIf
    If Abs(BadFrame) = 4
      If BadFrame = 4 : Downscale * 1.2 : ElseIf Badframe = -4 : Downscale * 0.8 : EndIf
      If Downscale < MinScale : Downscale = MinScale : ElseIf Downscale > MaxScale : Downscale = MaxScale : EndIf
      SizeX = DesktopWidth(0) / Downscale : SizeY = SizeX / 2
      Dim ImageArray_Main.l(SizeY-1,SizeX-1)
      BadFrame = 0
    EndIf
  EndIf
EndProcedure
Procedure Init_Main()
  Protected MyLoop, StrideY.i = Round(SizeY / ThreadCount,#PB_Round_Up), Y = 0
  OpenWindow(#Window_Main,0,0,SizeX, SizeY,"",#PB_Window_Maximize|#PB_Window_BorderLess)
  OpenGLGadget(#Gad_GL, 0, 0,WindowWidth(#Window_Main),WindowHeight(#Window_Main), #PB_OpenGL_NoStencilBuffer|#PB_OpenGL_NoDepthBuffer|#PB_OpenGL_NoAccumulationBuffer)
  AddWindowTimer(0,0,1)
  
  ;/ Optimize parameters, as we're only rendering on 3/7ths of the screen
  StrideY.i = Round(((SizeY / 7)*3) / ThreadCount,#PB_Round_Up) :  Y = (SizeY / 7) * 2
  For MyLoop = 1 To ThreadCount
    Render_ThreadControl(Myloop)\Y_Start = Y : Y + StrideY
    Render_ThreadControl(Myloop)\Y_End = Y - 1
    If Render_ThreadControl(Myloop)\Y_End > SizeY-1 : Render_ThreadControl(Myloop)\Y_End = SizeY-1 : EndIf
  Next  
EndProcedure
Init_Main()

Repeat
  Event = WaitWindowEvent()
  If Event = #PB_Event_Timer : Render_Main() : EndIf
  If Event = #PB_Event_Gadget : If EventType() = #PB_EventType_LeftButtonUp : End : EndIf : EndIf
ForEver
Image

Re: GLip - OpenGL Image Render

Posted: Sat Dec 02, 2023 10:49 pm
by STARGÅTE
Looks nice. Thanks for sharing.
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited