The lightning is drawn with lines, and the fire explosions are drawn with individual pixels.
Code: Select all
' Lightning! v1.0
' (C) 2007 i-TECH and Kristopher Windsor
Const screenx = 800, screeny = 600
Const midx = screenx / 2, midy = screeny / 2
Const ubolt = 3, ulightningbends = 10, shrinkspeed = .7
Type bolt
As Integer lightningbends 'if one, then the lightning is a straight line from top to bottom
As Integer midpointsx(0 To ulightningbends)
As Integer midpointsy(0 To ulightningbends)
As Integer thewidth
As Integer timeleft 'frames until lightning turns off
End Type
Screenres screenx, screeny, 32
Dim As Integer fc, pmx, pmy, pmb, mx, my, mb, p
Dim As Integer st
Dim As Double d
Dim As String key
Dim As bolt bolts(1 To ubolt)
Setmouse midx, midy
Sleep 500
st = Timer
Do
fc += 1
pmx = mx: pmy = my: pmb = mb
Getmouse mx, my,, mb
'redo the first lightning if the mouse moves or a button if pressed / released
If pmx <> mx Or pmy <> my Or pmb <> mb Then bolts(1).timeleft = 0
For a As Integer = 1 To ubolt
With bolts(a)
If .timeleft Then
.timeleft -= 1
Else
If Int(Rnd * 30) = 0 Then 'don't recreate lightning instantly
.lightningbends = my * .01 + 1
'top point
.midpointsx(0) = mx + (200 * Rnd) * Sgn(Rnd - Rnd)
.midpointsy(0) = 0 'top of the screen
'final destination
.midpointsx(.lightningbends) = mx
.midpointsy(.lightningbends) = my
.thewidth = (.midpointsy(.lightningbends) - .midpointsy(0)) * .2
.timeleft = 30 'about one second
'define the jagged midpoints
For b As Integer = 1 To .lightningbends - 1
.midpointsx(b) = (.midpointsx(.lightningbends) + .midpointsx(0)) * .5 + _
(.midpointsx(.lightningbends) - .midpointsx(0)) * _
((.lightningbends - b) / (.lightningbends + 1#)) * (Rnd - Rnd)
.midpointsy(b) = (b / (.lightningbends + 1#)) * _
(.midpointsy(.lightningbends) - .midpointsy(0)) + _
.midpointsy(0) + (Rnd - Rnd) * 10
Next b
End If
End If
End With
Next a
Screenlock
Cls
Print "FPS: " & Int(fc / (Timer - st)) & " "
'Circle (mx, my), 4, &HFFFFFFFF
For a As Integer = 1 To ubolt
With bolts(a)
If .timeleft Then
p = .thewidth / shrinkspeed 'undoes the first shrink
For b As Integer = 0 To .lightningbends - 1
p *= shrinkspeed
For c As Integer = 0 To p
d = Iif(c > p * .5, 1 - c / p, 1 + (c - p) / p) * 3 '*3 gives more white
'Iif handles colors with too much blue
Line (.midpointsx(b) + c, .midpointsy(b)) - _
(.midpointsx(b + 1) + c * shrinkspeed, .midpointsy(b + 1)), _
Rgb(255, 255, Int(255 * Iif(d > 1, 1#, d)))
Next c
Next b
End If
End With
Next a
Screenunlock
Sleep 20
key = Inkey
Loop Until key = Chr(27)
System
Code: Select all
' Fire Works! v1.0
' (C) 2007 i-TECH and Kristopher Windsor
Const screenx = 800, screeny = 600
Const midx = screenx / 2, midy = screeny / 2
Const twopi = 6.283185307179586, upix = 5000, true = -1
Const mode_cancel = 1, mode_bounce = 2, mode_spin = 3, mode_rain = 4
Type dot
As Double d, o
'these can be replaced with constants if the fire is not moving
As Integer x, y
End Type
Screenres screenx, screeny, 32
Dim Shared As Integer fc, mx, my, ms, mb, explosionsize
Dim Shared As Integer mode, xv, yv
Dim Shared As Double st
Dim Shared As String key
Dim Shared As dot pix(1 To upix)
For a As Integer = 1 To upix
With pix(a)
.d = 0
.o = Rnd * twopi
'center of explosion; only used because the explosion can move piece by piece this way
.x = midx
.y = midy
End With
Next a
Setmouse midx, midy
Locate 2, 1
Print "Press keys [1], [2], [3], and [4] for effects,"
Print "the scroll wheel to change the explosion size,"
Print "or the mouse buttons to clear the screen."
Sleep 500
st = Timer
Do
fc += 1
'automatically move the mouse for effect
Select Case mode
Case mode_bounce
'mouse moves and bounces from screen
mx += xv
my += yv
If mx < 0 Then mx = 0: xv =- xv
If mx >= screenx Then mx = screenx: xv =- xv
If my < 0 Then my = 0: yv =- yv
If my >= screeny Then my = screeny: yv =- yv
Setmouse mx, my
Case mode_spin
'mouse spins in circles around the screen (not in an oval shape)
mx = midx + Cos(fc * .1) * midy '+ Cos(fc * .19) * 250 'additional spinning
my = midy + Sin(fc * .1) * midy '+ Sin(fc * .19) * 250
Setmouse mx, my
Case mode_rain
'all pix() rain down the screen
For a As Integer = 1 To upix
With pix(a)
.y += 2
End With
Next a
End Select
'get the mouse after moving it (still gets mb when in bounce mode)
Getmouse mx, my, ms, mb
'find explosion size based on the scroll wheel
explosionsize = Abs(50 + ms * 10)
Select Case Val(key)
Case mode_cancel
mode = mode_cancel 'turn mode off
Setmouse midx, midy
Case mode_bounce
mode = mode_bounce
xv = (Int(Rnd * 12) + 1) * Sgn(Rnd - Rnd)
yv = (Int(Rnd * 12) + 1) * Sgn(Rnd - Rnd)
Case mode_spin
mode = mode_spin
Case mode_rain
mode = mode_rain
End Select
For a As Integer = 1 To upix
With pix(a)
If Int(Rnd * 5) Then
.d += Rnd * 3
Else
If .d > explosionsize Then
.d = 0
.o = Rnd * twopi
.x = mx
.y = my
End If
.d += Rnd * 3
End If
End With
Next a
Screenlock
If mb Then Cls Else Locate 1, 1
Print "FPS: " & Int(fc / (Timer - st)) & " Explosion size: " & explosionsize & " "
For b As Integer = 1 To upix
With pix(b)
Pset (Cos(.o) * .d + .x, Sin(.o) * .d + .y), Rgb(255, .d + .d, 0)
End With
Next b
Screenunlock
Sleep 20
key = Inkey
Loop Until key = Chr(27)
System