Using classes - my 1st attempt

New to FreeBASIC? Post your questions here.
Post Reply
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Using classes - my 1st attempt

Post by UEZ »

This is my 1st attempt to use classes to display some pixels to the screen but it has failed.

Code: Select all

'Snowfall v0.5 coded by UEZ Using classes (my 1st attempt^^)
#Include "fbgfx.bi"

Using FB

Const scrw = 1400, scrh = 800

Function RandomRange(fStart As Single, fEnd As Single) As Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Type Snowflake
   Public:
      Declare Constructor()
      Declare Destructor()
      Declare Sub Init()
      Declare Sub Reset()
      Declare Sub update()
      As Ushort w, h
      As Single x, y, vx, vy, radius, Alpha
End Type

Sub Snowflake.init()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * (This.h - This.radius)
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.1, 1.0)
End Sub

Sub Snowflake.Reset()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * -This.radius
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.1, 1.0)
End Sub

Sub Snowflake.Update()
   This.x += This.vx
   This.y += This.vy
   If (This.y > This.h + This.radius) Or (This.x < -This.radius) Or (This.x > This.w) Then This.Reset()
End Sub

Constructor Snowflake()
   This.w = scrw
   This.h = scrh
   This.Init
End Constructor

Destructor Snowflake()
End Destructor

Type Snowflakes
      Declare Constructor(n As Ushort = 5000)
      Declare Destructor()
      Declare Sub Draw()
   Private:
      As Ushort w, h, amount      
      As Snowflake Ptr pBuffer 
      As fb.Image Ptr Img1, Img0 
End Type

Sub Snowflakes.Draw()
   Put This.Img1, (0, 0), This.Img0, Pset
   For i As Ushort = 0 To This.amount - 1
      Circle This.Img1, (pBuffer[i].x, pBuffer[i].y), pBuffer[i].radius, Rgba(255, 255, 255, 255 * pBuffer[i].Alpha),,,,F
      pBuffer[i].update
   Next
   Put (0, 0), This.Img1, Pset
End Sub

Constructor Snowflakes(n As Ushort)
   With This
      .amount = n
      .w = scrw                       
      .h = scrh
      .img0 = Imagecreate(This.w, This.h, &hFF000000)
      .img1 = Imagecreate(This.w, This.h)
   End With
   pBuffer = New Snowflake[amount]
End Constructor

Destructor Snowflakes()
   Delete [] pBuffer
   pBuffer = 0
   Imagedestroy This.img1
   Imagedestroy This.img0
End Destructor


Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_HIGH_PRIORITY Or GFX_NO_SWITCH)

#Ifdef __Fb_win32__
   #Include "windows.bi"
   Dim As Integer iDW, iDH
   Screencontrol GET_DESKTOP_SIZE, iDW, iDH
   Dim tWorkingArea As RECT
   SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
   Screencontrol SET_WINDOW_POS, (iDW - scrw) \ 2, _
                                 ((tWorkingArea.Bottom - scrh) - (iDH - tWorkingArea.Bottom)) \ 2
#Endif
                              
Windowtitle "Simple Snowfall"
Dim As Snowflakes Snowfall
Dim As Ulong i, iFPS = 0, iFPS_current = 0
Dim As Double fTimer = Timer

Do
   Screenlock
   Snowfall.Draw
   Draw String(1, 1), iFPS_current & " fps", Rgb(&hF0, &h00, &h00)
   Screenunlock
   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   Sleep 15
Loop Until Inkey = Chr(27)
Can you tell me please what I did wrong respectively how it should be done?

Thx.
Edit1: updated .w / .h in constructor
Edit2: changed the construct a little bit
Edit3: this seems to work
Edit4: added correct delete for pBuffer
Edit5: final version
Last edited by UEZ on Dec 18, 2018 20:18, edited 6 times in total.
Imortis
Moderator
Posts: 1925
Joined: Jun 02, 2005 15:10
Location: USA
Contact:

Re: Using classes - my 1st attempt

Post by Imortis »

You create the image before you set Width and Height in the Reset sub. The images are all 0x0 pixels.
fxm
Moderator
Posts: 12131
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Using classes - my 1st attempt

Post by fxm »

and the graphics screen must be set before (before 'dim as Snowflake Snowflakes').
There is an infinite loop in the 'constructor Snowflake()', because 'New Snowflake' calls the constructor itself.
And .....
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

Ok, I added w / h in the constructor but how can I use the buffer within this class properly?
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

This updated version runs as expected but is this approach a good one?
fxm
Moderator
Posts: 12131
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Using classes - my 1st attempt

Post by fxm »

Code: Select all

   For i as UShort = 0 to amount - 1
      pBuffer[i].Init
   next 
is useless because 'Init()' is already called in the constructor.

Code: Select all

   Delete [] pBuffer
'Delete []', otherwise only the first element is destroyed.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

Merci fxm for your feedback. :-)

I updated the code with your suggestions and added additionally a fps counter.

Does the code work also on Linux?
badidea
Posts: 2591
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Using classes - my 1st attempt

Post by badidea »

UEZ wrote:Does the code work also on Linux?
Yes, with both freebasic 64 and 32 bit.
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

@badidea: thanks for testing.

Here the version with blur effect [x86 only]:

Code: Select all

'Snowfall v0.6 coded by UEZ Using classes (my 1st attempt^^)
#Include "fbgfx.bi"

Using FB

Declare Function _ASM_ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr 'function by Eukalyptus

Const scrw = 1200, scrh = 800

Function RandomRange(fStart As Single, fEnd As Single) As Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Type Snowflake
   Public:
      Declare Constructor()
      Declare Destructor()
      Declare Sub Init()
      Declare Sub Reset()
      Declare Sub update()
      As Ushort w, h
      As Single x, y, vx, vy, radius, Alpha
End Type

Sub Snowflake.init()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * (This.h - This.radius)
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.25, 0.95)
End Sub

Sub Snowflake.Reset()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * -This.radius
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.25, 0.95)
End Sub

Sub Snowflake.Update()
   This.x += This.vx
   This.y += This.vy
   If (This.y > This.h + This.radius) Or (This.x < -This.radius) Or (This.x > This.w) Then This.Reset()
End Sub

Constructor Snowflake()
   This.w = scrw
   This.h = scrh
   This.Init
End Constructor

Destructor Snowflake()
End Destructor

Type Snowflakes
      Declare Constructor(n As Ushort = 10000)
      Declare Destructor()
      Declare Sub Draw()
   Private:
      As Ushort w, h, amount      
      As Snowflake Ptr pBuffer 
      As fb.Image Ptr Img_Empty, Img_Snowfall, Img_Blur 
End Type

Sub Snowflakes.Draw()
   Put This.Img_Snowfall, (0, 0), This.Img_Empty, Pset
   For i As Ushort = 0 To This.amount - 1
      Circle This.Img_Snowfall, (pBuffer[i].x, pBuffer[i].y), pBuffer[i].radius, Rgba(255, 255, 255, 255 * pBuffer[i].Alpha),,,,F
      pBuffer[i].update
   Next
   This.Img_Blur = _ASM_ImageBlur(This.Img_Snowfall, 2)
   Put (0, 0), This.Img_Blur, Trans
   Imagedestroy This.Img_Blur
End Sub

Constructor Snowflakes(n As Ushort)
   amount = n
   w = scrw                       
   h = scrh
   Img_Empty = Imagecreate(This.w, This.h, 32)
   Img_Snowfall = Imagecreate(This.w, This.h, 32)
   pBuffer = New Snowflake[amount]
End Constructor

Destructor Snowflakes()
   Delete [] pBuffer
   pBuffer = 0
   Imagedestroy This.Img_Empty
   Imagedestroy This.Img_Snowfall
End Destructor


Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_HIGH_PRIORITY Or GFX_NO_SWITCH)

#Ifdef __Fb_win32__
   #Include "windows.bi"
   Dim As Integer iDW, iDH
   Screencontrol GET_DESKTOP_SIZE, iDW, iDH
   Dim tWorkingArea As RECT
   SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
   Screencontrol SET_WINDOW_POS, (iDW - scrw) \ 2, _
                                 ((tWorkingArea.Bottom - scrh) - (iDH - tWorkingArea.Bottom)) \ 2
#Endif
                              
Windowtitle "Simple Snowfall"
Dim As Snowflakes Snowfall
Dim As Ulong i, iFPS = 0, iFPS_current = 0
Dim As Double fTimer = Timer

Do
   Screenlock
   Snowfall.Draw
   Draw String(0, 0), iFPS_current & " fps", Rgb(&hFF, &h00, &h00)
   Screenunlock
   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   Sleep 1
Loop Until Inkey = Chr(27)

