Wonderful 2D Water effects...

Game development specific discussions.
Post Reply
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Post by leopardpm »

did a quick google of "water made with fast fourier transform" and got some good stuff

http://www.indiedb.com/tutorials/fft-oc ... g-tutorial

https://www.youtube.com/watch?v=B3YOLg0sA2g

Very interesting, with different types of simulation: http://www.gamasutra.com/view/feature/1 ... dering.php

and some research on even faster fourier transforms... http://news.mit.edu/2012/faster-fourier-transforms-0118
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Wonderful 2D Water effects...

Post by dafhi »

@dodicat - excellent flow simulation
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Wonderful 2D Water effects...

Post by dodicat »

Thanks Dafhi.
The river of sludge, rather than crystal clear drinking water, might make for a more interesting game in the long run.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Post by leopardpm »

dodicat wrote:Thanks Dafhi.
The river of sludge, rather than crystal clear drinking water, might make for a more interesting game in the long run.
but the two things are separate, right? I mean the 'sludge' or image can be exchanged for something 'better' and the river flow be applied to that, correct?
dafhi
Posts: 1641
Joined: Jun 04, 2005 9:51

Re: Wonderful 2D Water effects...

Post by dafhi »

@dodicat - regarding sludge, I am working on a solution; the 'when' is the big issue. According to many sources however, we are vibrational beings, so use your imagination - keep saying things like crystal clear water :)
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Post by leopardpm »

sending good vibes your way - "Crystal , clear water... Crystal , clear water... Crystal , clear water... Ripples on a pond... Crystal , clear water... Boat Wakes... Crystal , clear water... Crystal , clear water... raindrops... Crystal , clear water... Crystal , clear water..."
Tourist Trap
Posts: 2958
Joined: Jun 02, 2015 16:24

Re: Wonderful 2D Water effects...

Post by Tourist Trap »

leopardpm wrote:sending good vibes your way - "Crystal , clear water... Crystal , clear water... Crystal , clear water... Ripples on a pond... Crystal , clear water... Boat Wakes... Crystal , clear water... Crystal , clear water... raindrops... Crystal , clear water... Crystal , clear water..."
I've started trying to do a full app rendered with Dahfi's technics. I really don't understand the way the stuff is rendered, but I managed to make it replace the default window. Currently we can only move it by dragging the titlebar, but more is possible. Using AADOT is funny, but I was totally lost with AAREC... So it's only dots...

Code: Select all

'--------------------------------------
'a dahfi's IMAGEVARS refactored version
'--------------------------------------
'list of UDTs:
'	V3
'	P3D
'	AXIS3D
'	IMAGER
'	AADOT
'	SCRPOS
'	WIDHEI
'	BOX
'	MONOAPPSCREEN


#include "fbgfx.bi"


extern p alias "__fb_gfx" as long ptr
nameSpace dj
	'author: DJ.Peters@fb.net
   function IsScreenLocked() as boolean
      if screenPtr()=0 then return FALSE
      #ifndef __FB_64BIT__
        #define index 33
      #else
        #define index 44
      #endif
      return iif(p[index] and 1,true,false)
      #undef index
   end function
end nameSpace


nameSpace cst
    const as double _pi => 4*atn(1)
end nameSpace


type V3
    as double   _x, _y, _z
    as double   _radius
    as long     _color
end type
type P3D	as V3


type AXIS3D
    as V3       _axisX = (1,0,0)
    as V3       _axisY = (0,-1,0)
    as V3       _axisZ = (0,0,1)
    as double   _x, _y, _z
end type


type IMAGER
    declare constructor()
    enum _CREATIONMODE
    	_asScreen	= 0
    	_asImage	= 1
    end enum
    declare constructor(byval CreationMode as _CREATIONMODE)
    declare destructor()
    private:
    declare sub VarPoolInit()
    declare sub ImgDestroy()
    public:
    declare sub ClrScr(byval Colour as ulong=&HFF000000)
    declare sub ScrInf()
    declare sub InitAsScreen(byval Wid		as single=-1, _
                    		 byval Hei		as single=-1, _
                    		 byval Bpp		as uinteger=32, _
                    		 byval NumPage	as integer=1, _
                    		 byval Flag		as integer=0)
    declare function CreateAsImage(byval Wid		as long=-1, _
                        		   byval Hei		as long=0, _
                            	   byval Colour		as ulong=rgb(0,0,0)) _
                            	   as any ptr
    declare sub CheckerCreate(byval PColor	as ulong=rgba(145,145,145,255), _
                        	  byval Size	as uinteger=12)
        as any ptr			_img, _pix
        as integer      	_w, _h, _ 
        					_bpp, _bypp, _pitch, _ 
                        	_numpage, _flag, _rate, _
                        	_pitchBy, _wm, _hm
        as boolean			_isScreen
        as single       	_midx, _midy, _
                        	_midxm, _midym, _diag
        as string       	_driverName
end type
constructor IMAGER()
	screen 0
	dim as integer	deskW, deskH
	screenInfo deskW, deskH
	THIS.InitAsScreen(deskW, deskH, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW)
	ClrScr(rgb(255,0,255))
end constructor
constructor IMAGER(byval CreationMode as _CREATIONMODE)
	select case CreationMode
		case IMAGER._CREATIONMODE._asScreen
			screen 0
			dim as integer	deskW, deskH
			screenInfo deskW, deskH
			THIS.InitAsScreen(deskW, deskH, 32, 1, fb.GFX_NO_FRAME + fb.GFX_SHAPED_WINDOW)
			ClrScr(rgb(255,0,255))
		case IMAGER._CREATIONMODE._asImage
			''
	end select
end constructor
destructor IMAGER()
    ImgDestroy()
end destructor
sub IMAGER.VarPoolInit()
	with THIS
	    ._wm    => ._w - 1
	    ._midx  => ._w/2
	    ._midxm => ._wm/2
	    ._hm    => ._h - 1
	    ._midy  => ._h/2
	    ._midym => ._hm/2
	end with
    '
    THIS._diag => sqr(THIS._w*THIS._w + THIS._h*THIS._h)
    '
    if THIS._bypp<>0 then
    	THIS._pitchBy = THIS._pitch\THIS._bypp
    end if
end sub
sub IMAGER.ImgDestroy()
    if THIS._img<>0 then
        imageDestroy(THIS._img)
        THIS._img = 0
    end if
end sub
sub IMAGER.ClrScr(byval Colour as ulong=&HFF000000)
    line (0,0)-(THIS._wm, THIS._hm), Colour, bf
end sub
sub IMAGER.ScrInf()
	with THIS
	    screenInfo ._w, ._h, ._bpp, _
	               ._bypp, ._pitch, ._rate, _
	               ._driverName
	    ._pix => screenPtr()
	end with
    '
    THIS.VarPoolInit()
end sub
sub IMAGER.InitAsScreen(byval Wid		as single=-1, _
                    	byval Hei		as single=-1, _
                    	byval Bpp		as uinteger=32, _
                    	byval NumPage	as integer=1, _
                    	byval Flag	as integer=0)
    THIS.ImgDestroy()
    dim as integer ww, hh
    screenInfo ww, hh
    '
    Wid = abs(Wid)
    if Wid<=1 then
        Wid *= ww
    end if
    Hei = abs(Hei)
    if Hei<=1 then
        Hei *=  hh
    end if
    '
    with THIS
	    ._w         => 		Wid
	    ._h         =>		Hei
	    ._Bpp       =>		Bpp
	    ._flag		or=>	8
	    ._numpage	=>		Numpage
	    ._flag		=>		Flag
	    ._isScreen	=>		TRUE
    end with
    '
    screenRes Wid, _ 
    		  Hei, _ 
    		  Bpp, _ 
    		  Numpage, _ 
    		  Flag
    THIS.ScrInf()
    '
    if NumPage> 1 then
    	screenSet 0, 1
    end if
end sub
function IMAGER.CreateAsImage(byval Wid as long=-1, _
                        	  byval Hei as long=0, _
                        	  byval Colour as ulong=rgb(0,0,0)) _
                        	  as any ptr
    THIS.ImgDestroy()
    '
    if Hei=0 then
        THIS.ScrInf()
        Wid = THIS._w
        Hei = THIS._h
    end if
    '
    THIS._img => imageCreate( Wid, Hei, Colour, 32 )
    imageInfo THIS._img, _ 
    		  THIS._w, _ 
    		  THIS._h, _ 
    		  THIS._bypp, _ 
    		  THIS._pitch, _ 
    		  THIS._pix
    THIS._bpp = THIS._bypp*8
    '
    THIS.VarPoolInit()
    THIS._isScreen => FALSE
    '
    '---->
    return THIS._img
end function
sub IMAGER.CheckerCreate(byval PColor as ulong, byval Size as uinteger)
    dim as uinteger sizeDouble  => Size*2
    dim as uinteger sizeM       => Size - 1
    for y as integer = 0 to THIS._hm step Size
        for x as integer = -Size*( (y/sizeDouble)=int(y/sizeDouble) )	to _
                            THIS._wm									step _
                            sizeDouble
            line THIS._img, _ 
            		(x, y)-(x + sizeM, y + sizeM), _ 
            		PColor, _ 
            		bf
        next x
    next y
end sub


#macro _ALPHA256(ret, back, fore, am, a256)
  ret=((_
          ( fore and &hFF00FF)*a256 + _
          ( back and &hFF00FF)*am + &h800080 ) and &hFF00FF00 or _
          (_
              ( fore and &H00FF00)*a256 + _
              ( back and &h00FF00)*am + &h008000 ) and &h00FF0000) shr 8
#endMacro
type AADOT
	declare constructor()
    declare sub RenderTarget(byval Pti as IMAGER ptr)
    declare sub DrawAadot(byval X as single=0, _
                                      byval Y as single=0, _
                                      byval C as ulong=&hFFFFFFFF)
        as single               _radius
        as single               _alpha
        as boolean              _isOutlined
        as IMAGER ptr			_imagerPtr
        as any ptr              _pixPtr
    private:
        as single               _slope
        as single               _slope_X2
end type
constructor AADOT()
	with THIS
		._radius		=> 0.65
		._alpha			=> 1.
		._isOutlined	=> FALSE
	end with
