### Author Topic: ASCII Fireworks  (Read 9544 times)

0 Members and 1 Guest are viewing this topic.

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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 StaticOption ExplicitConst XRES=640Const YRES=480Const XRES2=XRES\2Const YRES2=YRES\2Const AXRES=XRES\8Const AYRES=YRES\8Const PI = 3.14151693Const Gravity=0.0175Type Frag          As Integer ID,R,G,B     As Double X, Y, XV, YVEnd TypeDim Shared TotalFragsDim Shared ScreenNoDim Shared MAXFRAGS=10000Dim Shared FireworkDurationDim Shared As Double RunningTime, FireWorkTimerDim Shared Frags(  MAXFRAGS    ) As FragDim 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 DoubleDeclare Function Rand   (ByVal lower as integer, ByVal upper as integer) As IntegerDeclare Function FRand  (ByVal lower as double,  ByVal upper as double ) As doubleInitializeASCII()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        NextEnd SubSub 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 SubSub InitializeASCII()    ScreenRes XRES,YRES,32,3,1 : Screenset 1, 0 : SetMouse   ,,0    WindowTitle "ASCII Fireworks"    Randomize Timer()       ScreenNo = 1   End SubSub 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 SubSub 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 SubFunction Millisecs( ByVal fltTimeValue As Double ) As Double        Return ( fltTimeValue * 1000.00 )    End FunctionFunction 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) + valueEnd 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) + valueEnd 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:

#### Tetra

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

Good JobÂ
Challenge Trophies Won:

#### Clyde

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

Challenge Trophies Won:

#### Rbz

• Founder Member
• Posts: 2731
• Karma: 485
##### Re: ASCII Fireworks
« Reply #3 on: July 12, 2006 »
Can you compile an exe for me ? I'm at work...
Challenge Trophies Won:

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

#### Shockwave

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

#### relsoft

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

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

#### Shockwave

• good/evil
• Founder Member
• Posts: 17378
• Karma: 497
• evil/good
##### 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:

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

#### Rbz

• Founder Member
• Posts: 2731
• Karma: 485
##### Re: ASCII Fireworks
« Reply #9 on: July 12, 2006 »
Very nice, welldone
Challenge Trophies Won:

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

• Atari ST
• Posts: 110
• Karma: 3
##### 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

#### Shockwave

• good/evil
• Founder Member
• Posts: 17378
• Karma: 497
• evil/good
##### Re: ASCII Fireworks
« Reply #12 on: July 12, 2006 »
Yeah good point.
This one was Freebasic.
Shockwave ^ Codigos
Challenge Trophies Won:

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

• Atari ST
• Posts: 110
• Karma: 3
##### 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 !

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

#### taj

• Bytes hurt
• Posts: 4810
• Karma: 189
• Scene there, done that.
##### 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:

#### Clyde

• A Little Fuzzy Wuzzy
• Posts: 7271
• Karma: 71
##### 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:

#### ninogenio

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

i really like the colors
Challenge Trophies Won:

#### Clyde

• A Little Fuzzy Wuzzy