PureBasic

Forums PureBasic - Français
http://www.purebasic.fr/french/

Compétition PurePunch Numéro 3

http://www.purebasic.fr/french/viewtopic.php?t=9548

Page 2 sur 3

Publié : ven. 03/juil./2009 8:57
par djes
Ollivier> ;) j'espère :)

J'ai ajouté une catégorie pour les débutants (une idée d'idle).

Publié : ven. 03/juil./2009 10:18
par cederavic
djes a écrit :
cederavic a écrit :On a le droit d'utiliser PureGDK (moteur 3D de DBP)?
Euh! Non! :)
Dans ce cas il faudrait rajouter la règle "Aucune userlib n'est autorisée" :P

Publié : ven. 03/juil./2009 10:59
par djes
Ok, si tu veux :)

Publié : ven. 03/juil./2009 19:08
par cederavic
Merci chef! :P

Je pensais à un truc (pendant que je bidouille sur ce dont je t'ai parler sur MSN), faire le vote en 2 etapes.
Premier étape, on eli les 3 meilleur punch des 3 plus grosse comunauté (EN, FR, DE)
Deuxieme étape, on eli les 3 meilleur punch EN, FR et DE confondu des 3 meilleur punch EN, FR et DE séparer.
Ouf... j'espere que vous avez compris, parceque moi j'ai rien pigé à ce que je viens de dir :roll:

Publié : sam. 04/juil./2009 1:19
par djes
Faut pas me faire une usine à gaz! Déjà que Dobro ne comprend rien au malheureux tableau que j'avais utilisé pour le 1er vote! ;)
Pour l'instant on pourrait tous simplement poster pour ses 3 punchs favoris, en leur donnant 3 points/2 points/1 point comme à l'eurovision :lol: . Plus tard on pourra rajouter des critères :)

Sinon, pour ceux qui n'ont pas d'idée, j'ai trouvé ça sur /. -> http://www.programmerfish.com/source-co ... -released/

J'ouvre le bal !

Publié : lun. 13/juil./2009 5:43
par Huitbit
Hello,
En attendant de voir les pros en action, j'envoie mes 20 lignes !
J'ai légèrement modifié un code qu'Ollivier m'avait "punché" (certaines lignes dépassaient 80 caractères, ajout du meilleur score courant, utilisation de goto pour refaire une partie).

Objectif: ralentir la fonte des icebergs

Code : Tout sélectionner

;***************************************************************************** 
;* 
;* PurePunch Contest #3 
;* 
;* Name     : "Old skull" game 
;* Author   : Huitbit 
;* Category : Game 
;* Date     : 12 / 07 / 09 
;* Notes    : "Purepunched" with the help of  the french coder Ollivier 
;* 
;***************************************************************************** 
Macro D:Macro:EndMacro:D K:End:End#D:Dim C(4):Dim N(4):Dim O(4):InitSprite() 
D Q:EndIf:K#D:D R:Random:K#D:D F:DisplaySprite:K#D:L=640:H=480:Dim B(4):a=1 
D P:Next:K#D:D S(A,B,C):For A=B To C:K#D:InitKeyboard():D U:StopDrawing():K#D 
S(I,1,4):D T(A,B,C):CreateSprite(A,B,C):StartDrawing(SpriteOutput(A)):K#D:P 
OpenWindowedScreen(OpenWindow(0,0,0,L,H,"Old skull !"),0,0,L,H,0,0,0):T(0,L,99) 
Box(0,0,L,99,$EFCF10):U:T(1,16,16):S(J,1,8):S(I,1,8) 
If Mid(RSet(Bin(Asc(Mid("|þˉþþU",J,1))),8,"0"),I,1)="1" 
Box(i*2-2,j*2-2,2,2,$FF):Q:P:P:U:T(2,16,16):Circle(8,8,8,$227CE9):U 
T(3,48,H):Ellipse(24,0,24,360,$FCFBEB):U:G::s=0:x=4:y=0:w=0:C(0)=240:N(0)=R(L) 
O(0)=-R(L):S(I,1,4):B(i)=B(i-1)+128+R(32):C(i)=160+R(160):N(i)=R(L):O(i)=-R(L) 
P:Repeat:FlipBuffers():ClearScreen(0):S(I,0,4):If O(i)>440:N(i)=r(L):O(i)=-r(L) 
C(i)+10:Q:If SpriteCollision(1,x,y,2,N(i),O(i)):N(i)=R(624):O(i)=-r(L):S+1:Q 
F(2,N(i),O(i)):O(i)=O(i)+1:P:S(I,0,4):F(3,B(i),C(i)):P:F(1,x,y):F(0,0,440) 
S(I,0,4):If SpriteCollision(1,x+v,y+w,3,B(i),C(i)):If y<=C(i)-15:Z=C(i)-16:Q 
I=4:Else:Z=0:Q:P:If SpriteCollision(1,x,y,0,0,440):If s>m:m=s:Q 
MessageRequester("","S:"+Str(s)+Chr(13)+"H:"+Str(m)):Goto G:Q:ExamineKeyboard() 
If KeyboardPushed(200):If z:w=-24:a=1:Q:Q:If KeyboardPushed(203) And x>3:v=-3 
ElseIf KeyboardPushed(205) And x<621:v=3:Else:v=0:Q:If z=0:If y<=424:x+v:w+a 
y+w:Q:Else:x+v:y=z:Q:Delay(1):Until WindowEvent()=16
Hasta la vista !

