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:
'
' 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
