Liquidish 3d Terrain

[Boromir]

Today I started trying to make a 2d rope simulation but I ended up making this Liquidish 3d Terrain.
WASDQE keys move around the terrain.
Left and Right clicks modify the mesh up and down.

Code: Select all

'======================================
'--------------------------------------
'3d Liquid Terrain by Ezekiel Gutierrez
'--------------------------------------
'======================================
type point3d
    x AS single
    y AS single
    z AS single
    declare sub draw
end type

type camera
    x AS single
    y AS single
    z AS single
    declare sub move
end type

type rope
	points(200,200) as point3d
	declare sub render(cam as camera)
	declare sub move
end type

dim shared as integer LENS=256,FOV=256,XCENTER=320,YCENTER=240
' Main
'==============================================
dim as integer mx,my,click
dim shared rope1 as rope
screenres 640,480,32,,1

for z as integer=0 to ubound(rope1.points,1)
	for x as integer=0 to ubound(rope1.points,2)
	rope1.points(x,z).x=(x*20)-480
	rope1.points(x,z).z=(z*20)-70
	rope1.points(x,z).y=0
	next
next

dim as camera mycamera
do
getmouse mx,my,,click
screenlock
cls
rope1.render(mycamera)
screenunlock
rope1.move
mycamera.move

dim as integer xx=(mx+30)\5,yy=my\5
if xx<1 then xx=1
if yy<1 then yy=1
if xx>ubound(rope1.points,1)-1 then xx=ubound(rope1.points,1)-1
if yy>ubound(rope1.points,1)-1 then xx=ubound(rope1.points,1)-1
if click and 2 then rope1.points(xx,yy).y+=5000:rope1.move:rope1.move:rope1.move:rope1.move
if click and 1 then rope1.points(xx,yy).y-=5000:rope1.move:rope1.move:rope1.move:rope1.move
'if click=2 then rope1.points(ubound(rope1.points)).x=mx:rope1.points(ubound(rope1.points)).y=my

sleep 10
loop until multikey(1)
'==============================================




sub rope.move
for y as integer=1 to ubound(points,1)-1
	for x as integer=1 to ubound(points,2)-1
dim as single py
py=(points(x+1,y).y+points(x-1,y).y+points(x,y+1).y+points(x,y-1).y)/4
points(x,y).y=py'-=1
points(x,y).y=py'+=1
	next
next

end sub

sub rope.render(cam as camera)
for y as integer=ubound(points,1)-1 to 1 step -1
	for x as integer=ubound(points,2)-1 to 1 step -1
	

    dim as single a,b,aa(3),bb(3)
    a=(points(x,y).x-cam.x)     / ((points(x,y).z-cam.z) + LENS) * FOV + XCENTER
	b=(points(x,y).y+200-cam.y) / ((points(x,y).z-cam.z) + LENS) * FOV + YCENTER
    for i as integer=0 to 3
		dim as integer x2=x,y2=y
		select case i
		case 0
		y2-=1
		case 1
		y2+=1
		case 2
		x2-=1
		case 3
		x2+=1
		end select
		aa(i) = (points(x2,y2).x-cam.x)     / ((points(x2,y2).z-cam.z) + LENS) * FOV + XCENTER
		bb(i) = (points(x2,y2).y+200-cam.y) / ((points(x2,y2).z-cam.z) + LENS) * FOV + YCENTER
    next
    dim as integer g=(points(x,y).y)/5
    if g<0 then g=-g
    if (points(x,y).z-cam.z)>-240 then line (a,b)-(aa(0),bb(0)),rgb(60,g,(g/2)/2)
    if (points(x,y).z-cam.z)>-240 then line (a,b)-(aa(1),bb(1)),rgb(60,g,(g/2)/2)
    if (points(x,y).z-cam.z)>-240 then line (a,b)-(aa(2),bb(2)),rgb(60,g,(g/2)/2)
    if (points(x,y).z-cam.z)>-240 then line (a,b)-(aa(3),bb(3)),rgb(60,g,(g/2)/2)
    
    'circle (a,b),3,rgb(0,points(x,y).y,0)
	next
next
end sub

sub camera.move
if multikey(17) then z+=5
if multikey(30) then x-=5
if multikey(31) then z-=5
if multikey(32) then x+=5
if multikey(16) then y+=5
if multikey(18) then y-=5
end sub

EDIT:
Here is something more like water.

Code: Select all

'=====================================
'-------------------------------------
'Fluid Simulation by Ezekiel Gutierrez
'-------------------------------------
'=====================================
Const wid = 640, hei = 480, hhei = hei Shr 1
Const As Single k = 0.025
Const maxPts = 60, pdist = 10
dim shared as integer LENS=256,FOV=256,XCENTER=320,YCENTER=240

type camera
    x AS single
    y AS single
    z AS single
    declare sub move
end type
Type wpoint
    As Single velocity,y,x,z
    declare sub render(cam as camera)
end type

dim as camera mycamera:mycamera.x=300:mycamera.y=300
Dim As wpoint points(maxPts,maxPts)
'init values
For x As UInteger = 0 To maxPts
	For z As UInteger = 0 To maxPts
		With points(x,z)
			.y = hhei
			.velocity = 0.0
			.x=x*pdist:.z=z*pdist
		End With
    next
Next

' ===== MAIN =====
ScreenRes(wid, hei, 32)

Dim As Integer  mx, my,click
Dim As Single   l(maxPts,maxPts), r(maxPts,maxPts)

Do
    ScreenLock
    Cls
	For x As UInteger = 0 To maxPts
		For z As UInteger = 0 To maxPts
			points(x,z).render(mycamera)
        next
    Next
    ScreenUnLock

    For x As UInteger = 0 To maxPts
		For z As UInteger = 0 To maxPts
        With points(x,z)
            Var x1 = hhei - .y
            .velocity += k * x1 - k * .velocity
            .y += .velocity
        End with
        next
    Next

    For j as Uinteger = 0 To 9
        For x As UInteger = 0 To maxPts
			For z As UInteger = 0 To maxPts
        
            If x > 0 Then
                l(x,z) = k * (points(x,z).y - points(x-1,z).y)
                points(x-1,z).velocity += l(x,z)
            End If
            If x < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x+1,z).y)
                points(x+1,z).velocity += r(x,z)
            End If
            If x > 0 Then points(x-1,z).y += l(x,z)
            If x < maxPts Then points(x+1,z).y += r(x,z)
            
            If z > 0 Then
                l(x,z) = k * (points(x,z).y - points(x,z-1).y)
                points(x,z-1).velocity += l(x,z)
            End If
            If z < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x,z+1).y)
                points(x,z+1).velocity += r(x,z)
            End If
            If z > 0 Then points(x,z-1).y += l(x,z)
            If z < maxPts Then points(x,z+1).y += r(x,z)
            next
        Next
    Next
	mycamera.move
	
    GetMouse mx,my,,click
	if click=1 then points(30,30).y-=300

    Sleep 50
Loop Until MultiKey(1)

sub wpoint.render(cam as camera)
    dim as single a,b,aa(3),bb(3)
    a=(x-cam.x)     / ((z-cam.z) + LENS) * FOV + XCENTER
	b=(y+200-cam.y) / ((z-cam.z) + LENS) * FOV + YCENTER
    if (z-cam.z)>-240 then circle (a,b),1,rgb(0,0,140+y)
end sub

sub camera.move
if multikey(17) then z+=5
if multikey(30) then x-=5
if multikey(31) then z-=5
if multikey(32) then x+=5
if multikey(16) then y+=5
if multikey(18) then y-=5
end sub

[badidea]

I need a light switch. I get a barely visible dark red (or blue) plane.

[Boromir]

I need a light switch. I get a barely visible dark red (or blue) plane.

I changed this to light blue.

Code: Select all

'=====================================
'-------------------------------------
'Fluid Simulation by Ezekiel Gutierrez
'-------------------------------------
'=====================================
Randomize Timer
Const wid = 640, hei = 480, hhei = hei Shr 1
Const As Single k = 0.025
Const maxPts = 100, pdist = 10
dim shared as integer LENS=256,FOV=256,XCENTER=320,YCENTER=240

type camera
    x AS single
    y AS single
    z AS single
    declare sub move
end type
Type wpoint
    As Single velocity,y,x,z
end type

dim as camera mycamera:mycamera.x=300:mycamera.y=300
Dim shared As wpoint points(maxPts,maxPts)
declare sub render(cam as camera)
'init values
For x As UInteger = 0 To maxPts
	For z As UInteger = 0 To maxPts
		With points(x,z)
			.y = hhei
			.velocity = 0.0
			.x=x*pdist:.z=z*pdist
		End With
    next
Next

' ===== MAIN =====
ScreenRes wid,hei,32,,1

Dim As Integer  mx, my,click
Dim As Single   l(maxPts,maxPts), r(maxPts,maxPts)

Do
    ScreenLock
    Cls
	render(mycamera)
    ScreenUnLock
    
    GetMouse mx,my,,click
    dim as integer xx=mx\(640/maxPts),zz=my\(480/maxPts)
	if xx<1 then xx=1
	if zz<1 then zz=1
	if xx>ubound(points,1)-1 then xx=ubound(points,1)-1
	if zz>ubound(points,1)-1 then zz=ubound(points,1)-1
	if click=1 then points(xx,zz).velocity-=200
	
	xx=(rnd*(maxpts-4))+2
	zz=(rnd*(maxpts-4))+2
	points(xx,zz).velocity-=50
	points(xx+1,zz).velocity-=40
	points(xx-1,zz).velocity-=40
	points(xx,zz+1).velocity-=40
	points(xx,zz-1).velocity-=40
	points(xx+2,zz).velocity-=30
	points(xx-2,zz).velocity-=30
	points(xx,zz+2).velocity-=30
	points(xx,zz-2).velocity-=30



    For x As UInteger = 0 To maxPts
		For z As UInteger = 0 To maxPts
        With points(x,z)
            Var x1 = hhei - .y
            .velocity += k * x1 - k * .velocity
            .y += .velocity
        End with
        next
    Next

    For j as Uinteger = 0 To 9
        For x As UInteger = 0 To maxPts
			For z As UInteger = 0 To maxPts
        
            If x > 0 Then
                l(x,z) = k * (points(x,z).y - points(x-1,z).y)
                points(x-1,z).velocity += l(x,z)
            End If
            If x < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x+1,z).y)
                points(x+1,z).velocity += r(x,z)
            End If
            If x > 0 Then points(x-1,z).y += l(x,z)
            If x < maxPts Then points(x+1,z).y += r(x,z)
            
            If z > 0 Then
                l(x,z) = k * (points(x,z).y - points(x,z-1).y)
                points(x,z-1).velocity += l(x,z)
            End If
            If z < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x,z+1).y)
                points(x,z+1).velocity += r(x,z)
            End If
            If z > 0 Then points(x,z-1).y += l(x,z)
            If z < maxPts Then points(x,z+1).y += r(x,z)
            next
        Next
    Next
	mycamera.move

    Sleep 50
Loop Until MultiKey(1)

sub render(cam as camera)
    For x As UInteger = 1 To maxPts-1
		For z As UInteger = 1 To maxPts-1
        dim as single a,b,aa(3),bb(3)
    a=(points(x,z).x-cam.x)     / ((points(x,z).z-cam.z) + LENS) * FOV + XCENTER
	b=(points(x,z).y+200-cam.y) / ((points(x,z).z-cam.z) + LENS) * FOV + YCENTER
    for i as integer=0 to 3
		dim as integer x2=x,z2=z
		select case i
		case 0
		z2-=1
		case 1
		z2+=1
		case 2
		x2-=1
		case 3
		x2+=1
		end select
		aa(i) = (points(x2,z2).x-cam.x)     / ((points(x2,z2).z-cam.z) + LENS) * FOV + XCENTER
		bb(i) = (points(x2,z2).y+200-cam.y) / ((points(x2,z2).z-cam.z) + LENS) * FOV + YCENTER
    next

    if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(0),bb(0)),rgb(100,100,255)
    if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(1),bb(1)),rgb(100,100,255)
    if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(2),bb(2)),rgb(100,100,255)
    if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(3),bb(3)),rgb(100,100,255)
    
    'circle (a,b),3,rgb(0,points(x,y).y,0)
		next
	next
end sub

sub camera.move
if multikey(17) then z+=5
if multikey(30) then x-=5
if multikey(31) then z-=5
if multikey(32) then x+=5
if multikey(16) then y+=5
if multikey(18) then y-=5
end sub

[Boromir]

Rasterized orange and yellow lava.

Code: Select all

'=====================================
'-------------------------------------
'Fluid Simulation by Ezekiel Gutierrez
'-------------------------------------
'=====================================
declare sub rast(a1 as single,b1 as single,a2 as single,b2 as single,a3 as single,b3 as single,col as integer)
Randomize Timer
Const wid = 640, hei = 480, hhei = hei Shr 1
Const As Single k = 0.025
Const maxPts = 100, pdist = 10
dim shared as integer LENS=256,FOV=256,XCENTER=320,YCENTER=240

type camera
    x AS single
    y AS single
    z AS single
    declare sub move
end type
Type wpoint
    As Single velocity,y,x,z
end type

dim as camera mycamera:mycamera.x=300:mycamera.y=100
Dim shared As wpoint points(maxPts,maxPts)
declare sub render(cam as camera)
'init values
For x As UInteger = 0 To maxPts
	For z As UInteger = 0 To maxPts
		With points(x,z)
			.y = hhei
			.velocity = 0.0
			.x=x*pdist:.z=z*pdist
		End With
    next
Next

' ===== MAIN =====
ScreenRes wid,hei,32,,1

Dim As Integer  mx, my,click
Dim As Single   l(maxPts,maxPts), r(maxPts,maxPts)

