PureBasic Forums - English

Posted: **Thu Jul 10, 2014 6:28 pm**

djes wrote:{snip}
The rules
1° The program will be created using Purebasic 5.22 (minimum), API allowed, demo version allowed, no userlib.
2° The full program source will only have a maximum of 50 text lines of 80 characters max per line. It's possible to have several text files (for example, a PB source and a textfile data, Ogre shader, preferences file, xml document...), but all text lines added should not excess the limit of 50 text lines of 80 characters per line.
3° To be unique, either a complete creation, or bringing something new to an existing code.
4° Must not to be harmful
5° Possibility to add a graphic file (only one image, or sprite, or texture...), maximum size 512 pixels width by 512 pixels height, 32 bits. Post it on the forum or on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.

I will not debate rule 4, but some could argue that it would be possible to disqualify all software based on that criteria.

My main question is how to interpret rule 5.
I interpret it to mean that the added graphics file can only contain one image.
Is that an accurate interpretation of your posted rules, or can the 512x512, 32 bits graphic, actually be used to contain multiple sprite/images?

Posted: **Thu Jul 10, 2014 7:12 pm**

heartbone wrote:
djes wrote:{snip}
The rules
1° The program will be created using Purebasic 5.22 (minimum), API allowed, demo version allowed, no userlib.
2° The full program source will only have a maximum of 50 text lines of 80 characters max per line. It's possible to have several text files (for example, a PB source and a textfile data, Ogre shader, preferences file, xml document...), but all text lines added should not excess the limit of 50 text lines of 80 characters per line.
3° To be unique, either a complete creation, or bringing something new to an existing code.
4° Must not to be harmful
5° Possibility to add a graphic file (only one image, or sprite, or texture...), maximum size 512 pixels width by 512 pixels height, 32 bits. Post it on the forum or on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.
I will not debate rule 4, but some could argue that it would be possible to disqualify all software based on that criteria.

My main question is how to interpret rule 5.
I interpret it to mean that the added graphics file can only contain one image.
Is that an accurate interpretation of your posted rules, or can the 512x512, 32 bits graphic, actually be used to contain multiple sprite/images?

Yes. I'd be glad you give some suggestions for better rules, feel free to correct and comment.

Posted: **Thu Jul 10, 2014 8:24 pm**

djes wrote:
heartbone wrote:
djes wrote:{snip}
The rules
1° The program will be created using Purebasic 5.22 (minimum), API allowed, demo version allowed, no userlib.
2° The full program source will only have a maximum of 50 text lines of 80 characters max per line. It's possible to have several text files (for example, a PB source and a textfile data, Ogre shader, preferences file, xml document...), but all text lines added should not excess the limit of 50 text lines of 80 characters per line.
3° To be unique, either a complete creation, or bringing something new to an existing code.
4° Must not to be harmful
5° Possibility to add a graphic file (only one image, or sprite, or texture...), maximum size 512 pixels width by 512 pixels height, 32 bits. Post it on the forum or on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.
I will not debate rule 4, but some could argue that it would be possible to disqualify all software based on that criteria.

My main question is how to interpret rule 5.
I interpret it to mean that the added graphics file can only contain one image.
Is that an accurate interpretation of your posted rules, or can the 512x512, 32 bits graphic, actually be used to contain multiple sprite/images?
Yes. I'd be glad you give some suggestions for better rules, feel free to correct and comment.

Far be it from me to correct the rules of your contest, I was just asking for clarification.
However since you have solicited suggestions, I'd like the graphic to be able to contain more than one image, or sprite, or texture.
Under those conditions I might then be able to produce something worthwhile.

I really appreciate the long heads up before the contest deadline. Thanks.

Also you didn't explicitly mention it, but should I assume that using web assets or operating system media is prohibited?

Posted: **Thu Jul 10, 2014 10:33 pm**

heartbone wrote:
djes wrote:
heartbone wrote:
djes wrote:{snip}
The rules
1° The program will be created using Purebasic 5.22 (minimum), API allowed, demo version allowed, no userlib.
2° The full program source will only have a maximum of 50 text lines of 80 characters max per line. It's possible to have several text files (for example, a PB source and a textfile data, Ogre shader, preferences file, xml document...), but all text lines added should not excess the limit of 50 text lines of 80 characters per line.
3° To be unique, either a complete creation, or bringing something new to an existing code.
4° Must not to be harmful
5° Possibility to add a graphic file (only one image, or sprite, or texture...), maximum size 512 pixels width by 512 pixels height, 32 bits. Post it on the forum or on another site which must be reachable during the contest length, or included in a full project archive posted in the forum.
I will not debate rule 4, but some could argue that it would be possible to disqualify all software based on that criteria.

My main question is how to interpret rule 5.
I interpret it to mean that the added graphics file can only contain one image.
Is that an accurate interpretation of your posted rules, or can the 512x512, 32 bits graphic, actually be used to contain multiple sprite/images?
Yes. I'd be glad you give some suggestions for better rules, feel free to correct and comment.
Far be it from me to correct the rules of your contest, I was just asking for clarification.
However since you have solicited suggestions, I'd like the graphic to be able to contain more than one image, or sprite, or texture.
Under those conditions I might then be able to produce something worthwhile.

I really appreciate the long heads up before the contest deadline. Thanks.

Also you didn't explicitly mention it, but should I assume that using web assets or operating system media is prohibited?

All things not forbidden are... authorised.

The graphics and sound limitation is just for distribution purpose, one file is a good limit and it permits to share it easily on the forum. No matter it contains several images or sprites or whatever.
If you decide to use a system file, be sure that everybody have it, because if your program doesn't work, the vote will sanction it, not me.

Posted: **Thu Jul 10, 2014 10:36 pm**

heartbone wrote:Far be it from me to correct the rules of your contest, I was just asking for clarification.
However since you have solicited suggestions, I'd like the graphic to be able to contain more than one image, or sprite, or texture.
Under those conditions I might then be able to produce something worthwhile

I think it's like the previous contest, and the graphic is to be something like you can see there

For the rest I can't tell...

@ Bananenfreak : nice 3D works ! Maybe you can add a default loading of the purebasic sample, dont think this will be broking the rules since it's a data processing program. But I don't any other *.mesh file on my computer

And I saw that for some of the exemple (AK47, ninja) the X, Y, Z = 0, is it normal ?

Posted: **Fri Jul 11, 2014 8:20 am**

@graph100:
Thank you

I want a program which is Independent to Purebasic and its examplefolder (A "real" program).
If Center of mesh is already Center of mass it will display (0,0,0).

EDIT:
@DKPeter:
You have to join the contest or you´ll get in trouble with me

Posted: **Fri Jul 11, 2014 3:51 pm**

may as well dip my feet into the water

Code: Select all

