Compétition PurePunch juillet-août 2014 : réalisez la meilleure application en 50 lignes de code

Le 1^er juillet 2014 à 11:27, par djes

31PARTAGES

~ 30 juin 2014 ~

Compétition PurePunch Juillet-Août 2014
Lien vers le sujet sur le forum officiel PureBasic français

Thème

Only 50 !
Montrez ce que vous savez faire avec PureBasic en 50 lignes de code seulement. Que ce soit un utilitaire, un jeu, une démo graphique en 3D, n'importe quoi qui montre vos capacités et celles du langage, repoussez les limites du possible !
Que le meilleur gagne !

Les lots & les sponsors

La société Goldoweb SL offre un kit complet Raspberry Pi au vainqueur ! Merci à lui !
Comme la dernière fois, Fantaisie Software et Fred sponsorisent la compétition. Il y a aura donc des prix pour la seconde et la troisième place ! A voir ici, prochainement.

Si vous aussi voulez sponsoriser, contactez-moi ! Cliquez ici pour voir les lots de la dernière compétition.

Les règles

Le programme sera fait en Purebasic version 5.22, soit en version complète, soit en version démo, les APIs sont autorisées mais pas l'ajout de bibliothèque utilisateur (userlib).
Le source du programme ne pourra comporter au maximum que 50 lignes de texte de 80 caractères max par ligne. Il est possible d'avoir fichiers texte, par exemple le code source PB, plus un fichier de données textuelles, un shader Ogre, un fichier de préférences, des données XML, etc. Mais les fichiers sont cumulatifs et les règles s'appliquent : l'ensemble des fichiers ne peut comporter que 50 lignes de texte, de 80 caractères maximum par ligne.
Etre original, c'est à dire soit être une création complète, soit apporter quelque chose de nouveau à un code existant.
Ne pas être néfaste.
Possibilité de joindre une (et une seule) image d'une taille maximale de 512 pixels de large sur 512 pixels de haut, en 32 bits. La poster sur le forum ou sur un site accessible durant toute la durée de la compétition, ou la joindre à l'archive complète du projet liée dans le post sur le forum.
Possibilité de joindre un fichier sonore (et un seul) d'une taille maximale de 1 Mo. Le poster sur un site accessible durant toute la durée de la compétition, ou le joindre à l'archive complète du projet liée dans le post sur le forum.
Il sera possible d'ajouter une ligne de code (non comptée) en début de source avertissant l'utilisateur d'une spécificité du programme (comme par exemple une attente ou la nécessité d'utiliser une bibliothèque sous-système particulière). Celle-ci devra être de la forme
Code : Sélectionner tout
```
MessageRequester("Information", "Message", #PB_MessageRequester_Ok)
```
Date et heure limite : 31 août 2014, 23h59
A la fin de la période, un fil pour le vote sera mis en place afin d'élire le meilleur programme. Seules les personnes inscrites sur le forum avant le 30 juin pourront voter (3 points pour le 1er, 2 points pour le second, 1 point pour le troisième). Les votants pourront télécharger et désigner leurs trois programmes favoris jusqu'au 14 septembre à 23h59. Après comptage et vérification, les vainqueurs seront contactés afin de recevoir leurs prix.

Comment poster

Postez le code dans le forum après y avoir ajouté et complété l'entête suivant (les lignes ne comptent pas dans les 50) :

Code :

Sélectionner tout

1
2
3
4
5
6
7
8
9
10
11
12
;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :  
;* Author   : 
;* Date     : 
;* Notes    :
;*
;*****************************************************************************

Bonne chance à tous les compétiteurs !

Une erreur dans cette actualité ? Signalez-nous-la !

Votre nom : Votre e-mail :

Décrivez l'erreur que vous souhaitez porter à notre connaissance :

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Where is the turtle
;* Author   : falsam   
;* Date     : Jul 02, 2014 - Update Jul 02, 2014
;* Notes    : Search and click on a turtle. A turtle found adds time and a tree.
;*
;*****************************************************************************
EnableExplicit
Structure x:s.i:x.i:y.i:a.i:EndStructure
Global fg,f1,f2,Dim m(12),NewList s.x(),ct,tf,ti,ns,li,i,ev,mr,ac=-1,bs,bo
Procedure f(w):Protected fc.b, mx, my
mx=WindowMouseX(w):my=WindowMouseY(w):MouseLocate(mx,my)
If mx>0 And mx<WindowWidth(w,1)-1 And my>0 And my<WindowHeight(w,1)-1
ReleaseMouse(0):fc=1:Else:fc=0:ReleaseMouse(1):EndIf
ProcedureReturn fc:EndProcedure
Procedure r(i,j):ProcedureReturn Random(i,j):EndProcedure
Procedure ps(f,p):SetSoundFrequency(0,f):SoundPan(0,p):PlaySound(0):EndProcedure
fg=LoadFont(-1,"Arial",20):f1=LoadFont(-1,"Arial",16)
f2=LoadFont(-1,"Arial",50,256)
InitSprite():InitKeyboard():InitMouse():InitSound():UsePNGImageDecoder()
OpenWindow(0,0,0,800,600,"Turtle",13107201):AddWindowTimer(0, 0, 1000)
OpenWindowedScreen(WindowID(0),0,0,800,600):LoadSound(0,"s.wav")
For i=0 To 12:m(i)=LoadSprite(-1,"s.png",8):ClipSprite(m(i),i*64,0,64,64):Next
ClipSprite(m(8),0,130,64,64):ClipSprite(m(9),65,130,64,64)
ClipSprite(m(10),129,130,64,64):ClipSprite(m(11),0,360,15,23)
ClipSprite(m(12),0,280,48,48)
Repeat:Repeat:ev=WindowEvent():If ev=13110 And ti>0:ti=ti-1:EndIf:
If ev=13116:End:EndIf:Until ev=0
FlipBuffers():ExamineKeyboard():ExamineMouse():ClearScreen($18D3D3D3) 
If ac=-1:ac=0:ct=10:ns=1:tf=0:ti=5:li=1:ps(44100,0):EndIf
If ns=1:ClearList(s()):For i=0 To ct:AddElement(s())
s()\s=m(r(7,0)):s()\x=r(692,64):s()\y=r(472,128):s()\a=r(255,128):Next
SelectElement(s(),0):s()\s=m(8):s()\x=r(448,128):s()\y=r(384,128):s()\a=255:ns=0
EndIf:ForEach s():DisplayTransparentSprite(s()\s,s()\x,s()\y,s()\a):Next
SelectElement(s(),0):DisplayTransparentSprite(m(12),380,540)
If f(0):DisplayTransparentSprite(m(11),MouseX(),MouseY()):EndIf
If MouseButton(1):If mr=0:mr=1
If SpriteCollision(m(11),MouseX(),MouseY(),m(12),380,540):ac=-1
ElseIf ac<>-2:If SpriteCollision(m(11),MouseX(),MouseY(),m(8),s()\x,s()\y)
tf+1:ps(r(50000,10000),r(300,100)-200):ti+2:ns=1:ct+1
Else:ac=2:EndIf:EndIf:EndIf:Else:mr=0:EndIf
If tf>49 And bo=0:li+1:bo+1:EndIf:If tf>79 And bo=1:li+1:bo+1:EndIf
If ti=0 And ac<>-2 Or ac<>-1:ac=2:mr=0:EndIf   
If ac=2:If li>0:li-1:ac=0:s()\s=m(9)
Else:ti=0:ac=-2:ps(4700,0):s()\s=m(10):EndIf:EndIf
StartDrawing(ScreenOutput()):DrawingMode(1):DrawingFont(FontID(f2))
If ac=-2:RotateSprite(m(12),1,1):DrawText(200,280,"GAME OVER!",$18808080): EndIf
DrawingFont(FontID(fg)):DrawText(10, 10, "Where is the turtle",$000000)
DrawText(530,10,"Turtles: "+Str(tf)+"  Time: "+Str(ti),$000000)
DrawingFont(FontID(f1))
DrawText(20,560,"falsam - PurePunch Contest 2014",$000000)
DrawText(610,560,"Escape key : End",$000000)
StopDrawing():Until KeyboardPushed(1)

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22+
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :Importunate fly
;* Author   :kvitaliy
;* Date     :Jul 02, 2014
;* Notes    :Banish a fly from the screen the mouse pointer
;*
;*****************************************************************************
UseOGGSoundDecoder():UsePNGImageDecoder():ExamineDesktops()
w=DesktopWidth(0):h=DesktopHeight(0):x=Random(w-130):y=Random(h-130)
LoadImage(3,"fly.png"):GrabImage(3,1,0,0,76,64):GrabImage(3,0,76,0,76,64)
If InitSound():LoadSound(0, "fly.ogg"):PlaySound(0): EndIf:Delay(2000)
hl=OpenWindow(0,x,y,76,64,"", #PB_Window_BorderLess|#PB_Window_Invisible)
ImageGadget(3,0,0,76,64,ImageID(1)):DisableGadget(3,1)
SetWindowColor(0,RGB(1,1,1)):StickyWindow(0,1):AddWindowTimer(0,1,200)
SetWindowLongPtr_(hl, #GWL_EXSTYLE, GetWindowLongPtr_(hl,
#GWL_EXSTYLE) | #WS_EX_LAYERED | #WS_EX_TOOLWINDOW)
SetLayeredWindowAttributes_(WindowID(0), RGB(1,1,1), 0, #LWA_COLORKEY)
HideWindow(0, 0):Dim P.POINT(1)
Procedure.f Distance(x1,y1,x2,y2)
   ProcedureReturn Sqr( ((x2-x1)*(x2-x1))+((y2-y1)*(y2-y1)) )
EndProcedure
Repeat: Event = WaitWindowEvent(10)
GetCursorPos_(P(0)):If Distance(x,y,P(0)\x,P(0)\y) < 50
HideWindow(0, 1):PlaySound(0):HideWindow(0, 0):x=Random(w-130):y=Random(h-130)
Delay(2000):count + 1: If count>5: Break:EndIf
ResizeWindow(0,x,y,#PB_Ignore,#PB_Ignore):HideWindow(0, 0)       
EndIf
Select Event
Case #PB_Event_Timer
If vis:vis=0:SetGadgetState(3,ImageID(0)):Else:vis=1
SetGadgetState(3,ImageID(1)):EndIf
Case #PB_Event_CloseWindow ; Alt+F4 exit!
CloseWindow(0):Break:EndSelect:ForEver

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :Osmosis 
;* Author   : idle
;* Date     : 4/7/2014
;* Notes   :Your a tiny cell lost in the petri dish full of preditors: the trick is finding where you are before you loose
;*                :Arrow keys move you round, escape ends , R resets 
;*****************************************************************************
Structure ball:x.d:vx.d:y.d:vy.d:r.d:m.d:sprite.i:EndStructure:Global ri,bo
Global NewList bb.ball():Global Dim sp(12):Global *player.ball,st,time
Procedure CircleToCircle(*b.ball,*b1.ball):dx.d=*b\x-*b1\x:dy.d=*b\y-*b1\y
dist.d=Sqr(dx*dx+dy*dy):t.d=*b\r+*b1\r:If dist<t:fd.d=(dist-t)/dist:m0.d=*b\m
m1.d=*b1\m:x0.d=*b\x-*b\vx:x1.d=*b1\x-*b1\vx:y0.d=*b\y-*b\vy:y1.d=*b1\y-*b1\vy
dx=*b\x-*b1\x:dy=*b\y-*b1\y:nx.d=dx/t:ny.d=dy/t
p.d=(2*(x0*nx+y0*ny)-(x1*nx+y1*ny))/(m0+m1)*(1/(2*#PI)):dx=x0-(p*m1*nx)
dy=y0-(p*m1*ny):*b\vx=*b\x-dx:*b\vy=*b\y-dy:dx=x1+(p*m0*nx):dy=y1+(p*m0*ny)
*b1\vx=*b1\x-dx:*b1\vy=*b1\y-dy:ProcedureReturn 1:EndIf:EndProcedure
Procedure up():Protected dx.d,dy.d:ForEach bb():dx=(bb()\x-bb()\vx)
dy=(bb()\y-bb()\vy):bb()\vx=bb()\x:bb()\vy=bb()\y:bb()\x+dx:bb()\y+dy
If bb()\x-bb()\r<0:bb()\vx=0+bb()\r:bb()\x=bb()\vx:bb()\x-dx
ElseIf bb()\x+bb()\r>ri:bb()\vx=ri-bb()\r:bb()\x=bb()\vx:bb()\x-dx:EndIf
If bb()\y-bb()\r<=0:bb()\vy=0+bb()\r:bb()\y=bb()\vy:bb()\y-dy
ElseIf bb()\y+bb()\r>=bo:bb()\vy=bo-bb()\r:bb()\y=bb()\vy:bb()\y-dy:EndIf:Next
EndProcedure:Procedure Reset():ClearList(bb()):For a=1 To 100:AddElement(bb())
If a=1:r=18:*player=@bb():Else:r=Random(20,3):EndIf:vx.d=(-1+Random(2))*0.5
vy.d=(-1+Random(2))*0.5 : bb()\x=Random(ri-r,r):bb()\y=Random(bo-r,r)
bb()\vx=bb()\x+vx:bb()\vy=bb()\y+vy:bb()\r=r:bb()\m=#PI*r*r:s=Random(1,0)
If a=1:s=3:EndIf:bb()\sprite=sp(s):Next:st=ElapsedMilliseconds():time=0
EndProcedure:Procedure RunWorld():Protected*bt.ball,ft.d,su.d,ag.d
Repeat:Repeat:EV=WindowEvent():If EV=#PB_Event_CloseWindow:End:EndIf:ag+0.1   
Until EV=0:FirstElement(bb()):ExamineKeyboard():If KeyboardPushed(#PB_Key_Up)
bb()\y-0.01:bb()\m-1:ElseIf KeyboardPushed(#PB_Key_Down):bb()\y+0.01
bb()\m-1:EndIf:If KeyboardPushed(#PB_Key_Left):bb()\x-0.01:bb()\m-1
ElseIf KeyboardPushed(#PB_Key_Right):bb()\x+0.01:bb()\m-1
ElseIf KeyboardInkey()="r":Reset():EndIf:For a=1 To 5:up():ForEach bb()
*bt=@bb():While NextElement(bb()):r= CircleToCircle(@bb(),*bt):If r
If bb()\r>=*bt\r
bb()\m+2:*bt\m-2:Else:*bt\m+2:bb()\m-2:EndIf:bb()\r=Sqr(bb()\m/#PI)
*bt\r=Sqr(*bt\m/#PI):EndIf:Wend:ChangeCurrentElement(bb(),*bt):Next:Next
ClearScreen(0):ZoomSprite(sp(12),ri*2,ri*2):RotateSprite(sp(12),ag,0)
DisplayTransparentSprite(sp(12),0-ri/2,0-ri/2):su=-*player\m:ForEach bb()
r=bb()\r:If bb()\m>0:su+bb()\m:ZoomSprite(bb()\sprite,bb()\r*2,bb()\r*2)
RotateSprite(sp(2),bb()\x-bb()\vx,1):ZoomSprite(sp(2),bb()\r*1.8,bb()\r*1.8)
rt=bb()\r*0.9:DisplayTransparentSprite(sp(2),bb()\x-rt,bb()\y-rt,127)   
DisplayTransparentSprite(bb()\sprite,bb()\x-bb()\r,bb()\y-bb()\r,127)   
Else: If *player=@bb():If Not time:time=(ElapsedMilliseconds()-st)/1000 
MessageRequester("osmosis","You got absorbed IN "+Str(time)+" seconds")
EndIf:Else:DeleteElement(bb()):EndIf:EndIf:Next:If *player\m>su:If Not time
time=(ElapsedMilliseconds()-st)/1000
MessageRequester("osmosis","You became the largest In "+Str(time)+" seconds")
EndIf:EndIf:FlipBuffers():Until  KeyboardPushed(#PB_Key_Escape):EndProcedure   
InitSprite():InitKeyboard():UsePNGImageDecoder():ri=800:bo=600
OpenWindow(0,0,0,ri,bo,"Osmosis"):OpenWindowedScreen(WindowID(0),0,0,ri,bo)
For a=0 To 3:sp(a)=LoadSprite(-1,"osmosis.png",8)
ClipSprite(sp(a),a*128,0,128,128):Next
sp(12)=LoadSprite(-1,"osmosis.png")
ClipSprite(sp(12),0,128,512,384):reset():RunWorld()

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Interference Circles
;* Author   : TazNormand
;* Date     : 04 July 2014
;* Notes    : largely inspired by "va!n aka 'thorsten will" thanks to him
;*
;*****************************************************************************
Macro dts:DisplayTransparentSprite:EndMacro
Macro tsc:TransparentSpritecolor:EndMacro:Macro cr:circle:EndMacro
InitSprite():InitKeyboard():ExamineDesktops()
dw=DesktopWidth(0):dh=DesktopHeight(0):posx=dw+100:cl=1
OpenScreen(dw,dh,32,"Exampe by va!n aka 'Thorsten Will' in 2007")
CreateSprite(0,Int(dw*1.6),Int(dh*1.6),#PB_Sprite_AlphaBlending)
CreateSprite(1,Int(dw*1.6),Int(dh*1.6),#PB_Sprite_AlphaBlending)
CreateSprite(2,500,64,#PB_Sprite_AlphaBlending)
fntid=LoadFont(1, "Arial", 24)
StartDrawing(SpriteOutput(2))
  DrawingFont(fntid)
  DrawText(0,0,"PurePunch Contest Summer 2014!!!",RGBA(128,255,128,0))
StopDrawing()
For ls = 0 To 1
  StartDrawing(SpriteOutput(ls)) 
  For i = 0 To dw*1.6 Step 24:cl!1
    If ls=0
      cr((dw*1.6)/2,(dh*1.6)/2,(dw*1.6)-i,RGB((i/(dw*1.6)*255)*cl,0,0))
    EndIf
    If ls=1
      cr((dw*1.6)/2,(dh*1.6)/2, (dw*1.6)-i, RGB(0,0,(i/(dw*1.6)*255)*cl))
    EndIf
  Next
  StopDrawing()
Next
Repeat
  ClearScreen(0)
  ExamineKeyboard()
  tsc(0,0):Tsc(1,0):tsc(2,0):
  dts(0,(((dw*1.6)-dw)/-2)+Cos(m2.d)*150, (((dh*1.6)-dh)/-2)+Sin(m.d)*50)
  dts(1,(((dw*1.6)-dw)/-2)+Sin(m.d)*50, (((dh*1.6)-dh)/-2)+Cos(m.d)*50)
  dts(2,posx,512+Cos(m2.d)*150)
  posx-5
  If posx<-500:posx=dw+100:EndIf
  m.d  = m.d  + 0.07:m2.d = m2.d + 0.032
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Fluid Dynamics Game Engine
;* Author   : Graph100
;* Date     :   07/07/2014
;* Notes    : Made from reading Jos Stam's article
;*                     "Real-Time Fluid Dynamics for Games"
;*
;*******************************************************************************
Macro M:Macro:EndMacro:M E:End:End#M:M A1:Array:EndMacro;#######################
M N:Next:E#M:M F(i,j,k):For i=j To k:E#M:M St:Structure:E#M:M P:Procedure:E#M;##
M El:ElapsedMilliseconds():E#M:M Ti(a,s):a=AllocateMemory(SizeOf(s));###########
Initialize#St(a,s):EndMacro:Macro AO(o,f,a,b):Define.d x,y,s0,t0,s1,t1,t0u,t0v;#
t0u=s\t*f\m:t0v=s\t*f\m:i0=Round(o\x,0):j0=Round(o\y,0):i1=i0+1:j1=j0+1;########
s1=o\x-i0:s0=1-s1:t1=o\y-j0:t0=1-t1:o\u=t0u*(s0*(t0*a(i0,j0)+t1*a(i0,j1))+;#####
s1*(t0*a(i1,j0)+t1*a(i1,j1))):o\v=t0v*(s0*(t0*b(i0,j0)+t1*b(i0,j1))+s1*(t0*b(i1,
j0)+t1*b(i1,j1))):o\x=o\x+o\u:o\y=o\y+o\v:If o\x<1:o\x=1:E#If:If o\x>f\W:o\x=f\W
E#If:If o\y<1:o\y=1:E#If:If o\y>f\H:o\y=f\H:E#If:EndMacro:M AF(o,a,b,c,d);######
AddElement(o):o\x=a:o\y=b:o\u=c:o\v=d:o\g=Sqr(c*c+d*d):EndMacro:M AOb(o,a,b);###
AddElement(o):o\x=a:o\y=b:EndMacro:St t:A1 t.d(0,0):E#St:St Fl:a.d:W.l:H.l:e.l;#
f.l:m.d:*u.t:*v.t:*s.t:*t.t:E#St:St Ob:x.d:y.d:u.d:v.d:E#St:St Sv:x.l:y.l:u.d;##
v.d:g.d:E#St:St Sf:F.Fl:t.d:List O.Ob():List Sv.Sv():E#St:P BC(*o.Fl,Mo,;#######
A1 x.d(2)):If Mo=2:F(i,1,*o\W):x(i,0)=-x(i,1):x(i,*o\f)=-x(i,*o\H):N:Else:F(i,1,
*o\W):x(i,0)=x(i,1):x(i,*o\f)=x(i,*o\H):N:E#If:If Mo=1:F(i,1,*o\H):x(0,i)=-x(1,;
i):x(*o\e,i)=-x(*o\W,i):N:Else:F(i,1,*o\H):x(0,i)=x(1,i):x(*o\e,i)=x(*o\W,i):N;#
E#If:x(0,0)=(x(1,0)+x(0,1))/2:x(0,*o\f)=(x(1,*o\f)+x(0,*o\H))/2:x(*o\e,0)=(0+;##
x(*o\W,0)+x(*o\e,1))/2:x(*o\e,*o\f)=(x(*o\W,*o\f)+x(*o\e,*o\H))/2:E#P;##########
P LS(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),a.d,c.d):F(k,0,20):F(i,1,*o\W):F(j,1,*o\H);##
x(i,j)=(x0(i,j)+a*(x(i-1,j)+x(i+1,j)+x(i,j-1)+x(i,j+1)))/c:N:N:BC(*o,MO,x()):N;#
E#P:P AD(*o.Fl,A1 x.d(2),A1 s.d(2),t.d):F(i,0,*o\e):F(j,0,*o\f):x(i,j)=x(i,j)+;#
t.d*s(i,j):N:N:E#P:P Di(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),d.d,t.d):a.d=t*d**o\W**o\H
LS(*o,MO,x(),x0(),a,1+4*a):E#P:P Av(*o.Fl,MO,A1 d.d(2),A1 d0.d(2),A1 u.d(2),;###
A1 v.d(2),t.d):t0_u.d=t**o\m:t0_v.d=t**o\m:F(i,1,*o\W):F(j,1,*o\H):x.d=i+;######
-t0_u*u(i,j):y.d=j-t0_v*v(i,j):If x<0.5:x=0.5:E#If:If x>*o\W+0.5:x=*o\W+0.5:E#If
i0=Round(x,0):i1=i0+1:If y<0.5:y=0.5:E#If:If y>*o\H+0.5:y=*o\H+0.5:E#If:j0=0+;##
Round(y,0):j1=j0+1:s1.d=x-i0:s0.d=1-s1:t1.d=y-j0:t0.d=1-t1:d(i,j)=s0*(t0*d0(i0,;
j0)+t1*d0(i0,j1))+s1*(t0*d0(i1,j0)+t1*d0(i1,j1)):N:N:BC(*o,MO,d()):E#P;#########
P Pr(*o.Fl,A1 u.d(2),A1 v.d(2),A1 q.d(2),A1 dv.d(2)):F(i,1,*o\W):F(j,1,*o\H);###
dv(i,j)=-((u(i+1,j)-u(i-1,j)+v(i,j+1)-v(i,j-1))/*o\m)/2:q(i,j)=0:N:N:BC(*o,0,;##
dv()):BC(*o,0,q()):LS(*o,0,q(),dv(),1,4):F(i,1,*o\W):F(j,1,*o\H):u(i,j)=u(i,j)+;
-*o\W*(q(i+1,j)-q(i-1,j))/2:v(i,j)=v(i,j)-*o\H*(q(i,j+1)-q(i,j-1))/2:N:N:BC(*o,;
1,u()):BC(*o,2,v()):E#P:Define s.Sf:s\F\W=50:s\F\H=50:s\F\m=s\F\H:If s\F\W>s\F\H
s\F\m=s\F\W:EndIf:s\F\e=s\F\w+1:s\F\f=s\F\h+1:Ti(s\F\u,t):Ti(s\F\v,t):Ti(s\F\s,;
t):Ti(s\F\t,t):Dim s\F\u\t(s\F\e,s\F\f):Dim s\F\v\t(s\F\e,s\F\f);###############
Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f):AF(s\Sv(),25,25,50,10);#######
AOb(s\O(),20,20):OpenWindow(0,0,0,520,520,"",$C80001):CanvasGadget(0,0,0,520,;##
520,4):te=El:Repeat:Repeat:ev=WindowEvent():Until ev=0 Or ev=13116:s\t=(El+;####
-te)/1000:Delay(20):te=El:Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f);####
ForEach s\Sv():s\F\s\t(s\Sv()\x,s\Sv()\y)=s\Sv()\u:s\F\t\t(s\Sv()\x,s\Sv()\y)=0+
s\Sv()\v:N:AD(s\F,s\F\u\t(),s\F\s\t(),s\t):AD(s\F,s\F\v\t(),s\F\t\t(),s\t);#####
If s\F\a:Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Di(s\F,1,s\F\u\t(),s\F\s\t(),s\F\a,;#
s\t):Di(s\F,2,s\F\v\t(),s\F\t\t(),s\F\a,s\t):E#If:Pr(s\F,s\F\u\t(),s\F\v\t(),;##
s\F\s\t(),s\F\t\t()):Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Av(s\F,1,s\F\u\t(),;#####
s\F\s\t(),s\F\s\t(),s\F\t\t(),s\t):Av(s\F,2,s\F\v\t(),s\F\t\t(),s\F\s\t(),;#####
s\F\t\t(),s\t):Pr(s\F,s\F\u\t(),s\F\v\t(),s\F\s\t(),s\F\t\t()):ForEach s\O();###
AO(s\O(),s\F,s\F\u\t,s\F\v\t):N:StartDrawing(CanvasOutput(0)):Box(0,0,800,600,0)
F(i,0,s\F\e):For j=0 To s\F\f:LineXY(10*i,10*j,10*i+100*s\F\u\t(i,j),10*j+;#####
100*s\F\v\t(i,j),$FF):N:N:ForEach s\O():Circle(s\O()\x*10,s\O()\y*10,3,#Green):N
StopDrawing():Until ev=13116;########BY#GRAPH100#####PUREPUNCH#AOUT#2014########

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :   Mastermind
;* Author   :   cshw89
;* Date     :   13/07/14
;* Notes    :   You have ten attempts to crack the code. Duplicates are
;*              allowed. Click or drag the colors to the respective positions.
;*
;*******************************************************************************
Global Dim i(3):Global Dim r(3);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Global cs.s="$A0A0A0$0000FF$00D000$FF0000$00D0D0$0070D0$D000D0":Global lb,mx,my;
Procedure RC(ns=0):If StartDrawing(CanvasOutput(0)):DrawingMode(1);;;;;;;;;;;;;;
Box(0,400*ns,250,480-400*ns,$D0D0D0):For y=ns*10 To 10:For x=0 To 3;;;;;;;;;;;;;
Circle(x*40+20,y*40+20,15,Val(Mid(cs,i(x)*7+1,7))):Next:Next:For x=0 To 5;;;;;;;
Circle(x*30+15,460,10,Val(Mid(cs,x*7+8,7))):Next:Box(170,405,70,30,$A0A0A0);;;;;
DrawText(160+(90-TextWidth("OK"))/2,412,"OK",0):If lb>0;;;;;;;;;;;;;;;;;;;;;;;;;
Circle(mx,my,15,Val(Mid(cs,lb*7+1,7))):EndIf:StopDrawing():EndIf:EndProcedure;;;
Procedure AbsI(i.i):If i<0:i*-1:EndIf:ProcedureReturn i:EndProcedure;;;;;;;;;;;;
OpenWindow(0,0,0,250,480,"Mastermind",#PB_Window_SystemMenu|;;;;;;;;;;;;;;;;;;;;
#PB_Window_ScreenCentered):CanvasGadget(0,0,0,250,480):For i=0 To 3;;;;;;;;;;;;;
r(i)=Random(5)+1:Next:yy=0:lb=-2:RC();;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Repeat:e=WaitWindowEvent():If e=#PB_Event_Gadget:t=EventType():Macro ga(t);;;;;;
GetGadgetAttribute(0,t):EndMacro:mx=ga(#PB_Canvas_MouseX);;;;;;;;;;;;;;;;;;;;;;;
my=ga(#PB_Canvas_MouseY):b=-1:If mx<160 And my>=400 And my<440:b=mx/40;;;;;;;;;;
ElseIf mx<180 And my>=440 And my<480:b=mx/30+4:EndIf:Select t;;;;;;;;;;;;;;;;;;;
Case #PB_EventType_MouseMove;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
If (ga(#PB_Canvas_Buttons)&#PB_Canvas_LeftButton) And fin=0;;;;;;;;;;;;;;;;;;;;;
If lb=-2 And(AbsI(mx-lx)>1 Or AbsI(my-ly)>1):If b=-1:lb=-1:ElseIf b<4:lb=i(b);;;
i(b)=0:Else:lb=b-3:EndIf:EndIf:EndIf:Case #PB_EventType_LeftButtonDown:If fin=0;
lx=mx:ly=my:EndIf:Case #PB_EventType_LeftButtonUp:If lb>0 And b>=0 And b<4;;;;;;
i(b)=lb:EndIf:If lb=-2:If b>-1 And fin=0:If b<4:i(b)=0:Else:For k=0 To 3;;;;;;;;
If i(k)=0:i(k)=b-3:Break:EndIf:Next:EndIf:Else:If mx>=160 And my>=400 And my<440
If fin:For k=0 To 3:i(k)=0:r(k)=Random(5)+1:Next:fin=0:yy=0:RC():Else:ch=1;;;;;;
For k=0 To 3:If i(k)=0:ch=0:EndIf:Next:If ch:r=0:w=0:For i=0 To 3:If r(i)=i(i);;
i(i)*-1:r(i)*-1:r+1:EndIf:Next:For i=0 To 3:For k=0 To 3;;;;;;;;;;;;;;;;;;;;;;;;
If i<>k And i(k)>0 And r(i)=i(k):i(k)*-1:w+1:Break:EndIf:Next:Next;;;;;;;;;;;;;;
If StartDrawing(CanvasOutput(0)):For x=0 To 3:i(x)=AbsI(i(x)):r(x)=AbsI(r(x));;;
Circle(x*40+20,yy*40+20,15,Val(Mid(cs,i(x)*7+1,7))):i(x)=0:Next:x=170;;;;;;;;;;;
For i=0 To r-1:Box(x,yy*40+12,16,16,0):x+20:Next:For i=0 To w-1;;;;;;;;;;;;;;;;;
Box(x,yy*40+12,16,16,$FFFFFF):x+20:Next:StopDrawing():EndIf:yy+1:If r=4;;;;;;;;;
MessageRequester("Mastermind","You Win!"):fin=1:ElseIf yy=10:For x=0 To 3;;;;;;;
i(x)=r(x):Next:RC(1):MessageRequester("Mastermind","You Lose!"):fin=1:EndIf;;;;;
EndIf:EndIf:EndIf:EndIf:EndIf:lb=-2:EndSelect:If my<415:my=415:EndIf:RC(1);;;;;;
EndIf:Until e=#PB_Event_CloseWindow;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Superformula
;* Author   : NicTheQuick
;* Date     : 13.07.2014
;* Notes    : Only tested on PB 5.30 b7 on Linux x64!
;*            You can also resize the window.
;*
;*******************************************************************************
Macro j(a):St#a#Drawing(:EndMacro:#n=1000:Define.d x,y,ox,oy,fx,fy,t,p,a,b,c,d,
e,r:Global w=600,h=600,i,v,m,f,g:Macro z:Pow(Pow(Abs(Cos(m*r/4)/a),d)+Pow(Abs(0+
Sin(m*r/4)/b),e),-1/c):EndMacro:CreateImage(0,w,h):OpenWindow(0,0,0,w,h,"Super"+
"formel",#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget):CanvasGadget(0,0,
0,w,h):AddWindowTimer(0,0,10):Repeat:f=WindowWidth(0):g=WindowHeight(0):If f<>w+
0 Or g<>h:w=f:h=g:ResizeGadget(0,0,0,w,h):ResizeImage(0,w,h):EndIf:v=0+
WaitWindowEvent():t=ElapsedMilliseconds()/10000:If v=#PB_Event_Timer And 0+
EventTimer()=0:m=2+2*Int(t/0.5)%20:c=10+9*Sin(t*2):d=9+9*Sin(t*3):e=9+9*Sin(t*5)
a=Abs(Sin(t*7)*0.6)+0.1:b=Abs(Cos(t*11)*0.6)+0.1:j(art)ImageOutput(0))
DrawImage(GetGadgetAttribute(0,#PB_Canvas_Image),0,0):j(op)):j(art)0+
CanvasOutput(0)):x=150+100*Sin(t/1.1):DrawAlphaImage(ImageID(0),w*Cos(t*9)/x,0+
h*Sin(t*9)/x,150):DrawingMode(#PB_2DDrawing_Gradient):x=w/2*(1+Cos(t*9)):y=(1+
Sin(t*9))*h/2:LinearGradient(x,y,w-x,h-y):FrontColor(RGB(127*(Sin(2*t)+1),(1+
Sin(3*t))*127,127*(1+Sin(5*t)))):BackColor(RGB(127*(1+Sin(7*t)),127*(1+Sin(11*t+
0)),127*(1+Sin(13*t)))):For i=0 To#n-1:r=i*2*#PI/#n:p+Sin(t)/30000:x=w/2*(1+
z*Cos(r+p)):y=h/2*(1+z*Sin(r+p)):If i=0:fx=x:fy=y:Else:LineXY(ox,oy,x,y):EndIf
ox=x:oy=y:Next:LineXY(x,y,fx,fy):j(op)):EndIf:Until v=#PB_Event_CloseWindow

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :   BoulderDash-Clone
;* Author   :   Mr.L
;* Date     :   20/07/14
;* Notes    :   My not 100% perfect remake of the famous C64 game :-)
;*              Use Arrow-Keys to move, Escape-Key = restart Map
;*******************************************************************************
UsePNGImageDecoder():#w=40:#h=22:Structure bm:b.i[8]:c.l:n.l:m.l:d.l;##########
EndStructure:LoadImage(0,"b.png"):NewList p.bm():OpenWindow(0,0,0,800,600,"BD");
CanvasGadget(0,0,0,800,600,#PB_Canvas_Keyboard):SetActiveGadget(0);############
AddWindowTimer(0,0,100):AddWindowTimer(0,1,50):AddWindowTimer(0,2,1000);#######
Dim b.bm(30):Macro F:EndIf:EndMacro:Macro H:Case:EndMacro:Macro G();###########
Dim w(#w,#h):ky=0:xs=0:xr=0:pl=3:ClearList(P()):StartDrawing(ImageOutput(0));##
u=lv*40:di=Point(u,406):ti=Point(u+1,406):dp=Point(u+2,406):ep=Point(u+3,406);#
For v=0 To #h-1:For u=0 To #w-1:w(u,v)=Point(u+lv*40,v+384):Select w(u,v):H 2;#
x=u:y=v:w(u,v)=18:H 99:hx=u:hy=v:w(u,v)=14:EndSelect:Next:Next:StopDrawing();##
EndMacro:Macro M(k,u,v,s):If ky=k:w=w(u,v):If w<2:w(x,y)=0:w(u,v)=s:x=u:y=v;###
ElseIf w=18:lv=(lv+1)%6:sc+ti:ti=0:de=50:w(x,y)=0:x=u:y=v:ElseIf w=7:di-1:sc+dp
If di=0:w(hx,hy)=18:bg=$FFFFFF:F:w(x,y)=0:w(u,v)=s:x=u:y=v:ElseIf w=5 And;#####
w(x+(x-u)*2,v)=0 And Random(3)=0:w(x,y)=0:w(u,v)=s:w(x+(x-u)*2,v)=5:x=u:y=v:F:F
EndMacro:Macro E(i,x,y):AddElement(p()):p()\m=x:p()\n=y:p()\d=i:p()\c=4;#######
EndMacro:Macro N(i,x,y):If c=i:If w(u+y*d,v-x*d)=0:j+y*d:k-x*d:p=1;############
ElseIf w(u+x,v+y)=0:j+x:k+y:F:F:EndMacro:Macro S(x,y):Select Abs(w(u+x,v+y));##
H 0,1:If xg And Random(120)=0:w(u+x,v+y)=15:xg=0:F:xt=0:H 9 To 12:E(0,u+x,v+y);
EndSelect:EndMacro:Macro L:Next:EndMacro:Macro I(x,y,c=8):For u=x To x+c-1;####
b(i)\b[u-x]=GrabImage(0,#PB_Any,u*32,y*32,32,32):L:b(i)\n=c:i+1:EndMacro;######
I(0,6,1):I(1,7,1):I(0,1):I(0,4):I(0,5):I(0,7,1):I(0,7,1):I(0,10):I(0,10):I(0,9)
I(0,9):I(0,9):I(0,9):I(3,6,1):I(1,6,1):I(0,8):I(1,0,3):I(4,6,4):I(4,0,4):lv=0;#
G():de=20:fi=LoadFont(0,"Verdana",16,#PB_Font_Bold):Repeat;####################
Select WaitWindowEvent():H #PB_Event_CloseWindow:End:H #PB_Event_Gadget;#######
If EventType()=#PB_EventType_KeyDown:ky=GetGadgetAttribute(0,#PB_Canvas_Key):F;
If EventType()=#PB_EventType_KeyUp:ky=0:If de<1:w(x,y)=2:F:F;##################
If ky=#PB_Shortcut_Escape:G():de=10:F:H #PB_Event_Timer:Select EventMenu():H 0;
If de<1:M(#PB_Shortcut_Up,x,y-1,3):M(#PB_Shortcut_Down,x,y+1,4);###############
M(#PB_Shortcut_Left,x-1,y,3):M(#PB_Shortcut_Right,x+1,y,4):F:xt=1:xg=1;########
For v=0 To #h-1:For u=0 To #w-1:c=w(u,v):j=u:k=v:d=Abs(w(u,v+1)):Select c:H 5,7
If d=0:c+1:ElseIf d=13 Or(d>4 And d<9):If w(u-1,v)=0 And w(u-1,v+1)=0:c+1;#####
ElseIf w(u+1,v)=0 And w(u+1,v+1)=0:c+1:F:F:H 6,8:Select d:H 2,3,4:E(0,x,y);####
H 9 To 12:E(7,u,v):H 17:If w(u,v+2)=0:k+2:If c=6:c=8:Else:c=6:F:F:EndSelect;###
If d=0:k+1:ElseIf d=13 Or(d>4 And d<9):If w(u-1,v)=0 And w(u-1,v+1)=0:j-1;#####
ElseIf w(u+1,v)=0 And w(u+1,v+1)=0:j+1:F:F:If j=u And k=v:c-1:F:H 9 To 12:d=1;#
N(9,1,0):N(10,0,1):N(11,-1,0):N(12,0,-1):If p:p=0:c-d:ElseIf(j=u And k=v);#####
c+d:F:If c=8:c=12:ElseIf c=13:c=9:F:For b=-1 To 1:For a=-1 To 1:If (a*b)=0;####
Select Abs(w(u+a,v+b)):H 2,3,4:E(0,u,v):EndSelect:F:L:L:H 15:If xs:c=7;########
ElseIf xr:c=5:Else:S(-1,0):S(1,0):S(0,-1):S(0,1):F:EndSelect:w(u,v)=0;#########
w(j,k)=-c:L:L:xs=xt:ForEach p():c=p()\c-1:d=p()\d:If c>0:d=16:F;###############
For v=p()\n-1 To p()\n+1:For u=p()\m-1 To p()\m+1:Select Abs(w(u,v)):H 2,3,4;##
de=30:E(0,u,v):H 9 To 12:E(0,u,v):H 15:xr=1:EndSelect:If Abs(w(u,v))<>14;######
w(u,v)=d:F:L:L:p()\c=c:If c<=0:DeleteElement(p()):F:L:If de:de-1:If de=20:G();#
ElseIf de=0:w(x,y)=2:F:F:H 1:c=((x*32+sx)-400):If Abs(c)>250:sx-c/20:F;########
c=((y*32+sy)-300):If Abs(c)>150:sy-c/15:F:c=((x*32)-400):For i=0 To 18;########
b(i)\c=(b(i)\c+1)%(b(i)\n):L:StartDrawing(CanvasOutput(0)):DrawingFont(fi);####
Box(0,0,800,600,0):For v=0 To #h-1:For u=0 To #w-1:b=Abs(w(u,v)):If b:w(u,v)=b;
DrawImage(ImageID(b(b)\b[b(b)\c]),u*32+sx,v*32+sy,32,32):Else;#################
Box(u*32+sx,v*32+sy,32,32,bg):F:L:L:bg=0;######################################
DrawText(0,0,"   D:"+Str(di)+Space(40)+Str(ti)+Space(40)+RSet(Str(sc),6,"0"));#
StopDrawing():H 2:If de<1:ti-1:If ti=0:E(0,x,y):F:F:EndSelect:EndSelect:ForEver

Identifiez-vous

Créer un compte

Compétition PurePunch juillet-août 2014 : réalisez la meilleure application en 50 lignes de code

Identifiant
Mot de passe

Mot de passe oublié ?