Simple lightning bolt algo

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Post by dodicat »

dafhi wrote:@dodicat

---- I live in a desert section of the pacific northwest (usa) where avg humidity is 43%
Well dafhi, we are half a planet apart.
They say about 1.5 billion strikes occur per year.
Each strike produces a little nitric acid to help the plants grow.
Dust in the atmosphere swirls around and settles, this gives the plants nutrition.
Soil builds by about an inch every thousand years.
You and I are drifting apart by about 5 cm. per year.
They say that the ice particles arriving from space over the eons would be enough to fill the oceans and rivers.
Darwin said about the British Isles, when you view the landscape, everything you see has passed through an earthworm.

This biosphere seems to have been built by accretion, we are reaping the harvest of 4.6 billion years.
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Post by Dr_D »

dafhi wrote:@dodicat
Darwin said about the British Isles, when you view the landscape, everything you see has passed through an earthworm.
makes me feel all warm and fuzzy(fungus?) inside. :p
attacke
Posts: 55
Joined: Mar 19, 2006 11:57
Contact:

Post by attacke »

dodicat wrote: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

wow!
i like the comic feeling of that lightning, typical bolt level 2 in ff6 or so :)
Muttonhead
Posts: 138
Joined: May 28, 2009 20:07

Post by Muttonhead »

@dodicat:
... Reminds me of the intro of an old (Amiga) game "Another World"
and now?
And now I am playing with the 15th anniversary version
:D
sero
Posts: 59
Joined: Mar 06, 2018 13:26
Location: USA

Re: Simple lightning bolt algo

Post by sero »

I was looking for a lightning algorithm and came across this old thread. Here is my contribution based on attacke's example. I stripped away the conversion from radian to degree ( and back again ) and changed some of the core routine.

Image

Code: Select all

#define min( v, x ) _
  iif( v < x, v, x )
#define max( v, x ) _
  iif( v > x, v, x )
  
declare sub lightning_bolt( _
  byref _start_x as long, _
  byref _start_y as long, _
  byref _end_x as long, _
  byref _end_y as long, _
  byref _magnitude as long = 3, _
  byref _color as ulong = rgb( 191, 215, 255 ) )

dim as long screen_x = 640
dim as long screen_y = 480
dim as long screen_x_half = screen_x shr 1
dim as long screen_y_half = screen_y shr 1

dim as long mx, my

screenres screen_x, screen_y, 32
setmouse( ,, 0 )

do
  getmouse mx, my
  screenlock()
    line( 0, 0 )-( screen_x - 1, screen_y - 1 ), rgb( 0, 0, 0 ), bf
    
    'lightning_bolt( mx, my, _
    '  screen_x_half, screen_y_half, _
    '  2, rgb( 39, 127, 191 ) )
    
    'lightning_bolt( _
    '  screen_x_half, screen_y_half, _
    '  mx, my, _
    '  1 )
    
    lightning_bolt( _
      mx, my, _
      screen_x_half, screen_y_half )
    
  screenunlock()
  sleep 15
loop while( inkey = "" )

sub lightning_bolt( _
  byref _start_x as long, _
  byref _start_y as long, _
  byref _end_x as long, _
  byref _end_y as long, _
  byref _magnitude as long = 3, _
  byref _color as ulong = rgb( 191, 215, 255 ) )
  #define deviation_limiter   7
  #define step_amount         3
  
  dim as long _distance_x = _start_x - _end_x
  dim as long _distance_y = _start_y - _end_y
  dim as single _angle = atan2( _distance_y, _distance_x )
  dim as single _distance = sqr( ( _distance_x * _distance_x ) + _
                               ( _distance_y * _distance_y ) )
  dim as single _center = _distance / 2
  
  dim as single _previous_deviation = 0
  dim as single _current_deviation
  
  dim as single _magnitude_ratio = 1 / deviation_limiter
  dim as single _step
  
  pset ( _start_x, _start_y ), _color
  for _step = 1 to _center step step_amount   ' First half of lightning bolt
    _current_deviation = _previous_deviation + ( _magnitude * ( rnd - .5 ) )
    if( _current_deviation < 0 ) then
      _distance_y = ( ( _center - ( _center - _step ) ) * -_magnitude_ratio )
      if( _current_deviation < _distance_y ) then _
        _current_deviation = _distance_y * 1
    else
      _distance_y = ( ( _center - ( _center -_step ) ) * _magnitude_ratio )
      if( _current_deviation > _distance_y ) then _
        _current_deviation = _distance_y * 1
    endif
    _previous_deviation = _current_deviation
    line -( _start_x - ( cos( _angle ) * _step ) + _
          ( ( sin( _angle ) * _current_deviation ) ), _
            _start_y - ( sin( _angle ) * _step ) - _
          ( ( cos( _angle ) * _current_deviation ) ) ), _
            _color
  next _step
  for _step = ( _center + 1 ) to _distance step step_amount   ' Last half of lightning bolt
    _current_deviation = _previous_deviation + ( _magnitude * ( rnd - .5 ) )
    if( _current_deviation < 0 ) then
      _distance_y = ( ( _distance - _step ) * -_magnitude_ratio )
      if( _current_deviation < _distance_y ) then _
        _current_deviation = _distance_y * 1
    else
      _distance_y = ( ( _distance - _step ) * _magnitude_ratio )
      if( _current_deviation > _distance_y ) then _
        _current_deviation = _distance_y * 1
    endif
    _previous_deviation = _current_deviation
    line -( _start_x - ( cos( _angle ) * _step ) + _
          ( ( sin( _angle ) * _current_deviation ) ), _
            _start_y - ( sin( _angle ) * _step ) - _
          ( ( cos( _angle ) * _current_deviation ) ) ), _
            _color
  next _step
  pset ( _end_x, _end_y ), _color