;*******************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     :  TCP Chat
;* Author   :  citystate
;* Date     :  11 July 2014
;* Notes    :  a combination server/client chat program with a couple of chat
;*             commands built in.
;*               /nick <nickname> - changes your display name
;*               /me              - personalised emotes
;*             tested on windows XP, 7 and 8.1
;*
;*******************************************************************************
Structure ln:c.i:e.b:m.s:EndStructure:Global NewList l.ln(),z,ce,NewMap u.s();;;
Global q=CreateMutex(),s=CreateSemaphore(),r=CreateMutex():Declare r(m$,w=1);;;;
Procedure p(c,e,m$):LastElement(l()):AddElement(l()):l()\c=c:l()\e=e:l()\m=m$;;;
SignalSemaphore(s):EndProcedure:Procedure k(p):If CreateNetworkServer(0,p):n=999
*b=AllocateMemory(n):While 1:Delay(10):e=NetworkServerEvent():c=EventClient();;;
If ce:v=NetworkClientEvent(ce):EndIf:Select e:Case 1,4:p(c,e,""):Case 2:l=n;;;;;
LockMutex(q):While l=n:l=ReceiveNetworkData(c,*b,n):p(c,e,PeekS(*b,l)):Wend;;;;;
UnlockMutex(q):EndSelect:If v=2:l=n:v=0:LockMutex(q):While l=n;;;;;;;;;;;;;;;;;;
l=ReceiveNetworkData(ce,*b,n):r(PeekS(*b,l),0):Wend:UnlockMutex(q):EndIf:Wend;;;
EndIf:EndProcedure:Procedure r(m$,w=1):If w:ForEach u():u=Val(MapKey(u()));;;;;;
LockMutex(q):SendNetworkString(u,m$):UnlockMutex(q):Next:Else;;;;;;;;;;;;;;;;;;;
y=CountGadgetItems(0):AddGadgetItem(0,-1,m$):SetGadgetState(0,y):EndIf;;;;;;;;;;
EndProcedure:Procedure m(a):While 1:Delay(10):If TrySemaphore(s):LockMutex(r);;;
FirstElement(l()):c$=Str(l()\c):If u(c$)="":m$=c$:Else:m$=u(c$):EndIf;;;;;;;;;;;
Select l()\e:Case 1:AddMapElement(u(),m$):m$+" <joins>":Case 4;;;;;;;;;;;;;;;;;;
DeleteMapElement(u(),m$):m$+" <left>":Default:If Left(l()\m,6)="/nick ";;;;;;;;;
u(c$)=Trim(Mid(l()\m,6)):m$+" is now known as "+u(c$):ElseIf Left(l()\m,3)="/me"
m$="*"+m$+Mid(l()\m,4)+"*":Else:m$+": "+l()\m:EndIf:EndSelect;;;;;;;;;;;;;;;;;;;
DeleteElement(l(),1):UnlockMutex(r):r(m$):EndIf:Wend:EndProcedure:Procedure s();
m$=GetGadgetText(1):SetGadgetText(1,""):If z :If m$<>"":LockMutex(q);;;;;;;;;;;;
SendNetworkString(z,m$):UnlockMutex(q):EndIf:Else:y=CountGadgetItems(0);;;;;;;;;
AddGadgetItem(0,-1,"<you are not connected>"):SetGadgetState(0,y):EndIf;;;;;;;;;
SetActiveGadget(1):EndProcedure:Procedure d():If z:CloseNetworkConnection(z);;;;
SetMenuItemText(0,2,"Connect"):Else:p=7873:a$="Connect":b$="Enter IP";;;;;;;;;;;
c$=InputRequester(a$,b$,"127.0.0.1"):z=OpenNetworkConnection(c$,p):ce=z:If z;;;;
SetMenuItemText(0,2,"Disconnect"):EndIf:EndIf:EndProcedure:f=13107201;;;;;;;;;;;
a=OpenWindow(0,0,0,300,200,"TCP Chat",f):CreateMenu(0,a):a=160:a$="Connect";;;;;
MenuItem(2,a$):ListViewGadget(0,0,0,300,a):StringGadget(1,0,a,300,20,"");;;;;;;;
AddKeyboardShortcut(0,13,1):InitNetwork():BindMenuEvent(0,1,@s()):a$="Help";;;;;
Procedure h():a$="Available Commands:"+#CRLF$+"/nick - change display name";;;;;
a$+#CRLF$+"/em - emote message":MessageRequester("Quick Help",a$):EndProcedure;;
MenuItem(3,a$):BindMenuEvent(0,3,@h()):BindMenuEvent(0,2,@d()):a=13116;;;;;;;;;;
CreateThread(@k(),7873):CreateThread(@m(),0):Repeat:SetActiveGadget(1);;;;;;;;;;
Until WaitWindowEvent()=a;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

Posted: **Fri Jul 11, 2014 4:32 pm**

Hmm, I can´t test it.
It opens a window with Connect and Help, but can´t be closed and gets no Response. And it takes very much CPU-power Oo

Posted: **Fri Jul 11, 2014 8:33 pm**

djes wrote:API allowed

Windows API? GTK API? Both of them?

Posted: **Fri Jul 11, 2014 10:26 pm**

NicTheQuick wrote:
djes wrote:API allowed
Windows API? GTK API? Both of them?

All. But as already said, don't forget your audience. If your code doesn't work for several people, you're loosing votes.

Posted: **Fri Jul 11, 2014 11:57 pm**

Bananenfreak wrote:Hmm, I can´t test it.
It opens a window with Connect and Help, but can´t be closed and gets no Response. And it takes very much CPU-power Oo

tweaked the CPU use (there was a loose thread

) - I've tested it on several machines with differing specs, not sure why you're not getting any response (or why you can't close it)

Posted: **Sat Jul 12, 2014 7:37 pm**

Bananenfreak wrote: EDIT:
@DKPeter:
You have to join the contest or you´ll get in trouble with me

LOL!! Yeah, I bet.

But noooo thanks, I'll stay out of the contest. Just
keep on adding excellent punches to this thread and I'm a happy guy.
Anyway, here another minor punch..And no...Still not participating.

This one is a grey-/height map creator. Far from perfect, but it surely makes
the job a lot easier. Created with less than 50 lines of code:
Shortcut keys are as follows:

Code: Select all

; 
    F2 = Open Image
    F3 = Save image
    F5 = Split image 
    F6 = Red2Gray 
    F7 = Green2Grey
    F8 = Blue2Grey 
      - = Darken 
      + = Lighten
 Up arrow = Increase threshold 
 Down arrow = Decrease threshold 
 ESCAPE key to quit

Code: Select all

;Grey-/heightmap creator: Is not part of contest!
;By DK_PETER - NOTE: Change #PX and #PY to change resolution
; F2 = Open Image ; F3 = Save image
; F5 = Split image ; F6 = Red2Gray ; F7 = Green2Grey
; F8 = Blue2Grey ; - = Darken ; + = Lighten
; Up arrow = Increase threshold ; Down arrow = Decrease threshold : ESCAPE key to quit
UsePNGImageDecoder():UseJPEGImageDecoder():UseJPEGImageEncoder():InitSprite()
InitKeyboard():Macro M:Macro:EndMacro:M STI(i):StartDrawing(ImageOutput(i))
EndMacro:M STC:StartDrawing(ScreenOutput()):EndMacro:M ST:StopDrawing()
EndMacro:M IW(i):ImageWidth(i):EndMacro:M IH(i):ImageHeight(i):EndMacro:
Structure po:List h.i():EndStructure:Structure ima:pi.po[4]:im.i[5]
EndStructure:M P:Procedure:EndMacro:M EP:EndProcedure:EndMacro:#PX=1920;<---
M II(i):IsImage(i):EndMacro:M FI(i):FreeImage(i):EndMacro:M AE(i):AddElement(i)
EndMacro:M FE(i):FirstElement(i):EndMacro:M NE(i):NextElement(i):EndMacro
M DRI(i,x,y,w,h):DrawImage(ImageID(i),x,y,w,h):EndMacro:M KR(i)
KeyboardReleased(i):EndMacro:M KP(i):KeyboardPushed(i):EndMacro:#PY=1080;<---
Global im.ima,sh.i,sw.i,Win.i,Name.s,CI.i = 0,TH.i = 140:P.i RA():For e=0 To 3
If II(im\im[e]):FI(im\im[e]):EndIf:ClearList(im\pi[e]\h()):Next e:EP:P.i GI()
RA():pt.s="Image|*.png;*.bmp;*.jpg":Name=OpenFileRequester("","",pt,0)
If Name<>"":im\im[4]=LoadImage(#PB_Any,Name):If II(im\im[4])>0:im\im[0] = _ +
CopyImage(im\im[4],#PB_Any):im\im[1]=CopyImage(im\im[4],#PB_Any):im\im[2]= _ +
CopyImage(im\im[4],#PB_Any):im\im[3]=CopyImage(im\im[4],#PB_Any):EndIf:EndIf:EP
P.i SI():If II(im\im[4])=0:ProcedureReturn #False:EndIf:STI(im\im[4])
DrawingMode(256):For y = 0 To IH(im\im[4])-1:For x = 0 To IW(im\im[4])-1
AE(im\pi[0]\h()):AE(im\pi[1]\h()):AE(im\pi[2]\h()):AE(im\pi[3]\h()):col.i= _+
Point(x,y):im\pi[0]\h()=Red(col):im\pi[1]\h()=Green(col):im\pi[2]\h()=Blue(col)
im\pi[3]\h()=RGB(col,col,col):Next x:Next y:ST:For d=0 To 2:FE(im\pi[d]\h())
STI(im\im[d]):For y = 0 To IH(im\im[d])-1:For x = 0 To IW(im\im[d])-1:Select d
Case 0:Plot(x,y,RGB(im\pi[d]\h(),0,0)):Case 1:Plot(x,y,RGB(0,im\pi[d]\h(),0))
Case 2:Plot(x,y,RGB(0,0,im\pi[d]\h())):EndSelect:NE(im\pi[d]\h()):Next x:Next y
ST:Next d:EP:P.i TH(Ix.i=0):CI=Ix:FE(im\pi[Ix]\h()):STI(im\im[3]):For y=0 To _ +
IH(im\im[Ix])-1:For x=0 To IW(im\im[Ix])-1:Plot(x,y,RGB(im\pi[Ix]\h(), _ +
im\pi[Ix]\h(),im\pi[Ix]\h())):NE(im\pi[Ix]\h()):Next x:Next y:ST:EP
P.i THC(CV.i=0):nv.i=0:oc.i:STI(im\im[3]):For y=0 To IH(im\im)-1
For x=0 To IW(im\im)-1:oc=Point(x,y):Select CI:Case 0:np=Red(oc):Case 1
np=Green(oc):Case 2:np=Blue(oc):EndSelect:If CV=0:If np-20>=TH:nv=np-20:Else
nv=np:EndIf:Else:If np+20<TH:nv=np+20:Else:nv=np:EndIf:EndIf
Plot(x,y,RGB(nv,nv,nv)):Next x:Next y:ST:EP:Global Q.i = 0, fn.i, fnb.i
OpenWindow(0,0,0,#PX,#PY,"",#PB_Window_ScreenCentered)
OpenWindowedScreen(WindowID(0),0,0,#PX,#PY,0,0,0,2):sw=#PX:sh=#PY
Repeat:ClearScreen(0):Repeat:u=WindowEvent():Until u=0:If II(im\im[0]):STC
DRI(im\im[0],0,0,sw/2,sh/2):DrawText(0,0,"Threshold = "+Str(TH),$FFAAEE,0):ST
EndIf:If II(im\im[1])>0:STC:DRI(im\im[1],sw/2,0,sw/2,sh/2):ST:EndIf
If II(im\im[2])>0:STC:DRI(im\im[2],0,sh/2,sw/2,sh/2):ST:EndIf
If II(im\im[3])>0:STC:DRI(im\im[3],sw/2,sh/2,sw/2,sh/2):ST:EndIf
ExamineKeyboard():If kr(#PB_Key_F2):ret = GI():EndIf
If kr(#PB_Key_F5):SI():EndIf:If kr(#PB_Key_F6):TH(0):CI=0:EndIf
If kr(#PB_Key_F7):TH(1):CI=1:EndIf:If kr(#PB_Key_F8):TH(2):CI=2:EndIf
If kr(#PB_Key_Add):THC(1):EndIf:If kr(#PB_Key_Subtract):THC(0):EndIf
If KP(#PB_Key_Up):If TH+1<256:TH+1:EndIf:EndIf:If KP(#PB_Key_Down):If TH-1>40
TH-1:EndIf:EndIf:If KR(#PB_Key_F3)
SaveImage(im\im[3],Name+"_G.jpg",#PB_ImagePlugin_JPEG)
MessageRequester("Done","Image:"+Name+"_Grey.jpg is saved"):EndIf:FlipBuffers()
Until KR(#PB_Key_Escape)

Have fun.

EDIT: @graph100
If you haven't got any meshes to test with, you can download some at my site.

Posted: **Sat Jul 12, 2014 11:38 pm**

My Punchs

All my codes only work on Window XP and Seven
and PureBasic 5.22

An Packer/depacker Zip

Code: Select all

;***********************************************
;Titre  :*pack_punch2
;Auteur  : Dobro
;Date  :04/07/2014
;Heure  :14:02:54
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Libairies necessaire : Aucune
; lancer en ThreadSafe et en mode Administrateur
;n'oubliez pas que Height (8) n'autorise pas l'ecriture sur c:\
;***********************************************

UseZipPacker():macro Ma:macro:EndMacro:Ma EN:enumeration:endmacro:Ma ED
EndEnumeration:Endmacro:Ma Dc:Declare:Endmacro:Ma OW:OpenWindow:Endmacro:Ma Bt
ButtonGadget:Endmacro:Ma Mr:MessageRequester:Endmacro:Ma Nn
NextSelectedFileName:Endmacro:Ma P:procedure :Endmacro:Ma EP:EndProcedure
Endmacro:Ma SG:SetGadget:Endmacro:Ma ST:SetGadgetState:Endmacro:Ma SD
SetCurrentDirectory:Endmacro:Ma SA:SetGadgetAttribute:EndMacro:Ma FZ:FileSize
Endmacro:Ma GI:GadgetID:EndMacro:Ma UW:UpdateWindow_:Endmacro:Ma ES:EndSelect
Endmacro:Ma Q:Select:Endmacro:Ma GP:GetPathPart:Endmacro:Ma W:While:Endmacro
Ma WE:Wend:Endmacro:Ma EI:Endif:Endmacro:Ma U:Else:EndMacro
Ma GD:GetCurrentDirectory:Endmacro:Ma RP:RunProgram:Endmacro
EN:#w:#bc:#p:#bd:#A:ED:EN:#Ah:#Ah2:#t1:ED:Dc  compress(*bidon):Dc  Decompress()
Global td,ta ,Cd$,n$,c:Ow(#w,10,10,350,150,"Compres",#PB_Window_SystemMenu)
Bt(#bc,10, 10,150,30,"compres"):Bt(#bd,10,40,150,30,"Uncompres")
ProgressBarGadget(#p,10,90,300,15,0,100,#PB_ProgressBar_Smooth)
TextGadget(#A,280,130,150,25,"By Dobro"):Repeat:E =WaitWindowEvent(2):Q E
Case #PB_Event_Gadget:Q EventGadget():Case #bd:F$="":ST(#p,0)
SetGadgetColor(#p,#PB_Gadget_FrontColor,rgb(0,255,120))
F$=OpenFileRequester("load file to Decompress",GD(),"*.*",0)
If OpenPack(#Ah2,F$)<>0:t_c=0:If ExaminePack(#Ah2):W NextPackEntry(#Ah2)
t_c=t_c+1:WE:EI:SA(#p,#PB_ProgressBar_Maximum ,t_c):ClosePack(#Ah2):EI
If OpenPack(#Ah2,F$)<>0:Cd$=GP(F$):CreateDirectory(Cd$):If ExaminePack(#Ah2)
c=0:d_f$=GetFilePart(F$):W NextPackEntry(#Ah2):n$=PackEntryName(#Ah2)
c_n$=GP(n$):nb=CountString(c_n$,"\"):For i=1 to nb:ex$=StringField(c_n$,i,"\")
CreateDirectory(ex$):SD(ex$):Next  i:SD(Cd$):Decompress():WE:EI:ClosePack(#Ah2)
ST(#p, 0):UW(GI(#p)):Mr("Fin" ,"All Uncompressed" ):RP(GD())
EI:Case #bc:F$="":ST(#p, 0):SetGadgetColor(#p, #PB_Gadget_FrontColor,
rgb(255,0,120)):F$=OpenFileRequester("load file to compress","c:\","*.*",0,
#PB_Requester_MultiSelection ):c_f$=F$:td=0:if CreatePack(#Ah,
GD()+ "mon_archive.zip",#PB_PackerPlugin_Zip)
Global newlist liste.s():W c_f$<>"":AddElement(liste.s()):liste.s()=c_f$
if FZ( c_f$ )<>-1 and FZ( c_f$ )<>-2:td=td+(FZ( c_f$ )):t_f=FZ( c_f$ ):SA(#p,
#PB_ProgressBar_Maximum , td):ST(#p, td-t_f):UW(GI(#p)):U:Break:EI:c_f$=Nn()
WE:ST(#p, 0) :UW(GI(#p)):ResetList(Liste()):CreateThread(@compress(),*bidon):U
Mr("Fin" ,"Error Of compression"):End:EI:ST(#p, 0):ES:Es
Until E = #PB_Event_CloseWindow:P compress(*bidon):static p_a:ForEach Liste()
td=FZ(Liste.s()):if td>0:p_a=p_a+td:AddPackFile(#Ah,Liste.s(),Mid(Liste.s(),4))
ST(#p, p_a):UW(GI(#p)):delay (190):U:Break:EI:NExt:R = ClosePack(#Ah)
Mr("Fin" ,"All compessed"):RP(GD()):ST(#p, 0) :UW(GI(#p)):EP:P Decompress()
UncompressPackFile(#Ah2,Cd$+n$):c=C+1:ST(#p,c) :UW(GI(#p)):WindowEvent():EP

My Deformer Punch (use Button mouse)

Code: Select all

;***********************************************
;Titre  :*deformer_punch
;Auteur  : Dobro
;Date  :07/07/2014
;Heure  :13:12:48
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Libairies necessaire : Aucune
; Connection internet Requise pour l'image
; Click pour deformerl'image a l'aide de la Souris
; ESCAPE pour quitter
;***********************************************
Macro M:Macro:EndMacro : M EM:End:End#M
M G:Global:EM#M :M P:Procedure:EM#M :M EP:Endprocedure:EM#M
M Dc:Declare:EM#M :M en:Enumeration:EM#M : M en2:EndEnumeration:EM#M
M W:Window:EM#M :M O:Open:EM#M :M IM:Image:EM#M :M OP:Output:EM#M
M D:drawing:EM#M :M S:Sprite:EM#M :M Q:Mouse:EM#M :M A1:Start:EM#M
M A2:Stop:EM#M :M X1:Endif:EM#M :M U:And:EM#M :M E1:examine:EM#M
M K1:keyboard:EM#M :M GT:GetTemporaryDirectory:EM#M :UseJPEG#IM#Decoder()
Dc  Action(oo):Dc  mouse_Sens(v.f):Dc.l Load#IM#_net(Ad$,ni$)
DisableDebugger:En:#win:#screen:En2:En:#pinceau:En2:Init#S():Init#Q():Init#K1()
Structure el :Id.l:x.l:y.l:d_x.f:d_y.f:c.l:EndStructure:g Dim el.el(1)
G im:G vy.f,vx.f:G nb=0:G tp=12:G v.f=0.8:G fr.f=v.f/6:G Bt
Ad$="http://lapeniche.net/wp-content/uploads/2013/12/Chat.jpg" :ni$="Chat.jpg"
G im=Load#IM#_net(Ad$,ni$):Resize#IM#(im,640,400):g il=IM#Width(im)
g ih=IM#Height(im):g T=(il* ih):G xp:G yp:G tt_i:Redim el.el(T):i=0
if O#W(#win,10,10,1024,768,"test"):if O#W#edScreen(W#ID(#win),1,1,640,400,1,1,
1):i=0:For y=1 to ih-1:For x=1 to il-1:A1#D(IM#OP#(im)):c.l=point(x,y)
A2#D():el(i)\id=i:el(i)\x=x:el(i)\y=y:el(i)\d_x.f=0:el(i)\d_y.f=0:el(i)\c.l=c.l
i=i+1:Next x:Next y:tt_i=i:Create#S(#pinceau,8,8,#PB_Sprite_PixelCollision)
A1#D(Sprite#OP(#pinceau)):circle(4,4,4,rgb(0,128,0)):A2#D():X1:X1:Repeat
E1#K1():E1#Q():Ev =W#Event():if Q#Button(#PB_#Q#Button_Left):Bt=1:Else:Bt=0:X1
xp=Q#x():yp=Q#y():A1#D(IM#OP#(im)):Action(oo):A2#D():A1#D(screen#OP#())
Draw#IM(IM#ID(im),0,0):A2#D():Q#_Sens(v.f):DisplayTransparent#S(#pinceau,Q#X(),
Q#Y()):FlipBuffers():ClearScreen(RGB(0,0,0)):Delay(2)
until  K1#Pushed(#PB_Key_Escape):P Action(oo):For i=1 to tt_i-1
if el(i)\x>= xp-nb U el(i)\x<=xp+tp U el(i)\y>= yp-tp U el(i)\y<=yp+tp
if Bt=1  U nb=0:if vx.f>0 :if el(i)\x>= xp-tp U el(i)\x<=xp+tp:el(i)\d_x.f=vx.f
X1:X1:if vx.f<0:if el(i)\x>= xp-tp U el(i)\x<=xp+tp:el(i)\d_x.f=vx.f:X1:X1
if vy.f>0:if el(i)\y>= yp-tp U el(i)\y<=yp+tp:el(i)\d_y.f=vy.f:X1:X1:if vy.f<0
if el(i)\y>= yp-tp U el(i)\y<=yp+tp:el(i)\d_y.f=vy.f:X1:X1:X1:X1
el(i)\x=el(i)\x+el(i)\d_x.f:el(i)\y=el(i)\y+el(i)\d_y.f:if el(i)\d_x.f>0
el(i)\d_x.f=el(i)\d_x.f-fr.f:X1:If el(i)\d_y.f>0:el(i)\d_y.f=el(i)\d_y.f-fr.f
X1:if el(i)\d_x.f<0:el(i)\d_x.f=el(i)\d_x.f-fr.f:X1:If el(i)\d_y.f<0
el(i)\d_y.f=el(i)\d_y.f-fr.f:X1:if el(i)\d_x.f<0:el(i)\d_x.f=0:X1
if el(i)\d_y.f<0:el(i)\d_y.f=0:X1:if el(i)\x> il-1:el(i)\x=0:X1:if el(i)\x< 0
el(i)\x=il-1:X1:if el(i)\y> ih-1:el(i)\y=0:X1:if el(i)\y<0:el(i)\y=ih-1:X1
plot(el(i)\x,el(i)\y,el(i)\c.l):Next i:Bt=0:nb=0:EP:P Q#_Sens(v.f)
Static mpx,mpy ,dx,dy:px=Q#x():py=Q#y():dx=Q#DeltaX():dy=Q#DeltaY():if px>mpx
vx.f=v.f:X1:if px<mpx:vx.f=-v.f:X1:if py>mpy:vy.f=v.f:X1:If py<mpy:vy.f=-v.f:X1
if px=mpx U py=mpy:nb=1:Else:nb=0:X1:mpx=px:mpy=py
if (dx<-2 or dx>2) or (dy<-2 or dy>2):nb=0:Else:nb=1:X1:EP
P.l Load#IM#_net(Ad$,ni$):InitNetwork():If ReceiveHTTPFile(Ad$, GT()+ni$)
iid=Load#IM#(#PB_Any, GT()+ni$):DeleteFile(GT()+ni$):ProcedureReturn iid:Else
X1:EP
; Epb

Fred watching you (old Code)

Code: Select all

;***********************************************
;Titre  :*fred_nous_surveille_Punch
;Auteur  : Dobro
;Date  :07/07/2014
;Heure  :13:50:11
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Libairies necessaire : Aucune
; un 20 Lignes :)
;***********************************************
Macro M:Macro:Endmacro :M E:End:Endmacro
M ST:Start:E#M :M StP:Stop:E#M :M W:Window:E#M :M CR:Create:E#M
M DR:Drawing:E#M :M DK:Desktop:E#M :M OP:Open:E#M :M OT:Output:E#M
M SP:Sprite:E#M :M KB:Keyboard:E#M :M EX:Examine:E#M :M ED:Endif :E#M
M PB:#PB_Ignore:E#M :#og=1 :#od=2 :Init#KB():R=Init#SP() :EX#DK#s()
EX = DK#Width(0) :EY =DK#Width(0):W#ID = OP#W(1, 0, 0, 100, 50 ,  "Fred",
#PB_#W#_SystemMenu|#PB_#W#_ScreenCentered ):Resize#W(1, EX-360,0, PB,PB)
Sticky#W(1,1):OP#W#edScreen(W#ID,0,0, 100, 50, 1, 0,0):Create#SP(#og,20,20)
Create#SP(#od,20, 20):ST#DR(SP#OT(#og) ):Circle(10,10,10,RGB(1,
1,1)):StP#DR():ST#DR(SP#OT(#od) ):Circle(10,10,10,RGB(1,1,1)):StP#DR()
xyg=15:yyg=15:xyd=115:yyd=15:Repeat:Delay(1):event = W#Event():Ex#KB()
If KB#Pushed( #PB_Key_Escape):End:ED:ST#DR( Screen#OT()):Circle(25,25,20,
RGB(0,200,255)):Circle(75, 25, 20 , RGB(0, 200, 255)):StP#DR()
DisplayTransparent#SP(#og,xyg,yyg):DisplayTransparent#SP(#od,
xyd,yyd):GetCursorPos_(CursorPos.POINT):MouseX=CursorPos\x:MouseY=CursorPos\y
xwin = W#X(1):ywin= W#Y(1):xyg=MouseX-xwin-11:xyd=MouseX-xwin-11
yyg=MouseY-ywin-25:yyd=MouseY-ywin-25:If xyg<5:xyg=5:ED:If xyg>25:xyg=25
EndIf:If xyd<55:xyd=55:ED:If xyd>75:xyd=75:ED:If yyg<5:yyg=5:ED
If yyg>25:yyg=25:ED:If yyd<5:yyd=5:ED:If yyd>25:yyd=25:ED:FlipBuffers()
ClearScreen(RGB(100, 100, 100)) :Until Event=#PB_Event_Close#W

the most beautiful Breakout of all time

(Arrow right/left/space)

Code: Select all

;***********************************************
;Titre  :*console_casse_brique
;Auteur  : Dobro
; Prg réalisé le 24/05/2005
;Heure  :14:47:07
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Libairies necessaire : Aucune
; 39 Lignes 80 colonnes
;***********************************************

Macro M:Macro:EndMacro :M E:End:EndMacro
M CC:ConsoleColor:E#M :M CL:ConsoleLocate:E#M :M CT:ConsoleTitle:E#M
M PR:Print:E#M :M ED:Endif:E#M :M NX :Next:E#M :M C:Console:E#M
M G:Gosub:E#M : debut: :Rs = Open#C():EnableGraphical#C(1):C#Cursor(0)
A$= " le plus beau casse brique de tout les temps ":CT(a$):CC(12,0):CL(17,1)
PR( a$):CC(15,0 ):CL (3,2)
PR( " ce programme necessite un pentium4 a 8 Ghz pour tourner correctement ")
CC(14,0 ):CL (22,5):PR(" Votre Score est de: "+Str(P)+ " points"):P=0:CC(10,0)
CL (10,10):PR( " pour jouer"):CL (10,11)
PR( " puis appuis sur la touche [espace] pour lancer la balle " ):CL(10,12)
PR( " les fleches dirigent la raquette " ):CC(15,0):CL(1,25)
PR( " Realise par Dobro en purebasic v3.93 sur un Cray !! " ):yy: :C$=Inkey()
Rs=RawKey():If Str(Rs)<>"32":C$= "":Goto yy:ED:Clear#C():C$= "":xr=35:yr=20
ybal=19:xbal=35:sensy=-1:sensx=1:bord$= "bas":Dim brique(60,15):Dim Co(15)
For yb=5 To 15 Step 2:For xb=15 To 59 Step 2:brique(xb,yb)=1:NX xb:NX yb
For coul=1 To 15:Co(coul)= Random (10)+5:NX coul:G Aff: :Repeat:G P_b:Delay(50)
C$=Inkey():Rs=RawKey():If Str(Rs)="39" :xr=xr+4:If xr>58:xr=58:ED:ED
If Str(Rs)= "37":xr=xr-4: If xr<4: xr=4: ED:ED:If Str(Rs)= "32":start=1:ED
If start=1 :ybal=ybal+sensy:xbal=xbal+sensx:ED:If xbal >66:G P_b:sensx=-sensx
bord$= "droit":ED:If xbal <8:G P_b:sensx=-sensx:bord$= "gauche":ED:If ybal >22
G P_b:sensy=-sensy:bord$= "bas":ED:If ybal <2:G P_b:sensy=-sensy:bord$= "haut"
ED:If start=1:If(xbal=xr+4 Or xbal=xr+5 Or xbal=xr+6 Or xbal=xr+7 )And ybal=20
R=1:ED:If ( xbal=xr+3 Or xbal=xr+8 ) And ybal=20:R=2:ED:ED:G Aff: :ForEver
Aff: :For yb=5 To 15 Step 2:For xb=15 To 59 Step 2:CC(Co(yb), 0):CL(xb,yb)
If ybal>20:C$= "":Close#C():Goto debut:ED
If (xbal=xb And ybal=yb) And start=1 And brique(xb,yb)=1:brique(xb,yb)=0:P=P+10
G P_b:If bord$= "gauche" Or bord$= "droit":sensx=-sensx:ED:
If bord$= "bas" Or bord$= "haut":sensy=-sensy:ED:ED:If R=1:R=0:sensy=-sensy:ED
If R=2:R=0:sensy=-sensy:sensx=-sensx:ED:If brique(xb,yb)=1:PR ( "=" ):Else
PR(" "):ED:NX xb:NX yb:CL (xr,yr):CC(15, 0):PR( Chr(32)+"   =====   "+Chr(32))
CL (0,yr-1):PR ( Space (66)):CL (0,yr+1):PR(Space (66)):For y=0 To 24:CL(7,y)
PR( "|" ):CL(67,y):PR( "|" ):NX y:For x=0 To 79:CL(x,1):PR("-")
CL(x,23):PR ("-"):NX x:CL (70,3):CC(11,0):PR("points"):CL(72,4):CC(11,0)
PR(Str(P)):Return:P_b: :If sensy<0 And sensx>0:CC(14, 0):CL (xbal,ybal):PR("o")
CL(xbal-1,ybal+1):PR (" "):Goto su2:ED:If sensy<0 And sensx<0 :CC(14,0)
CL(xbal,ybal):PR("o"):CL(xbal+1,ybal+1):PR(" "):Goto su2:ED
If sensy>0 And sensx>0:CC(14,0):CL(xbal,ybal):PR("o"):CL(xbal-1,ybal-1):PR(" ")
Goto su2:ED:If sensy>0 And sensx<0:CC(14,0):CL(xbal,ybal):PR ("o")
CL (xbal+1,ybal-1):PR (" "):Goto su2:ED:su2: :Return

the Tron (only Arrow right/left)

Code: Select all

;***********************************************
;Titre  :*tron_punch
;Auteur  : Dobro
;Date  :07/07/2014
;Heure  :16:45:17
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Libairies necessaire : Aucune
; utilisation fleche droite/Gauche
; une assistance existe seulement pour les murs exterieurs ..
;les fleches sur le Bords Exterieur indique le sens du rebond de l'assistance
;***********************************************
Macro M:Macro:Endmacro :Macro E:End:Endmacro : M RS:RandomSeed:Endmacro
M ST:StartDrawing:E#M :M SP:StopDrawing:E#M :M CO:ScreenOutput:E#M
M SPO:SPriteOutput:E#M :M Pro:Procedure:E#M :M DT:DrawText:E#M
M MG:MessageRequester:E#M :M PO:point:E#M :M G:Goto:E#M
M D:Random:E#M :M W:Window:E#M :M CLS:ClearScreen:E#M :M ED:Endif:E#M
M KR:KeyboardReleased:E#M :Declare tir(ss) :Global xo,yo,ymissille,tir:#o=1
M DP:DisplaySprite:E#M :M R:RGB:E#M :M A:And:E#M :M C:Case:E#M
M PK:#PB_Key:E#M :M Z:If:E#M:#j=2:InitKeyboard():Vt=10:vtj=10:Declare T_C(x)
InitSprite():i=350:j=1000:k=800:L=600:Q=780:U=580:U1=560:U2=760
ExamineDesktops():Wid = Open#W(1, 0, 0, k, L,"TRON Par Dobro",
#PB_#W#_SystemMenu|#PB_#W#_BorderLess|#PB_#W#_ScreenCentered):Wid =W#ID(1)
Open#W#edScreen(Wid,0,0,k,L,1,0,0):SetFrameRate(60):CreateSprite(#o,10,10)
CreateSprite(#j,10,10):ST(SPO(#o)):Box(0,0,10,10,R($FF,0,0)):SP():ST(SPO(#j))
Box(0,0,10,10,R(0,0,$FF)):SP():du: :R=50:V=50:B=50
sc$="You="+Str(Sch)+" TRON ="+Str(sct):Set#W#Title(1, Sc$):ST(CO())
Box(0, 0, k,L,R($FF,$FF,0)):SP():ST(CO()):Box(10,10,Q,U,R(0,0,0))
FrontColor(R(0,$FF,0)):BackColor(R(0,0,0)):SP():CoJ=0:xo=450
yo=200:xj=300:yj=500:de=D(j):RS(de):P1=D(3)+1:de=D(j):RS(de):ss=D(3)+1:Repeat
Delay(50):Event=W#Event():ExamineKeyboard():Z  P1=1:yj-VtJ:ST(CO()):
CoJ=PO(xj,yj):CJg=PO(xj-4,yj):Cd=PO(xj+14,yj):SP():t=T_C(CoJ):Z t=2:G su:ED:ED
If P1=2:xj+VtJ:ST( CO()):CoJ=PO(xj, yj):Cg=PO(xj, yj-4):Cd=PO(xj, yj+14):SP()
t=T_C(CoJ):Z t=2:G su:ED:ED:Z P1=3:   yj+VtJ:ST(CO()):CoJ=PO(xj, yj)
Cg=PO(xj-2,yj):Cd=PO(xj+14,yj):SP():t=T_C(CoJ):Z t=2:G su:ED:ED:Z P1=4:xj-VtJ
ST(CO()):CoJ=PO(xj, yj):Cg=PO(xj, yj+14):CJd=PO(xj,yj-4):SP():t=T_C(CoJ):Z t=2
G su:ED:ED:Gosub assm:If KR( PK#_Left):t=T_C(CoJ):Z t=2:G su:ED:P1-1:dob=1
Z P1<1:P1=4:ED:ED:Z KR(PK#_Right):t=T_C(CoJ):Z t=2:G su:ED:P1+1:dob=1:Z P1>4
P1=1:ED:ED:Select ss:C 1:ST(CO()):C1=PO(xo,yo-4):C2=PO(xo-4,yo):C3=PO(xo+14,yo)
SP():Z C1>0 A C2>0 A C3>0:tto=1:G su:ED:Z C1>0:If C3=0 A C2=0:de=D(2)+1:Z de=1
ss=4:G su:ED:Z de=2:ss=2:G su:ED:ED:If C3=0:ss=2:G su:ED:Z C2=0:ss=4:G su:ED:ED
Z  yo>10:yo-Vt:Else:ss=2:ED:C 2:ST(CO()):C1=PO(xo+13,yo):C2=PO(xo,yo-4)
C3=PO(xo,yo+13):SP():If C1>0 A C2>0 A C3>0:tto=1:G su:ED:Z C1>0:Z C2=0 A C3=0
de=D(2)+1:Z de=1:ss=3:G su:ED:Z de=2:ss=1:G su:ED:ED:Z C2=0:ss=1:G su:ED
If C3=0:ss=3:G su:ED:ED:Z xo<=Q:xo+Vt:Else:ss=3:ED:C 3:ST(CO()):C1=PO(xo,yo+14)
C2=PO(xo+14,yo):C3=PO(xo-4,yo):SP():If C1>0 A C2>0 A C3>0:tto=1:G su:ED:Z C1>0
Z C3=0 A C2=0:de=D(2)+1:If de=1:ss=2:G su:ED:Z de=2:ss=4:G su:ED:ED:Z C3=0:ss=4
G su:ED:Z C2=0:ss=2:G su:ED:ED:Z  yo<U:yo+Vt:Else:ss=4:ED:C 4:ST(CO())
C1=PO(xo-4,yo):Co2=PO(xo,yo-4):C3=PO(xo,yo+14):SP():Z C1>0 A C2>0 A C3>0:tto=1
G su:ED:Z C1>0:Z C2=0 A C3=0:de=D(2)+1:Z de=1:ss=3:G su:ED:Z de=2:ss=1:G su:ED
ED:Z C2=0:ss=1:G su:ED:Z C3=0:ss=3:G su:ED:ED:Z xo>10:xo-Vt:Else:ss=1:ED
E#Select:su: :Gosub msgx:DP(#o,xo,yo):DP(#j,xj ,yj):FlipBuffers()
R+1:ST(SPO(#o)):R=D(55)+200:h=R(R,100,50):Box(0,0,10,10,h):SP():ST(SPO(#j))
B=D(55)+200:h=R(150,0,B):Box(0,0,10,10,h):SP():Until Event=#PB_Event_Close#W
End:PRO T_C(CoJ):If CoJ>0 Or CoJ>0 Or CoJ>0:t=2:else:t=0:ED:PRO#Return t:
E#Pro:msgx: :If tto=1:tto=0:MG("Tron","U Win",#PB_#MG#_Ok):CLS(R(0,0,0)):Sch+1
G du:ED:Z t=2:t=0:MG("Tron", "I Win", #PB_#MG#_Ok ):CLS(R(0,0,0)):sct+1:G du:ED
Return:assm: :Z xj-VtJ<10 A Cg=0 A P1=4:P1=3:ED:If xj-VtJ<10 A Cd=0 A P1=4
P1=1:ED:Z xj-VtJ>U2 A Cg=0 A P1=2:P1=1:ED:Z xj-VtJ>U2 A Cd=0 A P1=2:P1=3:ED
If yj-VtJ<10 A Cg=0 A P1=1:P1=4:ED:Z yj-VtJ<10 A Cd=0 A P1=1:P1=2:ED
Z yj-VtJ>U1 A Cg=0 A P1=3:P1=4:ED:If yj-VtJ>U1 A Cd=0 A P1=3:P1=2:ED:Return


;


;
; Epb

Video Player

Code: Select all

;***********************************************
;Titre  :*Magneto
;Auteur  : Dobro
;Date  :08/07/2014
;Heure  :10:38:24
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.56
; Codé a l'epoque en PB V 3.72 !!
; Libairies necessaire : Aucune
; quitte le plein ecran avec ESCAPE
; Lecteur de Video
;***********************************************

Macro M:Macro:Endmacro :M E:End:EndMacro
M MSG:MessageRequester:E#M :M GS:GadgetState:E#M :M Z:Movie:E#M
M BG:ButtonGadget:E#M :M W:Window:E#M :M G:Gadget:E#M :M S:Screen:E#M
M EI:ElseIf:E#M :M EF:Endif:E#M :M PR:Procedure:E#M :M T:Goto:E#M
M TB:TrackBar:E#M :M R:Resume:E#M :M P:Pause:E#M :debut: :Enumeration :   #Win
#c:#Pl:#St:#Pa:#Ba:#Fr:#Q:#Plc:EndEnumeration:Global wl,wh,lg,hg,El,Eh
ExamineDesktops():El=DesktopWidth(0):Eh=DesktopHeight(0):Declare  Open_Win()
Init#Z():initsprite():InitKeyboard():Open_Win():Repeat:Ev = Wait#W#Event(2)
If Ret=1:Ret=0:if Load#Z(1, Nf$):fc=1:WI = W#ID(#Win) :Play#Z(1, WI)
Res=Z#Seek(1,po):TB#G( #Ba,20,wh-80,550,20,0,Longueur/100,#PB_#TB#_Ticks)
Resize#Z(1,10, 10,lg,hg):EF:EF:If bo=1:po=Get#GS(#Ba)*100:bo=0:Res=Z#Seek(1,po)
Delay(25):R#Z(1):EF:if Is#Z(1):fr=Z#Status(1):If fr>0:Set#GS(#Ba,fr/100):EF:EF
If Ev = #PB_Event_#G:Gi=Event#G():If Gi=#c
Nf$=OpenFileRequester("charge un fichier video", "c:\", "Video|*.avi",0)
if Nf$<>"":Res=Load#Z(1,Nf$):If Res=0
MSG("ALERTE !!","Ce format de Fichier n'est pas reconnu ",#PB_#MSG#_Ok):fc=0
T suite:EF:fc=1:Lo=Z#Length(1)
TB#G(#Ba,20,wh-90,550,20,0,Lo/100,#PB_#TB#_Ticks):Resize#Z(1,10,10,lg,hg)
EF:EI Gi=#Pl:If Pa=1:R#Z(1):Pa=0:T suite:EF:WI=W#ID(#Win):If fc=0
MSG("ALERTE !!","Aucun Fichier n'est chargé !! ",#PB_#MSG#_Ok):ST=0
T suite:EF:Play#Z(1,WI):EI Gi=#St:If fc=1:Stop#Z(1)
EF:ST=1:EI Gi=#Pa:If fc=1:P#Z(1):Pa=1:EF:EI Gi=#Ba:P#Z(1):   bo=1
T suite:EI Gi=#Plc:If fc=1:po=Get#GS(#Ba)*100:Free#Z(1):Close#W(#Win)
Ev=#PB_Event_Close#W:T plein_ecran:EF:EI Gi= #Q:ST=0:E:EF:EF:suite:
Until Ev=#PB_Event_Close#W:If ST=0 And fc=1:if Is#Z(1):Free#Z(1):EF:fc=0:EF:E
plein_ecran: :Res = Open#S(El,Eh,32,""):If fc=1:Res=Load#Z(1,Nf$):EF
Play#Z(1,S#ID()):Z#Seek(1,po):Resize#Z(1,50,0,El,Eh):Repeat:ExamineKeyboard()
Delay(1):Until (Z#Status(1)=Z#Length(1)-2) Or KeyboardPushed(#PB_Key_Escape)
If Z#Status(1)>0:po=Z#Status(1):EF:Free#Z(1):suite2: :Clear#S(rgb(0,0,0))
Close#S():fc=0:Ret=1:T debut:PR Open_Win():   If Open#W(#Win, 216, 80, 800, 500,
"Dobro Player",  #PB_#W#_SystemMenu|#PB_#W#_#S#Centered|#PB_#W#_TitleBar)
wl=W#Width(#Win):wh=W#Height(#Win):BG(#c,40,wh-50,130,30,"Charge un film")
BG(#Pl, 200, wh-50, 60, 30, "Play"):BG(#St,340,wh-50,60,30,"Stop"):BG(#Pa, 270,
wh-50, 60, 30, "Pause"):BG(#Plc,410,wh-50,60,30,"plein ecran"):BG(#Q, 480,
wh-50, 60, 30, "Quitter"):Frame#G(#Fr, 10, 10, wl-20, wh-100, "Film")
lg=G#Width(#Fr):hg=G#Height(#Fr):EF:E#PR
; Epb

and finally a small tribute to the game "Outrun"

Code: Select all

 Macro M:Macro:EndMacro:M E:End:EndMacro:M LM:LoadMusic:EndMacro:chm$="http://m"+
"ichel.dobro.free.fr/Forum_pb/Outrun3.mod":RandomSeed(8):Te$="OutRun Nostalgy "+
".....Punch 2014.... Pure Basic Power ... By Dobro":M G:Global:EndMacro;########
M ST:StartDrawing:E#M:M R1:StopDrawing:E#M:M PR:Procedure:E#M:M DC:Declare:E#M;#
M EF:EndIf:E#M:M CSP:CreateSprite:E#M:G U1=100:M R2:DisplaytransparentSprite:E#M
M OP:Open:E#M:M Wi:Window:E#M:M R3:Sprite:E#M:M OT:Output:E#M:M GC:GradientColor
EndMacro:M DR:Drawing:E#M:M DE:Random:E#M:M EX:Examine:E#M:M R4:ClearScreen:E#M;
M GT:GetTemporaryDirectory:E#M:M Z :Next:E#M:G py=550:G d_v=600:G yb:G j=255;###
M EV:Event:E#M:M FB:FlipBuffers:E#M:M R6:SystemParametersInfo_:E#M:G k=1024,;###
k1=768,U=300:M SA:Static:E#M:M PC:PixelCollision:E#M:M MB:MouseButton:E#M:G mx.f
M PT:Protected:E#M:M SE:Structure:E#M:M P:RGB:E#M:Init#R3():InitMouse():G my.f;#
M RH:ReceiveHTTPFile:E#M:M LG:LinearGradient:E#M:M FC:FrontColor:E#M:G my=50,mx;
InitSound():G Lg=k,H=k1:M TW:TextWidth:E#M:M DT:DrawText:E#M:M IN:InitNetwork;##
EndMacro:M DF:DeleteFile:E#M:M PM:PlayMusic:E#M:G d2.f,d3.f,md=U1:G Dim bx(201);
G Dim bY(201):G xt=Lg:DC C_e():DC ET():DC RD():DC OD(spr,x,y,tx,xt,Te$,co);#####
DC.l LMN(a$,n_m$):G W=1000:M RM:ReleaseMouse:E#M:G U2=200:SE dg:x.w:y.w:sx.l;###
sy.l:E#SE:G dg.dg:dg\sy.l=10:dg\sx=0:dg\x.w=0:dg\y.w=0:R6#(75,#False,0,0);######
LoadFont(0,"Arial",50,256):Op#Wi(0,0,0,Lg,H,"",C80000):Op#Wi#edScreen(Wi#ID(0),;
0,0,k,k1,0,0,0):mo=LMN(chm$,"Outrun3.mod"):CSP(0,k,10,#PB_#R3#_#PC):ST(R3#OT(0))
Box(0,0,k,10,P($0,$84,$42)):Box(U,0,400,10,P($A4,$A4,$A4)):Box(U,0,30,10,P($C7,;
$C7,$C7)):Box(700,0,30,10,P($C7,$C7,$C7)):R1():CSP(1,k,50,#PB_#R3#_#PC);########
ST(R3#OT(1)):Box(0,0,k,50,P($0,$84,$42)):Box(U,0,400,50,P($50,$79,$85)):Box(U,0,
30,50,P($F1,$1F,$1)):Box(700,0,30,50,P($F1,$1F,$1)):R1():ys=599:Repeat:ET();####
tm=DE(50,1):t2=DE(10,1):If t2=8:dv=DE(25,1):If dv>12:dv=-dv:EF:EF:If tm=1:dp=0+;
DE(50,1):If dp>25:dp-dp:EF:EF:If dp >0:d2.f=d2-2:EF:If dp <0:d2=d2.f+2:EF;######
If dp2<U1:If d2<-U1:d2+1:EF:d2+1:EF:If d2>U1:d2-1:EF:If dv >0:d3-2:EF:If dv <0:;
d3+2:EF:If d3<25:d3+1:EF:If d3>80:d3-1:EF:mx=d2/U1:my=d3.f/U1:EX#Mouse();#######
If MB(2):E:EF:G Lg=k,ta=10,C=U2,C1=Sin(C):x=2:y=2:co.l=$0:tx=Lg:xt-8:If xt<-Lg*3
xt=Lg:EF:OD(1008,x,y,tx,xt,Te$,co):RD():FB():R4($0):EV=wait#Wi#Ev(2):Until EV=0+
13116:R6#(75,1,0,0):RM(1):E:PR C_e():SE eo:x.i:Y.i:z.f:pas.i:co.i:E#SE:SA F_e;##
G Dim eo.eo(W):If F_e=0:For i=1 To W-1:eo(i)\x=-Lg/2+(DE(Lg)+1):eo(i)\Y=-H/2+;##
DE(H)+1:eo(i)\z=DE(W)+1:eo(i)\pas=(DE(3)+1)*2:eo(i)\co=P(DE(j),DE(j),DE(j));####
CSP(2+i,6,6):ST(R3#OT(2+i)):Circle(3,3,2,eo(i)\co):R1():Z i:F_e=1:EF:E#PR;######
PR ET():SA F_e:If F_e=0:C_e():F_e=1:EF:sp=20:F=U2:For i=1 To W-1:eo(i)\z=0+;####
eo(i)\z-sp:If eo(i)\z<=1:eo(i)\z=W:EF:XR=(F*eo(i)\x)/eo(i)\z+Lg/6+(mx*U2);######
YR=(F*eo(i)\Y)/eo(i)\z+H/3+(my*U2):R2(2+i, XR,YR):Z i:E#PR:PR RD();#############
SA C1,C,cmt:For b=0 To U2:Lg=Lg+ta:bx(b)=px+(mx/60)*C*C-((ta/2)* b)+420;########
bY(b)=py+b-(my)*C:Zoom#R3(0,Lg-1030,10):R2(0,bx(b),bY(b),J):C=C-1;##############
If C<0:C=U2:EF:Z b:Lg=k:For b=0 To U2:cmt=cmt+1;################################
xb=px+(mx/60)*C1*C1-((5)* b)+420:Zoom#R3(1,Lg-1030,2):If  cmt%21>=10;###########
yb=bY(b):For ii=0 To d_v:R2(1,xb,yb,J):Z ii:EF:Lg=Lg+10:C1=C1-1:If C1<0;########
C1=200:EF:Z b:E#PR:PR OD(spr,x,y,tx,xt,Te$,co):PT px,py,mmy,L.s,ty,yt;##########
mmy=ty:SA ao.f:#Va=1*#PI/50:#Hs=50:#LS=50:ty=#Hs*4:yt=#Hs*2:If CSP(spr,tx,ty);##
ST(R3#OT(spr)):DR#Font(FontID(0)):ao+#Va:If ao>=2*#PI:ao=0:EF:px=10;############
For n=1 To Len(Te$):L.s=Mid (Te$, n,1):py=#Hs*Sin(ao+px/#LS )-ty/4:If co=0;#####
DR#Mode(#PB_2D#DR#_Gradient|#PB_2D#DR#_Transparent):BackColor($0):For i=0 To J;#
GC(0.4, P(i,0,0)):GC(0.8,P(0,i,0)):GC(0.16,P(0,0,i)):GC(0.32,P(0,i,i)):GC(0.64,;
P(i,i,0)):Z i:LG(0,0,tx,ty):EF:DT(xt+px,yt+py,L):px+TW(L):Z:R1();###############
R2(spr,x,y):Free#R3(spr):EF:E#PR:PR.l LMN(a$,n_m$):IN():If RH(a$,GT()+n_m$);####
:i_m=LM(#PB_Any,GT()+n_m$):PM(i_m):DF(GT()+n_m$):PR#Return i_m:EF:E#PR;#########

Matrix punch

Code: Select all

;***********************************************
;Titre  :*Matrix_original
;Auteur  : Dobro
;Date  :14/07/2014
;Heure  :11:19:17
;Version Purebasic :  PureBasic 5.22 LTS (Windows - x86)
;Version de l'editeur :EPB V2.58
; Libairies necessaire : Aucune 
;***********************************************
Enumeration:#Window_0:#code:#Text_0:EndEnumeration:nbrsprite=18:taille_fonte=10
Dim ysprite(1000):Dim de(1000):Dim nom$(nbrsprite):Dim index(nbrsprite)
Dim y(nbrsprite):sprite=1:#Police=1:Param.s=Left(ProgramParameter(),2)
If Param="/p":End:EndIf:GetCursorPos_(SoOri.POINT):ShowCursor_(0)
InitSprite():FontID = LoadFont(#Police,"arial",taille_fonte, #PB_Font_Bold )
ExamineDesktops():EcranX =DesktopWidth(0):EcranY=DesktopHeight(0)
OpenWindow(1,0,0,EcranX,EcranY,"Matrix",#PB_Window_BorderLess ):StickyWindow(1,
1):OpenWindowedScreen(WindowID(1),0,0,EcranX,EcranY,1,0,0)
For reserv=1 To nbrsprite:nom$(reserv)=Space(30) :Next reserv
For spr=1 To nbrsprite:CreateSprite(spr,24,27*Len(nom$(spr)),0):
For chaine=33 To 58:car$=Chr(chaine+Random(223)):y(spr)=y(spr)+27
StartDrawing(SpriteOutput(spr)):BackColor($0):c=c+10:If c>255:c=20:EndIf
If chaine=58:c=0:EndIf:FrontColor(RGB(0,c,0)):If chaine=57:FrontColor($82FF82)
EndIf:DrawingFont(FontID):DrawText(0,y(spr),car$):long = TextWidth(nom$(1))
StopDrawing():Next chaine:Next spr:xrez=Int(EcranX/27):Dim col(xrez)
For t=1 To EcranX Step 27:col(h)=t:h+1:du: :Next t:indexc=0:For ind=1 To xrez
ysprite(ind)=-(long*2)-Random(long*10):If Col<>EcranX:indexc=indexc+1
de(ind)=col(ind):Else:indexc=0:EndIf:Next ind:indexc=0:pseud=255:Repeat
RandomSeed(Random(255)):For ind=1 To xrez:If ysprite(ind)>EcranY
ysprite(ind)=-(2+long*2)-Random(long*2):EndIf:spr=spr+1:If spr>nbrsprite:spr=1
EndIf:ysprite(ind)=ysprite(ind)+Random(8)+2:
DisplaySprite(spr,de(ind),ysprite(ind)):Next ind:If pseud>=380:pseud=254:EndIf
If dobro=0:StartDrawing( ScreenOutput()):BackColor($0):FrontColor($7800)
DrawingFont(FontID):DrawText(EcranX-200,EcranY-35,"By Dobro"):StopDrawing()
EndIf:FlipBuffers():ClearScreen($0):GetCursorPos_(So.POINT)
Until WindowEvent()=13116 Or So\x<>SoOri\x Or So\Y<>SoOri\Y:ShowCursor_(1)
; Epb

Posted: **Sun Jul 13, 2014 12:03 am**

I got this errors:

Packer/depacker Zip
[COMPILER] Line 37: UpdateWindow_() is not a function, array, list, map or macro.

My Deformer Punch
Opens window in bottom left corner and I had to kill it via an other console.

Fred watching you
[COMPILER] Zeile 25: GetCursorPos_() is not a function, array, list, map or macro.

the most beautiful Breakout of all time
Does not show anything but a high CPU usage.

the Tron
I am not able to control the game.
[ERROR] Zeile: 36
[ERROR] Point() ist außerhalb des Zeichenbereichs.

Video Player
First an alert: "Ce format de Fichier n'est pas reconnu"
[ERROR] Zeile: 25
[ERROR] Invalid memory access.

and finally a small tribute to the game "Outrun"
[COMPILER] Zeile 17: SystemParametersInfo_() is not a function, array, list, map or macro.

I hope there will be some submissions which work on all operating systems. Only Windows is bad.

Posted: **Sun Jul 13, 2014 12:57 am**

NicTheQuick wrote: I hope there will be some submissions which work on all operating systems. Only Windows is bad.

To be fair some punches won't run on linux due to compiler bugs and others are of course windows specific.
It would be nice however if people at least tested their submissions on linux or osx if they could before shrinking the entry

I'm going to try PB5.22 in wine to see if I can run some of the entries as the xp VM just won't run some entries

PureBasic Forums - English

PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014

Re: PurePunch Contest July-August 2014