Compétition PurePunch des fêtes de fin d'année 2012
Montrez ce que vous savez faire grâce à la nouvelle version de PureBasic.

Les rubriques (actu, forums, tutos) de Développez
Tags
Réseaux sociaux


 Discussion forum

Le , par comtois, Responsable Purebasic
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 :
    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


Vous avez aimé cette actualité ? Alors partagez-la avec vos amis en cliquant sur les boutons ci-dessous :


 Poster une réponse

Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 30/11/2012 18:25
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 02/12/2012 10:49
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 04/12/2012 22:18
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 04/12/2012 22:21
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)
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 04/12/2012 22:31
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 04/12/2012 22:33
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 30/12/2012 13:48
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);******************************************
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 05/01/2013 10:56
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.
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 15/01/2013 20:23
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
Avatar de comtois comtois
http://www.developpez.com
Responsable Purebasic
le 22/01/2013 23:16
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.

Offres d'emploi IT
Analyste développeur
Stage
PATRIMO - Ile de France - Bois-Colombes (92270)
Parue le 09/10/2014
Développeur c++
Alternance
IP-FORMATION - Ile de France - Paris (75000)
Parue le 16/10/2014
Ingénieur en intégration continue
CDI
Mobiskill - Ile de France - Paris (75000)
Parue le 24/09/2014

Voir plus d'offres Voir la carte des offres IT
 
 
 
 
Partenaires

PlanetHoster
Ikoula