Sorry your browser is not supported!

function Xvalue(x#,z#,ay#,L#)
zf#=(L#/2)*cos(ay#)
xf#=(L#/2)*sin(ay#)
lxzf#=sqrt(xf#^2+zf#^2)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction x2#

function Yvalue(x#,z#,ay#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
lxzf#=sqrt(xf#^2+zf#^2)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction y2#

function Zvalue(x#,z#,ay#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
lxzf#=sqrt(xf#^2+zf#^2)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction z2#

autocam off
sync on
sync rate 0
draw to front
cls
randomize timer()
set camera range 1,5050
backdrop off
set display mode 640,480,32
Dim ArbCoupe(352,4)
for i= 1 to 352
   ArbCoupe(i,1)=0
   ArbCoupe(i,2)=0
   ArbCoupe(i,3)=0
   ArbCoupe(i,4)=0
next i

make object sphere 1,10000
set object 1,1,1,0

fog on
fog color rgb(0,61,236)
fog distance 5000

create bitmap 1,257,257
ink rgb(0,62,242),0
box 0,0,256,256
ink rgb(0,0,50),0
for i=1 to 20000
   dot rnd(255),rnd(255)
next i
get image 98,0,0,256,256
texture object 1,98
delete bitmap 1

create bitmap 1,257,257
set current bitmap 1

for i=1 to 50
   ang=rnd(359)
   dist1=rnd(37)
   x=60+dist1*cos(ang)
   y=60+dist1*sin(ang)
   ink rgb(0,255,0),0
   for j=1 to 20
      circle x,y,j
   next j

   ink rgb(30,150,20),0
   for l=1 to 200
      ang=rnd(359)
      dist1=rnd(40)
      x=60+dist1*cos(ang)
      y=60+dist1*sin(ang)
      dot x,y
   next l

   ink rgb(125,77,15),0
   x2=rnd(15)+53
   y2=rnd(100)+95
   for k=1 to 12
      circle x2,y2,k
   next k
next i

get image 1,0,0,118,200
delete bitmap 1

create bitmap 1,257,257
set current bitmap 1

ink rgb(255,255,0),0
box 0,0,50,35
ink rgb(200,180,180),0
box 30,10,100,25
for i= 1 to 7
   circle 100,17,i
next i

get image 2,0,0,256,256
delete bitmap 1

create bitmap 1,256,256
ink rgb(255,25,117),0
box 50,0,90,50
box 65,50,75,60
box 40,60,100,150
box 40,100,60,200
box 80,100,100,200
box 0,70,140,90
get image 3,0,0,140,200
ink 0,0
box 80,175,100,200
get image 4,0,0,140,200
cls
paste image 3,0,0
box 40,175,60,200
get image 5,0,0,140,200
delete bitmap 1

create bitmap 1,257,257
set current bitmap 1
ink rgb(0,90,20),0
box 0,0,256,256
ink rgb(0,60,5),0
for i=1 to 20000
   dot rnd(255),rnd(255)
next i
get image 99,0,0,256,256
delete bitmap 1

make matrix 1,50000,50000,70,70
prepare matrix texture 1,99,1,1
fill matrix 1,0.0,1
randomize matrix 1,9999999
update matrix 1

dim ArbCoord(351,4)
for i=50 to 400 step 2
   grosx#=300
   make object plain i,grosx#,grosx#*1.6
   make object plain i+1,grosx#,grosx#*1.6
   set object rotation ZYX i
   set object rotation ZYX i+1
   texture object i,1
   texture object i+1,1
   set object i,1,0,0
   set object i+1,1,0,0
   ArbCoord(i-49,1)=rnd(50000)
   ArbCoord(i-49,3)=rnd(50000)
   ArbCoord(i-49,2)=(grosx#*1.6/2)+get ground height(1,ArbCoord(i-49,1),ArbCoord(i-49,3))
   position object i,ArbCoord(i-49,1),ArbCoord(i-49,2),ArbCoord(i-49,3)
   position object i+1,ArbCoord(i-49,1),ArbCoord(i-49,2),ArbCoord(i-49,3)
   yrotate object i,rnd(360)
   yrotate object i+1,wrapvalue(object angle y(i)+90)
   ArbCoord(i-49,4)=0
next i

remstart
dim ArbCarre(25,4)
dim ArbDansCarre(50,200)
ArbCarre(1,1)=0
ArbCarre(1,2)=0
ArbCarre(1,3)=10000
ArbCarre(1,4)=10000
for i=1 to 5
   for j=1 to 5
      ArbCarre((i-1)*5+j,1)=
      ArbCarre((i-1)*5+j,2)=
      ArbCarre((i-1)*5+j,3)=
      ArbCarre((i-1)*5+j,4)=
   next j
next i
remend




make object plain 402,200,286
scale object 402,60,60,60
position object 402,camera position x(),83+get ground height(1,camera position x(),camera position z() ),camera position z()
texture object 402,3
set object 402,1,0,0

x#=object position x(402)
y#=object position y(402)
z#=object position z(402)
ay#=0

frame=4
time#=timer()



do
   touch=0


   if leftkey()=1 then ay#=wrapvalue(ay#-2):touch=1
   if rightkey()=1 then ay#=wrapvalue(ay#+2):touch=1
   if upkey()=1 then x#=x#+Xvalue(x#,z#,ay#,10.0):y#=y#+Yvalue(x#,z#,ay#,10.0):z#=z#+Zvalue(x#,z#,ay#,10.0):touch=1
   if downkey()=1 then  x#=x#+Xvalue(x#,z#,wrapvalue(ay#+180),10.0):y#=y#+Yvalue(x#,z#,wrapvalue(ay#+180),10.0):z#=z#+Zvalue(x#,z#,wrapvalue(ay#+180),10.0):touch=1

   position object 1,camera position x(),0,camera position z()
   position object 402,x#,y#,z#
   yrotate object 402,ay#

   position camera x#,y#,z#:rotate camera 25,ay#,0:move camera -400


   rem set cursor 0,0
   rem print screen fps()
   rem print x#
   rem print ay#



   if touch=0 then texture object 402,3
   if timer()-time#>250 and touch=1 then time#=timer():texture object 402,frame:frame=frame+1
   if frame>5 then frame=4

   gosub Coupe
   if tombe=1 then gosub Tombe
  rem  if (Spacekey()=1) and (Transport=0) then gosub Ramasse
  rem if (Spacekey()=1) and (Transport=1) then gosub Depose

   sync
loop

rem ***********************************************************************************
function Xvalue(x#,z#,ay#,L#)
zf#=(L#/2)*cos(ay#)
xf#=(L#/2)*sin(ay#)
lxzf#=sqrt(xf#^2+zf#^2)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction x2#

function Yvalue(x#,z#,ay#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
lxzf#=sqrt(xf#^2+zf#^2)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction y2#

function Zvalue(x#,z#,ay#,L#)
zf#=l#*cos(ay#)
xf#=l#*sin(ay#)
yf#=get ground height(1,x#+xf#,z#+zf#)-get ground height(1,x#,z#)
lxzf#=sqrt(xf#^2+zf#^2)
ax#=(atan(yf#/lxzf#))
y2#=l#*sin(ax#)
lxz#=l#*cos(ax#)
x2#=lxz#*sin(ay#)
z2#=lxz#*cos(ay#)
endfunction z2#
rem ***********************************************************************************
coupe:
   for i=1 to 351 step 2
      if ((x#+(100*sin(wrapvalue(ay#+90))))>(ArbCoord(i,1)-50)) and ((x#+(100*sin(wrapvalue(ay#+90))))<(ArbCoord(i,1)+50)) and ((z#+(100*cos(wrapvalue(ay#+90))))>(ArbCoord(i,3)-50)) and ((z#+(100*cos(wrapvalue(ay#+90))))<(ArbCoord(i,3)+50))
         if (ArbCoord(i,4)=0)
            BonY#=Object position y(402)+10
            Arby#=Object position y(i+49)
            Sizey#=480
            Dif#=Arby#-Bony#
            HautArb=Sizey#/2+Dif#
            BasArb=Sizey#/2-Dif#
            Proportion#=dif#/Sizey#
            CoupeY=Proportion#*200+100
            Delete object i+49
            Delete Object i+50
            Make object Plain i+49,grosx#,BasArb
            Make object Plain i+50,grosx#,BasArb
            set object rotation ZYX i+49
            set object rotation ZYX i+50
            set object i+49,1,0,0
            set object i+50,1,0,0
            position object i+49,ArbCoord(i,1),(BasArb/2)+get ground height(1,ArbCoord(i,1),ArbCoord(i,3)),ArbCoord(i,3)
            position object i+50,ArbCoord(i,1),(BasArb/2)+get ground height(1,ArbCoord(i,1),ArbCoord(i,3)),ArbCoord(i,3)
            ArbCoord(i,2)=object position y(i+49)
            glue object to limb i+50,i+49,0
            yrotate object i+50,90
            yrotate object i+49,rnd(360)
            Create bitmap 1,257,257
            set current bitmap 1
            paste image 1,0,0
            get image 100+2*i,0,0,118,CoupeY
            get image 101+2*i,0,CoupeY,118,200
            delete bitmap 1
            set current bitmap 0
            Texture object i+49,101+2*i
            Texture object i+50,101+2*i
            Make object Plain i+405,grosx#,HautArb
            Make object Plain i+406,grosx#,HautArb
            set object rotation ZYX i+405
            set object rotation ZYX i+406
            set object i+405,1,0,0
            set object i+406,1,0,0
            position object i+405,ArbCoord(i,1),(BasArb/2)+(HautArb/2)+ArbCoord(i,2),ArbCoord(i,3)
            position object i+406,ArbCoord(i,1),(BasArb/2)+(HautArb/2)+ArbCoord(i,2),ArbCoord(i,3)
            Texture object i+405,100+2*i
            Texture object i+406,100+2*i
            yrotate object i+406,90
            glue object to limb i+406,i+405,0
            yrotate object i+405,object angle y(i+49)
            ArbCoord(i,4)=1
            ObjectTombe=i+405
            Tombe=1
            TAng=Rnd(360)
            AAcc#=1
            AAAx#=0
         endif
      endif
   next i
return
rem ****************************************************************************************************
Tombe:
AAAx#=AAAx#+1:xrotate object ObjectTombe,AAAx#
AOldX#=Object position x(ObjectTombe)
AOldY#=Object position y(ObjectTombe)
AOldZ#=Object position z(ObjectTombe)
AAx#=AOldX#+5*Sin(Object angle y(ObjectTombe))
AAz#=AOldz#+5*Cos(Object angle y(ObjectTombe))
AAy#=Aoldy#-AAcc#
AAcc#=AAcc#+0.2
if AAy#<=get ground height(1,AAx#,AAz#)+50
   Tombe=0
   xrotate object ObjectTombe,90
   ArbCoupe(ObjectTombe-405,1)=object position x(ObjectTombe)
   ArbCoupe(ObjectTombe-405,2)=object position y(ObjectTombe)
   ArbCoupe(ObjectTombe-405,3)=object position z(ObjectTombe)
endif
position object ObjectTombe,AAx#,AAy#,AAz#
return
rem ****************************************************************************************************
Ramasse:
ramasse=0
for i=1 to 351 step 2
   if (ArbCoupe(i,1)<>0) or (ArbCoupe(i,2)<>0) or (ArbCoupe(i,3)<>0) and (ArbCoupe(i,4)=0)
      if touch(i+405,25.0,100.0,x#,z#)
         Glue object to limb i+405,402,0
         xrotate object i+405,0
         yrotate object i+405,rnd(360)
         position object i+405,object position x(i+405)+75,object position y(i+405)+0.5*object size y(i+405),Object position z(i+405)
         ArbCoupe(i,4)=1
         Transport=1
      endif
   endif
next i
return
rem ****************************************************************************************************
Depose:


return
rem ****************************************************************************************************
Function touch(Obj,larg#,long#,ptx#,ptz#)
set cursor 0,0

Inter=1
ptx#=ptx#-object position x(obj)
ptz#=ptz#-object position z(obj)

TouchAY#=Object angle y(obj)
z1#=long#*cos(TouchAY#)
x1#=long#*sin(TouchAY#)
z2#=long#*cos(wrapvalue(TouchAY#+180.0))
x2#=long#*sin(wrapvalue(TouchAY#+180.0))
a1#=(z2#-z1#)/(x2#-x1#)
a2#=-1*a1#
b2#=ptx#-(ptz#*a2#)
zRencontre#=b2#/(a1#-a2#)
xRencontre#=a1#*zRencontre#
if sqrt((ptz#-zRencontre#)^2+(ptx#-xRencontre#)^2)>1000 then Inter=0
print "larg Dist=",sqrt((ptz#-zRencontre#)^2+(ptx#-xRencontre#)^2)


TouchAY#=TouchAY#+90
z1#=larg#*cos(TouchAY#)
x1#=larg#*sin(TouchAY#)
z2#=larg#*cos(wrapvalue(TouchAY#+180.0))
x2#=larg#*sin(wrapvalue(TouchAY#+180.0))
a1#=(z2#-z1#)/(x2#-x1#)
a2#=-1*a1#
b2#=ptx#-(ptz#*a2#)
zRencontre#=b2#/(a1#-a2#)
xRencontre#=a1#*zRencontre#
if sqrt((ptz#-zRencontre#)^2+(ptx#-xRencontre#)^2)>20 then Inter=0
print "long Dist=",sqrt((ptz#-zRencontre#)^2+(ptx#-xRencontre#)^2)
endfunction Inter