Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Ein einfaches Computergegner für ein "Vier gewinnt"

Uploader:MitgliedRoland 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