Function _ASM_ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr
   'By Eukalyptus 
   Dim As Integer iWidth, iHeight, iPX, iPitch, iPitchBlur 
   Dim As Any Ptr pData, pDataBlur, pDataTmp 
    
   If ImageInfo(pImage, iWidth, iHeight, iPX, iPitch, pData) <> 0 Then Return 0 
   If iPX <> 4 Then Return 0 
    
   If iRadius < 0 Then 
      iRadius = 0 
   ElseIf iRadius > 127 Then 
      iRadius = 127 
   EndIf 
    
   Dim As Any Ptr pImgBlur, pImgTmp 
   If iExpandEdge <> 0 Then 
      iWidth += iRadius * 2 
      iHeight += iRadius * 2 
   EndIf 
    
   pImgBlur = ImageCreate(iWidth, iHeight, 0, 32) 
   pImgTmp = ImageCreate(iWidth, iHeight, 0, 32) 
    
   ImageInfo(pImgBlur, , , , iPitchBlur, pDataBlur) 
   ImageInfo(pImgTmp, , , , , pDataTmp) 
   If pImgBlur = 0 Or pImgTmp = 0 Then 
      ImageDestroy(pImgBlur) 
      ImageDestroy(pImgTmp) 
      Return 0 
   EndIf 
    
   If iExpandEdge <> 0 Then 
      Put pImgBlur, (iRadius, iRadius), pImage, Alpha 
   Else 
      Put pImgBlur, (0, 0), pImage, Alpha 
   EndIf 
    

   Asm 
      mov ecx, [iWidth] 
      mov ebx, [iHeight] 
      mov edx, [iPitchBlur] 

      mov edi, [pDataTmp] 
      mov esi, [pDataBlur] 
       
      mov eax, [iRadius] 
      inc eax 
      push ebp 
      mov ebp, eax 
       
      sub esp, 64 

      mov [esp+8], ecx 
      mov [esp+12], ebx 
      mov [esp+16], edx 
      mov [esp+20], ebp 
      mov [esp+24], edi 
      mov [esp+32], edi 
      mov [esp+28], esi 
      mov [esp+36], esi 

      '       0   4   8   12  16       20  24     28     32      36 
      'esp = [X] [Y] [W] [H] [Stride] [R] [pDst] [pSrc] [pDstO] [pSrcO] 

      mov eax, 0x47000000 'ByteToFloat MSK 
      movd xmm7, eax 
      pshufd xmm7, xmm7, 0 

      ' #################################################### 
      ' # W-Loop 
      ' #################################################### 

      mov ebx, [esp+12] 
      mov [esp+4], ebx 
      _Blur_LoopW: 
         mov edi, [esp+24] 
         mov esi, [esp+28] 
         mov edx, [esp+16] 'Stride 
         add dword ptr[esp+24], 4 'next RowCol(Transform vertical<->horizontal) 
         add [esp+28], edx 'next Row 

         mov edx, [esp+12] 'Y-Stride 
         shl edx, 2 

         pxor xmm6, xmm6 'Reset In-Out 
         pxor xmm5, xmm5 'Reset Sum 
         /' 
         xmm7 = Msk 
         xmm6 = [AO][RO][GO][BO][AI][RI][GI][BI] 
         xmm5 = [AS][RS][GS][BS] 

         eax = (SumDiv) 
         ebx = (DivInc) 
         ecx = X 
         edx = Stride 
         esi = Src 
         edi = Dst 
         ebp = R 
         '/ 

         pxor xmm4, xmm4 'UnPack 

         mov eax, 0 'Reset SumDiv 
         mov ebx, 0 'Reset DivInc 

         ' ---------------------------------------------------- 
         ' | X-In += Next 
         ' ---------------------------------------------------- 
         mov ebp, 0 'Offset 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopX_In: 
            movd xmm0, [esi+ebp] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            paddw xmm6, xmm0 'IN+=Next 
            movdqa xmm0, xmm6 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            paddd xmm5, xmm0 'Stack += IN 

            add ebx, 1 'SumDivInc += 1 
            add eax, ebx 'SumDiv += Inc 

            add ebp, 4 
            sub ecx, 1 
            jg _Blur_LoopX_In 


         ' ---------------------------------------------------- 
         ' | XIn += Next / XIn -= Mid / XOut += Mid 
         ' ---------------------------------------------------- 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopX_InOut: 
            cvtsi2ss xmm3, eax 
            rcpss xmm3, xmm3 
            pshufd xmm3, xmm3, 0 'SumDiv 

            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi+ebp] 
            movd xmm1, [esi] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next] 
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next 
            psubw xmm6, xmm1 '(OUT-=Last) / IN-=Mid 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            sub ebx, 1 'SumDivInc += 1 
            add eax, ebx 'SumDiv += Inc 

            add esi, 4 
            add edi, edx 
            sub ecx, 1 
            jg _Blur_LoopX_InOut 


         cvtsi2ss xmm3, eax 
         rcpss xmm3, xmm3 
         pshufd xmm3, xmm3, 0 'SumDiv 

         mov ebx, ebp 
         neg ebx 'Last Index 


         ' ---------------------------------------------------- 
         ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last 
         ' ---------------------------------------------------- 
         mov ecx, [esp+8] 'iWidth 
         sub ecx, [esp+20] 
         sub ecx, [esp+20] 
         _Blur_LoopX: 
            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi+ebp] 
            movd xmm1, [esi] 
            movd xmm2, [esi+ebx] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last 
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next] 
            movlhps xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid] 
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next 
            psubw xmm6, xmm1 'OUT-=Last / IN-=Mid 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            add esi, 4 
            add edi, edx 
            sub ecx, 1 
            jg _Blur_LoopX 


         ' ---------------------------------------------------- 
         ' | XIn -= Mid / XOut += Mid / XOut -= Last 
         ' ---------------------------------------------------- 
         mov ebp, 0 'DivInc 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopX_Out: 
            cvtsi2ss xmm3, eax 
            rcpss xmm3, xmm3 
            pshufd xmm3, xmm3, 0 'SumDiv 

            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi] 
            movd xmm1, [esi+ebx] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last 
            movlhps xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid] 
            psubw xmm6, xmm0 'OUT-=Last / IN-=Mid 
            pslldq xmm0, 8 
            paddw xmm6, xmm0 'OUT+=Mid / (IN+=Next) 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            add ebp, 1 
            sub eax, ebp 

            add esi, 4 
            add edi, edx 
            sub ecx, 1 
            jg _Blur_LoopX_Out 

         sub dword ptr[esp+4], 1 
         jg _Blur_LoopW 



      ' #################################################### 
      ' # H-Loop 
      ' #################################################### 


      mov edi, [esp+36] 
      mov esi, [esp+32] 
      mov [esp+24], edi 
      mov [esp+28], esi 

      mov ebx, [esp+8] 
      mov [esp], ebx 
      _Blur_LoopH: 
         mov edi, [esp+24] 
         mov esi, [esp+28] 
         mov edx, [esp+12] 
         Shl edx, 2 
         Add dword ptr[esp+24], 4 'next Col 
         Add [esp+28], edx 'next ColRow 

         mov edx, [esp+16] 'Stride 

         pxor xmm6, xmm6 'Reset In-Out 
         pxor xmm5, xmm5 'Reset Sum 

         /' 
         xmm7 = Msk 
         xmm6 = [AO][RO][GO][BO][AI][RI][GI][BI] 
         xmm5 = [AS][RS][GS][BS] 

         eax = (SumDiv) 
         ebx = (DivInc) 
         ecx = X 
         edx = Stride 
         esi = Src 
         edi = Dst 
         ebp = R 
         '/ 

         pxor xmm4, xmm4 'UnPack 

         mov eax, 0 'Reset SumDiv 
         mov ebx, 0 'Reset DivInc 

         ' ---------------------------------------------------- 
         ' | X-In += Next 
         ' ---------------------------------------------------- 
         mov ebp, 0 'Offset 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopY_In: 
            movd xmm0, [esi+ebp] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            paddw xmm6, xmm0 'IN+=Next 
            movdqa xmm0, xmm6 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            paddd xmm5, xmm0 'Stack += IN 

            Add ebx, 1 'SumDivInc += 1 
            Add eax, ebx 'SumDiv += Inc 

            Add ebp, 4 
            Sub ecx, 1 
            jg _Blur_LoopY_In 


         ' ---------------------------------------------------- 
         ' | XIn += Next / XIn -= Mid / XOut += Mid 
         ' ---------------------------------------------------- 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopY_InOut: 
            cvtsi2ss xmm3, eax 
            rcpss xmm3, xmm3 
            pshufd xmm3, xmm3, 0 'SumDiv 

            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi+ebp] 
            movd xmm1, [esi] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next] 
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next 
            psubw xmm6, xmm1 '(OUT-=Last) / IN-=Mid 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            Sub ebx, 1 'SumDivInc += 1 
            Add eax, ebx 'SumDiv += Inc 

            Add esi, 4 
            Add edi, edx 
            Sub ecx, 1 
            jg _Blur_LoopY_InOut 


         cvtsi2ss xmm3, eax 
         rcpss xmm3, xmm3 
         pshufd xmm3, xmm3, 0 'SumDiv 

         mov ebx, ebp 
         neg ebx 'Last Index 


         ' ---------------------------------------------------- 
         ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last 
         ' ---------------------------------------------------- 
         mov ecx, [esp+12] 'iHeight 
         Sub ecx, [esp+20] 
         Sub ecx, [esp+20] 
         _Blur_LoopY: 
            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi+ebp] 
            movd xmm1, [esi] 
            movd xmm2, [esi+ebx] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last 
            movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next] 
            movlhps xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid] 
            paddw xmm6, xmm0 'OUT+=Mid / IN+=Next 
            psubw xmm6, xmm1 'OUT-=Last / IN-=Mid 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            Add esi, 4 
            Add edi, edx 
            Sub ecx, 1 
            jg _Blur_LoopY 


         ' ---------------------------------------------------- 
         ' | XIn -= Mid / XOut += Mid / XOut -= Last 
         ' ---------------------------------------------------- 
         mov ebp, 0 'DivInc 
         mov ecx, [esp+20] 'iR 
         _Blur_LoopY_Out: 
            cvtsi2ss xmm3, eax 
            rcpss xmm3, xmm3 
            pshufd xmm3, xmm3, 0 'SumDiv 

            movdqa xmm0, xmm5 
            paddd xmm0, xmm7 ' UByte -> Float 
            subps xmm0, xmm7 '/ 
            mulps xmm0, xmm3 
            addps xmm0, xmm7 ' Float -> UByte 
            psubd xmm0, xmm7 '/ 
            packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B] 
            packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB] 
            movd [edi], xmm0 

            movd xmm0, [esi] 
            movd xmm1, [esi+ebx] 
            punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid 
            punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last 
            movlhps xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid] 
            psubw xmm6, xmm0 'OUT-=Last / IN-=Mid 
            pslldq xmm0, 8 
            paddw xmm6, xmm0 'OUT+=Mid / (IN+=Next) 
            movdqa xmm1, xmm6 
            movdqa xmm0, xmm6 
            punpckhwd xmm1, xmm4 '[AO][RO][GO][BO] 
            punpcklwd xmm0, xmm4 '[AI][RI][GI][BI] 
            psubd xmm5, xmm1 'Stack -= OUT 
            paddd xmm5, xmm0 'Stack += IN 

            Add ebp, 1 
            Sub eax, ebp 

            Add esi, 4 
            Add edi, edx 
            Sub ecx, 1 
            jg _Blur_LoopY_Out 


         Sub dword Ptr[esp], 1 
         jg _Blur_LoopH 

      add esp, 64 
       
      pop ebp 
   End Asm 
    

   ImageDestroy(pImgTmp) 
   Return pImgBlur 