Do
    ScreenLock
    Cls
	render(mycamera)
	print mycamera.x; mycamera.y; mycamera.z
    ScreenUnLock
    
    GetMouse mx,my,,click
    dim as integer xx=mx\(640/maxPts),zz=my\(480/maxPts)
	if xx<1 then xx=1
	if zz<1 then zz=1
	if xx>ubound(points,1)-1 then xx=ubound(points,1)-1
	if zz>ubound(points,1)-1 then zz=ubound(points,1)-1
	if click=1 then points(xx,zz).velocity-=200
	if click=2 then points(xx,zz).velocity+=200
	
	xx=(rnd*(maxpts-4))+2
	zz=(rnd*(maxpts-4))+2
	points(xx,zz).velocity-=50
	points(xx+1,zz).velocity-=40
	points(xx-1,zz).velocity-=40
	points(xx,zz+1).velocity-=40
	points(xx,zz-1).velocity-=40
	points(xx+2,zz).velocity-=30
	points(xx-2,zz).velocity-=30
	points(xx,zz+2).velocity-=30
	points(xx,zz-2).velocity-=30



    For x As UInteger = 0 To maxPts
		For z As UInteger = 0 To maxPts
        With points(x,z)
            Var x1 = hhei - .y
            .velocity += k * x1 - k * .velocity
            .y += .velocity
        End with
        next
    Next

    For j as Uinteger = 0 To 9
        For x As UInteger = 0 To maxPts
			For z As UInteger = 0 To maxPts
        
            If x > 0 Then
                l(x,z) = k * (points(x,z).y - points(x-1,z).y)
                points(x-1,z).velocity += l(x,z)
            End If
            If x < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x+1,z).y)
                points(x+1,z).velocity += r(x,z)
            End If
            If x > 0 Then points(x-1,z).y += l(x,z)
            If x < maxPts Then points(x+1,z).y += r(x,z)
            
            If z > 0 Then
                l(x,z) = k * (points(x,z).y - points(x,z-1).y)
                points(x,z-1).velocity += l(x,z)
            End If
            If z < maxPts Then
                r(x,z) = k * (points(x,z).y - points(x,z+1).y)
                points(x,z+1).velocity += r(x,z)
            End If
            If z > 0 Then points(x,z-1).y += l(x,z)
            If z < maxPts Then points(x,z+1).y += r(x,z)
            next
        Next
    Next
	mycamera.move
	if multikey(2) then mycamera.x=415:mycamera.y=-1260:mycamera.z=-2535
	if multikey(3) then mycamera.x=300:mycamera.y=100:mycamera.z=0

    Sleep 50
Loop Until MultiKey(1)

sub render(cam as camera)
    For z As UInteger = maxPts-1 To 1 step -1
		For x As UInteger = 1 To maxPts-1
        dim as single a,b,aa(3),bb(3)
    a=(points(x,z).x-cam.x) / ((points(x,z).z-cam.z) + LENS) * FOV + XCENTER
	b=(points(x,z).y-cam.y) / ((points(x,z).z-cam.z) + LENS) * FOV + YCENTER
    for i as integer=0 to 3
		dim as integer x2=x,z2=z
		select case i
		case 0
		z2-=1
		case 1
		z2+=1
		case 2
		x2-=1
		case 3
		x2+=1
		end select
		aa(i) = (points(x2,z2).x-cam.x) / ((points(x2,z2).z-cam.z) + LENS) * FOV + XCENTER
		bb(i) = (points(x2,z2).y-cam.y) / ((points(x2,z2).z-cam.z) + LENS) * FOV + YCENTER
    next
	dim as integer y=(points(x,z).y-30)
	dim as integer r=340-y,g=270-y,bc=0-y
	if r>255 then r=255
	if g>255 then g=255
	if bc>255 then bc=255
	if r<0 then r=0
	if g<0 then g=0
	if bc<0 then bc=0
	
	dim as integer col=rgb(150,g,(g/2)/2)
	
	if (points(x,z).z-cam.z)>-240 then 
	if (a>0 andalso b>0 andalso b<480 andalso a<640) orelse _
	   (aa(0)>0 andalso bb(0)>0 andalso bb(0)<480 andalso aa(0)<640) orelse _
	   (aa(1)>0 andalso bb(1)>0 andalso bb(1)<480 andalso aa(1)<640) orelse _
	   (aa(2)>0 andalso bb(2)>0 andalso bb(2)<480 andalso aa(2)<640) orelse _
	   (aa(3)>0 andalso bb(3)>0 andalso bb(3)<480 andalso aa(3)<640) then 
		rast(a,b,aa(0),bb(0),aa(1),bb(1),col)
		rast(a,b,aa(1),bb(1),aa(2),bb(2),col)
		rast(a,b,aa(2),bb(2),aa(3),bb(3),col)
		rast(a,b,aa(0),bb(0),aa(3),bb(3),col)
	end if
	end if
	
    'if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(0),bb(0)),rgb(r,g,bc)
    '''if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(1),bb(1)),rgb(100,100,255)
    'if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(2),bb(2)),rgb(r,g,bc)
    '''if (points(x,z).z-cam.z)>-240 then line (a,b)-(aa(3),bb(3)),rgb(100,100,255)
    
    if multikey(19) and (points(x,z).z-cam.z)>-240 then circle (a,b),1,rgb(255,255,255)
		next
	next
