In continuation of the thread here , here's an FBSL script that implements the same procedural fire generation algorithm, this time using FBSL's Dynamic Assembler.
As always, the assembly language removes the viewport size restrictions imposed by relative slowliness of the interpreted nested loops. As you will see, the fire can be rendered into screen-wide windows without any visible loss of speed. In fact, the rendering speed is even restricted by the timer to approx. 30FPS to make the flame look more natural. Higher FPS rates and/or larger window sizes are possible though they may stress the CPU unnecessarily.
The script uses a transparent layered window onto which a 32-bpp alpha-channeled DIB is rendered using GDI+ APIs. The DIB (device-independent bitmap) is generated on the fly based on the flame pixel data created programmatically. Flicker is eliminated using double back-buffering in the memory DCs. Special care is taken to release GDI and GDI+ resources in each render call to eliminate possible memory and resource leaks.
Provided the GDI+ DLL is available on the PC (normally it is), the script runs on any configuration of Win XP and it also runs as intended under Basic and Classic themes of Win Vista and Win 7. Composited Aero modes are not fully supported though they don't break program execution. The currently available version of Win 8 CP doesn't provide any non-composited themes at all so the rendering portion of the application wouldn't yield the intended transparency effects there either.
Click on the fire or press "Escape" to exit.
- Code: Select all
' =====================================
' " ... Heaven's on Fire! ... " (©1984 "KISS")
' http://www.youtube.com/watch?v=EZjevnnkA20
' =====================================
' ©2012 Mike LOBANOVSKY -= Public Domain =-
' Heck, that was exactly half of my life ago! ;)
' =====================================
#Uses "@|WIN32"
#Option Strict
#DllDeclare User32("SetLayeredWindowAttributes", "SystemParametersInfo", "GetDesktopWindow")
#DllDeclare Gdiplus("GdiplusStartup", "GdiplusShutdown", "GdipCreateBitmapFromScan0", _
"GdipCreateFromHDC", "GdipDrawImageRectI", "GdipDisposeImage", "GdipDeleteGraphics")
#Define WS_EX_LAYERED &H80000
#Define LWA_COLORKEY &H1
#Define LWA_ALPHA &H2
#Define SRCCOPY &HCC0020 ' blit mode
#Define SPI_GETWORKAREA 48 ' unobscured by taskbar
Type BYTE
Default %b * 8
End Type
Type RECT
%Left
%Top
%Right
%Bottom
End Type
Type GDIPLUSSTARTUPINPUT
GdiplusVersion As Integer
DebugEventCallback As Integer
SuppressBackgroundThread As Integer
SuppressExternalCodecs As Integer
End Type
Dim %token ' just another one of Windows' atrocities, for some unknown reason required to run GDI+
Dim sui As GDIPLUSSTARTUPINPUT ' GDI+ startup UDT
Dim %hImg, %hGrfx ' these can't be reduced to volatiles
Dim %X, %Y, %Fire[255], RC As RECT
For X = 0 To 255 ' alpha + rgb ==> RGBA format, little-endian style
Fire[X] = ((%IIf((X << 2) < 255, X << 2, 255)) << 24) BOr Rgb(0, %IIf((X << 1) < 255, X << 1, 255), %IIf((X << 1) < 255, %IIf((X << 2) < 255, X * 3, 255), 255))
Next
Style_Remove(ME, WS_OVERLAPPEDWINDOW)
SystemParametersInfo(SPI_GETWORKAREA, 0, @RC, 0)
Dim %W = rc.Right - rc.Left, %H = 165, %L = rc.Left, %T = rc.Bottom - H
Resize(ME, L, T, W, H)
Dim %Heavens[W - 1, H - 1], Hell[W - 1, H - 1] As BYTE ' 4 times less memory
Dim %hDeskDC = GetDC(GetDesktopWindow())
sui.GdiplusVersion = 1 ' initialize GDI+ startup structure (this is the only GDI+ version to date)
GdiplusStartup(@token, @sui, 0) ' launch GDI+
ExStyle_Add(ME, WS_EX_LAYERED)
Fbsl_SetFormColor(ME, 0) ' else it flickers on launching
SetLayeredWindowAttributes(ME, 0, 255, LWA_ALPHA BOr LWA_COLORKEY) ' black transparent color
Fbsl_SetText(ME, "Heaven's on Fire!")
SetTimer(ME, &HDEADBEEF, 35)
Show(ME)
Begin Events
Select Case CBMSG
Case WM_COMMAND
' That's VK_ESCAPE pressed
If CBWPARAM = 2 Then PostMessage(ME, WM_LBUTTONDOWN, 0, 0)
Case WM_TIMER
If CBWPARAM = &HDEADBEEF Then
Burn()
Return 0
End If
Case WM_LBUTTONDOWN
Destroy(ME)
Return 0
Case WM_DESTROY
If token Then GdiplusShutdown(token) ' unload GDI+
ReleaseDC(GetDesktopWindow, hDeskDC)
KillTimer(ME, &HDEADBEEF)
End Select
End Events
Sub Burn()
For X = 0 To W - 1
Hell[X, H - 1] = RandInt(0, 255)
Next
Ignite()
GdipCreateBitmapFromScan0(W, H, W * 4, &H26200A, @Heavens[0, 0], @hImg) ' create GDI+ image from raw pixel data (PixelFormat32bppARGB)
CreateCompatibleDC(GetDC(ME))
CreateCompatibleBitmap(GetDC, W, H)
SelectObject(CreateCompatibleDC, CreateCompatibleBitmap)
BitBlt(CreateCompatibleDC, 0, 0, W, H, hDeskDC, L, T, SRCCOPY) ' blit desktop into memory DC first
GdipCreateFromHDC(CreateCompatibleDC, @hGrfx) ' create GDI+ graphics object from device context where user can draw things interactively
GdipDrawImageRectI(hGrfx, hImg, 0, 0, W, H) ' overlay transparent GDI+ image onto GDI+ graphics object using integer metrics (width, height)
BitBlt(GetDC, 0, 0, W, H, CreateCompatibleDC, 0, 0, SRCCOPY) ' blit everything to layered window
ReleaseDC(ME, GetDC) ' clean up GDI objects
DeleteObject(SelectObject(CreateCompatibleDC, SelectObject))
DeleteDC(CreateCompatibleDC)
GdipDeleteGraphics(hGrfx) ' delete GDI+ graphics object
GdipDisposeImage(hImg) ' delete GDI+ image object
End Sub
Asm Ignite(%b = w, %t = h, %hellptr = @Hell[0, 0], %pixptr = @Heavens[0, 0], %palptr = @Fire[0]) As Integer
push ebp
mov ebp, esp
push ebx
push esi
push edi
Xor ebx, ebx ' y
@foryhell
Xor ecx, ecx ' x
@forxhell
Xor edx, edx
mov eax, ecx ' x
dec eax
add eax,[ebp + 8] ' w
div WORD PTR[ebp + 8] ' w
mov[esp - 4], edx ' (x-1+w) Mod w
Xor edx, edx
mov eax, ebx ' y
inc eax
div WORD PTR[ebp + 12] ' h
imul edx,[ebp + 8] ' w
mov esi,[ebp + 16] ' hellptr
add esi, edx ' esi=@Hell[0,0]+((y+1) Mod h)*w
mov eax,[esp - 4]
movzx eax, BYTE PTR[esi + eax]
mov[esp - 4], eax ' Hell[(x-1+w) Mod w, (y+1) Mod h]
Xor edx, edx
mov eax, ecx ' x
inc eax
div WORD PTR[ebp + 8] ' w
movzx eax, BYTE PTR[esi + edx]
mov[esp - 8], eax ' Hell[(x+1) Mod w, (y+1) Mod h]
Xor edx, edx
mov eax, ecx ' x
div WORD PTR[ebp + 8] ' w
mov[esp - 16], edx ' x Mod w
movzx eax, BYTE PTR[esi + edx]
mov[esp - 12], eax ' Hell[x Mod w, (y+1) Mod h]
Xor edx, edx
mov eax, ebx ' y
add eax, 2
div WORD PTR[ebp + 12] ' h
imul edx,[ebp + 8] ' w
mov esi,[ebp + 16] ' hellptr
add esi, edx ' esi=@Hell[0,0]+((y+2) Mod h)*w
mov eax,[esp - 16]
movzx eax, BYTE PTR[esi + eax] ' Hell[x Mod w, (y + 2) Mod h]
add eax,[esp - 12] ' Hell[x Mod w, (y+1) Mod h]
add eax,[esp - 8] ' Hell[(x+1) Mod w, (y+1) Mod h]
add eax,[esp - 4] ' Hell[(x-1+w) Mod w, (y+1) Mod h]
Xor edx, edx
shl eax, 5
mov DWORD PTR[esp - 4], 129
div WORD PTR[esp - 4]
mov edx, ebx ' y
imul edx,[ebp + 8] ' w
add edx,[ebp + 16] ' hellptr
mov[edx + ecx], al
inc ecx
cmp ecx,[ebp + 8] ' w
jl forxhell
inc ebx
cmp ebx,[ebp + 12] ' h
jl foryhell
mov edi,[ebp + 20] ' pixptr
Xor ebx, ebx ' y
@forypal
Xor ecx, ecx ' x
@forxpal
mov eax,[ebp + 8] ' w
imul eax, ebx ' y
mov[esp - 4], eax ' y*w
mov esi,[ebp + 16] ' hellptr
add esi, eax
movzx eax, BYTE PTR[esi + ecx]
mov esi,[ebp + 24] ' palptr
mov eax,[esi + 4 * eax] ' color
mov edx,[esp - 4] ' y*w
add edx, ecx
mov[edi + 4 * edx], eax
inc ecx
cmp ecx,[ebp + 8] ' w
jl forxpal
inc ebx
cmp ebx,[ebp + 12] ' h
jl forypal
pop edi
pop esi
pop ebx
pop ebp
ret
End Asm
