Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
GFX2SDL.bi
| Uploader: |  OneCypher |
| Datum/Zeit: | 31.05.2010 22:00:35 |
#include "SDL\SDL.bi"
'This file should work with Linux and MS-Windows
'Windows:
' A program compiled with this lib only needs SDL.DLL additionally in the same directory where the excutable is saved
' Ein Programm mit dieser Bibliothek benötigt zusätzlich lediglich die SDL.DLL im selben Verzeichnis wie die ausführbare Datei
'Linux:
' You need to install the libsdl - package. The name of this package variates by the distribution you're using
' Man muss das libsdl - Packet installiert haben. Der Name dieses Packetes kann von Distribution zu Distribution unterschiedlich sein.
'Ubuntu 10.04:
' SDL does not work: every program with SDL.bi included says "segmentation fault" :-(( i dont know why :-((
' SDL scheint nicht korrekt zu funktionieren, jedes Programm in dem ich die SDL.bi einbinde meldet "segmentation fault":-(( Und ich weiss nicht warum :-((
namespace SDL
'I include crt.bi inside the namespace because i recognized that some libs don't like this library.
'Aus Erfahrung lade ich die crt.bi in diesen Namensraum, weil anscheinend manche Bibliotheken mit ihr Namenskonflike haben!
#include "crt.bi"
'Several variables for thread synchronization
'Diverse variablen zur Thread-Syncronisierung
Dim Shared SDLMutex as any ptr
Dim Shared SDLScreenMutex as any ptr
Dim Shared SDLKeyCond as any ptr
Dim Shared SDLMouseCond as any ptr
'Image-Buffer an variable for SDL-Screen-Settings
'Bild/Screen-Puffer und Variablen zur Einstellung des SDL-Screens
Dim Shared SrfcPtr as SDL_Surface ptr
Dim Shared ClrDepth as integer
Dim Shared BufferPtr as any ptr
Dim Shared ThreadPtr as any ptr
Dim shared FlagModes as uinteger
Dim Shared SDLEvent as SDL_Event
Dim Shared FrameRate as integer
'If Resized is TRUE, NewWidth and NewHeight are containing the new size of the window.
'Wenn Resized Wahr ist, kann in NewWidth und NewHeight die neue Fenstergröße gelesen werden.
Dim Shared Resized as integer
Dim Shared NewWidth as integer
Dim Shared NewHeight as integer
'Variables for input-methods
'Variablen der Eingabemethoden:
Dim shared in as string 'Keyboard-buffer
Dim Shared MouseX as integer 'Mouse-Variables
Dim Shared MouseY as integer '
Dim Shared MouseScroll as integer '
Dim Shared MouseButton as integer '
'The pointer to the Buffer-Pointer
'Der Zeiger auf den Puffer-Zeiger
Dim shared BufferPtrPtr as any ptr ptr
'Get the mouse-data similar to the GetMouse-function of the GFX-Lib
'This function is only used in this namespace by the SDL-ScreenThread
'Holt die Maus-Daten ähnlich wie GetMouse der GFX-Lib
'Wird vom SDL-Screen-Thread intern benutzt
Sub GetSDLMouse(byref mx as integer=0,byref my as integer=0,byref ms as integer=0,byref mb as integer=0)
dim tmpx1 as integer
dim tmpy1 as integer
dim SDLMButton as ubyte
SDLMButton = SDL_GetMouseState(@mx, @my): mb = 0
if (SDLMButton and SDL_BUTTON(SDL_BUTTON_LEFT)) then mb = mb + 1
if (SDLMButton and SDL_BUTTON(SDL_BUTTON_RIGHT)) then mb = mb + 2
'Mouse-Scrolling informations can't be read so far, plz help!! :-(((
'Folgendes klappt leider bisher nicht, bitte um Hilfe!! :-(((
'if (SDLMButton AND SDL_BUTTON(SDL_BUTTON_WHEELUP)) then ms = 1
'if (SDLMButton AND SDL_BUTTON(SDL_BUTTON_WHEELDOWN)) then ms = -1
SDL_PumpEvents
end sub
'Get the Keyboard Input similar to the GFX-Inkey-function
'This function is only used in this namespace by the SDL-ScreenThread
'Holt die Tastatur-Eingaben ähnlich wie Inkeyder GFX-Lib
'Wird vom SDL-Screen-Thread intern benutzt
function SDLInkey(SEvent as any ptr) as string
DIM SDLEvent as SDL_Event ptr = SEvent
Dim Tmp as string
if SDL_PollEvent ( SDLEvent ) then
if SDLEvent->type = SDL_KEYDOWN then
with *SDLEvent
if .Key.KeySym.sym > 126 then
return CHR(255, .key.keysym.scancode)
else
TMP = CHR(.key.keysym.unicode_ )
end if
'if .key.keysym.mod_ = 4097 then Tmp = ucase(Tmp)
if ( .key.keysym.mod_ = 4160 or .key.keysym.mod_ = 4224) and CHR(.key.keysym.sym) = "v" then tmp = CHR(22)
if ( .key.keysym.mod_ = 4160 or .key.keysym.mod_ = 4224) and CHR(.key.keysym.sym) = "c" then tmp = CHR(3)
end with
return TMP
else
return ""
end if
end if
end function
'This function writes the gfx-image-buffer to the SDL-Surface and is only used in this namespace by the SDL-Thread
'Schreibt die pixel-daten eines GFX-Buffers in ein SDL_Surface
'Wird vom SDL-Screen-Thread intern benutzt
sub Buffer2Surface(MyBuffer as any ptr, Srfc as SDL_Surface ptr)
dim MyPixData as any ptr
Dim ImgSize as uinteger
DIm as integer iw, ih
dim as uinteger p
imageinfo MyBuffer,iw,ih,,p,MyPixdata, ImgSize
SDL_LockSurface( Srfc )
'I dont know why, but the GFX-Image-Pitch sometimes differs to the SDL-Pixeldata-Pitch
'If theres a quicker method, please let me know!!
'Ich weiss nicht warum, aber manchmal unterscheidet sich der GFX-Image Pitch vom SDL-Pixeldata Pitch
'Wenn da einer eine schnellere Methode kennt, lasst es mich bitte wissen!
if Srfc->pitch > p then
if Srfc->h > ih then
for y as integer = 0 to ih -1
memcpy Srfc->pixels + (y * Srfc->pitch), MyPixData + (y*p), p
next
else
for y as integer = 0 to Srfc->h -1
memcpy Srfc->pixels + (y * Srfc->pitch), MyPixData + (y*p), p
next
end if
end if
if Srfc->pitch < p then
if Srfc->h > ih then
for y as integer = 0 to ih -1
memcpy Srfc->pixels + (y * Srfc->pitch),MyPixData + (y*p) , Srfc->pitch
next
else
for y as integer = 0 to Srfc->h -1
memcpy Srfc->pixels + (y * Srfc->pitch),MyPixData + (y*p) , Srfc->pitch
next
end if
end if
if Srfc->pitch = p then
if Srfc->h > ih then
for y as integer = 0 to ih -1
memcpy Srfc->pixels + (y * Srfc->pitch),MyPixData + (y*p) , Srfc->pitch
next
else
memcpy Srfc->pixels, MyPixData, Srfc->pitch * Srfc->h 'ImgSize - 32
end if
end if
SDL_Flip Srfc
SDL_UnlockSurface( Srfc )
end sub
'SDLThread() is only initiated by Screen(...) or ScreenRes( ...) and runs as long the SDL-Screen consists
'This Thread handles the SDL - mouse and meyboard informations and releases this informations by thread-conditions
'SDLThread() wird von Screen/Screenres initialisiert und läuft so lange der SDL-Screen bestehen soll.
'Er kümmert sich auch um Maus/Tastatur-Daten und gibt sie per Condition an den Hauptthread frei.
Sub SDLThread()
'#define SDLDebug
Dim T1 as double
#ifdef SDLDebug
Dim t2 as double
Dim FrameCounter as double
Dim LastFPS as double
#endif
Dim as integer iw1, ih1
Dim as integer iw2, ih2
imageinfo *BufferPtrPtr,iw1,ih1
'mutexlock SDLMutex
if SrfcPtr = 0 then
SrfcPtr = SDL_SetVideoMode(iw1, ih1, ClrDepth, SDL_SWSURFACE + FlagModes)
SDL_EnableKeyRepeat(200, 10)
SDL_EnableUNICODE( SDL_ENABLE )
end if
'Mutexunlock SDLMutex
dim t as string
t1 = timer
#ifdef SDLDebug
t2 = timer
#endif
While SrfcPtr <> 0
if SrfcPtr = 0 then
ThreadPtr = 0
exit sub
end if
#ifdef SDLDebug
if timer > t2 +1 then
LastFPS = FrameCounter
FrameCounter = 0
t2 = timer
end if
#endif
imageinfo *BufferPtrPtr,iw2,ih2
if iw2 <> iw1 or ih2 <> ih1 then
SrfcPtr = SDL_SetVideoMode(iw2, ih2, ClrDepth, SDL_SWSURFACE + FlagModes)
iw1 = iw2: ih1 = ih2
end if
if SDLEvent.type = SDL_VIDEORESIZE then
if SDLEvent.resize.w <> iw1 or SDLEvent.resize.h <> ih1 then
NewWidth = SDLEvent.resize.w
NewHeight = SDLEvent.resize.h
Resized = (1 <> 0)
end if
end if
if timer >= t1 + (1 / FrameRate) then
#ifdef SDLDebug
FrameCounter = FrameCounter +1
draw string *BufferPtrPtr, (-1,0), "Frames p/s=" & int(LastFPS),RGB(0,0,0)
draw string *BufferPtrPtr, (+1,0), "Frames p/s=" & int(LastFPS),RGB(0,0,0)
draw string *BufferPtrPtr, (0,-1), "Frames p/s=" & int(LastFPS),RGB(0,0,0)
draw string *BufferPtrPtr, (0,+1), "Frames p/s=" & int(LastFPS),RGB(0,0,0)
draw string *BufferPtrPtr, (0,0), "Frames p/s=" & int(LastFPS),RGB(255,255,255)
#endif
mutexlock SDLScreenMutex
'screensync
Buffer2Surface *BufferPtrPtr, SrfcPtr
Mutexunlock SDLScreenMutex
t1 = timer
else
sleep 1,1
end if
if SDLEvent.type = SDL_QUIT_ then
in = CHR(255) & CHR(107)
else
in = SDLInkey(@SDLEvent)
end if
CondBroadCast SDLKeyCond
GetSDLMouse( MouseX,MouseY,MouseScroll,Mousebutton)
CondBroadCast SDLMouseCond
Wend
End sub
'If Resized is TRUE, this function can be used to resize the GFX-Buffer:
'Resized is set to TRUE if the user changes the size of the SDL-Window. If this happens, FitBuffer can be used to arrange a new GFX-Image-Buffer.
'FitBuffer kann aufgerufen werden, wenn Resized WAHR ist:
'Wird die Größe des SDL-Fensters vom Benutzer verändert, kann man das feststellen indem man die Variable Resized auf Wahrheit überprüft. Daraufhin muss der GFX-Buffer auf die neue Größe des Fensters eingestellt werden.
'FitBuffer erledigt genau das!
Sub FitBuffer()
Dim OldBuffer as any ptr = *BufferPtrPtr
*BufferPtrPtr = ImageCreate(NewWidth, NewHeight, RGB(0,0,0))
ImageDestroy OldBuffer
Resized = (1 <> 1)
end sub
'This is a placeholder for SDL.ScreenRes
'ScreenRes_tmp ist ein Platzhalter für SDL.ScreenRes
Sub ScreenRes_tmp(Screen_Width as integer, Screen_Height as integer, ClrDepth1 as integer = 32, Pages as integer = 1, Flags as uinteger = 0, FrameRate1 as integer= 30)
DIM driver AS STRING
Dim OldBuffer as any ptr
if BufferPtrPtr = 0 then BufferPtrPtr = @BufferPtr
if SDLMutex = 0 then SDLMutex = MutexCreate
if SDLScreenMutex = 0 then SDLScreenMutex = MutexCreate
If SDLKeyCond = 0 then SDLKeyCond = CondCreate
if SDLMouseCond = 0 then SDLMouseCond = CondCreate
'Mutexlock SDLMutex
FlagModes = 0
FrameRate = FrameRate1
ClrDepth = ClrDepth1
SCREENINFO , , , , , , driver
if driver = "" then ScreenRes Screen_Width, Screen_Height, ClrDepth, , -1
if Flags AND &H01 then FlagModes = FlagModes + SDL_FULLSCREEN
if Flags AND &H02 then FlagModes = FlagModes
if Flags AND &H04 then FlagModes = FlagModes
if Flags AND &H08 then FlagModes = FlagModes + SDL_NOFRAME
if Flags AND &H10 then FlagModes = FlagModes
if Flags AND &H20 then FlagModes = FlagModes
if Flags AND &H40 then FlagModes = FlagModes
if Flags AND &H80 then FlagModes = FlagModes
if Flags AND &H100 then FlagModes = FlagModes + SDL_RESIZABLE
OldBuffer = *BufferPtrPtr
*BufferPtrPtr = ImageCreate(Screen_Width, Screen_Height, RGB(0,0,0))
if OldBuffer <> 0 then ImageDestroy OldBuffer
If ThreadPtr = 0 then ThreadPtr = ThreadCreate(cast(any ptr, @SDLThread))
end sub
'Screen can be used similar to the usual GFX-Screen(...) function
'Screen kann analog zur GFX-Screen-Anweisung benutzt werden.
Sub Screen(Modus as integer, ClrDepth1 as integer = 32, Pages as integer = 1, Flags as uinteger = 0, FrameRate1 as integer= 30)
Dim w as integer, h as integer
Select Case Modus
case -1
ScreenControl 3, w, h
FlagModes = FlagModes + SDL_FULLSCREEN
case 0
SDL_Quit
SrfcPtr = 0
if *BufferPtrPtr <> 0 then ImageDestroy *BufferPtrPtr
*BufferPtrPtr = 0
exit sub
Case 14
w = 320: h = 240
Case 15
w = 400: h = 300
Case 16
w = 512: h = 384
Case 17
w = 640: h = 400
Case 18
w = 640: h = 480
Case 19
w = 800: h = 600
case 20
w = 1024: h = 768
case 21
w = 1280: h = 1024
case 22
w = 1600: h = 1200
End select
ScreenRes_tmp(w, h , ClrDepth1 , Pages , Flags , FrameRate1)
End Sub
'ScreenRes can be used similar to the usual GFX-ScreenRes(...) function
'ScreenRes kann analog zur GFX-ScreenRes-Anweisung benutzt werden.
Sub ScreenRes(Screen_Width as integer, Screen_Height as integer, ClrDepth1 as integer = 32, Pages as integer = 1, Flags as uinteger = 0, FrameRate1 as integer= 30)
ScreenRes_tmp(Screen_Width, Screen_Height , ClrDepth1 , Pages , Flags , FrameRate1)
end sub
'Inkey can be used similar to the usual GFX-Inkey function
'Inkey kann analog zum GFX-Inkey benutzt werden.
Function Inkey() as string
if ThreadPtr <> 0 then
CondWait SDLKeyCond, SDLMutex
return in
end if
end function
'GetMouse can be used similar to the usual GFX-Getmouse(...) function
'GetMouse kann analog zum GFX-GetMouse benutzt werden.
sub GetMouse(byref mx as integer=0,byref my as integer=0,byref ms as integer=0,byref mb as integer=0)
if ThreadPtr <> 0 then
CondWait SDLKeyCond, SDLMutex
mx = MouseX
my = MouseY
ms = MouseScroll
mb = MouseButton
end if
end Sub
'Screeninfo can be used similar to the usual GFX-Screeninfo(...) function
'ScreenInfo kann analog zum GFX-ScreenInfo benutzt werden.
'Der Treiber wird allerdings mit "SDL" ausgegeben falls der SDL-Screen initialisiert ist.
Sub ScreenInfo(byref w as integer = 0, byref h as integer = 0, byref depth as integer = 0, byref pitch as integer = 0, byref rate as integer = 0, driver as string = "")
if BufferPtrPtr <> 0 then
if *BufferPtrPtr <> 0 then
imageinfo *BufferPtrPtr, w,h, , pitch
depth = ClrDepth
rate = FrameRate
driver = "SDL"
end if
end if
End sub
'SetBuffer can be used to define an own Screen-Pointer. This simplifies the access to the SDL-Window.
'SetBufferPtr kann dazu benutzt werden, den ScreenBuffer des SDL-Fensters auf einen Bestehenden Buffer umzulenken oder einen neuen zu setzen.
sub SetBufferPtr(byref BufferVar as any ptr)
if BufferPtrPtr <> 0 then BufferVar = *BufferPtrPtr
BufferPtrPtr = @BufferVar
end sub
'Similar to GFX-Screenlock
'Analog zum GFX-Screenlock
sub Screenlock()
Mutexlock SDLScreenMutex
end sub
'Similar to GFX-Screenunlock
'Analog zum GFX-Screenunlock
sub Screenunlock()
Mutexunlock SDLScreenMutex
end sub
End NameSpace