end sub

sub camera.move
if multikey(17) then z+=5
if multikey(30) then x-=5
if multikey(31) then z-=5
if multikey(32) then x+=5
if multikey(16) then y+=5
if multikey(18) then y-=5
end sub

sub rast(a1 as single,b1 as single,a2 as single,b2 as single,a3 as single,b3 as single,col as integer)
if ((a2-a1)*(b3-b1))<((a3-a1)*(b2-b1)) then

dim as integer maxX,minX,maxY,minY

if a1>a2 then maxX=a1 else maxX=a2
if a3>maxX then maxX=a3

if a1<a2 then minX=a1 else minX=a2
if a3<minX then minX=a3

if b1>b2 then maxY=b1 else maxY=b2
if b3>maxY then maxY=b3

if b1<b2 then minY=b1 else minY=b2
if b3<miny then minY=b3

dim as single s,t,vx1,vy1,vx2,vy2,vx3,vy3
dim as integer x,y

vx1 = a2 - a1
vy1 = b2 - b1
vx2 = a3 - a1
vy2 = b3 - b1

for x=minX to maxX
	for y=minY to maxY
    'Vertice q = new Vertice(x - vt1.x, y - vt1.y);
    vx3 = x - a1
    vy3 = y - b1

    s = (vx3*vy2-vy3*vx2) / (vx1*vy2-vy1*vx2)
    t = (vx1*vy3-vy1*vx3) / (vx1*vy2-vy1*vx2)

    if ( (s >= 0) and (t >= 0) and (s + t <= 1)) then 
		if x>0 andalso y>0 andalso y<480 andalso x<640 then pset(x, y),col
    end if

	next
next
end if

end sub

[h4tt3n]

Ah, these are nice!

Reminds me of a 2d elastic grid I made way back. There's something to work on with your rope sim in that code :-)

Cheers,
Mike

Code: Select all

'******************************************************************************'
'
'   Michael "h4tt3n" Nissen, November 2009 - edited july 2017
'
'      sqrareroot-less spring grid.
'
'      (Press esc to quit)
'
'******************************************************************************'

dim as integer scrn_wid, scrn_hgt
screeninfo   scrn_wid, scrn_hgt

dim as integer    mesh_wid                 = scrn_wid * 0.1      ''   
dim as integer    mesh_hgt                 = scrn_hgt * 0.1      ''
dim as integer    num_particles            = mesh_wid*mesh_hgt   ''
dim as integer    num_springs               = (mesh_wid-1)*mesh_hgt + (mesh_hgt-1)*mesh_wid   

''   define constants. Play around with these and see what happens!
const as integer    border                     = 50                           ''   border around grid
const as integer    sleep_time                = 1                              ''   sleep time
const as single      pi                           = 4*atn(1)                  ''   pi
const as single    dt                     = 0.01                        ''  timestep, delta time
const as single      k                            = 0.4 / (dt*dt) *0.5    ''   spring stiffnes coefficient
const as single      c                            = 0.2 /  dt     *0.5   ''   spring damping coefficient
const as single      kg                            = k * 0.05                  ''   grid stiffnes
const as single      cg                            = c   * 0.05                  ''   grid damping
const as single      ks                            = k * 1                        ''   net stiffnes
const as single      cs                            = c   * 0.1                     ''   net damping
const as integer   interaction_radius   = 16                           ''   mouse interaction radius
const as integer   int_radius_sqrd         = interaction_radius*interaction_radius   

''  define types
type Vector_Type
  as single X, Y
end type

type Particle_Type
  as Vector_Type Frc, Vel, Psn, Home
end type 

type Spring_Type
   as integer a, b
   as single length
   as vector_type rest_length
end type

''   dim variables
dim shared as Particle_type Particle(1 to num_particles)
dim shared as Spring_type Spring(1 to num_springs)
dim as Vector_Type dst, vel
dim as single dst_sqrd
dim as integer mouse_x, mouse_y, mouse_x_old, mouse_y_old, mouse_vel_x, mouse_vel_y, mouse_b
dim as integer p = 0, S = 0

randomize

''   particles
for i as integer = 1 to mesh_hgt
   for j as integer = 1 to mesh_wid
      p += 1
      with Particle(p)
        .Psn.x    = border + ((j-1)/(mesh_wid-1)) * (scrn_wid-2*border)
        .Psn.y    = border + ((i-1)/(mesh_hgt-1)) * (scrn_hgt-2*border)
        .home.x = .psn.x
        .home.y = .psn.y
        '.Psn.x = (rnd-rnd) * 100000
        '.Psn.y = (rnd-rnd) * 100000
        '.vel.x = (rnd-rnd) * 100000
        '.vel.y = (rnd-rnd) * 100000
      end with
   next
next

''   horizontal springs
for i as integer = 1 to mesh_hgt step 1
   for j as integer = 1 to mesh_wid-1 step 1
         s += 1
         with Spring(s)
            .a = ((i-1)*mesh_wid+j)
            .b = ((i-1)*mesh_wid+j+1)
            .rest_length.x = particle(.b).home.x - particle(.a).home.x
            .rest_length.y = particle(.b).home.y - particle(.a).home.y
         end with
   next
next

''   vertical springs
for i as integer = 1 to mesh_wid step 1
   for j as integer = 1 to mesh_hgt-1 step 1
         s += 1
         with Spring(s)
            .a = (i+(j-1)*mesh_wid)
            .b = (i+mesh_wid+(j-1)*mesh_wid)
            .rest_length.x = particle(.b).home.x - particle(.a).home.x
            .rest_length.y = particle(.b).home.y - particle(.a).home.y
         end with
   next
next


ScreenRes( scrn_Wid, scrn_Hgt, 24, 2, 1 )
ScreenSet( 0, 1 )

Color RGB(128, 128, 255), RGB(0, 0, 0)

do
   
   mouse_x_old = mouse_x
   mouse_y_old = mouse_y
   
   GetMouse( mouse_x, mouse_y )
   
   ''
   mouse_vel_x = (mouse_x-mouse_x_old)/dt
   mouse_vel_y = (mouse_y-mouse_y_old)/dt
   
   ''
   for i as integer = 1 to num_particles
      with Particle(i)
         
         dst.x = (.psn.x - mouse_x)':   if abs(dst.x) > interaction_radius then continue for
         dst.y = (.psn.y - mouse_y)':   if abs(dst.y) > interaction_radius then continue for
         
         if dst.x*dst.x+dst.y*dst.y > int_radius_sqrd then continue for
         
         if mouse_vel_x then .vel.x += mouse_vel_x-.vel.x
         if mouse_vel_y then .vel.y += mouse_vel_y-.vel.y
         
      end with
   next
   
   ''   damped spring force that keeps particles snapped to grid
   ''   (cheap because it is of rest length zero)
   for i as integer = 1 to num_particles
      with Particle(i)
         .frc.x += -(.psn.x - .home.x) * kg - .vel.x * cg 
         .frc.y += -(.psn.y - .home.y) * kg - .vel.y * cg
      end with
   next
   
   ''   particle-particle damped spring grid
   for i as integer = 1 to num_springs
      with Spring(i)
         
         ''   distance vector
         dst.x = (particle(.b).psn.x - particle(.a).psn.x) - .rest_length.x
         dst.y = (particle(.b).psn.y - particle(.a).psn.y) - .rest_length.y
         
         ''
         vel.x = particle(.b).vel.x - particle(.a).vel.x
         vel.y = particle(.b).vel.y - particle(.a).vel.y
         
         ''   apply force vector
         particle(.a).frc.x -= -dst.x * ks - vel.x * cs
         particle(.a).frc.y -= -dst.y * ks - vel.y * cs
         
         particle(.b).frc.x += -dst.x * ks - vel.x * cs
         particle(.b).frc.y += -dst.y * ks - vel.y * cs
         
      end with
   next
   
   Cls
      
   for i as integer = 1 to num_springs
      with Spring(i)
         
         Line(particle(.a).Psn.X, particle(.a).Psn.Y)-(particle(.b).Psn.X, particle(.b).Psn.Y)
         
      end with
   Next
   
   ScreenCopy() 
   
   ''   integrate (symplectic Euler 1st order)
   for i as integer = 1 to num_particles
      
      ''   keep edges fixed to frame
      'if i <= mesh_wid then continue for
      'if i >= num_particles-mesh_wid then continue for
      'if (i mod mesh_wid) = 0 then continue for
      'if ((i-1) mod mesh_wid) = 0 then continue for
      
      ''   integrate
      with Particle(i)
         .vel.x += .frc.x * dt
         .vel.y += .frc.y * dt
         .frc.x  = 0
         .frc.y  = 0
         .Psn.x += .vel.x*dt
         .Psn.y += .vel.y*dt
      end with
      
   next
   
   sleep sleep_time, 1
   
loop while Not MultiKey(1)

End

[dodicat]

These are really good.
I think that h4tt3n waits patiently for an opening, then springs in with his tried and tested spring physics.

I had this one for water effects a while age, but didn't post it.
It is very boring (probably why I didn't post it).
No mouse effects, just let it settle.

The only thing I like about it is the water could be almost tropical.

Code: Select all

const bdr=120
const nn=93
dim shared as long jmp
dim shared as integer xres,yres
#macro SetPixel(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro

#define range(f,l) Int(Rnd*((l+1)-(f))+(f))

screenres 800,800,32
Dim shared As Integer pitch
Dim shared As Any Pointer row
row=screenptr
Dim shared As Ulong Pointer pixel
screeninfo xres,yres,,,pitch
jmp=nn+1
type pt
    as single x,y,z,dx,dy,dz
      #define vct Type<pt>
end type
        Operator + (Byref v1 As pt,Byref v2 As pt) As pt
        Return vct(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
        End Operator
        
        Operator ^ (Byref v1 As pt,Byref v2 As pt) As pt 'cross product
        Return vct(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
        End Operator
        
        Operator -(Byref v1 As pt,Byref v2 As pt) As pt
        Return vct(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
        End Operator
        
        Operator * (Byval f As Single,Byref v1 As pt) As pt
        Return vct(f*v1.x,f*v1.y,f*v1.z)
        End Operator
       
        function distance(v1 as pt,v2 as pt) as single
            return sqr((v1.x-v2.x)^2+(v1.y-v2.y)^2+(v1.z-v2.z)^2)
        end function
        
        Function normalize(byval v As pt) As pt
            dim as single length=Sqr(v.x*v.x+v.y*v.y+v.z*v.z)
            Return vct(v.x/length,v.y/length,v.z/length)
        End Function
        
type polygon
    as pt v(1 to 4)
    as long maxx=1e-6,minx=1e6,maxy=1e-6,miny=1e6
end type

Type angle
    As Single a(1 To 6)
End Type

function map(a as single,b as single,x as single,c as single,d as single) as single
 return ((d)-(c))*((x)-(a))/((b)-(a))+(c)
end function

Sub drawpolygon(p As Polygon,Byref col As Uinteger,Byval im As Any Pointer=0)
    For n As Long=1 To 4
        if p.maxx<p.v(n).x then p.maxx=p.v(n).x
        if p.minx>p.v(n).x then p.minx=p.v(n).x
        if p.maxy<p.v(n).y then p.maxy=p.v(n).y
        if p.miny>p.v(n).y then p.miny=p.v(n).y
    Next
    dim as pt c=p.v(2)-p.v(1),d=p.v(3)-p.v(2)
    c=normalize(c^d)     'cross product
    dim as single f=map(-1,1,c.z,0,1)
     Var cc=Cptr(Ubyte Ptr,@col)
    dim as ulong col2=Rgb(f*cc[2],f*cc[1],f*cc[0])
    for n1 as long=p.minx to p.maxx
        for n2 as long=p.miny to p.maxy
            setpixel(n1,n2,col2)
            next:next
End Sub

sub setpolygon(pg() as polygon,p() as pt)
    dim as long ct
     for x as long=2 to jmp-1
          for y as long=2 to jmp-1
              ct+=1
              with pg(ct)
              .v(1)=p(x+1,y+1)
              .v(2)=p(x+1,y-1)
              .v(3)=p(x-1,y-1)
              .v(4)=p(x-1,y+1)
              end with
          next
      next
    end sub

type v3 as pt
Function Rotate(c As V3,p As V3,a As angle,scale As V3=vct(1,1,1)) As V3
    Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
    Return vct((scale.x)*((a.a(5)*a.a(6))*dx+(-a.a(4)*a.a(3)+a.a(1)*a.a(2)*a.a(6))*dy+(a.a(1)*a.a(3)+a.a(4)*a.a(2)*a.a(6))*dz)+c.x,_
    (scale.y)*((a.a(5)*a.a(3))*dx+(a.a(4)*a.a(6)+a.a(1)*a.a(2)*a.a(3))*dy+(-a.a(1)*a.a(6)+a.a(4)*a.a(2)*a.a(3))*dz)+c.y,_
    (scale.z)*((-a.a(2))*dx+(a.a(1)*a.a(5))*dy+(a.a(4)*a.a(5))*dz)+c.z)
End Function

Function perspective(p As V3,eyepoint As V3) As V3
    Dim As Single   w=1+(p.z/eyepoint.z)
    Return vct((p.x-eyepoint.x)/w+eyepoint.x,_
    (p.y-eyepoint.y)/w+eyepoint.y,_
    (p.z-eyepoint.z)/w+eyepoint.z)
End Function 


dim as pt p(1 to (nn+1),1 to (nn+1)) 'grid point
dim as pt r(1 to (nn+1),1 to (nn+1)) 'copy
dim as long xx,yy
'set the grid
for x as long=bdr to xres-bdr step(xres-2*bdr)/nn
    xx+=1:yy=0
    for y as long=bdr to yres-bdr  step(yres-2*bdr)/nn
        yy+=1
        p(xx,yy)=type(y,x,0)
        r(xx,yy)=p(xx,yy)
    next
next

Function Regulate(Byval MyFps As long,Byref fps As long) As long
    Static As Double timervalue,lastsleeptime,t3,frames
    frames+=1
    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
    If sleeptime<1 Then sleeptime=1
    lastsleeptime=sleeptime
    timervalue=Timer
    Return sleeptime
End Function

    'reaction from surrounding 12 closest points
    function force(p() as pt,x as long,y as long) as pt
        dim as pt d(1 to 12)
        static as single z=1.38
               d(1)=(z/distance(p(x,y),p(x+1,y+1)))*(p(x,y)-p(x+1,y+1))
               d(2)=(z/distance(p(x,y),p(x+1,y-1)))*(p(x,y)-p(x+1,y-1))
               d(3)=(z/distance(p(x,y),p(x-1,y-1)))*(p(x,y)-p(x-1,y-1))
               d(4)=(z/distance(p(x,y),p(x-1,y+1)))*(p(x,y)-p(x-1,y+1))
            
               d(5)=(z/distance(p(x,y),p(x+1,y)))*(p(x,y)-p(x+1,y))
               d(6)=(z/distance(p(x,y),p(x,y+1)))*(p(x,y)-p(x,y+1))
               d(7)=(z/distance(p(x,y),p(x-1,y)))*(p(x,y)-p(x-1,y))
               d(8)=(z/distance(p(x,y),p(x,y-1)))*(p(x,y)-p(x,y-1))
               
               d(9)=(z/distance(p(x,y),p(x+2,y)))*(p(x,y)-p(x+2,y))
               d(10)=(z/distance(p(x,y),p(x,y+2)))*(p(x,y)-p(x,y+2))
               d(11)=(z/distance(p(x,y),p(x-2,y)))*(p(x,y)-p(x-2,y))
               d(12)=(z/distance(p(x,y),p(x,y-2)))*(p(x,y)-p(x,y-2))
             
             return -1*(d(1)+d(2)+d(3)+d(4)+d(5)+d(6)+d(7)+d(8)+d(9)+d(10)+d(11)+d(12)) 
        end function
        
    'rotate the full set of screen points
    sub slant(p as polygon,r as polygon,A as angle)
        for n as long=1 to 4
            r.v(n)= rotate(type(xres/2,yres/2),p.v(n),A) 
            r.v(n)=perspective(r.v(n),type(xres/2,yres/2,1000-200))
            next
    end sub
    
    
dim as pt angle
dim as angle A
dim as polygon pg(1 to (jmp-2)^2)
dim as polygon rt(1 to (jmp-2)^2)'rotated
dim as long fps
angle.x=-1
A=Type<angle>({Sin(angle.x),Sin(angle.y),Sin(angle.z),Cos(angle.x),Cos(angle.y),Cos(angle.z)})
do

     p(range(3,(jmp-2)),range(3,(jmp-2))).z+=15
    
    for x as long=3 to jmp-2
        for y as long=3 to jmp-2
           if instr(str(timer),"1234") then p(x,y)=r(x,y)
            dim as pt f=force(p(),x,y)
            p(x,y).dx=f.x
            p(x,y).dy=f.y
            p(x,y).dz=f.z
            p(x,y).x+=p(x,y).dx
            p(x,y).y+=p(x,y).dy
            p(x,y).z+=p(x,y).dz
            next:next
            
       setpolygon(pg(),p())
       
       for n as long=1 to ubound(pg)
              slant(pg(n),rt(n),A) 
           next n
           
    screenlock
    cls
 for n as long=1 to ubound(pg) 
     drawpolygon(rt(n),rgb(0,100,255))
 next
 draw string(20,20), "Framerate " &fps
    
    screenunlock
    sleep regulate(20,fps),1
loop until inkey=chr(27)


sleep

  

[Boromir]

Ah, these are nice!

Reminds me of a 2d elastic grid I made way back. There's something to work on with your rope sim in that code :-)

Cheers,
Mike

That looks really cool!
It encourages me to put more study time into physics. :)

I had this one for water effects a while age, but didn't post it.
It is very boring (probably why I didn't post it).
No mouse effects, just let it settle.

The only thing I like about it is the water could be almost tropical.

Not boring to me! :)
I wish I could code something like that. It kind of reminds me of the water from age of empires 2.