end constructor
sub AADOT.RenderTarget(byval Pti as IMAGER ptr)
    if pti->_isScreen then
        THIS._pixPtr = screenPtr()
    else
        THIS._pixPtr = Pti->_pix
    end if
    '
    THIS._imagerPtr = Pti
end sub
sub AADOT.DrawAadot(byval X as single=0, _
                    byval Y as single=0, _
                    byval C as ulong=&hFFFFFFFF)
    if THIS._imagerPtr->_h<1 then
    	exit sub
    end if
    '
    THIS._slope       = THIS._alpha*256
    THIS._slope_X2    = THIS._slope*2
    '
    dim as single     coneHei	=> THIS._radius*THIS._slope
    dim as integer    x1        => X - THIS._radius
    dim as integer    x2        => X + THIS._radius 
    x1 += x1*( x1<0 )
    dim as integer    y1        => Y - THIS._radius
    dim as integer    y2        => Y + THIS._radius 
    y1 += y1*( y1<0 )
    dim as single     dxClip    => THIS._slope*(X - x1)
    dim as single     dy        => THIS._slope*(Y - y1)
    x2 += (x2 - THIS._imagerPtr->_wm)*(x2>THIS._imagerPtr->_wm)
    y2 += (y2 - THIS._imagerPtr->_hm)*(y2>THIS._imagerPtr->_hm)
    dim as integer    pWidm     => x2 - x1
    dim as ulong ptr  pCorner   => THIS._pixPtr
    pCorner += x1 + y1*THIS._imagerPtr->_pitchBy
    '
    if THIS._isOutlined then
        for py as ulong ptr = pCorner											to _
                              @pCorner[ (y2 - y1)*THIS._imagerPtr->_pitchBy ]	step _
                              THIS._imagerPtr->_pitchBy
            '
            dim as single ySq   => dy*dy
            dim as single dx    => dxClip
            for px as ulong ptr = py to py + pWidm
            	'
                dim as integer  alph => coneHei - sqr(dx*dx + ySq)
                if alph>THIS._slope then alph = THIS._slope_X2 - alph
                if alph>0 then
	                dim as integer  alphM => 256 - alph
	                _ALPHA256( *px, _ 
	                		   *px, _ 
	                		   C, _ 
	                		   alphM, _ 
	                		   alph )
                end if
                dx -= THIS._slope
                '
            next px
            dy -= THIS._slope
            '
        next py
    else
        for py as ulong ptr = pCorner											to _ 
        					  @pCorner[ (y2 - y1)*THIS._imagerPtr->_pitchBy ]	step _ 
        					  THIS._imagerPtr->_pitchBy
        	'
            dim as single ySq	=> dy*dy
            dim as single dx	=> dxClip
            for px as ulong ptr = py to py + pWidm
                dim as integer  alph => coneHei - sqr(dx*dx + ySq)
                '
                if alph> THIS._slope then
                    alph = THIS._slope
                else
                    alph += alph*(alph<0)
                end if
                '
                dim as integer  alphM => 256 - alph
                _ALPHA256( *px, _ 
                		   *px, _ 
                		   C, _ 
                		   alphM, _ 
                		   alph )
                dx -= THIS._slope
            next px
            dy -= THIS._slope
            '
        next py
    end if
    '
end sub


type SCRPOS
		as integer	_scrPosX
		as integer	_scrPosY
End Type


type WIDHEI
		as integer	_wid
		as integer	_hei
end type


type BOX
	declare property Xi() as integer
	declare property Xi(byval as integer)
	declare property Yi() as integer
	declare property Yi(byval as integer)
	declare property W() as integer
	declare property W(byval as integer)
	declare property H() as integer
	declare property H(byval as integer)
	declare property Xf() as integer
	declare property Xf(byval as integer)
	declare property Yf() as integer
	declare property Yf(byval as integer)
		as SCRPOS	_scrPos
		as WIDHEI	_widHei
end type
property BOX.Xi() as integer
	'---->
	return THIS._scrPos._scrPosX
end property
property BOX.Xi(byval SetValue as integer)
	THIS._scrPos._scrPosX = SetValue
end property
property BOX.Yi() as integer
	'---->
	return THIS._scrPos._scrPosY
End Property
property BOX.Yi(byval SetValue as integer)
	THIS._scrPos._scrPosY = SetValue
end property
property BOX.W() as integer
	'---->
	return THIS._widHei._wid
end property
property BOX.W(byval SetValue as integer)
	THIS._widHei._wid = SetValue
End Property
property BOX.H() as integer
	'---->
	return THIS._widHei._hei
end property
property BOX.H(byval SetValue as integer)
	THIS._widHei._hei = SetValue
end property
property BOX.Xf() as integer
	'---->
	return ( THIS._scrPos._scrPosX + THIS._widHei._wid - 1 )
end property
property BOX.Xf(byval SetValue as integer)
	THIS._widHei._wid = SetValue - THIS._scrPos._scrPosX + 1
end property
property BOX.Yf() as integer
	'---->
	return ( THIS._scrPos._scrPosY + THIS._widHei._hei - 1 )
