Compétition PurePunch Numéro 2

Partagez votre expérience de PureBasic avec les autres utilisateurs.
tonton
Messages : 315
Inscription : mar. 26/avr./2005 15:19

Message par tonton »

en gratant un peu , tu pouvais faire 9 ligne flype! :wink:

Code : Tout sélectionner

InitSprite():X=GetSystemMetrics_(0):Y=GetSystemMetrics_(1):k=255 
Macro R:Random:EndMacro::D=OpenWindow(1,0,0,X,Y,"",2160590849):j=k*4:u=10*j 
v=10*j:w=2*j:sp=-10:l=10:n=5*j:cx=X/2:cy=Y/2:m=60:sh=0:Dim f(n):Dim g(n)
Dim h(n):OpenWindowedScreen(D,0,0,X,Y,1,1,1):For i=0 To n:f(i)=R(u)-u/2:
g(i)=R(v)-v/2:h(i)=R(w):Next:Repeat:StartDrawing(ScreenOutput()):For i=0 To n
h(i)+sp:If h(i)<=l:h(i)=w:f(i)=R(u)-u/2:g(i)=R(v)-v/2:EndIf:ux=(f(i)*m)/h(i)+cx 
uy=(-g(i)*m)/h(i)+cy:sh=Int(k/w*-h(i)):If ux<X:If uy<Y:If ux>0:If uy>0 
r=R(k)+1:t=R(k)+1:b=R(k)+1:Circle(ux,uy,1,RGB(r,t,b)):EndIf:EndIf:EndIf 
EndIf:Next:StopDrawing():FlipBuffers():ClearScreen(0):Until WindowEvent()=16
Avatar de l’utilisateur
Flype
Messages : 2431
Inscription : jeu. 29/janv./2004 0:26
Localisation : Nantes

Message par Flype »

oui j'avais fait le plus dur... mais y'avait un peu de marge encore :D
Image
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

En grattant un peu, tu pouvais faire 7 lignes Tonton !! :lol:

Code : Tout sélectionner

X=GetSystemMetrics_(0):Y=GetSystemMetrics_(1):Macro R:Random:EndMacro:k=255
InitSprite():D=OpenWindow(1,0,0,X,Y,"",$80C80001):j=k*4:n=5*j:Dim f(n):Dim g(n)
u=10*j:v=u:w=2*j:sp=-10:l=10:cx=X/2:cy=Y/2:OpenWindowedScreen(D,0,0,X,Y,1,1,1)
m=60:Dim h(n):Macro Z:f(i)=R(u)-u/2:g(i)=R(v)-v/2:EndMacro:For i=0 To n
h(i)=R(w):Z:Next:Repeat:StartDrawing(ScreenOutput()):Box(0,0,X,Y):For i=0 To n
h(i)+sp:If h(i)<=l:h(i)=w:Z:EndIf:C=(f(i)*m)/h(i)+cx:D=(-g(i)*m)/h(i)+cy
Circle(C,D,1,R(1<<24)):Next:StopDrawing():FlipBuffers():Until WindowEvent()=16
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Message par djes »

:lol: excellent! En plus l'effet est joli!
tonton
Messages : 315
Inscription : mar. 26/avr./2005 15:19

Message par tonton »

Bwai !! 6!!



Code : Tout sélectionner

k=255:X=k*4:InitSprite():D=OpenWindow(1,0,0,X,X,"",$80C80001):n=5*x:Dim f(n)
Dim g(n):u=10*x:k=u/2:w=2*x:l=10:p=-l:g=X/2:OpenWindowedScreen(D,0,0,X,X,1,1,1) 
Dim h(n):Macro Z:f(i)=Random(u)-k:g(i)=Random(u)-k:EndMacro:For i=0 To n:m=60 
h(i)=Random(w):Z:Next:Repeat:StartDrawing(ScreenOutput()):Box(0,0,X,X)
For i=0 To n:h(i)+p:If h(i)<l:h(i)=w:EndIf:C=(f(i)*m)/h(i)+g:D=(-g(i)*m)/h(i)+g 
Circle(C,D,1,Random(1<<24)):Next:StopDrawing():FlipBuffers():Until WindowEvent()=16 

je ne veux rien entendre sur la derniere ligne :D
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

ben dis donc, j'en etait loin moi au debut !! :lol:
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

..............
Dernière modification par Backup le dim. 17/juil./2011 17:20, modifié 1 fois.
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

Ouais, mais en grattant encore un peu, Tonton pouvait faire 5 lignes !!!! :D

Code : Tout sélectionner