End Function 
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Using classes - my 1st attempt

Post by dodicat »

I just measured that blur function, it comes in at about 8 feet long, but it is blazingly fast.
The blur effect reminds me of staggering out of the boozer about this time of the night into a flurry, indeed it brings back memories.(The boozer in this village is now closed).
Thank you UEZ.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Using classes - my 1st attempt

Post by D.J.Peters »

Here are how to use the same Assembler code for x86 and x86_64.
I compile all my ASM stuff with: "fbc -w all -gen gcc -asm intel file.bas"

I changed only the LONG arguments to INTEGER so it becomes 32 or 64-bit.
And redefined only the register names e.g REG_SP becomes ESP or RSP ...
and used #define for the local var stuff e.g. mov reg,XOFF instead off mov reg,[esp+0] ...

Joshy

Code: Select all

'Snowfall v0.6 coded by UEZ Using classes (my 1st attempt^^)
#Include "fbgfx.bi"

Using FB

Declare Function _ASM_ImageBlur(pImage As Any Ptr, iRadius As integer, iExpandEdge As integer = 0) As Any Ptr 'function by Eukalyptus

Const scrw = 1200, scrh = 800

Function RandomRange(fStart As Single, fEnd As Single) As Single
   Return Rnd() * (fEnd - fStart) + fStart
End Function

Type Snowflake
   Public:
      Declare Constructor()
      Declare Destructor()
      Declare Sub Init()
      Declare Sub Reset()
      Declare Sub update()
      As Ushort w, h
      As Single x, y, vx, vy, radius, Alpha
End Type

Sub Snowflake.init()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * (This.h - This.radius)
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.25, 0.95)
End Sub

Sub Snowflake.Reset()
   This.radius = RandomRange(1, 3)
   This.x = Rnd() * (This.w - This.radius)
   This.y = Rnd() * -This.radius
   This.vx = RandomRange(-3, 3)
   This.vy = RandomRange(1, 4)
   This.Alpha = RandomRange(0.25, 0.95)
End Sub

Sub Snowflake.Update()
   This.x += This.vx
   This.y += This.vy
   If (This.y > This.h + This.radius) Or (This.x < -This.radius) Or (This.x > This.w) Then This.Reset()
End Sub

Constructor Snowflake()
   This.w = scrw
   This.h = scrh
   This.Init
End Constructor

Destructor Snowflake()
End Destructor

Type Snowflakes
  Declare Constructor(n As Ushort = 10000)
  Declare Destructor()
  Declare Sub Draw()
  Private:
  As integer w, h, amount     
  As Snowflake Ptr pBuffer
  As fb.Image Ptr Img_Empty, Img_Snowfall, Img_Blur
End Type

Sub Snowflakes.Draw()
  Put This.Img_Snowfall, (0, 0), This.Img_Empty, Pset
  For i As integer = 0 To This.amount - 1
    Circle This.Img_Snowfall, (pBuffer[i].x, pBuffer[i].y), pBuffer[i].radius, Rgba(255, 255, 255, 255 * pBuffer[i].Alpha),,,,F
    pBuffer[i].update
  Next
  This.Img_Blur = _ASM_ImageBlur(This.Img_Snowfall, 2)
  Put (0, 0), This.Img_Blur, Trans
   
  'Put (0, 0), This.Img_Snowfall, Trans
  Imagedestroy This.Img_Blur
End Sub

Constructor Snowflakes(n As Ushort)
   amount = n
   w = scrw                       
   h = scrh
   Img_Empty = Imagecreate(This.w, This.h, 32)
   Img_Snowfall = Imagecreate(This.w, This.h, 32)
   pBuffer = New Snowflake[amount]
End Constructor

Destructor Snowflakes()
   Delete [] pBuffer
   pBuffer = 0
   Imagedestroy This.Img_Empty
   Imagedestroy This.Img_Snowfall
End Destructor


Screenres (scrw, scrh, 32, 1, GFX_ALPHA_PRIMITIVES Or GFX_HIGH_PRIORITY Or GFX_NO_SWITCH)

