TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 16th Mar 2005 15:24

Modified: 1st Jan 1970 01:00

Author: Anonymous Coder

Summary

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

Full Description

DarkBASIC Source 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

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 "carte graphique utilisÃ©e ";current graphics card$()

print "Attendez SVP [***] "

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"

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

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

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

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

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

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

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

if c<50 then goto ecriture_mat

rem on ferme le fichier

close file 1

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

Download

Please login to download

Comments

No comments yet.

CodeBase - MatriXedit

Information

Summary

Full Description

DarkBASIC Source Code

Download

Screen Shot

Author

Comments

Author Name:	Anonymous Coder
CodeBase Entries:	6