A destructable terrain.

A pretty complicated system to do destructable terrains. Not really in usable form yet, but I hope I can make it usable in the near future.

                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    sync on : sync rate 60



rem VAR setup

global worldsizex : worldsizex=20
global worldsizey : worldsizey=20
global worldsizez : worldsizez=20
global xsize# as float : xsize#=25.0
global ysize# as float : ysize#=25.0
global zsize# as float : zsize#=25.0
global Utile# as float : Utile#=1.00
global Vtile# as float : Vtile#=1.00
global Wtile# as float : Wtile#=1.00
global radiusx# as float : radiusx#=5.0
global radiusy# as float : radiusy#=10.0
global radiusz# as float : radiusz#=5.0
global radius2# as float
radius2#=radiusx#*radiusx#
global radparty# as float
radparty#=radiusy#/radiusx#
global radpartz# as float
radpartz#=radiusz#/radiusx#
global poly : poly=0
global smooth# as float : smooth#=0.250
global smoothamount : smoothamount=5
global dim poxeldata(255,12)
global dim conv(8,2)
read_poxeldata()
global dim poxels(worldsizex,worldsizey,worldsizez)
global dim poxeldisplace#(worldsizex,worldsizey,worldsizez,2)
global dim poxelexpl(worldsizex,worldsizey,worldsizez)
global dim poxelpoly(worldsizex,worldsizey,worldsizez)
global dim poxelcolor(worldsizex,worldsizey,worldsizez)






rem fill array
for x=0 to worldsizex
for y=0 to worldsizey
for z=0 to worldsizez
height#=sin(x*9)*sin(z*9)*18.0
dist#=sqrt(((y-5.00)*(y-5.00))+((z-10.00)*(z-10.00)))
dist2#=sqrt(((x-10.00)*(x-10.00))+((z-10.00)*(z-10.00)))
dist3#=sqrt(((x-10.00)*(x-10.00))+((y-10.00)*(y-10.00))+((z-10.00)*(z-10.00)))
if y<height# and dist#>=3 and dist2#>=2 then poxels(x,y,z)=1
rem if x>=1 and x<=3 and y>=1 and y<=3 and z>=1 and z<=3 then poxels(x,y,z)=1
next z
next y
next x



rem load image
load image "grass.bmp",1



write_mesh()
copyarray()

position light 0,0,500,0
position camera 0,500,0

wireframe=0
wkey=0
blow=0

autocam off
make object sphere 5,10.0
scale object 5,100,200,100
ghost object on 5



rem create bullet
make object sphere 6,4.0
color object 6,rgb(255,0,0)
launchtime=timer()
hide object 6





rem MAIN LOOP

do

text 0,0,str$(screen fps())
text 0,20,str$(statistic(1))

yrotate camera wrapvalue(camera angle y()+mousemovex())
xrotate camera wrapvalue(camera angle x()+mousemovey())
if mouseclick()=1 then move camera 2
if mouseclick()=2 then move camera -2


rem collision
gosub poxelcollision



if inkey$()="w" and wkey=0
wkey=1
wireframe=1-wireframe
set object wireframe 10,wireframe
endif

if inkey$()<>"w" then wkey=0



rem rebuild mesh code in steps for speed
if blow=4 then gosub changeit : blow=0
if blow=3 then gosub rebuild2 : blow=4
if blow=2 then gosub rebuild : blow=3
if blow=1 then copyarray() : blow=2





rem launch bullet
if object visible(6)=0 and spacekey()=1 and timer()-launchtime>1000
launchtime=timer()
position object 6,cx#,cy#,cz#
show object 6
rotate object 6,camera angle x(),camera angle y(),0
endif

rem move bullet
col2=0
if object visible(6)=1 then gosub bulletcollision
if timer()-launchtime>2000 then hide object 6

