Isometric Cube Liquid Sim

Game development specific discussions.
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Isometric Cube Liquid Sim

Post by Boromir »

Hey all,
I hadn't been doing much programming before this so my Freebasic is pretty rusty.
It's a little isometric water simulation. Fun project to get back in gear.

Code: Select all

type isolooptype
	dim as integer lbx=0,lby=0,ubx=60,uby=60
	dim as integer xp=0,yp=0,mw=32,mh=24
	dim as integer xs,ys
	dim as integer x,y,d
	dim as integer i,j
	
	declare sub init(mw2 as integer,mh2 as integer,xs2 as integer,ys2 as integer,lbx2 as integer,ubx2 as integer,lby2 as integer,uby2 as integer)
	declare function finish as integer
end type



sub isolooptype.init(mw2 as integer,mh2 as integer,xs2 as integer,ys2 as integer,lbx2 as integer,ubx2 as integer,lby2 as integer,uby2 as integer)
lbx=lbx2:lby=lby2:ubx=ubx2:uby=uby2
xp=0:yp=0
mw=mw2:mh=mh2
xs=xs2:ys=ys2
x=xs:y=ys:d=0
i=0:j=0

if x<lbx then finish
if x>ubx then finish
if y<lby then finish
if y>uby then finish

end sub

function isolooptype.finish as integer

do
	i+=1
	x+=1
	y+=1
	if i>mw then
			if d=1 then
			xp-=1
			d=0
			else
			yp+=1
			d=1
			end if
		y=ys+yp
		x=xs+xp
		i=0
		j+=1
		if j>mh then return 1
	end if
loop until x>=lbx andalso y>=lby andalso x<=ubx andalso y<=uby

return 0
end function

dim shared as isolooptype isoloop










Function darken( ByVal sourcepixel As ulong, ByVal destinationpixel As ulong, ByVal parameter As Any Ptr ) As ulong
    Dim threshold As Single = 0
    If parameter <> 0 Then threshold = *CPtr(Single Ptr, parameter)
	threshold*=6
	if threshold>100 then threshold=100
	if threshold<-100 then threshold=-100
	if sourcepixel=rgb(0,100,100) then
		Return rgb(0,130+threshold,130+threshold)
	elseif sourcepixel=rgb(0,150,150) then
		Return rgb(0,100+threshold,100+threshold)
	elseif sourcepixel=rgb(0,200,200) then
		Return rgb(100+threshold,150+threshold,150+threshold)
	else
		return destinationpixel
	end if
End Function

type p2d
	x as double
	y as double
end type

type water
	img as any ptr
	posit as p2d
	w as integer
	h as integer
	res as integer
	height(any,any) as double
	heightc(any,any) as double
	speed(any,any) as double
	rendermode as integer=-1
	declare sub init(w2 as integer,h2 as integer,res2 as integer)
	declare sub process()
	declare sub render()
	declare sub drawcube()
end type



sub water.init(w2 as integer,h2 as integer,res2 as integer)
w=w2
h=h2
res=res2
redim height(w,h) as double
redim heightc(w,h) as double
redim speed(w,h) as double

img=imagecreate(1,1,rgb(255,0,255))
drawcube
end sub

sub water.drawcube()
dim as integer w,h,ext
w=res*2:h=res*2':ext=res*4
imagedestroy(img)
img=imagecreate(w,h+ext,rgb(255,0,255))
dim as uinteger col1,col2,col3
col1=rgb(0,100,100)
col2=rgb(0,150,150)
col3=rgb(0,200,200)

line img,(0,h/4)-(w/2,0),col1
line img,(0,(h*.75)+ext)-(w/2,h+ext),col1
line img,(w/2,0)-(w/2,h+ext),col1
paint img,(w/4,h/2),col1,col1

line img,(w/2,h+ext)-(w,(h*.75)+ext),col2
line img,(w/2,0)-(w,h/4),col2
line img,(w/2,0)-(w/2,h+ext),col2
paint img,(w*.75,h/2),col2,col2


