PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Contamination

https://www.purebasic.fr/french/viewtopic.php?t=13746

Page 1 sur 1

Contamination

Publié : ven. 28/juin/2013 17:23
par SPH
Histoire de virus. Le virus rouge mange le vert, le vert mange le bleu, le bleu mange le jaune, et le jaune mange le rouge.
Pour l'instant, il n'y a pas de regle du jeu mais ca peux faire un jeu...
:mrgreen:

Code : Tout sélectionner

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Contamination
; SPH(2013)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

InitSprite() 
InitKeyboard() 
InitMouse()

If ExamineDesktops()
  scr_w = DesktopWidth(0)
  scr_h = DesktopHeight(0)
  OpenScreen(scr_w,scr_h,32,"");   OpenWindowedScreen(WindowID(window),0,0,sWidth,sHeight,1,0,0,#PB_Screen_SmartSynchronization)
Else
MessageRequester("Erreur", "OpenScreen impossible")
End
EndIf 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
i=1
For u=1 To 5
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
If u=1
  rgb=RGB(255,0,0)
ElseIf u=2
  rgb=RGB(0,255,0)
ElseIf u=3
  rgb=RGB(0,0,255)
ElseIf u=4
  rgb=RGB(255,255,0)
ElseIf u=5
  rgb=RGB(255,255,255)
EndIf
Circle(40,40,40,rgb)
StopDrawing()
i+1
Next

CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,0,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(0,255,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(0,255,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(0,0,255))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(0,0,255))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,255,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,255,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,0,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1

CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,0,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(0,0,255))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(0,255,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,255,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(0,0,255))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,255,255))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,255,255))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(0,255,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,0,0))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,255,255))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
CreateSprite(i,81,81)
StartDrawing(SpriteOutput(i))
Circle(40,40,40,RGB(30,30,30))
Circle(40,40,37,RGB(255,255,255))
Box(0,39,80,2,RGB(30,30,30))
FillArea(40,20,-1,RGB(255,255,0))
Box(38,0,4,4,RGB(0,0,0))
Box(38,78,4,4,RGB(0,0,0))
StopDrawing()
i+1
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Dim p(scr_h,scr_w)
Dim p2(scr_h,scr_w)

For i=0 To scr_w/2-1
For u=0 To scr_h/2-1  
p(u,i)=RGB(0,0,255)  
p2(u,i)=RGB(0,0,25+Random(230))  
Next
Next

For i=scr_w/2 To scr_w-1
For u=0 To scr_h/2-1  
p(u,i)=RGB(0,255,0)  
p2(u,i)=RGB(0,25+Random(230),0)  
Next
Next

For i=0 To scr_w/2-1
For u=scr_h/2 To scr_h-1  
  p(u,i)=RGB(0,255,255)  
  x=25+Random(230)
  p2(u,i)=RGB(0,x,x)  
Next
Next

For i=scr_w/2 To scr_w-1
For u=scr_h/2 To scr_h-1  
p(u,i)=RGB(255,0,0)  
p2(u,i)=RGB(25+Random(230),0,0)  
Next
Next

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Dim s(4)
For i=0 To 4
  s(i)=Random(12)+1
Next
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Repeat
;contamination
For nb=1 To 10000
i=Random(scr_w-2)+1
u=Random(scr_h-2)+1
c=p(u,i)
;
If c=RGB(255,255,255)
d=RGB(0,0,255)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
p(u,i)=d
p2(u,i)=RGB(0,0,25+Random(230))  
EndIf
d=RGB(0,255,0)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
  p(u,i)=d
  p2(u,i)=RGB(0,25+Random(230),0)  
EndIf
d=RGB(255,0,0)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
p(u,i)=d
p2(u,i)=RGB(25+Random(230),0,0)  
EndIf
d=RGB(0,255,255)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
p(u,i)=d
  x=25+Random(230)
  p2(u,i)=RGB(0,x,x)  
EndIf
EndIf
;;;;;;;;;;;
;;;;;;;;;;;
If c=RGB(0,255,0)
d=RGB(0,0,255)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
  p(u,i)=d
  p2(u,i)=RGB(0,0,25+Random(230))  
