Compétition PurePunch Numéro 2

[djes]

Août 2009

La compétition est terminée.

Archive de la 2ème compétition PureBasic PurePunch

Le vote a donné Hades comme vainqueur, avec 10 points, pour son impressionnant micro-raytracer ; il est suivi par MrVain avec 7 points, pour sa démo style oldschool, et par RocketRider et son PureStrudel (5 points). Le tout sur un total de 35 points.

Je crois ne pas avoir été le seul à être vraiment épaté par la qualité et le niveau de certaines des réalisations présentées. On peut dire que beaucoup se sont surpassés!

Merci à tous les compétiteurs!

Sera-t-il possible de faire mieux pour la prochaine compétition?


------------------------------------------------------------


Juin 2009

Voici la seconde Compétition PurePunch!

Les règles ont changé :

• 1° Le programme sera fait en Purebasic 4.30.
  2° Le source du programme n'aura qu'au maximum 10 lignes de 80 caractères par line
  3° Vous n'aurez qu'un mois pour créer un bon utilitaire, un effet, ou quoi que ce soit d'autre!

A la fin de cette période, un vote sera mis en place afin de voter pour le meilleur code. Faites de votre mieux et ce sera le vôtre!

Poster le code dans le forum anglais si possible : http://www.purebasic.fr/english/viewtopic.php?t=37609 après y avoir ajouté et complété l'entête suivant :

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  
;* Author : 
;* Date   : 
;* Notes  :
;*
;*****************************************************************************

Bonne chance à tous les compétiteurs!

[Anonyme]

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Automatic Pong
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit ( not tested on windows but linux )
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(640,480,32,""):Bx.d=320:By.d=240:Bd.b=4
Macro M:Macro:EndMacro:M I:If:EndMacro:M EI:EndIf:EndMacro:M A:And:EndMacro:
M clsw:W=255:EndMacro:M C:Case:EndMacro:H=$FFFFFF:Dy=240:Gy=240:Repeat:Gy=By
ExamineKeyboard():W-1:I W<0:W=0:EI:Select Bd:C 1:Bx+0.5:By+0.5:C 2:Bx-0.5:
By+0.5:C 3:Bx-0.5:By-0.5:C 4:Bx+0.5:By-0.5:EndSelect:I By>476 A Bd=1:Bd=4:
clsw:EI:I By<4 A Bd=4:Bd=1:clsw:EI:I By>476 A Bd=2:Bd=3:clsw:EI:I By<4 A Bd=3:
Bd=2:clsw:EI:I Bx<20 A Bd=2:Bd=1:clsw:EI:I Bx<20 A Bd=3:Bd=4:clsw:EI:Dy=By
I Bx>610 A Bd=1:Bd=2:clsw:EI:I Bx>610 A Bd=4:Bd=3:clsw:EI:O=ScreenOutput()
StartDrawing(O):Circle(Bx,By,4,H):Box(10,Gy-32,10,64,H):Box(610,Dy-32,10,64,H)
StopDrawing():FlipBuffers(2):ClearScreen(RGB(W,W,W)):Until KeyboardInkey()

[Anonyme]

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Black Hole
;* Author : Cpl.Bator
;* Date   : 1/06/2009
;* Notes  : Press any key to quit , tested on Linux
;*
;***************************************************************************** 
InitSprite():InitKeyboard():OpenScreen(1024,768,32,"")
Repeat:ExamineKeyboard():StartDrawing(ScreenOutput())
TM = ElapsedMilliseconds():L.d=1024+512*Cos(TM/500):For S = 1 To 20
T.d=(1024+L)/S : C = (S*255)/20: X.d=(S*2)*Cos(TM/1250): Y.d=(S*4)*Sin(TM/550)
Circle((512+X),(384+Y),T,RGB(0,0,255-C)):Next :StopDrawing():FlipBuffers(2)
Until KeyboardInkey()

[tonton]

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* nom   : Pompage
;* Auteur : Tonton 
;* Date   : 1/06/2009 
;* commentaire  : bouges la souris
;* 
;*********************************************************************
#CameraSpeed=15:IncludeFile "Screen3DRequester.pb":Define.f KeyX,KeyY,MouseX
Define.f MouseY:InitEngine3D():Add3DArchive("Data\",#PB_3DArchive_FileSystem)
Add3DArchive("Data\Skybox.zip", #PB_3DArchive_Zip):InitSprite():InitKeyboard()
InitMouse():Screen3DRequester():CreateMaterial(0,LoadTexture(0,"r2skin.jpg"))
CreateEntity(0,LoadMesh(0,"Robot.mesh"),MaterialID(0)):SkyBox("desert07.jpg")
CreateCamera(0,0,0,100,100):CameraLocate(0,0,0,100):Repeat:Screen3DEvents()
ExamineMouse():MouseX =-(MouseDeltaX()/10)*#CameraSpeed/2
MouseY =-(MouseDeltaY()/10)*#CameraSpeed/2:RotateCamera(0,MouseX,MouseY, RollZ)
MoveCamera(0,KeyX,0,KeyY):RenderWorld():Screen3DStats():FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape):End

[Ollivier]

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Crazy waves
;* Author : Ollivier
;* Date   : 02/06/09
;* Notes  : Cf http://www.purebasic.fr/french/viewtopic.php?t=9437 
;*
;***************************************************************************** 
Q=600:Dim SX.F(Q):Dim SY.F(Q):Dim SA.F(Q):Dim SR.F(Q):#Z=4:Dim SV.F(Q)
InitSprite():#N=3:InitMouse():#B=2:ExamineDesktops():DW=DesktopWidth(0)
DH=DesktopHeight(0):OpenScreen(DW,DH,DesktopDepth(0),""):CreateSprite(0,DW,DH)
CreateSprite(1,#Z,#Z):StartDrawing(SpriteOutput(1)):Box(0, 0, #Z, #Z,#White)
StopDrawing():X.F=SX(0):Y.F=SY(0):For CA=0 To Q:SX(CA)=DW/2:SY(CA)=DH/2
SA(CA)=Random(628)/100:SV(CA)=Random(800)/100:Next CA:Repeat:Delay(1)
ExamineMouse():FlipBuffers():DisplaySprite(0,0,0):For I=0 To Q:X=SX(I):Y=SY(I)
DisplaySprite(1,X,Y):DX.F=(4999*X+DW/2)/5000:DY.F=(4999*Y+DH/2)/5000 
V.F=Sqr(DX*DX+DY*DY):VS.F=SV(I)*(100/V):SX(I)=DX+(Cos(SA(I))*VS):SR(I)+0.0001
SY(I)=DY-(Sin(SA(I))*VS):SA(I)+Sin(SR(I))*(10/V):Next:Until MouseButton(2)

[Anonyme]

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : Bump-Mapping 640x480
;* Author : Cpl.Bator
;* Date   : 2/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
Macro R:For:EndMacro:Macro T:Next:EndMacro:S=512:W=640:H=480:W2=320:H2=240
Macro N:EndIf:EndMacro:InitSprite():OpenScreen(W,H,32,""):Dim L(S,S):g=64
R y=0 To S:R x=0 To S:Nxl.f=(x-(S/2))/(S/4):Nyl.f=(y-(S/2))/(S/4):Nzl.f:v.f
Nzl=1-Sqr((Nxl*Nxl)+(Nyl*Nyl)):If Nzl<=0:Nzl=0:N:L(x,y)=(200 * NZl):T x:T y
Dim B(1000,1000):R i = 0 To 79:R y= 0 To 63:R x= 0 To 63:C=(x*256/g)!(y*256/g)
B(x+dx,y+dy)=RGB(C,C,C):T:T:dx+g:If dx=W:dx=0:dy+g:N:T:Repeat:ClearScreen(0)
v+0.1:LX.f=W2+160*Cos(v):LY.f=H2+120*Sin(v/2):StartDrawing(ScreenOutput())
R y=1 To 479:R x=1 To 639:NX=(B(x+1,y)-B(x-1,y)):NY=(B(x,y+1)-B(x,y-1))
NLX.f=X-LX:NLY.f=Y-LY:NX=(NX+NLX)+(S/2):NY=(NY+NLY)+(S/2):NX%512:NY%512
C=L(NX,NY)<<8:Plot(x,y,C):T x:T y:StopDrawing():FlipBuffers(2):Until v>50

Hades à mis la barre haut avec son raytracer , surtout que j'aurais du y penser , voilà de quoi me remonté

[tonton]

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Nom   : lancé de rayons
;* Auteur : Tonton 
;* Date   : 02/06/2009 
;* Notes  : En deux lignes
;* 
;***************************************************************************** 
s.s="http://www.vincentlefort.com/projets/raytrace/raytrace_1.png"
#Http :ShellExecute_(GetDesktopWindow_(),"open",s.s,0,0,#SW_SHOWNORMAL) 

[Anonyme]

du raycasting , peut on me dire si sa tourne sous zindozs ?

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : RayCasting 640x480
;* Author : Cpl.Bator
;* Date   : 3/06/2009
;* Notes  : Tested on linux , program quit automatically
;*
;***************************************************************************** 
w=1024:x=360:px=9*w:py=11*w:st=5:he=0:tr=1:Fc=$FFFFFF:Macro rnd(v):Random(v);##
EndMacro:Macro ef:EndIf:EndMacro:Dim L(20,20):For c=0 To 11:L(C,12)=rnd(Fc);###
b=540:L(C,0)=rnd(Fc):L(12,C)=rnd(Fc):L(0,C)=rnd(Fc):L(rnd(11),rnd(11))=rnd(Fc);
Next:Dim t(b):For i=0 To b:t(i) = (Cos((i*0.0174))*w)/10:Next:InitSprite():u=91
OpenScreen(640,480,32,""):Repeat:x1=0:y1=0:x2=0:y2=0:tm+1:q=100:If t<tm:t=tm+10
he=(he+tr)%x:ef:StartDrawing(ScreenOutput()):gl=he-44%x:If gl<0:gl=gl+x:ef;####
For a=gl To gl+89:xx=px:yy=py:tx=t(a+u):ty=t(a+1):l=0:While 1:xx=xx-tx:yy=yy-ty
l=l+1:O=(xx/w)%12:Li=(yy/w)%12:If L(Li,O)!0:Break:ef:Wend:h=900/l:y1=q-h:y2=q+h
x2=x1+3:Box(x1*2,y1*2,12,h*6,L(Li,O)):x1 = x2+1:Next:StopDrawing();############
FlipBuffers(2):ClearScreen(0):Until tm>10000;##################################

[Anonyme]

ça rame mais ça marche
par contre pas de moyen de sortir du prg ?

;* Notes : Tested on linux , program quit automatically

Merci , difficile d'optimiser avec 800 caractères de code


sinon en 320x240 pixels :

Code : Tout sélectionner

w=1024:x=360:px=9*w:py=11*w:st=5:he=0:tr=1:Fc=$FFFFFF:Macro rnd(v):Random(v);##
EndMacro:Macro ef:EndIf:EndMacro:Dim L(20,20):For c=0 To 11:L(C,12)=rnd(Fc);###
b=540:L(C,0)=rnd(Fc):L(12,C)=rnd(Fc):L(0,C)=rnd(Fc):L(rnd(11),rnd(11))=rnd(Fc);
Next:Dim t(b):For i=0 To b:t(i) = (Cos((i*0.0174))*w)/10:Next:InitSprite():u=91
OpenScreen(320,240,32,""):Repeat:x1=0:y1=0:x2=0:y2=0:tm+1:q=100:If t<tm:t=tm+10
he=(he+tr)%x:ef:StartDrawing(ScreenOutput()):gl=he-44%x:If gl<0:gl=gl+x:ef;####
For a=gl To gl+89:xx=px:yy=py:tx=t(a+u):ty=t(a+1):l=0:While 1:xx=xx-tx:yy=yy-ty
l=l+1:O=(xx/w)%12:Li=(yy/w)%12:If L(Li,O)!0:Break:ef:Wend:h=900/l:y1=q-h:y2=q+h
x2=x1+3:Box(x1,y1,6,h*3,L(Li,O)):x1 = x2+1:Next:StopDrawing();############
FlipBuffers(2):ClearScreen(0):Until tm>5000;###################################

allasktulu , merci

[Ollivier]

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name : Pure Punch Pink Ghost
;* Author : Ollivier
;* Date : 05.06.09
;* Notes : Add DIRECTX9 option in compiler options if problem
;*
;*****************************************************************************
a.F:Macro P(C):Particle#C:EndMacro:UsePNGImageEncoder():InitEngine3D():v.F
InitSprite():InitKeyboard():Add3DArchive("\",0):OpenScreen(1024,768,32,"")
CreateImage(1,256,256):StartDrawing(ImageOutput(1)):For i=0 To 127:c=i*i*i/7850
Circle(128,128,127-i,RGB(c,c,c)):Next:StopDrawing():SaveImage(1,"PP",$474E50)
LoadTexture(0,"PP"):CreateMaterial(0,TextureID(0)):DisableMaterialLighting(0,1)
MaterialBlendingMode(0,1):Create#P(Emitter)(0,10,1,1,0):P(EmissionRate)(0,100);
P(Size)(0,256,256):P(Material)(0,MaterialID(0)):P(TimeToLive)(0,2,8)
P(Velocity)(0,1,300):F=100:P(ColorRange)(0,$FF0000,$FF):CreateCamera(0,0,0,F,F)
CameraLocate(0,0,0,2000):Repeat:P(EmitterDirection)(0,Cos(a),Sin(a),0):a+1.246
FlipBuffers():ExamineKeyboard():RenderWorld():Until KeyboardPushed(1)

[TazNormand]

Ma contribution :

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Screen Wave
;* Author : TazNormand
;* Date   : 05 June 2009
;* Notes  :
;*
;***************************************************************************** 

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():y=-256
InitKeyboard():i=CreateImage(0,w,h) :hDC=StartDrawing(ImageOutput(0))
Ddc=GetDC_(GetDesktopWindow_()):BitBlt_(hDC,0,0,w,h,DDC,0,0,#SRCCOPY)
StopDrawing() :ReleaseDC_(GetDesktopWindow_(),DDC):OpenScreen(w,h,32,"")
CreateSprite(0,w,h):StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h)
StopDrawing():Repeat:ExamineKeyboard():x=(Sin((y)/w*#PI*4)*128)+10
ClipSprite(0,0,y,w,256):DisplaySprite(0,x,y):FlipBuffers():ClearScreen(0):y=y+4
If y=h+32:y=-256:EndIf:Until KeyboardPushed(#PB_Key_Escape):End

[TazNormand]

Un autre essai basé sur le code d'avant :

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Agitated Desktop
;* Author : TazNormand
;* Date   : 05 June 2009
;* Notes  : Appel d'API, ne devrait pas marcher sur Mac/linux/Amiga et Version Démo
;*
;*****************************************************************************


ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite()
InitSprite3D():InitKeyboard():i=CreateImage(0,w,h):sy=4:x=0:y=0:sx=8
hdc=StartDrawing(ImageOutput(0)):Ddc=GetDC_(GetDesktopWindow_())
BitBlt_(hdc,0,0,w,h,Ddc,0,0,#SRCCOPY):StopDrawing()
ReleaseDC_(GetDesktopWindow_(),Ddc):OpenScreen(w,h,32,""):CreateSprite(0,w,h,4)
StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h):StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,w/1.2,h/1.2):Repeat:ExamineKeyboard()
If x<0 Or x>w-(w/1.2):sx*-1:EndIf:If y<0 Or y>h-(h/1.2):sy*-1:EndIf:x+sx:y+sy
Start3D():DisplaySprite3D(0,x,y):Stop3D():FlipBuffers():ClearScreen(0)
Until KeyboardPushed(#PB_Key_Escape):End

[zaphod]

c'est pas fabuleux... une simple fractale...
pour participer.

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Name   :Fractale
;* Author : Z@ph0d
;* Date   : 07/06/09
;* Notes  : 
;* 
;***************************************************************************** 

Procedure f(x.f,y.f,l.f,a.f)
 Protected ll.f, aa.f, l4.f , s.f, c.f
If l>1:f(x,y,l/4,a):aa=a:l4=l/4:s=Sin(a):c=Cos(a):x+s*l4:y+c*l4:a-#PI/2
f(x,y,l4,a):x+Sin(a)*l4:y+Cos(a)*l4:a+#PI/2+#PI/4:ll=l/2*Sqr(2)
f(x,y,ll,a):x+Sin(a)*ll:y+Cos(a)*ll
f(x,y,l4,a-#PI/1.33):f(x + Sin(a-#PI/1.33)*l4,y+Cos(a-#PI/1.33)*l4,l4,aa)
Else:StartDrawing(WindowOutput(0)):Plot(x,y,#Blue):StopDrawing():EndIf
EndProcedure
If OpenWindow(0,10,10,800,500,"Fractale",13107200|1|12582912)
f(10,250,750,#PI/2):Repeat:EventID=WaitWindowEvent():Until EventID=16:EndIf

Z@ph0d//

[TazNormand]

Bon, je continue avec mes copies de Desktop.

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   :  Ouch !!!
;* Author : TazNormand
;* Date   : 07 June 2009
;* Notes  : Appel d'API, ne devrait pas marcher sur Mac/linux/Amiga et Version Démo
;*
;*****************************************************************************

ExamineDesktops():w=DesktopWidth(0):h=DesktopHeight(0):InitSprite():sx=0:p=8
InitSprite3D():InitKeyboard():i=CreateImage(0,w,h):sy=0:r=32:x=(w-(w/r))/2
hc=StartDrawing(ImageOutput(0)):d=GetDC_(GetDesktopWindow_()):y=(h-(h/r))/2
BitBlt_(hc,0,0,w,h,d,0,0,#SRCCOPY):StopDrawing():
ReleaseDC_(GetDesktopWindow_(),d):OpenScreen(w,h,32,""):CreateSprite(0,w,h,4)
StartDrawing(SpriteOutput(0)):DrawImage(i,0,0,w,h):StopDrawing()
CreateSprite3D(0,0):ZoomSprite3D(0,w/r,h/r):Repeat:ExamineKeyboard():Start3D()
DisplaySprite3D(0,x,y):Stop3D():r-1:If r>1:x=(w-(w/r))/2:y=(h-(h/r))/2
ZoomSprite3D(0,w/r,h/r):sy=y:sx=x:EndIf:If r<1:y=sy:sy+4:x=sx+p:p*-1:EndIf
FlipBuffers():ClearScreen(0):Until KeyboardPushed(#PB_Key_Escape) Or sy>w:End

[Huitbit]

Ma petite contribution vu que les jeux ont "un peu" été oubliés jusqu'à présent

Largement inspiré du livre "Jeux d'action "(pour MSX) écrit par Pierre Monsaut en 1985 et publié par Sybex

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* Name   :  Punch Blitz 
;* Author : Huitbit 
;* Date   : 10 June 2009 
;* Notes  : Old MSX code translated  ;) 
;* 
;***************************************************************************** 
Macro c(a,b):ConsoleLocate(a,b):EndMacro:*z=AllocateMemory(1920):OpenConsole() 
w=v:n.s="   ":EnableGraphicalConsole(1):a.s=" "+Chr(200)+Chr(205)+Chr(206) 
For i=12 To 28:For j=23 To Random(5)+14 Step -1:PokeC(*z+i+j*40,1):c(i,j) 
Print(Chr(178)):Next j:Next i:For y=0 To 23:For x=0 To 38:c(x,y):Print(a) 
If x<37:If Inkey()<>"" And v=0:u=x+1:v=y+1:EndIf:EndIf:If PeekC(*z+x+4+y*40) 
s=40*y+x:For i=y To 22:c(x+1,i):Print(n):c(x+1,i+1):Print(Right(a,3)) 
Delay(99):Next i:c(3,0):Print("SCORE : "+Str(s)):Input():End:EndIf:If v<>0 
If v>23:v=0:EndIf:PokeC(*z+u+w*40,0):c(u,v-1):Print(" "):w=v:If v:c(u,v) 
Print("*"):v=v+1:EndIf:EndIf:Delay(50):Next x:c(39,y):Print(n):Next y
c(3,0):Print("**MISSION ACCOMPLIE !**"):Input():End

Hasta la vista !

PS : Et dire qu'à l'époque, (j'avais 11 ans) les "peek" et les "poke" me cassaient les pieds !