Combat de vermine (R,G et B)

Partagez votre expérience de PureBasic avec les autres utilisateurs.
kelly
Messages : 176
Inscription : jeu. 09/sept./2004 16:15

Combat de vermine (R,G et B)

Message par kelly »

C'est debile, je sais mais j'aime les combats de pseudo virus rongeant l'une des teinte du RGB des pixels (mettez la capture d'ecran de votre bureau (seulement en 1024*768)=) :

Code : Tout sélectionner

InitSprite() 
InitMouse()
InitKeyboard() 
UseJPEGImageDecoder() 
Dim r.w(1024,768)
Dim v.w(1024,768)
Dim b.w(1024,768)
Dim p(1024*768)
Dim rr.b(1024,768)

For i=0 To 100
rr(Random(1023),Random(767))=Random(2)+1
Next

OpenScreen(1024,768,32,"")    

LoadSprite(0,"pic1024*768.jpg")   
DisplaySprite(0,0,0)     
StartDrawing(SpriteOutput(0))

For u=0 To 767
For i=0 To 1023
x=Point(i,u)
r(i,u)=Red(x)
v(i,u)=Green(x)
b(i,u)=Blue(x)
Next
Next
StopDrawing()
FreeSprite(0)
w=-1
w1=1
w2=2
w3=3
www=2000
Repeat
StartDrawing(ScreenOutput())
For u=0 To 767
For i=0 To 1023
Plot(i,u,RGB(r(i,u),v(i,u),b(i,u)))
Next
Next
StopDrawing()
FlipBuffers()

For n=1 To 60000
a=Random(1022)+1
b=Random(766)+1
If rr(a,b)=w1
For i=-1 To 1
For u=-1 To 1
rr(a+i,b+u)=w1
If Random(30)<>0
r(a+i,b+u)+w
If r(a+i,b+u)<0
r(a+i,b+u)=0
EndIf
EndIf
Next
Next
EndIf

If rr(a,b)=w2
For i=-1 To 1
For u=-1 To 1
rr(a+i,b+u)=w2
If Random(30)<>0
v(a+i,b+u)+w
If v(a+i,b+u)<0
v(a+i,b+u)=0
EndIf
EndIf
Next
Next
EndIf

If rr(a,b)=w3
For i=-1 To 1
For u=-1 To 1
rr(a+i,b+u)=w3
If Random(30)<>0
b(a+i,b+u)+w
If b(a+i,b+u)<0
b(a+i,b+u)=0
EndIf
EndIf
Next
Next
EndIf
Next
www-5
If Random(www)<10
w0=w1
w1=w2
w2=w3
w3=w0
www=2000
EndIf

ExamineKeyboard() : Until KeyboardPushed(#PB_Key_Escape): End
:jesors:
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Ouais! Sors!





;)
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

wahoo ! super beau !! :D

cela peut faire de jolis fond d'ecran !! :D

Bravo ! :D
Dr. Dri
Messages : 2527
Inscription : ven. 23/janv./2004 18:10

Message par Dr. Dri »

il a un problème ton prog, il salit l'écran...

Dri :jesors:
kelly
Messages : 176
Inscription : jeu. 09/sept./2004 16:15

Message par kelly »

C'est encore plus fun si a la place de cette boucle du tout debut :

Code : Tout sélectionner

For i=0 To 100 
rr(Random(1023),Random(767))=Random(2)+1 
Next 
vous mettez un petit nombre a la place de 100 (mettez 2 ou 3 et l'ecran se fait ronger localement puis ca se propage)
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Tu as dû pas mal chercher pour les paramètres :)
kelly
Messages : 176
Inscription : jeu. 09/sept./2004 16:15

Message par kelly »

non, ca a ete tres facile
pkoi ???
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Oh je dis juste ça comme ça : quand on fait un programme comme ça, on passe toujours un petit moment à changer les variables pour essayer certains motifs, etc. Les variantes sont infinies et personnellement, j'ai toujours du mal à donner une version définitive!
AYBABTU
Messages : 26
Inscription : mer. 10/août/2005 14:34

Message par AYBABTU »

Pas mal de faire ca en si peu de code. J'ai l'impression que c'est une des grandes particularité de PureBasic.
kelly
Messages : 176
Inscription : jeu. 09/sept./2004 16:15

Message par kelly »

