4Gewinnt - wer kann es schlagen ?

Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Neue Antwort erstellen

 

Krümel

Betreff: 4Gewinnt - wer kann es schlagen ?

BeitragMo, Sep 18, 2006 20:12
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo Leute!

Hier ist mein neuestes Programm - 4Gewinnt ! Very Happy
Mein Ziel war es, das Programm möglichst kurz zu halten und
natürlich ein passabel spielenden Gegner zu kreieren.
Das ist mir meiner Meinung nach gut gelungen,
obwohl das Programm keinesfalls Perfekt spielt.

Probiert es mal aus und sagt mir ob ihr das Programm schlagen
könnt. (Für einen halbwegs guten Spieler sollte das kein Problem darstellen).

Code: [AUSKLAPPEN]

Global PCStrength=2000                          'Anzahl der Testspiele für PC
Global WinCount=4                               'Länge der Gewinnreihe
Global BoardWidth=7                             'Felder Horizontal         
Global BoardHeight=6                            'Felder Vertikal   
Global Size=50                                  'Größe der Felder
Global CurrentPlayer
Global TEST=False
Global LastX,LastY                              'zuletzt gespieltes Feld
Global Board[BoardWidth,BoardHeight, 2]         'das Spielfeld

Graphics BoardWidth*Size,(BoardHeight+1)*Size,0
SeedRnd MilliSecs()

Global ListLine:TList=CreateList()              'Speichern der letzten Gewinnreihe
Type line
   Field x,y
End Type

Function newGame()
   CurrentPlayer=Rand(1,2)                     'Spieler "auswürfeln"
   LastX=-1 ; LastY=-1
   For yy=0 To BoardHeight-1
   For xx=0 To BoardWidth-1
      Board(xx,yy,0)=0                        'Steine vom Spielfeld löschen         
   Next
   Next
   ListLine.clear()
   FlushKeys()
   Cls ; Draw() ; Flip
End Function

Function GameOver(Message$)
   SetColor 255,255,255
   DrawText Message,10,10

   Draw()
   SetColor 0,0,0                              'Gewinnreihe anzeigen
   For l:line=EachIn ListLine
      DrawOval l.x*Size+15,l.y*Size+Size+15,Size-30,Size-30
      Board(l.x,l.y, 0)=0
   Next
   SetColor 0,0,255 ; DrawOval LastX*Size+15,LastY*Size+Size+15,Size-30,Size-30   
   Flip
   FlushKeys() ; WaitKey() ; If KeyHit(KEY_ESCAPE) End
   newGame()
End Function

Function SetStone(x)
   full=True                                   'Spielfeld voll?
   For xx=0 To BoardWidth-1
      If Board(xx,0,TEST)=0 full=False ; Exit
   Next
   If full=True
      If TEST=0 GameOver("UNENTSCHIEDEN")   Else Return -2
   EndIf   

   For y=0 To BoardHeight-1                    'Reihe voll?
      If Board(x,y,TEST)<>0 Exit
   Next
   If y=0 Return -1

   Board(x,y-1,TEST)=CurrentPlayer             'Stein setzen
   Result=checkwin(x,y-1)                      'Steine zählen
   LastX=x ; LastY=y-1
   
   If TEST=False
      If Result>=WinCount                       'Gewonnen?
         If CurrentPlayer=1 GameOver("ROT gewinnt") Else GameOver("GELB gewinnt")
      EndIf
   EndIf

   'Spieler tauschen
   If CurrentPlayer=1 CurrentPlayer=2 Else CurrentPlayer=1

   Return Result
End Function

Function checkWin(x,y)                          'Funktion zum zählen der zusammenhängenden Steine
   'suche links-rechts:
   ListLine.clear() ; c=CountStones(x,y, -1, 0)+CountStones(x,y, 1, 0)-1 ; If c>=WinCount Return c
   'suche oben-unten:
   ListLine.clear() ; c=CountStones(x,y,  0,-1)+CountStones(x,y, 0, 1)-1 ; If c>=WinCount Return c
   'suche diagonal:
   ListLine.clear() ; c=CountStones(x,y, -1,-1)+CountStones(x,y, 1, 1)-1 ; If c>=WinCount Return c
   ListLine.clear() ; c=CountStones(x,y, -1, 1)+CountStones(x,y, 1,-1)-1 ; If c>=WinCount Return c
End Function
Function CountStones(x,y, dirX,dirY)
   Repeat
      Count:+1
      If TEST=0 l:Line=New Line ; l.x=x ; l.y=y ; ListAddLast ListLine,l
      x:+dirX ; y:+dirY
      If x<0 Or x>BoardWidth-1 Or y<0 Or y>BoardHeight-1 Exit
      If Board(x,y, TEST)<>CurrentPlayer Exit
   Forever
   Return Count
End Function

Function CalculateMove(Computer)
   TEST=True                                   'Testmodus anschalten

   For x=0 To BoardWidth-1                     'der PC testet nacheinander alle Reihen durch
      wMax=0
      For t=1 To PCstrength                   'Testspiele starten
         For yy=0 To BoardHeight-1           'Spielfeld in Ausgangslage bringen
         For xx=0 To BoardWidth-1
            Board(xx,yy, TEST)=Board(xx,yy,0)   
         Next
         Next

         CurrentPlayer=Computer
         xx=x
         Repeat                              'Zufällig Steine setzen bis Spiel
            Result=SetStone(xx)             'gewonnen oder Spielfeld voll ist   
            xx=Rand(0,BoardWidth-1)
         Until (Result>=WinCount) Or (Result=-2)   

         If (CurrentPlayer<>Computer) And (Result>=WinCount) wMax:+1 'PC gewinnt - wMax um 1 erhoehen
      Next
      If wMax>WinMax WinMax=wMax ; MaxX=x     'hoechste Anzahl gewonnener Spiele (WinMax) + dazugehoerige Reihe (MaxX) merken
   Next

   TEST=False                                  'Testmodus ausschalten

   CurrentPlayer=Computer                      'Stein an Position mit
   Result=setStone(MaxX)                       'maximaler Gewinnchance setzen
   
   If Result=-1                                'Die gewählte Reihe ist voll
      For x=0 To BoardWidth-1                 'suche nach freiem Feld               
         If Board(x,0, TEST)=0 SetStone(x) ; Exit
      Next
   EndIf   
End Function

Function draw()
   SetColor 0,0,255                            'Spielfeld zeichnen   
   DrawRect 0,size,BoardWidth*Size,BoardHeight*Size

   For y=0 To BoardHeight-1
   For x=0 To BoardWidth-1
      If Board(x,y, 0)=1 SetColor 255,0,0 Else If Board(x,y, 0)=2 SetColor 255,255,0 Else SetColor 0,0,0
      xx=x*Size ; yy=y*Size
      DrawOval xx+4,yy+4+Size,Size-8,Size-8   'Steine zeichen
   Next
   Next
   SetColor 0,0,255                            'zuletzt gespielten Stein markieren
   DrawOval LastX*Size+15,LastY*Size+Size+15,Size-30,Size-30
End Function

newGame()

While Not KeyHit(KEY_ESCAPE)
   If CurrentPlayer=1
      If MouseHit(1) Or KeyHit(KEY_SPACE) SetStone(Int(MouseX()/size))
   Else
      CalculateMove(2)
      FlushKeys()
   EndIf   

   draw ; Flip

Wend

  • Zuletzt bearbeitet von Krümel am Mo, Sep 18, 2006 23:52, insgesamt einmal bearbeitet

Blitzcoder

Newsposter

BeitragMo, Sep 18, 2006 20:28
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab 0 Ahnung von Bmax, wollte es aber mal mit der Demo testen. Er findet das Flushmem() nicht. Und syncronize modules geht in der demo nicht, wenn man das braucht.

MfG Blitzcoder

EDIT: Ah, wenn man das Flushmem() auskommentiert gehts. Ich hab kein einziges Spiel fertigbekommen, nach einigen Stein stürzt er ab Sad
P4 3 Ghz@3,55Ghz|GF 6600GT 256MB|Samsung 80GB | 2x Samsung 160GB|2048MB DDR-400 RAM|6 Mbit Flatrate | Logitech G15 | Samsung 225BW-TFT | Ubuntu Gutsy Linux | Windows Vista | Desktop | Blog | CollIDE | Worklog
________________
|°°°°°°°°°°°°°°||'""|""\__,_
|______________ ||__ |__|__ |)
|(@) |(@)"""**|(@)(@)****|(@)
 

Krümel

BeitragMo, Sep 18, 2006 20:36
Antworten mit Zitat
Benutzer-Profile anzeigen
nanu? also abtzürzen tuts bei mir nicht - auch ohne flushmem... Sad
ich schreibe das program kurz um, dann poste ichs nochmal im BlitzBasic Forum.

Artemis

BeitragMo, Sep 18, 2006 20:50
Antworten mit Zitat
Benutzer-Profile anzeigen
@Krümel, welche BlitzMax-Version hast du?

FlushMem gibt es seit 1.18 oder 1.20 (Mein ich) nicht mehr.
 

Krümel

BeitragMo, Sep 18, 2006 21:09
Antworten mit Zitat
Benutzer-Profile anzeigen
... 1.18 ...1.20 - Ich arbeite noch immer mit v. 1.10 Laughing

BlitzMax benutze ich eigentlich garnicht mehr, normalerweise programmiere ich alles mit Blitz3d.
(4Gewinnt ist mittlerweile umgeschrieben und im BlitzBasic Forum / Codearchiv
zu bewundern)
 

Dreamora

BeitragMo, Sep 18, 2006 23:06
Antworten mit Zitat
Benutzer-Profile anzeigen
Dann passe den Code bitte der aktuellen Version an, so das er da lauffähig ist.
Da es ein neuer Codeeintrag ist, dürfen User denke ich erwarten, das er auch mit der aktuellen Version (1.22) funktioniert, die viele Verbesserungen, auch im Performancebereich, erfahren hat.
Ihr findet die aktuellen Projekte unter Gayasoft und könnt mich unter @gayasoft auf Twitter erreichen.

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Codearchiv & Module

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group