if col2=1 and blow=0
hide object 6
hole(radius#,centerx#,centery#,centerz#)
blow=1
bx=int((centerx#-radius#)/xsize#)-2 : ex=int((centerx#+radius#)/xsize#)+2
by=int((centery#-radius#)/ysize#)-2 : ey=int((centery#+radius#)/ysize#)+2
bz=int((centerz#-radius#)/zsize#)-2 : ez=int((centerz#+radius#)/zsize#)+2
if bx<0 then bx=0
if ex>worldsizex then ex=worldsizex
if by<0 then by=0
if ey>worldsizey then ey=worldsizey
if bz<0 then bz=0
if ez>worldsizez then ez=worldsizez
endif


if returnkey()=1
for x=0 to worldsizex
for y=0 to worldsizey
for z=0 to worldsizez
for n=0 to 2
poxeldisplace#(x,y,z,n)=0
next n
next z
next y
next x
blow=1
bx=0 : ex=20
by=0 : ey=20
bz=0 : ez=20
endif




move camera -150
sync
move camera 150

loop













rem COLLISION

poxelcollision:

cx#=camera position x() : cy#=camera position y() : cz#=camera position z()

minx=int((cx#-radiusx#-xsize#)/xsize#) : maxx=int((cx#+radiusx#+xsize#)/xsize#)
miny=int((cy#-radiusy#-ysize#)/ysize#) : maxy=int((cy#+radiusy#+ysize#)/ysize#)
minz=int((cz#-radiusz#-zsize#)/zsize#) : maxz=int((cz#+radiusz#+zsize#)/zsize#)

col2=0
vecx#=0.00 : vecy#=0.00 : vecz#=0.00

for p=1 to poly
col=0
if polys(p,18)>=minx and polys(p,18)<=maxx and polys(p,19)>=miny and polys(p,19)<=maxy and polys(p,20)>=minz and polys(p,20)<=maxz

v1x#=memblock float(1,12+((p-1)*108)) : v1y#=memblock float(1,16+((p-1)*108)) : v1z#=memblock float(1,20+((p-1)*108))
v2x#=memblock float(1,48+((p-1)*108)) : v2y#=memblock float(1,52+((p-1)*108)) : v2z#=memblock float(1,56+((p-1)*108))
v3x#=memblock float(1,84+((p-1)*108)) : v3y#=memblock float(1,88+((p-1)*108)) : v3z#=memblock float(1,92+((p-1)*108))
rem nx#=polynormal#(p,0) : ny#=polynormal#(p,1) : nz#=polynormal#(p,2)
nx#=((v2y#-v1y#)*(v3z#-v1z#))-((v2z#-v1z#)*(v3y#-v1y#))
ny#=((v2z#-v1z#)*(v3x#-v1x#))-((v2x#-v1x#)*(v3z#-v1z#))
nz#=((v2x#-v1x#)*(v3y#-v1y#))-((v2y#-v1y#)*(v3x#-v1x#))
l#=sqrt((nx#*nx#)+(ny#*ny#)+(nz#*nz#))
nx#=nx#/l# : ny#=ny#/l# : nz#=nz#/l#
D#=((v1x#*nx#)+(v1y#*ny#)+(v1z#*nz#))
u#=((nx#*cx#)+(ny#*cy#)+(nz#*cz#)-D#)/((nx#*nx#*radiusx#)+(ny#*ny#*radiusy#)+(nz#*nz#*radiusz#))

if u#>=0.00 and u#<1.00
   ix#=cx#-(nx#*u#*radiusx#) : iy#=cy#-(ny#*u#*radiusy#) : iz#=cz#-(nz#*u#*radiusz#)
   gosub linecol
   if col=1
      newx#=ix#+(nx#*radiusx#) : newy#=iy#+(ny#*radiusy#) : newz#=iz#+(nz#*radiusz#)
   else
      gosub edgecol
      if col=1
      else
         gosub distcol
         if col=1
         endif
      endif
   endif
endif

if col=1 then col2=1 : vecx#=vecx#+(newx#-cx#) : vecy#=vecy#+(newy#-cy#) : vecz#=vecz#+(newz#-cz#)

endif
next p

position camera curvevalue(cx#+vecx#,camera position x(),2),curvevalue(cy#+vecy#,camera position y(),2),curvevalue(cz#+vecz#,camera position z(),2)
position object 5,curvevalue(cx#+vecx#,object position x(5),2),curvevalue(cy#+vecy#,object position y(5),2),curvevalue(cz#+vecz#,object position z(5),2)

return
















function write_mesh()

poly=0

for x=0 to worldsizex-1
for y=0 to worldsizey-1
for z=0 to worldsizez-1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
poly=poly+(poxeldata(blocktype,0))
next z
next y
next x

global dim polys(poly,20)

poly=0

for x=0 to worldsizex-1
for y=0 to worldsizey-1
for z=0 to worldsizez-1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)

for q=1 to poxeldata(blocktype,0)
poly=poly+1
polys(poly,0)=x+conv(poxeldata(blocktype,1+((q-1)*3)),0)
polys(poly,1)=y+conv(poxeldata(blocktype,1+((q-1)*3)),1)
polys(poly,2)=z+conv(poxeldata(blocktype,1+((q-1)*3)),2)
polys(poly,9)=(((conv(poxeldata(blocktype,1+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00
polys(poly,10)=(((conv(poxeldata(blocktype,1+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00
polys(poly,11)=(((conv(poxeldata(blocktype,1+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00

polys(poly,3)=x+conv(poxeldata(blocktype,2+((q-1)*3)),0)
polys(poly,4)=y+conv(poxeldata(blocktype,2+((q-1)*3)),1)
polys(poly,5)=z+conv(poxeldata(blocktype,2+((q-1)*3)),2)
polys(poly,12)=(((conv(poxeldata(blocktype,2+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00
polys(poly,13)=(((conv(poxeldata(blocktype,2+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00
polys(poly,14)=(((conv(poxeldata(blocktype,2+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00

polys(poly,6)=x+conv(poxeldata(blocktype,3+((q-1)*3)),0)
polys(poly,7)=y+conv(poxeldata(blocktype,3+((q-1)*3)),1)
polys(poly,8)=z+conv(poxeldata(blocktype,3+((q-1)*3)),2)
polys(poly,15)=(((conv(poxeldata(blocktype,3+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00
polys(poly,16)=(((conv(poxeldata(blocktype,3+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00
polys(poly,17)=(((conv(poxeldata(blocktype,3+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00

polys(poly,18)=x : polys(poly,19)=y : polys(poly,20)=z
poxelpoly(polys(poly,0),polys(poly,1),polys(poly,2))=1
poxelpoly(polys(poly,3),polys(poly,4),polys(poly,5))=1
poxelpoly(polys(poly,6),polys(poly,7),polys(poly,8))=1
next q

next z
next y
next x


rem smoothshading

global dim poxelnormal#(worldsizex,worldsizey,worldsizez,2)
global dim polynormal#(poly,2)

for p=1 to poly

v1x#=polys(p,0)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),0) : v1y#=polys(p,1)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),1) : v1z#=polys(p,2)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),2)
v2x#=polys(p,3)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),0) : v2y#=polys(p,4)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),1) : v2z#=polys(p,5)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),2)
v3x#=polys(p,6)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),0) : v3y#=polys(p,7)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),1) : v3z#=polys(p,8)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),2)

nx2#=((v2y#-v1y#)*(v3z#-v1z#))-((v2z#-v1z#)*(v3y#-v1y#))
ny2#=((v2z#-v1z#)*(v3x#-v1x#))-((v2x#-v1x#)*(v3z#-v1z#))
nz2#=((v2x#-v1x#)*(v3y#-v1y#))-((v2y#-v1y#)*(v3x#-v1x#))
l#=sqrt((nx2#*nx2#)+(ny2#*ny2#)+(nz2#*nz2#))
nx2#=nx2#/l# : ny2#=ny2#/l# : nz2#=nz2#/l#

polynormal#(p,0)=nx2# : polynormal#(p,1)=ny2# : polynormal#(p,2)=nz2#

for v=0 to 2
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)+nx2#
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)+ny2#
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)+nz2#
next v

next p



for s=1 to smoothamount

global dim smoothed(worldsizex,worldsizey,worldsizez)

for p=1 to poly
for v=0 to 2
if smoothed(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)))=0
smoothed(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)))=1
x=polys(p,0+(v*3)) : y=polys(p,1+(v*3)) : z=polys(p,2+(v*3))
bx#=(x+poxeldisplace#(x,y,z,0))*xsize# : by#=(y+poxeldisplace#(x,y,z,1))*ysize# : bz#=(z+poxeldisplace#(x,y,z,2))*zsize#
gx#=0.00 : gy#=0.00 : gz#=0.00 : count#=0.00
dim done(27) : cur=0

for q=1 to poly
for w=0 to 2
if polys(q,0+(w*3))=x and polys(q,1+(w*3))=y and polys(q,2+(w*3))=z
for u=0 to 2
if u<>w
x2=polys(q,0+(u*3)) : y2=polys(q,1+(u*3)) : z2=polys(q,2+(u*3)) : ID=(z2*(worldsizex+1)*(worldsizey+1))+(y2*(worldsizex+1))+x2
check=0
for c=0 to cur-1
if done(c)=ID then check=1
next c

if check=0
done(cur)=ID : cur=cur+1
gx#=gx#+((x2+poxeldisplace#(x2,y2,z2,0))*xsize#) : gy#=gy#+((y2+poxeldisplace#(x2,y2,z2,1))*ysize#) : gz#=gz#+((z2+poxeldisplace#(x2,y2,z2,2))*zsize#)
count#=count#+1.00
endif

endif
next u
endif
next w
next q

if count#=0.00
gx#=bx# : gy#=by# : gz#=bz#
else
gx#=gx#/count# : gy#=gy#/count# : gz#=gz#/count#
endif

newx#=bx#+((gx#-bx#)*smooth#) : newy#=by#+((gy#-by#)*smooth#) : newz#=bz#+((gz#-bz#)*smooth#)
poxeldisplace#(x,y,z,0)=(newx#-(x*xsize#))/xsize# : poxeldisplace#(x,y,z,1)=(newy#-(y*ysize#))/ysize# : poxeldisplace#(x,y,z,2)=(newz#-(z*zsize#))/zsize#

if abs(poxeldisplace#(x,y,z,0))>0.50 then poxeldisplace#(x,y,z,0)=poxeldisplace#(x,y,z,0)/(abs(poxeldisplace#(x,y,z,0))/0.500)
if abs(poxeldisplace#(x,y,z,1))>0.50 then poxeldisplace#(x,y,z,1)=poxeldisplace#(x,y,z,1)/(abs(poxeldisplace#(x,y,z,1))/0.500)
if abs(poxeldisplace#(x,y,z,2))>0.50 then poxeldisplace#(x,y,z,2)=poxeldisplace#(x,y,z,2)/(abs(poxeldisplace#(x,y,z,2))/0.500)

undim done(27)
endif
next v
next p

undim smoothed(worldsizex,worldsizey,worldsizez)

next s








make memblock 1,12+(poly*3*36)
write memblock dword 1,0,338
write memblock dword 1,4,36
write memblock dword 1,8,poly*3

for p=1 to poly
for v=0 to 2
pv1=polys(p,0+(v*3)) : pv2=polys(p,1+(v*3)) : pv3=polys(p,2+(v*3))
write memblock float 1,12+(v*36)+((p-1)*108),(pv1+poxeldisplace#(pv1,pv2,pv3,0))*xsize#
write memblock float 1,16+(v*36)+((p-1)*108),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*ysize#
write memblock float 1,20+(v*36)+((p-1)*108),(pv3+poxeldisplace#(pv1,pv2,pv3,2))*zsize#
write memblock float 1,24+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)
write memblock float 1,28+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)
write memblock float 1,32+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)
if abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,0)) and abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,2))
color=rgb((pv2+poxeldisplace#(pv1,pv2,pv3,1))*8,255,(pv2+poxeldisplace#(pv1,pv2,pv3,1))*8) : poxelcolor(pv1,pv2,pv3)=1
else
color=rgb(120+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*6),100+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*5),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*4)
endif
write memblock dword 1,36+(v*36)+((p-1)*108),color
if abs(polynormal#(p,1))>=abs(polynormal#(p,0)) and abs(polynormal#(p,1))>=abs(polynormal#(p,2)) then U#=polys(p,9+(v*3))/1000.0 : V#=polys(p,11+(v*3))/1000.0
if abs(polynormal#(p,2))>=abs(polynormal#(p,0)) and abs(polynormal#(p,2))>abs(polynormal#(p,1)) then U#=polys(p,9+(v*3))/1000.0 : V#=polys(p,10+(v*3))/1000.0
if abs(polynormal#(p,0))>abs(polynormal#(p,1)) and abs(polynormal#(p,0))>abs(polynormal#(p,2)) then U#=polys(p,11+(v*3))/1000.0 : V#=polys(p,10+(v*3))/1000.0
write memblock float 1,40+(v*36)+((p-1)*108),U#
write memblock float 1,44+(v*36)+((p-1)*108),V#
next v
next p

rem undim poxelnormal#(worldsizex,worldsizey,worldsizez,2)

make mesh from memblock 10,1
if object exist(10)=1 then delete object 10
make object 10,10,1


endfunction













rem REBUILD MESH
rebuild:

newpoly=0


for x=bx to ex-1
for y=by to ey-1
for z=bz to ez-1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
newpoly=newpoly+(poxeldata(blocktype,0))
next z
next y
next x

x=bx : y=by : z=bz : q=1
rem find next
lastone=0
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
repeat
if q>poxeldata(blocktype,0) then x=x+1 : q=1
if x=ex then y=y+1 : x=bx
if y=ey then z=z+1 : y=by
if z=ez then lastone=1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
until q<=poxeldata(blocktype,0) or lastone=1



rem ADDITION

addpolys=newpoly
backpoly=poly+1

for p=1 to poly
if polys(p,18)>=bx and polys(p,18)<=ex-1 and polys(p,19)>=by and polys(p,19)<=ey-1 and polys(p,20)>=bz and polys(p,20)<=ez-1
if addpolys<=0

addpolys=addpolys-1
repeat
backpoly=backpoly-1
until polys(backpoly,18)<bx or polys(backpoly,18)>ex-1 or polys(backpoly,19)<by or polys(backpoly,19)>ey-1 or polys(backpoly,20)<bz or polys(backpoly,20)>ez-1
if backpoly>0
copy memblock 101,101,12+((backpoly-1)*108),12+((p-1)*108),108
polynormal#(p,0)=polynormal#(backpoly,0) : polynormal#(p,1)=polynormal#(backpoly,1) : polynormal#(p,2)=polynormal#(backpoly,2)
endif
copypolys(p,0)=-100

else
addpolys=addpolys-1

rem fill in
copypolys(p,0)=x+conv(poxeldata(blocktype,1+((q-1)*3)),0) : copypolys(p,1)=y+conv(poxeldata(blocktype,1+((q-1)*3)),1) : copypolys(p,2)=z+conv(poxeldata(blocktype,1+((q-1)*3)),2) : copypolys(p,9)=(((conv(poxeldata(blocktype,1+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : copypolys(p,10)=(((conv(poxeldata(blocktype,1+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : copypolys(p,11)=(((conv(poxeldata(blocktype,1+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
copypolys(p,3)=x+conv(poxeldata(blocktype,2+((q-1)*3)),0) : copypolys(p,4)=y+conv(poxeldata(blocktype,2+((q-1)*3)),1) : copypolys(p,5)=z+conv(poxeldata(blocktype,2+((q-1)*3)),2) : copypolys(p,12)=(((conv(poxeldata(blocktype,2+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : copypolys(p,13)=(((conv(poxeldata(blocktype,2+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : copypolys(p,14)=(((conv(poxeldata(blocktype,2+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
copypolys(p,6)=x+conv(poxeldata(blocktype,3+((q-1)*3)),0) : copypolys(p,7)=y+conv(poxeldata(blocktype,3+((q-1)*3)),1) : copypolys(p,8)=z+conv(poxeldata(blocktype,3+((q-1)*3)),2) : copypolys(p,15)=(((conv(poxeldata(blocktype,3+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : copypolys(p,16)=(((conv(poxeldata(blocktype,3+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : copypolys(p,17)=(((conv(poxeldata(blocktype,3+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
copypolys(p,18)=x : copypolys(p,19)=y : copypolys(p,20)=z : q=q+1
poxelpoly(copypolys(p,0),copypolys(p,1),copypolys(p,2))=1 : poxelpoly(copypolys(p,3),copypolys(p,4),copypolys(p,5))=1 : poxelpoly(copypolys(p,6),copypolys(p,7),copypolys(p,8))=1
rem get new
if q>poxeldata(blocktype,0)
lastone=0
repeat
if q>poxeldata(blocktype,0) then x=x+1 : q=1
if x=ex then y=y+1 : x=bx
if y=ey then z=z+1 : y=by
if z=ez then lastone=1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
until q<=poxeldata(blocktype,0) or lastone=1
endif

rem normals
v1x#=copypolys(p,0)+poxeldisplace#(copypolys(p,0),copypolys(p,1),copypolys(p,2),0) : v1y#=copypolys(p,1)+poxeldisplace#(copypolys(p,0),copypolys(p,1),copypolys(p,2),1) : v1z#=copypolys(p,2)+poxeldisplace#(copypolys(p,0),copypolys(p,1),copypolys(p,2),2)
v2x#=copypolys(p,3)+poxeldisplace#(copypolys(p,3),copypolys(p,4),copypolys(p,5),0) : v2y#=copypolys(p,4)+poxeldisplace#(copypolys(p,3),copypolys(p,4),copypolys(p,5),1) : v2z#=copypolys(p,5)+poxeldisplace#(copypolys(p,3),copypolys(p,4),copypolys(p,5),2)
v3x#=copypolys(p,6)+poxeldisplace#(copypolys(p,6),copypolys(p,7),copypolys(p,8),0) : v3y#=copypolys(p,7)+poxeldisplace#(copypolys(p,6),copypolys(p,7),copypolys(p,8),1) : v3z#=copypolys(p,8)+poxeldisplace#(copypolys(p,6),copypolys(p,7),copypolys(p,8),2)

nx2#=((v2y#-v1y#)*(v3z#-v1z#))-((v2z#-v1z#)*(v3y#-v1y#))
ny2#=((v2z#-v1z#)*(v3x#-v1x#))-((v2x#-v1x#)*(v3z#-v1z#))
nz2#=((v2x#-v1x#)*(v3y#-v1y#))-((v2y#-v1y#)*(v3x#-v1x#))
l#=sqrt((nx2#*nx2#)+(ny2#*ny2#)+(nz2#*nz2#))
nx2#=nx2#/l# : ny2#=ny2#/l# : nz2#=nz2#/l#
polynormal#(p,0)=nx2# : polynormal#(p,1)=ny2# : polynormal#(p,2)=nz2#

explcolor=0
if poxelexpl(copypolys(p,0),copypolys(p,1),copypolys(p,2))=1 and poxelexpl(copypolys(p,3),copypolys(p,4),copypolys(p,5))=1 and poxelexpl(copypolys(p,6),copypolys(p,7),copypolys(p,8))=1 then explcolor=1

for v=0 to 2
pv1=copypolys(p,0+(v*3)) : pv2=copypolys(p,1+(v*3)) : pv3=copypolys(p,2+(v*3))
write memblock float 101,12+(v*36)+((p-1)*108),(pv1+poxeldisplace#(pv1,pv2,pv3,0))*xsize#
write memblock float 101,16+(v*36)+((p-1)*108),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*ysize#
write memblock float 101,20+(v*36)+((p-1)*108),(pv3+poxeldisplace#(pv1,pv2,pv3,2))*zsize#
write memblock float 101,24+(v*36)+((p-1)*108),poxelnormal#(copypolys(p,0+(v*3)),copypolys(p,1+(v*3)),copypolys(p,2+(v*3)),0)
write memblock float 101,28+(v*36)+((p-1)*108),poxelnormal#(copypolys(p,0+(v*3)),copypolys(p,1+(v*3)),copypolys(p,2+(v*3)),1)
write memblock float 101,32+(v*36)+((p-1)*108),poxelnormal#(copypolys(p,0+(v*3)),copypolys(p,1+(v*3)),copypolys(p,2+(v*3)),2)
if abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,0)) and abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,2))
color=rgb((pv2+poxeldisplace#(pv1,pv2,pv3,1))*8,255,(pv2+poxeldisplace#(pv1,pv2,pv3,1))*8)
else
color=rgb(120+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*6),100+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*5),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*4)
endif
if poxelexpl(pv1,pv2,pv3)=1 or poxelcolor(pv1,pv2,pv3)=0 then color=rgb(120+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*6),100+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*5),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*4)
write memblock dword 101,36+(v*36)+((p-1)*108),color
if abs(polynormal#(p,1))>=abs(polynormal#(p,0)) and abs(polynormal#(p,1))>=abs(polynormal#(p,2)) then U#=copypolys(p,9+(v*3))/1000.0 : V#=copypolys(p,11+(v*3))/1000.0
if abs(polynormal#(p,2))>=abs(polynormal#(p,0)) and abs(polynormal#(p,2))>abs(polynormal#(p,1)) then U#=copypolys(p,9+(v*3))/1000.0 : V#=copypolys(p,10+(v*3))/1000.0
if abs(polynormal#(p,0))>abs(polynormal#(p,1)) and abs(polynormal#(p,0))>abs(polynormal#(p,2)) then U#=copypolys(p,11+(v*3))/1000.0 : V#=copypolys(p,10+(v*3))/1000.0
write memblock float 101,40+(v*36)+((p-1)*108),U#
write memblock float 101,44+(v*36)+((p-1)*108),V#
next v

endif
endif
next p

return












rem REBUILD MESH

rebuild2:


rem CREATION/REMOVAL


newp=poly+addpolys
dim polys(newp,20)
delete memblock 1
make memblock 1,12+(newp*108)

if addpolys<=0
copy memblock 101,1,0,0,12+(newp*108)
write memblock dword 1,8,newp*3
backpoly=poly+1
for p=1 to newp
if copypolys(p,0)=-100
repeat
backpoly=backpoly-1
until copypolys(backpoly,0)<>-100
for n=0 to 20
polys(p,n)=copypolys(backpoly,n)
next n
else
for n=0 to 20
polys(p,n)=copypolys(p,n)
next n
endif
next p

else
copy memblock 101,1,0,0,12+(poly*108)
write memblock dword 1,8,newp*3
for p=1 to poly
for n=0 to 20
polys(p,n)=copypolys(p,n)
next n
next p

for p=poly+1 to newp

polys(p,0)=x+conv(poxeldata(blocktype,1+((q-1)*3)),0) : polys(p,1)=y+conv(poxeldata(blocktype,1+((q-1)*3)),1) : polys(p,2)=z+conv(poxeldata(blocktype,1+((q-1)*3)),2) : polys(p,9)=(((conv(poxeldata(blocktype,1+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : polys(p,10)=(((conv(poxeldata(blocktype,1+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : polys(p,11)=(((conv(poxeldata(blocktype,1+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
polys(p,3)=x+conv(poxeldata(blocktype,2+((q-1)*3)),0) : polys(p,4)=y+conv(poxeldata(blocktype,2+((q-1)*3)),1) : polys(p,5)=z+conv(poxeldata(blocktype,2+((q-1)*3)),2) : polys(p,12)=(((conv(poxeldata(blocktype,2+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : polys(p,13)=(((conv(poxeldata(blocktype,2+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : polys(p,14)=(((conv(poxeldata(blocktype,2+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
polys(p,6)=x+conv(poxeldata(blocktype,3+((q-1)*3)),0) : polys(p,7)=y+conv(poxeldata(blocktype,3+((q-1)*3)),1) : polys(p,8)=z+conv(poxeldata(blocktype,3+((q-1)*3)),2) : polys(p,15)=(((conv(poxeldata(blocktype,3+((q-1)*3)),0)-0.00)/Utile#)+((x-0.00)/Utile#)-int((x-0.00)/Utile#))*1000.00 : polys(p,16)=(((conv(poxeldata(blocktype,3+((q-1)*3)),1)-0.00)/Vtile#)+((y-0.00)/Vtile#)-int((y-0.00)/Vtile#))*1000.00 : polys(p,17)=(((conv(poxeldata(blocktype,3+((q-1)*3)),2)-0.00)/Wtile#)+((z-0.00)/Wtile#)-int((z-0.00)/Wtile#))*1000.00
polys(p,18)=x : polys(p,19)=y : polys(p,20)=z : q=q+1
poxelpoly(polys(p,0),polys(p,1),polys(p,2))=1 : poxelpoly(polys(p,3),polys(p,4),polys(p,5))=1 : poxelpoly(polys(p,6),polys(p,7),polys(p,8))=1
rem get new
if q>poxeldata(blocktype,0)
lastone=0
repeat
if q>poxeldata(blocktype,0) then x=x+1 : q=1
if x=ex then y=y+1 : x=bx
if y=ey then z=z+1 : y=by
if z=ez then lastone=1
blocktype=(poxels(x,y,z)*1)+(poxels(x+1,y,z)*2)+(poxels(x,y+1,z)*4)+(poxels(x+1,y+1,z)*8)+(poxels(x,y,z+1)*16)+(poxels(x+1,y,z+1)*32)+(poxels(x,y+1,z+1)*64)+(poxels(x+1,y+1,z+1)*128)
until q<=poxeldata(blocktype,0) or lastone=1
endif

v1x#=polys(p,0)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),0) : v1y#=polys(p,1)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),1) : v1z#=polys(p,2)+poxeldisplace#(polys(p,0),polys(p,1),polys(p,2),2)
v2x#=polys(p,3)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),0) : v2y#=polys(p,4)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),1) : v2z#=polys(p,5)+poxeldisplace#(polys(p,3),polys(p,4),polys(p,5),2)
v3x#=polys(p,6)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),0) : v3y#=polys(p,7)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),1) : v3z#=polys(p,8)+poxeldisplace#(polys(p,6),polys(p,7),polys(p,8),2)
nx2#=((v2y#-v1y#)*(v3z#-v1z#))-((v2z#-v1z#)*(v3y#-v1y#))
ny2#=((v2z#-v1z#)*(v3x#-v1x#))-((v2x#-v1x#)*(v3z#-v1z#))
nz2#=((v2x#-v1x#)*(v3y#-v1y#))-((v2y#-v1y#)*(v3x#-v1x#))
l#=sqrt((nx2#*nx2#)+(ny2#*ny2#)+(nz2#*nz2#))
nx2#=nx2#/l# : ny2#=ny2#/l# : nz2#=nz2#/l#
polynormal#(p,0)=nx2# : polynormal#(p,1)=ny2# : polynormal#(p,2)=nz2#

explcolor=0
if poxelexpl(polys(p,0),polys(p,1),polys(p,2))=1 and poxelexpl(polys(p,3),polys(p,4),polys(p,5))=1 and poxelexpl(polys(p,6),polys(p,7),polys(p,8))=1 then explcolor=1

for v=0 to 2
pv1=polys(p,0+(v*3)) : pv2=polys(p,1+(v*3)) : pv3=polys(p,2+(v*3))
write memblock float 1,12+(v*36)+((p-1)*108),(pv1+poxeldisplace#(pv1,pv2,pv3,0))*xsize#
write memblock float 1,16+(v*36)+((p-1)*108),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*ysize#
write memblock float 1,20+(v*36)+((p-1)*108),(pv3+poxeldisplace#(pv1,pv2,pv3,2))*zsize#
write memblock float 1,24+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)
write memblock float 1,28+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)
write memblock float 1,32+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)
if abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,0)) and abs(poxelnormal#(pv1,pv2,pv3,1))>abs(poxelnormal#(pv1,pv2,pv3,2))
color=rgb((pv2+poxeldisplace#(pv1,pv2,pv3,1))*8,255,(pv2+poxeldisplace#(pv1,pv2,pv3,1))*8)
else
color=rgb(120+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*6),100+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*5),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*4)
endif
if poxelexpl(pv1,pv2,pv3)=1 or poxelcolor(pv1,pv2,pv3)=0 then color=rgb(120+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*6),100+((pv2+poxeldisplace#(pv1,pv2,pv3,1))*5),(pv2+poxeldisplace#(pv1,pv2,pv3,1))*4)
write memblock dword 1,36+(v*36)+((p-1)*108),color
if abs(polynormal#(p,1))>=abs(polynormal#(p,0)) and abs(polynormal#(p,1))>=abs(polynormal#(p,2)) then U#=polys(p,9+(v*3))/1000.0 : V#=polys(p,11+(v*3))/1000.0
if abs(polynormal#(p,2))>=abs(polynormal#(p,0)) and abs(polynormal#(p,2))>abs(polynormal#(p,1)) then U#=polys(p,9+(v*3))/1000.0 : V#=polys(p,10+(v*3))/1000.0
if abs(polynormal#(p,0))>abs(polynormal#(p,1)) and abs(polynormal#(p,0))>abs(polynormal#(p,2)) then U#=polys(p,11+(v*3))/1000.0 : V#=polys(p,10+(v*3))/1000.0
write memblock float 1,40+(v*36)+((p-1)*108),U#
write memblock float 1,44+(v*36)+((p-1)*108),V#
next v

next p

endif

poly=newp

global dim poxelnormal#(worldsizex,worldsizey,worldsizez,2)

for p=1 to poly
nx2#=polynormal#(p,0) : ny2#=polynormal#(p,1) : nz2#=polynormal#(p,2)
for v=0 to 2
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)+nx2#
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)+ny2#
poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)=poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)+nz2#
next v
next p

for p=1 to poly
for v=0 to 2
write memblock float 1,24+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),0)
write memblock float 1,28+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),1)
write memblock float 1,32+(v*36)+((p-1)*108),poxelnormal#(polys(p,0+(v*3)),polys(p,1+(v*3)),polys(p,2+(v*3)),2)
next v
next p


return









rem CHANGE IT

changeit:
make mesh from memblock 10,1
if object exist(10)=1 then delete object 10
make object 10,10,1
return










function hole(radius#,centerx#,centery#,centerz#)

bigsize#=xsize#
if ysize#>bigsize# then bigsize#=ysize#
if zsize#>bigsize# then bigsize#=zsize#
rad#=radius#*radius# : rad2#=(radius#-bigsize#)*(radius#-bigsize#) : rad3#=(radius#+bigsize#)*(radius#+bigsize#)

for x=int((centerx#-radius#)/xsize#)-1 to int((centerx#+radius#)/xsize#)+2
for y=int((centery#-radius#)/ysize#)-1 to int((centery#+radius#)/ysize#)+2
for z=int((centerz#-radius#)/zsize#)-1 to int((centerz#+radius#)/zsize#)+2
changed=0
if x>=0 and x<=worldsizex and y>=0 and y<=worldsizey and z>=0 and z<=worldsizez
x#=x*xsize# : y#=y*ysize# : z#=z*zsize#
rem x2#=x#+poxeldisplace#(x,y,z,0) : y2#=y#+poxeldisplace#(x,y,z,1) : z2#=z#+poxeldisplace#(x,y,z,2)
dist#=((x#-centerx#)*(x#-centerx#))+((y#-centery#)*(y#-centery#))+((z#-centerz#)*(z#-centerz#))
part1#=rad#/dist#
if part1#>1.00 and poxels(x,y,z)=1 then poxels(x,y,z)=0 : changed=1
if dist#=0 then poxels(x,y,z)=0

if dist#>rad2# and dist#<rad3#
part#=radius#/sqrt(dist#)
newx#=centerx#+((x#-centerx#)*part#) : newy#=centery#+((y#-centery#)*part#) : newz#=centerz#+((z#-centerz#)*part#)
if abs(newx#-x#)<=0.50*xsize# and abs(newy#-y#)<=0.50*ysize# and abs(newz#-z#)<=0.50*zsize#
if newx#-x#=-0.50*xsize# or newy#-y#=-0.50*ysize# or newz#-z#=-0.50*zsize# then poxels(x,y,z)=0
if poxelpoly(x,y,z)=0 then poxeldisplace#(x,y,z,0)=(newx#-x#)/xsize# : poxeldisplace#(x,y,z,1)=(newy#-y#)/ysize# : poxeldisplace#(x,y,z,2)=(newz#-z#)/zsize#
if poxelpoly(x,y,z)=1 then poxeldisplace#(x,y,z,0)=0.50*(poxeldisplace#(x,y,z,0)+((newx#-x#)/xsize#)) : poxeldisplace#(x,y,z,1)=0.50*(poxeldisplace#(x,y,z,1)+((newy#-y#)/ysize#)) : poxeldisplace#(x,y,z,2)=0.50*(poxeldisplace#(x,y,z,2)+((newz#-z#)/zsize#))
poxelexpl(x,y,z)=1
if changed=1 then poxels(x,y,z)=1
if poxelpoly(x,y,z)=0 then poxelnormal#(x,y,z,0)=centerx#-newx# : poxelnormal#(x,y,z,1)=centery#-newy# : poxelnormal#(x,y,z,2)=centerz#-newz#
if poxelpoly(x,y,z)=1 then poxelnormal#(x,y,z,0)=0.50*(((centerx#-newx#)/radius#)+poxelnormal#(x,y,z,0)) : poxelnormal#(x,y,z,1)=0.50*(((centery#-newy#)/radius#)+poxelnormal#(x,y,z,1)) : poxelnormal#(x,y,z,2)=0.50*(((centerz#-newz#)/radius#)+poxelnormal#(x,y,z,2))
endif
endif

endif
next z
next y
next x

rem second check
for x=int((centerx#-radius#)/xsize#)-1 to int((centerx#+radius#)/xsize#)+1
for y=int((centery#-radius#)/ysize#)-1 to int((centery#+radius#)/ysize#)+1
for z=int((centerz#-radius#)/zsize#)-1 to int((centerz#+radius#)/zsize#)+1
if poxelexpl(x,y,z)=1
for p=0 to 1
for q=0 to 1
for r=0 to 1
x2=x+p : y2=y+q : z2=z+r
if poxels(x2-1,y2-1,z2-1)+poxels(x2,y2-1,z2-1)+poxels(x2-1,y2,z2-1)+poxels(x2,y2,z2-1)+poxels(x2-1,y2-1,z2)+poxels(x2,y2-1,z2)+poxels(x2-1,y2,z2)+poxels(x2,y2,z2)>=3
p2=(p*2)-1 : q2=(q*2)-1 : r2=(r*2)-1
if poxels(x+p2,y,z)=0 and poxels(x,y+q2,z)=0 and poxels(x,y,z+r2)=0 then poxels(x,y,z)=0 : r=1 : q=1 : p=1
endif
next r
next q
next p
endif
if poxels(x+1,y,z)+poxels(x-1,y,z)+poxels(x,y+1,z)+poxels(x,y-1,z)+poxels(x,y,z+1)+poxels(x,y,z-1)<3 then poxels(x,y,z)=0
next z
next y
next x

endfunction












function copyarray()
global dim copypolys(poly,20)
for p=1 to poly
for n=0 to 20
copypolys(p,n)=polys(p,n)
next n
next p
if memblock exist(101)=1 then delete memblock 101
rem make memblock from mesh 101,10
make memblock 101,get memblock size(1) : copy memblock 1,101,0,0,get memblock size(1)
endfunction












rem Poly Collision
linecol:

col=0
count=0

if abs(nz#)>=abs(nx#) and abs(nz#)>=abs(ny#)
if iy#>v1y# and iy#<v2y# or iy#<v1y# and iy#>v2y#
if (((iy#-v1y#)/(v2y#-v1y#))*(v2x#-v1x#))+v1x#<ix# then count=count+1
endif
if iy#>v3y# and iy#<v2y# or iy#<v3y# and iy#>v2y#
if (((iy#-v3y#)/(v2y#-v3y#))*(v2x#-v3x#))+v3x#<ix# then count=count+1
endif
if iy#>v1y# and iy#<v3y# or iy#<v1y# and iy#>v3y#
if (((iy#-v1y#)/(v3y#-v1y#))*(v3x#-v1x#))+v1x#<ix# then count=count+1
endif
endif

if abs(ny#)>=abs(nx#) and abs(ny#)>abs(nz#)
if iz#>v1z# and iz#<v2z# or iz#<v1z# and iz#>v2z#
if (((iz#-v1z#)/(v2z#-v1z#))*(v2x#-v1x#))+v1x#<ix# then count=count+1
endif
if iz#>v3z# and iz#<v2z# or iz#<v3z# and iz#>v2z#
if (((iz#-v3z#)/(v2z#-v3z#))*(v2x#-v3x#))+v3x#<ix# then count=count+1
endif
if iz#>v1z# and iz#<v3z# or iz#<v1z# and iz#>v3z#
if (((iz#-v1z#)/(v3z#-v1z#))*(v3x#-v1x#))+v1x#<ix# then count=count+1
endif
endif

if abs(nx#)>abs(ny#) and abs(nx#)>abs(nz#)
if iy#>v1y# and iy#<v2y# or iy#<v1y# and iy#>v2y#
if (((iy#-v1y#)/(v2y#-v1y#))*(v2z#-v1z#))+v1z#<iz# then count=count+1
endif
if iy#>v3y# and iy#<v2y# or iy#<v3y# and iy#>v2y#
if (((iy#-v3y#)/(v2y#-v3y#))*(v2z#-v3z#))+v3z#<iz# then count=count+1
endif
if iy#>v1y# and iy#<v3y# or iy#<v1y# and iy#>v3y#
if (((iy#-v1y#)/(v3y#-v1y#))*(v3z#-v1z#))+v1z#<iz# then count=count+1
endif
endif

count#=count
if count#/2.0<>int(count#/2.0) then col=1

return







rem Vertex Collision
distcol:


distv1#=((cx#-v1x#)*(cx#-v1x#))+((cy#-v1y#)*(cy#-v1y#)/(radparty#*radparty#))+((cz#-v1z#)*(cz#-v1z#)/(radpartz#*radpartz#))
if distv1#<radius2#
col=1
part#=radiusx#/sqrt(distv1#)
newx#=v1x#+((cx#-v1x#)*part#) : newy#=v1y#+((cy#-v1y#)*part#) : newz#=v1z#+((cz#-v1z#)*part#)
return
endif
distv2#=((cx#-v2x#)*(cx#-v2x#))+((cy#-v2y#)*(cy#-v2y#)/(radparty#*radparty#))+((cz#-v2z#)*(cz#-v2z#)/(radpartz#*radpartz#))
if distv2#<radius2#
col=1
part#=radiusx#/sqrt(distv2#)
newx#=v2x#+((cx#-v2x#)*part#) : newy#=v2y#+((cy#-v2y#)*part#) : newz#=v2z#+((cz#-v2z#)*part#)
return
endif
distv3#=((cx#-v3x#)*(cx#-v3x#))+((cy#-v3y#)*(cy#-v3y#)/(radparty#*radparty#))+((cz#-v3z#)*(cz#-v3z#)/(radpartz#*radpartz#))
if distv3#<radius2#
col=1
part#=radiusx#/sqrt(distv3#)
newx#=v3x#+((cx#-v3x#)*part#) : newy#=v3y#+((cy#-v3y#)*part#) : newz#=v3z#+((cz#-v3z#)*part#)
return
endif

return








rem Edge Collision
edgecol:

u1#=(((cx#-v1x#)*(v2x#-v1x#))+((cy#-v1y#)*(v2y#-v1y#)/(radparty#*radparty#))+((cz#-v1z#)*(v2z#-v1z#)/(radpartz#*radpartz#)))/(((v2x#-v1x#)*(v2x#-v1x#))+((v2y#-v1y#)*(v2y#-v1y#)/(radparty#*radparty#))+((v2z#-v1z#)*(v2z#-v1z#)/(radpartz#*radpartz#)))
uq1#=(((cx#-v1x#)*(v2x#-v1x#))+((cy#-v1y#)*(v2y#-v1y#))+((cz#-v1z#)*(v2z#-v1z#)))/(((v2x#-v1x#)*(v2x#-v1x#))+((v2y#-v1y#)*(v2y#-v1y#))+((v2z#-v1z#)*(v2z#-v1z#)))

if u1#>=0.00 and u1#<=1.00
p1x#=v1x#+(u1#*(v2x#-v1x#)) : p1y#=v1y#+(u1#*(v2y#-v1y#)) : p1z#=v1z#+(u1#*(v2z#-v1z#))
pq1x#=v1x#+(uq1#*(v2x#-v1x#)) : pq1y#=v1y#+(uq1#*(v2y#-v1y#)) : pq1z#=v1z#+(uq1#*(v2z#-v1z#))
distl1#=((cx#-p1x#)*(cx#-p1x#))+((cy#-p1y#)*(cy#-p1y#)/(radparty#*radparty#))+((cz#-p1z#)*(cz#-p1z#)/(radpartz#*radpartz#))
if distl1#<radius2#
part#=radiusx#/sqrt(distl1#)
newx#=pq1x#+((cx#-pq1x#)*part#) : newy#=pq1y#+((cy#-pq1y#)*part#) : newz#=pq1z#+((cz#-pq1z#)*part#)
col=1
return
endif
endif

u2#=(((cx#-v1x#)*(v3x#-v1x#))+((cy#-v1y#)*(v3y#-v1y#)/(radparty#*radparty#))+((cz#-v1z#)*(v3z#-v1z#)/(radpartz#*radpartz#)))/(((v3x#-v1x#)*(v3x#-v1x#))+((v3y#-v1y#)*(v3y#-v1y#)/(radparty#*radparty#))+((v3z#-v1z#)*(v3z#-v1z#)/(radpartz#*radpartz#)))
uq2#=(((cx#-v1x#)*(v3x#-v1x#))+((cy#-v1y#)*(v3y#-v1y#))+((cz#-v1z#)*(v3z#-v1z#)))/(((v3x#-v1x#)*(v3x#-v1x#))+((v3y#-v1y#)*(v3y#-v1y#))+((v3z#-v1z#)*(v3z#-v1z#)))

if u2#>=0.00 and u2#<=1.00
p1x#=v1x#+(u2#*(v3x#-v1x#)) : p1y#=v1y#+(u2#*(v3y#-v1y#)) : p1z#=v1z#+(u2#*(v3z#-v1z#))
pq1x#=v1x#+(uq2#*(v3x#-v1x#)) : pq1y#=v1y#+(uq2#*(v3y#-v1y#)) : pq1z#=v1z#+(uq2#*(v3z#-v1z#))
distl1#=((cx#-p1x#)*(cx#-p1x#))+((cy#-p1y#)*(cy#-p1y#)/(radparty#*radparty#))+((cz#-p1z#)*(cz#-p1z#)/(radpartz#*radpartz#))
if distl1#<radius2#
part#=radiusx#/sqrt(distl1#)
newx#=pq1x#+((cx#-pq1x#)*part#) : newy#=pq1y#+((cy#-pq1y#)*part#) : newz#=pq1z#+((cz#-pq1z#)*part#)
col=1
return
endif
endif

u3#=(((cx#-v2x#)*(v3x#-v2x#))+((cy#-v2y#)*(v3y#-v2y#)/(radparty#*radparty#))+((cz#-v2z#)*(v3z#-v2z#)/(radpartz#*radpartz#)))/(((v3x#-v2x#)*(v3x#-v2x#))+((v3y#-v2y#)*(v3y#-v2y#)/(radparty#*radparty#))+((v3z#-v2z#)*(v3z#-v2z#)/(radpartz#*radpartz#)))
uq3#=(((cx#-v2x#)*(v3x#-v2x#))+((cy#-v2y#)*(v3y#-v2y#))+((cz#-v2z#)*(v3z#-v2z#)))/(((v3x#-v2x#)*(v3x#-v2x#))+((v3y#-v2y#)*(v3y#-v2y#))+((v3z#-v2z#)*(v3z#-v2z#)))

if u3#>=0.00 and u3#<=1.00
p1x#=v2x#+(u3#*(v3x#-v2x#)) : p1y#=v2y#+(u3#*(v3y#-v2y#)) : p1z#=v2z#+(u3#*(v3z#-v2z#))
pq1x#=v2x#+(uq3#*(v3x#-v2x#)) : pq1y#=v2y#+(uq3#*(v3y#-v2y#)) : pq1z#=v2z#+(uq3#*(v3z#-v2z#))
distl1#=((cx#-p1x#)*(cx#-p1x#))+((cy#-p1y#)*(cy#-p1y#)/(radparty#*radparty#))+((cz#-p1z#)*(cz#-p1z#)/(radpartz#*radpartz#))
if distl1#<radius2#
part#=radiusx#/sqrt(distl1#)
newx#=pq1x#+((cx#-pq1x#)*part#) : newy#=pq1y#+((cy#-pq1y#)*part#) : newz#=pq1z#+((cz#-pq1z#)*part#)
col=1
return
endif
endif


return










rem bullet collision
bulletcollision:

bx#=object position x(6) : by#=object position y(6) : bz#=object position z(6)
move object 6,10
ex#=object position x(6) : ey#=object position y(6) : ez#=object position z(6)

minx=int((bx#-20.0-xsize#)/xsize#) : maxx=int((bx#+20.0+xsize#)/xsize#)
miny=int((by#-20.0-ysize#)/ysize#) : maxy=int((by#+20.0+ysize#)/ysize#)
minz=int((bz#-20.0-zsize#)/zsize#) : maxz=int((bz#+20.0+zsize#)/zsize#)

col2=0

for p=1 to poly
col=0
if polys(p,18)>=minx and polys(p,18)<=maxx and polys(p,19)>=miny and polys(p,19)<=maxy and polys(p,20)>=minz and polys(p,20)<=maxz

v1x#=memblock float(1,12+((p-1)*108)) : v1y#=memblock float(1,16+((p-1)*108)) : v1z#=memblock float(1,20+((p-1)*108))
v2x#=memblock float(1,48+((p-1)*108)) : v2y#=memblock float(1,52+((p-1)*108)) : v2z#=memblock float(1,56+((p-1)*108))
v3x#=memblock float(1,84+((p-1)*108)) : v3y#=memblock float(1,88+((p-1)*108)) : v3z#=memblock float(1,92+((p-1)*108))
rem nx#=polynormal#(p,0) : ny#=polynormal#(p,1) : nz#=polynormal#(p,2)
nx#=((v2y#-v1y#)*(v3z#-v1z#))-((v2z#-v1z#)*(v3y#-v1y#))
ny#=((v2z#-v1z#)*(v3x#-v1x#))-((v2x#-v1x#)*(v3z#-v1z#))
nz#=((v2x#-v1x#)*(v3y#-v1y#))-((v2y#-v1y#)*(v3x#-v1x#))
l#=sqrt((nx#*nx#)+(ny#*ny#)+(nz#*nz#))
nx#=nx#/l# : ny#=ny#/l# : nz#=nz#/l#
D#=((v1x#*nx#)+(v1y#*ny#)+(v1z#*nz#))
u#=((nx#*bx#)+(ny#*by#)+(nz#*bz#)-D#)/((nx#*(bx#-ex#))+(ny#*(by#-ey#))+(nz#*(bz#-ez#)))

if u#>=-1.00 and u#<=1.00
   ix#=bx#+((ex#-bx#)*u#) : iy#=by#+((ey#-by#)*u#) : iz#=bz#+((ez#-bz#)*u#)
   gosub linecol
   if col=1
      centerx#=ix# : centery#=iy# : centerz#=iz# : radius#=80.0
   endif
endif

if col=1 then col2=1 : exit

endif
next p

return











function read_poxeldata()

open to read 1,"poxels.dat"

for poxel=0 to 255

read string 1,a$
poxeldata(poxel,0)=val(left$(a$,1))

for q=1 to poxeldata(poxel,0)
for v=0 to 2
place=2+v+((q-1)*3)
poxeldata(poxel,place-1)=val(mid$(a$,place))
next v
next q

next poxel


for q=1 to 8
q$=bin$(q-1)
conv(q,0)=val(mid$(q$,len(q$)))
conv(q,1)=val(mid$(q$,len(q$)-1))
conv(q,2)=val(mid$(q$,len(q$)-2))
next q

endfunction