'#Ifdef __Fb_win32__
'   #Include "windows.bi"
'   Dim As Integer iDW, iDH
'   Screencontrol GET_DESKTOP_SIZE, iDW, iDH
'   Dim tWorkingArea As RECT
'   SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
'   Screencontrol SET_WINDOW_POS, (iDW - scrw) \ 2, _
'                                 ((tWorkingArea.Bottom - scrh) - (iDH - tWorkingArea.Bottom)) \ 2
'#Endif
                             
Windowtitle "Simple Snowfall"
Dim As Snowflakes Snowfall
Dim As integer i, iFPS = 0, iFPS_current = 0
Dim As Double fTimer = Timer

Do
   Screenlock
   Snowfall.Draw
   Draw String(0, 0), iFPS_current & " fps", Rgb(&hFF, &h00, &h00)
   Screenunlock
   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
      iFPS = 0
      fTimer = Timer
   Else
      iFPS += 1
   Endif
   Sleep 10
Loop Until Inkey = Chr(27)

Function _ASM_ImageBlur(pImage As Any Ptr, iRadius As integer, iExpandEdge As integer = 0) As Any Ptr
   'By Eukalyptus
   Dim As Integer iWidth, iHeight, iPX, iPitch, iPitchBlur
   Dim As Any Ptr pData, pDataBlur, pDataTmp
   
   If ImageInfo(pImage, iWidth, iHeight, iPX, iPitch, pData) <> 0 Then Return 0
   If iPX <> 4 Then Return 0
   
   If iRadius < 0 Then
      iRadius = 0
   ElseIf iRadius > 127 Then
      iRadius = 127
   EndIf
   
   Dim As Any Ptr pImgBlur, pImgTmp
   If iExpandEdge <> 0 Then
      iWidth += iRadius * 2
      iHeight += iRadius * 2
   EndIf
   
   pImgBlur = ImageCreate(iWidth, iHeight, 0, 32)
   pImgTmp = ImageCreate(iWidth, iHeight, 0, 32)
   
   ImageInfo(pImgBlur, , , , iPitchBlur, pDataBlur)
   ImageInfo(pImgTmp, , , , , pDataTmp)
   If pImgBlur = 0 Orelse pImgTmp = 0 Then
      ImageDestroy(pImgBlur)
      ImageDestroy(pImgTmp)
      Return 0
   End If
   
   If iExpandEdge <> 0 Then
      Put pImgBlur, (iRadius, iRadius), pImage, Alpha
   Else
      Put pImgBlur, (0, 0), pImage, Alpha
   End If


  
  
#ifndef __FB_64BIT__

  #define REG_SIZE 4
  #define REG_ACCESS DWORD
  #define REG_AX eax
  #define REG_BX ebx
  #define REG_CX ecx
  #define REG_DX edx
  #define REG_DI edi
  #define REG_SI esi
  #define REG_SP esp
  #define REG_BP ebp

#else

  #define REG_SIZE 8
  #define REG_ACCESS QWORD
  #define REG_AX rax
  #define REG_BX rbx
  #define REG_CX rcx
  #define REG_DX rdx
  #define REG_DI rdi
  #define REG_SI rsi
  #define REG_SP rsp
  #define REG_BP rbp

#endif

  #define LOCAL_VAR_SPACE 16*REG_SIZE
  'esp/rsp = [X] [Y] [W] [H] [Stride] [R] [pDst] [pSrc] [pDstO] [pSrcO]
  
  #define X_OFF    [REG_SP]
  #define Y_OFF    [REG_SP+1*REG_SIZE]
  #define W_OFF    [REG_SP+2*REG_SIZE]
  #define H_OFF    [REG_SP+3*REG_SIZE]
  #define S_OFF    [REG_SP+4*REG_SIZE]
  #define R_OFF    [REG_SP+5*REG_SIZE]
  #define DST_OFF  [REG_SP+6*REG_SIZE]
  #define SRC_OFF  [REG_SP+7*REG_SIZE]
  #define DSTO_OFF [REG_SP+8*REG_SIZE]
  #define SRCO_OFF [REG_SP+9*REG_SIZE]
  
  
  Asm
  mov REG_CX, [iWidth]
  mov REG_BX, [iHeight]
  mov REG_DX, [iPitchBlur]
  mov REG_DI, [pDataTmp]
  mov REG_SI, [pDataBlur]
       
  mov REG_AX, [iRadius]
  inc REG_AX
  
  push REG_BP
  mov REG_BP, REG_AX
  sub REG_SP, LOCAL_VAR_SPACE
 
  mov W_OFF,    REG_CX
  mov H_OFF,    REG_BX
  mov S_OFF,    REG_DX
  mov R_OFF,    REG_BP
  mov DST_OFF,  REG_DI
  mov DSTO_OFF, REG_DI
  mov SRC_OFF,  REG_SI
  mov SRCO_OFF, REG_SI  

  mov REG_AX, 0x47000000 'ByteToFloat MSK
  movd xmm7, REG_AX
  pshufd xmm7, xmm7, 0

  ' ####################################################
  ' # W-Loop
  ' ####################################################
   mov REG_BX, H_OFF
   mov Y_OFF, REG_BX