line img,(0,h/4)-(w/2,0),col3
line img,(0,h/4)-(w/2,h/2),col3
line img,(w/2,h/2)-(w,h/4),col3
line img,(w/2,0)-(w,h/4),col3
paint img,(w/2,5),col3,col3

end sub


sub water.process()

for x as integer =0 to w
	for y as integer =0 to h
		heightc(x,y)=height(x,y)
	next
next

for x as integer =0 to w
	for y as integer =0 to h
		dim as double a1,a2,a3,a4,c
		if x>0 then a1=heightc(x-1,y):c+=1
		if x<w then a2=heightc(x+1,y):c+=1
		if y>0 then a3=heightc(x,y-1):c+=1
		if y<h then a4=heightc(x,y+1):c+=1
		dim as double dst=-heightc(x,y)+((a1+a2+a3+a4)/c)
		speed(x,y)+=dst-(heightc(x,y)/60)
		
		height(x,y)+=speed(x,y)
		speed(x,y)=speed(x,y)/1.05

		
		if height(x,y)>1 then height(x,y)=1
		if height(x,y)<-1 then height(x,y)=-1
	next
next

end sub 


function iso(x as double,y as double) as p2d
	dim as p2d ret
	ret.x=x+y
	ret.y=(-x+y)/2
	return ret
end function

function deiso(x as double,y as double) as p2d
	dim as p2d ret
	ret.x=(x/2)-y
	ret.y=(x/2)+y
	return ret
end function

function inbounds(pt as p2d,lx as integer,ly as integer,ux as integer,uy as integer) as boolean
	if pt.x>=lx andalso pt.x<=ux andalso pt.y>=ly andalso pt.y<=uy  then
	return true
	end if
	
	return false
end function


sub water.render()
dim as p2d n
n.x-=posit.x+2:n.y-=posit.y+1
n=deiso(n.x,n.y)
	
isoloop.init(840/res,620/(res/4),n.x,n.y,lbound(height,1),ubound(height,1),lbound(height,2),ubound(height,2)):do
	dim as integer x=isoloop.x,y=isoloop.y
	dim as p2d n=iso(x,y)
	n.x+=posit.x
	n.y+=posit.y
	n.x*=res
	n.y*=res
	
	dim as single j=height(x,y)*res*6

	if rendermode=-1 then
		put (n.x,n.y-j),img,custom,@darken,@j
	else
		put (n.x,n.y-j),img,alpha,100
	end if
loop until isoloop.finish=1


end sub 


screenres 820,600,32

dim as integer mx,my,cl
dim as water water1
water1.init(1100,1100,20)
water1.posit.x=0
water1.posit.y=12

do
getmouse mx,my,,cl

screenlock
cls
water1.render
draw string (0,0),"W-A-S-D keys move camera"
draw string (0,15),"Q-E keys adjust zoom"
draw string (0,30),"R key to toggle transparency"
screenunlock

if cl=1 orelse cl=2 then
	dim as p2d n
	n.x=mx               : n.y=my
	n.x/=water1.res      : n.y/=water1.res
	n.x-=water1.posit.x  : n.y-=water1.posit.y
	n=deiso(n.x,n.y)
	if inbounds(n,1,1,ubound(water1.height,1)-1,ubound(water1.height,2)-1)=true then
		if cl=1 then
			water1.speed(n.x,n.y)+=0.1
			water1.speed(n.x+1,n.y)+=0.05
			water1.speed(n.x,n.y+1)+=0.05
			water1.speed(n.x-1,n.y)+=0.05
			water1.speed(n.x,n.y-1)+=0.05
		elseif cl=2 then
			water1.speed(n.x,n.y)-=0.1
			water1.speed(n.x+1,n.y)-=0.05
			water1.speed(n.x,n.y+1)-=0.05
			water1.speed(n.x-1,n.y)-=0.05
			water1.speed(n.x,n.y-1)-=0.05
		end if
	end if
end if

water1.process

if multikey(17) then water1.posit.y+=1
if multikey(30) then water1.posit.x+=1
if multikey(31) then water1.posit.y-=1
if multikey(32) then water1.posit.x-=1