end sub
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple lightning bolt algo

Post by dodicat »

Here is an old one.

Code: Select all

#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define da rnd*90-rnd*90
#define dl rnd*20
sub drawline(x as integer,y as integer,angle as double,length as double,col as uinteger,byref x2 as integer=0,byref y2 as integer=0)
    angle=angle*.0174532925199433 
     x2=x+length*cos(angle)
     y2=y-length*sin(angle)
     for k as integer=-2 to 2
     line(x,y+k)-(x2,y2+k),col
     next k
end sub

sub wire(x1 as integer,y1 as integer,x2 as integer)
    dim as single r=10,pi=4*atn(1),count,min,max
    for z as single=x1 to x2-2*r step 2*r
        count+=1
        if count mod 2 then min=0:max=pi else min=pi:max=2*pi
        circle(z,y1),r,rgb(200,200,200),min,max
        next z
    end sub

sub spark
    static as single inc
    inc+=.1
    dim as integer x2=200,y2=300+100*sin(inc),x,y
        do
drawline(x2,y2,da,dl,rgb(200,200,255),x,y)
x2=x
y2=y
loop until x>570
end sub

screen 19,32,,64

do

screenlock
line(0,0)-(799,599),rgba(0,0,0,150),bf
'===============================
wire(0,300,200)
line(190,50)-(200,550),rgb(255,255,255),b
spark
line(580,50)-(590,550),rgb(255,255,255),b
wire(600,300,800)
screenunlock
sleep 50,1
loop until len(inkey)
sleep
  
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Simple lightning bolt algo

Post by UEZ »

Here some kind of electricity:

Code: Select all

'Coded by UEZ build 2023-01-26
#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

'Perlin Noise by Joshy aka D.J. Peters
Type REAL As Single
#Define rAbs(x_)				Iif( (x_) < 0, -(x_), (x_) )
Const As REAL rPI              	= Acos(-1)
Const As REAL rDeg2Rad         	= rPI / 180

Type PERLINNOISE 
	Declare Constructor
	Declare Sub NoiseSeed(Byval seed As Double)
	Declare Sub NoiseDetail(Byval lod As Integer)
	Declare Sub NoiseDetail(Byval lod As Integer, Byval falloff As REAL)
	Declare Function Noise1D(Byval x As REAL) As REAL
	Declare Function Noise2D(Byval x As REAL,Byval y As REAL) As REAL
	Declare Function Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL
Private:
	Const As REAL    SINCOS_PRECISION = 0.5
	Const As Integer SINCOS_LENGTH    = (360 / SINCOS_PRECISION)
	Const As Integer PERLIN_YWRAPB    = 4
	Const As Integer PERLIN_YWRAP     = 1 Shl PERLIN_YWRAPB
	Const As Integer PERLIN_ZWRAPB    = 8
	Const As Integer PERLIN_ZWRAP     = 1 Shl PERLIN_ZWRAPB
	Const As Integer PERLIN_SIZE      = 4095
	Const As Integer PERLIN_TWOPI     = SINCOS_LENGTH
	Const As Integer PERLIN_PI        = PERLIN_TWOPI Shr 1
	As Integer perlin_octaves   	  = 4   ' default To medium smooth
	As REAL  perlin_amp_falloff 	  = 0.5 ' 50% reduction/octave
	As REAL  perlin_cosTable(SINCOS_LENGTH-1)
	As REAL  perlin(PERLIN_SIZE)
	Declare Sub reInit
	Declare Function noise_fsc(Byval i As REAL) As REAL
End Type

Constructor PERLINNOISE 
	For i As Integer = 0 To SINCOS_LENGTH - 1
		perlin_cosTable(i) = Cos(i * rDEG2RAD * SINCOS_PRECISION)
	Next
	reInit
End Constructor

Sub PERLINNOISE.reInit 
	For i As Integer = 0 To PERLIN_SIZE
		perlin(i) = Rnd()
	Next
End Sub

Function PERLINNOISE.noise_fsc(Byval i As REAL) As REAL 
	Dim As Integer index = Int(i * PERLIN_PI)
	Return 0.5 * (1.0 - perlin_cosTable(index Mod SINCOS_LENGTH))
End Function

Sub PERLINNOISE.noiseSeed(Byval seed As Double) 
	'Randomize(0) ' !!!
	Randomize(seed) : reInit
End Sub

Sub PERLINNOISE.noiseDetail(Byval lod As Integer) 
	If (lod > 0) Then perlin_octaves = lod
End Sub

Sub PERLINNOISE.noiseDetail(Byval lod As Integer, Byval falloff As REAL) 
	If (lod > 0) Then perlin_octaves = lod
	If (falloff > 0) Then perlin_amp_falloff = falloff
End Sub

Function PERLINNOISE.Noise1D(Byval x As REAL) As REAL 
	Return noise3D(x, 0, 0)
End Function

Function PERLINNOISE.Noise2D(Byval x As REAL, Byval y As REAL) As REAL 
	Return noise3D(x, y, 0)
End Function

Function PERLINNOISE.Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL 
	x = rAbs(x) : y = rAbs(y) : z = rAbs(z)
	Dim As Integer xi = Int(x), yi = Int(y), zi = Int(z)
	Dim As REAL xf = x - xi, yf = y - yi, zf = z - zi
	Dim As REAL r, ampl = 0.5
	For i As Integer = 0 To perlin_octaves - 1
		Dim As Integer of= xi + (yi Shl PERLIN_YWRAPB) + (zi Shl PERLIN_ZWRAPB)
		Dim As REAL rxf = noise_fsc(xf)
		Dim As REAL ryf = noise_fsc(yf)
		Dim As REAL n1 = perlin(of And PERLIN_SIZE)
		n1 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n1)
		Dim As REAL n2 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
		n2 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n2)
		n1 += ryf * (n2 - n1)
		of += PERLIN_ZWRAP
		n2  = perlin(of And PERLIN_SIZE)
		n2 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n2)
		Dim As REAL n3 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
		n3 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n3)
		n2 += ryf * (n3 - n2)
		n1 += noise_fsc(zf) * (n2 - n1)
		r += n1 * ampl
		ampl *= perlin_amp_falloff
		xi Shl = 1: xf *= 2
		yi Shl = 1: yf *= 2
		zi Shl = 1: zf *= 2
		If (xf >= 1) Then xi += 1 : xf -= 1
		If (yf >= 1) Then yi += 1 : yf -= 1
		If (zf >= 1) Then zi += 1 : zf -= 1
	Next
	Return r
End Function
'End Perlin Noise

#Define _Alpha(iCol)	((iCol And &hFF000000) Shr 24)
#Define _Red(iCol)		((iCol And &h00FF0000) Shr 16)
#Define _Green(iCol)	((iCol And &h0000FF00) Shr 8)
#Define _Blue(iCol)		((iCol And &h000000FF))

Function ColBlend(col1 As Ulong, col2 As Ulong, blend As Single) As Ulong
	Dim As Ubyte a1 = _Alpha(col1), a2 = _Alpha(col2), r1 = _Red(col1), r2 = _Red(col2), g1 = _Green(col1), g2 = _Green(col2), b1 = _Blue(col1), b2 = _Blue(col2)
	Dim As Single bl = 1 - blend
	Return Rgba(r1 * blend + r2 * bl, g1 * blend + g2 * bl, b1 * blend + b2 * bl, a1 * blend + a2 * bl)
End Function

Sub LineAA(x1 As Single, y1 As Single, x2 As Single, y2 As Single, thickness As Single = 1, col As Ulong, pImage As Any Ptr = 0)
	Dim As Single dist, db, n, nn, px, py, sensX, sensY, th, dx, dy, CosAngle, SinAngle, Factor, w = x2 - x1, h = y2 - y1
	If w >= 0 Then
		sensX = 1
	Else
		sensX = -1
		w = -w
	Endif
	If h >= 0 Then
		sensY = 1
	Else
		sensY = -1
		h =- h
	Endif
	th = thickness / 2
	dist = Sqr(w * w + h * h)
	CosAngle = w / dist
	SinAngle = -Sin(Acos(CosAngle))
	For n = -thickness To w + thickness
		For nn=-thickness To h + thickness
			dx =n * CosAngle - nn * SinAngle
			dy = Abs(n * SinAngle + nn * CosAngle)
			
			If dy <= th + 0.5 Then
				Factor = 0.5 + th - dy
				If Factor > 1 Then
					Factor = 1
				Endif
				If dx > -1 And dx < dist + 1 Then
					If dx < 0 Then
						Factor *= 1 + dx
					Elseif dx > dist Then
						Factor *= (1 - dx + dist)
					Endif
				Else
					Factor = 0
				Endif
				If Factor > 0 Then
					If Factor < 1 Then
						px = x1 + n * SensX : py = y1 + nn * SensY
						Pset pImage, (px, py), ColBlend(col, Point (px, py, pImage), Factor)
					Else
						Pset pImage, (x1 + n * SensX, y1 + nn * SensY), col
					Endif
				Endif
			Endif
		Next
	Next
End Sub

Const w = 1920 Shr 0
Const h = 1080 Shr 0
Const w2 = w Shr 1
Const h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFF, &h80000000

Randomize, 2

Dim As Ulong iFPS, cfps = 0
Dim As Double fTimer = Timer
Dim Shared As PERLINNOISE Perlin

Sub Blitz3(x1 As Double, y1 As Double, rd As Long, d As Long = 0)
	If rd < 1 Then Exit Sub
	Dim As Double x2, y2
	Select Case d
		Case 0
			x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 50 - 24.5
			y2 = y1 + Perlin.Noise1D(y1) * 20
		Case 1
			x2 = x1 - Perlin.Noise1D(Rnd() * y1) * 100
			y2 = y1 + Perlin.Noise1D(y1) * 100
			If Rnd() > 0.1 Then 
				Blitz3(x2, y2, rd - 8, 0)
			Else
				Blitz3(x2, y2, rd - 2, 0)
			Endif
		Case 2
			x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 100
			y2 = y1 + Perlin.Noise1D(y1) * 100
			If Rnd() > 0.1 Then 
				Blitz3(x2, y2, rd - 8, 0)
			Else
				Blitz3(x2, y2, rd - 2, 2)
			Endif
	End Select
	LineAA(x1, y1, x2, y2, 1 + rd / 8, &h4000007F)
	LineAA(x1, y1, x2, y2, 1 + rd / 24, &hA0FFFFF0)
	If rd Mod 10 = 0 Then Circle (x1, y1), 200, &h0800007F,,,, F
	
	If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 1)
	If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 2)
	Blitz3(x2, y2, rd - 1)
End Sub

Do
	Cls

	Blitz3(w2 + Rnd() * 10 - 5, Rnd() * 10, 128)	

	Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
	
	Flip

	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep (1)
Loop Until Len(Inkey())
Do not touch the screen or you will get a power surge. :lol:
Last edited by UEZ on Jan 26, 2023 22:20, edited 1 time in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple lightning bolt algo

Post by dodicat »

I wouldn't want to be standing under that UEZ.
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Simple lightning bolt algo

Post by dafhi »

so satisfying

Code: Select all

/' -- colored lightning - 2023 Apr 11 - by dafhi

  bolts composed of dots, "brightness" is enhanced by exponential decay
  
   update
  metaball2d improve.  commented out unused vars _clipSQ and clip
  main loop .. for bolt -> for i
  
'/


#define flo(x) (((x)*2.0-0.5)shr 1) '' faster than int() - http://www.freebasic.net/forum/viewtopic.php?p=118633
'#DEFINE flo(V) ((V-.5) \ 1)  ''https://freebasic.net/forum/viewtopic.php?p=297522#p297522

#undef int
#define int     as Integer
#define sng     as single

#define min( a, b)        iif( (a)<(b), (a), (b) )
#define max( a, b)        iif( (a)>(b), (a), (b) )

function clamp( in sng, hi sng = 1, lo sng = 0) sng
  return min( max(in, lo), hi ) '' Mar 8
End Function

function bclamp( i sng ) as ubyte '' Feb 23
  return min( max( i, 0), 255 )
End Function

function int2float( i as ulong) as single
  return i / ((culngint(1) shl 32) + 128)
end function
' ------------------- boilerplate
  
  
  namespace gfx_workspace '' 2023 Feb 27 - by dafhi

function c( _c as ubyte) int
  return _c
end function


type pixel
  sng                 x,y,z
  
  declare operator    cast as ulong
  
  declare sub         in_rgb( as ulong, sng = 1)
  declare sub         subm_rgb( as ulong, sng = 1)  '' Feb 19
  declare sub         add( as pixel, sng = 1)       '' Feb 19
end type

sub pixel.add( in as pixel, alpha sng)      '' Feb 19
  x += alpha * in.x
  y += alpha * in.y
  z += alpha * in.z
end sub

sub pixel.subm_rgb( col as ulong, alpha sng) '' Feb 19 (old name add_rgb)
  x += alpha * ( c( col shr 16 )-127.5 )
  y += alpha * ( c( col shr 8 )-127.5 )
  z += alpha * ( c( col shr 0 )-127.5 )
end sub

sub pixel.in_rgb( col as ulong, alpha sng)
  x = alpha * c( col shr 16 )
  y = alpha * c( col shr 8 )
  z = alpha * c( col shr 0 )
end sub

operator pixel.cast as ulong
  return rgb( bclamp(x), bclamp(y), bclamp(z) )
end operator

dim as pixel          buf(any, any)

dim int               wm
dim int               hm

sub setup( w as short, h as short )
  const dimension_thresh = 11000
  if w > dimension_thresh orelse h > dimension_thresh then exit sub
  if w < 1 orelse h < 1 then exit sub
  wm = w - 1
  hm = h - 1
  redim buf( wm, hm)
end sub

sub fill( col as ulong = rgb(128,128,128), stren sng = 0.5)
  dim as pixel iwa:  iwa.in_rgb col, stren
  for p as pixel ptr = @buf(0,0) to @buf(wm,hm)
    *p = iwa
  next
end sub

end namespace ' ------ gfx_workspace
  

  namespace metaball2D  ' 2023 April 11 - by dafhi

type int_rect
  as long     x0, x1 = -1
  as long     y0, y1 = -1
  declare operator   cast as string
end type

operator int_rect.cast as string
  return "rect (" + str(x0) + "," + str(y0) + _
  ") - "  + str(x1) + "," + str(y1) + ")"
end operator

dim as int_rect       _clipped '' namespace globals

dim sng               _slope_by_rad', _clipSQ '' April 11
dim sng               _metaball_alpha_scalar '' March 21

dim sng               dx, dy, dx0, dySQ

sub _cliprect_calc( x sng, y sng, rad_multed sng ) '' Feb 24
  _clipped.x0 = max( flo( x - rad_multed ), 0 )
  _clipped.x1 = min( flo( x + rad_multed ), gfx_workspace.wm )
  _clipped.y0 = max( flo( y - rad_multed ), 0 )
  _clipped.y1 = min( flo( y + rad_multed ), gfx_workspace.hm )
end sub
  
dim as gfx_workspace.pixel pel '' March 24
  
sub _scan( col as ulong, plot_y int )
  
  dySQ = dy * dy
'  var clip = _clipSQ - dySQ '' April 11
  
  dx = dx0
  for plot_x int = _clipped.x0 to _clipped.x1
    var alpha = _metaball_alpha_scalar / ((dx*dx+dySQ)^2 + .001)
    gfx_workspace.buf(plot_x, plot_y).add pel, alpha '' Feb 19
    dx += _slope_by_rad
  next
  dy += _slope_by_rad
  
 end sub

