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.
Le 2012-11-28 21:49:58, 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
Envoyé par djes
[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
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 :
Bonne chance à tous les compétiteurs !
Source de l'information
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
[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)
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 : ;* ;******************************************************** |
Source de l'information
-
comtoisResponsable Purebasicvoici 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 !le 30/11/2012 à 18:25 -
comtoisResponsable PurebasicEt 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
le 02/12/2012 à 10:49 -
comtoisResponsable Purebasicun 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
le 04/12/2012 à 22:18 -
comtoisResponsable Purebasicun 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)
le 04/12/2012 à 22:21 -
comtoisResponsable PurebasicLa 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
le 04/12/2012 à 22:31 -
comtoisResponsable Purebasicet 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
le 04/12/2012 à 22:33 -
comtoisResponsable Purebasicvoici 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);******************************************
le 30/12/2012 à 13:48 -
comtoisResponsable PurebasicLe 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.le 05/01/2013 à 10:56 -
comtoisResponsable Purebasic
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!le 15/01/2013 à 20:23 -
comtoisResponsable Purebasicet 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.le 22/01/2013 à 23:16