

Code : Tout sélectionner
Dim etat.b(5000,20,20)
Dim vu.b(20,20)
Dim energie.f(21,21)
Dim onde.f(21,21,4)
Dim onde2.f(21,21,4)
Dim pris.b(20,20)
Dim comp.l(20,20)
Dim card.l(100,2)
Dim oeil.b(20,20)
Global n.b,joueur.b,etat,coup.l,total.l,vu,larg.l,niveau.l,gain.l,perte.l
Global energie,onde,onde2,pris,comp,card,oeil
joueur=-1:n=19:coup=1:total=1:niveau=50
font=LoadFont(0,"Times New Roman",14,#PB_Font_Bold|#PB_Font_Italic|#PB_Font_HighQuality)
For k=0 To 999
For i=0 To n
For j=0 To n
etat(k,i,j)=0
Next j:Next i:Next k
Procedure refresh()
StartDrawing(WindowOutput())
For i=0 To n*27+20
k.l=Round(110+145*i/(n*27+20),0)
FrontColor(k,0,k)
Line(0,i,larg,0)
Next i
FrontColor(255,255,255)
For i=0 To n-1
Line(13,33+27*i,27*n-26,0)
Line(13+27*i,33,0,27*n-26)
Next i
For i=0 To n-1:For j=0 To n-1
Select etat(coup-1,i+1,j+1)
Case 0
FrontColor(255,255,255)
Circle(13+27*i,33+27*j,3)
Case 1
For k=10 To 0 Step -1
Circle(13+27*i,33+27*j,k,RGB(20*k,20*k,20*k))
Next k
Case -1
For k=10 To 0 Step -1
Circle(13+27*i,33+27*j,k,RGB(20*k,0,0))
Next k
EndSelect
Next j:Next i
DrawingMode(1)
Locate(40,0)
DrawingFont(UseFont(0))
If joueur=-1:ins.s="1 (rouge)":Else:ins.s="2 (gris)":EndIf
titre.s="Joueur "+ins+" Coup "+Str(coup)
DrawText(titre)
DrawingMode(0)
StopDrawing()
EndProcedure
Procedure supprime(x,y)
StartDrawing(WindowOutput())
For i=23+27*(y-1) To 43+27*(y-1)
k.l=Round(110+145*i/(n*27+20),0)
FrontColor(k,0,k)
Line(3+27*(x-1),i,20,0)
Next i
FrontColor(255,255,255)
a.l=23+27*(y-1):b.l=21
If y=1:a=33:b=11:EndIf
If y=n:b=10:EndIf
Line(13+27*(x-1),a,0,b)
a.l=3+27*(x-1):b.l=21
If x=1:a=13:b=11:EndIf
If x=n:b=10:EndIf
Line(a,33+27*(y-1),b,0)
Circle(13+27*(x-1),33+27*(y-1),3)
StopDrawing()
EndProcedure
Procedure nouveau(i.l,j.l)
StartDrawing(WindowOutput())
For p=0 To 21
k.l=Round(110+145*p/(n*27+20),0)
FrontColor(k,0,k)
Line(0,p,n*27,0)
Next p
Select etat(coup,i,j)
Case 1
For k=10 To 0 Step -1
Circle(13+27*(i-1),33+27*(j-1),k,RGB(20*k,20*k,20*k))
Next k
Case -1
For k=10 To 0 Step -1
Circle(13+27*(i-1),33+27*(j-1),k,RGB(20*k,0,0))
Next k
EndSelect
DrawingMode(1)
Locate(40,0)
DrawingFont(UseFont(0))
FrontColor(255,255,255)
If joueur=-1:ins.s="1 (rouge)":Else:ins.s="2 (gris)":EndIf
titre.s="Joueur "+ins+" Coup "+Str(coup+1)
DrawText(titre)
DrawingMode(0)
StopDrawing()
EndProcedure
Procedure sauver()
file.s=SaveFileRequester("Sauver","partie.go","Fichiers Go|*.go",0)
pos.b=FindString(file,".",1)
If pos>0:file=Left(file,pos)+"go":Else:file=file+".go":EndIf
If Len(file)>3 And CreateFile(0,file)
WriteByte(n)
WriteLong(coup)
WriteLong(total)
WriteByte(joueur)
For i=1 To total
For j=1 To 20
For k=1 To 20
WriteByte(etat(i,j,k))
Next k:Next j:Next i
CloseFile(0)
EndIf
;refresh()
EndProcedure
Procedure ouvrir()
file.s=OpenFileRequester("Ouvrir","","Fichiers Go|*.go",0)
If file<>"" And OpenFile(0,file)
n=ReadByte()
coup=ReadLong()
total=ReadLong()
joueur=ReadByte()
For i=1 To total
For j=1 To 20
For k=1 To 20
etat(i,j,k)=ReadByte()
Next k:Next j:Next i
CloseFile(0)
larg=n*27:If larg<500:larg=500:EndIf
ResizeWindow(larg,40+27*n)
refresh()
EndIf
EndProcedure
Procedure precedent()
If coup>1
coup=coup-1:joueur=-joueur:refresh()
EndIf
EndProcedure
Procedure suivant()
If coup<total
coup=coup+1:joueur=-joueur:refresh()
EndIf
EndProcedure
Procedure bord(player,c)
For i=0 To 20
etat(c,0,i)=player:etat(c,n+1,i)=player
etat(c,i,0)=player:etat(c,i,n+1)=player
Next i
EndProcedure
Procedure voir(x,y)
If vu(x,y):ProcedureReturn 1:EndIf
If etat(coup,x,y)=0 :vu(x,y)=1:ProcedureReturn 0:EndIf
If etat(coup,x,y)=joueur:vu(x,y)=1:ProcedureReturn 1:EndIf
vu(x,y)=1
ProcedureReturn voir(x-1,y)*voir(x+1,y)*voir(x,y-1)*voir(x,y+1)
EndProcedure
Procedure elim(x,y)
For k=0 To 20:For p=0 To 20:vu(k,p)=0:Next p:Next k
If etat(coup,x,y)=joueur:ProcedureReturn 0:EndIf
bord(joueur,coup)
If voir(x,y)
For i=1 To 19:For j=1 To 19
If vu(i,j) And etat(coup,i,j)=-joueur:etat(coup,i,j)=0
supprime(i,j):EndIf
Next j:Next i
EndIf
EndProcedure
Procedure dimension()
debut:
taille.s=InputRequester("Taille","Choisir une taille entre 5 et 19","19")
i=Round(Val(taille),0)
If i<5 Or i>19:Goto debut:EndIf
n=i:joueur=-1:coup=1:total=1
For k=0 To 999
For i=0 To n
For j=0 To n
etat(k,i,j)=0
Next j:Next i:Next k
larg=n*27:If larg<500:larg=500:EndIf
ResizeWindow(larg,40+27*n)
refresh()
EndProcedure
Procedure opp(k)
Select k
Case 1
ProcedureReturn 3
Case 2
ProcedureReturn 4
Case 3
ProcedureReturn 1
Case 4
ProcedureReturn 2
EndSelect
EndProcedure
n=19
larg=n*27:If larg<500:larg=500:EndIf
win.l=OpenWindow(0,100,100,larg,n*27+40,#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered |#PB_Window_SystemMenu|#PB_Window_TitleBar,"Jeu de Go")
CreateMenu(1,win)
MenuItem(3,"Rafraichir")
MenuItem(4,"Sauver")
MenuItem(5,"Ouvrir")
MenuItem(6,"Précédent")
MenuItem(7,"sUivant")
MenuItem(8,"Nouveau")
MenuItem(10,"Taille")
AddKeyboardShortcut(0,#PB_Shortcut_R,3)
AddKeyboardShortcut(0,#PB_Shortcut_S,4)
AddKeyboardShortcut(0,#PB_Shortcut_O,5)
AddKeyboardShortcut(0,#PB_Shortcut_P,6)
AddKeyboardShortcut(0,#PB_Shortcut_U,7)
AddKeyboardShortcut(0,#PB_Shortcut_N,8)
AddKeyboardShortcut(0,#PB_Shortcut_A,9)
AddKeyboardShortcut(0,#PB_Shortcut_T,10)
refresh()
Repeat
event=WaitWindowEvent()
Select event
Case 513
x=WindowMouseX():y=WindowMouseY()
i=1+Round(x/27,0):j=Round((y-20)/27,0)-1
If i<=n And j>0 And j<=n
If etat(coup-1,i,j)=0
For k=1 To n:For p=1 To n:etat(coup,k,p)=etat(coup-1,k,p):Next p:Next k
etat(coup,i,j)=joueur
elim(i-1,j):elim(i+1,j):elim(i,j-1):elim(i,j+1)
joueur=-joueur:nouveau(i,j)
elim(i,j):coup=coup+1:total=coup
EndIf
EndIf
Case #PB_Event_Repaint
refresh()
Case #pb_event_menu
Select EventMenuID()
Case 3
refresh()
Case 4
sauver():refresh()
Case 5
ouvrir()
Case 6
precedent()
Case 7
suivant()
Case 8
sauver()
For i=1 To 1000:For j=1 To 20:For k=1 To 20
etat(i,j,k)=0:Next k:Next j:Next i
joueur=-1:coup=1:refresh()
Case 10
If coup>1:sauver():EndIf
dimension()
EndSelect
EndSelect
Until event= #PB_EventCloseWindow
sauver()
End
Eh oh nan faut pas exagérer... Tout de suite c'est de la daube... Je suis d'accord pour avoir l'esprit critique mais dans la vie faut être réaliste... C'est quoi cette facon d'agir là ? J'ai pris la peine de lire les articles et nan je ne suis pas d'accord... De quel droit tu te permet de dire que c'est 100% pure daube alors que c'est au moins à 150 voir 200% ??hardy a écrit :Je viens de jeter un coup d'oeil. 100% pure daube
Je parle bien des articles que j'y ai lu...cederavic a écrit :beuh... je connaissai ce site, je le trouve pas trop mal moi, pas pour les article, mais pour les liens vers les moteur 3d qui souvent envoi vers des site ou il y a d'autre liens bocoup plus interressantpour moi c'est mon google specialiser moteur :p