La, il y a une histoire :
4 virus grignotent l'image : un mange le R, un mange le V, un mange le B et un equilible le RVB pour faire du gris.
De plus:
Le virus A sait manger le B et assez difficilement le C
Le virus B sait manger le C et assez difficilement le D
Le virus C sait manger le D et assez difficilement le A
Le virus D sait manger le A et assez difficilement le B

Voici le code :

Code : Tout sélectionner

InitSprite() 
InitMouse()
InitKeyboard() 
UseJPEGImageDecoder() 
Dim r.w(1024,768)
Dim v.w(1024,768)
Dim b.w(1024,768)
Dim rr.b(1024,768)

For i=1 To 7
rr(Random(511),Random(380))=1
rr(1023-Random(511),Random(380))=2
rr(Random(511),767-Random(380))=3
rr(1023-Random(511),767-Random(380))=4
Next
rr(Random(511),Random(380))=2
rr(1023-Random(511),Random(380))=3
rr(Random(511),767-Random(380))=4
rr(1023-Random(511),767-Random(380))=1

rr(Random(511),Random(380))=3
rr(1023-Random(511),Random(380))=4
rr(Random(511),767-Random(380))=1
rr(1023-Random(511),767-Random(380))=2

rr(Random(612),Random(380))=4
rr(1023-Random(612),Random(380))=1
rr(Random(612),767-Random(380))=2
rr(1023-Random(612),767-Random(380))=3



OpenScreen(1024,768,32,"")    

LoadSprite(0,"ghost.jpg")   
DisplaySprite(0,0,0)     
StartDrawing(SpriteOutput(0))

For u=0 To 767
For i=0 To 1023
x=Point(i,u)
r(i,u)=Red(x)
v(i,u)=Green(x)
b(i,u)=Blue(x)
Next
Next
StopDrawing()
FreeSprite(0)

Repeat
StartDrawing(ScreenOutput())
For u=0 To 767
For i=0 To 1023
Plot(i,u,RGB(r(i,u),v(i,u),b(i,u)))
Next
Next
StopDrawing()
FlipBuffers()

For n=1 To 80000
a=Random(1022)+1
b=Random(766)+1

For nn=1 To 4
If rr(a,b)=nn

For i=-1 To 1
For u=-1 To 1
w=rr(a+i,b+u)
ww=nn+1
xx=nn+2
If ww=5
ww=1
EndIf
If xx>4
xx=-4
EndIf

If w=0 Or w=ww Or w=nn Or w=xx
If w<>xx
yy=16
Else
w=4
EndIf

If Random(yy)<>0
rr(a+i,b+u)=nn

If nn=1
r(a+i,b+u)-1
If r(a+i,b+u)<0
r(a+i,b+u)=0
EndIf
EndIf

If nn=2
v(a+i,b+u)-1
If v(a+i,b+u)<0
v(a+i,b+u)=0
EndIf
EndIf

If nn=3
b(a+i,b+u)-1
If b(a+i,b+u)<0
b(a+i,b+u)=0
EndIf
EndIf

If nn=4
r=r(a+i,b+u)
v=v(a+i,b+u)
d=b(a+i,b+u)
z=(r+v+d)/3
If r>z
r(a+i,b+u)-1
If r(a+i,b+u)<0
r(a+i,b+u)=0
EndIf
EndIf
If r<z
r(a+i,b+u)+1
If r(a+i,b+u)>255
r(a+i,b+u)=255
EndIf
EndIf
If v>z
v(a+i,b+u)-1
If v(a+i,b+u)<0
v(a+i,b+u)=0
EndIf
EndIf
If v<z
v(a+i,b+u)+1
If v(a+i,b+u)>255
v(a+i,b+u)=255
EndIf
EndIf
If d>z
b(a+i,b+u)-1
If b(a+i,b+u)<0
b(a+i,b+u)=0
EndIf
EndIf
If d<z
b(a+i,b+u)+1
If b(a+i,b+u)>255
b(a+i,b+u)=255
EndIf
EndIf
EndIf

EndIf
EndIf

Next
Next

EndIf
Next nn
Next n

ExamineKeyboard() : Until KeyboardPushed(#PB_Key_Escape): End

Restera t'il quelque chose de l'image ? :lol:
bombseb
Messages : 445
Inscription : jeu. 25/août/2005 22:59
Localisation : 974
Contact :

Message par bombseb »

hey mais c'est trop marrant votre truc !

c'est con chui au boulot je testerais ca ce soir :wink:
Répondre