Wonderful 2D Water effects...

Game development specific discussions.
leopardpm
Posts: 1590
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Postby leopardpm » Aug 31, 2016 20:28

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

http://www.indiedb.com/tutorials/fft-ocean-water-rendering-tutorial

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

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

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

Re: Wonderful 2D Water effects...

Postby dafhi » Sep 01, 2016 19:00

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

Re: Wonderful 2D Water effects...

Postby dodicat » Sep 02, 2016 22:06

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: 1590
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Postby leopardpm » Sep 02, 2016 22:23

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: 884
Joined: Jun 04, 2005 9:51

Re: Wonderful 2D Water effects...

Postby dafhi » Sep 03, 2016 1:29

@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: 1590
Joined: Feb 28, 2009 20:58

Re: Wonderful 2D Water effects...

Postby leopardpm » Sep 03, 2016 1:56

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: 2197
Joined: Jun 02, 2015 16:24

Re: Wonderful 2D Water effects...

Postby Tourist Trap » Sep 07, 2016 21:23

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...

Postby ralpharthur » Mar 19, 2017 14:18

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.

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 1 guest