..
titre="Awalé"
' bug: play="[N:24 A:1 B:0 C:0 D:0 E:0 F:1 1:1 2:0 3:0 4:0 5:0 6:0 S:21]A"
' msgbox "go"
version="20200927-0900"
' bug
' par famine debile!
' retorune * dans last si rien de joué
' revoir jouables nest que une mémorisation de liste() liste de estjouable
'
' est-il possible 24x24 ?
' terrain, initialisé par settopo
dim wikipedia
dim toponymie ' noms des cases
dim zero ' nom capture de sud
dim treize 'nom capture de nord
settopo(false) 'notations Pofland
showtime=false
token="last"
message=""
sansprise=false
helped=false ' deviendra true si $
'
encours="en cours."
abandon=false ' a vrai si erreur
web=false' false ' si vrai écriture last après chaque coup
list=false ' passera a true si L
'
' bug et incertitudes
' redondance candidats (global) et function liste
' notes
' appliquant les règles de http://www.african-concept.com/awale-regle-du-jeu.html
' !
' play st utilisé en cours de développement pour réexécuter la mêrme séquence
'plus longue partie (empirique)
play="F1A6E1A4C3F1E3A6D5E4E6D2C1E6B6A6E4C6D5B3F3D1E4D3B2A1C2A6D5C3B2E3F1B6D4B6D2E3C1A4D5F1D2E5B1C6F4A"
play=play& "3D6E4B5C6A1E2B3D4B5C6A1F2B4A1E2C3D4B5A6C1B2E3A4D1C5B2A6F3E4D5C1B6A2F3E1D2C4B5A6F3E1D4C5B6A2F1E3D2C3B4A6F5E6F1E2D3B4C5A1B6F2E3A4D1C2B5A6F3E1D4C2B5A6F3E4D1C5B2A6F1E2D3C5B4A6F5E1D2C3B6A1F4E2D3C4B5A6F1D2E3C4B5D6A1C2B3F4E5D6A1F2C3E4D5C6B1F2E3A1D4C5B6F2A1E3D2C3B4A6F5E1D2C6F3E4B5D6A1C2B3F4A5E1D6C2F3B4E5A6F1D2C3E4D5C6B1A2F3E4D5C1B2A6F1E3D2C3B4A6F1E2D3C4B5A6F1D2C3E4B5D6A1F2C3E4D5B6A1F2E3C4D5B6A1C2F3B4E5D6A1C2F3E4B5A6D1C2B3F4A1E2D3C5B6F4A5E1D6F2C3B4E5A6D1C2F3B4E5A1D2C6B3F4A5E6D1F2C3E4D5B6A1C2B3F4A5E1D2C6B3A1F4E2D3C4B5F6A1F2E3D4C5B6A2F1E3D2C3B4A6F1E5D6F2C3E4D5C6B1A1F2E4D5C6F3B4E5D6A1F2C3E4D5C6B1F2A1E3D2C3B4A6F1E5D6C2F3E4D5B6A1C2F3B4E5A6D1C2B3A4F1E2D3C4B5F6A1E2F3E4D5B6A1F2E3D4C5B6A2F1E3D2C4B5A6F3E4D5C1B6A1F2E3D4C6F5B6A1F2E3C4B5A1D2C3B4A6F5E1D2C6F3E4D5B6A1F2E3D4C5A6B1F2A1E2D3C4B5F6A1E2F3E4D5B6A1F2E3C4D5C6B1A2F3E4D1C2B5A6F1E2D3C5B6A1F4E2D3C5B4A6F1E2D3C5B4A6F5E6D1F2E3C4D5B6A1C2F3B4A1E2D5C6F3B4A5E1D6C2B3A1F2E3D4C5B6A1E2F3E4D"
play=play&"5B6A1C2B3A4F1E2D5C6B3A4F1E5D2C3B4A6F1E5D6F2C3B4E5D6A1F2C3E4B5D6A1C2F3B4A5E1D6C2B3F4E5D6A1F2C3E4D5B6A1F2E3C4B5D6A1C2B3A4F1E2D3C5B4A6F5E1D6F2C3B4E5A6D1C2B3F4A5E6D1F2E3C4B5D6A1F2C3E4B5A1D6F2E3C4D5C6B1F2A3E1D4C5B6F2A3E4D1C2B5A6F3E4D1C5B2A6F1E2D3C4B5A1F6E2F3E4D5B6A1C2F3B4A5E6F1D2E3D4C5B6A1F2E4D5C3B6F4A1E5D2C6F3B4A5E6D1C2B3A4F5E1D2C6F3B4A5E6D1F2E3C4D5B6A1F2E3D4C5A6F1B2A1E2D3C4B5F6A1F2E3C4D5C6B1F2A3E4D5C1B6F2E3A4D5C1B2A6F3E1D2C4B5A6F1E2D3C4B5F6A1F2E3D4C5B6A1F2E4D5C6F3E4D5B6A1F2E3C4D5C6B1F2E3A4D5C1B6A2F3E1D4C2B3A"
' plus courte:
'play="B1 A3 C3 D6 E5F4" ' 2A 1C 3c 5E 6D
' injection
'play="<N:22 A:1 B:1 C:0 D:0 E:1 F:0 1:0 2:0 3:0 4:0 5:0 6:2 S:21"
play=""
jouables=""
Set fs = CreateObject("Scripting.FileSystemObject")
numero=1
if list then
if fs.fileexists("numero.txt" )then
Set a = fs.openTextFile("numero.txt")
if not a.atendofstream then numero=a.readline
a.close
end if 'erxist
if fs.fileexists("numero.txt") then
Set a = fs.createTextFile("numero.txt", True)
if list then a.writeline numero+1
a.close
end if
end if
if list then nomlog="awale_"&numero&".txt"
if list then Set a = fs.CreateTextFile(nomlog, True)
if list then a.writeline titre & " "&version& " at:" & now
Set oArgs=WScript.Arguments ' tableau d'arguments
if oArgs.Count =1 then' nombre d'argument trasmis
' argument il a priorité sur le play forgé ci dessus
play=oArgs(0) ' premier argument
if len(play)>0 then if list then a.writeline "commande: " & play
'' msgbox play
end if
'msgbox "crochet:"&play
' sera utiliser pour si affame en auto
dim lettre
maxboucle=5000 ' jamais vu plus de 1200
dim cases(13)
dim capt(13)
cases(13)=0 'grenier nord
cases(0)=0 ' sud
coups=0
random=0' passera a 9999 si * et 1 si +
auto=false ' passera à true si != finir sans dialogue
fronton=false ' passera a true si / = fronton
randomize
chef=false ' mémorisera pile au moment de / pour déterminer suivant
started=false ' éviter comparaison au premier tour
tours=0
'
Set oArgs=WScript.Arguments ' tableau d'arguments
if oArgs.Count =1 then' nombre d'argument transmis
play=oArgs(0) ' premier argument
end if
histo=""
init
' ------------- choisir le premier à jouer
if len(play)>0 then
' selon la première lettre de play
choisi=false
i=0
while i<len(play) and not choisi
i=i+1
oui=instr(toponymie,mid(play,1,1))
if oui>0 then
pile=oui>6
choisi=true
end if
wend
end if
'sinon au hasard
if not choisi then pile=rnd>=0.5
'msgbox xx &" " & pile
' -----------------------
if web then
' effacer fichier "last.txt" si il existe
if fs.fileexists("last.txt") then
fs.deletefile ("last.txt")
end if
end if
while true
' vérifier si deux graines "diamétralement" opposées 23-23 ou 24-22
' if list then a.writeline 'TESTER INFINI"
if (cases(0)+cases(13)=46) and cases(0)<25 and cases(13)<25 then ' reste deux graines
for i=1 to 6
' if list then a.writeline "i="&i&" "&cases(i)&" " &cases(i+6)
if cases(i)=1 and cases(i+6)=1 then
' bof, joueur sera mis par finir
finir "infini"
end if
next 'i
end if' = 46 etc
'
'
coups=coups+1
patience=patience+1
' à l'autre de jouer
' if list then a.writeline "pile etait:"&pile&" " & joueur(pile)
pile=not pile
' if list then a.writeline " now coups="&coups&" joueur="&joueur(pile)&" adv="&adversaire(pile)& " choix dans liste pasfait :"&liste()
' compter nb de coups possibles pour ce joueur (SES cases non vide et non interdites )
base=0
' jouables
' tester si possibleya =false
' if list then a.writeline "actuel="&joueur(pile) &bacligne
jouables=liste()
if len(jouables)=0 then
if not auto then msgbox joueur(pile) & " aucun jouable "&jouables
if list then a.writeline joueur(pile) & " aucun jouable "&jouables
finir "ya pas"
end if 'ya
'a.write bacligne & " ?"&liste()
' preparer la ligne pour la log si reponse acceptee
projet=coups&":"& bacligne & " ? "&jouables
'
' pret pour un coup
' l'adversaire(pile) a des cases OU je peux le nourrir
'
j=-4
while j=-4 ' réponse de jeu si frappe n'est pas un coup 0-6 A-F
if random>0 or (fronton and not pile=chef) then
random=random-1
' if list then a.writeline "hasard "&joueur(pile) &" " &bacligne& "???" & liste()
if len(liste())=0 then
finir "impossible de jouer aléatoire pour "&joueur(pile)
end if
' if list then a.writeline "un de plus jouables="&jouables&" hasard="&random
jouables=liste()
j=hasard(jouables) ' voir ce que c'est
lettre=mid(toponymie,j,1)
' if list then a.writeline "hasard found rnd " & j & " touche=" & lettre
else
' la c'est un coup "humain"
j=-3
while j=-3
' if list then a.writeline "appel de jeu"
j=jeu
' if list then a.writeline "jeu a repondu "&j&" =="&lettre
wend ' j=-3
' if list then a.writeline "sortie par j<>-3"
end if 'random/else
' if list then a.writeline "repeter tant que de j=-4 "&j
wend ' j =-4
' if list then a.writeline "j<>-4 on continue"
started=true
' mémoriser le coup à jouer
histo=histo&lettre
'msgbox lettre & " " & j
' if list then a.writeline "reponse: "& lettre & " j="&j
projet=projet & " ="& lettre
if j<0 then finir "abandon "
last=0 'dernière case de la distribution pour tester si capture
if j=0 then
if list then a.writeline "invalide frappe apres distribution "&lettre&" j="&j
if lettre<>"." then
if list then a.writeline "invalide frappe pas point "&lettre
if not auto then msgbox "invalide frappe pas point "&lettre
abandon=true
finir "pa s point"
end if
else
' if list then a.writeline "distribution pile="&pile& " j="&j
' if list then a.writeline "????? pile="&pile& " j="&j& " case="& cases(j)
if ((pile and j<=6) or (j>=7 and not pile) ) and (cases(j)>0) then
' if list then a.writeline "faire pile="&pile& " j="&j& " case="& cases(j)
disp=cases(j)
cases(j)=0
start=j
t=j+1
repet=0
while (disp>0)
if t=13 then t=1
if t<>start then
cases(t)=cases(t)+1
' if list then a.writeline "cases("&t&") now " & cases(t)
last=t
disp=disp-1
end if
t=t+1
' if list then a.writeline "point 0"
wend 'disp >0
' if list then a.writeline "point 1"
end if ' 6 ou 7
' if list then a.writeline "point 2"
if last=0 then
if list then a.writeline "apres distrib invalide last=0!"
if random=0 then
if not auto then msgbox "invalide dans jeu last=0"
end if
abandon=true
finir "last=0"
else
if pile then
seuil=7
ok=12
else
seuil=1
ok=6
end if
' if list then a.writeline "point 4 last="&last& " seuil="&seuil
' if list then a.writeline bac(true)
for i=1 to 12
capt(i)=0
next 'i
' if list then a.writeline "avant capture:"&bacligne&" last="&last
while (last >=seuil) and (last <= seuil+5)
if ( pile and last>6) or (not pile and last<=6) then
if cases(last)=2 or cases(last)=3 then
' if list then a.writeline "capture " & joueur(pile) &" '"& last & ") "&cases(last)
'msgbox "capture " & pile &" "& last & " "&cases(last)
if patience>patiencemax then patiencemax=patience
patience=0
if pile then
cases(0)=cases(0)+cases(last)
' if list then a.writeline "cases(0) passe à "&cases(0)
else
cases(13)=cases(13)+cases(last)
' if list then a.writeline "cases(13) passe à "&cases(13)
end if ' nord sud
capt(last)=cases(last)
' if list then a.writeline "capt("&last&") mis à "&capt(last)
' if list then a.writeline "memo capt("&last&") mis a" & capt(last)
cases(last)=0
last=last-1
else
last=0
end if ' 6ou 7
end if '?????
wend ' recul last
' if list then a.writeline "point 5"
' if list then a.writeline "fin de distribution, vérifier exceptions" & bacligne
' vérifier adversaire(pile) a une case non vide=encore à manger
' manger est le nb de graines chez l'adversaire(pile) après le coup candidat en cours
manger=0
base=0
if pile then base=base+6
'explore les cases de l'adversaire(pile)
for i=base+1 to base+6
manger=manger+cases(i)
next 'i
'ajeun=false
'precedentaffamant=manger=true
if manger=0 then
' if list then a.writeline "adversaire(pile) serait mis à jeun "&joueur(pile)& " avait joué: "&lettre
' if list then a.writeline "impossible adversaire(pile) serait affamé:"&bacligne
' rendre à l'adversaire(pile)s ses captifs
sansprise=true
for i=base+1 to base+6
' if list then a.writeline "rendre la case "&i&" " & mid("123456gedcba",i,1)& " remis a "&capt(i)
cases(i)=capt(i)
if pile then
cases(0)=cases(0)-cases(i)
' if list then a.writeline "cases(0) rest re passe a "& cases(0)
else
cases(13)=cases(13)-cases(i)
' if list then a.writeline "cases(13) rest re passe a "& cases(13)
end if
next 'i
' if list then a.writeline "bilan apres restituion: le coup est joué"& bacligne
' test: rejouer sans fin!
' if list then a.writeline "POINT A manger="&manger
if manger>0 then
'
if list then a.writeline "examine stock adversaire(pile) " & stock& " manger=" & manger
if stock>0 and manger=0 then
if list then a.writeline "impossible affamer adversaire(pile) serait" & bacligne
play=""
' annuler les captures chez l'adversaire(pile)
if list then a.writeline "restaurer capt de "&base+1 & " à " & base+6
for i=base+1 to base+6
cases(i)=capt(i)
if list then a.writeline "cases("&i&") restaure a " & cases(i)
if pile then
cases(0)=cases(0)-capt(i)
' if list then a.writeline "cases(0) recukle a " &cases(0)
else
cases(13)=cases(13)-capt(i)
end if
next 'i
if list then a.writeline "apres annulation cases=" & bacligne
'possibles=possibles-1
' if list then a.writeline "adversaire(pile) garde ses graines possibles="&possibles
' if list then a.writeline bacligne
projet=bacligne
if list then a.writeline "projet mis a " & projet
end if
if list then a.writeline "point 8"
end if
' if list then a.writeline "point 9"
end if '******
' if len(projet)>0 then if list then a.writeline projet
end if ' ajouté test
end if ' ajouté test1
' verif
' if list then a.writeline "now ecrire last " &bacligne
if (cases(0)>=25) or (cases(13)>=25) then
if cases(0)>=25 then g=zero else g=treize
finir "" ' g & " gagne"
end if
wend 'true
' ------- fin du PP.
sub finir (comment)
nono=""
if showtime then nono=" {" &now &"} "
' if list then a.writeline comment & " stop=" & yastop
z="00000"&coups
z=mid(z,len(z)-5)
if z<10000 then z=mid(z,3)
sign="OUF"
' if list then a.writeline "OUf finir joueur="&joueur(pile)&" coups="&coups&" comment="&comment
' jouer ou 00
if (cases(0)+cases(13)=46) and cases(0)<25 and cases(13)<25 then ' reste deux graines
oppose=false
for i=1 to 6
if cases(i)=1 and cases(i+6)=1 then oppose=true
next 'i
end if
if oppose then
jj=" 00 "
else
jj=joueur(pile)
if instr(comment,"++")>0 or coups>=maxboucle then jj=joueur(pile) & " ++++ " & 48-cases(0)-cases(13)& " "
end if
'
if mid(comment,1,10)="OUF pas ch" then
sign="ouf"
comment=""
end if
if list then a.writeline sign&"=("&z&")["&patiencemax&"]"&jj&"=="&bacligne& nono& comment& " histo="&histo
if not auto then msgbox bac (true),,titre&" fin de partie."
if list then a.writeline " finit pile en "&pile& " " & jouables
if web then
if NOT pile then
lck=token&".S.lck.txt"
lautre=token&".N.lck.txt"
else
lck=token&".N.lck.txt"
lautre=token&".S.lck.txt"
end if
' if list then a.writeline "token="&token
if list then a.writeline "----creation fichier retour: "&token&".txt"
set b=fs.createtextfile(token&".txt",true)
if abandon then
if list then a.writeline "*"
b.writeline "*"
else
b.writeline bacligne
if list then a.writeline bacligne
end if
jouables=liste()
if cases(0)>24 or cases(13)>24 then
jouables=""
end if
b.writeline len(jouables)
if list then a.writeline len(jouables)
for jp=1 to len(jouables)
b.write mid(jouables,jp,1)
if list then a.write mid(jouables,jp,1)
next 'jp
b.writeline
if list then a.writeline
if lettre="." then coups=coups-1
b.writeline coups
if list then a.writeline coups
b.writeline joueur(pile)
if list then a.writeline joueur(pile)
gagnant=encours& " (A "&joueur(pile)&" de jouer)."
if sansprise then gagnant=gagnant & " (sans prise)"
if cases(0)>24 then gagnant ="Sud gagne."
if cases(13)>24 then gagnant= "Nord gagne."
if cases(0)<25 and cases(13)<25and lettre<>"." then gagnant=joueur(pile) & " gagnant par famine "
if jj=" 00 " or oppose then gagnant="aucun (partie interminable)."
b.writeline gagnant
if list then a.writeline gagnant
b.writeline message
if list then a.writeline message
b.writeline helped
if list then a.writeline helped
if list then a.writeline "--------"
b.close
if list then a.writeline "creation de flag unlock="&lck
moninit=mid(joueur(pile),1,1)
lcklck=token&"."&moninit&moninit&".lck.txt"
set b=fs.createtextfile(lck,true)
b.writeline "ouf! @:"&now&" " &lck
b.close
if gagnant<>encours then
if list then a.writeline "creation flag unlock="&lautre
set b=fs.createtextfile(lautre,true)
b.writeline "ouf! @:"&now&" " &lck
b.close
set b=fs.createtextfile(lcklck,true)
b.writeline "ouf! @:"&now&" " &lck
b.close
end if ' termine
end if
wscript.quit
end sub
function bac (fini) ' si fini pas d'invite à répondre
haut=""
bas=""
for i=1 to 6
haut=haut & mid(toponymie,13-i,1) & ":" & 0+cases(13-i)&" "
'haut=haut & mid(toponymie,6+i,1) & ":" & 0+cases(13-i)&" "
bas=bas & mid(toponymie,i,1) & ":" & 0+cases(i)&" "
'bas=bas & mid(toponymie,i,1) & ":" & 0+cases(i)&" "
next 'i
nextbac=joueur(false)&": "&cases(13) & vbcrlf & haut & vbcrlf & bas & vbcrlf & joueur(true)&": " & cases(0)
if not fini then
nextbac=nextbac & vbcrlf & joueur(pile) & "? "&liste() & vbcrlf & "(ou *: auto, /:fronton, !:silence, "&vbcrlf&_
"X pour tourner le jeu, W:wikipedia .: terminer, ?: aide.)"
end if
bac=nextbac
end function
function bacligne
dim i
haut=""
bas=""
for i=1 to 6
haut=haut & mid(toponymie,13-i,1)& ":" & cases(13-i)&" "
bas=bas & mid(toponymie,i,1) & ":" & cases(i)&" "
next 'i
'b1="["&mid(joueur(false),1,1)&":"&cases(13)&" "
'a.writeline b1'
'bacligne=b1&haut & bas &mid(joueur(true),1,1)&":"& cases(0) & "]"
bacligne="["&mid(joueur(false),1,1)&":"&cases(13)&" " & haut & bas & " "&mid(joueur(true),1,1)&":"& cases(0) & "]"end function
'
function jeu '
' si play est vide interroger joueur
if len(play)=0 then
play=inputbox (bac(false),titre & " ? " & coups)
' if list then a.writeline "inputbox play="&play
end if
alaide=false
jouables=liste()
if true then ' pour debug
'msgbox "list="&list&fs.fileexists(nomlog)
' if list then a.writeline "JEU:" & bacligne & "liste()="&liste()& " pile="&pile& " joueur="&joueur(pile)& " auto="&auto & _
' " jouables="&jouables& " play="&play
end if
' redemander sauf si al'aide!
while not alaide
if len(play)>0 then
' if list then a.writeline "dans jeu joueur="&joueur(pile)&" play="&len(play)&":"&play
'
lettre=mid(play,1,1)
'
' intercepter <
if instr("[",lettre)>0 then
injecteplay(1)
' if list then a.writeline "injecte play fait"
jeu=-4
exit function
end if
if instr("xX",lettre)>0 then
if list then a.writeline "tourner le jeu"
jeu=-4
pile=not pile
play=mid(play,2)
exit function
end if
if instr("lL",lettre)>0 then
' msgbox "ACTIVER LIST"
' list=true
if fs.fileexists("numero.txt" )then
Set a = fs.openTextFile("numero.txt")
numero=a.readline
a.close
nomlog="awale_"&numero&".txt"
end if
'//nomlog
nomlog="awale_"&numero&".txt"
Set a = fs.CreateTextFile(nomlog, True)
a.writeline titre & " "&version& " at:" & now
a.writeline "manque encours:"&play
jeu=-4
pile=not pile
play=mid(play,2)
exit function
end if
if lettre="!" then '1
auto=true
jeu=-4
if list then a.writeline "fin sans dialogue"
play=mid(play,2)
exit function
end if
if lettre="+" then
random=1
jeu=-4
if list then a.writeline "fronton une fois"
play=mid(play,2)
exit function
end if
if lettre="$" then
helped=true
jeu=-4
if list then a.writeline "helped "
play=mid(play,2)
exit function
end if
if lettre="{" then
jusque=instr(play,"}")
message=mid(play,1,jusque)
play=mid(play,jusque+1)
' if list then a.writeline "msg "&message& " reste "&play
jeu=-4
exit function
end if
if lettre="(" then
web=true
random=1
jeu=-4
play=mid(play,2)
fin=instr(play,")")
token=mid(play,1,fin-1)
if fin<=len(play) then
play=mid(play,fin+1)
else
play=""
end if
if list then a.writeline "token "&token& " reste:"&play
'----- copier log
if list then a.close
'msgbox nomlog
' supresdsion list
if false then
if list then
set aa=fs.opentextfile(nomlog)
aeffacer=nomlog
nomlog=token&"_"&numero&".txt"
'msgbox nomlog
set a=fs.createtextfile(nomlog,true)
a.writeline version
a.writeline "copier "&aeffacer& " vers "&nomlog
while not aa.AtEndOfStream
lu1= aa.readline
a.writeline "copie: "&lu1
wend
aa.close
fs.deletefile(aeffacer)
a.writeline "fini et efface "&aeffacer
end if 'list
end if ' false
exit function
end if
if instr("sSnNA",lettre)>0 then
pile=instr("sSA",lettre)>0
jeu=-4
' if list then a.writeline "pile demande:"&pile
play=mid(play,2)
exit function
end if
if instr("?,",lettre)>0 then 'UN
help
jeu=-4
play=mid(play,2)
exit function
end if
if instr("wWpP",lettre)>0 then
if list then a.writeline "notation wikipedia"
settopo=instr("wW",lettre)>0 ' true si wW
jouables=liste()
jeu=-4
play=mid(play,2)
exit function
end if
if instr("tT",lettre)>0 then
showtime=not showtime
if list then a.writeline "stamp "&showtime
jeu=-4
play=mid(play,2)
exit function
end if
if instr("iI",lettre)>0 then
if list then a.writeline "old web ignore "
jeu=-4
play=mid(play,2)
exit function
end if
if mid(lettre,1,1)="*" then ' un
random=9999999
play=""
jeu=-4
if list then a.writeline "(1) random mis a 9999"' (dans play) jeu=-4 exit (1)"
exit function
end if
if mid(lettre,1,1)="." then
finir "point "
end if
if lettre="." then
if list then a.writeline "inputbox retourne . (1)"
' confirm= inputbox ("quitter vraiment")
confirm= msgbox ("quitter vraiment?",vbok,titre)
' if list then a.writeline "confirm="&confirm
if confirm=vbok then finir "point"
jeu=-4
exit function
end if
if lettre="-" then
if list then a.writeline "tiret nul "
play=mid(play,2)
jeu=-4
exit function
end if
' if list then a.writeline "est ce dièse " & lettre
if lettre="#" then
' if list then a.writeline "nb de coups "
play=mid(play,2)
coups=0
while len(play)>=1 and instr("0123456789",mid(play,1,1))>0
coups=10*coups+mid(play,1,1)
play=mid(play,2)
wend
' if list then a.writeline "coups mis a "&coups
jeu=-4
exit function
end if
if list then a.writeline "gfini les exceptions ! lettre="&lettre
else '
if list then a.writeline "dans JEU demande inputbox play="&play
ok=false
while not ok
' lettre=ucase(inputbox (bac(false),titre & " ? " & coups))
lettre=inputbox (bac(false),titre & " ? " & coups)
if not wikipedia then lettre=ucase(lettre)
if list then a.writeline "inputbox " & lettre
ok=false
' 20200606 $ pour helped partage
if len(lettre)>0 then ok=instr(liste&"*!/xXwWpP?[#.nNsS{$",mid(lettre,1,1))>0
if list then a.writeline "ok is " & ok&" ==="&lettre&"==="
if not ok then
if list then a.writeline "frappe invalide: "&lettre
if not auto then msgbox "frappe invalide: "&lettre,,titre & " erreur."
else
' excepyions
'
end if 'ok or not
wend 'while not ok
end if
' if list then a.writeline "accepté (avant wend)" & lettre & " alaide="& alaide
alaide=true
wend ' while not alaide
' if list then a.writeline "wend lecture lettre="&lettre
if lettre="" then
jeu=-1
exit function
end if
if mid(lettre,1,1)="/" then
fronton=true
randomize
lettre=""
chef=pile
jeu=-3
play=mid(play,2)
exit function
end if
play=mid(play,2)
if not wikipedia then lettre=ucase(lettre)
if instr(toponymie,lettre)=0 then
if list then a.writeline "invalide "&lettre&" "&asc(lettre)&">>"&play
if (not auto) and (not web) then msgbox "invalide <<"&lettre&" "&asc(lettre)&">>"&play
abandon=true
finir "pas play"
jeu=-4
exit function
end if
if web then
' if list then a.writeline "web "&lettre& " "&pile
pile=instr(mid(toponymie,1,6),lettre)>0
' if list then a.writeline "web "&lettre& " "&pile
end if
if instr(liste,lettre)=0 then
if list then a.writeline "invalide pas case "&joueur(pile)& " " &lettre&" liste="&liste
if not auto then msgbox "invalide pas case joueur(pile) "&lettre
if web then
abandon=true
finir "pas case"
end if
jeu=-4
exit function
end if
jjj=instr(toponymie,lettre)
' if list then a.writeline "sortie de jeu="&jjj& " pl y orix yn="&play
jeu=jjj
end function
' ------
function init
' if list then a.writeline
cases(0)=0
cases(13)=0
for i=1 to 12
cases(i)=4
next 'i
end function
' --------
function liste
dim i ' locale
l=""
base=0
' selon pile ordre inversé!
if not pile then base=base+6
' if list then a.writeline "peut-on joue de "&base+1&" a"&base+6
for i=base+1 to base+6
if cases(i)>0 then
' if list then a.writeline i&" peunt jouer " & estjouable(i)
if estjouable(i) then
if pile then
l=l & nom(1,i)
else
l= nom(2,i)& l
end if 'pile
end if ' estjouable
end if'>0
next 'i
' if list then a.writeline "topo="&toponymie&" liste="&l
liste=l
end function 'liste
function nom(n,rang)
if rang<1 or rang>12 then finir "nom "&n&" demande idiotte pour rang="& rang
nom=mid(toponymie,rang,1)
end function 'nom
function hasard(l)
' retourne un nombre de 1 à 12, pour le joueur et avec case nonvide
' rertourne la varaible GLOBAL impolicite lettre
' if list then a.writeline "hasard dans l="&l
'11:26
'
' chercher au hasard parmi les possibles dans la chaine L
jj=int(0.9999999+len(l)*rnd())
ou=instr(toponymie,mid(l,jj,1))
' if list then a.writeline "found "&mid(l,jj,1)& " ou="&ou&" dans " & toponymie
hasard=ou
end function 'hasard
sub help
t=""
t=t & "mode d'emploi"&vbcrlf
t=t&"* pour terminer en automatique"&vbcrlf
t=t& "! pour continuer sans dialogue"&vbcrlf
t=t& "W notation wikipedia"&vbcrlf
t=t& "P notation Pofland"&vbcrlf
t=t& "X passer"&vbcrlf
t=t& "/ fronton"&vbcrlf
t=t& "T inverser estampage, actuellement="&showtime & vbcrlf
t=t& ". terminer"
if not auto then msgbox t,, titre
end sub 'help
sub injecteplay(num)
' GAFFE pas tolérant!
' if list then a.writeline "injecter " &num&": "& play
forbug=play
' ajouter espace à la fin pour si denoer nombre!
for i=0 to 13
cases(i)=0
next 'i
' au delà de <
' ajouter espace à la fin
play=mid(play,2)&" "
' injecter
' tant que pas épuisé
' ignirerespace entête
while len(trim(play))>0
' prendre le nom de la case
play=trim(play) ' din espcas si cessus inutils
acible=mid(play,1,1)
if not wikipedia then acible=ucase(acible)
' if list then a.writeline "acible="&acible &" lettre==="&lettre&"==="
if instr(">]",acible)>0 then
play=mid(play,2)
lettre=""
' GAFFE CI DESOSU SEULEMENT SI > suivi d'un coup et pas d'une commande
play=trim(play)
if list then a.writeline "trouve ] retour a jeu web play="&mid(play,1,1)& " toponymie=" & toponymie& " pile="&pile
' choisir joueur
' pile=instr(mid(toponymie,1,6),mid(play,1,1))>0
' if list then a.writeline "trouve ] retour a jeu web play="&mid(play,1,1)& " toponymie=" & toponymie& " pile="&pile
projet=bacligne
if list then a.writeline "pile est a "&pile
' jeu=-4
exit sub
end if
icible=instr(mid(zero,1,1)&toponymie&mid(treize,1,1),acible)-1 'répond 0 à 13
if icible=-1 and acible<>" " then
' if list then a.writeline "icible="&icible&" topo="&toponymie&" a="&acible
finir "pas espace en fin"
end if
' if list then a.writeline "icible="&icible&" topo="&toponymie&" a="&acible
play=mid(play,2)
' : fasultatif
if mid(play,1,1)=":" then play=mid(play,2)
' if list then a.writeline "ajout " & mid(play,1,1)
' GAFFE q a un chiffre
q=0
while len(play)>0 and instr("0123456789", mid(play,1,1))>0
' if list then a.writeline "ajouter si besoin===" & lettre&"===="
'msgbox "lettre="&lettre
q=10*q+mid(play,1,1)
play=mid(play,2)
' if list then a.writeline "init q="&q
wend ' not espace ni >
cases(icible)=q
' if list then a.writeline "init " & icible & "="&cases(icible)
' if list then a.writeline "wend reste lettre==="&lettre&"====="
wend 'while len(play)>0
if list then a.writeline "forge:"&bacligne
projet=coups&":"&bacligne & " ? "&liste
end sub 'injecter
function joueur(p)
if p then
joueur=zero
else
joueur=treize
end if
end function 'joueur
function estjouable(j) ' j de 1 à 12
' if list then a.writeline "estjouable " &joueur(pile) & ":"& j
estjouable=false
dim i
' base est le numéro de la première case de adversaire(pile) (6 si pile=sud et 0 si non=nord
base=0
if pile then base=base+6
'yavait est lenombre de pierre chez ladversaire(pile)
yavait=0
for i=base+1 to base+6
yavait=yavait+cases(i)
next 'i
if yavait>0 and cases(j)>0 then
estjouable=true
exit function
end if
' if list then a.writeline "nourrir"
'if pile then if list then a.writeline joueur(pile)&" faut nourrir avec "& j& " " &cases(j)& ">="& 7-j
'if not pile then if list then a.writeline joueur(pile)&" faut nourrir avec "& j & " " & cases(j)& ">="& 13-j
' donc ici faut nourrir adversaire(pile)
if (pile and cases(j)>=7-j ) or (not pile and cases(j)>=13-j)then
estjouable=true
exit function
end if
'if pile then if list then a.writeline "pas celui la "&cases(j) & " pas suip a "&7-i
'if not pile then if list then a.writeline "pas celui la "&cases(j) & " pas suip a "&13-i
' donc ici false mis au debut
end function
function adversaire(p)
if p then
adversaire=treize
else
adversaire=zero
end if
end function
function settopo(t)
wikipedia=t
if t then
toponymie="ABCDEFfedcba"
zero="MAJUSCULES"
treize="minuscules"
else
toponymie="123456FEDCBA"
zero="Sud"
treize="Nord"
end if
end function