Nouveau jeu Course d'escargots par ygeronimi

' les boules qui mangent des boules (JEAN CLAUDE 02/2010)

dim a,ap,bo,aj,c,d,n,nb,j,t,tr,vcy,x,y,yp,L,ESP,hg,H,EP,lj,clicX,clicY
dim r(6),g(6),b(6),x1(6),x2(6),y1(6),y2(6)
dim a$,tour$,temp,tempDE,nbpg
dim joueur$(6),gj$(6),lance(12)
dim cx(50),cy(50)
dim couleurboule(384),px(384),py(384),gain(384),nbpion(384)

x=screen_x:y=screen_y

label init,ini,quit,joueur,nom,modnom,mdn,gp,joue,joue1,joue2,clic,tour,joue3,joue4
label de,de1,de2,de3,de4,de5,de6,gain,nul,perdu,joue1a,joue2a,score,ordi,ordi2,ordi3
label ordi4
joueur$(1)="TERMINATOR":joueur$(2)="RAMBO":joueur$(3)="DARK VADOR"
joueur$(4)="SKYWALKER":joueur$(5)="OBI-WAN":joueur$(6)="YODA"

full_space 0
border_hide 0:font_name 0,"fixedsys"
picture 1:top 1,0:height 1,y-140:width 1,x
2d_target_is 1:font_name 1,"fixedsys":print_target_is 1
color 1,200,200,200
gosub ini:gosub init

main_menu 10
sub_menu 11:parent 11,10:caption 11,"Fichier"
sub_menu 111:parent 111,11:caption 111,"Nouvelle Partie":on_click 111,joue
sub_menu 112:parent 112,11:caption 112,"Charger une Partie"
sub_menu 113:parent 113,11:caption 113,"Sauver une Partie"
sub_menu 114:parent 114,11:caption 114,"QUITTER":on_click 114,quit
sub_menu 12:parent 12,10:caption 12,"Joueurs"
for j=1 to 6
sub_menu 12+j:parent 12+j,12:caption 12+j,joueur$(j)
on_click 12+j,joueur
next j
button 2:top 2,250:left 2,450:width 2,50:height 2,18:caption 2,"Modifier":hide 2
edit 3:top 3,250:left 3,550:width 3,100:height 3,18:hide 3
container_option 4
top 4,267:left 4,250:width 4,160:height 4,50:hide 4
option 5:parent 5,4:top 5,10:left 5,5:width 5,150
option 6:parent 6,4:top 6,30:left 6,5:width 6,150
picture 7:top 7,y-130:left 7,x-110:height 7,100:width 7,100
color 7,255,200,200
picture 8:top 8,7:left 8,0:height 8,22:width 8,x
color 8,200,200,200
temp=10: ' temps entre chaque joueurs
tempDE=50: ' temps de visualisation des dé
nbpg=29: ' Nombre de points pour gagner (maxi conseillé 50)
end
' ==============================================================================
joue:
hide 2:hide 4:inactive 111:inactive 12
color 1,200,200,200:gosub init:j=0
vcy=50
for nb=1 to 16
vcy=vcy+50
t=int(rnd(6))+1:j=t
for c=t to t+23
cx(t-1)=0
j=j+1:bo=bo+1
if j=7 then j=1
cx(c)=cx(c-1)+50:cy(c)=vcy
couleurboule(bo)=j:px(bo)=cx(c):py(bo)=cy(c)
2d_fill_color r(j),g(j),b(j)
2d_circle cx(c),cy(c),10
next c:next nb
for nb=1 to 6
nbpion(nb)=99
next nb
joue1:
gosub tour
if gj$(tr)="O" then gosub ordi:goto joue1
joue1a:
if nbpion(tr)<1 then message " "+joueur$(tr)+"vous n'avez plus de cartouches":goto joue1
print_target_is 0:print_locate 1,y-120:print string$(140," "):print_locate x-(x/2)-100,y-120
print " "+joueur$(tr)+" choisissez l'attaquant"
on_click 1,joue2
return

joue2:
gosub clic:ap=bo
if couleurboule(bo)<>tr then message "Vous devez attaquer avec votre couleur":goto joue1a
if couleurboule(bo)=7 then message " Vous devez Choisir une boule":goto joue1a
if couleurboule(bo)=8 then message " Cette boule est déja jouée":goto jouea1
2d_fill_color r(tr),g(tr),b(tr)
2d_circle px(bo),py(bo),2
joue2a:
print_locate 1,y-120:print string$(140," "):print_locate x-(x/2)-100,y-120
print " "+joueur$(tr)+" choisissez le défenseur"
on_click 1,joue3
return