if multikey(16) andalso water1.res>6 then water1.res-=1:water1.drawcube
if multikey(18) andalso water1.res<20 then water1.res+=1:water1.drawcube

if ucase(inkey)="R" then water1.rendermode=-water1.rendermode

sleep 1
loop until multikey(1)

Last edited by Boromir on Sep 30, 2021 17:21, edited 1 time in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: Isometric Cube Liquid Sim

Post by D.J.Peters »

For 32/64bit compatibility you have to change the custom blender function to ULONG color type

Code: Select all

Function darken(ByVal sourcepixel As ULong, _
                ByVal destinationpixel As  ULong, _
                ByVal parameter As Any Ptr ) As ULong
and in drawcube() you can used static ULONG colors and pre calculate some vales

Code: Select all

sub water.drawcube()
  const as ulong col1=rgb(0,100,100)
  const as ulong col2=rgb(0,150,150)
  const as ulong col3=rgb(0,200,200)
  dim as integer w,h,w2,h2,w4,h4,h75,w75
  w=res*2:h=res*2
  w2=w\2:h2=h\2
  w4=w\4:h4=h\4
  h75=h*0.75
  w75=w*0.75
  imagedestroy(img)
  img=imagecreate(w,h,rgb(255,0,255))
  
  line img,(0 ,h4 )-(w2,0),col1
  line img,(0 ,h75)-(w2,h),col1
  line img,(w2,0  )-(w2,h),col1
  paint img,(w4,h2),col1,col1

  line img,(w2,h)-(w,h75),col2
  line img,(w2,0)-(w,h4),col2
  line img,(w2,0)-(w2,h),col2
  paint img,(w75,h2),col2,col2
  
  line img,(0 ,h4)-(w2,0 ),col3
  line img,(0 ,h4)-(w2,h2),col3
  line img,(w2,h2)-(w ,h4),col3
  line img,(w2,0 )-(w ,h4),col3
  paint img,(w2,5),col3,col3
end sub
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Isometric Cube Liquid Sim

Post by badidea »

Maybe good to mention that one should use the mouse to see anything interesting.
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Re: Isometric Cube Liquid Sim

Post by counting_pine »

Pretty low FPS on my laptop, but it looks nice!
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: Isometric Cube Liquid Sim

Post by jj2007 »

TmpFb.bas(217) error 20: Type mismatch in 'put (n.x,n.y-j),img,custom,@darken,@j'
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric Cube Liquid Sim

Post by Boromir »

This should be much faster.

Using ulong in the darken function gives me this error
I'm using 64bit Freebasic on Ubuntu

Code: Select all

water.bas(219) error 20: Type mismatch in 'put (n.x,n.y-j),img,custom,@darken,@j'

Code: Select all

type isolooptype
	dim as integer lbx=0,lby=0,ubx=60,uby=60
	dim as integer xp=0,yp=0,mw=32,mh=24
	dim as integer xs,ys
	dim as integer x,y,d
	dim as integer i,j
	
	declare sub init(mw2 as integer,mh2 as integer,xs2 as integer,ys2 as integer,lbx2 as integer,ubx2 as integer,lby2 as integer,uby2 as integer)
	declare function finish as integer
end type



sub isolooptype.init(mw2 as integer,mh2 as integer,xs2 as integer,ys2 as integer,lbx2 as integer,ubx2 as integer,lby2 as integer,uby2 as integer)
lbx=lbx2:lby=lby2:ubx=ubx2:uby=uby2
xp=0:yp=0
mw=mw2:mh=mh2
xs=xs2:ys=ys2
x=xs:y=ys:d=0
i=0:j=0

if x<lbx then finish
if x>ubx then finish
if y<lby then finish
if y>uby then finish

end sub

function isolooptype.finish as integer

do
	i+=1
	x+=1
	y+=1
	if i>mw then
			if d=1 then
			xp-=1
			d=0
			else
			yp+=1
			d=1
			end if
		y=ys+yp
		x=xs+xp
		i=0
		j+=1
		if j>mh then return 1
	end if
