Generateur terrain 2D Simple avec gestion collision [QB64] - 2Ko seulement !

**Vetea** · 27/07/2015, 19h02

Ground2D_2Ko

Oui, je sais ... Je suis un dingue, mais voila, j'avais cette idée en tête depuis pas mal de temps, et j'ai voulu la mettre en oeuvre avec la contrainte des 2Ko !

Que fait donc ce programme ?
- Et bien, il va générer une carte en 2D sur 8192 pixel de long.
- Une fois la génération faite, un petit véhicule s'affichera que vous pourrez piloter avec les touches fléchées ( Haut et Bas pour faire varier la vitesse et Gauche Droite pour le déplacement )
- Scrolling et limite gérées.

Notre super véhicule de la mort qui tue !

Le listing (1396 octets ):

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
M=_Newimage(800,600,32):e=3:screen  M:dim T(-100 to 8192,2048):dim g(2):Dim  x(2):g(1)=300:g(2)=300:x(1)=10:X(2)=X(1)+40:Print "G‚n‚ration en  cours":for i=1to 8192
II:
randomize timer:Z=rnd*10
if Z<4then W=2
if Z>6then w=-2
if Z>=4and Z<=6then W=0
v=v+1*w:if abs(v)>250or abs(v)<10then goto II:
for j=(400+v)to 600:if j<1 then j=1
T(i,j)=1:next j,i:cls:do
_limit 60:cls:if _keydown(18432) and e<8 then e=e+1
if _keydown(20480) and e>0 then e=e-1
?"Vitesse :"+str$(e):for i=1+c to 800+c step 2:for j=1to 800step 2
if t(i,j)=1then pset(i-c,j),_rgb(200,255,0)
next j,i
for i=1 to 2
if x(i)>=400and m=1 and c>=0 and (800+c)<8192 then c=c+1*o*e
if c<0 then c=0
if c>7390 then c=7390
if _keydown(19712)and x(i)<8100then x(i)=x(i)+1*e:m=1:O=1
if _keydown(19200)and x(i)>0then x(i)=x(i)-1*e:m=1:O=-1
if x(1)<20 then x(1)=20
if x(2)<60 then x(2)=60
if x(1)>8060 then x(1)=8060
if x(2)>8100 then x(2)=8100
if g(i)<590 then g(i)=g(i)+1*e
circle(x(i)-c,g(i)-12),8,_rgb(255,0,0):if t(x(i),g(i))=1 then g(i)=g(i)-1*e
if m=1 and t(x(i)+1*e,g(i))=1 then g(i)=g(i)-1*e
if m=1 and t(x(i)-1*e,g(i))=1 then g(i)=g(i)-1*e
next
for   i=12 to  40:line(x(1)-i-c,g(1)-12)-(X(2)+i-c,g(2)-12),_rgb(255,255,0):line(x(1)-c,g(1)-12)-(X(1)-c,g(1)-40),_rgb(255,255,0):line(x(2)-c,g(2)-12)-(X(2)-c,g(2)-40),_rgb(255,255,0):line(x(1)-c-i,g(1)-40)-(X(2)+i-c,g(2)-40),_rgb(255,255,0):next:m=0:_display:loop

L'Exe :
https://dl.dropboxusercontent.com/u/...ound2D_2Ko.zip

C'est avant tout un petit exercice pédagogique qui pourra servir pour d'autres ... La gestion procédurale peut être modifiée à souhait !
Amusez vous bien !

**Vetea** · 27/07/2015, 22h15

* Ground2D_2Ko Update *

Et oui, première update du projet avec un commencement de jeu !
Désormais, la vitesse du véhicule sera unique, il faudra aller à l'autre bout de la carte sans se faire toucher par les bombes, sinon retour case départ !
Les Bombes détruisent et déforment le terrain en temps réel.

Petite vidéo:

Listing :
https://dl.dropboxusercontent.com/u/...5/Ground2D.bas

Lien:
https://dl.dropboxusercontent.com/u/...ound2D_2Ko.zip

Amusez vous bien !

**Vetea** · 29/07/2015, 04h43

Bonjour à tous,

Voici donc une nouvelle création : D3R3 the Digger Robot qui est une variante du code d'origine en respectant toujours une taille de code <= 2048 Octets.
D3R3 est un modèle prototype du fameux D2R2, à part qu'il est spécialisé dans le minage.
Il est doté d'un obusier qui permet d'exploser et de creuser de nouvelles cavités à la recherche de précieuses pépites ..

D3R3 en pleine action !

Vous devez donc aider D3R3 à récolter un maximum de pépites !
Simple ?! Attendez de voir les contraintes de notre héros à boulon : D3R3 ne peut pas franchir d'obstacle trop raide.

Déplacez D3R3 avec les touches Gauche et Droite, faire varier l'angle du canon avec Haut et Bas et tirer avec Espace.

Listing :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
M=_Newimage(800,600,32):e=2:f=80:screen M:dim P(8192,2048):dim T(-100to 8192,2048):g(1)=300:x(1)=10:for i=1to 8192:tt=0
II:
randomize timer:Z=rnd*10:if Z<4then W=2
if Z>6then w=-2
if Z>=4and Z<=6then W=0
v=v+1*w:if abs(v)>250or abs(v)<10then goto II:
for j=(350+v)to 600
if j<1then j=1
T(i,j)=1
if tt=0and rnd*100<0.004and j<589then P(I,J)=1:tt=1
next j,i
cls:X3=1:G3=25:do:_limit 60:cls:IF _KEYDOWN(18432)THEN Q=Q+5
IF _KEYDOWN(20480)THEN Q=Q-5
IF h=0AND _KEYDOWN(32)THEN H=1:xx=x(1)+2:yy=g(1)-45:Q1=Q
for i=1+c to 800+c step 2:for j=1to 800step 2
if t(i,j)=1then pset(i-c,j)
if P(i,j)=1 then
_printstring(i-c,j),"O":if abs(x(1)-i)<=30and abs(g(1)-10-j)<=30then P(i,j)=0:l=l+1:PLAY"MBL64O5DCABC":end if
next j,i:IF H=1and b=0THEN
T=T+0.06:X=xx-c+(COS(Q1*(3.14)/180)*f)*T:Y=yy+(-1*((SIN(Q1*(3.14)/180)*f*T))+(.5*9.8*T^2))*(300/150):_printstring(x,y),".":if  x<0or x>8100or y>598 or y<=10 then h=0:t=0
if t(X+c,y)=1and h=1then C1=c:b=3:U=30:END IF
if b=3then
for  i=1to 360:for j=1to  int(rnd*U):T(x+c1+j*cos(i*(3.14)/180),y+j*sin(i*(3.14)/180))=0:next  j,i:p=p+2:circle(X,y),p:if p>u then p=0:b=0:h=0:t=0:end if
for i=1to 2:if x(1)>=400and m=1and c>=0and(800+c)<8192then c=c+1*o*e*2
if c<0 then c=0
if c>7390then c=7390
if _keydown(19712)and x(1)<8100and r=0then x(1)=x(1)+1*e:m=1:O=1:d=1
if _keydown(19200)and x(1)>0then x(1)=x(1)-1*e:m=1:O=-1:d=2
for j=5 to 10:if d=1 then
if t(x(1)+j,g(1)-20-j)=1then x(1)=x(1)-1*e:if c>0then c=c-1*e
elseif d=2 then
if t(x(1)-j,g(1)-20-j)=1 then x(1)=x(1)+1*e:if c>0then c=c+1*e:end if
next:if x(i)<20then x(i)=20
if x(i)>8100then x(i)=8100
if g(i)<590then g(i)=g(i)+2*e
circle(x(1)-c,g(1)-12),8:if t(x(1),g(1))=1 then g(1)=g(1)-2*e
if m=1 and t(x(i)+1*e,g(i))=1then g(i)=g(i)-2*e
if m=1 and t(x(i)-1*e,g(i))=1then g(i)=g(i)-2*e
next:?"P‚pites   :"+str$(l):LINE(x(1)-c+2,g(1)-35)-(x(1)-c+2+18*COS(Q*(3.14)/180),g(1)-35-18*SIN(Q*(3.14)/180)),_RGB(255,0,0):for  i=12 to  40:circle(x(1)-c,g(1)-35),8,_rgb(255,255,255):line(x(1)-c,g(1)-25)-(X(1)-c,g(1)-25):next:m=0:_display:loop