end property
property BOX.Yf(byval SetValue as integer)
	THIS._widHei._hei = SetValue - THIS._scrPos._scrPosY + 1
end property


type ARRAYOFP3D
	declare constructor()
	declare constructor( P3DArray() as P3D )
		as P3D		_arrayOfP3D(any)
end type
constructor ARRAYOFP3D()
	'
end constructor
constructor ARRAYOFP3D( P3DArray() as P3D )
	redim THIS._arrayOfP3D(uBound(P3DArray) - lBound(P3DArray))
	'
	for index as integer = lBound(P3DArray) to uBound(P3DArray)
		THIS._arrayOfP3D(index - lBound(P3DArray)) = P3DArray(index)
	next index
end constructor


type MONOAPPSCREEN
	declare constructor()
	declare constructor(byval ImgWid as integer, _ 
						byval ImgHei as integer)
	declare constructor(byval ScreenBuffer as IMAGER, _
						byval BackgroundImg as IMAGER, _
						byval ZoomFactor as single, _
						byval MainAxis as AXIS3D, _
						ArrayOfPoint() as P3D)
	declare property BckgndImgXi() as integer
	declare property BckgndImgXi(byval as integer)
	declare property BckgndImgYi() as integer
	declare property BckgndImgYi(byval as integer)
	declare property BckgndImgXf() as integer
	declare property BckgndImgYf() as integer
	declare property DeltaXFromCenter() as integer
	declare property DeltaYFromCenter() as integer
	declare sub PlugArrayOfP3D( P3DArray() as P3D )
	declare sub UnPlugAllArrayOfP3D()
	declare sub QsortZ( Array() As P3D, Begin as long, Finish as long)
	declare sub TopBarInit()
	declare sub BuildArrayOfBorderLinePoint()
	declare sub BuildArrayOfTopBarFilledBoxPoint()
	declare sub BuildFullArrayOfPoint()
	declare function MouseIsInTopBar(byval GmX as integer, _ 
									 byval GmY as integer) _ 
									 as boolean
	declare sub TestMouse()
	declare sub DrawHelper()
	declare sub DrawTopBar()
	declare sub RenderAppScreenFramework()
	declare sub RenderAppScreenContent()
		as IMAGER		_screenBuffer
		as IMAGER		_mainBackgroundImageBuffer
		as integer		_mainBackgroundImageBufferTopLeftCornerX
		as integer		_mainBackgroundImageBufferTopLeftCornerY
		as P3D			_arrayOfBorderLinePoint(any)
		as P3D			_arrayOfTopBarFilledBoxPoint(any)
		as P3D			_arrayOfPoint(any)
		'
		as ARRAYOFP3D	_arrayOfArrayOfP3D(any)
		'
		as single		_zoomFactor
		as AXIS3D		_mainAxis
		'
		as BOX			_topBar
		as boolean		_hasTopBarMouseOver
		as boolean		_hasTopBarMouseClick
		as boolean		_hasTopBarDragStarted
		as boolean		_hasMovedAtLeastOnce
		as integer		_mouseXatDragStart
		as integer		_mouseYatDragStart
		'
		as ulong		_borderColor
		as boolean		_hasMouseOver
		as boolean		_hasMouseClick
end type
type as MONOAPPSCREEN	MAS
constructor MONOAPPSCREEN()
	with THIS
		._screenBuffer				=> IMAGER(IMAGER._CREATIONMODE._asScreen)
		._mainBackgroundImageBuffer	=> IMAGER(IMAGER._CREATIONMODE._asImage)
		._zoomFactor				=> 1
	end with
	'
	with THIS._mainBackgroundImageBuffer
		.CreateAsImage	THIS._screenBuffer._w\4, _ 
						THIS._screenBuffer._h\4, _ 
						rgb(48,48,48)
		.CheckerCreate	rgb(92,92,92), 30
	end with
	'
	THIS.BckgndImgXi	=> (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
	THIS.BckgndImgYi	=> (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
	redim preserve THIS._arrayOfPoint(0)
	'
	THIS.TopBarInit()
	THIS.BuildArrayOfBorderLinePoint()
	THIS.BuildArrayOfTopBarFilledBoxPoint()
	THIS.BuildFullArrayOfPoint()
end constructor
constructor MONOAPPSCREEN(byval ImgWid as integer, _ 
						  byval ImgHei as integer)
	with THIS
		._screenBuffer				=> IMAGER(IMAGER._CREATIONMODE._asScreen)
		._mainBackgroundImageBuffer	=> IMAGER(IMAGER._CREATIONMODE._asImage)
		._zoomFactor				=> 1
	end with
	'
	with THIS._mainBackgroundImageBuffer
		.CreateAsImage	ImgWid, _ 
						ImgHei, _ 
						rgb(100,110,165)
		.CheckerCreate	rgb(40,40,10), 50
	end with
	'
	THIS.BckgndImgXi	=> (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
	THIS.BckgndImgYi	=> (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
	redim preserve THIS._arrayOfPoint(0)
	'
	THIS.TopBarInit()
	THIS.BuildArrayOfBorderLinePoint()
	THIS.BuildArrayOfTopBarFilledBoxPoint()
	THIS.BuildFullArrayOfPoint()
end constructor
constructor MONOAPPSCREEN(byval ScreenBuffer as IMAGER, _
						  byval BackgroundImg as IMAGER, _
						  byval ZoomFactor as single, _
						  byval MainAxis as AXIS3D, _
						  ArrayOfPoint() as P3D)
	with THIS
		._screenBuffer				=> ScreenBuffer
		._mainBackgroundImageBuffer	=> BackgroundImg
		._mainAxis					=> MainAxis
		._zoomFactor				=> ZoomFactor
	end with
	'
	redim THIS._arrayOfPoint(uBound(ArrayOfPoint) - lBound(ArrayOfPoint))
	for index as integer = lBound(ArrayOfPoint) to uBound(ArrayOfPoint)
		THIS._arrayOfPoint(index - lBound(ArrayOfPoint)) => ArrayOfPoint(index)
	next index
	'
	THIS.BckgndImgXi	=> (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
	THIS.BckgndImgYi	=> (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
	'
	THIS.TopBarInit()
	THIS.BuildArrayOfBorderLinePoint()
	THIS.BuildArrayOfTopBarFilledBoxPoint()
	THIS.BuildFullArrayOfPoint()
end constructor
property MAS.BckgndImgXi() as integer
	'---->
	return THIS._mainBackgroundImageBufferTopLeftCornerX
end property
property MAS.BckgndImgXi(byval SetValue as integer)
	THIS._mainBackgroundImageBufferTopLeftCornerX = SetValue
end property
property MAS.BckgndImgYi() as integer
	'---->
	return THIS._mainBackgroundImageBufferTopLeftCornerY
end property
property MAS.BckgndImgYi(byval SetValue as integer)
	THIS._mainBackgroundImageBufferTopLeftCornerY = SetValue
end property
property MAS.BckgndImgXf() as integer
	'---->
	return ( THIS._mainBackgroundImageBufferTopLeftCornerX + THIS._mainBackgroundImageBuffer._w - 1)
end property
property MAS.BckgndImgYf() as integer
	'---->
	return ( THIS._mainBackgroundImageBufferTopLeftCornerY + THIS._mainBackgroundImageBuffer._h - 1)
end property
property MAS.DeltaXFromCenter() as integer
	dim as integer	initialX = (THIS._screenBuffer._w - THIS._mainBackgroundImageBuffer._w)\2
	'---->
	return (THIS.BckgndImgXi - initialX)/5
end property
property MAS.DeltaYFromCenter() as integer
	dim as integer	initialY = (THIS._screenBuffer._h - THIS._mainBackgroundImageBuffer._h)\2
	'---->
	return (THIS.BckgndImgYi - initialY)/5
end property
sub MAS.PlugArrayOfP3D( P3DArray() as P3D )
	dim as integer	extensionRange = uBound(P3DArray) - lBound(P3DArray) + 1
	if not extensionRange>0 then
		exit sub
	end if
	'
	dim as integer	initialUbound = uBound(THIS._arrayOfPoint)
	redim preserve THIS._arrayOfPoint(uBound(THIS._arrayOfPoint) + extensionRange)
	'
	for index as integer = lBound(P3DArray) to uBound(P3DArray)
		THIS._arrayOfPoint(initialUbound + index - lBound(P3DArray) + 1) = P3DArray(index)
	next index
end sub
sub MAS.UnPlugAllArrayOfP3D()
	erase THIS._arrayOfPoint
	'
	THIS.BuildArrayOfBorderLinePoint()
	THIS.BuildArrayOfTopBarFilledBoxPoint()
	THIS.BuildFullArrayOfPoint()
end sub
sub MAS.QsortZ( Array() As P3D, Begin as long, Finish as long)
	'author: dodicat@fb.net
	dim as long		i => Begin
	dim as long		j => Finish
	'
	dim as P3D		item => Array( ( (i + j)\2 ) )
	'
	while i<=j
		while Array(i)._z>item._z	: i += 1	: wend
		while Array(j)._z<item._z	: j -= 1	: wend
		if i<j then 
			swap Array(i), Array(j)
			i += 1
			j -= 1
		elseIf i=j then
			i += 1
			j -= 1
		end if
	wend
	'
	if j>Begin then QsortZ( array() , Begin, j )
	if i<Finish then QsortZ( array(), i, Finish)
end sub
sub MAS.TopBarInit()
	THIS._topBar._scrPos._scrPosX	=> THIS.BckgndImgXi
	THIS._topBar._scrPos._scrPosY	=> THIS.BckgndImgYi
	THIS._topBar._widHei._wid		=> THIS._mainBackgroundImageBuffer._w
	THIS._topBar._widHei._hei		=> 24
end sub
sub MAS.BuildArrayOfBorderLinePoint()
	dim as integer	horizontalSemiWidth	=> (THIS._mainBackgroundImageBuffer._w)\10
	dim as integer	verticalSemiHeight	=> (THIS._mainBackgroundImageBuffer._h)\10
	redim THIS._arrayOfBorderLinePoint( 4*( horizontalSemiWidth + verticalSemiHeight ) + 1)
	'
	dim as integer	index
	dim as integer	indexOffset
	'left vertical side
	indexOffset += 0
	for index = indexOffset to indexOffset + 2*verticalSemiHeight + 1
		'define point at index
		THIS._arrayOfBorderLinePoint(index)._x = -horizontalSemiWidth + THIS.DeltaXFromCenter
		THIS._arrayOfBorderLinePoint(index)._z = 0.1
		THIS._arrayOfBorderLinePoint(index)._radius = 100
		THIS._arrayOfBorderLinePoint(index)._color = rgb(200,0,0)
		if index<=verticalSemiHeight then
			THIS._arrayOfBorderLinePoint(index)._y = index - indexOffset + THIS.DeltaYFromCenter
		else
			THIS._arrayOfBorderLinePoint(index)._y = verticalSemiHeight - (index - indexOffset) + THIS.DeltaYFromCenter
		end if
	next index
	'right vertical side
	indexOffset += 2*verticalSemiHeight + 1
	for index = indexOffset to indexOffset + 2*verticalSemiHeight
		'define point at index
		THIS._arrayOfBorderLinePoint(index)._x = +horizontalSemiWidth + THIS.DeltaXFromCenter
		THIS._arrayOfBorderLinePoint(index)._z = 0.1
		THIS._arrayOfBorderLinePoint(index)._radius = 100
		THIS._arrayOfBorderLinePoint(index)._color = rgb(200,0,0)
		if index<=verticalSemiHeight then
			THIS._arrayOfBorderLinePoint(index)._y = index - indexOffset + THIS.DeltaYFromCenter
		else
			THIS._arrayOfBorderLinePoint(index)._y = verticalSemiHeight - (index - indexOffset) + THIS.DeltaYFromCenter
		end if
	next index
	'bottom vertical side
	indexOffset += 2*verticalSemiHeight
	for index = indexOffset to indexOffset + 2*horizontalSemiWidth
		'define point at index
		THIS._arrayOfBorderLinePoint(index)._y = +verticalSemiHeight + THIS.DeltaYFromCenter
		THIS._arrayOfBorderLinePoint(index)._z = 0.1
		THIS._arrayOfBorderLinePoint(index)._radius = 100
		THIS._arrayOfBorderLinePoint(index)._color = rgb(200,0,0)
		if index<=verticalSemiHeight then
			THIS._arrayOfBorderLinePoint(index)._x = index - indexOffset + THIS.DeltaXFromCenter
		else
			THIS._arrayOfBorderLinePoint(index)._x = horizontalSemiWidth - (index - indexOffset) + THIS.DeltaXFromCenter
		end if
	next index
	'top vertical side
	indexOffset += 2*horizontalSemiWidth
	for index = indexOffset to indexOffset + 2*horizontalSemiWidth
		'define point at index
		THIS._arrayOfBorderLinePoint(index)._y = -verticalSemiHeight + THIS.DeltaYFromCenter
		THIS._arrayOfBorderLinePoint(index)._z = 0.1
		THIS._arrayOfBorderLinePoint(index)._radius = 100
		THIS._arrayOfBorderLinePoint(index)._color = rgb(200,0,0)
		if index<=verticalSemiHeight then
			THIS._arrayOfBorderLinePoint(index)._x = index - indexOffset + THIS.DeltaXFromCenter
		else
			THIS._arrayOfBorderLinePoint(index)._x = horizontalSemiWidth - (index - indexOffset) + THIS.DeltaXFromCenter
		end if
	next index
end sub
sub MAS.BuildArrayOfTopBarFilledBoxPoint()
	dim as integer	horizontalSemiWidth	=> (THIS._mainBackgroundImageBuffer._w)\10
	dim as integer	verticalSemiHeight	=> (THIS._mainBackgroundImageBuffer._h)\10
	dim as integer	totalArrayCount		=> (2*(horizontalSemiWidth - 2) + 1)*(THIS._topBar._widHei._hei\4 - 1)
	redim THIS._arrayOfTopBarFilledBoxPoint(24*horizontalSemiWidth)
	'
	dim as integer	x, y
	for x = -(horizontalSemiWidth - 2) to horizontalSemiWidth - 2
		for y = 2 to THIS._topBar._widHei._hei\4 step 1
			THIS._arrayOfTopBarFilledBoxPoint( _ 
			(x - (horizontalSemiWidth - 2)) + 2*y*horizontalSemiWidth)._x = x + THIS.DeltaXFromCenter
			THIS._arrayOfTopBarFilledBoxPoint( _ 
			(x - (horizontalSemiWidth - 2)) + 2*y*horizontalSemiWidth)._y = -verticalSemiHeight + y + THIS.DeltaYFromCenter
			THIS._arrayOfTopBarFilledBoxPoint( _ 
			(x - (horizontalSemiWidth - 2)) + 2*y*horizontalSemiWidth)._z = 0.1
			THIS._arrayOfTopBarFilledBoxPoint( _ 
			(x - (horizontalSemiWidth - 2)) + 2*y*horizontalSemiWidth)._radius = 100
			THIS._arrayOfTopBarFilledBoxPoint( _ 
			(x - (horizontalSemiWidth - 2)) + 2*y*horizontalSemiWidth)._color = rgb(200,200,0)
		next y
	next x
end sub
sub MAS.BuildFullArrayOfPoint()
	dim as integer	totalPoint
	totalPoint = uBound(THIS._arrayOfBorderLinePoint) - lBound(THIS._arrayOfBorderLinePoint) + _ 
				 uBound(THIS._arrayOfTopBarFilledBoxPoint) - lBound(THIS._arrayOfTopBarFilledBoxPoint)
	'
	redim THIS._arrayOfPoint(totalPoint + 1)
	for index as integer = lBound(THIS._arrayOfBorderLinePoint) to _ 
						   uBound(THIS._arrayOfBorderLinePoint)
		THIS._arrayOfPoint(index + lBound(THIS._arrayOfBorderLinePoint)) = _ 
												THIS._arrayOfBorderLinePoint(index)
	next index
	for index as integer = lBound(THIS._arrayOfTopBarFilledBoxPoint) to _ 
						   uBound(THIS._arrayOfTopBarFilledBoxPoint)
		THIS._arrayOfPoint(index										+ _ 
						   lBound(THIS._arrayOfTopBarFilledBoxPoint)	+ _ 
						   uBound(THIS._arrayOfBorderLinePoint))		= _ 
												THIS._arrayOfTopBarFilledBoxPoint(index)
	next index
end sub
function  MAS.MouseIsInTopBar(byval GmX as integer, _ 
							  byval GmY as integer) as boolean
	if GmX>=THIS._topBar.Xi		andAlso _
	   GmX<=THIS._topBar.Xf		andAlso _
	   GmY>=THIS._topBar.Yi		andAlso _
	   GmY<=THIS._topBar.Yf	+ 14	then
		'---->
		return TRUE
	else
		'---->
		return FALSE
	end if
end function
sub MAS.TestMouse()
	dim as integer	gmX, gmY, gmWheel, gmBtn
		getMouse	gmX, gmY, gmWheel, gmBtn
	'
	draw string (THIS.BckgndImgXi, THIS.BckgndImgYi), str(gmX) &".."& str(gmY)
	draw string (THIS.BckgndImgXi, THIS.BckgndImgYi + 12), str(THIS._hasTopBarDragStarted)
	if gmX>=THIS.BckgndImgXi	andAlso _
	   gmX<=THIS.BckgndImgXf	andAlso _
	   gmY>=THIS.BckgndImgYi	andAlso _
	   gmY<=THIS.BckgndImgYf	then
		if not THIS._hasMouseOver then THIS._hasMouseOver = TRUE
		if gmBtn>0 then
			if not THIS._hasMouseClick then THIS._hasMouseClick = TRUE
		else
			if THIS._hasMouseClick then THIS._hasMouseClick = FALSE
		end if
	else
		if THIS._hasMouseOver then THIS._hasMouseOver = FALSE
		if THIS._hasMouseClick then THIS._hasMouseClick = FALSE
	end if
	'
   select case THIS._hasTopBarMouseClick
      case TRUE
         THIS._hasTopBarDragStarted = TRUE
         '
         if not _
            ( gmX=(THIS._topBar.Xi + THIS._mouseXatDragStart)   andAlso _
              gmY=(THIS._topBar.Yi + THIS._mouseYatDragStart) ) then
             'moving -> update position
                if not THIS._hasMovedAtLeastOnce then THIS._hasMovedAtLeastOnce = TRUE
				THIS._topBar.Xi   = gmX - THIS._mouseXatDragStart
				THIS._topBar.Yi   = gmY - THIS._mouseYatDragStart
				THIS.BckgndImgXi	= THIS._topBar.Xi
				THIS.BckgndImgYi	= THIS._topBar.Yi
         else
            'not moving
            if not THIS._hasMovedAtLeastOnce then
               THIS._hasTopBarDragStarted = FALSE
            else
               THIS._hasTopBarDragStarted = TRUE
            end if
            '
            if THIS.MouseIsInTopBar(gmX, gmY) then
               if not gmBtn>0 then
                  'reset mouseClick state
                  if THIS._hasMovedAtLeastOnce then THIS._hasMovedAtLeastOnce = FALSE
                  THIS._hasTopBarMouseClick = FALSE
                  THIS._mouseXatDragStart   = -1
                  THIS._mouseYatDragStart   = -1
               end if
            else
               'reset mouseOver state
               THIS._hasTopBarMouseOver = FALSE
            end if
         end if
      case else
         'THIS._hasMouseClick==FALSE
         if THIS._hasTopBarDragStarted then
            THIS._hasTopBarDragStarted = FALSE
         end if
         '
         if THIS.MouseIsInTopBar(gmX, gmY) then
            if not THIS._hasTopBarMouseOver then THIS._hasTopBarMouseOver = TRUE
            '
            if gmBtn>0 then
               THIS._hasTopBarMouseClick = TRUE
               THIS._mouseXatDragStart   = gmX - THIS._topBar.Xi
               THIS._mouseYatDragStart   = gmY - THIS._topBar.Yi
            end if
         else
            if THIS._hasTopBarMouseOver then THIS._hasTopBarMouseOver = FALSE
         end if
   end select
   '
end sub
sub MAS.DrawHelper()
	THIS.TestMouse()
	'
	if THIS._hasMouseClick then
		THIS._borderColor => rgb(190,175,175)
	elseIf THIS._hasMouseOver then
		THIS._borderColor => rgb(190,190,105)
	else
		THIS._borderColor => rgb(90,90,105)
	end if
	'
	line (THIS.BckgndImgXi, THIS.BckgndImgYi)-_ 
		 (THIS.BckgndImgXf, THIS.BckgndImgYf), _ 
		  THIS._borderColor, _
		  b
	THIS._mainBackgroundImageBuffer.CheckerCreate	THIS._borderColor, 10
end sub
sub MAS.DrawTopBar()
	THIS.TestMouse()
	'
	if not THIS._hasTopBarDragStarted then
		line (THIS._topBar.Xi, THIS._topBar.Yf + 12)-_ 
		 	 (THIS._topBar.Xf, THIS._topBar.Yf + 14), _ 
		  	  rgb(200,0,0), _
		  	  bf
	end if
end sub
sub MAS.RenderAppScreenFramework()
	if THIS._hasTopBarDragStarted then
		line (0,  0)-_
			 (THIS._screenBuffer._w,  + THIS._screenBuffer._h), _ 
			  rgb(255,0,255), _ 
			  bf
		THIS.BuildArrayOfBorderLinePoint()
		THIS.BuildArrayOfTopBarFilledBoxPoint()
		THIS.BuildFullArrayOfPoint()
		'exit sub
	end if
	'
	dim as boolean	isInitiallyScreenLocked => dj.IsScreenLocked
	if not isInitiallyScreenLocked then
		screenLock()
	end if
    put (THIS.BckgndImgXi, THIS.BckgndImgYi), _ 
    	THIS._mainBackgroundImageBuffer._img, _ 
    	PSET
    '
    dim as AADOT    dot
                    dot.RenderTarget (@THIS._screenBuffer)
                    dot._alpha	=> .65
    dim as single zPointScale	=> 0.011
    '
    /'
    THIS.QsortZ( THIS._arrayOfPoint(), _ 
    			 lBound(THIS._arrayOfPoint), _ 
    			 uBound(THIS._arrayOfPoint) )
    '/
    '
    for pt as P3D ptr = @THIS._arrayOfPoint(lBound(THIS._arrayOfPoint)) to _ 
    					@THIS._arrayOfPoint(uBound(THIS._arrayOfPoint))
        dim as single rz1 =>	( THIS._mainAxis._z + _
                            	  THIS._mainAxis._axisZ._z*pt->_z + _
                            	  0*THIS._mainAxis._axisX._z*pt->_x + _
                            	  0*THIS._mainAxis._axisY._z*pt->_y )
        if rz1>0.1 then
            dim as single rz2   => THIS._zoomFactor/rz1
            dim as single y     => THIS._screenBuffer._midy - _
                                   rz2*(THIS._mainAxis._y + _
                                		THIS._mainAxis._axisY._y*pt->_y + _
                                    	THIS._mainAxis._axisZ._y*pt->_z + _
                                    	THIS._mainAxis._AxisX._y*pt->_x)
            dim as single x     => THIS._screenBuffer._midx + _
                                   rz2*(THIS._mainAxis._x + _
                                    	THIS._mainAxis._axisX._x*pt->_x + _
                                    	THIS._mainAxis._axisY._x*pt->_y + _
                                    	THIS._mainAxis._axisZ._x*pt->_z)
            '
            dot._radius = zPointScale*rz2*pt->_radius
            dot.DrawAadot(x, y, pt->_color)
        end if
    next pt
	if not isInitiallyScreenLocked then
		screenUnlock()
	end if
    '
end sub

sub MAS.RenderAppScreenContent()
	
end sub


'-------------------------------------------------MAIN---

'-------------------------------------------------INIT---

dim as MONOAPPSCREEN	mono => MONOAPPSCREEN(740, 460)

mono._mainAxis._z = .1
mono._zoomFactor = 1

scope
	dim as P3D	p3DArray(99)
	for index as integer = 0 to uBound(p3DArray)
		p3DArray(index)._x		= 50*rnd() - 25
		p3DArray(index)._y		= 50*rnd() - 25
		p3DArray(index)._z		= 0.1
		p3DArray(index)._radius = 100
		p3DArray(index)._color	= rgb(rnd()*255, rnd()*255, rnd()*255)
	next index
	'
	mono.PlugArrayOfP3D(p3DArray())
end scope

do
	screenLock
		mono.RenderAppScreenFramework()
		mono.DrawTopBar()
		'mono.DrawHelper()
		
	screenUnlock
	'
	sleep 55
loop until inkey()=chr(27)


'-------------------------------------------------____---


getKey()
'(eof)
Don't know if that can be of any use!
ralpharthur
Posts: 1
Joined: Mar 19, 2017 13:44
Contact:

Re: Wonderful 2D Water effects...

Post by ralpharthur »

It's super cool, the effects in the first post. I really enjoy it. Maybe someday I will be able to do the same thing, so far I am a totally newbie in the thema.
Post Reply