' Flame test #2 by Conexion
' With assistance from ##Freebasic
' Extra help: Mysoft

#Include "fbgfx.bi"
Randomize , 1

'Adjustables
Dim As Single fTrail = 1 / 4.1 'Adjust this to adjust the fire trail
Dim As Integer spnRadius = 80 ' Size of the spinner
Dim As Integer spnDegrees = 5 ' Degrees Clockwise

Const fpsLimit = 75
Const pi = 3.14159265 'Shouldn't need any more than that

Dim As Integer ScrW = 800, ScrH = 600
Dim As UByte CharH = 8, CharW = 8

ScreenRes ScrW, ScrH, 8, , fb.gfx_high_priority

'Set up the pallete
'xPal is the counter
'bPal adds extra blue/brightness
Dim As UByte xPal = 255 'Set it so when xPal +=1 happens, you get 0
Dim As UByte bPal = 0

Dim As Integer fadewhite = 170
Do
    xPal += 1
    If xPal < 64 Then
        Palette xPal, xPal*4, xPal, 0
    Else
        If xPal > 192 Then
            bPal += 4
        end If
        Palette xPal, 255, xPal, bPal
    end if

Loop Until xPal = 255

/'Palette test
For iii As Integer = 0 To 255
    Line (iii*2.5+10, 15)-(iii*2.5+30, 40), iii, bf
    Dim As Integer ir, ig, ib
    Palette Get iii, ir, ig, ib
Next
'/

'Set up the Image Buffer
Dim As fb.image Ptr ImgBuff = ImageCreate(ScrW, (ScrH + 4) / 2)


'Spinner Variables
Dim As Single spnOldX, spnOldY, spnX, spnY = spnRadius
Dim As Single spnAngle = spnDegrees * -0.017453 'Degrees to Rads
Dim As Integer spnVX = ScrW / 2, spnVY = ScrH / 4 ' Center the Spinner

'Precalculate the distance to each pixel we need to average
Dim As Integer calcDL = ScrW - 1
Dim As Integer calcD = ScrW
Dim As Integer calcDR = ScrW + 1
Dim As Integer calcDD = ScrW Shl 1

'Fire trail variables
Dim As Integer fX, fY, fZ, fColor

' FPS Vars
Dim As Integer fpsX, fpsY, fps, fpsNew, fpsSeconds
fpsX = (ScrW - len(fps)*CharW)
fpsY = (ScrH - CharH) - 32

Dim As Double fpsStart
Dim As Integer fpslSleep
Dim As Double fpslStart
Dim As Double fpslV = 1.0 / fpsLimit

Do
    ' Start our timer
    fpslStart = Timer

    ScreenLock
    ' Lets get the spinner down first!
    spnOldX = spnX
    spnOldY = spnY

    ' Calculate the rotation coordinates
    spnX = (spnOldX * Cos(spnAngle)) + (spnOldY * Sin(spnAngle))
    spnY = (spnOldY * Cos(spnAngle)) - (spnOldX * Sin(spnAngle))

    ' Draw it, translated "V" distance. Also, half the arc/shape
    ' for when we stretch the image on the Y-axis.
    Circle ImgBuff, (spnX + spnVX, spnY / 2 + spnVY), 8, 255,,,.5

    ' The Screen Buffer
    Dim As UByte Ptr ScrBuff = ScreenPtr
    ' The pixel part of ImgBuff
    Dim As UByte Ptr ImgPix = Cast(any Ptr, ImgBuff+1)

    ' Random dots on the bottom line
    Dim As UByte Ptr BotLine = ImgPix
    BotLine += ScrW * CInt((ScrH-1)/2)

    dim as ubyte ptr SpecksPtr = cast(any ptr,ImgBuff+1)
    For ranLine As Integer = 0 To ScrW
        BotLine[ranLine] = (Rnd * 255)

        'Extra specks
        SpecksPtr[rnd*(scrw*(scrh/2-5))] = rnd*32
    Next

    ' Circle Flares
    circle ImgBuff,(rnd*scrw,rnd*(scrh*3)),Rnd*20, Rnd*6, , (Rnd*pi)*2 ,Rnd*0.9,f
    circle ImgBuff,(rnd*scrw,rnd*(scrh*2)),Rnd*10, Rnd*10, , ,0.5,f

    ' Output FPS with a shadow
    Draw String ImgBuff, (fpsX - 2, (fpsY - 2) / 2), Str(fps), 20
    Draw String ImgBuff, (fpsX - 2, (fpsY + 2) / 2), Str(fps), 20
    Draw String ImgBuff, (fpsX + 2, (fpsY - 2) / 2), Str(fps), 20
    Draw String ImgBuff, (fpsX + 2, (fpsY + 2) / 2), Str(fps), 20
    Draw String ImgBuff, (fpsX, fpsY / 2), Str(fpsNew), 254

    ' Filter Time!
    ' Fire is calculated by adding the 3 pixels touching the bottom of any pixel
    ' As well as one pixel two pixels down, then finding the average.
    ' fX, fY, fZ, fColor
    'Dim As Integer calcDL = ScrW - 1
    'Dim As Integer calcD = ScrW
    'Dim As Integer calcDR = ScrW + 1
    'Dim As Integer calcDD = ScrW Shl 2
    Dim As UByte Ptr fT = ImgPix

    For fY = 0 To (ScrH/2) - 1
        For fX = 0 To ScrW - 1
            fColor = (fT[calcDL] + fT[calcD] + fT[calcDR] + fT[calcDD]) * fTrail
            *fT = fColor
            fT += 1
        Next
    Next

    /' Draw ImgBuff at standard
    for PY as integer = 0 to (Scrh/2)-1
        for PX as integer = 0 to ScrW-1
            *ScrBuff = *ImgPix
            ScrBuff[ScrW] = *ImgPix
            ScrBuff += 1: ImgPix += 1
        Next
    Next'/

    /' Draw ImgBuff at 2*Y
    for PY as integer = 0 to (Scrh/2)-1
        for PX as integer = 0 to ScrW-1
            *ScrBuff = *ImgPix
            ScrBuff[ScrW] = *ImgPix
            ScrBuff += 1: ImgPix += 1
        next
        scrbuff += ScrW
    Next'/

    'ASM option
      asm
    mov edi,[ScrBuff]      'Get Screen Buffer pointer
    mov esi,[ImgPix]       'Get Image Buffer pointer
    mov eax,[ScrW]         'Get screen Width
    mov ebx,[ScrH]         'Get Screen height
    mov edx,eax            'make a copy of width
    shr eax,2              'convert pixels/line to dwords/line
    shr ebx,1              'only half of the screen will be read
    NextLine:               'Starting another line
    mov ecx,eax            'loading pixels per line (in dwords)
    rep movsd              'copying those pixels
    sub esi,edx            'we will repeat it again
    mov ecx,eax            'so pixels per line again
    rep movsd              'and copying those pixels (2:1)
    dec ebx                'one line is done.. there are more?
    jnz NextLine           'yes? than keep duplicating
  end Asm '

    ScreenUnLock

    ' Adjust for our FPS limit
    fpslSleep = CInt((fpslStart + fpslV - Timer) * 1000.0)
    If fpslSleep > 1 Then
        Sleep fpslSleep, 1
    Else
        'Let's not be a memory hog
        Sleep 1
    end If

    ' Calculate actual FPS
    fps += 1
    'fpsStart + 1 = One second going by
    If fpsStart + 1 < Timer Then
        fpsNew = fps
        fps = 0
        fpsSeconds += 1
        fpsStart = Timer
    end If

Loop Until InKey <> ""

ImageDestroy(ImgBuff)
End