fb:porticula NoPaste
Ein einfaches Computergegner für ein "Vier gewinnt"
Uploader: | Roland Chastain |
Datum/Zeit: | 17.05.2012 13:35:02 |
ENUM Couleur
Rouge = -1
Neant
Jaune
END ENUM
ENUM Booleen
Vrai = -1
Faux
END ENUM
TYPE Grille
AS Couleur c (6,5)
END TYPE
DIM SHARED Courante AS Grille
DIM SHARED Trait AS Couleur
DIM SHARED Automate AS Couleur
DIM SHARED Pions AS BYTE = 42
DECLARE SUB Initialise
DECLARE SUB Represente
DECLARE FUNCTION Ajoute (BYREF g AS Grille, c AS Couleur, x AS BYTE) AS Booleen
DECLARE SUB Choix
DECLARE FUNCTION Score (g AS Grille, c AS Couleur) AS BYTE
DECLARE FUNCTION MeilleurCoup AS BYTE
SUB Initialise
DIM AS BYTE x, y
FOR x = 0 TO 6
FOR y = 0 TO 5
Courante.c (x, y) = Neant
NEXT y
NEXT x
Trait = Jaune
Automate = Rouge
END SUB
SUB Represente
DIM AS BYTE x, y
DIM AS BYTE cc (-1 TO 1) = {12, 0, 14}
PRINT
FOR y = 5 TO 0 STEP -1
FOR x = 0 TO 6
COLOR 1
PRINT "[";
COLOR cc (Courante.c (x, y))
PRINT Chr (254);
COLOR 1
PRINT "]";
NEXT x
PRINT
NEXT y
PRINT
COLOR 7
PRINT " 0 1 2 3 4 5 6 "
PRINT
PRINT
END SUB
FUNCTION Ajoute (BYREF g AS Grille, c AS Couleur, x AS BYTE) AS Booleen
DIM y AS BYTE = 5
IF (x > -1) ANDALSO (x < 7) ANDALSO (g.c (x, y) = Neant) THEN
WHILE (y > 0) ANDALSO (g.c (x, y - 1) = Neant)
y -= 1
WEND
g.c (x, y) = c
RETURN Vrai
ELSE
RETURN Faux
END IF
END FUNCTION
SUB Choix
DIM x AS BYTE
DIM b AS Booleen = Faux
WHILE NOT b
IF Trait = Jaune THEN
INPUT "Jaune, votre coup ! ", x
ELSE
INPUT "Rouge, votre coup ! ", x
END IF
b = Ajoute (Courante, Trait, x)
WEND
END SUB
FUNCTION Score (g AS Grille, c AS Couleur) AS BYTE
DIM AS BYTE x, y, n, nmax, i
DIM AS BYTE Coord(11, 1) = {_
{0,3}, {0,4}, {0,5}, {1,5}, {2,5}, {3,5},_
{6,3}, {6,4}, {6,5}, {5,5}, {4,5}, {3,5}}
nmax = 0
FOR y = 5 TO 0 STEP -1
FOR x = 0 TO 6
IF x = 0 THEN n = 0
IF g.c (x, y) = c THEN n += 1 ELSE n = 0
IF n > nmax THEN nmax = n
NEXT x
NEXT y
FOR x = 0 TO 6
FOR y = 5 TO 0 STEP -1
IF y = 5 THEN n = 0
IF g.c (x, y) = c THEN n += 1 ELSE n = 0
IF n > nmax THEN nmax = n
NEXT y
NEXT x
FOR i = 0 TO 5
x = Coord (i, 0)
y = Coord (i, 1)
WHILE (x < 7) AND (y > -1)
IF x = Coord (i, 0) THEN n = 0
IF g.c (x, y) = c THEN n += 1 ELSE n = 0
IF n > nmax THEN nmax = n
x += 1
y -= 1
WEND
NEXT i
FOR i = 6 TO 11
x = Coord (i, 0)
y = Coord (i, 1)
WHILE (x > -1) AND (y > -1)
IF x = Coord (i, 0) THEN n = 0
IF g.c (x, y) = c THEN n += 1 ELSE n = 0
IF n > nmax THEN nmax = n
x -= 1
y -= 1
WEND
NEXT i
RETURN nmax
END FUNCTION
FUNCTION MeilleurCoup AS BYTE
DIM AS Grille g0, g1
DIM AS BYTE i, j, s, smax, n
DIM AS SHORT note (6), notemax = -32768
FOR i = 0 TO 6
smax = 0
note (i) = -32768
g0 = Courante
IF Ajoute (g0, Trait, i) THEN
IF Score (g0, Trait) > 3 THEN
RETURN i
ELSE
FOR j = 0 TO 6
g1 = g0
IF Ajoute (g1, -1 * Trait, j) THEN
s = Score (g1,-1 * Trait)
IF s > smax THEN smax = s
END IF
NEXT j
n = 0
FOR j = 0 TO 6
g1 = g0
IF Ajoute (g1, -1 * Trait, j) THEN
s = Score (g1, -1 * Trait)
IF s = smax THEN n += 1
END IF
NEXT j
note (i) = -1 * (100 * smax + 10 * n + 1 * Abs (i - 3))
END IF
END IF
IF note (i) > notemax THEN notemax = note (i)
NEXT i
FOR i = 0 TO 6
IF note (i) = notemax THEN RETURN i
NEXT i
END FUNCTION
' BEGINN DES HAUPTPROGRAMMS
Initialise
WHILE Trait <> Neant
Represente
IF Trait = Automate THEN
Ajoute (Courante, Trait, MeilleurCoup)
ELSE
Choix
END IF
Pions -= 1
IF (Score (Courante, Trait) > 3) OR (Pions = 0) THEN
Trait = 0
Represente
ELSE
Trait *= -1
END IF
WEND
PRINT "La partie est finie."
PRINT "Pressez une touche !"
SLEEP
' ENDE DES HAUPTPROGRAMMS