Metaeffect: DirectX + Metaballs + creative ideas

[Merri]

Thought I'd try FreeBasic out. I'm quite experienced Visual Basic programmer, so I converted one of my graphical test projects to FreeBasic format. It wasn't too easy, I had to make some hard decisions as this isn't allowed in FB:

Code: Select all

Type Something
    Buffer() As Something
End Type

So I had some problems making atleast some kind of objects that I could use. I worked it out and ended up with something reasonable. First, here is the code... you can download it or copy from below:

Code: Select all

'' Metaeffect by Vesa Piittinen aka Merri <http://merri.net/>
''
'' ORIGINAL HEADER FOLLOWS...
'' ddrawtest -- shows how to use DirectDraw directly from FB
''
'' code looks hard to read because all the COM interface "hacking" needed, as FB
'' has no OO-support (yet :P)
''
'' based on C++ DX tutorials found on the Net
''

defint a-z
option explicit
option private

#include once "win\kernel32.bi"
#include once "win\user32.bi"
#include once "win\gdi32.bi"
#include once "win\ddraw.bi"


const SCR_WIDTH 		    = 320
const SCR_HEIGHT 		    = 240
const SCR_SIZE 			    = (SCR_WIDTH * SCR_HEIGHT)
const SCR_BPP 			    = 32					'' changing BPP and doRendering has to be updated too

'' default TRESHOLD is 0.00397 (effect is then less than one pixel)
const TRESHOLD As Double    = 0.05 ''00397

TYPE metaball
    X as double
    Y as double
    Rad as ushort
    Size as ushort
    Red as double
    Green as double
    Blue as double
END TYPE

declare function WinMain( byval hInstance as integer, byval hPrevInst as integer, lpszCmdLine AS string, byval lCmdShow as integer ) as integer


'' globals
	dim shared hInst as integer
	
	dim shared pDD as IDirectDraw ptr
	dim shared pDDSFront as IDirectDrawSurface ptr
	dim shared pDDSBack as IDirectDrawSurface ptr
	dim shared ddsd AS DDSURFACEDESC

    dim shared Balls(9) as metaball
    dim shared BallBuffer() as double
    dim shared BFR(SCR_SIZE - 1) as double
    dim shared BFG(SCR_SIZE - 1) as double
    dim shared BFB(SCR_SIZE - 1) as double

    end WinMain( GetModuleHandle( null ), null, Command$, SW_NORMAL )


'':::::
function InitDirectDraw( byval hWnd as integer ) as integer	
	dim ddscaps as DDSCAPS

	InitDirectDraw = FALSE	
	
	' create an interface to DDraw
	if( DirectDrawCreate( NULL, @pDD, NULL ) <> DD_OK ) then
       exit function
	end if

	' set the access mode (full screen)
	if( IDirectDraw_SetCooperativeLevel( pDD, hWnd, DDSCL_EXCLUSIVE or DDSCL_FULLSCREEN ) <> DD_OK ) then
		exit function
	end if
	
	' set the display mode
	if( IDirectDraw_SetDisplayMode( pDD, SCR_WIDTH, SCR_HEIGHT, SCR_BPP ) <> DD_OK ) then
		exit function
	end if

	' create the primary surface with 1 back-buffer
	clear ddsd, 0, len( ddsd )
	ddsd.dwSize 			= len( ddsd )
	ddsd.dwFlags 			= DDSD_CAPS or DDSD_BACKBUFFERCOUNT
	ddsd.ddsCaps.dwCaps 	= DDSCAPS_PRIMARYSURFACE or DDSCAPS_FLIP or DDSCAPS_COMPLEX
	ddsd.dwBackBufferCount 	= 1

	if( IDirectDraw_CreateSurface( pDD, @ddsd, @pDDSFront, NULL ) <> DD_OK ) then
		exit function
	end if

	'' get a pointer to the back buffer
	clear ddscaps, 0, len( ddscaps )
	ddscaps.dwCaps 			= DDSCAPS_BACKBUFFER

	if( IDirectDrawSurface_GetAttachedSurface( pDDSFront, @ddscaps, @pDDSBack ) <> DD_OK ) then
		exit function
	end if

	InitDirectDraw = TRUE
	
