Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
SDL-FBGFX.bas
| Uploader: |  OneCypher |
| Datum/Zeit: | 02.11.2009 21:06:50 |
#include "SDL\SDL.bi"
#include "SDL\SDL_image.bi"
#include "crt.bi"
const pi = 3.1415926
sub dump(msg as string)
open cons for output as #1
print #1, msg
close #1
end sub
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
SDL_GetMouseState(@tmpx1, @tmpy1)
mx = tmpx1: my = tmpy1: mb = 0
SDLMButton = SDL_GetMouseState(NULL, NULL)
if (SDLMButton and SDL_BUTTON(SDL_BUTTON_LEFT)) then mb = 1
if (SDLMButton and SDL_BUTTON(SDL_BUTTON_RIGHT)) then mb = 2
SDL_PumpEvents
end sub
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.sym)
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
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 )
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
'dump "Partcopy"
memcpy Srfc->pixels, MyPixData, Srfc->pitch * ih
else
'dump "Fullcopy"
memcpy Srfc->pixels, MyPixData, Srfc->pitch * Srfc->h 'ImgSize - 32
end if
end if
SDL_Flip Srfc
SDL_UnlockSurface( Srfc )
end sub
Sub Surface2FBuffer(Srfc as SDL_Surface ptr, Buffer as any ptr)
dim MyPixData as any ptr
Dim ImgSize as uinteger
DIm as integer iw, ih
dim as uinteger p
imageinfo Buffer,iw,ih,,p,MyPixdata, ImgSize
SDL_LockSurface( Srfc )
if Srfc->pitch > p then
if Srfc->h > ih then
for y as integer = 0 to ih -1
memcpy MyPixData + (y*p),Srfc->pixels + (y * Srfc->pitch) , p
next
else
for y as integer = 0 to Srfc->h -1
memcpy MyPixData + (y*p),Srfc->pixels + (y * Srfc->pitch) , 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 MyPixData + (y*p),Srfc->pixels + (y * Srfc->pitch) , Srfc->pitch
next
else
for y as integer = 0 to Srfc->h -1
memcpy MyPixData + (y*p),Srfc->pixels + (y * Srfc->pitch) , Srfc->pitch
next
end if
end if
if Srfc->pitch = p then
if Srfc->h > ih then
memcpy MyPixData, Srfc->pixels, Srfc->pitch * ih
else
memcpy MyPixData, Srfc->pixels, Srfc->pitch * Srfc->h 'ImgSize - 32
end if
end if
SDL_UnlockSurface( Srfc )
end sub
screenres 320,200,32
Width 320 / 8, 200 /16
dim Video as SDL_Surface ptr
Dim Buffer as any ptr = ImageCreate(640,480,RGB(255,255,255))
Dim SDLBuffer as any ptr = ImageCreate(640,480,RGB(255,255,255))
Dim GFXBuffer as any ptr = ImageCreate(640,480,RGB(255,255,255))
Video = SDL_SetVideoMode( 640, 600, 32, SDL_Resizable)
if video = 0 then
SDL_Quit
end 1
end if
line Buffer,(0,0)-(639,479),RGB(255,0,0),B
line Buffer,(0,0)-(639,479),RGB(255,0,0)
line Buffer,(639,0)-(0,479),RGB(255,0,0)
draw string Buffer,(0,0),"Hallo Welt!",RGB(0,0,255)
Put(0,00),GFXBuffer,PSET
Dim as integer x, y, r, FPS
Dim T as double = timer
do
FPS += 1
if t + 1 <= timer then
Print "F/s = " & FPS
'Dump "F/s =" & FPS
FPS = 0
t = timer
end if
r += 1
if r = 360 then r = 0
x = 100 * sin(r / 360 * 2 * pi)
y = 100 * cos(r / 360 * 2 * pi)
put SDLBuffer,(x,y),Buffer,PSET
Buffer2Surface SDLBuffer,Video
SDL_PumpEvents
loop
SDL_Quit