### Author Topic: ASCII Fireworks  (Read 9564 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 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:

#### 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