Compétition PurePunch Numéro 2

Partagez votre expérience de PureBasic avec les autres utilisateurs.
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

@Djes

Désolé, j'entorse un peu le règlement: j'ai fait ce code hors compètition... Bon... Faut utiliser les 4 flèches et puis c'est tout...

Code : Tout sélectionner

Macro BL(X):For I=0 To 3:X:Next:EndMacro:Dim G(14,28):Dim G2(14,28):Dim C(1);##
Macro IT:X+PX(PC,I,Rt),Y+PY(PC,I,Rt):EndMacro:Dim PX(6,3,3):Dim PY(6,3,3);#####
Macro F(X,Y):For X=0 To Y:EndMacro:Macro N:Next:EndMacro:Macro Q:EndIf:EndMacro
F(I,28):G(1,I)=1:G(13,I)=1:G(I%13,27)=1:N:F(Pe,6):eC=0:F(Eg,1):F(PL,3);########
If Val("$"+Mid("33F06336747172",2*Pe+1+Eg,1))&(1<<PL):F(Ag,3):Y=1-PL:A=1.57*Ag;
C=Cos(A):S=Sin(A):PX(Pe,eC,Ag)=C*Eg-S*Y:PY(Pe,eC,Ag)=S*Eg+C*Y:N:eC+1:Q:N:N:N;##
Macro K0:AddKeyboardShortcut:EndMacro:OpenWindow(0,0,0,208,432,"",$CF0001);####
K0(0,37,10):K0(0,40,32):K0(0,39,12):K0(0,38,16):X=7:Y=2:D=1000:C(0)=$FFFFFF;###
C(1)=$1:Ok=1:Repeat:Delay(1):Et=WindowEvent():StartDrawing(WindowOutput(0));###
F(A,28):F(B,14):Box(B*16-16,(A-1)*16,16,16,C(G(B,A)|G2(B,A))):N:N:StopDrawing()
If Ok:BL(G2(IT)=0):MN=0:If Et=13101:MN=EventMenu():If MN=32:CH!1:Q:Q;#######
EL=ElapsedMilliseconds():If EL>T Or CH:T=EL+D:Y+1:Q:CA=0:F(I,3):If G(IT):CA=1:Q
N:If CA:Y-1:CH=0:MN=0:BL(G(IT)=1):X=7:Y=2:SC+1:If D>100:D-10:Q:DY=0;###########
For Y3=26 To 0 Step -1:CM=1:For X3=1 To 12:If G(X3,Y3)=0:CM=0:Q;###############
G(X3,Y3+DY)=G(X3,Y3):N:If CM:DY+1:Q:If Y3-DY<=0:Break:Q:N:SC+(DY*(DY+1));######
SetWindowTitle(0,Str(SC)):PC=Random(6):Rt=Random(3):Ok=1:F(I,3):If G(IT):Ok=0:Q
N:Else:BL(G2(IT)=1):Q:BL(G2(IT)=0):NS=0:If MN&8:NS=MN-11:Q:If NS:X+NS:Q:C0=0;##
F(I,3):If G(IT):C0=1:Q:N:If C0:X-NS:Q:If MN&16:Rt+1:Rt&3:Q:C3=0:F(I,3):If G(IT)
C3=1:Q:N:If C3:Rt-1:Rt&3:Q:BL(G2(IT)=1):Q:Until Et=16;#########################
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : PSphere
;* Author : djes
;* Date   : 06/17/2009
;* Notes  : -
;*
;*****************************************************************************
InitSprite():Macro g(t,d):Macro t:d:endmacr:EndMacro:g(d,drawing)o:g(n,Next)o
g(so,ScreenOutput)o:Structure v:x.f:y.f:z.f:c.i:EndStructure:w=511:r=255:k=127
g(q,s())o:g(C(m,l,p),Cos(0.03)*q\m l Sin(0.03)*q\p)o:g(e,EndIf)o:t$="PUREBASIC"
OpenWindow(0,0,0,w,w,""):OpenWindowedScreen(WindowID(0),0,0,w,w,0,0,0)
NewList s.v():LoadFont(1,"Arial",16):Start#D(so()):DrawingFont(FontID(1))
DrawText(10,0,t$,r,0):For y=-r To r:For x=-r To r:z=Sqr($FE01-(x*x)-(y*y))
If z>0:If Point(x&k,y&63)<>0:AddElement(q):If x&1=0:z*-1:e:q\x=x:q\y=y:q\z=z
q\c=-1:e:e:n x:n y:Stop#D():Repeat:FlipBuffer#q:ClearScreen(0):Start#D(so())
ForEach(q):Plot(r+q\x,r+q\y,w):b.f=C(x,-,z):q\z=C(z,+,x):q\x=b:b.f=C(x,-,y)
q\y=C(y,+,x):q\x=b:Plot(r+q\x,r+q\y,q\z):n:Stop#D():Until WindowEvent()=16
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

Dobro a écrit :je vous met celui ci , bien qu'il soit hors compete
Ben non... Ton code n'est plus hors compete!

Edit: j'ai corrigé le bug. C'était un dépassement d'index du tableau (index négatif).

Code : Tout sélectionner

;*****************************************************************************
;*
;* Name   : ColorWave
;* Author : Dobro
;* Date   : 06/17/2009
;* Notes  : optimisé par Olivier
;*
;*****************************************************************************
Macro S(X,Y):E#X=GetSystemMetrics_(Y):EndMacro:InitSprite():InitMouse():S(X,0)
Macro c:EndIf:EndMacro:S(Y,1):w=OpenWindow(0,0,0,EX,EY,"",$80C80001):CX=(EX)/2
OpenWindowedScreen(w,0,0,EX,EY,1,0,0):V.f=8.2:a.f=0:G.f=$78:p.f=0.3:V.f=2:a.F
L=500:Dim T.l(L):Macro Q(X):Abs(Cos(a+(X))*255):EndMacro:For i=0 To L:D=100
a+(2*#PI/L):T(i)=RGB(Q(4*#PI/6),Q(#PI/3),Q(0)):Next:Repeat:U+Cos(3.6):b+Sin(36)
StartDrawing(ScreenOutput()):a=Sin((x+U)/(L+Sin(x/D)*D))*75+75:For Y=1 To EY-1
U=Cos((Y+b)/(300+Cos(Y/D)*D))*150:E=a+U:E=Abs(E):E%500:E=T(E):i=Y:G+V:If G>120
V=-V:c:If G<-120:V=-0.001:V=-V:c:Macro h(X):Sin((a+i*p*X)*0.0174533)*G
EndMacro:x=CX-300+H(10):Line(x+H(3),Y,L,0,E):Next:ExamineMouse():StopDrawing()
a+V:WindowEvent():FlipBuffers():ClearScreen(0):Until MouseButton(2)
Dernière modification par Ollivier le mer. 17/juin/2009 22:42, modifié 1 fois.
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

J'ai pas tout suivi là, mais c'est pas grave! Il est très chouette ce code :)
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

je viens de nettoyer tout le topic des commentaires , comme ça on a accès direct aux codes :)

bien sur vous pouvez toujours laisser vos commentaires , de temps en temps
je ferai le ménage, pour laisser un topic de Punchs !

je trouve que c'est plus cool pour le future, de tomber directe sur les codes
plutôt que d'avoir a se taper 3 ou 4 pages de discutions, avant :)

mais comme je vous le dit, le but n'est pas de vous empecher de discuter
mais juste de nettoyer le topic de temps en temps :)
beauregard
Messages : 1307
Inscription : dim. 08/juil./2007 18:32
Localisation : Toulouse

Message par beauregard »

mon commentaire ne faisait qu'une seule et petite ligne, pour rester dans l'esprit de la chose... Fred a mis le sien aussi... de commentaire hein ;)
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

beauregard a écrit :mon commentaire ne faisait qu'une seule et petite ligne, pour rester dans l'esprit de la chose... Fred a mis le sien aussi... de commentaire hein ;)
( c'est comme dire, bah ! je n'ai jetté qu'un petit bout de papier dans la foret !
en oubliant que 1+1+1+1+1+1+1 ....etc ça fais beaucoups ;) )

je pourrai te dire que tout a l'heure il y avait une page en plus rien qu'avec les commentaires, que je trouve le topic beaucoup plus clair maintenant ..
(et encore KCC n'a pas ete tres bavard)

et j'ai laissé les messages de présentation a l'interieur des codes
(encore heureux)

que si vous preferez ce topic avec les discussions, et les commentaires
et que j'ai eu tord de vouloir faire un brin de nettoyage, parceque je pense trop
au futurs membres qui rechercheront un code, et qui mettront 3 plombes a trouver, voir qui abandonneront leurs recherches, pour demander que quelqu'un veuille bien le rechercher a leur place , pas de probleme ... :roll:

comme je l'ai dit je n'empêche pas les commentaires, mais une fois qu'ils ont été lu , je ne vois pas trop l'intérêt de les garder dans un topic qui se veux un recueil de codes avant tout !!

pour info mon forum est d'ailleurs fait sur ce model
si tu cherche un code, tu pourra plus vite le trouver chez moi , qu'ici :)
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

@Dobro

Si tu n'as pas vu avec Djes, la flagellation sur la place publique est préconisée! ça me surprend un peu. N'oublie pas qu'on poste nos avis, nos boutades, des choses qui font et défont l'ambiance. Et puis c'est un sujet en cours puisque c'est durant ce mois-ci.

Aussi c'est sûr que récupérer nos avis dans ces cas-là, ce n'est pas toujours simple. Si c'est à refaire, pourquoi ne pas créer un nouveau sujet avec sondage durant quelques jours dans la même section (dans le Hors sujet, ça peut être trop éloigné du sujet à traiter), le temps qu'une demi douzaine de personnes puissent donner leur avis? Et puis virer le sondage une fois que la décision a bien mûri à plusieurs?

Maintenant, c'est fait c'est fait. Ce n'est pas un drame. C'est plus direct!

En tout cas, j'ai déliré avec tes macros: finalement, tu commences à te faire la main avec ces petites bestioles-là!!!

Ollivier
Avatar de l’utilisateur
Polux
Messages : 440
Inscription : mer. 21/janv./2004 11:17
Localisation : france
Contact :

Message par Polux »

wow, c top vos trucs les mecs :D
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

..............
Dernière modification par Backup le dim. 02/oct./2011 13:02, modifié 1 fois.
Anonyme

Message par Anonyme »

14 ?
Macro M:Macro:EndMacro:M l:Dim:EndMacro:M rd:random:EndMacro:M E:EndIf:EndMacro
M fin:StopDrawing():FlipBuffers():ClearScreen(RGB(0, 0, 0)):EndMacro:M cal1:
ux=(sx(i)*zo)/sz(i)+cx:uy=(-sy(i)*zo)/sz(i)+cy:EndMacro:InitSprite():M cal2
sh=Int(255/zm*-sz(i)):If ux<EX:EndMacro:M N1:Next:EndMacro:P=255
EX=GetSystemMetrics_(0):EY=GetSystemMetrics_(1):M _w:OpenWindow:EndMacro:
M w_e:WindowEvent():EndMacro:M st_d:StartDrawing:EndMacro:M s_o:ScreenOutput
EndMacro:M F1:For i=0 To:EndMacro:M ows:openwindowedScreen:EndMacro:
M ow:_w:EndMacro:M j:1000:EndMacro:M C1:Circle(ux, uy,1,RGB(r ,v,b)):EndMacro:
WD=Ow(1,0,0,EX,EY,"",2160590849):M do1:OWS(WD,0,0,EX,EY,1,1,1):xm=10*j:ym=10*j:
zm=2*j:sp=-10:zn=10:n=5*j:EndMacro:M do2:cx=EX/2:cy=EY/2:zo=60:sh=0:l sx(n)
:l sy(n):l sz(n):EndMacro:do1:do2:F1 n:sx(i)=Rd(xm)-xm/2:sy(i)=Rd(ym)-ym/2:
sz(i)=Rd(zm):N1:Repeat:Ev=w_e:St_d(s_o()):F1 n:sz(i)=sz(i)+sp:If sz(i)<=zn:
sz(i)=zm:sx(i)=Rd(xm)-xm/2:sy(i)=Rd(ym)-ym/2:E:cal1:cal2:If uy<EY:If ux>0:
If uy>0:r=Rd(P)+1:v=Rd(P)+1:b=Rd(P)+1:C1:E:E:E:E:N1:fin:Until Ev=16
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

cà ressemble à petit défi dans le défi...

10 pour moi (722 cars)

Code : Tout sélectionner

InitSprite():EX=GetSystemMetrics_(0):EY=GetSystemMetrics_(1)
Macro R:Random:EndMacro::WD=OpenWindow(1,0,0,EX,EY,"",2160590849)
j=1000:xm=10*j:ym=10*j:zm=2*j:sp=-10:zn=10:n=5*j:cx=EX/2:cy=EY/2:zo=60:sh=0
Dim sx(n):Dim sy(n):Dim sz(n):OpenWindowedScreen(WD,0,0,EX,EY,1,1,1)
For i=0 To n:sx(i)=R(xm)-xm/2:sy(i)=R(ym)-ym/2:sz(i)=R(zm):Next
Repeat:StartDrawing(ScreenOutput()):For i=0 To n:sz(i)+sp:If sz(i)<=zn:sz(i)=zm
sx(i)=R(xm)-xm/2:sy(i)=R(ym)-ym/2:EndIf:ux=(sx(i)*zo)/sz(i)+cx
uy=(-sy(i)*zo)/sz(i)+cy:sh=Int(255/zm*-sz(i)):If ux<EX:If uy<EY:If ux>0:If uy>0
r=R(255)+1:v=R(255)+1:b=R(255)+1:Circle(ux,uy,1,RGB(r,v,b)):EndIf:EndIf:EndIf
EndIf:Next:StopDrawing():FlipBuffers():ClearScreen(0):Until WindowEvent()=16
Franchement Dobro je suis sûr que tu as fait exprès, vu la gueule du code :lol:
Sympa l'effet à part çà, j'espère que je ne l'ai pas 'abimé'...
Image
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

@dobro

Juste pour te chambrer gentiment (une façon de faire un coucou depuis le temps),

tu as posté il y a 10 jours :
perso je n'utilise jamais les macros, mais bon ...
http://www.purebasic.fr/french/viewtopic.php?t=9464

Maintenant tu vas pouvoir dire :
perso je n'utilise que les macros, mais bon ...
Dans ton <Punch> je compte 10 macros, soit une par ligne. :lol:



:wink:
Image
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

c'est bon !! je boude ! :twisted:
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

:D Tu devrais pas.

Ton StarEffect est très bien.
C'est le 1er du genre en plus dans ce concours je crois.


En plus, ton post va m'amener à poster un souhait dans la rubrique ' Suggestions et améliorations'.


à tout de suite...
Image
Répondre