Simple lightning bolt algo

[squall4226]

A simple algo I made to do lightning bolts. It doesn't do branched bolts, or make a flash or anything like the one does in my LH Media Player, because the flash brightness was tied to the spectrum analyzer and I didn't feel like redoing it.

Code: Select all

#Include Once "fbgfx.bi"
Using fb
Declare Sub bolt
Dim Shared As UInteger screenx = 640, screeny=480
ScreenRes screenx,screeny,32,2

Sub bolt
	Dim As Integer boltx = Rnd*screenx, bolty=0, boltdir = 2
	'1 = SW
	'2 = S
	'3 = SE
	Do
		Select Case boltdir
			Case 1
				boltx-=1
			Case 2
				'
			Case 3
				boltx+=1
		End Select
		bolty+=1
		PSet  (boltx,bolty),RGB(255,255,255)
		If Rnd*100 <60 Then ' 60 percent chance that we roll for a new direction
			boltdir = Rnd*100
                        '45% chance of SE and SW, only 10% of straight S
                        'These numbers and the 60 above can easily be modified
                        'to produce more eccentric or lazy bolts
			If boltdir < 45 Then boltdir = 1
			If boltdir > 45 And boltdir < 55 Then boltdir = 2
			If boltdir > 55 Then boltdir = 3
		End If
	Loop Until bolty = screeny or boltx > screenx or boltx < 0
'instead of checking the screen boundary you can check for an object
'to make the bolt strike things.


End Sub

'simple demo
Do
	Cls
	bolt
	ScreenCopy
	Sleep 500
Loop While Not MultiKey(SC_ESCAPE)
end

Enjoy.

~Blyss

[j_milton]

Maybe a little tighter and easier to read?

Code: Select all

#Include Once "fbgfx.bi"
Using fb
Declare Sub bolt
Dim Shared As UInteger screenx = 640, screeny=480
ScreenRes screenx,screeny,32,2

Sub bolt
    Dim As Integer boltx = Rnd*screenx, bolty=0, boltdir = 2
    '1 = SW, 2 = S 3 = SE
    Do
        Select Case boltdir
            Case 1
                boltx -=1
            Case 3
                boltx +=1
        End Select
        bolty+=1
        PSet  (boltx,bolty),RGB(255,255,255)
        If Rnd < 0.6 Then ' 60 percent chance that we roll for a new direction
            '45% chance of SE and SW, only 10% of straight S
            'These numbers and the 60 above can easily be modified
            'to produce more eccentric or lazy bolts
            Select Case Rnd
                Case Is < 0.45
                    boltdir = 1
                Case 0.45 To 0.55
                    boltdir = 2
                Case Else
                    boltdir = 3            
            End Select
        End If
    Loop Until bolty = screeny or boltx > screenx or boltx < 0
'instead of checking the screen boundary you can check for an object
'to make the bolt strike things.
End Sub

'simple demo
Do
        Cls
        bolt
        ScreenCopy
        Sleep 500
Loop While Not MultiKey(SC_ESCAPE)
end

[squall4226]

Dude I did not know you could SELECT CASE RND. Also I did not know how to do CASE IS < 0.45 I would just try CASE < 0.45 and that doesn't work. Thanks!

[j_milton]

Yep , you can in fact do

select case <expression>

so that could be somthing like

select case sqr(x)

or

select case lcase(mid(somestring, 3,7))

if you wanted

[squall4226]

That is most excellent. Haha I go to post a silly lightning bolt and now I've learned three new things.

Word.

[Kot]

This one I think looks more realistic:

Code: Select all

Const ResX As Integer=800, ResY As Integer=600
Dim As Integer NumOfPoints=3
Dim KeyPressed As String*1
Type tPoint
	x As Integer
	y As Integer