_Blur_LoopW:
  mov REG_DI, DST_OFF
  mov REG_SI, SRC_OFF
  mov REG_DX, S_OFF 'Stride
  add REG_ACCESS ptr DST_OFF, 4 'next RowCol(Transform vertical<->horizontal)
  add SRC_OFF, REG_DX 'next Row

  mov REG_DX, H_OFF 'Y-Stride
  shl REG_DX, 2

  pxor xmm6, xmm6 'Reset In-Out
  pxor xmm5, xmm5 'Reset Sum
  pxor xmm4, xmm4 'UnPack

  mov REG_AX, 0 'Reset SumDiv
  mov REG_BX, 0 'Reset DivInc
  ' ----------------------------------------------------
  ' | X-In += Next
  ' ----------------------------------------------------
  mov REG_BP, 0 'Offset
  mov REG_CX, R_OFF 'iR
  _Blur_LoopX_In:
    movd      xmm0, [REG_SI+REG_BP]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    paddw     xmm6, xmm0 'IN+=Next
    movdqa    xmm0, xmm6
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    paddd     xmm5, xmm0 'Stack += IN

    add REG_BX, 1 'SumDivInc += 1
    add REG_AX, REG_BX 'SumDiv += Inc
    add REG_BP, 4
    sub REG_CX, 1
  jg _Blur_LoopX_In
  ' ----------------------------------------------------
  ' | XIn += Next / XIn -= Mid / XOut += Mid
  ' ----------------------------------------------------
  mov REG_CX, R_OFF 'iR
  _Blur_LoopX_InOut:
    cvtsi2ss  xmm3, REG_AX
    rcpss     xmm3, xmm3
    pshufd    xmm3, xmm3, 0 'SumDiv
    movdqa    xmm0, xmm5
    paddd     xmm0, xmm7 ' UByte -> Float
    subps     xmm0, xmm7 ' /
    mulps     xmm0, xmm3
    addps     xmm0, xmm7 ' Float -> UByte
    psubd     xmm0, xmm7 ' /
    packssdw  xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb  xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd      [REG_DI], xmm0
    movd      xmm0, [REG_SI+REG_BP]
    movd      xmm1, [REG_SI]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    movlhps   xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
    paddw     xmm6, xmm0 'OUT+=Mid / IN+=Next
    psubw     xmm6, xmm1 '(OUT-=Last) / IN-=Mid
    movdqa    xmm1, xmm6
    movdqa    xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd     xmm5, xmm1 'Stack -= OUT
    paddd     xmm5, xmm0 'Stack += IN
    sub       REG_BX, 1 'SumDivInc += 1
    add       REG_AX, REG_BX 'SumDiv += Inc
    add       REG_SI, 4
    add       REG_DI, REG_DX
    sub       REG_CX, 1
  jg _Blur_LoopX_InOut

  cvtsi2ss  xmm3, REG_AX
  rcpss     xmm3, xmm3
  pshufd    xmm3, xmm3, 0 'SumDiv
  mov       REG_BX, REG_BP
  neg       REG_BX 'Last Index
  ' ----------------------------------------------------
  ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last
  ' ----------------------------------------------------
  mov REG_CX, W_OFF 'iWidth
  sub REG_CX, R_OFF
  sub REG_CX, R_OFF
  _Blur_LoopX:
    movdqa    xmm0, xmm5
    paddd     xmm0, xmm7 ' UByte -> Float
    subps     xmm0, xmm7 ' /
    mulps     xmm0, xmm3
    addps     xmm0, xmm7 ' Float -> UByte
    psubd     xmm0, xmm7 ' /
    packssdw  xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb  xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd      [REG_DI], xmm0
    movd xmm0,[REG_SI+REG_BP]
    movd xmm1,[REG_SI]
    movd xmm2,[REG_SI+REG_BX]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
    movlhps   xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
    movlhps   xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid]
    paddw     xmm6, xmm0 'OUT+=Mid / IN+=Next
    psubw     xmm6, xmm1 'OUT-=Last / IN-=Mid
    movdqa    xmm1, xmm6
    movdqa    xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd     xmm5, xmm1 'Stack -= OUT
    paddd     xmm5, xmm0 'Stack += IN
    add       REG_SI, 4
    add       REG_DI, REG_DX
    sub       REG_CX, 1
  jg _Blur_LoopX
  ' ----------------------------------------------------
  ' | XIn -= Mid / XOut += Mid / XOut -= Last
  ' ----------------------------------------------------
  mov REG_BP, 0 'DivInc
  mov REG_CX, R_OFF 'iR
  _Blur_LoopX_Out:
    cvtsi2ss  xmm3, REG_AX
    rcpss     xmm3, xmm3
    pshufd    xmm3, xmm3, 0 'SumDiv
    movdqa    xmm0, xmm5
    paddd     xmm0, xmm7 ' UByte -> Float
    subps     xmm0, xmm7 ' /
    mulps     xmm0, xmm3
    addps     xmm0, xmm7 ' Float -> UByte
    psubd     xmm0, xmm7 ' /
    packssdw  xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb  xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd      [REG_DI], xmm0
    movd      xmm0, [REG_SI]
    movd      xmm1, [REG_SI+REG_BX]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
    movlhps   xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid]
    psubw     xmm6, xmm0 'OUT-=Last / IN-=Mid
    pslldq    xmm0, 8
    paddw     xmm6, xmm0 'OUT+=Mid / (IN+=Next)
    movdqa    xmm1, xmm6
    movdqa    xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd     xmm5, xmm1 'Stack -= OUT
    paddd     xmm5, xmm0 'Stack += IN
    add       REG_BP, 1
    sub       REG_AX, REG_BP
    add       REG_SI, 4
    add       REG_DI, REG_DX
    sub       REG_CX, 1
  jg _Blur_LoopX_Out

  sub REG_ACCESS ptr Y_OFF, 1
jg _Blur_LoopW


  ' ####################################################
  ' # H-Loop
  ' ####################################################
  mov REG_DI, SRCO_OFF
  mov REG_SI, DSTO_OFF
  mov DST_OFF, REG_DI
  mov SRC_OFF, REG_SI

  mov REG_BX, W_OFF
  mov X_OFF, REG_BX
_Blur_LoopH:
  mov REG_DI, DST_OFF
  mov REG_SI, SRC_OFF
  mov REG_DX, H_OFF
  Shl REG_DX, 2
  Add REG_ACCESS ptr DST_OFF, 4 'next Col
  Add SRC_OFF, REG_DX 'next ColRow
  mov REG_DX, S_OFF 'Stride
  pxor xmm6, xmm6 'Reset In-Out
  pxor xmm5, xmm5 'Reset Sum
  pxor xmm4, xmm4 'UnPack
  mov REG_AX, 0 'Reset SumDiv
  mov REG_BX, 0 'Reset DivInc
  ' ----------------------------------------------------
  ' | X-In += Next
  ' ----------------------------------------------------
  mov REG_BP, 0 'Offset
  mov REG_CX, R_OFF 'iR
  
  _Blur_LoopY_In:
    movd xmm0, [REG_SI+REG_BP]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    paddw xmm6, xmm0 'IN+=Next
    movdqa xmm0, xmm6
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    paddd xmm5, xmm0 'Stack += IN
    Add REG_BX, 1 'SumDivInc += 1
    Add REG_AX, REG_BX 'SumDiv += Inc
    Add REG_BP, 4
    Sub REG_CX, 1
  jg _Blur_LoopY_In

  ' ----------------------------------------------------
  ' | XIn += Next / XIn -= Mid / XOut += Mid
  ' ----------------------------------------------------
  mov REG_CX, R_OFF 'iR
  _Blur_LoopY_InOut:
    cvtsi2ss xmm3, REG_AX
    rcpss xmm3, xmm3
    pshufd xmm3, xmm3, 0 'SumDiv
    movdqa xmm0, xmm5
    paddd xmm0, xmm7 ' UByte -> Float
    subps xmm0, xmm7 '/
    mulps xmm0, xmm3
    addps xmm0, xmm7 ' Float -> UByte
    psubd xmm0, xmm7 '/
    packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd [REG_DI], xmm0
    movd xmm0, [REG_SI+REG_BP]
    movd xmm1, [REG_SI]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
    paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
    psubw xmm6, xmm1 '(OUT-=Last) / IN-=Mid
    movdqa xmm1, xmm6
    movdqa xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd xmm5, xmm1 'Stack -= OUT
    paddd xmm5, xmm0 'Stack += IN
    Sub REG_BX, 1 'SumDivInc += 1
    Add REG_AX, REG_BX 'SumDiv += Inc
    Add REG_SI, 4
    Add REG_DI, REG_DX
    Sub REG_CX, 1
  jg _Blur_LoopY_InOut

  cvtsi2ss xmm3, REG_AX
  rcpss xmm3, xmm3
  pshufd xmm3, xmm3, 0 'SumDiv
  mov REG_BX, REG_BP
  neg REG_BX 'Last Index
  ' ----------------------------------------------------
  ' | XIn += Next / XIn -= Mid / XOut += Mid / XOut -= Last
  ' ----------------------------------------------------
  mov REG_CX, H_OFF 'iHeight
  Sub REG_CX, R_OFF
  Sub REG_CX, R_OFF
  _Blur_LoopY:
    movdqa xmm0, xmm5
    paddd xmm0, xmm7 ' UByte -> Float
    subps xmm0, xmm7 '/
    mulps xmm0, xmm3
    addps xmm0, xmm7 ' Float -> UByte
    psubd xmm0, xmm7 '/
    packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd [REG_DI], xmm0
    movd xmm0, [REG_SI+REG_BP]
    movd xmm1, [REG_SI]
    movd xmm2, [REG_SI+REG_BX]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][An][Rn][Gn][Bn] Next
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    punpcklbw xmm2, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
    movlhps xmm0, xmm1 '[Am][Rm][Gm][Bm][An][Rn][Gn][Bn] = [Mid][Next]
    movlhps xmm1, xmm2 '[Al][Rl][Gl][Bl][Ao][Ro][Go][Bo] = [Last][Mid]
    paddw xmm6, xmm0 'OUT+=Mid / IN+=Next
    psubw xmm6, xmm1 'OUT-=Last / IN-=Mid
    movdqa xmm1, xmm6
    movdqa xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd xmm5, xmm1 'Stack -= OUT
    paddd xmm5, xmm0 'Stack += IN
    
    Add REG_SI, 4
    Add REG_DI, REG_DX
    Sub REG_CX, 1
  jg _Blur_LoopY
  ' ----------------------------------------------------
  ' | XIn -= Mid / XOut += Mid / XOut -= Last
  ' ----------------------------------------------------
  mov REG_BP, 0 'DivInc
  mov REG_CX, R_OFF 'iR
  _Blur_LoopY_Out:
    cvtsi2ss xmm3, REG_AX
    rcpss xmm3, xmm3
    pshufd xmm3, xmm3, 0 'SumDiv
    
    movdqa xmm0, xmm5
    paddd xmm0, xmm7 ' UByte -> Float
    subps xmm0, xmm7 '/
    mulps xmm0, xmm3
    addps xmm0, xmm7 ' Float -> UByte
    psubd xmm0, xmm7 '/
    packssdw xmm0, xmm0 '[A][R][G][B][A][R][G][B]
    packuswb xmm0, xmm0 '[ARGB][ARGB][ARGB][ARGB]
    movd [REG_DI], xmm0
    
    movd xmm0, [REG_SI]
    movd xmm1, [REG_SI+REG_BX]
    punpcklbw xmm0, xmm4 '[ ][ ][ ][ ][Am][Rm][Gm][Bm] Mid
    punpcklbw xmm1, xmm4 '[ ][ ][ ][ ][Al][Rl][Gl][Bl] Last
    movlhps xmm0, xmm1 '[Al][Rl][Gl][Bl][Am][Rm][Gm][Bm] = [Last][Mid]
    psubw xmm6, xmm0 'OUT-=Last / IN-=Mid
    pslldq xmm0, 8
    paddw xmm6, xmm0 'OUT+=Mid / (IN+=Next)
    movdqa xmm1, xmm6
    movdqa xmm0, xmm6
    punpckhwd xmm1, xmm4 '[AO][RO][GO][BO]
    punpcklwd xmm0, xmm4 '[AI][RI][GI][BI]
    psubd xmm5, xmm1 'Stack -= OUT
    paddd xmm5, xmm0 'Stack += IN
    
    Add REG_BP, 1
    Sub REG_AX, REG_BP
    
    Add REG_SI, 4
    Add REG_DI, REG_DX
    Sub REG_CX, 1
  jg _Blur_LoopY_Out

  Sub REG_ACCESS Ptr X_OFF, 1
jg _Blur_LoopH

  add REG_SP, LOCAL_VAR_SPACE
  pop REG_BP

  End Asm
  ImageDestroy(pImgTmp)
  Return pImgBlur
End Function

D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Using classes - my 1st attempt

Post by D.J.Peters »

One short note:

Instead of drawing 10,000 "slow" filled circles as flakes every frame
you can blit the flakes as small images (is faster) and then blur the result (if needed)

Of course you don't need to allocate 10,000 images for the flakes !

As example I allocate 9 flake images from 1x1 - 9x9 pixels (radius 1-9) this images are used by the 10,000 flakes depended of it's radius.

With other words I use the integer radius of a flake as index in the array of flake images.