joue3:
gosub clic
if couleurboule(bo)=tr then message "Vous devez attaquer une autre couleur":goto joue2a
if couleurboule(bo)=7 then message " Vous devez Choisir une boule":goto joue2a
if couleurboule(bo)=8 then message " Cette boule est déja jouée":goto joue2a
2d_fill_color r(couleurboule(bo)),g(couleurboule(bo)),b(couleurboule(bo))
2d_circle px(bo),py(bo),15
print_locate 1,y-120:print string$(140," "):print_locate x-(x/2)-100,y-120
print " "+joueur$(tr)+" attaque "+joueur$(couleurboule(bo))
a=tr:gosub de:wait 1000
print_locate 1,y-100:print string$(100," "):print_locate 10,y-100
print " "+joueur$(tr)+" => "+str$(d):lance(tr)=d
a=couleurboule(bo):gosub de:wait 1000
print_locate 1,y-80:print string$(100," "):print_locate 10,y-80
print " "+joueur$(couleurboule(bo))+" => "+str$(d):lance(couleurboule(bo))=d
if joueur$(couleurboule(bo))="" then message " A coté !"+chr$(13)+"Recommencez":goto joue4
if lance(tr)>lance(couleurboule(bo)) then gosub gain:goto joue4
if lance(tr)=lance(couleurboule(bo)) then gosub nul:goto joue4
if lance(tr)<lance(couleurboule(bo)) then gosub perdu:goto joue4
joue4:
gosub score
if tour$="P" then goto joue1
goto joue1a
return

ordi:
off_click 1
if nbpion(tr)<1 then message " "+joueur$(tr)+"vous n'avez plus de cartouches":return
ordi2:
bo=int(rnd(384))+1
ap=bo
if couleurboule(bo)<>tr then goto ordi2
if couleurboule(bo)=7 then goto ordi2
if couleurboule(bo)=8 then goto ordi2
2d_fill_color 255,255,255
2d_circle px(bo),py(bo),10
wait temp
ordi3:
bo=int(rnd(384))+1
if couleurboule(bo)=tr then goto ordi3
if couleurboule(bo)=7 then goto ordi3
if couleurboule(bo)=8 then goto ordi3
2d_fill_color r(couleurboule(bo)),g(couleurboule(bo)),b(couleurboule(bo))
2d_circle px(bo),py(bo),15
print_locate 1,y-120:print string$(150," "):print_locate x-(x/2)-100,y-120
print " "+joueur$(tr)+" attaque "+joueur$(couleurboule(bo))
a=tr:gosub de:wait 1000
print_locate 1,y-100:print string$(100," "):print_locate 10,y-100
print " "+joueur$(tr)+" => "+str$(d):lance(tr)=d
a=couleurboule(bo):gosub de:wait 1000
print_locate 1,y-80:print string$(100," "):print_locate 10,y-80
print " "+joueur$(couleurboule(bo))+" => "+str$(d):lance(couleurboule(bo))=d
if lance(tr)>lance(couleurboule(bo)) then gosub gain:goto ordi4
if lance(tr)=lance(couleurboule(bo)) then gosub nul:goto ordi4
if lance(tr)<lance(couleurboule(bo)) then gosub perdu:goto ordi4
ordi4:
gosub score
if tour$="P" then return
goto ordi

score:
print_target_is 8
for n=1 to 6
if n=1 then yp=210
if n=2 then yp=370
if n=3 then yp=530
if n=4 then yp=690
if n=5 then yp=850
if n=6 then yp=1010
print_locate yp-20,5:print "      ":print_locate yp-15,5:print gain(n)
print_locate yp+18,5:print "      ":print_locate yp+22,5:print nbpion(n)
next n
print_target_is 0
return

perdu:
couleurboule(ap)=7
nbpion(tr)=nbpion(tr)-1
2d_pen_color 200,200,200:2d_fill_color 200,200,200:2d_circle px(ap),py(ap),20
2d_pen_color 0,0,0
2d_fill_color r(couleurboule(bo)),g(couleurboule(bo)),b(couleurboule(bo))
2d_circle px(bo),py(bo),15
gain(couleurboule(bo))=gain(couleurboule(bo))+1:couleurboule(bo)=8
nbpion(couleurboule(bo))=nbpion(couleurboule(bo))-1
tour$="P"
return

nul:
2d_pen_color 200,200,200:2d_fill_color 200,200,200:2d_circle px(ap),py(ap),20
2d_pen_color 0,0,0:2d_fill_color r(tr),g(tr),b(tr):2d_circle px(ap),py(ap),10
2d_pen_color 200,200,200:2d_fill_color 200,200,200:2d_circle px(bo),py(bo),20
2d_pen_color 0,0,0
2d_fill_color r(couleurboule(bo)),g(couleurboule(bo)),b(couleurboule(bo))
2d_circle px(bo),py(bo),10
tour$="P"
return

gain:
2d_pen_color 0,0,0:2d_fill_color r(tr),g(tr),b(tr):2d_circle px(ap),py(ap),10
nbpion(couleurboule(bo))=nbpion(couleurboule(bo))-1
couleurboule(bo)=tr
2d_fill_color r(couleurboule(bo)),g(couleurboule(bo)),b(couleurboule(bo))
2d_circle px(bo),py(bo),15
gain(tr)=gain(tr)+1:couleurboule(bo)=8::nbpion(tr)=nbpion(tr)-1
if gain(tr)>nbpg then message "Bravo! "+joueur$(tr)+ " Vous avez gagné la Partie.":goto quit
tour$="G"
return

de:
tour$=""
d=int(rnd(6))+1
for n=1 to 12
wait tempDE
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80
2d_fill_color r(a),g(a),b(a)
d=int(rnd(6))+1
if d=1 then gosub de1
if d=2 then gosub de2
if d=3 then gosub de3
if d=4 then gosub de4
if d=5 then gosub de5
if d=6 then gosub de6
next n
return

de1:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 50,50,5:2d_target_is 1:2d_pen_width ep
return

de2:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 40,40,5:2d_circle 60,60,5
2d_target_is 1:2d_pen_width ep
return

de3:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 35,35,5:2d_circle 50,50,5:2d_circle 65,65,5
2d_target_is 1:2d_pen_width ep
return

de4:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 35,35,5:2d_circle 65,35,5:2d_circle 35,65,5:2d_circle 65,65,5
2d_target_is 1:2d_pen_width ep
return

de5:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 35,35,5:2d_circle 65,35,5:2d_circle 35,65,5:2d_circle 65,65,5:2d_circle 50,50,5
2d_target_is 1:2d_pen_width ep
return

de6:
2d_target_is 7:2d_pen_width 5:2d_rectangle 20,20,80,80:2d_fill_color 0,0,0
2d_circle 40,35,4:2d_circle 40,50,4:2d_circle 40,65,4
2d_circle 60,35,4:2d_circle 60,50,4:2d_circle 60,65,4
2d_target_is 1:2d_pen_width ep
return

tour:
tr=tr+1
if tr>6 then tr=1
return

clic:
clicX=mouse_x_position(1):clicY=mouse_y_position(1)
for n=1 to 384
if px(n)<(clicX+10) and px(n)>(clicX-10) and py(n)<(clicY+10) and py(n)>(clicY-10) then bo=n:exit_for
bo=0:next n
return

joueur:
for j=1 to 6
if clicked(12+j)=1 then exit_for
next j
print_locate 250,250:print string$(20," ")
print_locate 250,250:print " NOM: "+joueur$(j)+" "
show 2:on_click 2,nom
show 4
if gj$(j)="O" then mark_on 6:set_focus 6
if gj$(j)="J" then mark_on 5:set_focus 5
caption 5," Gérer par "+joueur$(j)+" "
caption 6," Gérer par l ' Ordinateur "
on_click 5,gp
on_click 6,gp
return

gp:
if checked(5)=1 then gj$(j)="J"
if checked(6)=1 then gj$(j)="O"
return

nom:
show 3:set_focus 3
on_key_up 3,modnom
return

modnom:
if key_up_code=13 then a$=upper$(text$(3)):gosub mdn
return

mdn:
if len(a$)>11 then message "11 Caractères Maximum":text 3,"":return
if len(a$)<3 then message "3 Caractères Minimum":text 3,"":return
joueur$(j)=a$:hide 3:aj=j:gosub init:j=aj
print_locate 250,250:print string$(20," ")
print_locate 250,250:print " NOM: "+joueur$(j)+" "
caption 5," Gérer par "+joueur$(j)+" "
caption 6," Gérer par l ' Ordinateur "
caption 12+j,joueur$(j)
on_click 12+j,joueur
return

ini:
for j=2 to 6
gj$(j)="O"
next j
gj$(1)="J"
return

init:
L=120:ESP=40:H=5:EP=1.5
r(1)=50:g(1)=255:b(1)=0:r(2)=255:g(2)=150:b(2)=100:r(3)=255:g(3)=0:b(3)=255
r(4)=0:g(4)=255:b(4)=255:r(5)=255:g(5)=0:b(5)=100:r(6)=255:g(6)=255:b(6)=50
hg=int(((L/2)+(H/2))/2)
for n=1 to 6:x1(n)=(L*n)+(ESP*n):y1(n)=hg:x2(n)=x1(n)+L:y2(n)=hg*2:next n
for j=1 to 6:2d_pen_width ep:2d_fill_color r(j),g(j),b(j):2d_rectangle x1(j),y1(j),x2(j),y2(j)
a=len(joueur$(j)):if a<7 then lj=20
if a=7 then lj=14
if a>7 then lj=8
print_locate x1(j)+int((lj*4)/2),y1(j)+8:print joueur$(j):next j
return

quit:
terminate