for DB..i have beautiful trees in my game...
without any media:
-Arrow key to move
-SpaceBar = Action (the action depend of the object that you have in your hand)
-press 0 to have nothing in your hand
-press 1 to take your ChainSaw
-press 2 to take your Pick
-S= Jump
-When you have the Pick in your hand :press SpaceBar to Plow the ground
-When you have the ChainSaw in your hand just touch with your chainSaw to the trees to cut them...(they are cut at the RIGHT PLACE ..it mean if you jump and you cut it..the tree will be cut EXACTLY where your touch it with your chainsaw)
-when you have NOTHING in your hand ...press spacebar to pick up Trees ..(when they are cutted...you should be on them)
thats it i think..for concrole..
ok now the code (just copy/paste ..there is no media)
this is made for Classic DB V1.13:
rem =========================================
rem Bucheron.DBA V2.1 =
rem Jeu de Bucheron =
rem Programmé par BrainWasher =
rem (Chiwawa on DarkBasic Forum) =
rem Programmé à partir du 8 févrié =
rem =========================================
gosub Video
rem gosub Initialisation_Intro
rem gosub Initialisation_Menu
gosub Texte_Demo_initialisation
rem gosub Intro
rem gosub Menu
gosub Loading
gosub Initialisation_Variable
Gosub Creer_Texture
Gosub Creer_Environnement
Gosub Creer_Object_Environnement
Gosub Creer_Personnage
AnimPersoTime#=Timer()
do
if lower$(inkey$())="q" then for i=50 to 400 step 2:detach object from static i+1:detach object from static i:position object i+401,object position x(i),object position y(i)+50,object position z(i):next i
if lower$(inkey$())="w" then for i=50 to 400 step 2:attach object to static i+1:attach object to static i:position object i+401,object position x(i),object position y(i)+50,object position z(i):next i
if (labour=0) and (saut=0) then Gosub Inputs
if (lower$(inkey$() )="c") and (Saut=0) and (labour=0) and (c=0) then c=1:saut=1:touch=1:Gosub Initialiser_Saut
if saut=1 then Gosub Gerer_Saut
Gosub Gerer_Perso_Move_Cam
Gosub Gerer_Perso_Anim
gosub Gerer_Poulet
if outil=1 then Gosub Coupe_Arbre
if tombe=1 then gosub Anim_Arbre
if labour<>0 then Gosub Anim_Labour
if (Spacekey()=1) and (outil=2) and (Labour=0) and (space=0) and (saut=0) then MoveLastLoop=0:space=1:Labour=1:LabourTime#=Timer()
if (Spacekey()=1) and (transport=0) and (outil=0) and (space=0) and (saut=0) then MoveLastLoop=0:space=1:gosub Ramasse_Arbre
if (Spacekey()=1) and (transport=1) and (space=0) and (saut=0) then MoveLastLoop=0:space=1:gosub Depose_Arbre
if (lower$(inkey$() )="b") and (transport=1) and (saut=0) and (labour=0) then MoveLastLoop=0:gosub Creer_Entrepot
if (inkey$()="0") and (outil<>0) and (transport=0) and (labour=0) then outil=0:frame=3
if (inkey$()="1") and (outil<>1) and (transport=0) and (labour=0) then outil=1:frame=6
if (inkey$()="2") and (outil<>2) and (transport=0) and (labour=0) then outil=2:frame=9
set cursor 0,0
print ArbEntrepose
print "FPS=",screen fps()
if UpdMatrix=1 then update matrix 1:UpdMatrix=0
sync
loop
rem ***********************************************************************************
function Xvalue(x#,z#,ay#,L#)
zf#=(L#)*cos(ay#)
xf#=(L#)*sin(ay#)
lxzf#=sqrt(xf#^2.0+zf#^2.0)
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_Arbre:
for i=1 to 351 step 2
if (sqrt((newxvalue(x#,wrapvalue(ay#+90),90)-(ArbCoord(i,1)))^2+(newzvalue(z#,wrapvalue(ay#+90),100)-(ArbCoord(i,3)))^2)<=60)
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
if (CoupeY<=50) or (CoupeY>=199) then return
Create bitmap 1,257,257
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
YAngleArbre=Object angle y(i+49)
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)
rem 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)
ArbCoord(i,1)=object position x(i+49)
ArbCoord(i,3)=object position z(i+49)
make mesh from object 2,i+50
delete object i+50
add limb i+49,1,2
Texture limb i+49,0,101+2*i
Texture limb i+49,1,101+2*i
rotate limb i+49,1,0,90,0
yrotate object i+49,YAngleArbre
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)
rem position object i+406,ArbCoord(i,1),(BasArb/2)+(HautArb/2)+ArbCoord(i,2),ArbCoord(i,3)
make mesh from object 2,i+406
delete object i+406
add limb i+405,1,2
Texture limb i+405,0,100+2*i
Texture limb i+405,1,100+2*i
rotate limb i+405,1,0,90,0
yrotate object i+405,rnd(360)
ArbCoord(i,4)=1
ObjectTombe=i+405
Tombe=1
TAng=Rnd(360)
AAcc#=1
AAAx#=0
endif
endif
next i
return
rem ****************************************************************************************************
Anim_Arbre:
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
position object ObjectTombe,AAx#,AAy#,AAz#
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_Arbre:
for i=1 to 351 step 2
if (ArbCoupe(i,1)<>0) or (ArbCoupe(i,2)<>0) or (ArbCoupe(i,3)<>0)
if (transport=0)
if sqrt((x#-(ArbCoupe(i,1)))^2+(z#-(Arbcoupe(i,3)))^2)<=200
objcoll=i+405
if (object exist(2000))
if (object position x(objColl)<object position x(2002)) and (object position x(objColl)>object position x(2002)-332)
if (object position z(objColl)<object position z(2000)) and (object position z(objColl)>object position z(2000)-386)
ArbEntrepose=ArbEntrepose-1
endif
endif
endif
Glue object to limb objColl,402,0
xrotate object objColl,0
yrotate object objColl,rnd(360)
position object objColl,object position x(objColl)-100,object position y(objColl)+0.5*object size y(objColl),Object position z(objColl)
objDepose=objcoll
Transport=1
endif
endif
endif
next i
return
rem ****************************************************************************************************
Depose_Arbre:
unglue object objDepose
position object objDepose,newxvalue(x#,wrapvalue(ay#-90),100),get ground height(1,newxvalue(x#,wrapvalue(ay#-90),100),newzvalue(z#,wrapvalue(ay#-90),100))+50,newzvalue(z#,wrapvalue(ay#-90),100)
rotate object objDepose,90,ay#,0
ArbCoupe(objDepose-405,1)=object position x(objDepose)
ArbCoupe(objDepose-405,2)=object position y(objDepose)
ArbCoupe(objDepose-405,3)=object position z(objDepose)
Transport=0
if (object exist(2000))
if (object position x(objDepose)<object position x(2002)) and (object position x(objDepose)>object position x(2002)-332)
if (object position z(objDepose)<object position z(2000)) and (object position z(objDepose)>object position z(2000)-386)
ArbEntrepose=ArbEntrepose+1
endif
endif
endif
return
rem *******************************************************************************
creer_pluie:
dim pluiex#(2000)
dim pluiey#(2000)
dim pluiez#(2000)
for i=1000 to 1500
make object plain i,1,1
set object i,1,1,0
scale object i,50,1000,50
ghost object on i
pluiex#(i)=x#+rnd(400)-rnd(400)
pluiez#(i)=z#+rnd(400)-rnd(400)
pluiey#(i)=y#+300-rnd(300)
next i
return
rem ******************************************************************************
gerer_pluie:
rem descendre la_pluie
for i=1000 to 1500
pluiey#(i)=pluiey#(i)-10
position object i,pluiex#(i),pluiey#(i),pluiez#(i)
Pldx#=object position x(i)-camera position x()
Pldz#=object position z(i)-camera position z()
Play#=wrapvalue(atanfull(Pldx#,Pldz#))
rotate object i,0,Play#,0
next i
rem recréer le goutte de pluie qui touche au sol
for i=1000 to 1500
if pluiey#(i)<get ground height(1,pluiex#(i),pluiez#(i))
pluiex#(i)=x#+rnd(400)-rnd(400)
pluiez#(i)=z#+rnd(400)-rnd(400)
pluiey#(i)=y#+300-rnd(300)
endif
next i
return
`**********************************************************************************
Video:
autocam off
sync on
sync rate 0
cls
set camera range 1,3010
backdrop off
set display mode 640,480,32
set text transparent
draw to front
hide mouse
randomize timer()
sync
return
`*************************************************************************************
Texte_Demo_initialisation:
set current bitmap 0:text 75*7,200,"G"
create bitmap 1,640,480
set text to bold
set text size 30
set text font "comic sans ms"
for i=1 to 3
restore Demo_
for j=1 to 12
read frase$
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 320,(480/14*j)+(30-i/2),frase$
set text size (30-i)
next j
blur bitmap 1,1
next i
i=4
restore demo_
for j=1 to 12
read frase$
ink rgb(255,255,255),0
center text 320,(480/14*j)+(30-i/2),frase$
set text size (30-i)
next j
blur bitmap 1,1
get image 781,0,0,640,480
delete bitmap 1
return
`*************************************************************************************
Loading:
create bitmap 1,640,480
ink rgb(255,255,255),0
rem box 100,210,540,270
for i=1 to 8
ink rgb(255-20*(9-i),255-20*(9-i),255-20*(9-i)),0
box 100+i,210+i,540-i,270-i
next i
ink 0,0
box 108,218,532,262
get image 777,0,0,640,480
delete bitmap 1
remstart
set text to bold
set text font "comic sans ms"
create bitmap 1,640,480
create bitmap 2,640,480
set text size 80
for i=1 to 4
set current bitmap 1
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 320,240-text size()/2,"~Loading~"
set current bitmap 2
center text 320,240-text size()/2,"Loading"
set text size (80-2*i)
blur bitmap 2,4
blur bitmap 1,4
next i
set current bitmap 1
get image 777,0,0,640,480
set current bitmap 2
get image 888,0,0,640,480
delete bitmap 2
delete bitmap 1
paste image 777,0,0
remend
return
`*************************************************************************************
Initialisation_Variable:
saut=0
Acc_Gravite#=3000
labour=0
Outil=0
ArbEntrepose=0
Dim ArbCoupe(352,3)
for i= 1 to 352
ArbCoupe(i,1)=0
ArbCoupe(i,2)=0
ArbCoupe(i,3)=0
next i
dim ArbCoord(351,4)
grosx#=300
ay#=0
frame=3
x#=25000
z#=25000
XPoulet#=x#
ZPoulet#=Z#
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,120,260
sync
return
`*************************************************************************************
Creer_Texture:
Rem Ciel
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
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,125,260
sync
Rem Arbres
create bitmap 1,257,257
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
blur bitmap 1,4
get image 1,0,0,118,200
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,130,260
sync
Rem Scie
create bitmap 1,257,257
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,107,50
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,140,260
sync
rem Pioche
create bitmap 1,257,257
ink rgb(255,255,0),0
box 0,0,50,35
ink rgb(134,73,0),0
box 30,10,100,25
ink rgb(200,180,180),0
box 85,10,107,50
get image 69,0,0,107,50
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,140,260
sync
rem Bonhomme tout nue
create bitmap 1,256,256
ink rgb(255,25,117),0
box 50,5,90,50
box 65,50,75,60
box 40,60,100,150
box 40,100,60,200
box 80,100,100,200
box 5,70,135,90
get image 101,0,0,210,200
blur bitmap 1,4
get image 3,0,0,210,200
cls
paste image 101,0,0
ink 0,0
box 80,175,100,200
blur bitmap 1,4
get image 4,0,0,210,200
cls
paste image 101,0,0
box 40,175,60,200
blur bitmap 1,4
get image 5,0,0,210,200
rem bonhomme scie a chaine
cls 0
paste image 101,0,0
paste image 2,100,60
get image 102,0,0,210,200
blur bitmap 1,4
get image 6,0,0,210,200
cls
paste image 102,0,0
ink 0,0
box 80,175,100,200
blur bitmap 1,4
get image 7,0,0,210,200
cls
paste image 102,0,0
box 40,175,60,200
blur bitmap 1,4
get image 8,0,0,210,200
rem bonhomme pioche
cls 0
paste image 101,0,0
paste image 69,100,60
get image 102,0,0,210,200
blur bitmap 1,4
get image 9,0,0,210,200
cls
paste image 102,0,0
ink 0,0
box 80,175,100,200
blur bitmap 1,4
get image 10,0,0,210,200
cls
paste image 102,0,0
box 40,175,60,200
blur bitmap 1,4
get image 11,0,0,210,200
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,150,260
sync
Rem Herbe
create bitmap 1,1025,1025
ink rgb(0,90,20),0
box 0,0,512,512
ink rgb(0,60,5),0
for i=1 to 20000
dot rnd(512),rnd(512)
next i
rem terre
ink rgb(110,57,0),0
box 512,0,1024,512
ink rgb(125,77,15),0
for i=1 to 20000
dot rnd(512)+512,rnd(512)
next i
get image 99,0,0,1024,1024
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,200,260
sync
linelongeur#=50
xelipse=100
yelipse=100
ink rgb(255,255,255),0
create bitmap 1,200,200
for i=1 to 720
if (i<180) then LineLongeur#=linelongeur#-0.09
if (i>=180) and (i<360) then LineLongeur#=linelongeur#+0.09
if (i>=360) and (i<540) then LineLongeur#=linelongeur#-0.09
if (i>=540) and (i<=720) then LineLongeur#=linelongeur#+0.09
line Xelipse,yelipse,Xelipse+linelongeur#*cos((i/2)+45),yelipse+linelongeur#*sin((i/2)+45)
next i
ink rgb(248,163,80),0
for i=1 to 35
ellipse 75, 75, 35-i, 20-i
next i
ink rgb(255,0,0),0
box 50,80,55,85
ink rgb(248,163,80),0
box 115,140,130,190
get image 12,0,0,200,200
delete bitmap 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,200,260
sync
return
`*************************************************************************************
Creer_Environnement:
make object sphere 1,6000
set object 1,1,1,0
texture object 1,98
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,225,260
sync
make matrix 1,50000,50000,70,70
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,240,260
sync
prepare matrix texture 1,99,2,2
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,250,260
sync
fill matrix 1,0.0,1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,260,260
sync
randomize matrix 1,9999999
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,270,260
sync
update matrix 1
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,290,260
sync
y#=get ground height(1,x#,z#)+83
YPoulet#=Y#
fog on
fog color rgb(0,61,236)
fog distance 3000
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,300,260
sync
return
`*************************************************************************************
Creer_Object_Environnement:
rem Arbres
for i=50 to 400 step 2
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
rem attach object to static i
rem attach object to static i+1
next i
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,400,260
sync
return
`*************************************************************************************
Creer_Personnage:
make object plain 402,300,286
scale object 402,60,60,60
position object 402,x#,y#,z#
texture object 402,3
set object 402,1,0,0
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,500,260
sync
make object plain 403,200,200
position object 403,x#,y#,z#
texture object 403,12
set object 403,1,0,0
yrotate object 403,90
fix object pivot 403
ink rgb(255,255,255),0
paste image 777,0,0
box 110,220,500,260
sync
return
`*************************************************************************************
Inputs:
touch=0
sens1=0
sens2=0
if (leftkey() ) or (rightkey() ) or (upkey() ) or (downkey() ) then touch=1
if MoveLastLoop=0
MoveTime2#=Timer()
else
if leftkey()=1 then ay#=wrapvalue(ay#-90.0*((Timer()-MoveTime2#)/1000.0)):sens1=-1
if rightkey()=1 then ay#=wrapvalue(ay#+90.0*((Timer()-MoveTime2#)/1000.0)):sens1=1
rem 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
rem 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
if upkey()=1 then x#=x#+Xvalue(x#,z#,ay#,(500.0*((Timer()-MoveTime2#)/1000.0))):z#=z#+Zvalue(x#,z#,ay#,(500.0*((Timer()-MoveTime2#)/1000.0))):y#=get ground height(1,x#,z#)+83.0:sens2=1
if downkey()=1 then x#=x#+Xvalue(x#,z#,wrapvalue(ay#+180.0),(500.0*((Timer()-MoveTime2#)/1000.0))):z#=z#+Zvalue(x#,z#,wrapvalue(ay#+180.0),(500.0*((Timer()-MoveTime2#)/1000.0))):y#=get ground height(1,x#,z#)+83.0:sens2=-1
MoveTime2#=Timer()
endif
if lower$(inkey$() )<>"c" then c=0
if spacekey()=0 then space=0
y#=get ground height(1,x#,z#)+83
MoveLastLoop=touch
return
`*************************************************************************************
Gerer_Perso_Move_Cam:
position object 402,x#,y#,z#
yrotate object 402,ay#
position camera x#,y#,z#:rotate camera 25,ay#,0:move camera -400
position object 1,camera position x(),0,camera position z()
return
`*************************************************************************************
Gerer_Perso_Anim:
if touch=0 then texture object 402,(outil+1)*3
if timer()-AnimPersoTime#>250 and touch=1 then AnimPersoTime#=timer():texture object 402,frame:frame=frame+1
if frame>((outil+1)*3)+2 then frame=((outil+1)*3)+1
return
`****************************************************************************************************************
Initialisation_Intro:
create bitmap 1,640,480
set current bitmap 1
set text to bold
set text size 80
set text font "comic sans ms"
set current bitmap 0
ink rgb(134,163,164),0
text 75,200,"L"
text 75*2,200,"O"
text 75*3,200,"A"
text 75*4,200,"D"
text 75*5,200,"I"
text 75*6,200,"N"
text 75*7,200,"G"
ink rgb(rnd(255),rnd(255),rnd(255)),0
set current bitmap 1
sync
for j=1 to 4
ink rgb(rnd(255),rnd(255),rnd(255)),0
center text 320,200-text size()/2,"BrainWashing"
center text 320,300-text size()/2,"Corporation"
set text size (80-2*j)
blur bitmap 1,3
next j
set current bitmap 0
set text size 80
text 75,200,"L"
set current bitmap 1
sync
get image 1,0,0,640,480
for i=1 to 40
blur bitmap 1,4
get image i,0,0,640,480
for j=1 to 10
ink rgb(rnd(255),rnd(255),rnd(255)),0
boxX=rnd(640)
boxY=rnd(480)
box boxX,boxY,boxX+3,boxY+3
next j
if i=10
set current bitmap 0
text 75*2,200,"O"
set current bitmap 1
sync
endif
if i=20
set current bitmap 0
text 75*3,200,"A"
set current bitmap 1
sync
endif
if i=30
set current bitmap 0
text 75*4,200,"D"
set current bitmap 1
sync
endif
if i=40
set current bitmap 0
text 75*5,200,"I"
set current bitmap 1
sync
endif
next i
delete bitmap 1
return
`****************************************************************************************************************
Intro:
remstart
load animation "buche.avi",1
play animation 1,0,0
while animation playing(1):sync:endwhile
delete animation 1
remend
remstart
get image 200,0,0,640,480
delete animation 1
cls
paste image 200,0,0
load dll "user32.dll",1
load dll "gdi32.dll",2
hWnd = call dll(1,"GetActiveWindow")
hDC = call dll(1,"GetWindowDC",hWnd)
set current bitmap 0
do
for i=1 to 240
for j=1 to 1800
i1#=i
j1#=j/5.0
rem set current bitmap 1
Px=320.0+(i1#*cos(j1#))
Py=240.0-(i1#*sin(j1#))
rem color=point(px,py)
color=call dll(2,"GetPixel",hDC,Px,Py)
rem set current bitmap 0
Px=320.0+(i1#*cos(wrapvalue(j1#+10.0-(i1#/300.0)*10.0)))
Py=240.0-(i1#*sin(wrapvalue(j1#+10.0-(i1#/300.0)*10.0)))
ink rgb(rgbb(color),rgbg(color),rgbr(color)),0
dot Px,Py
next j
next i
sync
loop
delete bitmap 1
remend
for i=40 to 1 step -1
paste image i,0,0
sync
sleep 50
next i
for i=2 to 40
delete image i
next i
for i=2 to 400 step 1
get image i,125+i,0,125+i+1,480
next i
create bitmap 1,640,480
for i=1 to 500 step 5
set current bitmap 1
for j=2 to 400 step 1
paste image j,125+i+j,10*sin(((125+i+j)-400)*5)
next j
copy bitmap 1,0
sync
next i
delete bitmap 1
return
`****************************************************************************************************************
Creer_Entrepot:
if object exist(2000)=0
Transport=0
unglue object objdepose
position object objdepose,0,0,0
hide object objdepose
create bitmap 1,640,480
paste image 1,0,0
get image 500,0,120,118,207
rem get image 1,0,0,118,200
delete bitmap 1
for i=2000 to 2008
make object plain i,grosx#,400
set object i,1,0,0
texture object i,500
next i
for i=1 to 8 step 3
position object 2000+i-1,X#,0,Z#+193
position object 2000+i,X#,0,Z#-166
position object 2000+i+1,X#+166,0,Z#
zrotate object 2000+i-1,90
zrotate object 2000+i,90
`set object rotation ZYX 2002
`set object rotation ZYX 2003
rotate object 2000+i+1,0,90,90
next i
for i=2000 to 2002
position object i,object position x(i),get ground height(1,x#,z#)+50,object position z(i)
position object i+3,object position x(i),get ground height(1,x#,z#)+150,object position z(i)
position object i+6,object position x(i),get ground height(1,x#,z#)+250,object position z(i)
next i
endif
return
`****************************************************************************************************************
Menu:
choix=1
set current bitmap 0
paste image 778,0,0
do
if scancode()=0 then touch=0
if (upkey()=1) and (touch=0) then choix=choix-1:touch=1
if (downkey()=1) and (touch=0) then choix=choix+1:touch=1
if returnkey()=1
if choix=1 then return
if choix=2 then END
if choix=3
set current bitmap 0
paste image 781,0,0
wait key
wait key
paste image 777+choix,0,0
endif
endif
if touch=1
if choix>3 then choix=1
if choix<1 then choix=3
paste image 777+choix,0,0
endif
sync
loop
return
`****************************************************************************************************************
Initialisation_Menu:
Lines=0
restore Menu_
read texte$
while texte$<>"|"
Lines=Lines+1
read texte$
endwhile
dim color(4)
for i=1 to 4
color(i)=rgb(100+rnd(155),100+rnd(155),100+rnd(155))
next i
for i=1 to lines
create bitmap 1,640,480
set text size 80
for k=1 to 3
restore Menu_
ink color(k),0
for j=1 to lines
read texte$
if j=i then center text 320,(100*j)+((k-1)*2),"-="+texte$+"=-":else:center text 320,(100*j)+((k-1)*2),texte$
next j
blur bitmap 1,4
set text size (80-k)
next k
restore Menu_
ink color(4),0
for j=1 to lines
read texte$
if j=i then center text 320,(100*j)+(k*2),"-="+texte$+"=-":else:center text 320,(100*j)+(k*2),texte$
next j
blur bitmap 1,4
get image 777+i,0,0,640,480
delete bitmap 1
if i=1 then set current bitmap 0:text 75*6,200,"N"
next i
return
`***************************************************************************************************************
Anim_Labour:
rem map complete 50000,50000,70,70
rem 1 carreau=50000.0/70.0
if labour=1 then zrotate object 402,wrapvalue(object angle z(402)-(90*((Timer()-LabourTime#)/1000)))
if labour=2 then zrotate object 402,wrapvalue(object angle z(402)+(90*((Timer()-LabourTime#)/1000)))
if labour=2 and (object angle z(402)<5) then labour=0
LabourTime#=Timer()
YPioche#=(125*sin(object angle z(402)))+Y#+25
lxz#=125*cos(object angle z(402))
XPioche#=(lxz#*sin(ay#+90))+X#
ZPioche#=(lxz#*cos(ay#+90))+z#
if (YPioche#<=get ground height(1,XPioche#,ZPioche#)-10) and (labour=1)
Labour=2
CarreauX=round(X#/(50000.0/70.0))
CarreauZ=round(Z#/(50000.0/70.0))
set matrix height 1, CarreauX, CarreauZ,get matrix height(1, CarreauX, CarreauZ)-50
rem set matrix height 1, CarreauX+1, CarreauZ,get matrix height(1, CarreauX+1, CarreauZ)-50
rem set matrix height 1, CarreauX, CarreauZ+1,get matrix height(1, CarreauX, CarreauZ+1)-50
rem set matrix height 1, CarreauX+1, CarreauZ+1,get matrix height(1, CarreauX+1, CarreauZ+1)-50
if get matrix height(1, CarreauX, CarreauZ)<0 then set matrix height 1, CarreauX, CarreauZ,0
rem if get matrix height(1, CarreauX+1, CarreauZ)<0 then set matrix height 1, CarreauX+1, CarreauZ,0
rem if get matrix height(1, CarreauX, CarreauZ+1)<0 then set matrix height 1, CarreauX, CarreauZ+1,0
rem if get matrix height(1, CarreauX+1, CarreauZ+1)<0 then set matrix height 1, CarreauX+1, CarreauZ+1,0
CarreauX2=int(X#/(50000.0/70.0))
CarreauZ2=int(Z#/(50000.0/70.0))
set matrix tile 1, CarreauX2, CarreauZ2, 2
UpdMatrix=1
endif
return
`***************************************************************************************************************
Initialiser_Saut:
VitessYSaut#=Acc_Gravite#/4
VitessXZSaut#=500
SautTime#=Timer()
return
`***************************************************************************************************************
Gerer_Saut:
ay#=wrapvalue(ay#+sens1*90.0*((Timer()-SautTime#)/1000.0))
y#=y#+(vitessySaut#*((Timer()-SautTime#)/1000))
x#=newxvalue(x#,ay#,(vitessxzSaut#*sens2*((Timer()-SautTime#)/1000)))
z#=newzvalue(z#,ay#,(vitessxzSaut#*sens2*((Timer()-SautTime#)/1000)))
VitessYSaut#=VitessYSaut#-(Acc_Gravite#*(Timer()-SautTime#)/1000)
sauttime#=timer()
if y#<get ground height(1,x#,z#)+83
y#=get ground height(1,x#,z#)+83
MoveLastLoop=0
saut=0
endif
return
`***************************************************************************************************************
Gerer_Poulet:
if PouletAvance=1
xpoulet#=xpoulet#+Xvalue(xpoulet#,zpoulet#,aypoulet#,(50.0*((Timer()-PouletTime#)/1000.0))):zpoulet#=zpoulet#+Zvalue(xpoulet#,zpoulet#,aypoulet#,(50.0*((Timer()-PouletTime#)/1000.0))):ypoulet#=get ground height(1,xpoulet#,zpoulet#)+80
PouletTime#=timer()
else
PouletTime#=timer()
endif
if Rnd(100)>95
Action=rnd(3)+1
if action=1 then AyPoulet#=wrapvalue(AyPoulet#+(rnd(10)+5)):yrotate object 403,aypoulet#
if action=2 then AyPoulet#=wrapvalue(AyPoulet#-(rnd(10)+5)):yrotate object 403,aypoulet#
if action=3 then PouletAvance=0
endif
if (rnd(6)=3) then PouletAvance=1
position object 403,xpoulet#,ypoulet#,zpoulet#
return
`***************************************************************************************************************
Demo_:
data "FunKy Bucherons V2.1"," ","Bienvenue dans ce petit démo","qui ne contient qu'une infime partie des functionnalitées final..."
data "Dans ce démo vous pouvez:","1-Couper les arbre en leur touchant avec la Scie à Chaine","2-Ramasser les arbres en appuyant sur la barre d'espacement"
data "3-Déposer les arbre en appuyant sur la barre d'espacement."," ","Coded by BrainWasher HTTP://BrainWashing.cjb.net"," ","~Pressez une touche pour débuter~","|"
Menu_:
data "Jouer","Quitter","Help/About","|"
`***************************************************************************************************************
function round(No#)
if (No#+0.5)>int((No#)+1) then No2#=int(No#)+1:else:No2#=int(No#)
endfunction No2#