By the way here in Germany no chance ATM to get a white Christmas
I like it if tiny kids see and eat the first time snow and all the blinking lights. :-)

EDIT: added blurring in BASIC can you detect the trick I have done ?

Joshy

Code: Select all

#define RND2 (rnd-rnd)

type tVector
  as single x,y
end type  

type tFlake
  declare constructor(iCanvasWidth as integer, iCanvasHeight as integer)
  declare sub Update
  as tVector p ' position
  as tVector v ' velocity
  as integer r ' radius 1-10
  as integer w ' canvas width
  as integer h ' canvas height
end type
constructor tFlake(iCanvasWidth as integer, iCanvasHeight as integer)
  w   = iCanvasWidth-1
  h   = iCanvasHeight-1
  r   = 1+rnd*9
  p.x = RND*w
  p.y = RND*-h
  while abs(v.x)<0.1 : v.x=RND2*0.3 : wend
  while abs(v.y)<1 : v.y=RND*3  : wend
end constructor
sub tFlake.Update
  p.x += v.x
  if p.x + r < 0 then
    p.x += w+r
  elseif p.x - r > w then
    p.x -= w+r
  end if  
  p.y+=v.y
  if p.y - r > h then 
    r = 1+rnd*9
    p.y =-r
  end if  
end sub

type tSnow
  declare destructor
  declare constructor(iCanvasWidth as integer, iCanvasHeight as integer, iNumFlakes as integer=5000)
  declare sub draw
  as tFlake ptr ptr f ' flakes
  as integer        n ' number of flakes
  as any ptr ptr    p ' 10 pictures radius 1-10
end type
destructor tSnow
  if f<>0 then
    for i as integer = 0 to n-1
      if f[i] then delete f[i]
    next
    delete f
  end if
end destructor
constructor tSnow(iCanvasWidth as integer, iCanvasHeight as integer, iNumFlakes as integer)
  if iNumFlakes<1 then iNumFlakes=1
  n = iNumFlakes
  f = new tFlake ptr [n]
  for i as integer=0 to n-1 
    f[i] = new tFlake(iCanvasWidth, iCanvasHeight)
  next
  p = new any ptr [10]
  for i as integer = 0 to 9
    p[i]=imagecreate(i+1,i+1) 
    if i=0 then
      pset p[i],(0,0),&HFFFFFFFF
    elseif i=1 then
      pset p[i],(0,0),&HFFFFFFFF
      pset p[i],(1,1),&HFFFFFFFF
      pset p[i],(1,0),&HFFAAAAAA
      pset p[i],(0,1),&HFFAAAAAA
    else
      line p[i],(i\2-1,i\2-1)-(i\2+1,i\2+1),&HFFAAAAAA,B
      line p[i],(0,0)-(i,i),&HFFAAAAAA
      line p[i],(0,i)-(i,0),&HFFAAAAAA
      line p[i],(i\2,0)-(i\2,i),&HFFFFFFFF
      line p[i],(0,i\2)-(i,i\2),&HFFFFFFFF
    end if
  next  
end constructor
sub tSnow.draw
  dim as single x,y
  dim as integer r
  dim as any ptr picture
  for i as integer=0 to n-1
    f[i]->Update()
    r = f[i]->r : picture = p[r-1] : r shr=1
    x=f[i]->p.x-r
    y=f[i]->p.y-r
    put (x,y),picture,TRANS
  next  
end sub
'
' main
'
dim as boolean bFullScreen = false
dim as integer scr_w,scr_h,iPitch,iPages=1

screeninfo scr_w,scr_h

if bFullScreen = false then scr_w*=0.75 : scr_h*=0.75

screenres scr_w,scr_h,32,iPages,iif(bFullScreen,1,0)
if iPages>1 then screenset 1,0

screeninfo ,,,,iPitch

dim as tSnow snow = tSnow(scr_w,scr_h)
dim as ubyte ptr row0,row1,row2,p0,p1,p2
dim as long  c
dim as integer frames,fps=60
dim as double tNow,tLast=Timer()
while inkey()=""
  if iPages<2 then screenlock 
  
  ' a kind of cls 
  line (0,0)-step(scr_w-1,scr_h-1),0,BF
  ' sing "let it snow let it snow ..."
  snow.draw()
  
  ' blur the result
  row0=Screenptr()
  row1=row0+iPitch
  row2=row1+iPitch
  for y as integer=0 to scr_h-3
    p0=row0 : p1=row1 : p2=row2
    for x as integer=0 to scr_w-3
      c =p0[0]+p0[4]+p0[8]
      c+=p1[0]+p1[4]+p1[8]
      c+=p2[0]+p2[4]+p2[8]
      c\=9 
      p0[0]=c:p0[1]=c:p0[2]=c
      p0+=4 : p1+=4 : p2+=4
    next
    row0=row1 : row1=row2 : row2+=iPitch
  next 
  if iPages<2 then
    screenunlock 
    sleep 8
  else  
    flip
  end if  
wend
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

dodicat wrote:I just measured that blur function, it comes in at about 8 feet long, but it is blazingly fast.
The blur effect reminds me of staggering out of the boozer about this time of the night into a flurry, indeed it brings back memories.(The boozer in this village is now closed).
Thank you UEZ.
Indeed, long but faaaaast. ;-)

Thank you for your feedback. :-)
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Using classes - my 1st attempt

Post by UEZ »

@D.J.Peters: thank you for your modification of the ASM blur function to run it also using x64! Well done.
By the way here in Germany no chance ATM to get a white Christmas
I like it if tiny kids see and eat the first time snow and all the blinking lights. :-)
Yes, especially here around Frankfurt a.M. no snow and too hot for winter session.
EDIT: added blurring in BASIC can you detect the trick I have done ?
At the first look I would assume that you have interpolate the colors to make the contour look blurry. But I will have a closer look today in the evening.
Instead of drawing 10,000 "slow" filled circles as flakes every frame
you can blit the flakes as small images (is faster) and then blur the result (if needed)
My purpose was to learn and understand classes. This wasn't my first time coding a snowfall - I did it already in the past with AutoIt using pre-calculated images which will be blitted to the screen. If you are interested then have a look here: GDI+ Snowfall

Thanks for your feedback and suggestion. ^^
Post Reply