Simple lightning bolt algo

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
squall4226
Posts: 284
Joined: Dec 21, 2008 15:08
Contact:

Simple lightning bolt algo

Postby squall4226 » Oct 07, 2010 22:37

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




Image

Enjoy.

~Blyss
j_milton
Posts: 458
Joined: Feb 11, 2010 17:35

Postby j_milton » Oct 08, 2010 10:59

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
Posts: 284
Joined: Dec 21, 2008 15:08
Contact:

Postby squall4226 » Oct 08, 2010 19:58

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
Posts: 458
Joined: Feb 11, 2010 17:35

Postby j_milton » Oct 08, 2010 20:35

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
Posts: 284
Joined: Dec 21, 2008 15:08
Contact:

Postby squall4226 » Oct 08, 2010 20:37

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

Word.
Kot
Posts: 336
Joined: Dec 28, 2006 10:34

Postby Kot » Sep 08, 2011 22:10

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
Posts: 88
Joined: Apr 03, 2011 3:44
Location: Inside the bomb
Contact:

Postby Destructosoft » Sep 09, 2011 22:22

The first one is more significant than you might realize. Turn it sideways and you have the Defender background! :)
angros47
Posts: 1565
Joined: Jun 21, 2005 19:04

Postby angros47 » Sep 11, 2011 12:47

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
Posts: 123
Joined: May 28, 2009 20:07

Postby Muttonhead » Sep 13, 2011 20:01

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
Posts: 2392
Joined: May 27, 2005 4:59
Contact:

Postby Dr_D » Sep 13, 2011 22:42

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
Posts: 5532
Joined: Sep 28, 2006 2:41
Location: California, USA

Static Electricity

Postby albert » Nov 11, 2011 14:27

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
Posts: 55
Joined: Mar 19, 2006 11:57
Contact:

Postby attacke » Nov 22, 2011 11:39

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
Posts: 1329
Joined: Jun 04, 2005 9:51

Postby dafhi » Nov 22, 2011 14:03

@attacke

those are some nice-looking bolts
dodicat
Posts: 6232
Joined: Jan 10, 2006 20:30
Location: Scotland

Postby dodicat » Nov 22, 2011 16:38

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
Posts: 1329
Joined: Jun 04, 2005 9:51

Postby dafhi » Nov 23, 2011 13:30

@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%

Return to “Tips and Tricks”

Who is online

Users browsing this forum: Baidu [Spider] and 2 guests