k=255:X=k*4:D=OpenWindow(1,0,0,X,X,"",$C80001):n=5*X:Dim f(n):Dim g(n):Dim h(n)
w=2*X:g=WindowWidth(1)/2:h=g*3/4:StartDrawing(WindowOutput(1)):Box(0,0,X,X):u=n
Macro Q:i)=Random:EndMacro:Macro C:Circle((f(i)*60)/h(i)+g,(-g(i)*60)/h(i)+h,1
EndMacro:u*2:While WindowEvent()<>16:For i=0 To n:If D:h(Q(w)+1:f(Q(u)-n:g(Q(u)
g(i)-n:EndIf:C,0):h(i)-10:If h(i)<10:h(i)=w:EndIf:C,Random(1<<24)):Next:D!D:Wend
Je sors...

[Edit]Version avec moins d'étoiles parce que sinon sous Vista, ça rame...

Code : Tout sélectionner

k=255:X=k*4:D=OpenWindow(1,0,0,X,X,"",$C80001):n=X:Dim f(n):Dim g(n):Dim h(n)
w=2*X:g=WindowWidth(1)/2:h=g*3/4:StartDrawing(WindowOutput(1)):Box(0,0,X,X):u=n
Macro Q:i)=Random:EndMacro:Macro C:Circle((f(i)*60)/h(i)+g,(-g(i)*60)/h(i)+h,1
EndMacro:u*2:While WindowEvent()<>16:For i=0 To n:If D:h(Q(w)+1:f(Q(u)-n:g(Q(u)
g(i)-n:EndIf:C,0):h(i)-10:If h(i)<10:h(i)=w:EndIf:C,Random(1<<24)):Next:D!D:Wend
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

................
Dernière modification par Backup le dim. 17/juil./2011 17:21, modifié 1 fois.
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

Il est bien le dernier effet!

Pour les macros, il y a un truc important à vérifier : l'économie des caractères. Et quand on s'y attarde, c'est beaucoup plus compliqué que prévu.
Dans ce code,

Code : Tout sélectionner

:Macro X::EndMacro
...on voit qu'une macro à vide contient 18 caractères. C'est la perte de place nécessaire pour créer un simple macro vide dont le nom ne fait qu'un caractère.

Donc quand on a initialement n occurences de q caractères, on perd :

1) 18 caractères pour la macro à vide
2) q caractères pour insérer l'occurence dans la macro
3) n caractères pour remplacer chaque occurence par le nom de la macro (avec un nom d'une seule lettre)

Et on gagne n * q caractères pour toutes les occurences à remplacer.

Le bilan se calcule ainsi:
Bilan = Gain - Perte
Bilan = (n * q) - (18 + q + n)

Bilan = q * (n - 1) - n - 18
ou
Bilan = n * (q - 1) - q - 18
Si le bilan est strictement positif, la macro est valable.
S'il est nul, l'avantage est de répartir les caractères pour réussir à limiter plus facilement chaque ligne du code (une des contraintes de cette compétition), et l'inconvénient c'est d'empêcher la mise en place d'une autre macro.
Si le bilan est négatif, la macro n'est pas valable.

Exemple: Combien de boucles If...EndIf faut-il pour qu'une macro remplace chaque EndIf? q = Len("EndIf") = 5

(Rt°): Il faut: Bilan > 0
<=> n * (q - 1) - q - 18 > 0
<=> n * (5 - 1) - 5 - 18 > 0
<=> n * 4 - 23 > 0
<=> n * 4 > 23
<=> n > 23 / 4
<=> n > 5.75

Il faut donc au minimum 6 boucles If...EndIf pour qu'une macro remplaçant EndIf soit valable.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

..............
Dernière modification par Backup le dim. 17/juil./2011 17:22, modifié 1 fois.
Ollivier
Messages : 4197
Inscription : ven. 29/juin/2007 17:50
Localisation : Encore ?
Contact :

Message par Ollivier »

J'ai bien précisé que c'était compliqué! Pour optimiser le terme "Macro", il faut déjà 4 macros pour que ce soit valable. Ensuite, pour chacune des 4 macros, il faut vérifier que ce soit valable (donc qu'il y ait un minimum de répétitions pour chacune d'entre elles), même si tu allèges la consistance d'une macro. Tu te retrouves alors dans une configuration de code assez particulière, presqu'une contrainte supplémentaire.

Le but, c'est quand même d'abord de créer un code, puis le compresser, si besoin, utiliser les macros, voire, si besoin, comme tu le précises compresser les macros elles-même.

La technique que tu décris est bonne mais pas utilisable à tous les coups. Par exemple, pour les codes que j'ai déjà posté ici, elle ne l'est pas. 10 lignes c'est un peu juste pour ça...

Si j'ai posté ces calculs, ça n'est pas pour balancer ma science ou te faire chier, c'est parce que même si une macro semble séduisante, elle peut parfois pousser au piège. Un très bon exemple est ton code "hors compèt" que j'ai réduit à 10 lignes et que tu as effacé: la première chose que j'ai fait c'est démonter toutes tes macros pour vérifier si c'était faisable de comprimer le code: résultat, le code est rentré dans les règles des 10 lignes AVEC des macros ET SANS compresser les macros!

Créer une macro c'est, par définition un transfert d'ensemble et par application une montée dans un arbre, au risque de se tromper de branche et donc de ne pas réduire suffisamment son ensemble.

Ton astuce du jour est donc une branche maîtresse, mais il en existe d'autres qui, en l'espace de 10 lignes s'avèrent incompatibles, par exemple

Code : Tout sélectionner

Macro P:Procedure:EndMacro:Macro Q:End#P:P:EndMacro
qui permet d'enchaîner

Code : Tout sélectionner

P
Routine1
Q
Routine2
Q
Routine3
Q
Routine4
...
Q
RoutineN
End#P
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

....................
Dernière modification par Backup le dim. 17/juil./2011 17:22, modifié 1 fois.
Backup
Messages : 14526
Inscription : lun. 26/avr./2004 0:40

Message par Backup »

....................
Dernière modification par Backup le dim. 17/juil./2011 17:23, modifié 1 fois.
Avatar de l’utilisateur
TazNormand
Messages : 1297
Inscription : ven. 27/oct./2006 12:19
Localisation : Calvados (14)

Message par TazNormand »

Code : Tout sélectionner

"Notes : -exit white mouse right button"
Ah zut, j'ai une logitech MX1000 noire, et j'ai pas de bouton blanc, ça va pas marcher alors :D ?
Image
Image
Répondre