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

[comtois]

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

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 :

    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 :

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

[comtois]

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

[comtois]

Et voici le premier code du concours

Code :

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

[comtois]

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 :

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

[comtois]

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

Code :

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)

[comtois]

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 :

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

[comtois]

et celui ci met un peu de couleur dans les gadgets

Code :

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

[comtois]

voici ma contribution au PurePunch 2012.

Il faut cette image :

Code :

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);******************************************

[comtois]

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.

[comtois]

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

[comtois]

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.

[comtois]

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

[comtois]

Et enfin la photo du deuxième prix, gagné par einander.