Results 1 to 1 of 1

Thread: Doom's Fire Effect - VB.NET

  1. #1

    Thread Starter
    Fanatic Member Peter Porter's Avatar
    Join Date
    Jul 2013
    Posts
    532

    Doom's Fire Effect - VB.NET

    This is a VB.NET translation of PowerPete42's C# implementation of Doom's fire effect.
    https://old.reddit.com/r/csharp/comm...ire_algorithm/

    I used Telerik.com's code converter:
    https://converter.telerik.com/

    What you need:
    * Picturebox named Stage.
    * Timer named Ticker

    Code:
    Imports System
    Imports System.Collections.Generic
    Imports System.Linq
    Imports System.Text
    Imports System.Threading.Tasks
    Imports System.Drawing
    Imports System.Windows.Forms
    
    Public Class Form1
    
        Public Shared Property BITMAP As Bitmap
        Public Shared Property RANDOM As Random = New Random()
        Public Shared Property CJS_TICKER_FPS As Integer = 27
        Public Shared Property FIRE_WIDTH As Integer = 256
        Public Shared Property FIRE_HEIGHT As Integer = 128
        Public Shared Property FIRE_PAL As Color() = New Color(36) {}
        Public Shared Property FIRE_PIXELS As Integer() = New Integer(FIRE_WIDTH * FIRE_HEIGHT - 1) {}
        Public Shared Property FIRE_RGB As Integer() = {&H7, &H7, &H7, &H1F, &H7, &H7, &H2F, &HF, &H7, &H47, &HF, &H7, &H57, &H17, &H7, &H67, &H1F, &H7, &H77, &H1F, &H7, &H8F, &H27, &H7, &H9F, &H2F, &H7, &HAF, &H3F, &H7, &HBF, &H47, &H7, &HC7, &H47, &H7, &HDF, &H4F, &H7, &HDF, &H57, &H7, &HDF, &H57, &H7, &HD7, &H5F, &H7, &HD7, &H5F, &H7, &HD7, &H67, &HF, &HCF, &H6F, &HF, &HCF, &H77, &HF, &HCF, &H7F, &HF, &HCF, &H87, &H17, &HC7, &H87, &H17, &HC7, &H8F, &H17, &HC7, &H97, &H1F, &HBF, &H9F, &H1F, &HBF, &H9F, &H1F, &HBF, &HA7, &H27, &HBF, &HA7, &H27, &HBF, &HAF, &H2F, &HB7, &HAF, &H2F, &HB7, &HB7, &H2F, &HB7, &HB7, &H37, &HCF, &HCF, &H6F, &HDF, &HDF, &H9F, &HEF, &HEF, &HC7, &HFF, &HFF, &HFF}
    
    
        Public Sub New()
            InitializeComponent()
            TICKER.Interval = CJS_TICKER_FPS
            BITMAP = New Bitmap(Convert.ToInt32(FIRE_WIDTH), Convert.ToInt32(FIRE_HEIGHT), System.Drawing.Imaging.PixelFormat.Format32bppArgb)
    
            For i = 0 To 37 - 1
                FIRE_PAL(i) = Color.FromArgb((FIRE_RGB(i * 3 + 0)), (FIRE_RGB(i * 3 + 1)), (FIRE_RGB(i * 3 + 2)))
            Next
    
            For i = 0 To FIRE_WIDTH * FIRE_HEIGHT - 1
                FIRE_PIXELS(i) = 0
            Next
    
            For i = 0 To FIRE_WIDTH - 1
                FIRE_PIXELS((FIRE_HEIGHT - 1) * FIRE_WIDTH + i) = 36
            Next
        End Sub
    
    
        Public Function DrawPixel(ByVal x As Integer, ByVal y As Integer, ByVal pixel As Integer) As Integer
            BITMAP.SetPixel(x, y, FIRE_PAL(pixel))
            Return pixel
        End Function
    
    
        Public Function SpreadFire(ByVal pixel As Integer, ByVal curSrc As Integer, ByVal counter As Integer, ByVal srcOffset As Integer, ByVal rand As Integer, ByVal width As Integer) As Integer
            If pixel <> 0 Then
                Dim randIdx As Integer = RANDOM.[Next](0, 255)
                Dim tmpSrc As Integer
                rand = ((rand + 2) And 255)
                tmpSrc = (curSrc + (((counter - (randIdx And 3)) + 1) And (width - 1)))
                FIRE_PIXELS(tmpSrc - FIRE_WIDTH) = pixel - (randIdx And 1)
            Else
                FIRE_PIXELS(srcOffset - FIRE_WIDTH) = 0
            End If
    
            Return rand
        End Function
    
    
        Public Sub DoFire()
            Dim counter As Integer = 0
            Dim rand As Integer = RANDOM.[Next](0, 255)
            Dim curSrc As Integer = FIRE_WIDTH
    
            Do
                Dim srcOffset As Integer = (curSrc + counter)
                Dim pixel As Integer = FIRE_PIXELS(srcOffset)
                Dim [step] As Integer = 2
                rand = SpreadFire(pixel, curSrc, counter, srcOffset, rand, FIRE_WIDTH)
                curSrc += FIRE_WIDTH
                srcOffset += FIRE_WIDTH
    
                Do
                    pixel = FIRE_PIXELS(srcOffset)
                    [step] += 2
                    rand = SpreadFire(pixel, curSrc, counter, srcOffset, rand, FIRE_WIDTH)
                    pixel = FIRE_PIXELS(srcOffset + FIRE_WIDTH)
                    curSrc += FIRE_WIDTH
                    srcOffset += FIRE_WIDTH
                    rand = SpreadFire(pixel, curSrc, counter, srcOffset, rand, FIRE_WIDTH)
                    curSrc += FIRE_WIDTH
                    srcOffset += FIRE_WIDTH
                Loop While [step] < FIRE_HEIGHT
    
                counter += 1
                curSrc -= ((FIRE_WIDTH * FIRE_HEIGHT) - FIRE_WIDTH)
            Loop While counter < FIRE_WIDTH
        End Sub
    
    
        Private Sub Ticker_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Ticker.Tick
            DoFire()
    
            For h = 0 To FIRE_HEIGHT - 1
    
                For w = 0 To FIRE_WIDTH - 1
                    Dim p = FIRE_PIXELS(h * FIRE_WIDTH + w)
                    DrawPixel(w, h, p)
                Next
            Next
    
            Stage.SizeMode = PictureBoxSizeMode.StretchImage
            Stage.Image = BITMAP
        End Sub
    
    
    End Class
    https://raw.githubusercontent.com/r-...aster/demo.gif
    Name:  doom_fire_effect.jpg
Views: 304
Size:  23.8 KB
    Last edited by Peter Porter; Oct 3rd, 2021 at 03:02 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width