Simple Flame Simulation build 2018-01-22 [Windows and 32-bit only]

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Simple Flame Simulation build 2018-01-22 [Windows and 32-bit only]

Post by UEZ »

I converted one of my AutoIt scripts to FB for learning purposes. ^^

As I've embedded one image, the source code is too large to post it here in better quality. For a better image quality visit here: https://pastebin.com/GGrEdPWR

Probably the difference cannot be seen...

Code: Select all

'coded by UEZ build 2018-01-22
'thanks to Eukalyptus for the ASM Blur function and the procedural generated AU3 logo
'32-bit only!

#Define WIN_INCLUDEALL
#Include "fbgfx.bi"
#Include "windows.bi"
#Include "win/gdiplus.bi"

Using FB
Using GDIPLUS

Declare Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
Declare function ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr
Declare Function _GDIPlus_Startup() As Byte
Declare Sub _GDIPlus_Shutdown()
Declare Function _GDIPlus_BitmapCreateFromMemory(aBinImage() As UByte, bBitmap_GDI As Bool = FALSE) As Any Ptr
Declare Function Convert2FBImage(aMemGDIpBitmap() as UByte) as any Ptr

'Generated by *FB File2Bas Code Generator v0.50 build 2017-03-15 beta*
Dim Shared As UByte __Logo_398x3974bitpng(0 To ...) = _
_
	{&hFF, &hD8, &hFF, &hE0, &h00, &h10, &h4A, &h46, &h49, &h46, &h00, &h01, &h01, &h01, &h00, &h48, &h00, &h48, &h00, &h00, &hFF, &hDB, &h00, &h43, &h00, &hFF, &hB7, &hC8, &hE9, &hC8, &hA7, &hFF, &hE9, &hD9, &hE9, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hDB, &h00, &h43, &h01, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hFF, &hC2, &h00, &h11, &h08, &h01, &h8B, &h01, &h8C, &h03, &h01, &h22, &h00, &h02, &h11, &h01, &h03, &h11, &h01, &hFF, &hC4, &h00, &h16, &h00, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h02, &hFF, &hC4, &h00, &h14, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hFF, &hDA, &h00, &h0C, &h03, &h01, &h00, &h02, &h10, &h03, &h10, &h00, &h00, &h01, &hC8, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h6D, &h25, &h04, &hA2, &h67, &h63, &h0B, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hA3, &h2D, &h8C, &hDA, &h00, &h00, &h04, &hA2, &h4D, &h0C, &h37, &h0C, &hAC, &h00, &h6E, &h50, &h00, &h00, &h01, &h28, &hC2, &hC0, &h00, &h00, &h00, &h01, &hA3, &h3A, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h32, &hD0, &h01, &h60, &hA8, &h2A, &h0B, &h28, &h80, &h63, &h78, &h00, &h00, &h00, &h0B, &hA0, &h00, &h00, &h10, &hA9, &h0D, &h30, &h34, &hC8, &hD5, &hC0, &hDB, &h03, &h6C, &hD2, &h80, &h00, &h00, &h00, &h52, &h28, &h02, &h01, &h9D, &h64, &h80, &h00, &h05, &h68, &h00, &h01, &h0B, &h24, &h2C, &h00, &h00, &h00, &h00, &h00, &h58, &h36, &hC6, &h8A, &h00, &h00, &h28, &h8A, &h25, &h40, &h06, &h37, &h80, &h00, &h16, &h6C, &h00, &h01, &h92, &hE4, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hAC, &h8D, &hA5, &h00, &h00, &h00, &h04, &h24, &h00, &h06, &h8A, &h00, &h06, &h44, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h06, &hB2, &h36, &h94, &h00, &h02, &h42, &hE4, &h00, &h01, &hB9, &h40, &h00, &h99, &h00, &h00, &h00, &h00, &h15, &hA0, &h00, &h33, &h37, &h92, &h00, &h00, &h00, &h01, &hBC, &h53, &h40, &h03, &h33, &h78, &h00, &h00, &h53, &h40, &h01, &h9B, &h90, &h00, &h00, &h00, &h01, &hB0, &h00, &h00, &h03, &h0D, &h64, &h00, &h00, &h00, &h03, &h57, &h3A, &h00, &h67, &h43, &h00, &h01, &hAC, &hEC, &h00, &h0C, &hC0, &h00, &h00, &h00, &h14, &hB4, &h00, &h00, &h00, &h19, &hD0, &hC0, &h00, &h00, &h00, &h1B, &hC6, &h8A, &h00, &h33, &h35, &h90, &h0B, &hAC, &hE8, &h01, &h2E, _
	 &h48, &h00, &h00, &h00, &h06, &hE5, &h00, &h01, &h19, &h36, &hCE, &h80, &h00, &h99, &hDE, &h48, &h00, &h00, &h00, &h0D, &h80, &h09, &h9D, &hE0, &h03, &h56, &h50, &h06, &h75, &h80, &h00, &h00, &h01, &h66, &hC0, &h00, &h19, &h10, &h1A, &hC8, &hDA, &h50, &h00, &h30, &hDE, &h00, &h00, &h00, &h0D, &h59, &h40, &h18, &hDE, &h48, &h0D, &h59, &h40, &h18, &hDE, &h00, &h00, &h00, &h68, &hA0, &h00, &h41, &h90, &h00, &h06, &hF1, &h4D, &h00, &h04, &hA3, &h0B, &h00, &h00, &h02, &hEB, &h3A, &h00, &h67, &h59, &h20, &h35, &h65, &h00, &h63, &h78, &h00, &h00, &h0B, &hA4, &h2A, &h50, &h06, &h50, &h14, &h8A, &h22, &h88, &hA2, &hDC, &hE8, &h00, &h06, &h37, &h0C, &h80, &h00, &h2E, &hA5, &h00, &h67, &h58, &h00, &hBA, &hCD, &h2A, &h0B, &h8D, &h42, &h00, &h06, &hA5, &h00, &h00, &h64, &h02, &hE9, &h0A, &h82, &hA0, &hA9, &h40, &h00, &h00, &h0C, &hCD, &hE0, &h00, &h0D, &h59, &h40, &h18, &hDE, &h00, &h1A, &hCE, &h80, &h12, &h8C, &h81, &h66, &h8B, &h00, &h01, &h04, &h06, &h80, &h00, &h16, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hC5, &h30, &hB0, &h14, &hD0, &h00, &h99, &hB0, &h01, &h65, &h28, &h00, &hCB, &h59, &h00, &h00, &h00, &h00, &hA8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0B, &h01, &hAC, &hEC, &h00, &h43, &h20, &h00, &h0D, &h25, &h00, &h67, &h43, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h4B, &h40, &h06, &h6E, &h40, &h00, &h01, &hAC, &hD2, &h80, &h09, &h35, &h90, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1A, &h94, &h58, &h2A, &h09, &h00, &h00, &h00, &h03, &h4C, &hE8, &h00, &h0C, &hB5, &h90, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h54, &h00, &h06, &h6C, &h00, &h00, &h00, &h00, &h58, &h35, &h73, &h4A, &h80, &h09, &h35, &h08, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1A, &h00, &h00, &h4B, &h90, &h00, &h00, &h00, &h00, &h00, &h58, &h35, &h73, &h4A, &h00, &h24, &hD0, &hC3, &h50, &h8B, &h00, &h00, &h00, &h01, &h48, &hD0, &h00, &h00, &h11, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hD3, &h34, &hD2, &h50, &h00, &h12, &h88, &hA3, &h2D, &h0C, &hB5, &h00, &h00, &h00, &h00, &h12, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h05, &h83, &h4C, &hD2, &hD8, &h2A, &h0A, &h82, &hA0, &hA8, &h2A, &h0A, &h82, &hA4, &h2A, &h42, &hC0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hA8, &h34, &hC8, &hD3, &h23, &h4C, &h8D, &h48, &h2C, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hFF, &hC4, &h00, &h1D, &h10, &h00, &h02, &h03, &h00, &h02, &h03, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h50, &h11, &h20, &h60, &h00, &h30, &h70, &h80, &hA0, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h05, &h02, &h51, &h14, &h8C, &h54, &h72, &h3A, &h61, &h2C, &h61, &h63, &hDA, &h31, &hA3, &h19, &hD3, &h61, &hE0, &hC1, &h52, &hD8, &h54, &hAD, &h19, &hC0, &hC8, &h32, &h0C, &h83, &h21, &hF0, &hA9, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, _
	 &h01, &h03, &h01, &h01, &h3F, &h01, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h02, &h01, &h01, &h3F, &h01, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h10, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &hB0, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h06, &h3F, &h02, &h1C, &h4F, &hFF, &hC4, &h00, &h1E, &h10, &h00, &h02, &h02, &h03, &h01, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h11, &h00, &h20, &h30, &h31, &h40, &h10, &h50, &h21, &h60, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h3F, &h21, &hF8, &hEB, &hC2, &h13, &hF2, &h21, &hF3, &h40, &h60, &h23, &h95, &h7A, &h21, &h64, &h22, &h1E, &h11, &hE2, &h23, &hE1, &h14, &h54, &h19, &h0E, &h65, &h17, &h29, &h81, &hBC, &hA7, &h28, &h1F, &h18, &hEF, &h10, &h0E, &h6B, &h23, &h8E, &h3E, &h93, &hBC, &h20, &h62, &h71, &hE0, &h71, &hC7, &hC8, &h70, &h01, &h81, &hC7, &h9D, &hF1, &h1D, &hDC, &h0C, &h0F, &h8C, &h1E, &h60, &h2E, &h4F, &h30, &h39, &h8D, &h80, &h77, &h27, &hA4, &h1C, &h66, &hE3, &hF2, &hC4, &hF5, &h83, &h84, &h9B, &h85, &h89, &hED, &h16, &h71, &hE5, &h27, &h28, &h14, &h50, &h85, &h90, &h58, &hF5, &h00, &hB9, &h0B, &h20, &hE2, &h39, &h00, &h7C, &hA3, &h80, &h39, &h75, &h84, &h8C, &h83, &h18, &hD5, &h4E, &h40, &h31, &h91, &hC2, &h77, &hCA, &h06, &h53, &hC8, &h0D, &hD4, &hEB, &h88, &h9B, &h9F, &hDC, &h63, &h75, &h3A, &hE4, &h07, &hE6, &h01, &h72, &h3A, &h07, &h78, &h80, &hB9, &hF4, &h5C, &h85, &h88, &h6A, &hA7, &hD1, &hAC, &hC0, &h3B, &h9C, &h7B, &hCE, &h3B, &hF4, &h6B, &h36, &hAC, &h6C, &h2E, &h46, &h61, &hDF, &hA3, &h59, &h40, &hCC, &h2E, &h46, &h51, &hF4, &h6B, &h20, &h17, &h38, &h47, &h18, &hEF, &hD1, &hC4, &h4F, &hA8, &hC4, &h62, &h31, &h18, &h8C, &h46, &h23, &h11, &hB9, &hC8, &h3E, &h8A, &h9D, &hD8, &h7E, &h61, &h03, &h80, &h8B, &h0D, &h54, &hFA, &h2A, &h6A, &h05, &hCF, &h83, &hF7, &h9C, &h60, &h15, &h34, &h02, &hE7, &h94, &hFE, &hE1, &h3C, &h67, &hD1, &hC8, &h7D, &h15, &h35, &h15, &h39, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1C, &h71, &hC7, &h1F, &hA2, &hA6, &hA2, &hA7, &hE1, &h0F, &hA4, &h2A, &h6E, &h2A, &h7E, &h00, &hE3, &h3F, &h10, &hE1, &h16, &h3D, &hA3, &h80, &h7C, &h10, &h2C, &h7E, &h58, &h16, &h39, &h45, &hC8, &hE7, &h02, &hC7, &h38, &h37, &h5C, &h8A, &hE7, &h84, &h1C, &h0B, &h81, &h45, &hD4, &hF0, &hA8, &hB1, &hA8, &hBE, &h42, &h8A, &h28, &hA2, &h8A, &h2C, &h6F, &hA1, &hFD, &h47, &hC8, &hE3, &hEF, &h71, &hE7, &h71, &hFC, &h47, &h1C, &h76, &h71, &hC7, &h1F, &hF0, &hFF, &h00, &hFF, &hDA, &h00, &h0C, &h03, &h01, &h00, &h02, &h00, &h03, &h00, &h00, &h00, &h10, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &h0C, &hB1, &hC7, &h08, &h00, &h00, &h00, &h00, &h00, &h00, &h21, &h4B, &h0C, &hF3, &hC7, &h0C, &h30, &h00, &h2C, &hF3, &hCF, &h3C, &hB0, &h00, &h00, &h00, &h00, &h00, &hE2, &h00, &h00, &hC3, &h0C, &h30, &hC3, _
	 &hCB, &h2C, &hF2, &hC3, &h0C, &h43, &hC3, &h00, &h00, &h00, &h10, &h00, &h00, &h04, &h00, &h8C, &h20, &h10, &hC0, &h10, &hC3, &h0C, &h38, &hC0, &h0F, &h2C, &h00, &h00, &h1C, &h00, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h30, &h00, &h00, &h14, &hC3, &h09, &h38, &hC0, &h00, &h1C, &hF3, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h0D, &h08, &h00, &h00, &h00, &h12, &h00, &h00, &h73, &hCF, &h20, &h00, &h00, &h00, &h00, &h42, &h00, &h00, &h00, &h00, &h00, &h80, &h00, &h21, &h00, &h00, &hD3, &hCE, &h28, &h00, &h00, &h00, &h00, &hC7, &h28, &h20, &h00, &h00, &h00, &h09, &h00, &h02, &h40, &h00, &h10, &h8C, &h28, &h00, &h00, &h00, &h01, &h08, &h00, &h00, &h0A, &h00, &h00, &h00, &h00, &h90, &h84, &h00, &h01, &h00, &h00, &h80, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h10, &h20, &h00, &h00, &h00, &h0F, &h3C, &h00, &h02, &h00, &h10, &h00, &h00, &h00, &h0A, &h00, &h00, &hC0, &h00, &h02, &h40, &h00, &h00, &h04, &h34, &hF2, &h00, &h00, &h00, &h40, &h00, &h00, &h06, &h00, &h00, &h40, &h00, &h20, &h00, &h20, &h00, &h00, &h00, &hD3, &hCE, &h00, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h42, &h00, &h02, &h40, &h00, &h00, &h00, &h00, &h02, &hC3, &h28, &h00, &h00, &h00, &h00, &h01, &h04, &h20, &h02, &h00, &h00, &h00, &h08, &h00, &h04, &h00, &h00, &h08, &h00, &h10, &h09, &h0C, &h60, &h00, &h1C, &hF3, &hCB, &h04, &h90, &hC3, &h08, &h00, &h00, &h00, &h90, &h00, &h08, &h01, &h00, &h34, &hF3, &hC0, &h04, &h73, &hCF, &h00, &h53, &hCF, &h2C, &h30, &hC3, &h0C, &h31, &h82, &h10, &h00, &h0A, &h00, &h43, &hCF, &h20, &hC3, &h0C, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h60, &h01, &h20, &h00, &h0F, &h3C, &hE0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h1C, &h00, &h00, &h10, &hF3, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hCB, &h08, &h80, &h00, &h00, &h01, &hCF, &h3C, &hB0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h01, &hCF, &h3C, &hC0, &h00, &h00, &h00, &h00, &h24, &h33, &hC3, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h10, &hCF, &h3C, &hC0, &h00, &h00, &h00, &h00, &h00, &h02, &h40, &h00, &hC0, &hC0, &h00, &h00, &h00, &h08, &h51, &hCF, &h3C, &hE2, &h00, &h00, &h00, &h00, &h00, &h00, &h04, &h14, &h20, &h00, &h10, &h83, &h0D, &h1C, &hF3, &hCF, &h38, &hA0, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h03, &h0E, &h24, &h30, &hC3, &h0C, &h30, &hC3, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h41, &h00, &h14, &h21, &h04, &h20, &h00, &h00, &h00, &h00, &h00, &h00, &h03, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h03, &h01, &h01, &h3F, &h10, &h1C, &h7F, &hFF, &hC4, &h00, &h14, &h11, &h01, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h00, &h90, &hFF, &hDA, &h00, &h08, &h01, &h02, &h01, &h01, &h3F, &h10, &h1C, &h7F, &hFF, &hC4, &h00, &h28, &h10, &h01, &h00, &h02, &h01, &h03, &h04, &h01, _
	 &h05, &h01, &h01, &h01, &h01, &h00, &h00, &h00, &h00, &h01, &h00, &h11, &h20, &h30, &h31, &h41, &h21, &h40, &h51, &h61, &h10, &h50, &h71, &h81, &h91, &hA1, &hB1, &hF0, &hC1, &hD1, &hFF, &hDA, &h00, &h08, &h01, &h01, &h00, &h01, &h3F, &h10, &hFA, &h38, &hDF, &h50, &h1C, &hCF, &h44, &hAF, &h08, &hB4, &h7C, &h18, &h89, &hBF, &hD2, &h81, &h5E, &h90, &h0F, &h6E, &h7B, &hEF, &h29, &hDB, &hB5, &h13, &hC4, &h17, &h32, &h9E, &h67, &hA2, &h51, &hE2, &h7E, &h3E, &h7A, &h78, &h9E, &h8F, &h89, &hF0, &h62, &h51, &h13, &h7C, &h82, &hDA, &h80, &h05, &h1A, &h5C, &hC7, &h62, &h0B, &hB1, &h0F, &h26, &h00, &h6C, &h4B, &hD5, &hDF, &h78, &h97, &hD4, &h59, &hEF, &h03, &h47, &hB7, &h50, &hD3, &hAC, &h27, &h68, &h13, &h7E, &hBD, &hA2, &h0E, &hE4, &hF0, &h75, &h82, &hFE, &hCD, &h51, &h66, &hA6, &hF3, &hCB, &hFA, &h9F, &h6E, &hF2, &hE5, &hCB, &h97, &h90, &hA5, &hA4, &h90, &h06, &hCF, &hDE, &h9D, &hCA, &h79, &h94, &hF3, &h29, &hE6, &h59, &hE7, &hB0, &hA9, &h52, &hB5, &hEB, &h7A, &hBB, &h4D, &hBA, &h1A, &h0A, &h11, &h3C, &h45, &hCB, &h7C, &hE5, &h70, &h47, &h30, &hF3, &h20, &h1E, &hD1, &hF5, &hD0, &hE7, &h74, &h10, &h45, &h3E, &hB5, &h85, &h36, &h61, &hE7, &h06, &hF3, &hA9, &h52, &hA5, &h4A, &hCB, &hAB, &h37, &h33, &h9A, &h84, &h53, &hD9, &h0D, &h6D, &h3C, &hB9, &h1A, &h2B, &h46, &h77, &h75, &h76, &hCE, &h9D, &hA6, &hFD, &hAA, &h10, &h47, &h6D, &h57, &hC6, &h56, &h26, &hC5, &h19, &h70, &h1D, &hC0, &hD4, &hB3, &h4D, &h51, &h98, &hA6, &h57, &h74, &h36, &hEE, &hB6, &h96, &h7D, &hF4, &h68, &h8B, &h79, &h72, &h7E, &hB2, &hE2, &h35, &hA9, &h78, &h7F, &h51, &h13, &h71, &hD5, &h1A, &h62, &hB3, &h24, &h11, &hF1, &hCC, &h2D, &hA9, &hB1, &h58, &hD4, &h57, &h3A, &hAA, &hF5, &hD8, &h80, &h1B, &h12, &hE5, &hC4, &h3C, &h7E, &hA2, &h7D, &h9E, &h75, &h15, &h30, &hEB, &h89, &hE7, &h40, &h74, &hBC, &h56, &h8B, &h8B, &h6D, &hEA, &h5D, &hD5, &hDB, &hFD, &hCB, &hEF, &h2E, &h7A, &hD4, &h7C, &h63, &h56, &h54, &h4A, &h72, &h3A, &hB3, &h62, &hB1, &h76, &hD6, &hA5, &h8F, &hF7, &h41, &h2C, &hA6, &h25, &h34, &hEA, &h2B, &h31, &h1C, &hE4, &h3A, &hDF, &h8C, &h55, &h1A, &h87, &h58, &h14, &hAF, &hDE, &h8D, &hC5, &h9B, &h9A, &h8E, &h9A, &hF3, &h8A, &h59, &h91, &hAC, &h4F, &hAD, &h6A, &h54, &h5B, &hF8, &hD3, &hA9, &hB3, &h67, &h50, &h6C, &h1C, &h4D, &h60, &h37, &h9C, &h62, &hB6, &hE9, &hDC, &hDB, &hB1, &hA9, &hB9, &h4C, &h14, &hD6, &h9A, &hE3, &h11, &hCE, &h06, &hF1, &h3D, &h30, &h5B, &h52, &hA8, &hA3, &h2A, &h20, &hDE, &h42, &h9E, &hCD, &hB4, &hD5, &h0C, &h45, &hE0, &hDD, &h8A, &hEA, &h1A, &h62, &h9E, &hDC, &h96, &h88, &hB6, &hC7, &h4D, &h67, &hCC, &h7E, &h74, &hCE, &hA6, &h0E, &hD8, &h6C, &h75, &hEE, &h67, &hF1, &h9A, &hB7, &hE5, &hDE, &h76, &h3F, &hCD, &h7B, &h73, &hA1, &h3B, &hBA, &h36, &h3F, &hDC, &hDF, &h18, &h0D, &h30, &h6C, &hC9, &h29, &h5F, &hAD, &h2D, &h8F, &h6B, &h47, &h56, &h05, &h2B, &hF7, &h92, &hA3, &h25, &h4E, &h77, &h16, &h7E, &h74, &h79, &h68, &h5B, &h18, &h3B, &h68, &hD4, &h5B, &hBB, &h92, &hD4, &h5B, &h73, &h7C, &h67, &h53, &hE9, &hD0, &hE5, &h8E, &hFD, &h7A, &hE6, &hDD, &h8C, &hD5, &hF4, _
	 &hD1, &h56, &h64, &h96, &h53, &h12, &h9A, &h73, &hE5, &hA1, &h6D, &hC5, &hDF, &h20, &hB6, &hA6, &hC5, &h1A, &h27, &hAB, &hFC, &h9E, &hAF, &hE9, &h3D, &h5F, &hD2, &h7A, &hBF, &hA4, &hF5, &h7F, &h49, &hEA, &hFE, &h93, &hD5, &hFD, &h20, &h0E, &hDF, &hD3, &h33, &h65, &hF2, &h67, &hB1, &hC7, &h77, &hCF, &h3C, &h77, &h32, &h14, &hF6, &hEF, &h92, &hD1, &h1E, &hBF, &h1C, &hCF, &hE3, &hFE, &hFF, &h00, &hBA, &hF6, &h15, &h36, &h6C, &hFF, &h00, &hBA, &h76, &hEF, &h9D, &hF8, &hEF, &hC7, &h99, &hFC, &h7F, &hF7, &h35, &h6F, &hC0, &hB7, &hAE, &h7B, &h1D, &hCA, &h62, &h53, &h58, &hF4, &h06, &h0E, &hD1, &hDF, &hE7, &hA1, &hC7, &h6E, &h16, &h3E, &hB9, &hCD, &h71, &hF0, &h16, &hF4, &h81, &h45, &h7E, &hFB, &h21, &h4F, &h66, &h07, &h57, &h15, &hD3, &h13, &hA9, &h82, &h59, &hF2, &h16, &hC0, &hA2, &h8F, &hCE, &h4B, &hE4, &h51, &h6E, &hFF, &h00, &hF9, &hDA, &h1E, &h4F, &hCF, &hC9, &hEB, &h78, &hBC, &h5F, &h4C, &h45, &h3F, &h03, &h52, &hD9, &h6C, &hB9, &h72, &hE5, &hFC, &h9D, &h1F, &h32, &hD2, &hD2, &hD2, &hD2, &hD2, &hD2, &hDD, &h88, &h00, &h02, &h8C, &h57, &h5C, &h55, &h38, &h8B, &h3E, &hDF, &h42, &h16, &hE2, &hBD, &h33, &h1B, &h31, &h4A, &h7E, &h82, &h68, &hC5, &hE6, &hF8, &hC4, &h59, &hF4, &h01, &h6E, &h2B, &h16, &hDC, &hCE, &h8C, &h1B, &h31, &h1C, &hF7, &hDB, &hC0, &hA3, &h15, &hA2, &hB8, &hC8, &h53, &hDE, &h8A, &hEB, &hCE, &h2B, &h51, &hEB, &hA4, &hAC, &hC5, &h2C, &h89, &h4F, &h77, &hC8, &hE2, &hC5, &h7A, &h63, &h4C, &h1C, &h52, &hE2, &h57, &h73, &hC8, &hE4, &hB5, &h55, &h64, &h97, &h28, &hDB, &h6E, &hDB, &h79, &h46, &hFB, &hE4, &hBB, &h61, &hB6, &hD1, &h2B, &h7E, &hCC, &h4C, &h00, &hC9, &h47, &hAF, &h6E, &h25, &hEF, &h1F, &h19, &h55, &hAE, &h26, &h00, &hF7, &h9A, &hC5, &hBE, &hC8, &h81, &hCF, &h78, &h9E, &h22, &hA5, &h68, &h82, &hF1, &h0F, &h38, &h03, &h41, &h63, &hD7, &hB4, &h1A, &h83, &hA5, &h4F, &h12, &hB3, &hEF, &h9F, &h7C, &hFB, &hE5, &h65, &h3C, &h4A, &h3C, &h68, &hAC, &h7B, &h70, &hD4, &h22, &hFB, &h75, &h8B, &hDD, &h0D, &h42, &h2F, &hB2, &hB8, &hC3, &hDF, &h06, &h10, &h45, &hEA, &hDC, &h61, &hFA, &h1A, &hDC, &h05, &hCB, &h97, &h2E, &h5E, &h21, &h7F, &h4A, &hB9, &h6C, &hB7, &hBA, &hFF, &hD9}

Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput 

Const As UShort iW = 700, iH = 700, iW2 = iW \ 2
Const as Ulong iFlameParticles = 200

Screenres(iW, iH, 32, 1, GFX_ALPHA_PRIMITIVES or GFX_HIGH_PRIORITY or GFX_NO_SWITCH)
Dim memImage As Any Ptr = ScreenPtr()
WindowTitle("Simple Flame Simulation v2.1") 

'center windows by adding the taskbar to the calculation
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, (tWorkingArea.Right - iW) \ 2, ((tWorkingArea.Bottom - iH) - (iDH - tWorkingArea.Bottom)) \ 2

Dim As Any Ptr pImageBlurred, pImage = ImageCreate(iW, iH), pImageBack = ImageCreate(iW, iH, &hFF000000), _
               pImageLogo = Convert2FBImage(__Logo_398x3974bitpng())

Dim As Integer wl, hl
Imageinfo(pImageLogo, wl, hl)
   
Put pImageBack, ((iW - wl) / 2, 100), pImageLogo, Alpha

Dim AS Single aFlameCoords(0 to iFlameParticles, 8)

Randomize , 2
Dim as ulong i, iFPS = 0, iFPS_current = 0
For i = 0 to Ubound(aFlameCoords) - 1
   GenFlameParticle(aFlameCoords(), i)
Next

Dim evt As EVENT
Dim As Double fTimer = Timer

Do
   screenlock
   Put pImage, (0, 0), pImageBack, PSet
   
   For i = 0 To iFlameParticles - 1
      If aFlameCoords(i, 1) > -aFlameCoords(i, 4) Then
         Circle pImage, (aFlameCoords(i, 0), aFlameCoords(i, 1)), aFlameCoords(i, 4), aFlameCoords(i, 6), , , 2.5, F
      EndIf
      aFlameCoords(i, 0) -= aFlameCoords(i, 2)
      aFlameCoords(i, 1) -= aFlameCoords(i, 3)
      aFlameCoords(i, 4) -= aFlameCoords(i, 7)
      If aFlameCoords(i, 4) < aFlameCoords(i, 7) Then GenFlameParticle(aFlameCoords(), i)
   Next
   
   pImageBlurred = ImageBlur(pImage, 28)
   ImageContrast(pImageBlurred, 120, 0)
   
   Put (0, 0), pImageBlurred, Alpha, &h80
   Draw String(0, 0), iFPS_current & " fps", RGB(&hA0, &hA0, &hA0)
   
   screenunlock
   ImageDestroy(pImageBlurred)

   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	EndIf
   
   Sleep(1, 1)
Loop Until ((InKey = Chr(27)) Or (evt.Type = EVENT_WINDOW_CLOSE))

ImageDestroy(pImageBack)
ImageDestroy(pImage)
ImageDestroy(pImageLogo)

Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
   aFlameCoords(iPos, 4) = RandomRange(2, iWidth) 'size
   aFlameCoords(iPos, 0) = RandomRange(iW2 - iWidth, iW2 + iWidth)
   aFlameCoords(iPos, 1) = iH
   aFlameCoords(iPos, 2) = RandomRange(-8, 8) 'vx
   aFlameCoords(iPos, 3) = RandomRange(12, 30) 'vy (power of flame)
   aFlameCoords(iPos, 5) = CUbyte(RandomRange(&h60, &hFF))
   Dim as Ubyte iYellow = CUbyte(aFlameCoords(iPos, 5) - &hFF * Abs(aFlameCoords(iPos, 0) - iW2) / (2 * iW2))
   aFlameCoords(iPos, 6) = &hE8FF0000 + iYellow Shl 8 + Cubyte(iYellow * 0.6666)
   aFlameCoords(iPos, 7) = RandomRange(2, 5) 'min size of flame particle
End Sub

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

Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
   #Define Blue(colour) ((colors Shr 16) And 255)
   #Define Green(colour) ((colors Shr 8) And 255)
   #Define Red(colour) (colors And 255)
   #Define Truncate(colour) (Iif(colour < 0, 0, Iif(colour > 255, 255, CUbyte(colour))))
   Dim as Ulong colors
   Dim As Integer w, h, pitch
   Dim As Any Pointer pixdata
   Imageinfo(pImage, w, h, , pitch, pixdata)
   
   Dim as Single factor, contrastLevel = ((100.0 + contrast) / 100.0) * ((100.0 + contrast) / 100.0)
   
   For y as UShort = 0 to iH - 1
      For x as Ushort = 0 to iW - 1
         colors = *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2)
         *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2) = RGB(Truncate(((((Blue(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0 + brightness), _
                                                               Truncate(((((Green(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0 + brightness), _
                                                               Truncate(((((Red(colour) / 255.0) - 0.5) * contrastLevel) + 0.5) * 255.0) + brightness)
      Next
   Next
End Sub

Function 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 

Function _GDIPlus_Startup() As Byte
	GDIp.GdiplusVersion = 1
	If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
		Return FALSE
	EndIf
	Return TRUE
End Function

Sub _GDIPlus_Shutdown()
	GdiplusShutdown(gdipToken)
End Sub

Function _GDIPlus_BitmapCreateFromMemory(aBinImage() As UByte, bBitmap_GDI As Bool = FALSE) As Any Ptr
	Dim As HGLOBAL hGlobal
	Dim As LPSTREAM hStream
	Dim As Any Ptr hBitmap
	Dim As ULong iLen = UBound(aBinImage) + 1
	Dim As Any Ptr hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen)
	Dim As Any Ptr lpMemory = GlobalLock(hMemory)
	RtlCopyMemory(lpMemory, @aBinImage(0), iLen)
	GlobalUnlock(hMemory)
	
	CreateStreamOnHGlobal(hMemory, 0, @hStream)
	GdipCreateBitmapFromStream(hStream, @hBitmap)
	IUnknown_Release(hStream)
	
	If bBitmap_GDI = TRUE Then
		Dim hBitmap_GDI As Any Ptr
		GdipCreateHBITMAPFromBitmap(hBitmap, @hBitmap_GDI, &hFF000000)
		GdipDisposeImage(hBitmap)
		Return hBitmap_GDI
	EndIf
	Return hBitmap
End Function

Function Convert2FBImage(aMemGDIpBitmap() as UByte) as any Ptr
   _GDIPlus_Startup()
   Dim as any Ptr hImage = _GDIPlus_BitmapCreateFromMemory(aMemGDIpBitmap()), pImageMem
   Dim As Single iW_Img, iH_Img
   GdipGetImageDimension(hImage, @iW_Img, @iH_Img)
   
   pImageMem = ImageCreate(iW_Img, iH_Img)
     
   Dim As Integer w, h, pitchMem
   Dim As Any Pointer pixdataMem
   Imageinfo(pImageMem, w, h, , pitchMem, pixdataMem)
   
   Dim As Rect tRect = Type(0, 0, iW_Img - 1, iH_Img - 1)
   Dim As BitmapData tBitmapData
   GdipBitmapLockBits(hImage, Cast(Any Ptr, @tRect), ImageLockModeRead, PixelFormat32bppARGB, @tBitmapData)
   
   Dim as Ulong iX, iY, iRowOffset
   For iY = 0 To iH_Img - 1
		iRowOffset = iY * iW_Img
		For iX = 0 To iW_Img - 1
			*cptr(ulong ptr, pixdataMem + iY * pitchMem + iX shl 2) = Cast(ulong Ptr, tBitmapData.Scan0)[iRowOffset + iX]
		Next
	Next
	GdipBitmapUnlockBits(hImage, @tBitmapData)
   GdipDisposeImage(hImage)
   _GDIPlus_Shutdown()
   Return pImageMem
End Function
Image

Compile it with -gen gcc -O 3 to get max. fps.

Have fun.
Last edited by UEZ on Jan 22, 2018 22:33, edited 3 times in total.
paul doe
Moderator
Posts: 1732
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Simple Flame Simulation [Windows only] build 2018-01-15

Post by paul doe »

UEZ wrote:Compile it with -gen gcc -O 3 to get max. fps.
And 32-bit only. Nice one!!
UEZ
Posts: 988
Joined: May 05, 2017 19:59
Location: Germany

Re: Simple Flame Simulation build 2018-01-22 [Windows and 32-bit only]

Post by UEZ »

Another variation of this effect which looks also quite nice.

Image

Code: Select all

'coded by UEZ build 2018-01-27
'thanks to Eukalyptus for the ASM Blur function
'32-bit only!
'compile with -gen gcc -O 3 / -gen gcc -Wc -O2 to get max fps ;-)

#Define WIN_INCLUDEALL
#Include "fbgfx.bi"
#Include "windows.bi"

Using FB

Declare Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
Declare Function RandomRange(fStart as Single, fEnd as Single) as Single
Declare Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
Declare function ImageBlur(pImage As Any Ptr, iRadius As Long, iExpandEdge As Long = 0) As Any Ptr

Const As UShort iW = 600, iH = 800, iW2 = iW \ 2, iH2 = iH / 2
Const as Ulong iFlameParticles = 5000

Screenres(iW, iH, 32, 1, GFX_ALPHA_PRIMITIVES or GFX_HIGH_PRIORITY)
Dim memImage As Any Ptr = ScreenPtr()

'center windows by adding the taskbar to the calculation
Dim as ulong iDW, iDH
ScreenControl GET_DESKTOP_SIZE, iDW, iDH
Dim tWorkingArea As RECT
SystemParametersInfo(SPI_GETWORKAREA, null, @tWorkingArea, null)
ScreenControl SET_WINDOW_POS, (iDW - iW) \ 2, _
                              ((tWorkingArea.Bottom - iH) - (iDH - tWorkingArea.Bottom)) \ 2

Dim Shared As Integer w, h, bpp, scanline
ScreenInfo w, h, , bpp, scanline
Color 0, &hFFFFFF
Dim As Any Ptr pImage = ImageCreate(iW, iH), pImageEmpty = ImageCreate(iW, iH, &hF0787878), pImageBlurred

Dim AS Single aFlameCoords(0 to iFlameParticles, 8)

Randomize

Dim as ulong i, iFPS = 0, iFPS_current = 0
For i = 0 to Ubound(aFlameCoords) - 1
   GenFlameParticle(aFlameCoords(), i, 25)
Next

Dim evt As EVENT
Dim As Double fTimer = Timer

Do
   screenlock
   Put pImage, (0, 0), pImageEmpty, PSet
   
   For i = 0 To iFlameParticles - 1
      If aFlameCoords(i, 1) > -aFlameCoords(i, 4) Then
         Circle pImage, (aFlameCoords(i, 0), aFlameCoords(i, 1)), aFlameCoords(i, 4), aFlameCoords(i, 6), , , 2.5
      EndIf
      aFlameCoords(i, 0) -= aFlameCoords(i, 2)
      aFlameCoords(i, 1) -= aFlameCoords(i, 3)
      aFlameCoords(i, 4) -= aFlameCoords(i, 7)
      If aFlameCoords(i, 4) < aFlameCoords(i, 7) Then GenFlameParticle(aFlameCoords(), i, RandomRange(2, 50))
   Next
   
   pImageBlurred = ImageBlur(pImage, 20)
   ImageContrast(pImageBlurred, 120, 0)
   
   Put (0, 0), pImageBlurred, Pset
   Draw String(0, 0), iFPS_current & " fps", RGB(&hA0, &hA0, &hA0)
   
   screenunlock
   ImageDestroy(pImageBlurred)

   If Timer - fTimer > 0.99 Then
      iFPS_current = iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	EndIf
   
   Sleep(1, 1)
Loop Until ((InKey = Chr(27)) Or (evt.Type = EVENT_WINDOW_CLOSE))

ImageDestroy(pImageEmpty)
ImageDestroy(pImage)

Sub GenFlameParticle(aFlameCoords() as Single, iPos as ushort, iWidth as UShort = 100)
   aFlameCoords(iPos, 4) = RandomRange(1, iWidth) 'size
   aFlameCoords(iPos, 0) = RandomRange(iW2 - iWidth, iW2 + iWidth)
   aFlameCoords(iPos, 1) = iH
   aFlameCoords(iPos, 2) = RandomRange(-1.5, 1.5) 'vx
   aFlameCoords(iPos, 3) = RandomRange(3, 30) 'vy (power of flame)
   aFlameCoords(iPos, 5) = CUbyte(RandomRange(&h70, &hFF))
   Dim as Ubyte iYellow = CUbyte(aFlameCoords(iPos, 5) - &hFF * (aFlameCoords(iPos, 0) - iW2) / (2 * iW2))
   aFlameCoords(iPos, 6) = &hE0000000 or (&hFF Shl 16) or (iYellow Shl 8) or Cubyte(iYellow * 0.875)
   aFlameCoords(iPos, 7) = RandomRange(0.5, 3.5) 'min size of flame particle
End Sub

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

Sub ImageContrast(pImage as any Pointer, contrast as Byte, brightness as Byte = 0)
   #Define Red(colour) ((colors Shr 16) And 255)
   #Define Green(colour) ((colors Shr 8) And 255)
   #Define Blue(colour) (colors And 255)
   #Define Truncate(colour) (Iif(colour < 0, 0, Iif(colour > 255, 255, CUbyte(colour))))
   Dim as Ulong colors
   Dim As Integer w, h, pitch
   Dim As Any Pointer pixdata
   Imageinfo(pImage, w, h, , pitch, pixdata)
   
   Dim as Single factor, contrastLevel = (((100.0 + contrast) / 100.0) * ((100.0 + contrast) / 100.0))

   For y as UShort = 0 to iH - 1
      For x as Ushort = 0 to iW - 1
         colors = *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2)
         *CPtr(ulong ptr, pixdata + y * pitch + x Shl 2) = RGB(Truncate(brightness + (((Red(colour) / 255 - 0.5) * contrastLevel) + 0.5) * 255.0), _
                                                               Truncate(brightness + (((Green(colour) / 255 - 0.5) * contrastLevel) + 0.5) * 255.0), _
                                                               Truncate(brightness + (((Blue(colour) / 255 - 0.5) * contrastLevel) + 0.5) * 255.0))
      Next
   Next
End Sub

Function 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 
Another example is this:
Image
Post Reply