Publié : mer. 15/juil./2009 9:43
par PAPIPP
Bonjour à tous
Voici une aide MSDOS pour les nostalgiques du système de base
Je l’ai réalisé en punch avec l’utilisation d’un fichier *.bat ou *.cmd au choix.

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS " Aide Msdos avec file *.BAT et listicongadget
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;***************************************************************************** 
#W0=0:#L0=0:#L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0
:asci$=ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0
:asci$ =ReadString(OF)+Chr(10):OemToChar_(@asci$,@ansi$):AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure
Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS",13107200|12845056|13238272|12582912):ListIconGadget(#L0, 0, 0, 800, 300, "CMD Dos Double cliquez sur une CMD", 800, 8|65536|1073741824)
:ListIconGadget(#L1, 0, 300, 800, 300, "Help CMD", 800, 8|65536|1073741824): GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")
:EndIf::EndProcedure::U$="c:\":s$=".BAT":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date())
:fb$=u$+fp$+s$:FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$)
:WriteString(FB,"Exit /B 233"):CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1))
:prg=RunProgram(fb$,"",".",1):afch(#L0,ft$):Repeat: WWE = WaitWindowEvent(): Select WWE: Case #PB_Event_Gadget: EG = EventGadget():ET = EventType()
:If EG = #L0:If ET=2:ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1)
:prg=RunProgram(fb$,cmd$,".",1):ClearGadgetItems(#L1):afch(#L1,ft$,CMD$):DeleteFile(ft$):EndIf:EndIf:Case 16:EventWindow = EventWindow()
:If EventWindow = #W0:CloseWindow(#W0): DeleteFile(FB$):DeleteFile(FT$):Break: EndIf:EndSelect:ForEver
OU celui-ci avec CMD et listviewgadget

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS " Aide Msdos avec file *.CMD et listviewgadget
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;***************************************************************************** 
#W0=0:#L0=0: #L1=1:Procedure afch(gdgt,f_t$,hlp$="HELP"):asci$ = Space(99):ansi$=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0:asci$=ReadString(OF)
:OemToChar_(@asci$,@ansi$): AddGadgetItem(gdgt,-1, hlp$+" :"+ansi$):eof1=Eof(OF):While Eof(of)=0:asci$ =ReadString(OF):OemToChar_(@asci$,@ansi$)
:AddGadgetItem(gdgt,-1,ansi$):Wend:EndIf:CloseFile (OF):EndProcedure:Procedure OW0():If OpenWindow(#W0, 0, 0, 800, 600, "HELP MSDOS Double cliquez une ligne pour aide",13107200|12845056|13238272|12582912)
:ListViewGadget(#L0, 0, 0, 800, 300):ListViewGadget(#L1, 0, 300, 800, 300):GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")
EndIf:EndProcedure:U$="c:\":s$=".CMD":ft$=Space(255):mask$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mask$,Date()):fb$=u$+fp$+s$
FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$):WriteStringN(FB, "@ECHO OFF"):WriteStringN(FB, "help %1>"+ft$):WriteString(FB,"Exit /B 233")
:CloseFile(FB):OW0():F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1)):SetGadgetFont(#L1, FontID(F1)):prg=RunProgram(fb$,"",".",1)
:afch(#L0,ft$):Repeat:WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget:EG = EventGadget():ET = EventType():If EG = #L0:If ET=2
ELEM.l = GetGadgetState(#L0):ELEM$= GetGadgetItemText(#L0, Elem):Pos= FindString(elem$, " ", 1):CMD$=Mid(elem$,1,pos-1):prg=RunProgram(fb$,cmd$,".",1)
:ClearGadgetItems(#L1):afch(#L1,ft$,CMD$): DeleteFile(ft$):EndIf:EndIf:Case 16: EW = EventWindow():If EW = #W0:CloseWindow(#W0)
: DeleteFile(FB$):DeleteFile(FT$):Break:EndIf:EndSelect:ForEver

Publié : mer. 15/juil./2009 10:04
par djes
Pas bête, ça fonctionne bien! Mais par contre ça ne rentre pas dans les limites imposées d'un punch, c'est à dire 20 lignes de 80 caractères max, ou 50 lignes avec une instruction par ligne. Désolé! Mais je peux l'inclure dans la future archive en "hors concours".

Publié : mer. 15/juil./2009 23:51
par PAPIPP
@Djes
OK et comme cela 20 lignes de 80 caractères max

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS " Aide Msdos avec file *.CMD et listviewgadget
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;*****************************************************************************
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Macro M:Macro:EndMacro:M ws:WriteStringN:EndMacro:#W0=0:#L0=0:#L1=1:#L8=800
:M AGI:AddgadgetItem:EndMacro:Procedure af(gd,f_t$,h$):A1.s=Space(99)
:A2.s=Space(99):OF.l=OpenFile(#PB_Any,f_t$):If of<>0:A1=ReadString(OF)
:OemToChar_(@a1,@A2):AGI(gd,-1,h$+":"+A2):While Eof(of)=0:A1 =ReadString(OF)
:OemToChar_(@a1,@A2):AGI(gd,-1,A2):Wend:EndIf:CloseFile (OF):EndProcedure
:Procedure OW0():If OpenWindow(#W0,0,0,#L8,600,"")
:ListViewGadget(#L0,0,0,#L8,300):ListViewGadget(#L1,0,300,#L8,300):EndIf
:EndProcedure:U$="c:\":s$=".CMD":ft$=Space(255)
:mk$="%YY"+Str(DayOfYear(Date()))+"%ii%ss":fp$="PB"+FormatDate(mk$,Date())
:fb$=u$+fp$+s$:FB.l=CreateFile(#PB_Any,fb$):GetTempFileName_(@U$,@fp$,000,@ft$)
:ws(FB, "@ECHO OFF"):ws(FB,"help %1>"+ft$):ws(FB,"Exit"):CloseFile(FB):OW0()
:F1=LoadFont(#PB_Any,"Courier New",8,256):SetGadgetFont(#L0, FontID(F1))
:SetGadgetFont(#L1, FontID(F1)):RunProgram(fb$,"",".",1):af(#L0,ft$,"Dbl clic")
:Repeat:WWE=WaitWindowEvent():Select WWE:Case 13100:EG = EventGadget()
:ET = EventType():If EG = #L0:If ET=2:ELEM.l = GetGadgetState(#L0)
:el$= GetGadgetItemText(#L0, Elem):Pos= FindString(el$," ",1)
:CMD$=Mid(el$,1,pos-1):RunProgram(fb$,cmd$,".",1):ClearGadgetItems(#L1)
:af(#L1,ft$,CMD$):DeleteFile(ft$):EndIf:EndIf:Case 16: EW = EventWindow()
:If EW = #W0:CloseWindow(#W0):DeleteFile(FB$):DeleteFile(FT$)
:Break:EndIf:EndSelect:ForEver
Pour améliorer on peut retirer le caractère : devant chaque ligne.

Publié : jeu. 16/juil./2009 8:51
par PAPIPP
Encore plus court 18 lignes de 80 caractères

Code : Tout sélectionner

;*****************************************************************************
;*
;* PurePunch Contest #3
;*
;* Name     : "Help MSDOS Normal" Aide Msdos Double cliquez sur une ligne
;* Author   : PAPIPP
;* Category : UTIL
;* Date     : 15 / 07 / 09
;*
;***************************************************************************** 
;----0---_____1____----2-----_____3____-----4----_____5____-----6----_____7____-
;2345678901234567890123456789012345678901234567890123456789012345678901234567890
Macro M: Macro : EndMacro:M AGI:AddGadgetItem:EndMacro :#W0=0:#L0=0: #L1=1
M RPS :ReadProgramString:EndMacro:Procedure OW0():
If OpenWindow(#W0, 0, 0, 800, 600, "Dbl Clic")
ListViewGadget(#L0, 0, 0, 800, 300):ListViewGadget(#L1, 0, 300, 800, 300)
GadgetToolTip(#L0, "Double Cliquez sur une des ligne pour une aide")::EndIf
EndProcedure:Procedure AFCH(Gd,Cm$)
prg=RunProgram("cmd"," /A /C  help "+CM$,".",28)
As$ = Space(99):an$=Space(99):ClearGadgetItems(Gd):If prg:As$=RPS(prg)
OemToChar_(@as$,@an$):   AGI(gd,-1, "Help "+Cm$+" :"+an$)
While ProgramRunning(prg):As$ =RPS(prg):OemToChar_(@as$,@an$):AGI(Gd,-1, an$)
Wend:EndIf:EndProcedure:OW0():Font1 = LoadFont(#PB_Any, "Courier New",8)
SetGadgetFont(#L0, FontID(Font1)):SetGadgetFont(#L1, FontID(Font1))
AFCH(#L0,""):Repeat: WWE = WaitWindowEvent():Select WWE:Case #PB_Event_Gadget
EG = EventGadget():ET = EventType():If EG = #L0:If ET=2:EL.l=GetGadgetState(#L0)
EL$= GetGadgetItemText(#L0, El):Pos= FindString(el$, " ", 1):
CMD$=Mid(el$,1,pos-1):AFCH(#L1, CMD$):EndIf:EndIf:Case #PB_Event_CloseWindow
EW = EventWindow():If EW = #W0:CloseWindow(#W0):Break:EndIf: EndSelect
ForEver

Publié : jeu. 16/juil./2009 9:16
par djes
Yep, nickel comme ça!

Publié : jeu. 16/juil./2009 9:26
par Flype
@PAPIPP

Sympa et utile, un bon petit punch...

Par contre, doit surement y avoir un moyen de ne pas faire apparaitre la console DOS non ?

Publié : jeu. 16/juil./2009 12:07
par Backup
................

Publié : jeu. 16/juil./2009 13:40
par Flype
@dobro
Je me permets juste une modif à ta version afin de réutiliser
la fonction OemToChar() qui est bien utile ici (accents).
et l'affichage avec la police Courier assez adapté pour le DOS.
Le tout en 6 lignes.

Code : Tout sélectionner

OpenWindow(0,10,10,800,480,"Aide MSDOS"):StringGadget(1,2,2,796,20,"dir")
EditorGadget(2,2,24,796,454,2048):SetGadgetFont(2,LoadFont(0,"Courier",8))
Repeat:Select WaitWindowEvent():Case 16:Break:Case 257:c$=GetGadgetText(1)
If c$:p=RunProgram("cmd.exe","/c "+c$+"/?","",30):If p:h$=""
While ProgramRunning(p):h$+ReadProgramString(p)+#LF$:Wend:OemToChar_(@h$,@h$)
SetGadgetText(2,h$):CloseProgram(p):EndIf:EndIf:EndSelect:ForEver
Petite remarque sur a fonction OemToChar() :
http://msdn.microsoft.com/en-us/library ... S.85).aspx
En ASCII (contrairement donc au mode UNICODE) pas besoin d'allouer une variable pour le résultat, il suffit de mettre le même pointeur qu'en entrée : OemToChar_(@text$, @text$), un remplacement octet par octet est effectué dans la chaine passée en premier argument.

:wink:

Publié : jeu. 16/juil./2009 14:26
par Backup
j'ai modifié mon code du coup :)

ps; j'ai laissé mon boutton :)
Fuseau horaire sur UTC+01:00
Page 2 sur 3

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru