PureBasic

Code : Tout sélectionner

Macro O
EndIf
EndMacro

Define test.POINT

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

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

Code : Tout sélectionner

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

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)

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