sub draw( x sng, y sng, col as ulong = -1, rad sng = 10)
  
  '' for large metaballs i normally have this at .69
  var draw_dist_from_center = .25
  
  _metaball_alpha_scalar = min( rad, .003 ) '' March 21
  
  _cliprect_calc x, y, rad * draw_dist_from_center
'  _clipSQ = (draw_dist_from_center) ^ 2 '' April 11
  
  _slope_by_rad = 1 / max(rad, .001)
  
  dx0 = (_clipped.x0 - x) * _slope_by_rad
  dy = (_clipped.y0 - y) * _slope_by_rad
  
  pel = type(0,0,0)
  pel.subm_rgb col '' Feb 19

  for plot_y int = _clipped.y0 to _clipped.y1
    _scan col, plot_y
  next
  
end sub

end namespace ' ---- metaball2D  
  
  
  namespace myhash '' 2023 Jan 23 u1

type base_literal     as ulong '' size: ubyte to ulongint (ubyte during development)

const 					      lenx8 = len(base_literal) * 8

const 					      lenByv = lenx8 \ 2 + 1'' integer divide

const as ulongint 		mulC = &b1000000001000000000100000000100000001000000100000100001000100101
const as ulongint     xorA = &b0101010101010101010101010101010101010101010101010101010101010101

' inspired by PCG, calculates a "random" bit rotate
const                 _rotbits_count = log(lenx8) / log(2)
const as ubyte        _rota_mask  = 2 ^ (_rotbits_count-2) - 1

dim as base_literal   a, b, c
dim as byte           _rot_amount

sub reset(aa as base_literal = 0, bb as base_literal = 0)
  a = aa
  b = bb
  c = 0
End Sub

function prng( seed_a as base_literal = 0 ) as single
  c xor= seed_a xor xora + a
  b xor= c + c shl (c and _rota_mask)
  a xor= b shr 1
  a *= mulC
  a xor= a shr lenbyv
  return int2float(a)
end function

end namespace

function triwave( i sng ) sng
  return abs( i - flo(i) - .5 ) - .25  '' by Stonemonkey
end function

function _cchsv(h sng, s sng, v sng) as ubyte
  var wave_hgt = s * v
  var elevate = v - wave_hgt
  return 255.499 * (wave_hgt * clamp(triwave(h)*6 + .5) + elevate)
end function

function hsv( h sng=0, s sng=1, v sng=1 ) as ulong '' 2023 April 8
    return rgb( _
  _cchsv( h + 0/3, s,v ), _
  _cchsv( h + 2/3, s,v ), _
  _cchsv( h + 1/3, s,v ) )
end function


sub show
  '' reference
  dim int w,h,bpp,bypp,pitch,rate
  dim as string driver_name

  ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name
  
  var wm = w - 1
  dim as any ptr pp = screenptr
    for y int = 0 to h-1
  dim as ulong ptr p = pp + y * pitch
    for x int = 0 to wm
  p[x] = gfx_workspace.buf(x,y)
  next
  next
end sub


'' procedural location & shape
#define rng   myhash.prng


const     w = 800
const     h = 600

gfx_workspace.setup w,h
screenres w, h, 32


const     bolts = 19

type boltVars '' March 30
  sng     staying_power = .03 + .5 * (rnd*rnd*rnd)
  sng     flash_next = rnd * rnd * rnd * sqr(bolts) * 25
  sng     wid
end type

dim as boltVars   vars( bolts-1 )


var       seconds_max = 150

var       tp = timer
var       report_next = tp + 2.5
var       curr_run_time = 0f

  randomize
var bolts_seed = rnd * culng(-1)


while curr_run_time < seconds_max

  gfx_workspace.fill rgb(245,240,245), .65
  myhash.reset bolts_seed
  
  for i int = 0 to bolts - 1
    var x = w * (.05 + .9 * rng)
    var y = 0f
    var col = hsv( rng, .5*(rng+0), 1 )
    while y < h
      const tau = 8 * atn(1)
      var angle = rng * tau
      y += .8 * (.5 + sin(angle))
      if vars(i).wid > .15 then
        metaball2d.draw x, y, col, vars(i).wid
        x += 1.2 * (.0 + cos(angle))
      endif
    wend
  next
  
  var k = inkey
  if k <> "" then end
  
  var t = timer
  dim sng dt = t - tp
  tp = t
  curr_run_time += dt
  
  for i int = 0 to bolts - 1
    vars(i).wid *= .5 ^ (dt / vars(i).staying_power)
    if curr_run_time >= vars(i).flash_next then
      vars(i) = *(new boltVars)
      vars(i).wid = 12
      vars(i).flash_next += curr_run_time
    endif
  next
    
    screenlock
  show
  static sng  dt2, dt_sum
  if t > report_next then
    dt_sum = dt + dt2
    var m = str(report_next)
    windowtitle "FPS: " + str( 2 / dt_sum ) '' deltatime avg
    report_next += 1
  elseif curr_run_time < 1.75 then
    locate 2,2
    ? "demo runs"; seconds_max; " seconds"
  endif
  dt2 = dt
  screenunlock
  
  sleep 1

wend
Last edited by dafhi on Apr 12, 2023 6:37, edited 7 times in total.
neil
Posts: 555
Joined: Mar 17, 2022 23:26

