Dark Bit Factory & Gravity

GENERAL => Challenges & Competitions => Topic started by: Clyde on July 12, 2006

Title: ASCII Fireworks
Post by: Clyde on July 12, 2006
Here's another entry of mine into the ASCII Compo. This time only using one character graphic for the main display. For a future incarnation will investigate how ASCII / ANSI demos calculate the character tables; as it looked a bit odd using the animated method from my Plasma effort.

Anyhows thanks for running it. And also big thanks to Blitz Amateur for the BB Random Functions.

Executable in zip format found at bottom of Topic.

Freebasic Code:
Code: [Select]
'
' Blocky178 Fireworks
' Code By Clyde
' Random Functions By Blitz Amateur.
'
Option Static
Option Explicit

Const XRES=640
Const YRES=480

Const XRES2=XRES\2
Const YRES2=YRES\2

Const AXRES=XRES\8
Const AYRES=YRES\8

Const PI = 3.14151693
Const Gravity=0.0175

Type Frag
     
     As Integer ID,R,G,B
     As Double X, Y, XV, YV

End Type

Dim Shared TotalFrags
Dim Shared ScreenNo

Dim Shared MAXFRAGS=10000
Dim Shared FireworkDuration
Dim Shared As Double RunningTime, FireWorkTimer


Dim Shared Frags(  MAXFRAGS    ) As Frag
Dim Shared RGBScreen( AXRES, AYRES, 3 )

Declare Sub BlurASCII()

Declare Sub CreateFrags( Byval X As Integer , Byval Y As Integer )

Declare Sub InitializeASCII()
Declare Sub RunASCII()

Declare Sub UpdateASCII()
Declare Sub UpdateFrags()

Declare Function Millisecs( ByVal fltTimeValue As Double ) As Double
Declare Function Rand   (ByVal lower as integer, ByVal upper as integer) As Integer
Declare Function FRand  (ByVal lower as double,  ByVal upper as double ) As double

InitializeASCII()
RunASCII()


Sub BlurASCII()
   
    Dim x,y,col
    Dim Red, Grn, Blu, Char, CharCol
   
    For y=1 To AYRES-1
        For x=1 To AXRES-1
           
            Red = ((RGBScreen(x,y,1) + RGBScreen(x-1,y,1) + RGBScreen(x+1,y,1) + RGBScreen(x,y+1,1)) Shr 2) -1
            Grn = ((RGBScreen(x,y,2) + RGBScreen(x-1,y,2) + RGBScreen(x+1,y,2) + RGBScreen(x,y+1,2)) Shr 2) -1
            BLU = ((RGBScreen(x,y,3) + RGBScreen(x-1,y,3) + RGBScreen(x+1,y,3) + RGBScreen(x,y+1,3)) Shr 2) -1

            If Red<000 Then Red=000
            If Grn<000 Then Grn=000
            If Blu<000 Then Blu=000
           
            If Red>255 Then Red=255
            If Grn>255 Then Grn=255
            If Blu>255 Then Blu=255
           
            RGBScreen(x,y,1) = Red
            RGBScreen(x,y,2) = Grn
            RGBScreen(x,y,3) = Blu
           
            Col=( Red Shl 16 ) Or (Grn Shl 8) Or (Blu Shl 0)
            Color Col,0 : Locate y,x : Print Chr(178);

        Next   
    Next

End Sub


Sub CreateFrags( Byval X As Integer , Byval Y As Integer )

    Dim count =Rand(15,60)'Rand(8,16)
   
    Dim As Single angstep = 360 / count
    Dim As Single ang = FRand(0,angstep)

    Dim r = Rand(128,245)
    Dim g = Rand(128,245)
    Dim b = Rand(128,245)
   
    Dim i
   
    Dim Add = TotalFrags
   
    If TotalFrags<MAXFRAGS-1 Then
   
        For i = 1 To count
               
            Frags( Add+i ).ID = 1
       
            Frags( Add+i ).X = x
            Frags( Add+i ).y = y
            Frags( Add+i ).xv = Cos(ang * (PI/180.00) ) * FRand(.5,1)
            Frags( Add+i ).yv = Sin(ang * (PI/180.00) ) * FRand(.5,1)
            Frags( Add+i ).r = r
            Frags( Add+i ).g = g
            Frags( Add+i ).b = b
           
            ang = ang + angstep
       
            TotalFrags=TotalFrags+1
       
        Next

    End If
   
End Sub



Sub InitializeASCII()

    ScreenRes XRES,YRES,32,3,1 : Screenset 1, 0 : SetMouse   ,,0
    WindowTitle "ASCII Fireworks"
    Randomize Timer()
   
    ScreenNo = 1
   
End Sub


Sub RunASCII()
   
    Dim Key As String
   
    FireWorkTimer=Millisecs( Timer )
    FireWorkDuration=Rand(100,800)
   
    While Key<>Chr(27)
       
        Screencopy 2, ScreenNo
       
        RunningTime=Timer()
       
        If ( FireWorkTimer + FireWorkDuration ) <=Millisecs( RunningTime ) Then
           
            CreateFrags( Rand(4,AXRES),Rand(4,AYRES-4) )

            FireWorkTimer=Millisecs( RunningTime )
            FireWorkDuration=Rand(500,800)

        End if
       
        UpdateFrags()
        BlurASCII()
       
        Screensync()
       
        ScreenNo Xor = 1
        Screenset ScreenNo, ScreenNo xor 1
       
        Key=Inkey()
        Cls

    Wend
   
End Sub


Sub UpdateFrags()
   
    Dim Update
   
    For Update=0 to TotalFrags-1
       
        If Frags( Update ).ID=1 Then
         
            Frags( Update ).x = Frags( Update ).x + Frags( Update ).xv
            Frags( Update ).y = Frags( Update ).y + Frags( Update ).yv
            Frags( Update ).yv= Frags( Update ).yv+ gravity
       
            If Frags( Update ).x>1 And Frags( Update ).x<AXRES-1 And Frags( Update ).y>1 And Frags( Update ).y<AYRES-1 Then
           
                RGBscreen(Frags( Update ).x,Frags( Update ).y,1) = (Frags( Update ).r + RGBscreen(Frags( Update ).x,Frags( Update ).y,1)) '/ 2
                RGBscreen(Frags( Update ).x,Frags( Update ).y,2) = (Frags( Update ).g + RGBscreen(Frags( Update ).x,Frags( Update ).y,2)) '/ 2
                RGBscreen(Frags( Update ).x,Frags( Update ).y,3) = (Frags( Update ).b + RGBscreen(Frags( Update ).x,Frags( Update ).y,3)) '/ 2
               
                If RGBScreen( Frags( Update ).x,Frags( Update ).y,1)>255 then RGBScreen( Frags( Update ).x,Frags( Update ).y,1)=255
                If RGBScreen( Frags( Update ).x,Frags( Update ).y,2)>255 then RGBScreen( Frags( Update ).x,Frags( Update ).y,2)=255
                If RGBScreen( Frags( Update ).x,Frags( Update ).y,3)>255 then RGBScreen( Frags( Update ).x,Frags( Update ).y,3)=255

            Else
               
                Frags( Update ).ID=0
                TotalFrags=TotalFrags-1
               
            EndIf
       
        End If
   
    Next
   
End Sub


Function Millisecs( ByVal fltTimeValue As Double ) As Double
   
    Return ( fltTimeValue * 1000.00 )
   
End Function


Function Rand(ByVal lower As Integer, ByVal upper As Integer) As Integer
   
    Dim temp As Integer
   
    If upper < lower Then
        temp=upper
        upper=lower
        lower=temp
    Endif
   
    Dim value   As Integer
    Dim dist    As Integer
   
    value=lower
   
    dist = Abs(lower-upper)
   
    Return (Rnd(1)*dist) + value

End Function


Function FRand(ByVal lower As Double, ByVal upper As Double) As Double
   
    Dim temp As Double
   
    If upper < lower then
        temp=upper
        upper=lower
        lower=temp
    Endif
   
    Dim value   As Double
    Dim dist    As Double
   
    value=lower
   
    dist = Abs(lower-upper)
   
    Return (Rnd(1)*dist) + value

End function
Title: Re: ASCII Fireworks
Post by: Tetra on July 12, 2006
Very cool m8Â  8)
Thats very nicely done,  it looks great.

Good Job  ;D
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
Cheers Dude. :D
Title: Re: ASCII Fireworks
Post by: Rbz on July 12, 2006
Can you compile an exe for me ? I'm at work...
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
Sure thing mate, it's added to the initial topic.
Title: Re: ASCII Fireworks
Post by: Shockwave on July 12, 2006
That's really really cool.
Lovely colours used there Clyde!
Title: Re: ASCII Fireworks
Post by: relsoft on July 12, 2006
Really nize!!!!

So we could use more than 16 colors?
Title: Re: ASCII Fireworks
Post by: Shockwave on July 12, 2006
As long as the effect is rendered from ascii characters you can use 32 bit colour if you like Rel :)
I bet your plasmas would look amazing.
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
Thanks all, really appreciate it.

Cheers,
Clyde
Title: Re: ASCII Fireworks
Post by: Rbz on July 12, 2006
Very nice, welldone  :)
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
Cheers Rbraz.
Title: Re: ASCII Fireworks
Post by: Dad1916 on July 12, 2006
Nice, Is this BlitzMax, BlitzBasic, Blitz3d? Can you include the language in the subject in future to shut me up  ;D
Title: Re: ASCII Fireworks
Post by: Shockwave on July 12, 2006
Yeah good point.
This one was Freebasic.
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
I have actually in Bold letters stated FREEBASIC Code before the code.
Please back on topic. Cheers.
Title: Re: ASCII Fireworks
Post by: Dad1916 on July 12, 2006
I have actually in Bold letters stated FREEBASIC Code before the code.
Please back on topic. Cheers.
Thanks for pointing that out. Posting this in the topic subject would be helpful also :) I love the effect !
Title: Re: ASCII Fireworks
Post by: Clyde on July 12, 2006
Cheers Dude :)
Title: Re: ASCII Fireworks
Post by: taj on September 11, 2006
This is simply GREAT. I love everything about it. I like the faded colours, I like the blockiness , I like the pattern in the blocks, I like ...
ahem...its kinda nice. ;)
Title: Re: ASCII Fireworks
Post by: Clyde on September 11, 2006
Glad you dig it and thanks heaps Taj dude :)
Title: Re: ASCII Fireworks
Post by: ninogenio on September 12, 2006
very very nice clyde,

i really like the colors  :)
Title: Re: ASCII Fireworks
Post by: Clyde on September 12, 2006
Thanks Nino :)