end function

sub Init_Ball(byval Index as byte, byval Radius as ushort, byval Red as double, byval Green as double, byval Blue as double)
    Dim tmpRad as double, tmpDouble as double, tmpSize as long, tmpY As uinteger, X as uinteger, Y as uinteger, A as uinteger
    '' initialize some settings
    Balls(Index).Rad = Radius
    Balls(Index).Red = Red
    Balls(Index).Green = Green
    Balls(Index).Blue = Blue
    Balls(Index).X = CDbl(SCR_WIDTH \ 2)
    Balls(Index).Y = CDbl(SCR_HEIGHT \ 2)
    '' reserve initial memory
    tmpSize = Radius * Radius
    If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize)
    '' set some temporary variables
    tmpRad = CDbl(Radius)
    tmpDouble = CDbl(Radius)
    '' count the first line (and thus the size of the metaball)
    Do Until tmpDouble < TRESHOLD
        BallBuffer(Index, A) = tmpDouble - TRESHOLD
        A += 1
        tmpDouble = tmpRad / CDbl(A * A)
        '' reserve more memory as required
        If A > tmpSize Then
            tmpSize += tmpSize
            If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize)
        End If
    Loop
    '' set size
    tmpSize = A
    Balls(Index).Size = A
    '' the final buffer size is now known
    If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize * tmpSize - 1)
    '' draw the rest of the ball
    For Y = 1 To tmpSize - 1
        tmpY = Y * Y
        '' set the first item
        BallBuffer(Index, A) = tmpRad / CDbl(tmpY) - TRESHOLD
        '' loop through whole line
        For X = 1 To tmpSize - 1
            '' calculate the strength
            tmpDouble = tmpRad / CDbl(X * X + tmpY)
            '' check if it is a good idea to quit the current row
            If tmpDouble < TRESHOLD Then Exit For
            '' set the strength to item
            BallBuffer(Index, A + X) = tmpDouble - TRESHOLD
        Next X
        '' jump to the next row
        A += tmpSize
    Next Y
end sub

'':::::
sub doRendering	
	dim dst as uinteger ptr
	dim X as integer, Y as integer, iX as integer, iY as integer, aX as integer, aY as integer
    dim tmpX as integer, tmpY as integer, tmpYX as integer, XX as integer, YX as integer
    dim A as byte, Red as uinteger, Green as uinteger, Blue as uinteger
	
	'' lock the back buffer before start drawing on it
	if( IDirectDrawSurface_Lock( pDDSBack, NULL, @ddsd, DDLOCK_WAIT, NULL ) <> DD_OK ) then
		exit function
	end if
    
    '' yes, we really go the easiest way here moving the balls...
    Balls(0).X += Rnd * 150 - 75
    Balls(0).Y += Rnd * 150 - 75
    '' check we're not out of boundaries
    If Balls(0).X < 0 Then Balls(0).X = 0
    If Balls(0).Y < 0 Then Balls(0).Y = 0
    If Balls(0).X > SCR_WIDTH Then Balls(0).X = SCR_WIDTH
    If Balls(0).Y > SCR_HEIGHT Then Balls(0).Y = SCR_HEIGHT
    
    '' move balls
    For A = 1 To 9
        Balls(A).X += (Balls(A - 1).X - Balls(A).X) / 5 - (Balls(0).X - Balls(A - 1).X) * 0.02
        Balls(A).Y += (Balls(A - 1).Y - Balls(A).Y) / 5 - (Balls(0).Y - Balls(A - 1).Y) * 0.02
    Next A

    ' draw the balls
    For A = 0 To 9
        '' calculate the area to draw into
        aX = SCR_WIDTH - 1
        If aX > CInt(Balls(A).X) + Balls(A).Size - 1 Then aX = CInt(Balls(A).X) + Balls(A).Size - 1
        aY = SCR_HEIGHT - 1
        If aY > CInt(Balls(A).Y) + Balls(A).Size - 1 Then aY = CInt(Balls(A).Y) + Balls(A).Size - 1
        iX = 0
        If iX < CInt(Balls(A).X) - Balls(A).Size + 1 Then iX = CInt(Balls(A).X) - Balls(A).Size + 1
        iY = 0
        If iY < CInt(Balls(A).Y) - Balls(A).Size + 1 Then iY = CInt(Balls(A).Y) - Balls(A).Size + 1
        
        '' now just draw the ball
        YX = iY * SCR_WIDTH
        tmpY = iY - CInt(Balls(A).Y)
        tmpYX = CUInt(Abs(tmpY)) * Balls(A).Size
        For Y = iY To aY
            tmpX = iX - CInt(Balls(A).X)
            For X = iX To aX
                XX = YX + X
                BFR(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Red
                BFG(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Green
                BFB(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Blue
                tmpX += 1
            Next X
            YX += SCR_WIDTH
            tmpY += 1
            If tmpY < 0 Then
                tmpYX -= Balls(A).Size
            Else
                tmpYX += Balls(A).Size
            End If
        Next Y
    Next A
	
	'' get pointer to back-buffer
	dst = ddsd.lpSurface
	
    YX = 0
   	'' draw some static (code from ptc_test)
   	for Y = 0 to SCR_HEIGHT - 1
   		for X = 0 to SCR_WIDTH - 1
            XX = YX + X
            Select Case BFR(XX)
                Case Is >= 1
                    Red = 255
                Case Is <= 0
                    Red = 0
                Case Else
                    Red = CUInt(BFR(XX) * 255)
            End Select
            BFR(XX) = BFR(XX) * 0.95
            Select Case BFG(XX)
                Case Is >= 1
                    Green = 255
                Case Is <= 0
                    Green = 0
                Case Else
                    Green = CUInt(BFG(XX) * 255)
            End Select
            BFG(XX) = BFG(XX) * 0.95
            Select Case BFB(XX)
                Case Is >= 1
                    Blue = 255
                Case Is <= 0
                    Blue = 0
                Case Else
                    Blue = CUInt(BFB(XX) * 255)
            End Select
            BFB(XX) = BFB(XX) * 0.95
			*dst = (Red shl 16) or (Green shl 8) or Blue
			dst = dst + len( uinteger )
		next X
        YX += SCR_WIDTH
		dst += ddsd.lPitch - (SCR_WIDTH * len( uinteger ))
   	next Y
	
	'' unlock it, no more needed
	IDirectDrawSurface_Unlock( pDDSBack, NULL )

end sub

'':::::
sub CleanUp

    '' free the back-buffer
    if( pDDSBack <> NULL ) then
        IDirectDrawSurface_Release( pDDSBack )
        pDDSBack = NULL
    end if

    '' and the primary one
    if( pDDSFront <> NULL ) then
        IDirectDrawSurface_Release( pDDSFront )
        pDDSFront = NULL
    end if

    '' and for last the ddraw interface
    if( pDD <> NULL ) then
        IDirectDraw_Release( pDD )
        pDD = NULL
    end if

end sub

'':::::
function ProcessIdle
    dim hRet as integer
    
    ProcessIdle = FALSE

	'' buffers were not allocated? exit
	if( (pDDSBack = NULL) or (pDDSFront = NULL) ) then
		exit function
	end if

    '' draw onto back-buffer
    doRendering

    '' turn it visible (flip)
    do        
        hRet = IDirectDrawSurface_Flip( pDDSFront, NULL, 0 )
        
        '' flip done? exit
        if( hRet = DD_OK ) then
        	exit do
        
        '' surface lost? (user switched to desktop??)
        elseif( hRet = DDERR_SURFACELOST ) then        
            IDirectDrawSurface_Restore( pDDSFront )
        
        '' wait until all current drawing is being done
        elseif( hRet <> DDERR_WASSTILLDRAWING ) then
        	exit do
    	end if
    loop

	ProcessIdle = TRUE

end function

'':::::
function WndProc(byval hWnd as integer, byval uMsg as integer, byval wParam as integer, byval lParam as integer) as integer

	WndProc = 0
	
	'' process messages
	select case uMsg
	case WM_CREATE
		if( InitDirectDraw( hWnd ) = FALSE ) then
			CleanUp
			PostMessage hWnd, WM_CLOSE, 0, 0
		end if

	case WM_DESTROY
		PostQuitMessage 0

	case WM_KEYDOWN
		if( (wParam and &hff) = 27 ) then
			CleanUp
			PostMessage hWnd, WM_CLOSE, 0, 0
		end if

	case else
		WndProc = DefWindowProc( hWnd, uMsg, wParam, lParam )
	end select

end function

'':::::
function WinMain( byval hInstance as integer, byval hPrevInst as integer, lpszCmdLine AS string, byval lCmdShow as integer ) as integer
	dim szAppName as string
	dim wc as WNDCLASS
	dim hWnd as integer
	dim msg as MSG

    '' metaballs first!
    dim ball as byte

    redim BallBuffer(9, 0)

    '' initialize 10 random balls
    randomize
    For ball = 0 To 9
        '' init by index, radius, red, green, blue
        Init_Ball ball, 65, CDbl(Rnd), CDbl(Rnd), CDbl(Rnd)
    Next ball

	hInst = hInstance

	'' create an window
	szAppName = "DD test"
	
	with wc
		.style 			= CS_HREDRAW or CS_VREDRAW
   		.lpfnWndProc 	= @WndProc
   		.cbClsExtra 	= 0
   		.cbWndExtra 	= 0
   		.hInstance 		= hInst
   		.hIcon 			= LoadIcon( hInst, IDI_APPLICATION )
   		.hCursor 		= LoadCursor( NULL, IDC_ARROW )
   		.hbrBackground 	= GetStockObject( BLACK_BRUSH )
   		.lpszMenuName 	= NULL
   		.lpszClassName 	= strptr( szAppName )
   	end with
   	
	if( RegisterClass( wc ) = 0 ) then
		exit function
	end if

	hWnd = CreateWindowEx( WS_EX_TOPMOST, szAppName, szAppName, WS_POPUP, NULL, NULL, SCR_WIDTH, SCR_HEIGHT, _
						   NULL, NULL, hInst, NULL )

	if( hWnd = null ) then
		exit function
	end if

	'' show it
	ShowWindow hWnd, lCmdShow
	UpdateWindow hWnd
	SetFocus hWnd

	'' check for messages and do the rendering if idle
	do while( hWnd )
		if( PeekMessage( msg, hWnd, 0, 0, PM_REMOVE ) ) then

			if( msg.message = WM_QUIT ) then
				exit do
			end if

			TranslateMessage msg
			DispatchMessage msg
		
		else
			if( ProcessIdle = FALSE ) then
				exit do
			end if
		end if
	loop

	''
	WinMain = msg.wParam
	
end function

It might be a bit speedy on over gigahertz machines, just make the resolution 640 x 400 to slow it down. It does the whole screen in real time, 32-bit, so it slows down a lot when the screen size gets bigger.

Thanks to whomever has made the DirectX test code :)

[dumbledore]

that's pretty neat.

Code: Select all

Type Something
    Buffer() As Something
End Type

there is a way around that, which is

Code: Select all

dim as integer numelements = 4
Type Something
    value as integer
    Buffer As Something ptr
End Type
dim as Something ptr var
var = callocate( len( Something ) )
var->Buffer = callocate( len( Something ) * numelements )
var->value = 1
var->Buffer[0 * len( Something )].value = 2
var->Buffer[1 * len( Something )].value = 3
? var->value, var->Buffer[0 * len( Something )].value, var->Buffer[1 * len( Something )].value
sleep

[Hexadecimal Dude!]

that's beautiful..............
im on my own in a thunderstorm...... but that proggy made everything...ok.........................
ahhhh...............
ohhhhh.................

[v1ctor]

Whoa, it looks great, i could add it to the distro, if you don't mind (the current DirectX test is er.. nm). Full credits will be given..

That could be done also as:

Code: Select all

Type Something2
  value as double
end type

Type Something1 
  Buffer As Something2 ptr 
End Type 

dim var(0 to somethings1-1) as Something1

  for i = 0 to somethings1-1
    var(i).Buffer = callocate( len( Something2 ) * somethings2 ) 
    for j = 0 to somethings2-1
      var(i).Buffer[j].value = 123456.7
    next
  next

[lillo]

Heh, ported it over to gfxlib, so it can be run also under Linux... :)

Code: Select all

'' Metaeffect by Vesa Piittinen aka Merri <http://merri.net/>
''
'' FreeBASIC gfxlib version.

defint a-z
option explicit
option private

const SCR_WIDTH           = 320
const SCR_HEIGHT           = 240
const SCR_SIZE              = (SCR_WIDTH * SCR_HEIGHT)
const SCR_BPP              = 32               '' changing BPP and doRendering has to be updated too

'' default TRESHOLD is 0.00397 (effect is then less than one pixel)
const TRESHOLD As Double    = 0.05 ''00397

TYPE metaball
    X as double
    Y as double
    Rad as ushort
    Size as ushort
    Red as double
    Green as double
    Blue as double
END TYPE

declare function doMain() as integer


'' globals
	dim shared Balls(9) as metaball
    dim shared BallBuffer() as double
    dim shared BFR(SCR_SIZE - 1) as double
    dim shared BFG(SCR_SIZE - 1) as double
    dim shared BFB(SCR_SIZE - 1) as double

	end doMain


'':::::
sub Init_Ball(byval Index as byte, byval Radius as ushort, byval Red as double, byval Green as double, byval Blue as double)
    Dim tmpRad as double, tmpDouble as double, tmpSize as long, tmpY As uinteger, X as uinteger, Y as uinteger, A as uinteger
    '' initialize some settings
    Balls(Index).Rad = Radius
    Balls(Index).Red = Red
    Balls(Index).Green = Green
    Balls(Index).Blue = Blue
    Balls(Index).X = CDbl(SCR_WIDTH \ 2)
    Balls(Index).Y = CDbl(SCR_HEIGHT \ 2)
    '' reserve initial memory
    tmpSize = Radius * Radius
    If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize)
    '' set some temporary variables
    tmpRad = CDbl(Radius)
    tmpDouble = CDbl(Radius)
    '' count the first line (and thus the size of the metaball)
    Do Until tmpDouble < TRESHOLD
        BallBuffer(Index, A) = tmpDouble - TRESHOLD
        A += 1
        tmpDouble = tmpRad / CDbl(A * A)
        '' reserve more memory as required
        If A > tmpSize Then
            tmpSize += tmpSize
            If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize)
        End If
    Loop
    '' set size
    tmpSize = A
    Balls(Index).Size = A
    '' the final buffer size is now known
    If UBound(BallBuffer, 2) < tmpSize Then ReDim Preserve BallBuffer(9, tmpSize * tmpSize - 1)
    '' draw the rest of the ball
    For Y = 1 To tmpSize - 1
        tmpY = Y * Y
        '' set the first item
        BallBuffer(Index, A) = tmpRad / CDbl(tmpY) - TRESHOLD
        '' loop through whole line
        For X = 1 To tmpSize - 1
            '' calculate the strength
            tmpDouble = tmpRad / CDbl(X * X + tmpY)
            '' check if it is a good idea to quit the current row
            If tmpDouble < TRESHOLD Then Exit For
            '' set the strength to item
            BallBuffer(Index, A + X) = tmpDouble - TRESHOLD
        Next X
        '' jump to the next row
        A += tmpSize
    Next Y
end sub

'':::::
sub doRendering   
   dim dst as uinteger ptr
   dim X as integer, Y as integer, iX as integer, iY as integer, aX as integer, aY as integer
    dim tmpX as integer, tmpY as integer, tmpYX as integer, XX as integer, YX as integer
    dim A as byte, Red as uinteger, Green as uinteger, Blue as uinteger
   
	'' lock the back buffer before start drawing on it
	screenlock
   
    '' yes, we really go the easiest way here moving the balls...
    Balls(0).X += Rnd * 150 - 75
    Balls(0).Y += Rnd * 150 - 75
    '' check we're not out of boundaries
    If Balls(0).X < 0 Then Balls(0).X = 0
    If Balls(0).Y < 0 Then Balls(0).Y = 0
    If Balls(0).X > SCR_WIDTH Then Balls(0).X = SCR_WIDTH
    If Balls(0).Y > SCR_HEIGHT Then Balls(0).Y = SCR_HEIGHT
   
    '' move balls
    For A = 1 To 9
        Balls(A).X += (Balls(A - 1).X - Balls(A).X) / 5 - (Balls(0).X - Balls(A - 1).X) * 0.02
        Balls(A).Y += (Balls(A - 1).Y - Balls(A).Y) / 5 - (Balls(0).Y - Balls(A - 1).Y) * 0.02
    Next A

    ' draw the balls
    For A = 0 To 9
        '' calculate the area to draw into
        aX = SCR_WIDTH - 1
        If aX > CInt(Balls(A).X) + Balls(A).Size - 1 Then aX = CInt(Balls(A).X) + Balls(A).Size - 1
        aY = SCR_HEIGHT - 1
        If aY > CInt(Balls(A).Y) + Balls(A).Size - 1 Then aY = CInt(Balls(A).Y) + Balls(A).Size - 1
        iX = 0
        If iX < CInt(Balls(A).X) - Balls(A).Size + 1 Then iX = CInt(Balls(A).X) - Balls(A).Size + 1
        iY = 0
        If iY < CInt(Balls(A).Y) - Balls(A).Size + 1 Then iY = CInt(Balls(A).Y) - Balls(A).Size + 1
       
        '' now just draw the ball
        YX = iY * SCR_WIDTH
        tmpY = iY - CInt(Balls(A).Y)
        tmpYX = CUInt(Abs(tmpY)) * Balls(A).Size
        For Y = iY To aY
            tmpX = iX - CInt(Balls(A).X)
            For X = iX To aX
                XX = YX + X
                BFR(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Red
                BFG(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Green
                BFB(XX) += BallBuffer(A, CUInt(Abs(tmpX)) + tmpYX) * Balls(A).Blue
                tmpX += 1
            Next X
            YX += SCR_WIDTH
            tmpY += 1
            If tmpY < 0 Then
                tmpYX -= Balls(A).Size
            Else
                tmpYX += Balls(A).Size
            End If
        Next Y
    Next A
   
	'' get pointer to back-buffer
	dst = screenptr
   
    YX = 0
      '' draw some static (code from ptc_test)
      for Y = 0 to SCR_HEIGHT - 1
         for X = 0 to SCR_WIDTH - 1
            XX = YX + X
            Select Case BFR(XX)
                Case Is >= 1
                    Red = 255
                Case Is <= 0
                    Red = 0
                Case Else
                    Red = CUInt(BFR(XX) * 255)
            End Select
            BFR(XX) = BFR(XX) * 0.95
            Select Case BFG(XX)
                Case Is >= 1
                    Green = 255
                Case Is <= 0
                    Green = 0
                Case Else
                    Green = CUInt(BFG(XX) * 255)
            End Select
            BFG(XX) = BFG(XX) * 0.95
            Select Case BFB(XX)
                Case Is >= 1
                    Blue = 255
                Case Is <= 0
                    Blue = 0
                Case Else
                    Blue = CUInt(BFB(XX) * 255)
            End Select
            BFB(XX) = BFB(XX) * 0.95
         *dst = rgb(Red, Green, Blue)
         dst = dst + len( uinteger )
      next X
        YX += SCR_WIDTH
      next Y
   
	'' unlock it, no more needed
	screenunlock

end sub

'':::::
function doMain() as integer

    '' metaballs first!
    dim ball as byte
    dim key as string
    dim page as integer

    redim BallBuffer(9, 0)

    '' initialize 10 random balls
    randomize
    For ball = 0 To 9
        '' init by index, radius, red, green, blue
        Init_Ball ball, 65, CDbl(Rnd), CDbl(Rnd), CDbl(Rnd)
    Next ball

	screenres SCR_WIDTH, SCR_HEIGHT, SCR_BPP, 2
	page = 0
	
	do
		doRendering
		
		'' do page flipping
		screenset page, page xor 1
		page = page xor 1
		
		'' exit if ESC is pressed or if the window close button is clicked
		key = inkey
		if ((key = chr(27)) or (key = chr(255) + "X")) then
				exit do
		end if
	loop

	function = 0
end function

[Merri]

I don't mind it being added in the distro :) It is actually a bit buggy, I don't know why exactly it behaves differently compared to the Visual Basic counterpart. Though with VB I made that using a 8-bit palette and used Windows API to create a DIB... it is a bit heavier than this as it doesn't access everything so directly. But that is off the topic.

GFXlib version is nice, but under Windows, is it possible to get rid of the console window so that it isn't visible?

This made me think that one could make some kind of compatibility files, ie. linux.bas compiles the same program for Linux and windows.bas compiles it for Windows. I don't have much experience on Linux, but think it is good to make cross-platform apps. And it would be great addition to the examples too, if there were one program that used DirectX in Windows and something else on Linux.

Edit Btw, noticed the thing runs fine with Singles as well, just make a replace all for Double -> Single and CDbl -> CSng and it consumes less memory and runs a bit faster.

[dumbledore]

compile with -s gui on the command line to get rid of the console window.

[lillo]

Merri: actually the FB built-in gfxlib does exactly what you're wondering about... Under Windows it uses DirectX underneath (or GDI if DirectX is not installed on the host machine), while under Linux it uses raw Xlib calls. DrV is working on DOS drivers, so far VGA and ModeX already work, and VESA is planned. A program that uses just the FB built-in commands (and this includes gfxlib commands) is fully portable, that is, you can compile it with no changes under the supported platforms and it will work out of the box.

[Merri]

Does gfxlib include controls or can I use them in some other general way? Also, the final EXE file seems to have a few kB of bloat compared to the DirectX version (roughly 20 kB vs. 60 kB).

[lillo]

Yes, it includes functions to control user input, namely MULTIKEY, GETMOUSE and GETJOYSTICK. See them in the docs/gfxlib.txt file or in the online Wiki.

Apart from this, the metaball example using gfxlib is 48K here, compiled with latest 0.14 pre-release. The ~30K overhead is due to several factors:
- support for both fullscreen and windowed modes (press ALT-Enter at any time to switch between the two)
- support for any resolution/color depth, with automatic conversion between formats (if your desktop does not support a depth and you request it, FB will still work and will transparently emulate it, converting colors accordingly). Each converter comes in two versions: a plain C version and an MMX optimized version.
- two normal drivers (for Win32): DirectX and GDI. If the first doesn't work, the second is used, transparently for the user.
- OpenGL driver: you can set up an OpenGL mode with one line of code only, by just calling SCREEN.
- Included in the 40K are the binary data for 3 default fonts (8x8, 8x14 and 8x16 pixels per 256 characters) and default palettes (CGA, EGA and VGA palettes)

Gfxlib always links as a static library, so no external DLLs are needed (apart from the system libs like GDI32, KERNEL32 and a few others; DirectX and OpenGL DLLs are loaded at runtime if available).
I don't think 40K is much bloat; actually, I've tried to keep it to a minimum... Suggestions to make generated EXEs even smaller are always welcome!

[relsoft]

Can someone "exegenate" this so that I could see. :*)

Thanks!

[Merri]

There is a download link in the first post ;)

So I'll repeat it here: http://merri.net/fb/metaeffect.zip

[mjs]

Hi,

I got a SIGSEGV (Access Violation) when I try to compile/run this program (gfxlib version) under DOS. Any idea?

Regards,
Mark

[cha0s]

its beautiful =)

[DrV]

Hi,

I got a SIGSEGV (Access Violation) when I try to compile/run this program (gfxlib version) under DOS. Any idea?

Regards,
Mark

Currently, only 320x240x8 and 320x200x8 are supported; this tries to set 320x240x32 and doesn't check for success/failure of SCREENRES... voila, memory violations. :)