Re: Simple lightning bolt algo

Post by neil »

That looks real cool dafhi.
Dr_D
Posts: 2451
Joined: May 27, 2005 4:59
Contact:

Re: Simple lightning bolt algo

Post by Dr_D »

Oh... that one is nice!
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: Simple lightning bolt algo

Post by UEZ »

I have changed my above Electricity code to look more like lightning:

Code: Select all

'Coded by UEZ build 2023-03-30
#Include "fbgfx.bi"
#Include "crt/math.bi"
Using FB

'Perlin Noise by Joshy aka D.J. Peters
Type REAL As Single
#Define rAbs(x_)				Iif( (x_) < 0, -(x_), (x_) )
Const As REAL rPI              	= Acos(-1)
Const As REAL rDeg2Rad         	= rPI / 180

Type PERLINNOISE 
	Declare Constructor
	Declare Sub NoiseSeed(Byval seed As Double)
	Declare Sub NoiseDetail(Byval lod As Integer)
	Declare Sub NoiseDetail(Byval lod As Integer, Byval falloff As REAL)
	Declare Function Noise1D(Byval x As REAL) As REAL
	Declare Function Noise2D(Byval x As REAL,Byval y As REAL) As REAL
	Declare Function Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL
Private:
	Const As REAL    SINCOS_PRECISION = 0.5
	Const As Integer SINCOS_LENGTH    = (360 / SINCOS_PRECISION)
	Const As Integer PERLIN_YWRAPB    = 4
	Const As Integer PERLIN_YWRAP     = 1 Shl PERLIN_YWRAPB
	Const As Integer PERLIN_ZWRAPB    = 8
	Const As Integer PERLIN_ZWRAP     = 1 Shl PERLIN_ZWRAPB
	Const As Integer PERLIN_SIZE      = 4095
	Const As Integer PERLIN_TWOPI     = SINCOS_LENGTH
	Const As Integer PERLIN_PI        = PERLIN_TWOPI Shr 1
	As Integer perlin_octaves   	  = 4   ' default To medium smooth
	As REAL  perlin_amp_falloff 	  = 0.5 ' 50% reduction/octave
	As REAL  perlin_cosTable(SINCOS_LENGTH-1)
	As REAL  perlin(PERLIN_SIZE)
	Declare Sub reInit
	Declare Function noise_fsc(Byval i As REAL) As REAL
End Type

Constructor PERLINNOISE 
	For i As Integer = 0 To SINCOS_LENGTH - 1
		perlin_cosTable(i) = Cos(i * rDEG2RAD * SINCOS_PRECISION)
	Next
	reInit
End Constructor

Sub PERLINNOISE.reInit 
	For i As Integer = 0 To PERLIN_SIZE
		perlin(i) = Rnd()
	Next
End Sub

Function PERLINNOISE.noise_fsc(Byval i As REAL) As REAL 
	Dim As Integer index = Int(i * PERLIN_PI)
	Return 0.5 * (1.0 - perlin_cosTable(index Mod SINCOS_LENGTH))
End Function

Sub PERLINNOISE.noiseSeed(Byval seed As Double) 
	'Randomize(0) ' !!!
	Randomize(seed) : reInit
End Sub

Sub PERLINNOISE.noiseDetail(Byval lod As Integer) 
	If (lod > 0) Then perlin_octaves = lod
End Sub

Sub PERLINNOISE.noiseDetail(Byval lod As Integer, Byval falloff As REAL) 
	If (lod > 0) Then perlin_octaves = lod
	If (falloff > 0) Then perlin_amp_falloff = falloff
End Sub

Function PERLINNOISE.Noise1D(Byval x As REAL) As REAL 
	Return noise3D(x, 0, 0)
End Function

Function PERLINNOISE.Noise2D(Byval x As REAL, Byval y As REAL) As REAL 
	Return noise3D(x, y, 0)
End Function

Function PERLINNOISE.Noise3D(Byval x As REAL,Byval y As REAL,Byval z As REAL) As REAL 
	x = rAbs(x) : y = rAbs(y) : z = rAbs(z)
	Dim As Integer xi = Int(x), yi = Int(y), zi = Int(z)
	Dim As REAL xf = x - xi, yf = y - yi, zf = z - zi
	Dim As REAL r, ampl = 0.5
	For i As Integer = 0 To perlin_octaves - 1
		Dim As Integer of= xi + (yi Shl PERLIN_YWRAPB) + (zi Shl PERLIN_ZWRAPB)
		Dim As REAL rxf = noise_fsc(xf)
		Dim As REAL ryf = noise_fsc(yf)
		Dim As REAL n1 = perlin(of And PERLIN_SIZE)
		n1 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n1)
		Dim As REAL n2 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
		n2 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n2)
		n1 += ryf * (n2 - n1)
		of += PERLIN_ZWRAP
		n2  = perlin(of And PERLIN_SIZE)
		n2 += rxf * (perlin((of + 1) And PERLIN_SIZE) - n2)
		Dim As REAL n3 = perlin((of + PERLIN_YWRAP) And PERLIN_SIZE)
		n3 += rxf * (perlin((of + PERLIN_YWRAP + 1) And PERLIN_SIZE) - n3)
		n2 += ryf * (n3 - n2)
		n1 += noise_fsc(zf) * (n2 - n1)
		r += n1 * ampl
		ampl *= perlin_amp_falloff
		xi Shl = 1: xf *= 2
		yi Shl = 1: yf *= 2
		zi Shl = 1: zf *= 2
		If (xf >= 1) Then xi += 1 : xf -= 1
		If (yf >= 1) Then yi += 1 : yf -= 1
		If (zf >= 1) Then zi += 1 : zf -= 1
	Next
	Return r
