+ Répondre à la discussion Actualité déjà publiée
  1. #1
    Responsable Purebasic

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

    Par défaut PureBasic : Compétition PurePunch des fêtes de fin d'année 2012

    Le concours est terminé : Télécharger l'archive du PurePunch 2012


    Avant propos: le texte ci-dessous est mal formaté sur la page actu, et le lien vers la pièce jointe n'apparait pas. Vous pouvez vous rendre sur le forum pour une lecture plus aisée et récupérer l'archive.


    Avis aux amateurs, djes relance son fameux PurePunch. Lors des compétitions précédentes il nous a permis de voir de jolis démos.

    Il est même possible d'utiliser la version démo puisque le concours limite les codes à 80 lignes. Et croyez moi on peut faire de sacrés trucs en 80 lignes! souvenez vous du précédent PurePunch qui limitait les codes à 10 lignes et bien y'en a un qui nous a quand même pondu un RayTracing en 10 lignes !

    NOTE : Suite à cette annonce, Fred (l'auteur de PureBasic) annonce qu'il dote le concours de quelques bricoles. Je ne connais pas le détail, c'est surtout pour le 'fun' ce concours

    Citation Envoyé par djes
    Bonne nouvelle, Fred sponsorise, il y aura donc quelques petits cadeaux

    [EDIT]J'ai ajouté en pièce jointe un fichier .zip comportant les codes d'un concours PurePunch précédent. Le RayTracing dont je parle se trouve dans le code numéro 007.Pb.

    ~ Décembre 2012 ~

    Compétition PurePunch des fêtes de fin d'année 2012

    Thème

    The fantastic PB 5.00 Demo !
    Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic. Cette démo peut aussi bien être un utilitaire, un jeu, une démo graphique en 3D, n'importe quoi qui montre vos capacités et celles de la nouvelle version de PB, en en repoussant les limites !
    Que le meilleur gagne !

    Les lots & les sponsors
    Fred et Fantaisie software vont sponsoriser la compétition. La liste de prix est en cours de création.
    Si vous voulez sponsoriser, contactez-moi.


    Les règles

    1° Le programme sera fait en Purebasic version 5.00 sans l'ajout de bibliothèque utilisateur (userlib).
    2° Le source du programme ne pourra comporter au maximum que 80 lignes de 80 caractères max 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 décembre, 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 27 novembre pourront voter (3 points pour le 1er, 2 points pour le second, 1 point pour le troisième).

    Comment poster

    Postez le code dans le forum après y avoir ajouté et complété l'entête suivant :


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    ;********************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : 
    ;* Author   :
    ;* Date     :
    ;* Notes    :
    ;*
    ;********************************************************
    Bonne chance à tous les compétiteurs !

    Source de l'information
    Fichiers attachés Fichiers attachés
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  2. #2
    Responsable Purebasic

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

    Par défaut

    voici la liste des prix :
    Fred et Fantaisie software sont heureux de sponsoriser la compétition :
    1er prix : Un superbe petit nounours PureBasic !
    2ème prix : Un magnifique mug PureBasic
    3ème prix : Un splendide tapis souris PureBasic
    Si vous aussi voulez sponsoriser, contactez-moi !
    Bon c'est surtout pour le fun ce concours hein
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  3. #3
    Responsable Purebasic

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

    Par défaut

    Et voici le premier code du concours
    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
    64
    65
    66
    67
    68
    69
    70
    71
    72
     
    ;*****************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : Pure4Power
    ;* Author   : cederavic
    ;* Date     : 12/01/2012
    ;* Notes    : Hmmm... Better to play with two players!
    ;*          : media.png can be downloaded here : http://slimevoid.net/games/pure4power/media.png
    ;*
    ;*****************************************************************************
    #width=512:#height=440
    Global Dim g(6,5),tu=1,pw=-1,Dim f(6,5):Declare checkWin()
    InitSprite():UsePNGImageDecoder():UsePNGImageEncoder()
    OpenWindow(0,0,0,#width,#height,"Pure4Power",13107201)
    CanvasGadget(0,0,0,#width,#height,#PB_Canvas_ClipMouse)
    media=LoadImage(#PB_Any,"media.png")
    GrabImage(media,0,0,0,512,440)
    GrabImage(media,1,0,440,72,72)
    GrabImage(media,2,72,440,72,72)
    LoadFont(0,"Consolas",22,#PB_Font_HighQuality|#PB_Font_Bold)
    playertuTime=ElapsedMilliseconds()
    Repeat:Repeat:wEvent=WindowEvent():If wEvent=16:quit=#True:EndIf
    If wEvent=#WM_LBUTTONUP And dp=#False:If pw=0
    dropCol=Int((WindowMouseX(0)-8)/72)
    If g(dropCol,0)=0:dp=#True:dy=0:EndIf:Else:FreeArray(g()):Global Dim g(6,5)
    tu=1:pw=0:EndIf:EndIf:Until wEvent=#Null:If dp=#True:dy+12
    cr=Int((dy-8)/72)+1:If cr=6:dp=#False:g(dropCol,cr-1)=tu:checkWin()
    If tu=1:tu=2:Else:tu=1:EndIf:playertuTime=ElapsedMilliseconds():Else
    If g(dropCol,cr) > 0:dp=#False:g(dropCol,cr -1)=tu:checkWin()
    If tu=1:tu=2:Else:tu=1:EndIf
    playertuTime=ElapsedMilliseconds():EndIf:EndIf:EndIf
    StartDrawing(CanvasOutput(0))
    DrawingMode(#PB_2DDrawing_Gradient):LinearGradient(0,0,0,#height)
    BackColor(RGBA(182,180,255,255)):FrontColor(RGBA(100,182,255,255))
    Box(0,0,#width,#height,RGBA(0,42,224,255)):If (dp=#True)
    DrawAlphaImage(ImageID(tu),dropCol * 72+4,dy+4):ElseIf (pw=0)
    DrawAlphaImage(ImageID(tu),Int((WindowMouseX(0)-8)/72) * 72+4,4,128)
    EndIf:For x=0 To 6:For y=0 To 5:If (g(x,y) > 0):If (pw=0)
    DrawAlphaImage(ImageID(g(x,y)),x * 72+4,y * 72+4):Else
    DrawAlphaImage(ImageID(g(x,y)),x * 72+4,y * 72+4,63+f(x,y) * 192)
    EndIf:EndIf:Next:Next:DrawAlphaImage(ImageID(0),0,0)
    DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AlphaBlend)
    DrawingFont(FontID(0)):If (pw > 0)
    text.s="Player "+Str(pw)+" has won!"
    DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,127))
    DrawText(#width/2-TextWidth(text)/2,128,text,RGBA(42,241,64,255))
    text.s="Click to play again"
    DrawText(#width/2-TextWidth(text)/2+2,126+48,text,RGBA(32,32,32,127))
    DrawText(#width/2-TextWidth(text)/2,128+48,text,RGBA(42,241,64,255))
    ElseIf (pw=0):If (ElapsedMilliseconds()-playertuTime < 3000)
    alpha.f=255-(255 * (ElapsedMilliseconds()-playertuTime)/3000.0)
    text.s="Player "+Str(tu)+" turn"
    If tu=1:color=RGBA(255,174,0,alpha):Else:color=RGBA(255,16,16,alpha):EndIf
    DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,(alpha/2)))
    DrawText(#width/2-TextWidth(text)/2,128,text,color):EndIf:Else
    text.s="Click to Play"
    DrawText(#width/2-TextWidth(text)/2+2,126,text,RGBA(32,32,32,127))
    DrawText(#width/2-TextWidth(text)/2,128,text,RGBA(242,180,100,255))
    EndIf:StopDrawing():Until quit=#True:End
    Procedure p(x,y,dx,dy,player,win):If x<0 Or x>6 Or y<0 Or y>5
    ProcedureReturn win:EndIf:If g(x,y)<>player:ProcedureReturn win:EndIf
    If g(x,y)=player:f(x,y)=1:ProcedureReturn p(x+dx,y+dy,dx,dy,player,win+1):EndIf
    EndProcedure
    Procedure checkWin():For x=0 To 6:For y=0 To 5:If (g(x,y) > 0)
    For dx=-1 To 1:For dy=-1 To 1:If (dx <> 0 Or dy <> 0):FreeArray(f())
    Global Dim f(6,5):If p(x,y,dx,dy,g(x,y),0) >= 4
    pw=g(x,y):ProcedureReturn pw:EndIf:EndIf:Next:Next:EndIf
    Next:Next:ProcedureReturn 0:EndProcedure
    à utiliser avec cette image
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  4. #4
    Responsable Purebasic

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

    Par défaut

    un autre code de electrochrisso. il faut récupérer des fichiers de recettes à cette adresse , et le programme se charge de la mise en page.


    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
    ;*****************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : Meal Master Quickview
    ;* Author   : electrochrisso
    ;* Date     : 04.12.2012
    ;* Notes    : Download Recipes Here: http://home.earthlink.net/~darkstar105/
    ;*
    ;*****************************************************************************
    OpenWindow(0,100,0,842,540,"Meal Master Quickview",#PB_Window_SystemMenu)
    CreateToolBar(0,WindowID(0)):ToolBarStandardButton(0,#PB_ToolBarIcon_Open)
    ListViewGadget(0,0,28,200,512)
    EditorGadget(1,202,28,640,512,#PB_Editor_ReadOnly)
    SetGadgetColor(0,#PB_Gadget_BackColor,$FAFFF5)
    SetGadgetColor(1,#PB_Gadget_BackColor,$F0FFFF)
    SetGadgetFont(1,LoadFont(0,"Courier",10))
    Repeat:Select WaitWindowEvent():Case #PB_Event_Menu:Select EventMenu()
    Case 0:f$=OpenFileRequester("Open Menu Master File","","Text (*.txt)",0)
    If f$:If ReadFile(0,f$):ClearGadgetItems(0):SetGadgetText(1,""):Repeat
    a$=ReadString(0):If Left(a$,12)="      Title:":AddGadgetItem(0,-1,Mid(a$,13))
    EndIf:Until Eof(0):CloseFile(0):EndIf:EndIf:EndSelect
    Case #PB_Event_Gadget:Select EventGadget():Case 0:If ReadFile(0,f$)
    Repeat:a$=ReadString(0)
    Until a$=Left(a$,12)+GetGadgetItemText(0,GetGadgetState(0))
    While a$<>"MMMMM":If a$<>"MMMMM":b$+a$+#CRLF$:a$=ReadString(0):EndIf:Wend
    CloseFile(0):EndIf:SetGadgetText(1,b$):b$="":EndSelect
    Case #PB_Event_CloseWindow:End:EndSelect:ForEver
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    un space invaders pong de Graph100. Il faut l'image suivante :



    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
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    ;******************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : SPACE INVADERS PONG
    ;* Author   : Graph100
    ;* Date     : 02/12/12
    ;* Notes    : Just enjoy the little game ! There is no score, nor levels ;)
    ;*            But there are two ending : you win or you loose.
    ;*            You win by destroying the Space Invaders MasterShip (the big red
    ;*            one), with the red ball
    ;*            You loose if the Space Invaders touches the earth, if you came to
    ;*            loose all your three lives and if the red ball thrown by the
    ;*            Space Invaders MotherShip touches the earth
    ;*
    ;******************************************************************************
    Structure p:x.d:y.d:t.l:x1.d:y1.d:EndStructure:Dim e.p(9,5):m=286:z=m:b.p\x=294
    InitSprite():InitKeyboard():NewList t.p():v=3:NewList r.p():NewList g.p():l=100
    #h=400:OpenWindow(0,0,0,600,#h,"PP",$C80001):x=32:LoadImage(0,"512.png"):b\y=82
    OpenWindowedScreen(WindowID(0),0,0,600,#h,0,0,0):b\x1=(Random(10)-5)/5:b\y1=1;#
    Macro O:EndIf:EndMacro:Macro D(i,x,y):DisplayTransparentSprite(i,x,y):EndMacro;
    Macro S(i,x,y,j,w,h):SpritePixelCollision(i,x,y,j,w,h):EndMacro:Macro N:Next;##
    EndMacro:NewList _t.p():Macro C2(i):If i\t>0:D(i\t+24,i\x-10,i\y-10):O:i\t+1;##
    If i\t>15:DeleteElement(i):O:EndMacro:Macro C(i,x,y,w,h):CreateSprite(i,w,h);##
    GrabImage(0,1,x,y,w,h):StartDrawing(SpriteOutput(i)):DrawImage(ImageID(1),0,0);
    StopDrawing():TransparentSpriteColor(i,0):EndMacro:LoadFont(0,"Arial",19,272);#
    Macro F1(i,j,k):For i=j To k:EndMacro:Macro C1(t1):StartDrawing(ScreenOutput())
    DrawingFont(FontID(0)):DrawText(0,0,t1):i2=TextWidth(t1):j2=TextHeight(t1)-1;##
    F1(i,0,i2):F1(j,0,j2):If Point(i,j):AddElement(_t()):_t()\x=i:_t()\y=j;########
    _t()\x1=Random(600):_t()\y1=Random(#h):_t()\t=Point(i,j):O:N:N:Box(0,0,i2,j2,0)
    StopDrawing():EndMacro:F1(i,0,11):C(i,i*24,50,24,16):N:F1(i,0,5);##############
    C(i+12,i*6,80,6,16):N:C(18,320,50,26,16):C(19,0,0,510,50):C(20,0,462,510,50);##
    C(21,22,110,468,15):C(22,288,50,32,16):C(23,510,0,2,512):#b=540:F1(i,0,15);####
    C(i+24,i*20,141,20,20):N:Macro Q(x1,y1,w,h,t1):F1(t2,0,t1):AddElement(r());####
    r()\x=Random(w)+x1:r()\y=Random(h)+y1:r()\t=-Random(t1):N:EndMacro:F1(i,0,7);##
    C(i+40,346+i*16,50,16,16):N:Repeat:Repeat:w=WindowEvent():Until w=0 Or w=16:_+1
    ExamineKeyboard():ClearScreen(0):D(19,44,v1):D(20,44,350):D(23,42,0);##########
    D(23,556,0):If f And a>0:a-1:D(21,66,40):O:If v>0:F1(i,1,v):D(18,9,i*30):N;####
    If l<70:If _%6=0:If l<60:With e((59-l)%10,(59-l)/10);##########################
    \t=l/10:\x=294:\y=40:EndWith:O:l+1:O:Else:u+ed:If u>=262 Or u<=48:ed=-ed:y+10:O
    EndIf:For j=0 To 5:For i=0 To 9:With e(i,j);###################################
    If l=100:\t=-1:O:If \t<>-1:If l<70:\x+2*(i*30+u-\x)/8:\y+(j*20+y-\y)/8:Else;###
    \x=u+i*30:\y=y+j*20:If Random(1000)=0:AddElement(g()):g()\t=\t/2+13:g()\y=\y+16
    g()\x=\x+12:O:O:D(\t*2+_%40/20,\x,\y):If S(20,44,350,\t*2+_%40/20,\x,\y):v=0:O;
    If l1>3 And S(40,b\x,b\y,\t*2+_%40/20,\x,\y):\t=-1:Q(\x,\y,24,16,20):h-1:Else;#
    ForEach t():If S(12,t()\x,t()\y,\t*2+_%40/20,\x,\y):DeleteElement(t()):\t=-1;##
    h-1:Q(\x,\y,24,16,20):Break:O:N:O:O:N:N:EndWith:If h=0:l=0:l1+1:h=60:ed=2:u=150
    y=110:O:dx=0:If KeyboardPushed(203):m-3:dx=-1:If m<44:m=44:O:O:If _%18=0:ta=1:O
    If KeyboardPushed(205):m+3:dx=1:If m>530:m=530:O:O:D(18,m,340):D(22,z,65);#####
    If ta And KeyboardReleased(57):ta=0:AddElement(t()):t()\x=m+10:t()\y=324:O;####
    D(40+_%32/4,b\x,b\y):If l1>3:b\x+b\x1:b\y+b\y1:If b\x<z+8:z-4:O:If b\x>z+8:z+4;
    O:If b\x<44 Or b\x>#b:b\x1=-b\x1:b\x+b\x1:O:If b\y>60 And S(40,b\x,b\y,22,z,65)
    b\y1=-b\y1:b\y=80:O:If b\y<344 And S(40,b\x,b\y,18,m,340):b\y1=-b\y1:b\y=324;##
    b\x1+dx:If Abs(b\x1)>5:b\x1=5*Sign(b\x1):O:O:If S(40,b\x,b\y,20,44,350):v=0:O;#
    If b\y<30:v=-2:EndIf:EndIf:ForEach t():With t();###############################
    \y-2:D(12,\x,\y):If S(12,\x,\y,21,66,40) Or \y<-8:If \y>0:f=1:a=8:O;###########
    DeleteElement(t()):EndIf:EndWith:Next:ForEach g():With g();####################
    \y-12+\t:D(\t,\x,\y):If S(\t,\x,\y,20,44,345):DeleteElement(g());##############
    ElseIf S(\t,\x,\y,18,m,340):DeleteElement(g()):v-1:O:EndWith:N:ElseIf v=0:v-1;#
    Q(m,340,26,16,100):F1(j,0,5):F1(i,0,9):If e(i,j)\t<>-1;########################
    Q(e(i,j)\x,e(i,j)\y,24,16,20):O:N:N:F1(i,0,5):e(0,i)\t=i:e(0,i)\x=294;#########
    e(0,i)\y=40:N:C1("Les SPACE INVADERS envahissent la terre..."):f=1:a=j2;#######
    ElseIf v=-2:v-1:C1("Tu as vaincus les SPACE INVADERS !!"):ElseIf v=-3;#########
    If v1>-50 And _%5=0:Q(70,0,454,40+v1,20):v1-1:O:D(18,m,340);#PUREPUNCH#DEC#2012
    D(40+_%32/4,m+5,320-50*Abs(Sin(_/10))):Else:F1(i,0,5);######SPACE#INVADERS#PONG
    ra.d=920+25*Abs(Sin(_/24+i)*Sin(_/8+i)*Sin(_/8+i));############PAR#GRAPH100####
    e(0,i)\x=e(0,i)\x+(300+ra*Cos(0.2*Sin(_/90+i/2)-#PI/2)-e(0,i)\x)/x;############
    e(0,i)\y=e(0,i)\y+(1270+ra*Sin(0.2*Sin(_/90+i/2)-#PI/2)-e(0,i)\y)/x;###########
    D(e(0,i)\t*2+_%40/20,e(0,i)\x,e(0,i)\y):Q(e(0,i)\x+12,e(0,i)\y+24,2,2,2):N;####
    If _%200=0:f=-f:a=j2:O:If _%3=0:a-1:O:If _%20=0:x/2+1:O:O;###JOYEUSE#NOUVELLE##
    StartDrawing(ScreenOutput()):ForEach _t():With _t();##ANNEE#A#TOUT#LE#FORUM#!!#
    \x1+(300-i2/2+\x+2*Sin(\y+_/5)-\x1)/8:If (f=-1 And \y>=a) Or (f=1 And \y>=j2-a)
    \y1+(200+\y-\y1)/8:Else:\y1+(100+\y-\y1)/8:O:Box(\x1,\y1,1,1,\t):EndWith:N;####
    StopDrawing():ForEach r():C2(r()):N:FlipBuffers();#############################
    Until w=16 Or KeyboardPushed(1)
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    La 1ere partition à un purepunch. de Ar-s
    - Catégorie logiciel.
    J'ai créé ce petit prog en 2 jours.
    Il permet de créer/décoder des rubans de couleurs cachant un message jusqu'à 600 caractères.
    Envoyez un ruban de couleur à votre ami et Magic Ruban pourra le décoder.
    L'image qui accompagne le programme :



    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
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    ;*****************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : Magic Ruban
    ;* Author    : Ar-S
    ;* Date       : Dec 2012 
    ;* Notes    : This code is non unicode.
    ;*
    ;*****************************************************************************
    ;*****************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : Magic Ruban
    ;* Author    : Ar-S
    ;* Date       : Dec 2012 
    ;* Notes    : This code is non unicode.
    ;*
    ;*****************************************************************************
    inf$ = "Write a message into the editor then create your magic ruban!"+Chr(10)
    inf$ + "C = Clear   -     P = Paste"
    MessageRequester("Information", inf$, #PB_MessageRequester_Ok)
    UsePNGImageEncoder() : UsePNGImageDecoder()
    NewList T.i() : NewList Message.s()
    Macro M : Macro : EndMacro
    M Rnd : Random(200) : EndMacro
    M Gb : Global : EndMacro
    M Dg : DisableGadget : EndMacro
    M Bt : ButtonGadget : EndMacro
    M SGT (inside) : SetGadgetText(5,inside) : EndMacro
    M SDC : StartDrawing(CanvasOutput(1)) : EndMacro
    M SDI(gad) : StartDrawing(ImageOutput(gad)) : EndMacro
    Gb Name$ = "Magic Ruban" : Gb GO,RUBOK : RUBOK=0
    Gb imgfile$ = GetCurrentDirectory()+"MyRuban.rub"
    Gb titre : titre = LoadImage(12,GetCurrentDirectory()+"title.png")
    Procedure Msgt(mess.s,Opt = 0)
      ProcedureReturn  MessageRequester("Info",mess.s, Opt)
    EndProcedure
    OpenWindow (0, 0, 0, 600, 450,Name$, #PB_Window_SystemMenu)
    CanvasGadget (1, 1, 1, 600, 256)
    Bt(2, 42, 349, 159, 20, "Create a "+Name$)
    Bt(3, 201, 349, 200, 20, "Save my "+Name$)
    Bt(4, 402, 349, 200, 20, "Read a "+Name$)
    EditorGadget(5, 1, 258, 600, 90)
    Bt(6, 1, 349, 20, 20, "C") : Bt(7, 21, 350, 20, 20, "P")
    ImageGadget(8,4,370,592,80,titre) 
    SendMessage_(GadgetID(5), #EM_LIMITTEXT, 600, 0)
    SendMessage_(GadgetID(5), #EM_SETTARGETDEVICE, #Null, 0)
    SGT("Enter your message in here : Max 600 car. Enjoy "+Name$) : DG(3,1)
    GO = 1 : SDC : Box(0,0,600, 257, $0) : StopDrawing()
    Repeat : Select WaitWindowEvent() : Case #PB_Event_Gadget:Select EventGadget()
    Case 2 : ClearList (T()) : Mess$ = GetGadgetText(5) : LenM = Len(Mess$)
    For NumCar=1 To LenM : AddElement (T()) : T()=Asc(Mid(Mess$, NumCar,1)) : Next
    Max=0 : ForEach T() : Size=T() : If Size > Max : Max=T() : EndIf : Next : Max+1
    If CreateImage (10, 600, Max) : SDI(10) : Box(0,0,600, Max-1, $0)
    For Pix = 0 To lenM-1
    SelectElement(T(), Pix) : R = Rnd+55 : G = Rnd+55 : B = Rnd+55
    Line(Pix,0,1,Max-2, RGB(R-5, G-5, B-5))
    Line(Pix,0,1,T()-1, RGB(R, G, B)) : Next : StopDrawing()
    SDC : DrawImage(ImageID(10),0,0,600,256) : StopDrawing()
    If RUBOK = 0 : RUBOK+1 : DG(3,0) : EndIf : EndIf
    Case 3 : SaveImage(10, imgfile$, #PB_ImagePlugin_PNG) : FreeImage(10)
    msgt( imgfile$ + " has been save")
    Case 4 : ClearList(Message())
    imgLoad$ = OpenFileRequester(name$,imgfile$, "Ruban File *.rub|*.rub" ,0)
    If imgLoad$ <> "" : If LoadImage(11, imgLoad$) : ClearList(Message())
    T$ = "" : SGT("") : imgL = ImageWidth(11) : imgH = ImageHeight(11)
    SDC : DrawImage(ImageID(11),0,0,600,256) : StopDrawing()
    SDI(11) : NbrCar = 0 : For L = 0 To ImgL-1 : i = 0 : Stop = 0
    Repeat : COL = Point(L, i) : If i = 0 : NewCOL = COL : EndIf
    If NewCOL <> COL : AddElement (Message())
    Message() = Chr(i+1) : T$ + Message() : NewCOL = COL : NbrCar+1  : Stop = 1
    Else : i+1 : If i = imgH-1 : Stop = 1 : EndIf : EndIf : Until Stop = 1
    Next L : StopDrawing() : FreeImage(11) : SGT(T$) : Else : EndIf : EndIf     
    Case  5 : If GetGadgetText(5) = "" : DG(2,1) : Else : DG(2,0) : EndIf
    Case  6 : Q=msgt ("Do you really want to clear everything ?", 4)
    If Q = 6 : SGT("") : If RUBOK = 1 : RUBOK-1 : DG(3,1) : EndIf
    SDC : Box(0,0,600, 256, $0) : StopDrawing() : EndIf
    Case 7 : If GetClipboardText() <> "" :  SGT(GetClipboardText())
    Else : Msgt ("There is no text in the clipboard !") : EndIf
    EndSelect
    Case #PB_Event_CloseWindow : If EventWindow() = 0 : CloseWindow(0)
    FreeImage(12) : End : EndIf : EndSelect : ForEver
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    et celui ci met un peu de couleur dans les gadgets
    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
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
     
    ;******************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;
    ;* Name     : PanelGadget Color Toobar
    ;* Author   : Kernadec
    ;* Date     : 04.12.2012
    ;* Notes    : ...
    ;*
    ;******************************************************************************
    Enumeration
          #Win:#PanelGadget1
          #bouton1:#bouton2
          #Container1:#Container2
          #Canvas1:#Canvas2
          #ToolBar1:#ToolBar2
    EndEnumeration
    Enumeration 1
          #icon1:#icon2:#icon3:#icon4:#icon5:#icon6:#icon7:#icon8
    EndEnumeration
    #Options=#PB_Window_SystemMenu|#PB_Window_ScreenCentered
    titre$="PanelGadget color & ToolBar"
    Procedure.f GradientCallback1(x, y)
       ProcedureReturn Cos(x * 0.5) * Sin(y * 0.5) / Cos(x*0.5)
    EndProcedure
    Procedure.f GradientCallback2(x, y)
       ProcedureReturn Cos(x * 0.6) * Sin(x * 0.6) / Cos(x*0.6)
    EndProcedure 
    OpenWindow( #Win, 0, 0, 300, 200,titre$,#Options)
    PanelGadget(#PanelGadget1,10,10,WindowWidth(#Win)-20,WindowHeight(#Win)-20)
    AddGadgetItem(#PanelGadget1, -1, "Panel 1")
    ContainerGadget(#Container1, 0, 0, 272,24,#PB_Container_BorderLess) 
    CloseGadgetList()
    CanvasGadget(#Canvas1, 0, 25, 272,128):StartDrawing(CanvasOutput(#Canvas1))
    DrawingMode(#PB_2DDrawing_Gradient):BackColor($00FFFF):FrontColor($FF0F0F)
    CustomGradient(@GradientCallback1()):Box(0, 0, 272,128):StopDrawing()
    DisableGadget(#Canvas1,1):ButtonGadget(#bouton1, 90,  62, 100, 56, "Button1")
    CreateToolBar(#ToolBar1,GadgetID(#Container1))
    ToolBarStandardButton(#icon1,#PB_ToolBarIcon_New)
    ToolBarStandardButton(#icon2,#PB_ToolBarIcon_Open)
    ToolBarStandardButton(#icon3,#PB_ToolBarIcon_Undo)
    ToolBarStandardButton(#icon4,#PB_ToolBarIcon_Redo)
    ;-----------------------------------------------------------------------------
    AddGadgetItem(#PanelGadget1, -1, "Panel 2")
    ContainerGadget(#Container2,  0, 0, 272,24,#PB_Container_BorderLess)
    CloseGadgetList()
    CanvasGadget(#Canvas2, 0, 25, 272,128):StartDrawing(CanvasOutput(#Canvas2))
    DrawingMode(#PB_2DDrawing_Gradient):BackColor($00FFFF):FrontColor($FF0F0F)
    CustomGradient(@GradientCallback2()):Box(0, 0, 272,128):StopDrawing()
    DisableGadget(#Canvas2,1):ButtonGadget(#bouton2, 90,  62, 100, 56, "Button2")
    CreateToolBar(#ToolBar2, GadgetID(#Container2))
    ToolBarStandardButton(#icon5,#PB_ToolBarIcon_Cut)
    ToolBarStandardButton(#icon6,#PB_ToolBarIcon_Copy)
    ToolBarStandardButton(#icon7,#PB_ToolBarIcon_Paste)
    ToolBarStandardButton(#icon8,#PB_ToolBarIcon_Replace)
    Repeat
          Select WaitWindowEvent()
                Case #PB_Event_CloseWindow
                      End
                Case #PB_Event_Gadget
                      Select EventGadget()
                            Case #bouton1
                                  Debug "Identifiant bouton: "+Str(EventGadget())
                            Case #bouton2
                                  Debug "Identifiant bouton: "+Str(EventGadget())
                      EndSelect
                Case #PB_Event_Menu
                      Debug "Identifiant ToolBar: "+Str(EventMenu())   
          EndSelect
          ResizeGadget(#bouton1,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
          ResizeGadget(#bouton2,#PB_Ignore,#PB_Ignore,#PB_Ignore,#PB_Ignore)
          ;ResizeGadget = mode XP, Seven No ResizeGadget, vista No test.
    ForEver
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    voici ma contribution au PurePunch 2012.

    Il faut cette image :


    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
     
    ;*******************************************************************************
    ;*
    ;* Season's Greetings PurePunch Demo contest
    ;* PureBasic 5.00
    ;* 80 lines of 80 chars, 1 month delay
    ;*
    ;* Name     : FAST EDITOR 2D
    ;* Author   : Comtois
    ;* Date     : 30/12/2012
    ;* Notes    : Esc to Quit : Left button add a tile: Right button remove a tile
    ;*
    ;*******************************************************************************
    Macro G(n,t,u):GrabSprite(n,t,u,32,32):EndMacro:Macro E:EndIf:EndMacro;*********
    InitSprite():InitKeyboard():InitMouse():OpenScreen(1024,768,32,"M"):#X=32:#Y=32;
    Global W,Z,F:Global Dim M(32,24):LoadSprite(16,"S.bmp"):DisplaySprite(16,0,0);**
    For I=0 To 7:G(i,i*32,0):G(i+8,i*32,32):Next i:G(20,0,64):Procedure T(x,y,R):F=0
    If R:If x<32:If M(x+1,y)>0:F|1:E:E:If x>0:If M(x-1,y)>0:F|2:E:E:If y<24;********
    If M(x,y+1)>0:F|4:E:E:If y>0:If M(x,y-1)>0:F|8:E:E:If M(x,y)>0:If F=0:F=15:E;***
    Else:F=0:E:E:Ch=M(x,y):M(x,y)=F:If Ch<>F Or R=0:If x>0:T(x-1,y,1):E:If x<32;****
    T(x+1,y,1):E:If y>0:T(x,y-1,1):E:If y<24:T(x,y+1,1):E:E:EndProcedure:Repeat;****
    ClearScreen(0):For j=0 To 24:For i=0 To 32:DisplaySprite(M(i,j),i*#X,j*#Y);*****
    Next i:Next j:ExamineMouse():ExamineKeyboard():P=MouseX():Q=MouseY();***********
    DisplayTransparentSprite(20,P-#X/2,Q-#Y/2):W=P/#X:Z=Q/#Y:If W<=32 And Z<=24;****
    If MouseButton(2):M(W,Z)=0:T(W,Z,0):E:If MouseButton(1):M(W,Z)=17:T(W,Z,1):E:E:;
    FlipBuffers():Until KeyboardPushed(1);******************************************
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    Le concours est terminé, les votes sont en cours, dans 10 jours on connaitra le vainqueur.

    Voici une archive qui comporte les codes des 14 concurrents. J'ai ajouté un exécutable (windows x86) pour ceux qui voudraient tester sans PureBasic.

    Téléchargez l'archive

    En ce qui me concerne, je vote pour einander pour son code :
    Eine Kleine PBmusik - Experiment in recombinatorial music

    C'est vraiment excellent et incroyable d'avoir réussi à coder un truc pareil en 80 lignes seulement.
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    Après décompte, voici les résultats des votes :

    • 1st - Spaceinvaders - Graph100 - 32 points
    • 2nd - Eine Kleine PBMusik - einander - 26 points
    • 3rd - Winter punch - Cool Dji - 25 points
    • 4th - Pict2AsciiArt - lepiaf31 - 10 points
    • 5th - Music Sequencer - BasicallyPure - 7 points
    • 6th - Hanoï Towers - Wood51 - 5 points
    • 7th - Fast Editor 2D - Comtois - 4 points
    • 8th - Puissance 4 - Cederavic - 3 points
    • 9th - Démineur - Kernadec & Graph100 - 1 points
    • 10th - ForumOnlineChecker - infratec - 1 points


    Un grand bravo à Graph100, einander et Cool Dji, qui remportent chacun un lot bien mérité, offert par Fantaisie Software!
    C'est cool je ne suis pas fanny
    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 167
    Détails du profil
    Informations forums :
    Inscription : avril 2003
    Messages : 1 167
    Points : 5 249
    Points
    5 249
    Billets dans le blog
    7

    Par défaut

    et hop une image du 3ème prix, gagné par Cool Dji un comtois comme moi

    En espérant qu'on verra bientôt des images des 2 autres prix.

    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  12. #12
    Responsable Purebasic

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

    Par défaut

    Et voici la photo du premier prix, gagné par Graph100

    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

  13. #13
    Responsable Purebasic

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

    Par défaut

    Et enfin la photo du deuxième prix, gagné par einander.
    Vous souhaitez participer à la rubrique PureBasic (tutoriels, FAQ, sources) ? Contactez-moi par MP.

Discussions similaires

  1. bonnes fêtes de fin d'année
    Par Bart169 dans le forum La taverne du Club : Humour et divers
    Réponses: 2
    Dernier message: 27/12/2012, 11h56
  2. Bonnes fêtes de fin d'année
    Par Tardiff Jean-François dans le forum Composants VCL
    Réponses: 9
    Dernier message: 25/12/2007, 22h31
  3. Brevetabilité des logiciels : la fin du "libre" ??
    Par xhandle dans le forum Débats sur le développement - Le Best Of
    Réponses: 102
    Dernier message: 11/05/2006, 22h14
  4. Suppression des blancs en fin de chaine
    Par Spyco dans le forum C
    Réponses: 4
    Dernier message: 22/12/2005, 16h13

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