PureBoard

Code: Alles auswählen

;..................................................................................
;
; tiny purebasic-opengl example | traumatic!2002 [traumatic@connection-refused.org]
;
;..................................................................................
;
;
;
;
; 20.06.2002  - displays text using a bitmap font and draws a tunnel in the background
;
;               filesize: 32.800 bytes (upx-compressed)
; 
; 27.06.2002  - filesize is now 16.928 bytes (upx-compressed)
;               due to texture-generation (->initPlasma())
;
; 28.06.2002  - added three different 'texture-generation-modes' can be toggled
;               by passing "-1", "-2" or "-3" as parameters
;
;               guess all bugs are gone now (screenresolution-switching)
;               glScissor-problem on some cards
;
;
; 12.12.2006 -  converted to pb4 on public demand - omg, what an ugly code... *sigh*
;               do yourself a favour and DON'T (read: DO NOT!) take this to learn from it!
;
;               note: I let "procedure modulo()" in as this is just meant to be
;                     compileable in pb4, not nice.
;

; opengl headers
XIncludeFile "pfd.pbh"
XIncludeFile "gl.pbh"
XIncludeFile "glu.pbh"

; windows headers
XIncludeFile "wingdi.pbh"
XIncludeFile "winuser.pbh"


Import "opengl32.lib"
  gluPerspective(a.d, b.d, c.d, e.d)
  glOrtho(a.d, b.d, c.d, d.d, e.d, f.d)
EndImport


#WNDTITLE = ""  ; App-Title
#FPS_TIMER = 1                    ; Timer to calculate FramesPerSecond
#FPS_INTERVAL = 1000              ; Calculate FPS every 1000 ms

ProgParam$ = ProgramParameter()

;
; variables
;


ElapsedTime.l     ; Elapsed time between frames

Global h_Wnd.l  ; global window handle
Global h_DC.l   ; global device context
Global h_RC.l   ; OpenGL rendering context

WndProcMsg.MSG


#appWidth = 640
#appHeight = 480


; tunnel
Structure TCoord  ; Texture Coordinates
  u.f
  v.f
EndStructure

Structure PCoord  ; Polygon Coordinates
  x.f
  y.f
  z.f
EndStructure

Global Dim imgArray.PCoord(32,32)
Global Dim texcord.TCoord(32,32)


; bmpfont
#fntSize = 32



;------------------------------------------------------------------
;  taken from glLibOnly2.pb
;
Procedure.l WndProc(hWnd,Msg,wParam,lParam)
  Shared quit
  
  If Msg=#WM_KEYDOWN  ; Set the pressed key (wparam) To equal true so we can check If its pressed
    quit=1
    ProcedureReturn 0
  EndIf


  If Msg=#WM_SYSCOMMAND   ; Intercept System Commands
  ; screensaver trying to start? monitor trying to enter powersaving?
    If wParam=#SC_SCREENSAVE ;Or wParam=#SC_MONITORPOWER ; (0F170h - winuser.h)
      ProcedureReturn 0   ; Prevent From Happening
    EndIf
  EndIf

  ProcedureReturn DefWindowProc_(hWnd, Msg, wParam, lParam)
EndProcedure

; ------------------------------------------------------------------
; Properly destroys the window created at startup (no memory leaks)
; ------------------------------------------------------------------
Procedure glKillWnd(FullscreenFlag.b);
  If FullscreenFlag = 1 ;  Change back To non fullscreen
    ChangeDisplaySettings_(0, 0)
    ShowCursor_(1)
  EndIf
  
  ; Makes current rendering context not current and releases the device
  ; context that is used by the rendering context.
  If wglMakeCurrent_(h_DC, 0) = 0
    MessageBox_(0, "Release of DC And RC failed!", "error?!", #MB_OK | #MB_ICONERROR)
  EndIf

  ; Attempts to delete the rendering context
  If wglDeleteContext_(h_RC) = 0
    MessageBox_(0, "Release of rendering context failed!", "error?!", #MB_OK | #MB_ICONERROR)
    h_RC = 0
  EndIf
  
  ; Attempts to release the device context
  If (h_DC = 1) And (ReleaseDC_(h_Wnd, h_DC) <> 0)
    MessageBox_(0, "Release of device context failed!", "error?!", #MB_OK | #MB_ICONERROR)
    h_DC = 0
  EndIf
  
  ; Attempts to destroy the window
  If (h_Wnd <> 0) And (DestroyWindow_(h_Wnd) = 0)
    MessageBox_(0, "Unable To destroy window!", "error?!", #MB_OK | #MB_ICONERROR)
    h_Wnd = 0
  EndIf

  ; Attempts to unregister the window class
  If UnregisterClass_("OpenGL", h_Instance) = 0
    MessageBox_(0, "Unable To unregister window class!", "error?!", #MB_OK | #MB_ICONERROR)
    h_Instance = 0
  EndIf
EndProcedure


;
; Creates the window and attaches an OpenGL rendering context to it
;
Procedure glCreateWnd(wWidth.l, wHeight.l, PixelDepth.b, FullscreenFlag.b)

  ClassName.s = "OpenGL"

  wndClass.WNDCLASS         ; Window class

  dwStyle.l                 ; Window styles
  dwExStyle.l               ; Extended window styles
  dmScreenSettings.DEVMODE  ; Screen settings (fullscreen, etc...)
  PixelFormat.l             ; Settings For the OpenGL rendering
  h_Instance.l               ; Current instance
  pfd.PIXELFORMATDESCRIPTOR ; Settings for the OpenGL window

  h_Instance = GetModuleHandle_(0);       Grab An Instance For Our Window
  
  ; Set up the window class
    wndClass\style         = #CS_HREDRAW | #CS_VREDRAW | #CS_OWNDC                
    ;                        CS_HREDRAW -> Redraws entire window If length changes
    ;                        CS_VREDRAW -> Redraws entire window If height changes
    ;                        CS_OWNDC   -> Unique device context For the window

    wndClass\hIcon         = LoadIcon_(0,#IDI_WINLOGO)
    wndClass\lpfnWndProc   = @WndProc() ; Set the window procedure to our func WndProc
    wndClass\hInstance     = h_Instance;
    wndClass\hCursor       = LoadCursor_(0, #IDC_ARROW);
    wndCLass\lpszClassName = @ClassName

  If RegisterClass_(wndClass) = 0 ; Attempt To register the window class
    MessageBox_(0, "Failed To register the window class!", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf
  
  ; change to fullscreen if desired
  If FullscreenFlag = 1
    ; Set parameters For the screen setting
      dmScreenSettings\dmSize = SizeOf(DEVMODE)
      dmScreenSettings\dmPelsWidth  = wWidth       ; Window width
      dmScreenSettings\dmPelsHeight = wHeight      ; Window height
      dmScreenSettings\dmBitsPerPel = PixelDepth  ; Window color depth
      dmScreenSettings\dmFields     = #DM_PELSWIDTH | #DM_PELSHEIGHT | #DM_BITSPERPEL

   ; try to change screen mode to fullscreen
   If ChangeDisplaySettings_(dmScreenSettings, #CDS_FULLSCREEN) = #DISP_CHANGE_FAILED
      MessageBox_(0, "unable To switch to fullscreen!", "error?!", #MB_OK | #MB_ICONERROR)
      FullscreenFlag = 0
    EndIf
  EndIf


  ; If we are still in fullscreen then
  If FullscreenFlag = 1
    ; Creates a popup window | Doesn't draw within child windows | Doesn't draw within sibling windows
    dwStyle = #WS_POPUP | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS
    dwExStyle = #WS_EX_APPWINDOW   ; Top level window
    ShowCursor_(0)                 ; Turn of the cursor (gets in the way)
  Else
    ; Creates an overlapping window | Doesn't draw within child windows | Doesn't draw within sibling windows
    dwStyle = #WS_OVERLAPPEDWINDOW | #WS_CLIPCHILDREN | #WS_CLIPSIBLINGS
    ;  Top level window | Border with a raised edge
    dwExStyle = #WS_EX_APPWINDOW | #WS_EX_WINDOWEDGE
  EndIf

  ; Attempt To create the actual window
  
  ; given Parameters are as follows:
  ; Extended window styles , Class name , Window title (caption) , Window styles
  ; Window position , Size of window , No parent window , No menu , Instance , Pass nothing To WM_CREATE
 
  h_Wnd = CreateWindowEx_(dwExStyle, "OpenGL", #WNDTITLE, dwStyle, 0, 0, wWidth, wHeight, 0, 0, h_Instance, 0)

  If h_Wnd = 0 
    MessageBox_(0, "Unable To create window!", "error?!", #MB_OK | #MB_ICONERROR)
    glKillWnd(FullscreenFlag)  ; Undo all the settings we've changed
    ProcedureReturn 0
  EndIf

  ; Try To get a device context
  h_DC = GetDC_(h_Wnd)
  
  If h_DC = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable to get device context!", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Settings For the OpenGL window
  pfd\nSize           = SizeOf(PIXELFORMATDESCRIPTOR) ; Size Of This Pixel Format Descriptor
  pfd\nVersion        = 1                    ; The version of this data structure
                      ; Buffer supports drawing To window | Buffer supports OpenGL drawing | Supports double buffering
  pfd\dwFlags         = #PFD_DRAW_TO_WINDOW | #PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER
  pfd\iPixelType      = #PFD_TYPE_RGBA        ; RGBA color format
  pfd\cColorBits      = PixelDepth;           ; OpenGL color depth
  pfd\cRedBits        = 0;                    ; Number of red bitplanes
  pfd\cRedShift       = 0;                    ; Shift count for red bitplanes
  pfd\cGreenBits      = 0;                    ; Number of green bitplanes
  pfd\cGreenShift     = 0;                    ; Shift count for green bitplanes
  pfd\cBlueBits       = 0;                    ; Number of blue bitplanes
  pfd\cBlueShift      = 0;                    ; Shift count for blue bitplanes
  pfd\cAlphaBits      = 0;                    ; Not supported
  pfd\cAlphaShift     = 0;                    ; Not supported
  pfd\cAccumBits      = 0;                    ; No accumulation buffer
  pfd\cAccumRedBits   = 0;                    ; Number of red bits in a-buffer
  pfd\cAccumGreenBits = 0;                    ; Number of green bits in a-buffer
  pfd\cAccumBlueBits  = 0;                    ; Number of blue bits in a-buffer
  pfd\cAccumAlphaBits = 0;                    ; Number of alpha bits in a-buffer
  pfd\cDepthBits      = 16;                   ; Specifies the depth of the depth buffer
  pfd\cStencilBits    = 0;                    ; Turn off stencil buffer
  pfd\cAuxBuffers     = 0;                    ; Not supported
  pfd\iLayerType      = #PFD_MAIN_PLANE;      ; Ignored
  pfd\bReserved       = 0;                    ; Number of overlay and underlay planes
  pfd\dwLayerMask     = 0;                    ; Ignored
  pfd\dwVisibleMask   = 0;                    ; Transparent color of underlay plane
  pfd\dwDamageMask    = 0;                    ; Ignored

  ; Attempts To find the pixel format supported by a device context that
  ; is the best match To a given pixel format specification.
  PixelFormat = ChoosePixelFormat_(h_DC, @pfd)
  If PixelFormat = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable To find a suitable pixel format", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Sets the specified device context's pixel format To the format specified by the PixelFormat.
  If SetPixelFormat_(h_DC, PixelFormat, @pfd) = 0
    glKillWnd(FullscreenFlag);
    MessageBox_(0, "Unable To set required pixel format", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Create a OpenGL rendering context
  h_RC = wglCreateContext_(h_DC)
  
  If h_RC = 0
    glKillWnd(FullscreenFlag)
    MessageBox_(0, "Unable To create an OpenGL rendering context", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Makes the specified OpenGL rendering context the calling thread's current rendering context
  If wglMakeCurrent_(h_DC, h_RC) = 0
    glKillWnd(FullscreenFlag);
    MessageBox_(0, "Unable To activate OpenGL rendering context", "error?!", #MB_OK | #MB_ICONERROR)
    ProcedureReturn 0
  EndIf

  ; Settings To ensure that the window is the topmost window
  ShowWindow_(h_Wnd, #SW_SHOW)
  SetForegroundWindow_(h_Wnd)
  SetFocus_(h_Wnd)

  ProcedureReturn 1
EndProcedure


;------------------------------------------------------------------


;
; anyone knows why pb doesn't have % ?
;
Procedure.l modulo(x,y)
  ; x % y ~ x - (x / y) * y
  ProcedureReturn x-(x/y)*y
EndProcedure

;
;
;
Procedure drawTunnelNew(ElapsedTime.f, wireframe)
  Shared tunnelTex, plasmaTex
  
  glDisable_(#GL_FOG)

  glEnable_(#GL_CULL_FACE)                             ; do not calculate inside of poly's
  glDisable_(#GL_BLEND)
  glDisable_(#GL_LIGHTING)

  glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT);     Clear The Screen And The Depth Buffer
  glLoadIdentity_()
 
   glTranslatef_(0.0, 0.0, -4.2)

 
   glPolygonMode_(#GL_FRONT, #GL_FILL)
   glPolygonMode_(#GL_BACK, #GL_FILL)

 ; 'ElapsedTime' is used as the angle here
 For i.b=0 To 32
  For j.b=0 To 32
    ; precalc texture-coordinates (this way only works for 24bit images)
    texcord(i,j)\u = (i / 32.0 + Cos(((ElapsedTime*3) + 8 * j) / 60.0) / 2)
    texcord(i,j)\v = (j / 32.0 + ((ElapsedTime*3) + j) / 120)
  
    ; setup tunnel
    imgArray(i,j)\x = (3.0 - j/12.0)*(Cos(2.0*#PI/32*i)+ 2*Sin((ElapsedTime+2*j)/29) + Cos((ElapsedTime+2*j)/13) - 2*Sin(ElapsedTime/29) - Cos(ElapsedTime/13))
    imgArray(i,j)\y = (3.0 - j/12.0)*(Sin(2.0*#PI/32*i)+ 2*Cos((ElapsedTime+2*j)/33) + Sin((ElapsedTime+2*j)/17) - 2*Cos(ElapsedTime/33) - Sin(ElapsedTime/17))
    imgArray(i,j)\z = -j
  Next
 Next


 glColor3f_(0.8, 1.0, 0.9)
 glEnable_(#GL_TEXTURE_2D)
 glBindTexture_(#GL_TEXTURE_2D, plasmaTex)


  ; draw cylinder for tunnel
  For xl.b=0 To 31
   glBegin_(#GL_QUADS)
    For yl.b=0 To 31
 
     glTexCoord2f_(texcord(xl,yl)\u, texcord(xl,yl)\v)
     glVertex3f_(imgArray(xl,yl)\x, imgArray(xl,yl)\y, imgArray(xl,yl)\z)

     glTexCoord2f_(texcord(xl+1,yl)\u, texcord(xl+1,yl)\v)
     glVertex3f_(imgArray(xl+1,yl)\x, imgArray(xl+1,yl)\y, imgArray(xl,yl)\z)

     glTexCoord2f_(texcord(xl+1,yl+1)\u, texcord(xl+1,yl+1)\v)
     glVertex3f_(imgArray(xl+1,yl+1)\x, imgArray(xl+1,yl+1)\y, imgArray(xl,yl+1)\z)

     glTexCoord2f_(texcord(xl,yl+1)\u, texcord(xl,yl+1)\v)
     glVertex3f_(imgArray(xl,yl+1)\x, imgArray(xl,yl+1)\y, imgArray(xl,yl+1)\z)

    Next
   glEnd_()
  Next  

  glMatrixMode_(#GL_PROJECTION)   ; Switch to projection matrix
  glPopMatrix_()                  ; Restore the old projection matrix
  glMatrixMode_(#GL_MODELVIEW)    ; Return to modelview matrix
  glPopMatrix_()                  ; Restore old modelview matrix
  glDisable_(#GL_TEXTURE_2D)      ; Turn on textures, don't want our text textured
  glPopAttrib_()                  ; Restore depth testing      

  glEnable_(#GL_BLEND) 
  glDisable_(#GL_CULL_FACE)
  glEnable_(#GL_FOG)
  glEnable_(#GL_LIGHTING)
  glEnable_(#GL_DEPTH_TEST) 
EndProcedure

;
; create textures
;
Procedure _CreateTexture(pData.l, mode.s, mipmapping.b, bmpWidth.l, bmpHeight.l)

  If pData = 0
    MessageBox_(0, "unable to load texture", ":textureLib", #MB_OK | #MB_ICONERROR)
  Else

  glGenTextures_(1, @texture)
  glBindTexture_(#GL_TEXTURE_2D, texture)
  glTexEnvi_(#GL_TEXTURE_ENV, #GL_TEXTURE_ENV_MODE, #GL_MODULATE)       ; Texture blends with object background
  glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR)  ; only first two can be used
  
  If mipmapping = 1
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR_MIPMAP_LINEAR)  ; all of the above can be used
  Else
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR)  ; all of the above can be used
  EndIf


  Select mode
    Case LCase("rgb")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_RGB, bmpWidth, bmpHeight, #GL_RGB, #GL_UNSIGNED_BYTE, pData):
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGB, bmpWidth, bmpHeight, 0, #GL_RGB, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf
    
    Case LCase("rgba")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_RGBA, bmpWidth, bmpHeight, #GL_RGBA, #GL_UNSIGNED_BYTE, pData)   ;
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGBA, bmpWidth, bmpHeight, 0, #GL_RGBA, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf

    Case LCase("luminance")
      If mipmapping = 1
        gluBuild2DMipmaps_(#GL_TEXTURE_2D, #GL_LUMINANCE, bmpWidth, bmpHeight, #GL_LUMINANCE, #GL_UNSIGNED_BYTE, pData)
      Else
        glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_LUMINANCE, bmpWidth, bmpHeight, 0, #GL_LUMINANCE, #GL_UNSIGNED_BYTE, pData)   ; Use when not wanting mipmaps to be built by openGL
      EndIf
      
  EndSelect

  EndIf
  ProcedureReturn texture
EndProcedure 

;
; load BMPs from memory-locations (IncludeBinary)
; loads 8, 16 and 24bit bmps
;
Procedure loadBMPTextureMem(memloc.l, mode.s, depth.b, mipmapping.b)
  FileHeader.BITMAPFILEHEADER
  InfoHeader.BITMAPINFOHEADER

  ; read the bitmap file header
  FileHeader\bfType                 = PeekW(memloc +0) ;2
  FileHeader\bfSize                 = PeekL(memloc +2) ;4
  FileHeader\bfReserved1            = PeekW(memloc +6) ;2
  FileHeader\bfReserved2            = PeekW(memloc +8) ;2
  FileHeader\bfOffBits              = PeekL(memloc+10) ;4

  ; check if it's a valid bmp-file
  If FileHeader\bfType <> $4D42
    ; MessageBox_(0, "invalid bmpfile @"+Str(memlocation), "error?!", #MB_OK)
    ProcedureReturn 0
  EndIf


  ; read the bitmap information header
  InfoHeader\biSize          = PeekL(memloc+14) ;4
  InfoHeader\biWidth         = PeekL(memloc+18) ;4
  InfoHeader\biHeight        = PeekL(memloc+22) ;4
  InfoHeader\biPlanes        = PeekW(memloc+26) ;2
  InfoHeader\biBitCount      = PeekW(memloc+28) ;2
  InfoHeader\biCompression   = PeekL(memloc+30) ;4
  InfoHeader\biSizeImage     = PeekL(memloc+34) ;4
  InfoHeader\biXPelsPerMeter = PeekL(memloc+38) ;4
  InfoHeader\biYPelsPerMeter = PeekL(memloc+42) ;4
  InfoHeader\biClrUsed       = PeekL(memloc+46) ;4
  InfoHeader\biClrImportant  = PeekL(memloc+50) ;4

  If InfoHeader\biSizeImage = 0
    InfoHeader\biSizeImage = (InfoHeader\biWidth * InfoHeader\biHeight * InfoHeader\biBitCount / 8)
  EndIf

  ; allocate enough mem to store the bitmap
  Dim bitmapImage.b (InfoHeader\biSizeImage)

;  bitmapImage = AllocateMemory(0,InfoHeader\biSizeImage,0)

  ; read in the bitmap image data
  For i.l=FileHeader\bfOffBits To InfoHeader\biSizeImage
    bitmapImage(i2) = PeekB(memloc+i)
    i2.l+1
  Next

  If depth>8
  ; swap BGR to RGB
    For i.l=0 To InfoHeader\biSizeImage Step 3
      tempRGB.l = bitmapImage(i)
      bitmapImage(i) = bitmapImage(i+2)
      bitmapImage(i+2) = tempRGB
    Next    
  EndIf 

  ; create texture
  texture = _CreateTexture(bitmapImage(), mode.s, mipmapping.b, InfoHeader\biWidth, InfoHeader\biHeight)

  ; cleanup
;  FreeMemory(0)
  Dim bitmapImage.b(0)

  ProcedureReturn texture
EndProcedure


;
; generates a plasma-like-texture
;
Procedure initPlasma(size.b, mode.s)
  Dim plasma.b(size*size*3)

  For i=0 To size*size*3 Step 3
    Temp = 114 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

  For i=1 To size*size*3 Step 3
    Temp =4 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

  For i=2 To size*size*3 Step 3
    Temp = 16 * #PI * i/512
    val  = Sin(temp/2) * 128 + 8
    PokeB(@plasma(i), val)
  Next

 
  Shared plasmaTex
  plasmaTex = _CreateTexture(plasma(), mode.s, 1, size, size)  ; this looks good ;)

  ; clean up
  Dim plasma.b(0)
EndProcedure


;
; this is due to problems with the real glScissors
; doh! what a waste...
;
Procedure drawScissor(y.f)
  ; render a blank quad
  glLoadIdentity_()
  x.f=-2.5
  z.f=-3.0

  glDisable_(#GL_FOG)
  glDisable_(#GL_BLEND)
  glDisable_(#GL_LIGHTING)
 
  glColor3f_(0, 0, 0.1)

  glTranslatef_(x.f, y, z)
  
  glBegin_(#GL_QUADS)
    glVertex2f_(0.0,0.0)
    glVertex2f_(0.0,0.5)
    glVertex2f_(5.0,0.5)
    glVertex2f_(5.0,0.0)
  glEnd_()

  glEnable_(#GL_LIGHTING)
  glEnable_(#GL_BLEND)
  glEnable_(#GL_FOG)
EndProcedure

;------------------------------------------------------------------

;
; build the font displaylists
;
Procedure BuildFont()
  Shared base.l, fontTex
  base.l = glGenLists_(128)                       ; Creating 256 Display Lists

  glBindTexture_(#GL_TEXTURE_2D, fontTex)         ; Select Our Font Texture

  For loop.l = 0 To 128                           ; Loop Through All 256 Lists
    cx.f = ( modulo(loop, 16) ) / 16               ; X Position Of Current Character
    cy.f = ( Round(loop/16,0) ) / 8               ; Y Position Of Current Character
  
    glNewList_(base+loop, #GL_COMPILE)            ; Start Building A List
    glBegin_(#GL_QUADS)                           ; Use A Quad For Each Character
      glTexCoord2f_(cx, 1.0 - cy.f - 0.0625*2)                     ; Texture Coord (Bottom Left)
      glVertex2i_(0, 0)                           ; Vertex Coord (Bottom Left)
      glTexCoord2f_(cx + 0.0625, 1.0 - cy.f - 0.0625*2) ; Texture Coord (Bottom Right)
      glVertex2i_(#fntSize, 0)                           ; Vertex Coord (Bottom Right)
      glTexCoord2f_(cx + 0.0625, 1.0 - cy)    ; Texture Coord (Top Right)
      glVertex2i_(#fntSize, #fntSize)                          ; Vertex Coord (Top Right)
      glTexCoord2f_(cx, 1.0 - cy)               ; Texture Coord (Top Left)
      glVertex2i_(0, #fntSize)                           ; Vertex Coord (Top Left)
    glEnd_()                                      ; Done Building Our Quad (Character)

    glTranslatef_(#fntSize-(#fntSize/3), 0.0, 0.0)
    glEndList_()                                  ; Done Building The Display List
  Next                                            ; Loop Until All 256 Are Built
EndProcedure

;
; delete the font displaylists from mem
;
Procedure KillFont()
  glDeleteLists_(base, 128) ; Delete All 256 Display Lists
EndProcedure
 
;
; print a single char
;
Procedure glPrintChar(x.f, y.f, alpha.f, scale.f, char.s)
  Shared base, fontTex

  glPolygonMode_(#GL_BACK,#GL_FILL)
  glPolygonMode_(#GL_FRONT,#GL_FILL)
  glDisable_(#GL_LIGHTING)

  glEnable_(#GL_TEXTURE_2D)
  glEnable_(#GL_BLEND)
  glBindTexture_(#GL_TEXTURE_2D, fontTex);			 Select Our Font Texture
  glDisable_(#GL_DEPTH_TEST);					 Disables Depth Testing
  glMatrixMode_(#GL_PROJECTION);					 Select The Projection Matrix
  glPushMatrix_();						 Store The Projection Matrix
  glLoadIdentity_();						 Reset The Projection Matrix
  glOrtho(0, #appWidth, 0, #appHeight, -100, 100);				 Set Up An Ortho Screen
  glMatrixMode_(#GL_MODELVIEW);					 Select The Modelview Matrix
  glPushMatrix_();						 Store The Modelview Matrix
  glLoadIdentity_();						 Reset The Modelview Matrix
  glTranslatef_(x, y, 0)
  glColor3f_(alpha.f, alpha.f, alpha.f)
  glScalef_(scale.f, scale.f, 1.0)

  glCallList_(Asc(char)-31);			 Write The Text To The Screen
  glMatrixMode_(#GL_PROJECTION);					 Select The Projection Matrix
  glPopMatrix_();						 Restore The Old Projection Matrix
  glMatrixMode_(#GL_MODELVIEW);					 Select The Modelview Matrix
  glPopMatrix_();						 Restore The Old Projection Matrix
  glEnable_(#GL_DEPTH_TEST);					 Enables Depth Testing
  glDisable_(#GL_BLEND)
  glDisable_(#GL_TEXTURE_2D)
  
  glEnable_(#GL_LIGHTING)
EndProcedure

;
;
;
Procedure glResizeWnd2()
  
  glViewport_(0, 0, #appWidth, #appHeight);     Set the viewport for the OpenGL window
  glMatrixMode_(#GL_PROJECTION);         Change Matrix Mode to Projection
  glLoadIdentity_();                    Reset View

  gluPerspective(45.0, #appWidth/#appHeight, 1.0, 100.0);   Do the perspective calculations. Last value = max clipping depth

  glMatrixMode_(#GL_MODELVIEW);          Return to the modelview matrix
  glLoadIdentity_();                    Reset View
EndProcedure


;------------------------------------------------------------------
;  Initialise OpenGL                                               
;------------------------------------------------------------------
Procedure glInit2()
  glShadeModel_(#GL_SMOOTH);                  Enables Smooth Color Shading
  glEnable_(#GL_DEPTH_TEST);                  Enable Depth Buffer
  glDepthFunc_(#GL_LESS);		            The Type Of Depth Test To Do
  glBlendFunc_(#GL_SRC_ALPHA, #GL_ONE)

  glHint_(#GL_PERSPECTIVE_CORRECTION_HINT, #GL_NICEST);   Realy Nice perspective calculations

  glEnable_(#GL_TEXTURE_2D);                      Enable Texture Mapping

  Shared fontTex
  fontTex = LoadBMPTextureMem(?fonttex, "luminance", 8, 0)
;  tunnelTex= LoadBMPTextureMem(?tunneltex, "rgb", 24, 0)  
  BuildFont()
EndProcedure

;------------------------------------------------------------------

; main
;If MessageBox_(0, "run fullscreen?", "[100% PureBasic]", #MB_YESNO | #MB_ICONQUESTION) = 6
;  FullscreenFlag = 1
;Else
  FullscreenFlag = 0
;EndIf

; open screen
If glCreateWnd(#appWidth, #appHeight, 32, FullscreenFlag) = 0
  End
EndIf

; generate different textures based on parameter
If ProgParam$ = "-1" Or ProgParam$ = ""
  initPlasma(16, "luminance")
EndIf

If ProgParam$ = "-2"
  initPlasma(32, "rgb")
EndIf

If ProgParam$ = "-3"
  initPlasma(48, "luminance")
EndIf
  
glInit2()

AppStart = GetTickCount_() ; get starttime of app


  ; resize window
; glViewport_(0,0,#appWidth,#appHeight);											 Reset The Current Viewport
                   
 glMatrixMode_(#GL_PROJECTION);											 Select The Projection Matrix
 glLoadIdentity_();														 Reset The Projection Matrix

 gluPerspective(45.0, #appWidth/#appHeight, 1.0, 100.0)

 glMatrixMode_(#GL_MODELVIEW);												 Select The Modelview Matrix
 glLoadIdentity_();	

;
;
;
Procedure readText2(delay)
  Shared txt$, txt2$, al.f;, sl.f,kk.f

  ; using threads and delay() lets me don't care about anything ;)
  Repeat

    Read txt$
    Read tmd$
         
    al.f = 0  ; 'alpha'  
    
    ; single letters
;    If txt$<>"+++"
      For lc=1 To Len(txt$)
        txt2$ = Mid(txt$, 1, lc)

;          If Mid(txt$,lc,1) = "§"
;            yl+50
;          EndIf

        sl.f+0.05
              
        ; 'fade-in'
        If al.f<0.7
          al.f+0.06
        EndIf
        
        
        ; only delay if letter isn't a [space]    

        If Mid(txt$, lc, 1) <> " "
          Delay(delay)
;        kk+0.01
        EndIf

      Next
;    EndIf


    ; reset text
    If txt$ = "###"
      Restore txtdata
      txt2$ = txt$
    EndIf
 
    
    
    Delay(Val(tmd$))
  ForEver
EndProcedure



CreateThread(@readText2(), 20) ; variable is the delay-time

;
; MAIN - LOOP
;
Repeat

;  ExamineKeyboard()
     
  If PeekMessage_(@WndProcMsg, 0, 0, 0, #PM_REMOVE)  ; Check If there is a message For this window
    ;translate And dispatch the message To this window
    TranslateMessage_(@WndProcMsg)
    DispatchMessage_(@WndProcMsg)
  EndIf
    
  FPSCount+1    ; Increment FPS Counter

  LastTime = ElapsedTime
  ElapsedTime = GetTickCount_() - AppStart     ; Calculate Elapsed Time
  ElapsedTime = (LastTime + ElapsedTime) / 2 ; Average it out for smoother movement

    drawTunnelNew(ElapsedTime*0.02, 0)
 
    If txt2$<>"###"
   
      i2.f=ElapsedTime*0.003
      
      x3l.w = 0 : y3l.w = 0
      
      For i = 1 To Len(txt$)
        txt3$ = Mid(txt2$, i, 1)

        ; waveblur
;        glPrintChar(32 + x3l*22+Sin(i2+i/4+sl)*4, 345-y3l, 0.4, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)
;        glPrintChar(32 + x3l*22+Cos(i2+i/4+sl)*0.5, 345-y3l, 0.9, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)

        glPrintChar(32 + x3l*22+Cos(i2+i/4+sl)*0.5, 345-y3l, 0.2, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)
        glPrintChar(32 + x3l*22+Sin(i2+i/4+sl)*4, 345-y3l, 0.6, 1.0 + Sin(i2+i/4+sl)*0.03, txt3$)

        ; oldskool - sin movement
;        glPrintChar(x3l*20, 280+Sin(i2+i/4+sl)*15 - y3l, 0.1+Sin(i2+i/4+sl)*0.5, 1, txt3$)
;        glPrintChar(52 + x3l*22, 345+Sin(i2+i/4+sl)*15 - y3l - 30, 0.1+Sin(i2+i/4+sl)*0.4, 0.9, txt3$)

        ; new line
        If txt3$="§"
          x3l=0
          y3l+30
        Else
          x3l+1
        EndIf  
          
      Next
      
    EndIf

  ; draw 'tv-screen'
  drawScissor(0.8)
  drawScissor(-1.3)
  
  ; display the scene (flipscreens)
  SwapBuffers_(h_DC)

  Delay(2)    ; don't lock up cpu

Until quit=1


;
; quit app
;
glKillWnd(FullscreenFlag)
End


;
;------------------------------------------------------------------
;
DataSection
  fonttex:
  IncludeBinary "20thCentury_8bit_sm2.bmp"

  txtdata:
  ; "text", "time" - § means new line
  Data.s "+++++++++++++++++++++++++§+                       +§+        WELCOME        +§+     TO THIS SMALL     +§+     DEMONSTRATION     +§+       in 100 %        +§+      PUREBASIC!!      +§+                       +§+++++++++++++++++++++++++§", "6000"
  Data.s "+++++++++++++++++++++++++§+                       +§+                       +§+ FOR MORE INFORMATION  +§+     PLEASE VISIT      +§+   www.purebasic.com   +§+                       +§+                       +§+++++++++++++++++++++++++§", "6000"
  Data.s "###"    ; end of text
EndDataSection

Code: Alles auswählen

; OS: Windows, Linux

Code: Alles auswählen

; English forum: http://www.purebasic.fr/english/viewtopic.php?t=6477&highlight=
; Author: cecilcheah
; Date: 11. June 2003
; OS: Windows
; Demo: 

; Fully functional Screen Capture (like SnagIt)
; ---------------------------------------------
; Feature: 
; Left mouse down o start cpature 
; Drag while left mouse is still down to define a rectangle to capture.
; Left mouse up to finish capture 
; Hotkey (Shift + Ctrl + F11) to start capture. 
;
; When the capture start, it will sit there until someone press the hot keys and then you
; should start the capturing process. The captured image will be in the clipboard. 


;Drag with left mouse button to select a part of the screen 
;Release the left button to paste it as a bitmap to the clipboard and end 

Window_Width  = GetSystemMetrics_(#SM_CXSCREEN) 
Window_Height = GetSystemMetrics_(#SM_CYSCREEN) 

corner1.POINT 
corner2.POINT 

; Added by Andre to work without include picture
CreateImage(1,200,200)
CreateImage(2,200,200)

If OpenWindow(0,100,150,291,155,"TBK Capture (STRG + F11 für Screenshot)",#PB_Window_SystemMenu) 
  CreateGadgetList(WindowID(0)) 
  TextGadget(2, 10, 10, WindowWidth(0)-20, WindowHeight(0)-20, "STRG + F11 für einen Screenshot drücken, danach auf dem Bildschirm den bereich auswählen, der in der Zwischenablage gespeichert werden soll")
  RegisterHotKey_(WindowID(0),1, #MOD_CONTROL,#VK_F11) 
  
  Repeat 
    WindowEvent = WaitWindowEvent()
    
    Select EventWindow()
      Case 0 ;{ Normale, 1. Fenster
        If WindowEvent = #WM_HOTKEY
          Pic_desktop = CreateImage(1, Window_Width, Window_Height) 
          
          hDC = StartDrawing(ImageOutput(1)) 
            BitBlt_(hDC, 0, 0, Window_Width, Window_Height, GetDC_(GetDesktopWindow_()), 0, 0, #SRCCOPY) 
          StopDrawing()
          
          OpenWindow(1, 0, 0, Window_Width, Window_Height, "Capturing", #WS_POPUP) 
          CreateGadgetList(WindowID(1)) 
          StartDrawing(WindowOutput(1))
            DrawImage(ImageID(1), 0, 0)      
            DrawingMode(#PB_2DDrawing_XOr | #PB_2DDrawing_Outlined) 
            GetCursorPos_(@corner2) 
            Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
          StopDrawing()
          Layer1_desktop = CreateImage(2, Window_Width, Window_Height) 
          
          hWnd1 = FindWindow_(0, "Capturing") 
          SetForegroundWindow_(hWnd1) 
        EndIf
      ;}
      Case 1 ;{ Das Fenster, auf dem man den Bereich auswählt
        Select WindowEvent
          Case #WM_MOUSEMOVE ;{
            If drawbox And SettingCursor=0 
              StartDrawing(WindowOutput(1)) 
                DrawImage(ImageID(1), 0, 0)      
                DrawingMode(#PB_2DDrawing_XOr | #PB_2DDrawing_Outlined) 
                GetCursorPos_(@corner2) 
                Box(corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y, $FFFFFF) 
              StopDrawing() 
              SettingCursor = 1 
              SetCursorPos_(corner2\x, corner2\y) 
            Else 
              SettingCursor = 0 
            EndIf 
          ;}
          Case #WM_LBUTTONDOWN ;{
            GetCursorPos_(@corner1)
            Debug corner1\x
            drawbox = 1
          ;}
          Case #WM_LBUTTONUP ;{
            StartDrawing(WindowOutput(1)) ; don't grab the boxlines 
              DrawImage(ImageID(1),0,0)                    
            StopDrawing() 
            
            ;CreateCompatibleBitmap_ cannot handle negative width/height values... 
            If corner1\x > corner2\x
              Swap corner2\x, corner1\x
            EndIf 
            If corner1\y > corner2\y
              Swap corner2\y, corner1\y
            EndIf
            
            GrabImage(1, 0, corner1\x, corner1\y, corner2\x-corner1\x, corner2\y-corner1\y)
            SetClipboardImage(0)
            
            MessageRequester("", "Das Bild wurde in die Zwischenablage kopiert", #MB_ICONINFORMATION) 
            
            drawbox = 0
            Break
          ;}
        EndSelect
      ;}
    EndSelect
  ForEver 
EndIf 

End