End Function
'End Perlin Noise

#Define _Alpha(iCol)	((iCol And &hFF000000) Shr 24)
#Define _Red(iCol)		((iCol And &h00FF0000) Shr 16)
#Define _Green(iCol)	((iCol And &h0000FF00) Shr 8)
#Define _Blue(iCol)		((iCol And &h000000FF))

Function ColBlend(col1 As Ulong, col2 As Ulong, blend As Single) As Ulong
	Dim As Ubyte a1 = _Alpha(col1), a2 = _Alpha(col2), r1 = _Red(col1), r2 = _Red(col2), g1 = _Green(col1), g2 = _Green(col2), b1 = _Blue(col1), b2 = _Blue(col2)
	Dim As Single bl = 1 - blend
	Return Rgba(r1 * blend + r2 * bl, g1 * blend + g2 * bl, b1 * blend + b2 * bl, a1 * blend + a2 * bl)
End Function

Sub LineAA(x1 As Single, y1 As Single, x2 As Single, y2 As Single, thickness As Single = 1, col As Ulong, pImage As Any Ptr = 0)
	Dim As Single dist, db, n, nn, px, py, sensX, sensY, th, dx, dy, CosAngle, SinAngle, Factor, w = x2 - x1, h = y2 - y1
	If w >= 0 Then
		sensX = 1
	Else
		sensX = -1
		w = -w
	Endif
	If h >= 0 Then
		sensY = 1
	Else
		sensY = -1
		h =- h
	Endif
	th = thickness / 2
	dist = Sqr(w * w + h * h)
	CosAngle = w / dist
	SinAngle = -Sin(Acos(CosAngle))
	For n = -thickness To w + thickness
		For nn=-thickness To h + thickness
			dx =n * CosAngle - nn * SinAngle
			dy = Abs(n * SinAngle + nn * CosAngle)
			
			If dy <= th + 0.5 Then
				Factor = 0.5 + th - dy
				If Factor > 1 Then
					Factor = 1
				Endif
				If dx > -1 And dx < dist + 1 Then
					If dx < 0 Then
						Factor *= 1 + dx
					Elseif dx > dist Then
						Factor *= (1 - dx + dist)
					Endif
				Else
					Factor = 0
				Endif
				If Factor > 0 Then
					If Factor < 1 Then
						px = x1 + n * SensX : py = y1 + nn * SensY
						Pset pImage, (px, py), ColBlend(col, Point (px, py, pImage), Factor)
					Else
						Pset pImage, (x1 + n * SensX, y1 + nn * SensY), col
					Endif
				Endif
			Endif
		Next
	Next
End Sub

Const w = 1920 Shr 0
Const h = 1080 Shr 0
Const w2 = w Shr 1
Const h2 = h Shr 1

Screenres w, h, 32, 2, GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME 'Or GFX_ALWAYS_ON_TOP 'Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFF, &hE0000000

Randomize, 2

Dim As Ulong iFPS, cfps = 0
Dim As Double fTimer = Timer, tt
Dim Shared As PERLINNOISE Perlin

Sub Blitz3(x1 As Double, y1 As Double, rd As Long, d As Long = 0)
	If rd < 1 Then Exit Sub
	Dim As Double x2, y2
	Select Case d
		Case 0
			x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 50 - 24.5
			y2 = y1 + Perlin.Noise1D(y1) * 20
		Case 1
			x2 = x1 - Perlin.Noise1D(Rnd() * y1) * 100
			y2 = y1 + Perlin.Noise1D(y1) * 100
			If Rnd() > 0.1 Then 
				Blitz3(x2, y2, rd - 8, 0)
			Else
				Blitz3(x2, y2, rd - 2, 0)
			Endif
		Case 2
			x2 = x1 + Perlin.Noise1D(Rnd() * y1) * 100
			y2 = y1 + Perlin.Noise1D(y1) * 100
			If Rnd() > 0.1 Then 
				Blitz3(x2, y2, rd - 8, 0)
			Else
				Blitz3(x2, y2, rd - 2, 2)
			Endif
	End Select
	LineAA(x1, y1, x2, y2, 1 + rd / 8, &h4000007F)
	LineAA(x1, y1, x2, y2, 1 + rd / 24, &hA0FFFFF0)
	If rd Mod 10 = 0 Then Circle (x1, y1), 200, &h0800007F,,,, F
	If rd Mod 5 = 0 Then Flip 'speed
	If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 1)
	If Rnd() > 0.9925 Then Blitz3(x2, y2, rd - 10 - Rnd() * 50, 2)
	Blitz3(x2, y2, rd - 1)
End Sub

Blitz3(w2 + Rnd() * 10 - 5, Rnd() * 10, 128)
tt = Timer
Do
	Cls
	If Timer - tt > 1 Then
		Blitz3(w2 + Rnd() * 10 - 5, Rnd() * 10, 128)
		tt = Timer
	End If
		
	'Flip
	'Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep (1)
Loop Until Len(Inkey())


@dafhi: nice one
It looks similar to the one I ported from Dwitter.net:

Code: Select all

'Ported from https://www.dwitter.net/d/21790 by BackendForth To FB by UEZ build 2021-03-02

#Include "fbgfx.bi"
Using FB

Randomize
Dim As Integer w = 1920 Shr 0, h = 1080 Shr 0

Screenres w, h, 32, 2, GFX_ALWAYS_ON_TOP Or GFX_ALPHA_PRIMITIVES Or GFX_NO_SWITCH Or GFX_NO_FRAME 'Or GFX_FULLSCREEN
Screenset 1, 0
Color &hFFFF00, &h0F000000

Dim As Ulong iFPS, cfps = 0
Dim As Double fTimer = Timer
Dim As Integer i, s = 5
Dim As Single px, py, a

Do
	'Cls
	
	For i = 4999 To 0 Step -1
		px = w * Rnd
		py = h * Rnd
		Line (px, py) - (px + 15, py + 15), &h30000000, BF
	Next
	a = Rnd * w
	If Rnd < 0.04 Then
		For i = h To 0 Step -1
			Line (a, i) - (a + s, i + s), &hA0FFFFFF, BF
			Line (a, i) - (a + s, i + s), &h300000FF, B
			a += (Rnd - 0.5) * s
		Next
	Endif

	Draw String(4, 4), iFPS & " fps", &hFFFFFFFF
	Flip
	
	cfps += 1
	If Timer - fTimer > 0.99 Then
		iFPS = cfps
		cfps = 0
		fTimer = Timer
	End If
	Sleep(1)
Loop Until Len(Inkey())
:D
Last edited by UEZ on Mar 30, 2023 19:29, edited 1 time in total.
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Simple lightning bolt algo

Post by dafhi »

cool beans. first reminds me of dodicat's
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Simple lightning bolt algo

Post by dodicat »

Re-did mine a bit.
Dakar Senegal, as I remember it.
Thank you basiccoder2, I have used your thickline routine.

Code: Select all


#include "crt.bi"
#define range(f,l)  (rand() mod (((l)-(f))+1)) + (f)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c) 
#define waitabit for n as long =1 to 500000:next

Dim Shared As Long xres,yres
Screeninfo xres,yres
Screenres xres,yres,32,,64


Type pair
      As Long x,y
      Declare Sub strike
End Type

Sub thickLine(x1 As Long,y1 As Long,x2 As Long,y2 As Long,size As Long,c As Ulong)
      Var dx = x2 - x1
      Var dy = y2 - y1
      If dx = 0 Andalso dy=0 Then
            Circle (x1, y1), size, c, , , , f        
      Elseif Abs(dx) > Abs(dy) Then
            Var m = dy / dx
            For x As Long = x1 To x2 Step Sgn(dx)
                  Circle (x,m * (x - x1) + y1), size, c, , , , f
            Next
      Else
            Var m =dx / dy
            For y As Long = y1 To y2 Step Sgn(dy)
                  Circle (m * (y - y1) + x1,y), size, c, , , ,f
            Next
      End If
End Sub

Sub strike Overload(start As pair, t As Double)
      Redim As pair node(range(15,25))
      node(0)=start
      Dim As Integer k=range(2,5)
      Var delta=Iif(Rnd>.5,Rnd*70-Rnd*50,Rnd*50-Rnd*70)
      For z As Integer=1 To Ubound(node)\2
            node(z)=Type(node(z-1).x+(delta),node(z-1).y+Rnd*100)
            Var th=map(1,Ubound(node)\2,z,t,0)
            Screenlock
            thickline(node(z-1).x,node(z-1).y,node(z).x,node(z).y,th,Rgb(200,200,255))
            Screenunlock
            waitabit
      Next
End Sub


Sub strike
      Var r=range(15*2,25*2)
      Redim As pair node(r)
      node(0)=Type(range(.3*xres,.7*xres),Rnd*10)
      Dim As Integer k=range(2,5)
      If Rnd<.05 Then
            randomize 1
            Paint(0,0),Rgb(k*5,20,k*10)
            For n As Long=-0 To xres
                  Line (n,yres) -(n,50*Sin(n/(xres/8))+.8*yres + rnd*20),Rgb(0,20,0)
            Next
           randomize
            For z As Integer=1 To Ubound(node)
                   Var delta=Iif(Rnd>.5,Rnd*100-Rnd*10,Rnd*10-Rnd*100)
                  node(z)=Type(node(z-1).x+delta,node(z-1).y+Rnd*100)' 200
                  Var th=map(1,Ubound(node)\2,z,3,0)  
                  If Rnd<.2 And z>.1*r  Then 
                        strike(Type<pair>(node(z-0).x,node(z-0).y),th)
                  End If
                  Screenlock
                  thickline(node(z-1).x,node(z-1).y,node(z).x,node(z).y,th,Rgb(200,200,255))
                  Screenunlock
                  waitabit
            Next
      End If
End Sub

function fbmain as integer
Do
      Line (0,0)-(xres,yres),Rgba(0,0,0,15),bf
      strike
      Sleep 1,1
Loop Until Inkey=Chr(27)
return 0
end function

end fbmain
Sleep

 
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Simple lightning bolt algo

Post by BasicCoder2 »

dodicat wrote:
Thank you basiccoder2, I have used your thickline routine.
Looking at the code I would have say that was someone else's version of the thickline routine.

I just did a search for the author and it was written by D.J.Peters

viewtopic.php?t=23772
Post Reply