End Type
Randomize Timer
ScreenRes ResX, ResY,24
Do
ReDim As tPoint Lightning(1 To NumOfPoints), LightningTMP() 
Lightning(1).y=ResY*Rnd:Lightning(1).x=0
Lightning(3).y=ResY*Rnd:Lightning(3).x=ResX
Lightning(2).x=(Lightning(1).x+Lightning(3).x)/2
Lightning(2).y=(Lightning(1).y+Lightning(3).y)/2+Rnd*.5*(Lightning(3).x-Lightning(1).x)-.5*(Lightning(3).x-Lightning(1).x)/2
For i As Integer=1 To 10
	ReDim LightningTMP(2*UBound(Lightning)-1)
	Dim Index As Integer=1
	For j As Integer=1 To UBound(Lightning)
		LightningTMP(Index)=Lightning(j)
		Index+=2
	Next j
	ReDim Lightning(UBound(LightningTMP))
	For j As Integer=1 To UBound(Lightning)
		Lightning(j)=LightningTMP(j)
	Next j
	For j As Integer=2 To UBound(Lightning)-1
		If Lightning(j).x=0 Then
			Lightning(j).x=(Lightning(j-1).x+Lightning(j+1).x)/2
			Lightning(j).y=(Lightning(j-1).y+Lightning(j+1).y)/2+Rnd*.35*(Lightning(j+1).x-Lightning(j-1).x)-.35*(Lightning(j+1).x-Lightning(j-1).x)/2
		EndIf
	Next j
Next i
Cls
'first set of colors ***********************
/'For PointNum As Integer=1 To UBound(Lightning)
	PSet (Lightning(PointNum).x,Lightning(PointNum).y-2), &hff30ff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y-1), &hffe0ff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y), &hffffff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y+1), &hffe0ff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y+2), &hff30ff
Next PointNum'/
'second set of colors **********************
For PointNum As Integer=1 To UBound(Lightning)
	PSet (Lightning(PointNum).x,Lightning(PointNum).y-2), &h698fff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y-1), &hffe0ff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y), &hffffff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y+1), &hffe0ff
	PSet (Lightning(PointNum).x,Lightning(PointNum).y+2), &h698fff
Next PointNum
Do
	Sleep 1
	KeyPressed=InKey
Loop While KeyPressed=""
If KeyPressed=Chr(27) Then Exit Do
Loop

[Destructosoft]

The first one is more significant than you might realize. Turn it sideways and you have the Defender background! :)

[angros47]

Try this variant:

Code: Select all

#Include Once "fbgfx.bi"
Using fb
Declare Sub bolt
Dim Shared As UInteger screenx = 640, screeny=480
ScreenRes screenx,screeny,32,2

Sub bolt
        Dim As Integer boltx = Rnd*screenx, bolty=0, boltdir = 2
        '1 = SW
        '2 = S
        '3 = SE
        Do
                Select Case boltdir
                        Case 1
                                boltx-=1
                        Case 2
                                '
                        Case 3
                                boltx+=1
                End Select
                bolty+=1
                PSet  (boltx,bolty),RGB(bolty/15*8,255,255)
                if bolty<440 then PSet  (boltx+1,bolty),RGB(255-bolty/15*8,255,bolty/15*8)
                if bolty<320 then PSet  (boltx-1,bolty),RGB(255-bolty/15*8,255,bolty/15*8)
                if bolty<160 then PSet  (boltx-2,bolty),RGB(255,255,0)
                if bolty<80 then PSet  (boltx+1,bolty),RGB(255,255,0)
                If Rnd*100 <60 Then ' 60 percent chance that we roll for a new direction
                        boltdir = Rnd*100
                        '45% chance of SE and SW, only 10% of straight S
                        'These numbers and the 60 above can easily be modified
                        'to produce more eccentric or lazy bolts
                        If boltdir < 45 Then boltdir = 1
                        If boltdir > 45 And boltdir < 55 Then boltdir = 2
                        If boltdir > 55 Then boltdir = 3
                End If
        Loop Until bolty = screeny or boltx > screenx or boltx < 0
'instead of checking the screen boundary you can check for an object
'to make the bolt strike things.


End Sub

'simple demo
Do
        Cls
        bolt
        ScreenCopy
        Sleep 500
Loop While Not MultiKey(SC_ESCAPE)
end

[Muttonhead]

Code: Select all

declare sub bolt (s as integer, e as integer, mode as integer=0)
dim shared as integer screenx = 640, screeny=480
screenres screenx,screeny,32,2
dim shared as integer boltarray(screeny-1),level,boltpos
level=100
boltpos=screenx / 2
randomize timer

