Author Topic: ASCII Fireworks  (Read 9325 times)

0 Members and 1 Guest are viewing this topic.

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
ASCII Fireworks
« 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
« Last Edit: July 12, 2006 by Clyde »
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Tetra

  • DBF Aficionado
  • ******
  • Posts: 2532
  • Karma: 83
  • Pirate Monkey!
    • View Profile
Re: ASCII Fireworks
« Reply #1 on: July 12, 2006 »
Very cool m8Â  8)
Thats very nicely done,  it looks great.

Good Job  ;D
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #2 on: July 12, 2006 »
Cheers Dude. :D
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Rbz

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 2721
  • Karma: 484
    • View Profile
    • http://www.rbraz.com/
Re: ASCII Fireworks
« Reply #3 on: July 12, 2006 »
Can you compile an exe for me ? I'm at work...
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #4 on: July 12, 2006 »
Sure thing mate, it's added to the initial topic.
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: ASCII Fireworks
« Reply #5 on: July 12, 2006 »
That's really really cool.
Lovely colours used there Clyde!
Shockwave ^ Codigos
Challenge Trophies Won:

Offline relsoft

  • DBF Aficionado
  • ******
  • Posts: 3303
  • Karma: 47
    • View Profile
Re: ASCII Fireworks
« Reply #6 on: July 12, 2006 »
Really nize!!!!

So we could use more than 16 colors?
Challenge Trophies Won:

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: ASCII Fireworks
« Reply #7 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.
Shockwave ^ Codigos
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #8 on: July 12, 2006 »
Thanks all, really appreciate it.

Cheers,
Clyde
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Rbz

  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 2721
  • Karma: 484
    • View Profile
    • http://www.rbraz.com/
Re: ASCII Fireworks
« Reply #9 on: July 12, 2006 »
Very nice, welldone  :)
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #10 on: July 12, 2006 »
Cheers Rbraz.
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Dad1916

  • Atari ST
  • ***
  • Posts: 110
  • Karma: 3
    • View Profile
    • Quadriga demo group
Re: ASCII Fireworks
« Reply #11 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

Offline Shockwave

  • good/evil
  • Founder Member
  • DBF Aficionado
  • ********
  • Posts: 17376
  • Karma: 497
  • evil/good
    • View Profile
    • My Homepage
Re: ASCII Fireworks
« Reply #12 on: July 12, 2006 »
Yeah good point.
This one was Freebasic.
Shockwave ^ Codigos
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #13 on: July 12, 2006 »
I have actually in Bold letters stated FREEBASIC Code before the code.
Please back on topic. Cheers.
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline Dad1916

  • Atari ST
  • ***
  • Posts: 110
  • Karma: 3
    • View Profile
    • Quadriga demo group
Re: ASCII Fireworks
« Reply #14 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 !

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #15 on: July 12, 2006 »
Cheers Dude :)
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline taj

  • Bytes hurt
  • DBF Aficionado
  • ******
  • Posts: 4810
  • Karma: 189
  • Scene there, done that.
    • View Profile
Re: ASCII Fireworks
« Reply #16 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. ;)
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #17 on: September 11, 2006 »
Glad you dig it and thanks heaps Taj dude :)
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won:

Offline ninogenio

  • Pentium
  • *****
  • Posts: 1666
  • Karma: 133
    • View Profile
Re: ASCII Fireworks
« Reply #18 on: September 12, 2006 »
very very nice clyde,

i really like the colors  :)
Challenge Trophies Won:

Offline Clyde

  • A Little Fuzzy Wuzzy
  • DBF Aficionado
  • ******
  • Posts: 7271
  • Karma: 71
    • View Profile
Re: ASCII Fireworks
« Reply #19 on: September 12, 2006 »
Thanks Nino :)
Still Putting The IT Into Gravy
If Only I Knew Then What I Know Now.

Challenge Trophies Won: