+ Répondre à la discussion Actualité déjà publiée
  1. #1
    Candidat au Club
    Inscrit en
    août 2005
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2005
    Messages : 3
    Points : 4
    Points
    4

    Par défaut Compétition PurePunch Juillet-Août 2014

    ~ 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
    1. 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).
    2. 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.
    3. Etre original, c'est à dire soit être une création complète, soit apporter quelque chose de nouveau à un code existant.
    4. Ne pas être néfaste.
    5. 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.
    6. 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.
    7. 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 - Visualiser dans une fenêtre à part
      MessageRequester("Information", "Message", #PB_MessageRequester_Ok)
    8. 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 - Visualiser dans une fenêtre à part
    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 !

  2. #2
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Si je trouve une idée et un peu de temps, je participerai

    Pour ceux qui n'ont pas de licence PureBasic, la version démo est suffisante pour participer, elle permet de coder jusqu'à 800 lignes.
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  3. #3
    Candidat au Club
    Inscrit en
    août 2005
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2005
    Messages : 3
    Points : 4
    Points
    4

    Par défaut Nouveau sponsor

    Plus on est de fous...

    Sinon, Fred et Fantaisie Software m'ont contacté pour sponsoriser la compétition.

  4. #4
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Falsam nous propose le code suivant :
    Ambiance ombre chinoise, dégradé de gris et son tibétain pour un jeu 2D dans lequel une tortue se cache derrière des arbres.

    Trouver le plus de tortue et cliquer dessus : Une tortue trouvée ajoute du temps au jeu ainsi qu'un arbre pour compliquer la recherche. Les moines vous accordent le droit de vous tromper 1 fois.

    Si vous trouvez 50 tortues, les moines vous accordent une seconde chance de vous tromper. 30 Tortues de plus et les moines vous accordent une troisième chance de vous tromper.

    Nom : turtles.jpg
Affichages : 156
Taille : 40,9 KoNom : turtlesgo.jpg
Affichages : 148
Taille : 60,9 Ko
    L'image et le son sont dans le zip:
    http://s242132022.onlinehome.fr/Down...sic/turtle.zip

    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    ;*****************************************************************************
    ;*
    ;* 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)
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  5. #5
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    kvitaliy propose le code suivant :
    Importunate fly

    Nom : scrfly.jpg
Affichages : 142
Taille : 15,8 Ko
    L'image et le son se trouvent dans cette archive

    http://www.upload.ee/files/4137028/fly.zip.html

    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
    ;*****************************************************************************
    ;*
    ;* 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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  6. #6
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Idle nous propose le code suivant :

    We haven't had a purepunch for awhile!
    Here's a brief time absorbing cellular challenge
    Avec cette image
    Nom : osmosis.png
Affichages : 131
Taille : 354,1 Ko

    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    ;*****************************************************************************
    ;*
    ;* 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()
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  7. #7
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Contribution de TazNormand

    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    ;*****************************************************************************
    ;*
    ;* 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)
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  8. #8
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Contribution de graph100

    Hop, mon premier code, il n'est pas super car il ne permet aucune interaction, et ne fait absolument pas ce que je voulais faire à la base...
    Simplement c'est un essai pour voir si je pouvais faire tenir mon moteur de dynamique des fluides dans les limites du Punch !

    Et ça rentre ! En 50 ligne tout pile. (Quand j'ai eu fini, j'en avais 50 lignes + 28 caractères, mais j'ai coupé dans le vif pour faire entrer l'essentiel.
    Le code initial, commenté et propre fait 525 lignes
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    ;*******************************************************************************
    ;*
    ;* 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########
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  9. #9
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    La contribution de CSHW89

    My Punch, a mastermind clone in 35 lines :
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    ;*******************************************************************************
    ;*
    ;* 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;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  10. #10
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    La contribution de NicTheQuick

    Some superformula fun! (works also with EnableExplicit)
    Pour l'instant c'est mon préféré. à noter également que le règlement a changé, la version doit être au minimum 5.22, ce qui veut dire que la 5.30 peut être utilisée.

    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
    ;*******************************************************************************
    ;*
    ;* 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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  11. #11
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Contribution de Mr.L

    Hi everyone!
    Here is my attempt: A not 100% perfect clone of the famous C64 game "Boulder Dash"!
    Maybe one or another in this forum was addicted to this game like me, back in the old days

    This imagefile file is needed. Please save the code and the image to the same directory.
    Nom : b.png
Affichages : 138
Taille : 6,5 Ko
    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
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    ;*******************************************************************************
    ;*
    ;* 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
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  12. #12
    Candidat au Club
    Inscrit en
    août 2005
    Messages
    3
    Détails du profil
    Informations forums :
    Inscription : août 2005
    Messages : 3
    Points : 4
    Points
    4

    Par défaut Voter

    Vous pouvez voir les programmes réalisés et aller voter ici : http://www.purebasic.fr/french/viewt...hp?f=6&t=14760

  13. #13
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    Il est possible de suivre le résultat des votes à cette adresse
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  14. #14
    Responsable Purebasic

    Avatar de comtois
    Inscrit en
    avril 2003
    Messages
    1 169
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 169
    Points : 5 312
    Points
    5 312
    Billets dans le blog
    7

    Par défaut

    les résultats du vote

    Ouf j'ai obtenu 1 point, je ne suis pas fanny


    Compétition PurePunch Juillet-Août 2014 - Résultats

    1er - PunchAnabalt - Majikeyric - 48 points
    2nd - BoulderDash-Clone - Mr.L - 31 points
    3ème - Back to Winterfell - Huitbit - 19 points
    4ème - StarSky - Cool Dji - 14 points
    4ème ex-aequo - MoonLander nightmare - Graph100 - 14 points
    5ème - Minidemo - SPH - 13 points
    5ème ex-aequo - Console Animation - JHPJHP - 13 points
    6ème - Osmosis - Idle - 10 points
    7ème - Superformula - NicTheQuick - 8 points
    7ème ex-aequo - Mastermind - cshw89 and NicTheQuick - 8 points
    8ème - Fluid Dynamics Game Engine - graph100 - 6 points
    9ème - Where is the turtle - falsam - 4 points
    10ème - PurePunch Cruncher - majikeyric - 3 points
    10ème ex-aequo - Happy Days ! Only 50's - Ar-S - 3 points
    11ème - console_casse_brique - dobro - 2 points
    12ème - Je Te Vois - Comtois - 1 point
    12ème ex-aequo - Interference Circles - TazNormand - 1 point
    13èmes ex-aequo :
    COM - Bananenfreak - 0 point
    deformer_punch - dobro - 0 point
    fred_nous_surveille_Punch - dobro - 0 point
    Importunate fly - kvitaliy - 0 point
    Interplanetary War - BasicallyPure - 0 point
    Magneto - dobro - 0 point
    Matrix_original - dobro - 0 point
    pack_punch2 - dobro - 0 point
    Statistique loto Belge - microdevweb - 0 point
    TCP Chat - citystate - 0 point
    Timer (Not really a good name) - Bananenfreak - 0 point
    tron_punch - dobro - 0 point


    Félicitations à Majikeyric, Mr.L et Huitbit pour leurs programmes ! Vous serez contactés prochainement pour recevoir vos prix.

    Merci à tous les codeurs pour la qualité et l'originalité de leur travail, et pour ce moment de partage. Tout le monde ne peut pas recevoir un lot, même si nous les apprécions tous et qu'ils méritent notre respect. Merci à tous les votants d'avoir pris le temps de participer. Un merci spécial à falsam pour son aide, notamment avec le tableau de décompte des votes, et pour l'animation du forum. Et merci à Fred, Freak et à l'équipe de Fantaisie Software pour PureBasic et pour rendre tout cela possible.
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

Discussions similaires

  1. Réponses: 0
    Dernier message: 30/08/2014, 14h43
  2. Réponses: 12
    Dernier message: 29/01/2013, 09h45
  3. Compétition PurePunch été 2010
    Par comtois dans le forum PureBasic
    Réponses: 5
    Dernier message: 07/08/2010, 10h30

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo