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
Wonderful 2D Water effects...
Re: Wonderful 2D Water effects...
@dodicat - excellent flow simulation
Re: Wonderful 2D Water effects...
Thanks Dafhi.
The river of sludge, rather than crystal clear drinking water, might make for a more interesting game in the long run.
The river of sludge, rather than crystal clear drinking water, might make for a more interesting game in the long run.
Re: Wonderful 2D Water effects...
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?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.
Re: Wonderful 2D Water effects...
@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 :)
Re: Wonderful 2D Water effects...
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..."
-
- Posts: 2958
- Joined: Jun 02, 2015 16:24
Re: Wonderful 2D Water effects...
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...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..."
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)
-
- Posts: 1
- Joined: Mar 19, 2017 13:44
- Contact:
Re: Wonderful 2D Water effects...
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.