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

[lepiaf31]

Hmm aller je participerai si j'ai un peu de temps

[graph100]

Moi j'ai mon idée ! ça va être un spécial pour Kcc qui va encore pouvoir faire le malin devant sa femme (ou pas )

[lepiaf31]

Petite question: on peut concourir plusieurs fois ou bien c'est limité à un seul code par personne ?

[graph100]

ce code plante à la compilation. Je ne pense pas que ce soit un comportement normal.

Code : Tout sélectionner

Macro O
EndIf
EndMacro

Define test.POINT

If 1=1
	;bla
O:With test
test\x = 1
EndWith

votre avis ?

[nico]

Je suis d'avis que c'est un bug.

[Ar-S]

Idem pour les EndProcedure, EndMacro... ^^
En gros les commandes de fermeture n'ont pas l'air d'être acceptées.

[djes]

Un peu embêtant ! Mais on peut mettre le with bien avant, ce n'est pas trop grave. De toutes façons, il faudra faire avec... A moins qu'il n'y ait un correctif d'ici la fin du mois.

[graph100]

Pour moi le bug c'est que la macro n'ayant pas de parenthèse, le précompilateur croit qu'il est toujours dans une macro quand il traite le "with", qui est un genre de macro lui aussi.
C'est comme ça que je l'interprète.

C'est pas non plus trop grave mais c'est sans doute à corriger.

[cederavic]

Bon aller juste histoire d'ouvrir le bal...
J'aurais pu compacter beaucoup plus, mais pas vraiment d'interet, ça fait deja moins de 60 lignes.
J'espere avoir le temps de faire quelque chose d'un peut plus "complet" avant mon déménagement

Code : Tout sélectionner

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

Avec l'image :


Pas de son...

[graph100]

Sympa ton puissance 6

Code : Tout sélectionner

For i=0 To 5:30*i:Next

L'éditeur de PB m'affiche *i comme une variable avec ce code ...

[edit]: il me reste 32 lignes de rab... je devrais arriver à faire tout rentrer

[djes]

Cederavic> Hey, bien sympa ! Retour en forme

[comtois]

cederavic, super, et il te reste encore 20 lignes pour ajouter l'IA

[Cool Dji]

Chouette ce Puissance 4, Cederavic
Du grand art en si peu de lignes, bravo !!

[graph100]

Aller ! Je poste la première version de mon PurePunch

Vous devez télécharger l'image suivante :


J'ai aussi mis une archive avec l'exécutable compilé pour ceusse qui veulent : Space Invaders Pong

Dites moi si vous arrivez à l'écran de victoire
Si j'ai le temps, j'essayerai d'utiliser les 20 lignes de rab

Code : Tout sélectionner

;******************************************************************************
;*
;* 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
;*
;******************************************************************************
UsePNGImageDecoder():Macro Rm(i):Random(i):EndMacro;###########################
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=(Rm(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 i<600:If Point(i,j):AddElement(_t()):_t()\x=i:_t()\y=j
_t()\x1=Rm(600):_t()\y1=Rm(#h):_t()\t=Point(i,j):O: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=Rm(w)+x1:r()\y=Rm(h)+y1:r()\t=-Rm(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 Rm(750)=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)

[Ar-S]

Ma 1ere partition à un purepunch.
- 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.
Lien de l'image : http://stock.ldvmultimedia.com/title.png

Code : Tout sélectionner

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