PureBasic

bon , voici ma participation .. (me foule pas ... )

c'est un utilitaire (Packer/depacker ZIP ) en 39 lignes

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

ps: si toutefois je gagnais , je désire que le Kit aille chez G-rom , qui en fera meilleurs usage que moi
avec ses Bananes

Pourrais-tu le modifier pour qu'il se compile nativement avec PureBasic STP ? Il te reste assez de ligne je pense. Merci !

Arf ! Pardon , je croyais que le Signe "_" faisait parti des signes de sésure de ligne

mais c'est une particularité de EPB ....

Dobro a écrit :Arf ! Pardon , je croyais que le Signe "_" faisait parti des signes de sésure de ligne

mais c'est une particularité de EPB ....

Je ne sais pas, je ne connais pas toutes les nouvelles subtilités de l'éditeur... C'est une chouette possibilité, surtout pour les défis comme celui-là !

Merci d'avoir modifié !

Hello,

Pour info, il semble que le mode 800x600 en plein écran ne passe plus sur certains ordi windows 8.
En tous les cas, chez moi, plus possible de compiler ou exécuter un truc avec cette résolution.
Vous avez remarqué ça aussi ?

Minuscule contribution inspirée de "Va!n" sur feu DBF

Code : Tout sélectionner

;*****************************************************************************
;*
;* July-August 2014 PurePunch contest
;* PureBasic 5.22
;* 50 lines of 80 chars, 2 months delay
;*
;* Name     : Interference Circles
;* Author   : TazNormand
;* Date     : 04 July 2014
;* Notes    : largely inspired by "va!n aka 'thorsten will" thanks to him
;*
;*****************************************************************************
Macro dts:DisplayTransparentSprite:EndMacro
Macro tsc:TransparentSpritecolor:EndMacro:Macro cr:circle:EndMacro
InitSprite():InitKeyboard():ExamineDesktops()
dw=DesktopWidth(0):dh=DesktopHeight(0):posx=dw+100:cl=1
OpenScreen(dw,dh,32,"Tribute to va!n aka 'Thorsten Will'")
CreateSprite(0,Int(dw*1.6),Int(dh*1.6),#PB_Sprite_AlphaBlending)
CreateSprite(1,Int(dw*1.6),Int(dh*1.6),#PB_Sprite_AlphaBlending)
CreateSprite(2,500,64,#PB_Sprite_AlphaBlending)
fntid=LoadFont(1, "Arial", 24)
StartDrawing(SpriteOutput(2))
  DrawingFont(fntid)
  DrawText(0,0,"PurePunch Contest Summer 2014!!!",RGBA(128,255,128,0))
StopDrawing()
For ls = 0 To 1
  StartDrawing(SpriteOutput(ls))  
  For i = 0 To dw*1.6 Step 24:cl!1
    If ls=0
      cr((dw*1.6)/2,(dh*1.6)/2,(dw*1.6)-i,RGB((i/(dw*1.6)*255)*cl,0,0))
    EndIf
    If ls=1
      cr((dw*1.6)/2,(dh*1.6)/2, (dw*1.6)-i, RGB(0,0,(i/(dw*1.6)*255)*cl))
    EndIf
  Next
  StopDrawing()
Next
Repeat
  ClearScreen(0)
  ExamineKeyboard()
  tsc(0,0):Tsc(1,0):tsc(2,0):
  dts(0,(((dw*1.6)-dw)/-2)+Cos(m2.d)*150, (((dh*1.6)-dh)/-2)+Sin(m.d)*50)
  dts(1,(((dw*1.6)-dw)/-2)+Sin(m.d)*50, (((dh*1.6)-dh)/-2)+Cos(m.d)*50)
  dts(2,posx,512+Cos(m2.d)*150)
  posx-5
  If posx<-500:posx=dw+100:EndIf
  m.d  = m.d  + 0.07:m2.d = m2.d + 0.032
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Merci pour les yeux et l'estomac TazNormand

Bravo. Nous revoila au temps de l'amiga dans les annees 80

Mon code est mise à jour : Ajout de sprites pour indiquer le nombre de vies, de tortues trouvées et du temps restant.

Voir et télécharger le code sur le message d'origine : http://www.purebasic.fr/french/viewtopi ... 66#p164166

Hop, mon premier code, il n'est pas super car il ne permet aucune interaction, et ne fait absolument pas ce que je voulais faire à la base...
Simplement c'est un essai pour voir si je pouvais faire tenir mon moteur de dynamique des fluides dans les limites du Punch !

Et ça rentre ! En 50 ligne tout pile. (Quand j'ai eu fini, j'en avais 50 lignes + 28 caractères, mais j'ai coupé dans le vif pour faire entrer l'essentiel.
Le code initial, commenté et propre fait 525 lignes

[edit] V3 : quelques modifs et amélioration de la qualité du code
V4 : compatibilité vers linux et mac (second code car ce n'est pas possible de réduire le code avec la taille des constantes !)

VERSION Windows

Code : Tout sélectionner

;******************************************************************************* 
;* 
;* July-August 2014 PurePunch contest 
;* PureBasic 5.22 
;* 50 lines of 80 chars, 2 months delay 
;* 
;* Name : Fluid Dynamics Game Engine  
;* Author : Graph100 
;* Date : 07/07/2014 
;* Notes : Made from reading Jos Stam's article 
;* "Real-Time Fluid Dynamics for Games" 
;*  
;* Version 3 Windows
;******************************************************************************* 
DisableDebugger:Macro M:Macro:EndMacro:M E:End:End#M:M A1:Array:EndMacro;#######
M N:Next:E#M:M F(i,j,k):For i=j To k:E#M:M St:Structure:E#M:M P:Procedure:E#M;##
M El:ElapsedMilliseconds():E#M:M Ti(a,s):a=AllocateMemory(SizeOf(s));###########
Initialize#St(a,s):EndMacro:Macro AO(o,f,a,b):Define.d x,y,s0,t0,s1,t1,t0u,t0v;#
t0u=s\t*f\m:t0v=s\t*f\m:i0=Round(o\x,0):j0=Round(o\y,0):i1=i0+1:j1=j0+1;########
s1=o\x-i0:s0=1-s1:t1=o\y-j0:t0=1-t1:o\u=t0u*(s0*(t0*a(i0,j0)+t1*a(i0,j1))+;#####
s1*(t0*a(i1,j0)+t1*a(i1,j1))):o\v=t0v*(s0*(t0*b(i0,j0)+t1*b(i0,j1))+s1*(t0*b(i1,
j0)+t1*b(i1,j1))):o\x=o\x+o\u:o\y=o\y+o\v:If o\x<1:o\x=1:E#If:If o\x>f\W:o\x=f\W
E#If:If o\y<1:o\y=1:E#If:If o\y>f\H:o\y=f\H:E#If:EndMacro:M AF(o,a,b,c,d);######
AddElement(o):o\x=a:o\y=b:o\u=c:o\v=d:o\g=Sqr(c*c+d*d):EndMacro:M AOb(o,a,b);###
AddElement(o):o\x=a:o\y=b:EndMacro:St t:A1 t.d(0,0):E#St:St Fl:a.d:W.l:H.l:e.l;#
f.l:m.d:*u.t:*v.t:*s.t:*t.t:E#St:St Ob:x.d:y.d:u.d:v.d:E#St:St Sv:x.l:y.l:u.d;##
v.d:g.d:E#St:St Sf:F.Fl:t.d:List O.Ob():List Sv.Sv():E#St:P BC(*o.Fl,Mo,;#######
A1 x.d(2)):If Mo=2:F(i,1,*o\W):x(i,0)=-x(i,1):x(i,*o\f)=-x(i,*o\H):N:Else:F(i,1,
*o\W):x(i,0)=x(i,1):x(i,*o\f)=x(i,*o\H):N:E#If:If Mo=1:F(i,1,*o\H):x(0,i)=-x(1,;
i):x(*o\e,i)=-x(*o\W,i):N:Else:F(i,1,*o\H):x(0,i)=x(1,i):x(*o\e,i)=x(*o\W,i):N;#
E#If:x(0,0)=(x(1,0)+x(0,1))/2:x(0,*o\f)=(x(1,*o\f)+x(0,*o\H))/2:x(*o\e,0)=(0+;##
x(*o\W,0)+x(*o\e,1))/2:x(*o\e,*o\f)=(x(*o\W,*o\f)+x(*o\e,*o\H))/2:E#P;##########
P LS(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),a.d,c.d):F(k,0,20):F(i,1,*o\W):F(j,1,*o\H);##
x(i,j)=(x0(i,j)+a*(x(i-1,j)+x(i+1,j)+x(i,j-1)+x(i,j+1)))/c:N:N:BC(*o,MO,x()):N;#
E#P:P AD(*o.Fl,A1 x.d(2),A1 s.d(2),t.d):F(i,0,*o\e):F(j,0,*o\f):x(i,j)=x(i,j)+;#
t.d*s(i,j):N:N:E#P:P Di(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),d.d,t.d):a.d=t*d**o\W**o\H
LS(*o,MO,x(),x0(),a,1+4*a):E#P:P Av(*o.Fl,MO,A1 d.d(2),A1 d0.d(2),A1 u.d(2),;###
A1 v.d(2),t.d):t0_u.d=t**o\m:t0_v.d=t**o\m:F(i,1,*o\W):F(j,1,*o\H):x.d=i+;######
-t0_u*u(i,j):y.d=j-t0_v*v(i,j):If x<0.5:x=0.5:E#If:If x>*o\W+0.5:x=*o\W+0.5:E#If
i0=Round(x,0):i1=i0+1:If y<0.5:y=0.5:E#If:If y>*o\H+0.5:y=*o\H+0.5:E#If:j0=0+;##
Round(y,0):j1=j0+1:s1.d=x-i0:s0.d=1-s1:t1.d=y-j0:t0.d=1-t1:d(i,j)=s0*(t0*d0(i0,;
j0)+t1*d0(i0,j1))+s1*(t0*d0(i1,j0)+t1*d0(i1,j1)):N:N:BC(*o,MO,d()):E#P;#########
P Pr(*o.Fl,A1 u.d(2),A1 v.d(2),A1 q.d(2),A1 dv.d(2)):F(i,1,*o\W):F(j,1,*o\H);###
dv(i,j)=-((u(i+1,j)-u(i-1,j)+v(i,j+1)-v(i,j-1))/*o\m)/2:q(i,j)=0:N:N:BC(*o,0,;##
dv()):BC(*o,0,q()):LS(*o,0,q(),dv(),1,4):F(i,1,*o\W):F(j,1,*o\H):u(i,j)=u(i,j)+;
-*o\W*(q(i+1,j)-q(i-1,j))/2:v(i,j)=v(i,j)-*o\H*(q(i,j+1)-q(i,j-1))/2:N:N:BC(*o,;
1,u()):BC(*o,2,v()):E#P:Define s.Sf:s\F\W=50:s\F\H=50:s\F\m=s\F\H:If s\F\W>s\F\H
s\F\m=s\F\W:EndIf:s\F\e=s\F\w+1:s\F\f=s\F\h+1:Ti(s\F\u,t):Ti(s\F\v,t):Ti(s\F\s,;
t):Ti(s\F\t,t):Dim s\F\u\t(s\F\e,s\F\f):Dim s\F\v\t(s\F\e,s\F\f):AF(s\Sv(),25,;#
25,40,10):Goto j:GRAPH100: :OpenWindow(0,0,0,520,520,"",$C80001):CanvasGadget(0,
0,0,520,520,4):te=El:Repeat:Repeat:ev=WindowEvent():Until ev=0 Or ev=13116;#####
s\t=(El-te)/1000:If s\t<0.04:Delay(1000*(0.04-s\t)):s\t=(El-te)/1000:Else:s\t=0+
0.04:E#If:te=El:Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f):ForEach s\Sv()
s\F\s\t(s\Sv()\x,s\Sv()\y)=s\Sv()\u:s\F\t\t(s\Sv()\x,s\Sv()\y)=s\Sv()\v:N;######
AD(s\F,s\F\u\t(),s\F\s\t(),s\t):AD(s\F,s\F\v\t(),s\F\t\t(),s\t):If s\F\a;#######
Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Di(s\F,1,s\F\u\t(),s\F\s\t(),s\F\a,s\t);######
Di(s\F,2,s\F\v\t(),s\F\t\t(),s\F\a,s\t):E#If:Pr(s\F,s\F\u\t(),s\F\v\t(),;#######
s\F\s\t(),s\F\t\t()):Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Av(s\F,1,s\F\u\t(),;#####
s\F\s\t(),s\F\s\t(),s\F\t\t(),s\t):Av(s\F,2,s\F\v\t(),s\F\t\t(),s\F\s\t(),;#####
s\F\t\t(),s\t):Pr(s\F,s\F\u\t(),s\F\v\t(),s\F\s\t(),s\F\t\t()):ForEach s\O();###
AO(s\O(),s\F,s\F\u\t,s\F\v\t):N:StartDrawing(CanvasOutput(0)):Box(0,0,800,600,0)
F(i,0,s\F\e):For j=0 To s\F\f:LineXY(10*i,10*j,10*i+100*s\F\u\t(i,j),10*j+;#####
100*s\F\v\t(i,j),$FF):N:N:ForEach s\O():Circle(s\O()\x*10,s\O()\y*10,3,$FF00):N;
StopDrawing():Until ev=13116:End :j: :F(i,15,35):AOb(s\O(),10,i):N:Goto GRAPH100

VERSION LINUX / MAC

Code : Tout sélectionner

;******************************************************************************* 
;* 
;* July-August 2014 PurePunch contest 
;* PureBasic 5.22 
;* 50 lines of 80 chars, 2 months delay 
;* 
;* Name : Fluid Dynamics Game Engine  
;* Author : Graph100 
;* Date : 07/07/2014 
;* Notes : Made from reading Jos Stam's article 
;* "Real-Time Fluid Dynamics for Games" 
;*  
;* Version 3 Linux / Mac
;******************************************************************************* 
DisableDebugger:Macro M:Macro:EndMacro:M E:End:End#M:M A1:Array:EndMacro;#######
M N:Next:E#M:M F(i,j,k):For i=j To k:E#M:M St:Structure:E#M:M P:Procedure:E#M;##
M El:ElapsedMilliseconds():E#M:M Ti(a,s):a=AllocateMemory(SizeOf(s));###########
Initialize#St(a,s):EndMacro:Macro AO(o,f,a,b):Define.d x,y,s0,t0,s1,t1,t0u,t0v;#
t0u=s\t*f\m:t0v=s\t*f\m:i0=Round(o\x,0):j0=Round(o\y,0):i1=i0+1:j1=j0+1;########
s1=o\x-i0:s0=1-s1:t1=o\y-j0:t0=1-t1:o\u=t0u*(s0*(t0*a(i0,j0)+t1*a(i0,j1))+;#####
s1*(t0*a(i1,j0)+t1*a(i1,j1))):o\v=t0v*(s0*(t0*b(i0,j0)+t1*b(i0,j1))+s1*(t0*b(i1,
j0)+t1*b(i1,j1))):o\x=o\x+o\u:o\y=o\y+o\v:If o\x<1:o\x=1:E#If:If o\x>f\W:o\x=f\W
E#If:If o\y<1:o\y=1:E#If:If o\y>f\H:o\y=f\H:E#If:EndMacro:M AF(o,a,b,c,d);######
AddElement(o):o\x=a:o\y=b:o\u=c:o\v=d:o\g=Sqr(c*c+d*d):EndMacro:M AOb(o,a,b);###
AddElement(o):o\x=a:o\y=b:EndMacro:St t:A1 t.d(0,0):E#St:St Fl:a.d:W.l:H.l:e.l;#
f.l:m.d:*u.t:*v.t:*s.t:*t.t:E#St:St Ob:x.d:y.d:u.d:v.d:E#St:St Sv:x.l:y.l:u.d;##
v.d:g.d:E#St:St Sf:F.Fl:t.d:List O.Ob():List Sv.Sv():E#St:P BC(*o.Fl,Mo,;#######
A1 x.d(2)):If Mo=2:F(i,1,*o\W):x(i,0)=-x(i,1):x(i,*o\f)=-x(i,*o\H):N:Else:F(i,1,
*o\W):x(i,0)=x(i,1):x(i,*o\f)=x(i,*o\H):N:E#If:If Mo=1:F(i,1,*o\H):x(0,i)=-x(1,;
i):x(*o\e,i)=-x(*o\W,i):N:Else:F(i,1,*o\H):x(0,i)=x(1,i):x(*o\e,i)=x(*o\W,i):N;#
E#If:x(0,0)=(x(1,0)+x(0,1))/2:x(0,*o\f)=(x(1,*o\f)+x(0,*o\H))/2:x(*o\e,0)=(0+;##
x(*o\W,0)+x(*o\e,1))/2:x(*o\e,*o\f)=(x(*o\W,*o\f)+x(*o\e,*o\H))/2:E#P;##########
P LS(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),a.d,c.d):F(k,0,20):F(i,1,*o\W):F(j,1,*o\H);##
x(i,j)=(x0(i,j)+a*(x(i-1,j)+x(i+1,j)+x(i,j-1)+x(i,j+1)))/c:N:N:BC(*o,MO,x()):N;#
E#P:P AD(*o.Fl,A1 x.d(2),A1 s.d(2),t.d):F(i,0,*o\e):F(j,0,*o\f):x(i,j)=x(i,j)+;#
t.d*s(i,j):N:N:E#P:P Di(*o.Fl,MO,A1 x.d(2),A1 x0.d(2),d.d,t.d):a.d=t*d**o\W**o\H
LS(*o,MO,x(),x0(),a,1+4*a):E#P:P Av(*o.Fl,MO,A1 d.d(2),A1 d0.d(2),A1 u.d(2),;###
A1 v.d(2),t.d):t0_u.d=t**o\m:t0_v.d=t**o\m:F(i,1,*o\W):F(j,1,*o\H):x.d=i+;######
-t0_u*u(i,j):y.d=j-t0_v*v(i,j):If x<0.5:x=0.5:E#If:If x>*o\W+0.5:x=*o\W+0.5:E#If
i0=Round(x,0):i1=i0+1:If y<0.5:y=0.5:E#If:If y>*o\H+0.5:y=*o\H+0.5:E#If:j0=0+;##
Round(y,0):j1=j0+1:s1.d=x-i0:s0.d=1-s1:t1.d=y-j0:t0.d=1-t1:d(i,j)=s0*(t0*d0(i0,;
j0)+t1*d0(i0,j1))+s1*(t0*d0(i1,j0)+t1*d0(i1,j1)):N:N:BC(*o,MO,d()):E#P;#########
P Pr(*o.Fl,A1 u.d(2),A1 v.d(2),A1 q.d(2),A1 dv.d(2)):F(i,1,*o\W):F(j,1,*o\H);###
dv(i,j)=-((u(i+1,j)-u(i-1,j)+v(i,j+1)-v(i,j-1))/*o\m)/2:q(i,j)=0:N:N:BC(*o,0,;##
dv()):BC(*o,0,q()):LS(*o,0,q(),dv(),1,4):F(i,1,*o\W):F(j,1,*o\H):u(i,j)=u(i,j)+;
-*o\W*(q(i+1,j)-q(i-1,j))/2:v(i,j)=v(i,j)-*o\H*(q(i,j+1)-q(i,j-1))/2:N:N:BC(*o,;
1,u()):BC(*o,2,v()):E#P:Define s.Sf:s\F\W=50:s\F\H=50:s\F\m=s\F\H:If s\F\W>s\F\H
s\F\m=s\F\W:EndIf:s\F\e=s\F\w+1:s\F\f=s\F\h+1:Ti(s\F\u,t):Ti(s\F\v,t):Ti(s\F\s,;
t):Ti(s\F\t,t):Dim s\F\u\t(s\F\e,s\F\f):Dim s\F\v\t(s\F\e,s\F\f):AF(s\Sv(),25,;#
25,40,10):Goto j:GRAPH100: :OpenWindow(0,0,0,520,520,"",0000068):CanvasGadget(0,
0,0,520,520,4):te=El:Repeat:Repeat:ev=WindowEvent():Until ev=0 Or ev=2;#########
s\t=(El-te)/1000:If s\t<0.04:Delay(1000*(0.04-s\t)):s\t=(El-te)/1000:Else:s\t=0+
0.04:E#If:te=El:Dim s\F\s\t(s\F\e,s\F\f):Dim s\F\t\t(s\F\e,s\F\f):ForEach s\Sv()
s\F\s\t(s\Sv()\x,s\Sv()\y)=s\Sv()\u:s\F\t\t(s\Sv()\x,s\Sv()\y)=s\Sv()\v:N;######
AD(s\F,s\F\u\t(),s\F\s\t(),s\t):AD(s\F,s\F\v\t(),s\F\t\t(),s\t):If s\F\a;#######
Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Di(s\F,1,s\F\u\t(),s\F\s\t(),s\F\a,s\t);######
Di(s\F,2,s\F\v\t(),s\F\t\t(),s\F\a,s\t):E#If:Pr(s\F,s\F\u\t(),s\F\v\t(),;#######
s\F\s\t(),s\F\t\t()):Swap s\F\s,s\F\u:Swap s\F\t,s\F\v:Av(s\F,1,s\F\u\t(),;#####
s\F\s\t(),s\F\s\t(),s\F\t\t(),s\t):Av(s\F,2,s\F\v\t(),s\F\t\t(),s\F\s\t(),;#####
s\F\t\t(),s\t):Pr(s\F,s\F\u\t(),s\F\v\t(),s\F\s\t(),s\F\t\t()):ForEach s\O();###
AO(s\O(),s\F,s\F\u\t,s\F\v\t):N:StartDrawing(CanvasOutput(0)):Box(0,0,800,600,0)
F(i,0,s\F\e):For j=0 To s\F\f:LineXY(10*i,10*j,10*i+100*s\F\u\t(i,j),10*j+;#####
100*s\F\v\t(i,j),$FF):N:N:ForEach s\O():Circle(s\O()\x*10,s\O()\y*10,3,$FF00):N;
StopDrawing():Until ev=00002:End :j: :F(i,15,35):AOb(s\O(),10,i):N:Goto GRAPH100

Excellent

a propos puisque ce n'est pas interdit

... on peut participer plusieurs fois ?

Voici mon Deformer Punch en 43 lignes de Macro biotique ... non de Macro Purebasic

(excuse mon entete, mais elle est generé par mon Editeur ..donc )

Code : Tout sélectionner

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

Tant que j'y suis un de mes vieux Code "Fred nous Surveille" mis en Punch 20 lignes !!

Code : Tout sélectionner

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

Dobro a écrit :Excellent

a propos puisque ce n'est pas interdit ... on peut participer plusieurs fois ?

Oui, pas de problème !

Categorie Jeux : encore un Ancien code mis en Punch
"Le plus beau Casse brique de tout les Temps"

Code : Tout sélectionner

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

PureBasic

Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014

Re: Compétition PurePunch Juillet-Août 2014