TGC Codebase Backup



MatriXedit by Anonymous Coder

16th Mar 2005 15:24
Summary

You can create your own matrice with object( that you can change(lumonosité,size,...)).



Description



Code
                                    ` This code was downloaded from The Game Creators
                                    ` It is reproduced here with full permission
                                    ` http://www.thegamecreators.com
                                    
                                    Rem * Title  : MatriXEdit
Rem * Author : Petit-Jean Nicolas
Rem * Date   : 31 Janvier 2005
temps_debut=timer()
remstart
backdrop on
do
text 0,0,str$(scancode())
sync
loop
remend


remstart
----------------------------------------------------------------
---------------------------MatriXEdit---------------------------
----------------------------------------2.0.--------------------
Petit-Jean
Nicolas
Merci de laisser apparaitre mon nom dans votre programme
pjnico27@hotmail.com
remend

perform checklist for graphics cards
for t=1 to checklist quantity()
print t," ",checklist string$(t)
next t
print
print "carte graphique utilisée ";current graphics card$()
print
print "Attendez SVP [***] "
print
print "Votre carte graphique est une" ; current graphics card$()

set graphics card checklist string$(1)
cls
sync on
rem font
set text font "verdana"
set text size 15
rem titre de l'application
set window title "MatriXEdit"
rem createur
text 0,0, "Creation map 3d + matrice"
text 0,30, "P-J Nicolas"
text 0,60, "2004"
text 0,90,"VERSION 3.0"
sleep 500

rem sys
cls
backdrop on
color backdrop 0
sync on
sync rate 0
rem distance cam max
set camera range 1,45000
ink rgb(255,255,255),0
rem mipmaping on lineaire
set mipmap mode 3
autocam off


rem menu
load image "new.bmp",1000
load image "sauvegarde.bmp",1001
load image "charger.bmp",1002

rem tableaux
dim elements(1001,20)
dim nom$(1000,2)
dim matrix(2501,4)
dim light(1000,11)
box=1
cot=matrix(2501,4)
rem object repere
make object cone 10000,100
backdrop off
rem pour faire quoi!!!
menu:
cls
text 500,400, "P-J Nicolas"
text 500,440, "2004"
text 500,470,"VERSION 3.0"

center text 320,0,"MatriXEdit 3.0"

do
text 0,15,"Charger"
if mx>0 and mx<50 and my>0 and my<40 and mouseclick()=1
reponse$="a"
exit
endif
text 400,15,"Nouveau fichier"
if mx>400 and mx<500 and my>0 and my<40 and mouseclick()=1
set cursor 400,50
input "Quelle nom a votre nouveau projet?>";nom$
exit
endif

mx=mousex()
my=mousey()
sync
loop

rem charger
if reponse$="a"
cls
rem fichier
fichier_ch:
cls

rem liste des fichiers 
perform checklist for files
print "fichiers dans ce dossier:"
for t=1 to checklist quantity()
text 0,45+(t*10), checklist string$(t)
next t

backdrop off
input "Quel fichier voulez vous charger?>";fich$

if fich$="cd.." 
 cd ".."
goto fichier_ch
endif

if fich$="cd"
Input "nom du dossier>";doss$
if path exist(doss$)=0 then goto fichier_ch 
cd doss$
goto fichier_ch
endif

if file exist(fich$+".n3d")=0 
print "Le fichier n'existe pas"
sleep 500
goto fichier_ch
endif

cls

rem chargements du tableau ds le fichier
load array fich$+".n3d",elements(1)
load array fich$+"e3d"+".n3d",nom$(1)

backdrop on

for box=1 to elements(1001,12)
rem infos
text 0,0,"element n="+str$(box)+" nom element ="+nom$(box,1) + " texture = "+nom$(box,2)
text 0,15,"posx= "+str$(elements(box,1))
text 0,30,"posy= "+str$(elements(box,2))
text 0,45,"posz= "+str$(elements(box,3))

text 0,60,"taille x= "+str$(elements(box,4))
text 0,75,"taille y= "+str$(elements(box,5))
text 0,90,"taille z= "+str$(elements(box,6))

text 0,105,"angle x= "+str$(elements(box,7))
text 0,120,"angle y= "+str$(elements(box,8))
text 0,135,"angle z= "+str$(elements(box,9))

text 0,150,"Rouge= "+str$(elements(box,11))
text 0,165,"Vert= "+str$(elements(box,12))
text 0,180,"Bleu= "+str$(elements(box,13))
text 0,195,"Code couleur="+str$(elements(box,11)+elements(box,12)+elements(box,13))

text 0,210,"Luminosité = "+str$(elements(box,14))

text 0,225,"Transparent = "+str$(elements(box,15))

text 0,240,"Caché = "+str$(elements(box,17))

taille_max=elements(1001,12)
taille_x=box
taille_max_x=640

if taille_x>640 then box 1,440,1+box,460
if taille_x<640 then box 1,400,1+box,420

box taille_max,400,taille_max,420


make object box box,elements(box,4),elements(box,5),elements(box,6)
set object box,1,1,0
rotate object box,wrapvalue(elements(box,7)),wrapvalue(elements(box,8)),wrapvalue(elements(box,9))
color object box,rgb( elements(box,11), elements(box,12), elements(box,13))
position object box,elements(box,1),elements(box,2),elements(box,3)
position camera elements(box,1),400,elements(box,3)
point camera elements(box,1),elements(box,2),elements(box,3)
fade object box,elements(box,14)



if elements(box,15)=0
ghost object off box
else
ghost object on box
endif

if elements(box,16)=1
set object box,1,0,0
else
set object box,1,1,0
endif

if elements(box,17)=0
show object box
else
set object box,0,0,0 
endif

if elements(box,18)=1
load object nom$(box,1),box
set object box,1,1,0
rotate object box,wrapvalue(elements(box,7)),wrapvalue(elements(box,8)),wrapvalue(elements(box,9))
position object box,elements(box,1),elements(box,2),elements(box,3)
fade object box,elements(box,14)
scale object box,elements(box,4),elements(box,5),elements(box,6)
endif


if file exist(nom$(box,2))=1
load image nom$(box,2),box
texture object box,box
endif

sleep 1

next box
if matrix exist(1)=1 
 delete matrix 1
endif
rem matrice
make matrix 1,15000,15000,50,50

cls
if file open(1)=1 then close file 1
open to read 1,fich$+"matrix_code.n3d"
if file open(2)=1 then close file 2 
if file exist(fich$+"matrixTexture"+".n3d")=1 then open to read 2,fich$+"matrixTexture"+".n3d"

rem image sol defaul
load image "sols1.jpg",65535
rem la texture decoupé en 5x3
prepare matrix texture 1,65535,5,3

c=0
z=0
lecture_mat:
for x=0 to 50
read string 1,a$
read string 1,b$

if file open(2) then read string 2,facettex$
if file open(2) then read string 2,facettez$
if file open(2) then read string 2,partie$

set matrix height 1,x,c,val(a$)
set matrix height 1,z,c,val(b$)

if file open(2) then set matrix tile 1,val(facettex$),val(facettez$),val(partie$)
next x
c=c+1
if c<50 then goto lecture_mat
if file open(2) then close file 2

update matrix 1
lecture_light:

load array fich$+"coord_light.n3d",light(1)
for x=1 to light(1000,10)
make light x
position light x,light(x,1),light(x,2),light(x,3)
color light x,rgb(light(x,4),light(x,5),light(x,6))
set light range x,light(x,7)
next x
set ambient light light(1000,1)
if light(1000,2)=1
fog on
fog color rgb(light(1000,4),light(1000,5),light(1000,6))
fog distance light(1000,3)
endif
rem pr l'editeur
on=light(1000,2)
distance=light(1000,3)
rb=light(1000,4)
gb=light(1000,5)
bb=light(1000,6)
ambience=light(1000,1)

close file 1

rem elements
box=elements(1001,12)+1
make object box box,100,100,100
set object box,1,1,0
yrotate object box,ay#
r=255
g=0
b=0
position object box,posx#,posy#,posz#
make object collision box box,-50,-50,-50,50,50,50,0
taillex=100
tailley=100
taillez=100
fade=100
fade object box,fade

goto boucle
else
rem si on charge pas on creer
rem premier objet
make object box box,100,100,100
set object box,1,1,0
yrotate object box,ay#
r=255
g=0
b=0
position object box,posx#,posy#,posz#
make object collision box box,-50,-50,-50,50,50,50,0
taillex=100
tailley=100
taillez=100
fade=100
fade object box,fade
endif


boucle:
rem lumiere ini
light=0
color light 0,rgb(255,255,255)
light=1

if light exist(light)=0 
light=1
 make light light
rem ambience
ambience=50
set ambient light ambience
portee=500
else
light=light(1000,10)+1
make light light
endif
rem menu sprite 
sprite 1,610,10,1000
sprite 2,610,50,1001
sprite 3,610,90,1002
rem si la matrice n existe pas on la creer ac tt le bordel necessaire
if matrix exist(1)=0 
 make matrix 1,15000,15000,50,50
rem image sol defaul
load image "sols1.jpg",65535
prepare matrix texture 1,65535,5,3
fill matrix 1,0.0,1
endif
rem ciel on
backdrop on
color backdrop rgb(125,125,125)
position camera 150,500,150
rem boucle
do
rem ----------------------------------------------------------
rem 			GESTION DES	des fichiers 								 -
rem ----------------------------------------------------------
rem infos
ink rgb(255,255,255),0
text 0,0,"nombres d'elements "+str$(box)
text 0,15,"position en x object"+str$(posx#)
text 0,30,"position en y object"+str$(posy#)
text 0,45,"position en z object"+str$(posz#)
text 0,60,"position en x camera"+str$(x)
text 0,75,"position en y camera"+str$(y)
text 0,90,"position en z camera"+str$(z)


rem ink rgb(155,105,105),0
rem menu
sprite 1,610,0,1000
sprite 2,610,30,1001
sprite 3,610,60,1002

text 300,0,"Object"
if mx>300 and mx<340 and my>0 and my<20 and mouseclick()=1
object_change=1
matrice_change=0
lumiere_change=0
endif

text 300,40,"Matrice"
if mx>300 and mx<340 and my>35 and my<65 and mouseclick()=1
object_change=0
matrice_change=1
lumiere_change=0
endif

text 300,80,"Lumiere"
if mx>300 and mx<340 and my>80 and my<105 and mouseclick()=1
object_change=0
matrice_change=0
lumiere_change=1
endif


rem nouveau fichier
if mousex()>600 and mousex()<640 and mousey()>0 and mousey()<20 and mouseclick()=1
position camera -1500,-1500,-1500
backdrop off
cls
input "Attention êtes-vous sur de vouloir créer un nouveau fichier(0,1)?>";nouveau

if nouveau=1
rem efface les tableaux
undim elements(1001,12)
undim elements(1000,2)
rem efface les elements 3d
for x=1 to elements(1001,12)
if object exist(x) then delete object x
next x
if object exist(elements(1001,12)+1) then delete object elements(1001,12)+1
rem efface la matrice
fill matrix 1,0.1,1
rem creer un premier object
box=1
make object box box,100,100,100
set object box,1,1,0
yrotate object box,ay#
r=255
g=0
b=0
position object box,posx#,posy#,posz#
make object collision box box,-50,-50,-50,50,50,50,0
taillex=100
tailley=100
taillez=100
fade=100
fade object box,fade
endif
for x=1 to light
delete light light
next x
light=1
make light light 
rem remet la camera
position camera cx#,cy#,cz#
rem active le ciel
backdrop on
endif
rem enregister
if mousex()>600 and mousex()<640 and mousey()>25 and mousey()<50 and mouseclick()=1
gosub enregistrement
endif

rem ouvrir
if mousex()>600 and mousex()<640 and mousey()>60 and mousey()<95 and mouseclick()=1
backdrop off
cls
position camera -1500,-1500,-1500
input "Enregister les changements?(0,1)>";change

if change=0
else
gosub enregistrement
goto ouvrir
endif

ouvrir:
rem efface les elements 3d
for x=1 to elements(1001,12)
if object exist(x) then delete object x
next x

for x=1 to light
if light exist(light) then delete light light
next x

if object exist(elements(1001,12)+1) then delete object elements(1001,12)+1
cls
flush video memory
goto fichier_ch
endif



rem ----------------------------------------------------------
rem 			GESTION DES 	elements 3d								 -
rem ----------------------------------------------------------
if object_change=1
rem il faut au moins un object
if box<>0

rem pos onject
vposx#=object position x(box)
vposy#=object position y(box)
vposz#=object position z(box)
rem position objet
position object box,vposx#,vposy#,vposz#

rem effacement
if keystate(211)=1
delete object box
make object box box,100,100,100
set object box,1,1,0
yrotate object box,ay#
r=255
g=0
b=0
position object box,posx#,posy#,posz#
make object collision box box,-50,-50,-50,50,50,50,0
taillex=100
tailley=100
taillez=100
fade=100
fade object box,fade
sleep 100
endif
rem --------------------------
rem modification de la taille
rem --------------------------
rem x
text 0,400,"taillex" 
if mx>0 and mx<40 and my>380 and my<440 
if mouseclick()=1 then taillex=taillex+5
if mouseclick()=2 then taillex=taillex-5
scale object box,taillex,tailley,taillez
endif
rem y
text 50,400,"tailley"
if mx>50 and mx<100 and my>380 and my<440 
if mouseclick()=1 then tailley=tailley+5
if mouseclick()=2 then tailley=tailley-5
scale object box,taillex,tailley,taillez
endif
rem z 
text 110,400,"taillez"
if mx>110 and mx<160 and my>380 and my<440 
if mouseclick()=1 then taillez=taillez+5
if mouseclick()=2 then taillez=taillez-5
scale object box,taillex,tailley,taillez
endif
rem -------------------
rem gestion luminosité
rem -------------------
text 170,400,"luminosite"
if mx>170 and mx<230 and my>380 and my<440 
if mouseclick()=1 then fade=fade+5
if mouseclick()=2 then fade=fade-5
endif
rem transparence
text 240,400,"Transparence"
if mx>240 and mx<290 and my>380 and my<440 
if mouseclick()=1
ghost object on box
ghost=1
endif
if mouseclick()=2
ghost object off box 
ghost=0
endif
endif
rem vois ou vois pas!
text 350,400,"Visibilite"
if mx>350 and mx<400 and my>380 and my<440 
if mouseclick()=1
hide=1
set object box,0,1,1
endif
if mouseclick()=2
hide=0
set object box,1,1,0
endif
endif
rem affiche le noir de la texture
text 420,400,"Afficher noir"
if mx>420 and mx<470 and my>380 and my<440 
if mouseclick()=1
trn=1
set object box,1,0,0
endif
if mouseclick()=2
trn=0
set object box,1,1,0
endif
endif
rem --------------------------
rem modification de l'angle
rem --------------------------
rem en x
text 0,460,"AngleX"
if mx>0 and mx<50 and my>460 and my<480
if mouseclick()=1 then AngleX=AngleX+5
if mouseclick()=2 then AngleX=AngleX-5
endif
rem en y 
text 60,460,"AngleY"
if mx>60 and mx<100 and my>460 and my<480
if mouseclick()=1 then AngleY=AngleY+5
if mouseclick()=2 then AngleY=AngleY-5
endif
rem en z
text 110,460,"angleZ"
if mx>110 and mx<160 and my>460 and my<480
if mouseclick()=1 then angleZ=angleZ+5
if mouseclick()=2 then angleZ=angleZ-5
endif

rem charger un object 3d independant
text 180,460,"Charger un objet"
if mx>180 and mx<280  and my>460 and my<480 and mouseclick()=1
obj3d:
cls
backdrop off
position camera -1500,-1500,-1500
for x=1 to box
hide object x
next x
rem liste des fichiers 
perform checklist for files
print "fichiers dans ce dossier:"
for t=1 to checklist quantity()
text 0,45+(t*10), checklist string$(t)
next t
input "Votre fichier(3ds,x)";n3d$
if file exist(n3d$)=0
print "le fichier existe pas"
sleep 500
goto obj3d
endif 
load object n3d$,box
o3d=1
nom$(box,1)=n3d$
backdrop on
for x=1 to box
show object x
next x
position camera cx#,cy#,cz#
endif
rem revemir au cube d'origine
text 310,460,"Recuperer"
if mx>310 and mx<350  and my>460 and my<480 and mouseclick()=1
taillex=100
taillez=100
tailley=100
angley=0
anflex=0
anglez=0
endif
rem enregistrement de la position de l'object
text 500,460,"Enregister position"
if mx>500 and mx<640  and my>460 and my<480 and mouseclick()=1
sleep 100
rem sauvegarde+!
gosub saveposition
gosub creation_nouveau_cube
else
endif
rem --------------------------
rem modification de la couleur
rem --------------------------
rem rouge
text 600,100,"Rouge"
if mx>600 and mx<640 and my>100 and my<120
if mouseclick()=1 then r=r+5
if mouseclick()=2 then r=r-5
if r>255 then r=255
if r<0 then r=0
color object box,rgb(r,g,b)
endif
 rem vert
text 600,130,"Vert"
if mx>600 and mx<640 and my>130 and my<150
if mouseclick()=1 then g=g+5
if mouseclick()=2 then g=g-5
if g>255 then g=255
if g<0 then g=0
color object box,rgb(r,g,b)
endif
rem bleu
text 600,160,"Bleu"
if mx>600 and mx<640 and my>160 and my<180
if mouseclick()=1 then b=b+5
if mouseclick()=2 then b=b-5
if b>255 then b=255
if b<0 then b=0
color object box,rgb(r,g,b)
endif

rem appliquer une texture
text 590,190,"Texture"
if mx>570 and mx<640 and my>190 and my<210
if mouseclick()=1 
backdrop off
position camera -1500,-1500,-1500
for x=1 to box
hide object x
next x
texture:
cls
set text size 15
rem liste des fichiers 
perform checklist for files
print "fichiers dans ce dossier:"
for t=1 to checklist quantity()
text 0,45+(t*10), checklist string$(t)
next t
input "Texture>";texture$
if file exist(texture$)=0 
print "le fichier n'existe pas"
sleep 500
goto texture 
endif
color object box,0
load image texture$,box
texture object box,box
set object texture box,3,3
nom$(box,2)=texture$
endif
for x=1 to box
show object x
next x
backdrop on
set text size 15
position camera cx#,cy#,cz#
endif
rem donne un nom a ton object 3d
text 600,230,"Nom"
if mx>600 and mx<640 and my>225 and my<240 and mouseclick()=1
for x=1 to elements(1001,12)
hide object x
next x
cls
backdrop off
position camera -1500,-1500,-1500
set cursor 0,0
input "Quelle nom a votre element>";obj$
for x=1 to elements(1001,12)
show object x
next x
backdrop on
position camera cx#,cy#,cz#
endif
rem ----------------------------------------------------
rem 		GESTION DU MOUVEMENT de l object 3d           -
rem ----------------------------------------------------
rem position
rem px
if rightkey()=1 then  vposx#=vposx#+5
if leftkey()=1 then vposx#=vposx#-5
rem py
if keystate(30)=1 then vposy#=vposy#+5
if keystate(44)=1 then vposy#=vposy#-5
rem pz
if upkey()=1 then vposz#=vposz#+5
if downkey()=1 then vposz#=vposz#-5
rem position objet
position object box,vposx#,vposy#,vposz#

rem infos
text 450,0,"numero d'objet="+str$(box)
text 450,15,"Texture objet="+str$(texture)
text 450,30,"Luminosité objet="+str$(fade)
text 450,45,"Objet transparent="+str$(ghost)
text 450,60,"Taille en x="+str$(taillex)
text 450,75,"Taille en y="+str$(tailley)
text 450,90,"Taille en z="+str$(taillez)
text 450,105,"Caché="+str$(hide)
text 450,120,"Object 3d special="+str$(o3d)
text 450,135,"Rouge="+str$(r)
text 450,150,"Vert="+str$(g)
text 450,165,"Bleu="+str$(b)
text 450,180,"Angle x="+str$(anglex)
text 450,195,"Angle y="+str$(angley)
text 450,210,"Angle z="+str$(anglez)
text 450,225,"Texture="+nom$(box,2)
text 450,240,"Type d'objet="+nom$(box,1)

rem repositionne l object sur la cam a hauteur de matrice
if mouseclick()=4
position object box,x,get ground height(1,posx#,posz#),z
endif

rem pos object modifiable
posx#=object position x(box)
posy#=object position y(box)
posz#=object position z(box)

rem position objet
position object box,posx#,posy#,posz#
rem box
endif

rem applique les changements effectué en tps reel
fade object box,fade
rotate object box,wrapvalue(anglex),wrapvalue(angley),wrapvalue(anglez)
endif
rem ----------------------------------------------------------
rem 			GESTION DE LA	lumiere								    -
rem ----------------------------------------------------------
if lumiere_change=1

rem infos
text 400,0,"Numero de lumiere="+str$(light)
text 400,20,"Rouge="+str$(rl)
text 400,40,"Vert="+str$(gl)
text 400,60,"Bleu="+str$(bl) 
text 400,80,"Position x="+str$(light position x(light)) 
text 400,100,"Position y="+str$(posy_light) 
text 400,120,"Position z="+str$(light position z(light))  
text 400,140,"Taux de la lumiere d'ambience="+str$(ambience)+" %"
text 400,160,"Portee de la lumiere ="+str$(portee)
text 400,180,"Brouillard active="+str$(on)
text 400,200,"Distance du brouillard="+str$(distance)
text 400,220," brouillard Rouge="+str$(rb)
text 400,240," brouillard Vert="+str$(gb)
text 400,260," brouillard Bleu="+str$(bb)
rem creer une lumiere
text 400,460,"Creer une lumiere(enregistrement)" 
if mx>400 and mx<640 and my>440 and my<480 and mouseclick()=1
light(light,1)=light position x(light)
light(light,2)=light position y(light)
light(light,3)=light position z(light)
light(light,4)=rl
light(light,5)=gl
light(light,6)=bl
light(light,7)=portee
light(1000,1)=ambience
light(1000,2)=on
light(1000,3)=distance
light(1000,4)=rb
light(1000,5)=gb
light(1000,6)=bb
light(1000,10)=light

light=light+1
make light light
sleep 100
endif

rem --------------------------
rem modification de la couleur
rem --------------------------
rem en rouge
text 160,400,"Rouge" 
if mx>160 and mx<200 and my>380 and my<420
if mouseclick()=1 then rl=rl+5
if mouseclick()=2 then rl=rl-5
if rl>255 then rl=255
if rl<0 then rl=0
endif
rem en vert
text 220,400,"Vert"  
if mx>220 and mx<260 and my>380 and my<420
if mouseclick()=1 then gl=gl+5
if mouseclick()=2 then gl=gl-5
if gl>255 then gl=255
if gl<0 then gl=0
endif
rem en bleu
text 280,400,"Bleu"  
if mx>280 and mx<320 and my>380 and my<420
if mouseclick()=1 then bl=bl+5
if mouseclick()=2 then bl=bl-5
if bl>255 then bl=255
if bl<0 then bl=0
endif

rem ---------------------------------------------------------
rem hauteur lumiere
text 340,400,"Posy_light" 
if mx>340 and mx<420 and my>380 and my<420
if mouseclick()=1 then posy_light=posy_light+1
if mouseclick()=2 then posy_light=posy_light-1
endif

rem portee lumiere
text 440,400,"Portee de la lumiere" 
if mx>440 and mx<550 and my>380 and my<420
if mouseclick()=1 then portee=portee+5
if mouseclick()=2 then portee=portee-5
endif

rem lumiere d'ambience
text 0,400,"% lumiere ambience"
if mx>0 and mx<140 and my>380 and my<420
if mouseclick()=1 then ambience=ambience+1
if mouseclick()=2 then ambience=ambience-1
if ambience>100 then ambience=100
if ambience<0 then ambience=0
endif

rem brouillard
text 0,460,"Fog"
if mx>0 and mx<40 and my>440 and my<480 
if mouseclick()=1 then on=1
if mouseclick()=2 then on=0
endif

text 60,460,"Distance"
if mx>60 and mx<160 and my>440 and my<480 
if mouseclick()=1 then distance=distance+5
if mouseclick()=2 then distance=distance-5
endif


rem en rouge
text 200,460,"Rouge" 
if mx>200 and mx<240 and my>440 and my<480
if mouseclick()=1 then rb=rb+5
if mouseclick()=2 then rb=rb-5
if rb>255 then rb=255
if rb<0 then rb=0
endif
rem en vert
text 260,460,"Vert"  
if mx>260 and mx<300 and my>440 and my<480
if mouseclick()=1 then gb=gb+5
if mouseclick()=2 then gb=gb-5
if gb>255 then gb=255
if gb<0 then gb=0
endif
rem en bleu
text 320,460,"Bleu"  
if mx>320 and mx<360 and my>440 and my<480
if mouseclick()=1 then bb=bb+5
if mouseclick()=2 then bb=bb-5
if bb>255 then bb=255
if bb<0 then bb=0
endif

rem changement tps reel
if on=1
fog on
fog distance distance
fog color rgb(rb,gb,bb)
else
fog off
endif


rem apliquation en tps reel
color light light,rgb(rl,gl,bl)
position light light,x,posy_light,z
set ambient light ambience
set light range light,portee
endif


rem ----------------------------------------------------------
rem 			GESTION DE LA	matrice									 -
rem ----------------------------------------------------------
if matrice_change=1
rem calcul pr trouver une facette
facettex=int(cx#/300)
facettez=int(cz#/300)
rem infos
text 400,0,"hauteur matrice="+str$(get ground height(1,cx#,cz#))
text 400,20,"hauteur facette="+str$(get matrix height(1,facettex,facettez))
text 400,40,"num facette x="+str$(facettex)
text 400,60,"num facette z="+str$(facettez)
text 400,80,"Hauteur pr le moment="+str$(hauteur)
text 400,100,"Normale en x="+str$(normale_x)
text 400,120,"Normale en y="+str$(normale_y)
text 400,140,"Normale en z="+str$(normale_z)
rem modification de la taille de la matrice
text 0,400,"Hauteur de la facette"
if mx>0 and mx<140 and my>380 and my<420
if mouseclick()=1 then hauteur=hauteur+1
if mouseclick()=2 then hauteur=hauteur-1
 set matrix height 1,facettex,facettez,hauteur
 update matrix 1
endif

rem texturage de la matrice
text 160,400,"Texture"
if mx>160 and mx<220 and my>380 and my<420  and mouseclick()=1
matrix_text:
cot=cot+1
cls
backdrop off
position camera -1500,-1500,-1500
for x=1 to box
hide object x
next x
paste image 65535,0,0
get image 65535,0,0,638,382
prepare matrix texture 1,65535,5,3
text 0,400,"Nombre de texture="+str$(matrix tile count(1))
set cursor 0,420
input "Votre texture";partie
set matrix tile 1,facettex,facettez,partie

rem enre place text ds un fichier
if file exist(fich$ + "matrixTexture" + ".n3d")=1 then delete file fich$+ "matrixTexture" + ".n3d"
if file open(2)=0 then open to write 2,fich$+"matrixTexture"+".n3d"
write string 2,str$(facettex)
write string 2,str$(facettez)
write string 2,str$(partie)
backdrop on
for x=1 to box
show object x
next x
matrix(cot,1)=facettex
matrix(cot,2)=facettez
matrix(cot,3)=partie
matrix(2501,4)=cot
for x=0 to matrix(2501,4)
set matrix tile 1,matrix(x,1),matrix(x,2),matrix(x,3)
next x
position camera cx#,cy#,cz#
update matrix 1
endif

rem pour ne pas tjs devoir reprendre l image
text 240,400,"Appliquer"
if mx>240 and mx<340 and my>380 and my<420 and mouseclick()=1 and partie<>0
rem get image 65535,0,0,256,256
prepare matrix texture 1,65535,5,3
cot=cot+1
set matrix tile 1,facettex,facettez,partie
rem enregister place text ds un fichier
if file exist(fich$ + "matrixTexture" + ".n3d")=1 then delete file fich$+ "matrixTexture" + ".n3d"
if file open(2)=0 then open to write 2,fich$+"matrixTexture"+".n3d"
write string 2,str$(facettex)
write string 2,str$(facettez)
write string 2,str$(partie)
for x=1 to box
show object x
next x
matrix(cot,1)=facettex
matrix(cot,2)=facettez
matrix(cot,3)=partie
matrix(2501,4)=cot
rem re appliquer les textures
for x=0 to matrix(2501,4)
set matrix tile 1,matrix(x,1),matrix(x,2),matrix(x,3)
next x
sleep 100
update matrix 1
endif

endif



rem pos souris
rem text 0,300,str$(mx)
rem text 0,320,str$(my)
mx=mousex()
my=mousey()
text 600,440,str$(screen fps())
text 0,440,get time$()
remstart
--------------------------------------------
************GESTION DE LA CAMERA***********|
--------------------------------------------
remend
rem position camera (sav)
cx#=camera position x()  
cy#=camera position y() 
cz#=camera position z() 

rem position camera
x=camera position x()  
y=camera position y() 
z=camera position z() 
rem move
if keystate(72)=1 then z=z+10
if keystate(80)=1 then z=z-10

if keystate(77)=1 then x=x+10
if keystate(75)=1 then x=x-10
rem hauteur cam
if keystate(71)=1
 y=y+15
endif
if keystate(79)=1
y=y-15
endif
rem position camera
position camera x,y,z
position object 10000,x,get ground height(1,x,z),z
rem rotation
xrotate camera 90
zrotate camera 0
yrotate camera 0
rem --------------------------
rem GESTION NOUVELLE CAMERA
rem --------------------------
if inkey$()="x"
sleep 500
rem boucle
do
rem depl
if upkey()=1 then move object 10000,10
if downkey()=1 then move object 10000,-10
if rightkey()=1 then yrotate object 10000,wrapvalue(ay#+5) 
if leftkey()=1 then  yrotate object 10000,wrapvalue(ay#-5) 
rem pos obj repere
posxr#=object position x(10000)
posyr#=object position y(10000)
poszr#=object position z(10000)
ay#=object angle y(10000)
if inkey$()="x"
sleep 500 
exit
endif
rem position camera x,y,z
rem rotation
zrotate camera 0
yrotate camera wrapvalue(ry)
xrotate camera 0
position object 10000,posxr#,get ground height(1,posxr#,poszr#),poszr#
set camera to follow posxr#,posyr#,poszr#,ay#,100,150+get ground height(1,posxr#,poszr#),3,0
point camera posxr#,posyr#+mousey(),poszr#
sync 
loop
position camera posxr#,get ground height(1,posxr#,poszr#)+cy#,poszr#
endif
sync
loop



rem ---------------------------------------------------------
rem 			SOUS PROGRAMME ET CO
rem ---------------------------------------------------------

rem sauvegarde de la coord. a chaque new object
saveposition:
 rem box
 elements(box,1)=posx#
 elements(box,2)=posy#
 elements(box,3)=posz#
 elements(box,4)=taillex
 elements(box,5)=tailley
 elements(box,6)=taillez
 elements(box,7)=anglex
 elements(box,8)=angley
 elements(box,9)=anglez
 elements(box,10)=texture
 elements(box,11)=r
 elements(box,12)=g
 elements(box,13)=b
 elements(box,14)=fade
 elements(box,15)=ghost
 elements(box,16)=trn
 elements(box,17)=hide
 elements(box,18)=o3d
 elements(box,19)=num3d
 elements(1001,12)=box
rem ecriture du nom
if elements(box,18)=0 
if obj$="" then obj$="box"
nom$(box,1)=obj$
endif
rem pause pour le voir
o3d=0
fade=100
ghost=0
hide=0
return

rem assez explicite!!!
creation_nouveau_cube:
box=box+1

if object exist(box)=0
rem taille par defaut
taillex=100
tailley=100
taillez=100
r=255
g=0
b=0
anglex=0
angley=0
anglez=0
rem creation new object
make object box box,taillex,tailley,taillez
set object box,1,1,0
texture object box,texture
position object box,posx#,posy#,posz#
endif
rotate object box,anglex,angley,anglez
return
rem !!!
enregistrement:
rem efface 
cls
rem + de raffraichissement
backdrop off
rem cache les object 3d
for x=1 to box
if object exist(x)=1 then hide object x 
next x
position camera -1500,-1500,-1500
rem liste des fichiers 
perform checklist for files
print "fichiers dans ce dossier:"
for t=1 to checklist quantity()
text 0,45+(t*10), checklist string$(t)
next t
rem demande le nom de votre fichier
input "Nom de votre fichier>";nom$
if nom$="cd.." 
 cd ".."
goto enregistrement
endif

if nom$="cd"
Input "nom du dossier>";doss$
if path exist(doss$)=0 then goto enregistrement 
cd doss$
goto enregistrement
endif
if nom$="make doss"
input "Nom du nouveau dossier>";path$
make directory path$
cd path$
goto enregistrement
endif

rem sauvegarde des elements 3d ds un tableau---> fichier
 save array nom$+".n3d",elements(1)
 save array nom$+"e3d"+".n3d",nom$(1)

rem matrice
c=0
x=0
z=0
rem ecriture ds un fichier
if file exist(nom$+"matrix_code.n3d") then delete file nom$+"matrix_code.n3d"
open to write 1,nom$+"matrix_code.n3d"
rem ecriture de la matrice
ecriture_mat:
for x=0 to 50
write string 1,str$(get matrix height(1,x,c))
write string 1,str$(get matrix height(1,z,c))
next x
c=c+1
rem si tt les coté ne sont pas fait ...
if c<50 then goto ecriture_mat
rem on ferme le fichier 
close file 1
rem on montre les elements 3d caché avant
for x=1 to box
if object exist(x)=1 then show object x
next x

ecriture_light:
save array nom$+"coord_light.n3d",light(1)
rem on remet la camera a 0,0,0
position camera cx#,cy#,cz#
backdrop on
return