Rem Project: RPG 2d Rem Created: 09/08/2005 07:04:09 Rem ***** Main Source File ***** set display mode 1024,768,32 temps1=timer() create bitmap 1,160,64 set current bitmap 1 rem Création de la terre et de l'herbe ------------------------------------------------------------ for image=0 to 3 for x=32*image to 31+(32*image) if yorigine=1 yorigine=0 else yorigine=1 endif for y=yorigine to 30+yorigine step 2 ink rgb(0,85+(rnd(7)*21),0),0 dot x,y next y next x yorigine=1 for x=32*image to 31+(32*image) if yorigine=1 yorigine=0 else yorigine=1 endif for y=yorigine to 30+yorigine step 2 xg=x-1 yh=y-1 xd=x+1 yb=y+1 if xg<32*image then xg=31+(32*image) if yh<0 then yh=31 if xd>31+32*image then xd=32*image if yb>31 then yb=0 pixg=point(xg,y) pixh=point(x,yh) pixd=point(xd,y) pixb=point(x,yb) ink (pixg+pixh+pixd+pixb)/4,0 dot x,y next y next x yorigine=0 next image for image=0 to 3 for x=32*image to 31+(32*image) if yorigine=1 yorigine=0 else yorigine=1 endif for y=32+yorigine to 62+yorigine step 2 variable=rnd(7) ink rgb(83+(variable*21),53+(variable*12),2+int((variable/3))),0 dot x,y next y next x yorigine=1 for x=32*image to 31+(32*image) if yorigine=1 yorigine=0 else yorigine=1 endif for y=32+yorigine to 62+yorigine step 2 xg=x-1 yh=y-1 xd=x+1 yb=y+1 if xg<32*image then xg=31+(32*image) if yh<32 then yh=63 if xd>31+32*image then xd=32*image if yb>63 then yb=32 pixgr=rgbr(point(xg,y)) pixgg=rgbg(point(xg,y)) pixgb=rgbb(point(xg,y)) pixhr=rgbr(point(xg,y)) pixhg=rgbg(point(xg,y)) pixhb=rgbb(point(xg,y)) pixdr=rgbr(point(xd,y)) pixdg=rgbg(point(xd,y)) pixdb=rgbb(point(xd,y)) pixbr=rgbr(point(x,yb)) pixbg=rgbg(point(x,yb)) pixbb=rgbb(point(x,yb)) ink rgb((pixgr+pixhr+pixdr+pixbr)/4,(pixgg+pixhg+pixdg+pixbg)/4,(pixgb+pixhb+pixdb+pixbb)/4),0 dot x,y next y next x yorigine=0 next image rem Création des routes horizontale et verticale -------------------------------------------------- dim terre(31,31) image=rnd(3)+1 for x=32*(image-1) to (32*image)-1 for y=32 to 63 terre(x-(32*(image-1)),y-32)=point(x,y) next y next x dim efface1(8,1) do niveau=niveau+1 x=rnd(2)-1 y=rnd(3)+4 if ytotal+y>31 then y=31-ytotal ytotal=ytotal+y efface1(niveau,0)=x efface1(niveau,1)=y if ytotal=31 efface1(0,0)=niveau exit endif loop dim efface2(8,2) niveau=0 ytotal=0 do niveau=niveau+1 x=rnd(2)-1 y=rnd(3)+4 if ytotal+y>31 then y=31-ytotal ytotal=ytotal+y efface2(niveau,0)=x efface2(niveau,1)=y if ytotal=31 efface2(0,0)=niveau exit endif loop image=rnd(3)+1 copierimage(32*(image-1),0,128,0) for y=0 to 31 for test=1 to efface1(0,0) ycumule=ycumule+efface1(test,1) if y=<ycumule xg=efface1(test,0) ycumule=0 exit endif next test for test=1 to efface2(0,0) ycumule=ycumule+efface2(test,1) if y=<ycumule xd=efface2(test,0) ycumule=0 exit endif next test for x=9+xg to 22+xd ink terre(x,y),0 dot 128+x,y next x next y image=rnd(3)+1 for x=32*(image-1) to (32*image)-1 for y=32 to 63 terre(x-(32*(image-1)),y-32)=point(x,y) next y next x do niveau=niveau+1 y=rnd(2)-1 x=rnd(3)+4 if xtotal+x>31 then x=31-xtotal xtotal=xtotal+x efface1(niveau,0)=y efface1(niveau,1)=x if xtotal=31 efface1(0,0)=niveau exit endif loop niveau=0 xtotal=0 do niveau=niveau+1 y=rnd(2)-1 x=rnd(3)+4 if xtotal+x>31 then x=31-xtotal xtotal=xtotal+x efface2(niveau,0)=y efface2(niveau,1)=x if ytotal=31 efface2(0,0)=niveau exit endif loop image=rnd(3)+1 copierimage(32*(image-1),0,128,32) for x=0 to 31 for test=1 to efface1(0,0) xcumule=xcumule+efface1(test,1) if x=<xcumule yh=efface1(test,0) xcumule=0 exit endif next test for test=1 to efface2(0,0) xcumule=xcumule+efface2(test,1) if x=<xcumule yb=efface2(test,0) xcumule=0 exit endif next test for y=9+yh to 22+yb ink terre(x,y),0 dot 128+x,32+y next y next x rem Test ------------------------------------------------------------------------------------------ for image=1 to 5 get image image,32*(image-1),0,(32*image),32 get image image+5,32*(image-1),32,(32*image),64 next image set current bitmap 0 for x=0 to 22 for y=0 to 22 paste image rnd(9)+1,271+(32*x),15+(32*y) next y next x ink rgb(510,510,510),0 print "Chargement : ";int((timer()-temps1)/1000) wait 10000 rem Fonctions ------------------------------------------------------------------------------------- function copierimage(abscisseorigine,ordonneeorigine,abscissedestination,ordonneedestination) differenceabscisse=abscissedestination-abscisseorigine differenceordonnee=ordonneedestination-ordonneeorigine for x=abscissedestination to abscissedestination+31 for y=ordonneedestination to ordonneedestination+31 ink point(x-differenceabscisse,y-differenceordonnee),0 dot x,y next y next x endfunction