Else
p2(u,i)=RGB(0,25+Random(230),0) 
EndIf
EndIf
;
If c=RGB(255,0,0)
d=RGB(0,255,0)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
p(u,i)=d
  p2(u,i)=RGB(0,25+Random(230),0)  
Else
p2(u,i)=RGB(25+Random(230),0,0) 
EndIf
EndIf
;
If c=RGB(0,255,255)
d=RGB(255,0,0)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
p(u,i)=d
  p2(u,i)=RGB(25+Random(230),0,0)  
Else
  x=25+Random(230)  
p2(u,i)=RGB(0,x,x) 
EndIf
EndIf
;
If c=RGB(0,0,255)
d=RGB(0,255,255)
If p(u-1,i)=d Or p(u+1,i)=d Or p(u,i-1)=d Or p(u,i+1)=d Or p(u-1,i-1)=d Or p(u+1,i-1)=d Or p(u-1,i+1)=d Or p(u+1,i+1)=d
  p(u,i)=d
x=25+Random(230)  
p2(u,i)=RGB(0,x,x) 
Else
p2(u,i)=RGB(0,0,25+Random(230)) 
EndIf
EndIf
;
;
Next

ExamineMouse() 
mx=MouseX()
my=MouseY()
mkey=MouseButton(1)
;;;;; tracage
StartDrawing(ScreenOutput())
MemVideo = DrawingBuffer() 
For u=0 To scr_h-1
CopyMemory(@p2(u,0), MemVideo+DrawingBufferPitch()*u,scr_w*4)
Next
StopDrawing() 

DisplayTransparentSprite(s(0),mx-40,my-40) 
If mkey_old=1
  mkey_old=2
EndIf

If mkey<>0 And mkey_old=0
  mkey_old=1
DisplaySprite(s(0),mx-40,my-40) 
StartDrawing(ScreenOutput())
  For i=-40 To 40
    For u=-40 To 40
      If mx+i>=0 And mx+i<=scr_w-1 And my+u>=0 And my+u<=scr_h-1
        c=Point(mx+i,my+u)
        If c<>0
          If c=RGB(0,0,255)
            c=RGB(255,0,0)
          ElseIf c=RGB(255,0,0)
            c=RGB(0,0,255)
          ElseIf c=RGB(255,255,0)
            c=RGB(0,255,255)
          EndIf
        p(my+u,mx+i)=c
        p2(my+u,mx+i)=c
      EndIf
      EndIf
    Next
  Next
StopDrawing() 
s(0)=s(1)
s(1)=s(2)
s(2)=s(3)
s(3)=s(4)
s(4)=Random(12)+1
EndIf
If mkey=0
  mkey_old=0
EndIf


DisplayTransparentSprite(s(1),scr_w-110,scr_h-110)
DisplayTransparentSprite(s(2),scr_w-110,scr_h-220)
DisplayTransparentSprite(s(3),scr_w-110,scr_h-330)
DisplayTransparentSprite(s(4),scr_w-110,scr_h-440)

If mkey_old<>1
  FlipBuffers() 
EndIf

;;;;;;;;;;;;;;

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

Re: Contamination

Publié : ven. 28/juin/2013 18:14
par Huitbit
SPH a écrit :Histoire de virus. Le virus rouge mange le vert, le vert mange le bleu, le bleu mange le jaune, et le jaune mange le rouge.
Pour l'instant, il n'y a pas de regle du jeu mais ca peux faire un jeu...
:mrgreen:
Ou un écran de veille !
En tout cas, c'est original !

Ciao

Re: Contamination

Publié : dim. 30/juin/2013 14:40
par Kwai chang caine
Joli....et dans l'air du temps...on dirait Windows 8 et ses tuiles :D
En espérant que les vrais ne feront pas comme ça :mrgreen:

Re: Contamination

Publié : lun. 01/juil./2013 9:12
par kelebrindae
Idée originale, effectivement; Très sympa!

Re: Contamination

Publié : sam. 06/juil./2013 20:38
par SPH
Code mis a jour : la, on dirait des virus grouillants :wink:
Fuseau horaire sur UTC+01:00
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru