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)