do
  bolt(0,ubound(boltarray))
  pset(boltpos+boltarray(0),0),&HFFFFFF
  for i as integer=1 to ubound(boltarray)
    line -(boltpos+ boltarray(i),i),&HFFFFFF
  next i
  sleep 100
  cls
loop until inkey<>""
end

sub bolt (s as integer, e as integer, mode as integer=0)
  static as integer diff
  dim as integer actdiff,center
  dim as single actlevel

  if mode=0 then
    boltarray(s)=rnd*level * sgn(rnd-.5)
    boltarray(e)=rnd*level * sgn(rnd-.5)
    diff=e-s
  end if

  actdiff=e-s
  actlevel=actdiff/diff * level

  center=s +(e-s)/2

  if (center<>s) and (center<>e) then boltarray(center)=(boltarray(e)+boltarray(s))/2  + rnd*actlevel*sgn(rnd-.5)

  if center-s>1 then bolt(s,center,1)
  if e-center>1 then bolt(center,e,1)
end sub

another interesting effect:

Code: Select all

sub bolt (s as integer, e as integer, mode as integer=0)
  static as integer diff
  dim as integer actdiff,center
  dim as single actlevel

  if mode=0 then
    boltarray(s)=0'<----!!!
    boltarray(e)=0'<----!!!
    diff=e-s
  end if

  actdiff=e-s
  actlevel=actdiff/diff * level

  center=s +(e-s)/2

  if (center<>s) and (center<>e) then boltarray(center)=(boltarray(e)+boltarray(s))/2  + rnd*actlevel*sgn(rnd-.5)

  if center-s>1 then bolt(s,center,1)
  if e-center>1 then bolt(center,e,1)
end sub

[Dr_D]

Hehehe... cool stuff. :) It reminds me of something I made for a game a while back. I had to add in the op overloading & stuff directly in the file... so it's kinda huge for such a simple demo. :p

Code: Select all

#include "fbgfx.bi"

const pi=3.1415926, pi2 = pi*2


type vec2f
    x as single
    y as single
    
    declare constructor () 
    declare constructor ( byval x as single, byval y as single )
    
    declare function distance( byref v as vec2f ) as single
end type

constructor vec2f ()
end constructor


constructor vec2f ( byval x as single, byval y as single )
    
	this.x = x
	this.y = y
    
end constructor


function vec2f.distance( byref v as vec2f ) as single
    
	return sqr((v.x - this.x)^2 + (v.y - this.y)^2)
    
end function


operator + ( byref lhs as vec2f, byref rhs as vec2f ) as vec2f
    
	return type<vec2f>( lhs.x + rhs.x, lhs.y + rhs.y )
    
end operator


operator - ( byref lhs as vec2f, byref rhs as vec2f ) as vec2f
    
	return type<vec2f>( lhs.x - rhs.x, lhs.y - rhs.y )
    
end operator


operator * ( byref lhs as vec2f, byref rhs as single ) as vec2f
    
	return type<vec2f>( lhs.x * rhs, lhs.y * rhs )
    
end operator 


operator / ( byref lhs as vec2f, byref rhs as single ) as vec2f
    
    return type<vec2f>(lhs.x / rhs, lhs.y / rhs)
    
end operator


screenres 640,480,32,1,FB.GFX_ALPHA_PRIMITIVES

type lstruct
    a as single
    p as vec2f
end type



dim as single radius = 5
dim as vec2f posit = vec2f(320f,240f)


dim as double this_time

dim as lstruct rpoint(1 to 20, 1 to 10)

do
    this_time = timer
    
    screenlock
    cls
    radius = 150+140*sin(this_time)
    
    
    for i as integer = 1 to 20
        
        dim as single rangle = rnd*pi2
        rpoint(i,1).a = rangle
        rpoint(i,1).p = posit + vec2f(radius/5*sin(rangle), radius/5*cos(rangle) )
        
        for r as integer = 2 to 10
            dim as single nr = radius/10
            rangle = rpoint(i,r-1).a -.75+rnd*1.5
            rpoint(i,r).a = rangle
            rpoint(i,r).p = rpoint(i,r-1).p + vec2f(nr*sin(rangle), nr*cos(rangle) )
            
            dim as single bcheck = ((rpoint(i,r).p.y - posit.y)^2) + ((rpoint(i,r).p.x - posit.x)^2)
            if bcheck>radius^2 or r = 10 then
                dim as single dist = rpoint(i,r).p.Distance(posit)
                rpoint(i,r).p = posit + ( rpoint(i,r).p - posit ) / dist * radius
            end if
        next
        
    next
    
    for i as integer = radius to radius/5 step -1
        circle(posit.x, posit.y), i, rgb(0,0,255-(255*((i-1)/radius))),,,,f
    next
    circle(posit.x, posit.y),radius/5,rgb(0,0,0),,,,f

    dim as integer c
    for i as integer = 1 to 20
        for r as integer = 2 to 10
            c = 255-(255*(r/10))
            line(rpoint(i,r-1).p.x, rpoint(i,r-1).p.y)-(rpoint(i,r).p.x, rpoint(i,r).p.y),rgba(255,255,0,c)
        next
    next
    
    screensync
    screenunlock
    
    sleep 3,1
loop until multikey(fb.sc_escape)


sleep

[albert]

Heres one i did a few months ago.
I made it go side to side, it could just go down. but would need a wider spread.

Code: Select all

dim as integer xres,yres
screen 19
screeninfo xres,yres
screenres xres,yres

dim as integer lines = 4

dim as integer direction_L(1 to lines)
dim as integer direction_R(1 to lines)

dim as integer x_L(1 to lines)
dim as integer x_R(1 to lines)

dim as integer y_L(1 to lines)
dim as integer y_R(1 to lines)

dim as integer toggle=0

do
    if toggle = 0 then 
        for a as integer = 1 to lines
            x_L(a)=0
            y_L(a)=yres/2
            
            x_R(a)=xres
            y_R(a)=yres/2
        next
        toggle=1
    end if
    
    for a as integer = 1 to lines
        direction_L(a) = (rnd*3)+1
        direction_R(a) = (rnd*3)+1
    next
    
    for a as integer = 1 to lines
        select case direction_L(a)
            case 1 
                x_L(a)=x_L(a)-1
                y_L(a)=y_L(a)+1
            case 2
                x_L(a)=x_L(a)+1
                y_L(a)=y_L(a)+1
            case 3 
                x_L(a)=x_L(a)+1
                y_L(a)=y_L(a)-1
            case 4
                x_L(a)=x_L(a)-1
                y_L(a)=y_L(a)-1
        end select
        select case direction_R(a)
            case 1 
                x_R(a)=x_R(a)+1
                y_R(a)=y_R(a)-1
            case 2
                x_R(a)=x_R(a)-1
                y_R(a)=y_R(a)+1
            case 3 
                x_R(a)=x_R(a)-1
                y_R(a)=y_R(a)-1
            case 4
                x_R(a)=x_R(a)+1
                y_R(a)=y_R(a)+1
        end select
    next
    
    for a as integer = 1 to lines
        pset(x_L(a),y_L(a)),15 'rnd*256
        pset(x_R(a),y_R(a)),15 'rnd*256
    next
    
    if x_L(1)>=xres then if toggle=1 then toggle=0:cls else toggle = 0:cls
    
loop until inkey<>""
    

sleep

[attacke]

this is my version of it.

the bolt is chasing the pointer.

Code: Select all

Const PI As Single = Atn(1.0)*4
Const PI180 As Single = pi/180

#Define SinD(ang) (Sin((ang)*pi180))
#Define CosD(ang) (Cos((ang)*pi180))

Declare sub bolt (s as integer, e as integer, mode as integer=0)
Declare Function getDistance(x As Single, y As Single,x2 As Single = 0, y2 As Single = 0) As Single
Declare Function getDegree(x As Single, y As Single) As Single

Dim Shared as Integer screenx = 1024, screeny=768
Dim As Integer			sx2 = screenX/2, sy2 = screeny/2
Dim Shared as Integer boltarray(screenx*2),level,boltpos

screenres screenx,screeny,32
level=100
randomize timer



Dim As Integer		mx, my, lmx, lmy, dst, ax, ay
Dim As Single		ang, ang2, activePosX, activePosY

activePosX = sx2
activePosY = sy2

Do
	ScreenLock
	Cls
	
	' quick and dirty correction of mousepointer is outside.
	lmx = mx
	lmy = my
	GetMouse mx, my
	If( mx=-1 ) Then
		mx=lmx
		my=lmy
	EndIf
	
	'get the new position, 5% of the diffrence from the bolt to the cursor.
	activePosX -= (activePosX-mx)*.05
	activePosY -= (activePosY-my)*.05
	
	'get the distance of the mousepointer from the center
	dst = getDistance( activePosX-sx2, activePosY-sy2 )
	
	'set the bolt level due to the distance, but we dont want it to big.
	level = dst/4
	If( level>100 )Then level=100
	
	'get the angle of the bolt and then calculate it
	ang = getDegree( activePosX-sx2, activePosY-sy2 )
	bolt(0,dst)
	
	pset( sx2, sy2 ),&HFFFFFF
	for i as integer=1 to dst
		'get the active degree of the lightning position
		ax = boltArray(i)
		ay = i
		ang2 = getDegree( ax, ay )-180
		
		'draw it up something like: mouseAngle+lightningAngle
		line -( sx2+ i*sind(ang+ang2), sy2 - i*cosd(ang+ang2) ),&HFFFFFF
		
	next i
	
	ScreenUnLock
	sleep 10
loop until inkey<>""
end

'no modifications here.
sub bolt (s as integer, e as integer, mode as integer=0)
  static as integer diff
  dim as integer actdiff,center
  dim as single actlevel

  if mode=0 then
    boltarray(s)=0
    boltarray(e)=0
    diff=e-s
  end if

  actdiff=e-s
  actlevel=actdiff/diff * level

  center=s +(e-s)/2

  if (center<>s) and (center<>e) then boltarray(center)=(boltarray(e)+boltarray(s))/2  + rnd*actlevel*sgn(rnd-.5)

  if center-s>1 then bolt(s,center,1)
  if e-center>1 then bolt(center,e,1)
end Sub

'returns the distance
Function getDistance(x As Single, y As Single,x2 As Single = 0, y2 As Single = 0) As Single
	Return Sqr((x-x2)^2+(y-y2)^2)
End Function

'returns the degree of a point where top=0 right=90 bottom=180 left=270
Function getDegree(x As Single, y As Single) As Single
	Dim degree As Single
	
	degree = ( Atn(Abs(y) / Abs(x)) / (pi180) )+90
	
	If x = 0 Then
		If ( y > 0 ) Then 
			degree = 180
		End If
		If ( y < 0 ) Then 
			degree = 0
		End If
	End If
	
	If ( x > 0 ) Then
		If ( y < 0 )Then 
			degree = 180 - degree
		End If
		If ( y > 0 ) Then 
			degree = degree
		End If
	End If
	
	If ( x < 0 ) Then
		If ( y < 0 ) Then 
			degree = 180 + degree
		End If
		If ( y >= 0 ) Then 
			degree = 360 - degree
		End If
	End If
	
	Return degree
End Function

uses modified code from Muttonhead

[dafhi]

@attacke

those are some nice-looking bolts

[dodicat]

Here's my modest contribution.

All this stuff reminds me of the time when Dodicat himself was struck by lightning while walking along the strand in Portobello.

But he is such a big headed dandy, he thought someone had taken his picture.

Code: Select all

screen 19,32
type pair
    as integer x,y
end type
do
    randomize
redim as pair node(int(rnd*15))
node(0)=type(rnd*600,rnd*10)
dim as integer k=2+rnd*4
screenlock
cls
if val(right(time,1))> rnd*20 then
paint(0,0),rgb(k*5,20,k*10)
for z as integer=1 to ubound(node)
    node(z)=type(node(z-1).x+(rnd*100-rnd*100),node(z-1).y+rnd*200)
    for z2 as integer=-k to k
    line(node(z-1).x+z2,node(z-1).y)-(node(z).x-z2,node(z).y),rgb(200,200,255)
    next z2
next
end if
screenunlock
sleep 60'1,1
loop until inkey=chr(27)
sleep

[dafhi]

@dodicat

There's a sense of impressionism to that. The air crackles, and the humidity is present. It's also up close and personal. You paint the atmosphere well. I live in a desert section of the pacific northwest (usa) where avg humidity is 43%