loop until x>=lbx andalso y>=lby andalso x<=ubx andalso y<=uby

return 0
end function

dim shared as isolooptype isoloop





Function darken( ByVal sourcepixel As ulong, ByVal destinationpixel As ulong, ByVal parameter As Any Ptr ) As ulong
    Dim threshold As Single = 0
    If parameter <> 0 Then threshold = *CPtr(Single Ptr, parameter)
	threshold*=6
	if threshold>100 then threshold=100
	if threshold<-100 then threshold=-100
	if sourcepixel=rgb(0,100,100) then
		Return rgb(0,130+threshold,130+threshold)
	elseif sourcepixel=rgb(0,150,150) then
		Return rgb(0,100+threshold,100+threshold)
	elseif sourcepixel=rgb(0,200,200) then
		Return rgb(100+threshold,150+threshold,150+threshold)
	else
		return destinationpixel
	end if
End Function

type p2d
	x as double
	y as double
end type

type water
	img as any ptr
	posit as p2d
	w as integer
	h as integer
	res as integer
	height(any,any) as double
	heightc(any,any) as double
	speed(any,any) as double
	rendermode as integer=-1
	declare sub init(w2 as integer,h2 as integer,res2 as integer)
	declare sub process()
	declare sub render()
	declare sub drawcube()
end type



sub water.init(w2 as integer,h2 as integer,res2 as integer)
w=w2
h=h2
res=res2
redim height(w,h) as double
redim heightc(w,h) as double
redim speed(w,h) as double

img=imagecreate(1,1,rgb(255,0,255))
drawcube
end sub

sub water.drawcube()
  const as ulong col1=rgb(0,100,100)
  const as ulong col2=rgb(0,150,150)
  const as ulong col3=rgb(0,200,200)
  dim as integer w,h,w2,h2,w4,h4,h75,w75
  w=res*2:h=res*2
  w2=w\2:h2=h\2
  w4=w\4:h4=h\4
  h75=h*0.75
  w75=w*0.75
  imagedestroy(img)
  img=imagecreate(w,h,rgb(255,0,255))
 
  line img,(0 ,h4 )-(w2,0),col1
  line img,(0 ,h75)-(w2,h),col1
  line img,(w2,0  )-(w2,h),col1
  paint img,(w4,h2),col1,col1

  line img,(w2,h)-(w,h75),col2
  line img,(w2,0)-(w,h4),col2
  line img,(w2,0)-(w2,h),col2
  paint img,(w75,h2),col2,col2
 
  line img,(0 ,h4)-(w2,0 ),col3
  line img,(0 ,h4)-(w2,h2),col3
  line img,(w2,h2)-(w ,h4),col3
  line img,(w2,0 )-(w ,h4),col3
  paint img,(w2,5),col3,col3
end sub



sub water.process()

for x as integer =0 to w
	for y as integer =0 to h
		heightc(x,y)=height(x,y)
	next
next

for x as integer =0 to w
	for y as integer =0 to h
		dim as double a1,a2,a3,a4,c
		if x>0 then a1=heightc(x-1,y):c+=1
		if x<w then a2=heightc(x+1,y):c+=1
		if y>0 then a3=heightc(x,y-1):c+=1
		if y<h then a4=heightc(x,y+1):c+=1
		dim as double dst=-heightc(x,y)+((a1+a2+a3+a4)/c)
		speed(x,y)+=dst-(heightc(x,y)/60)
		
		height(x,y)+=speed(x,y)
		speed(x,y)=speed(x,y)/1.05

		
		if height(x,y)>1 then height(x,y)=1
		if height(x,y)<-1 then height(x,y)=-1
	next
next

end sub 


function iso(x as double,y as double) as p2d
	dim as p2d ret
	ret.x=x+y
	ret.y=(-x+y)/2
	return ret
end function

function deiso(x as double,y as double) as p2d
	dim as p2d ret
	ret.x=(x/2)-y
	ret.y=(x/2)+y
	return ret
end function

function inbounds(pt as p2d,lx as integer,ly as integer,ux as integer,uy as integer) as boolean
	if pt.x>=lx andalso pt.x<=ux andalso pt.y>=ly andalso pt.y<=uy  then
	return true
	end if
	
	return false
end function


sub water.render()
dim as p2d n
n.x-=posit.x+2:n.y-=posit.y+1
n=deiso(n.x,n.y)
	
isoloop.init(840/res,620/(res/4),n.x,n.y,lbound(height,1),ubound(height,1),lbound(height,2),ubound(height,2)):do
	dim as integer x=isoloop.x,y=isoloop.y
	dim as p2d n=iso(x,y)
	n.x+=posit.x
	n.y+=posit.y
	n.x*=res
	n.y*=res
	
	dim as single j=height(x,y)*res*6

	if rendermode=-1 then
		put (n.x,n.y-j),img,custom,@darken,@j
	else
		put (n.x,n.y-j),img,alpha,100
	end if
loop until isoloop.finish=1


end sub 


screenres 820,600,32

dim as integer mx,my,cl
dim as water water1
water1.init(100,100,20)
water1.posit.x=0
water1.posit.y=12

do
getmouse mx,my,,cl

screenlock
cls
water1.render
draw string (0,0),"W-A-S-D keys move camera"
draw string (0,15),"Q-E keys adjust zoom"
draw string (0,30),"R key to toggle transparency"
draw string (0,45),"L and R click to push/pull water"
screenunlock

if cl=1 orelse cl=2 then
	dim as p2d n
	n.x=mx               : n.y=my
	n.x/=water1.res      : n.y/=water1.res
	n.x-=water1.posit.x  : n.y-=water1.posit.y
	n=deiso(n.x,n.y)
	if inbounds(n,1,1,ubound(water1.height,1)-1,ubound(water1.height,2)-1)=true then
		if cl=1 then
			water1.speed(n.x,n.y)+=0.1
			water1.speed(n.x+1,n.y)+=0.05
			water1.speed(n.x,n.y+1)+=0.05
			water1.speed(n.x-1,n.y)+=0.05
			water1.speed(n.x,n.y-1)+=0.05
		elseif cl=2 then
			water1.speed(n.x,n.y)-=0.1
			water1.speed(n.x+1,n.y)-=0.05
			water1.speed(n.x,n.y+1)-=0.05
			water1.speed(n.x-1,n.y)-=0.05
			water1.speed(n.x,n.y-1)-=0.05
		end if
	end if
end if

water1.process

if multikey(17) then water1.posit.y+=1
if multikey(30) then water1.posit.x+=1
if multikey(31) then water1.posit.y-=1
if multikey(32) then water1.posit.x-=1

if multikey(16) andalso water1.res>6 then water1.res-=1:water1.drawcube
if multikey(18) andalso water1.res<20 then water1.res+=1:water1.drawcube

if ucase(inkey)="R" then water1.rendermode=-water1.rendermode

sleep 1
loop until multikey(1)
Last edited by Boromir on Sep 30, 2021 17:30, edited 2 times in total.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Isometric Cube Liquid Sim

Post by MrSwiss »

Boromir wrote:Using ulong in the darken function gives me this error -- I'm using 64bit Freebasic on Ubuntu
It's NOT what you do in the darken() procedure, it's the 'return type' which must be ULong too (NOT UInteger).
Btw: Joshy (D.J.Peters) has already stated that, in his post before.

Code: Select all

Function darken( ByVal sourcepixel As ulong, ByVal destinationpixel As ulong, ByVal parameter As Any Ptr ) As Ulong
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric Cube Liquid Sim

Post by Boromir »

MrSwiss wrote:It's NOT what you do in the darken() procedure, it's the 'return type' which must be ULong too (NOT UInteger).
Btw: Joshy (D.J.Peters) has already stated that, in his post before.
Yes, if even one of those is a ulong I get a compiler error.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Isometric Cube Liquid Sim

Post by MrSwiss »

Boromir wrote:Yes, if even one of those is a ulong I get a compiler error.
ALL of them must be ULONG, except the PTR.

What compiler errors are you getting ? (I'll get none ...)
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric Cube Liquid Sim

Post by Boromir »

MrSwiss wrote:ALL of them must be ULONG, except the PTR.

What compiler are you getting ? (I'll get none ...)
I'm using the FreeBASIC Compiler - Version 1.07.1 (2019-09-27), built for linux-x86_64 (64bit)
This compiles with no error

Code: Select all

Function darken( ByVal sourcepixel As uinteger, ByVal destinationpixel As uinteger, ByVal parameter As Any Ptr ) As uinteger
And this gives the error 20: Type mismatch in 'put (n.x,n.y-j),img,custom,@darken,@j'

Code: Select all

Function darken( ByVal sourcepixel As ulong, ByVal destinationpixel As ulong, ByVal parameter As Any Ptr ) As ulong
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Isometric Cube Liquid Sim

Post by MrSwiss »

Seems to be the FBC version then: I'm using 1.08.1 - WIN - 64-bit.
(a lot of graphics related stuff, has been updated, since 1.07.n versions)
Wiki - online manual ... wrote:declare function identifier ( byval source_pixel as ulong, byval destination_pixel as ulong, byval parameter as any ptr ) as ulong
See: https://www.freebasic.net/wiki/KeyPgPutgraphics
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Isometric Cube Liquid Sim

Post by BasicCoder2 »

Downloading what I assume was the latest from the first post in this thread I get the same error.
Type mismatch in 'put (n.x,n.y-j),img,custom,@darken,@j'

System:
FBIde: 0.4.6
fbc: FreeBASIC Compiler - Version 1.07.1 (2019-09-27), built for win32 (32bit)
OS: Windows NT 6.2 (build 9200)
I don't know why it says, OS: Windows NT because I am using a windows 10 64 bit computer maybe that is the issue. Whatever it is I have no idea how to change the code to make it work on this machine with this FB compiler.

Problem with updates is the breaking of old source code. I had the same issue with c++ tutorial books I spent a lot of money on 12 years ago that will not compile with the latest compilers and I don't know how to modify that source code either. I don't have enough hobby time to keep up with it all.
MrSwiss
Posts: 3910
Joined: Jun 02, 2013 9:27
Location: Switzerland

Re: Isometric Cube Liquid Sim

Post by MrSwiss »

@BasicCoder2,

get the latest official release: FBC 1.08.1 and everything is OK.
It's in fact the 'other way around' this time: new code and, to old compiler ...

OS: Windows NT 6.2 (build 9200) says: Windows NT (Y2K [aka: Win 2000], XP and later) 6.2 = Win 8.0 (very old)
(if you'd truely had Win 10 it whould show: Windows NT 10 ...)
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Isometric Cube Liquid Sim

Post by BasicCoder2 »

It is a recent new laptop windows 10 64 bit computer regardless of what the compiler error message says.

So if I update then maybe my old code will not run. Really need to keep the old compiler and old code in one folder and the new compiler and new code in another folder.

Tried to run it with Geany and something strange happened. The Build was there for one source code but not for the new one.
Boromir
Posts: 463
Joined: Apr 30, 2015 19:28
Location: Oklahoma,U.S., Earth,Solar System
Contact:

Re: Isometric Cube Liquid Sim

Post by Boromir »

BasicCoder2 wrote:It is a recent new laptop windows 10 64 bit computer regardless of what the compiler error message says.

So if I update then maybe my old code will not run. Really need to keep the old compiler and old code in one folder and the new compiler and new code in another folder.

Tried to run it with Geany and something strange happened. The Build was there for one source code but not for the new one.
If you'd rather not update you could just change the darken function back to this and it will work with your current compiler.

Code: Select all

Function darken( ByVal sourcepixel As uinteger, ByVal destinationpixel As uinteger, ByVal parameter As Any Ptr ) As uinteger
Post Reply