4Gewinnt - wer kann es schlagen ?
Übersicht

KrümelBetreff: 4Gewinnt - wer kann es schlagen ? |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Hallo Leute!
Hier ist mein neuestes Programm - 4Gewinnt ! ![]() 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
![]() |
BlitzcoderNewsposter |
![]() Antworten mit Zitat ![]() |
---|---|---|
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 ![]() |
||
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 |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
nanu? also abtzürzen tuts bei mir nicht - auch ohne flushmem... ![]() ich schreibe das program kurz um, dann poste ichs nochmal im BlitzBasic Forum. |
||
![]() |
Artemis |
![]() Antworten mit Zitat ![]() |
---|---|---|
@Krümel, welche BlitzMax-Version hast du?
FlushMem gibt es seit 1.18 oder 1.20 (Mein ich) nicht mehr. |
||
Krümel |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
... 1.18 ...1.20 - Ich arbeite noch immer mit v. 1.10 ![]() BlitzMax benutze ich eigentlich garnicht mehr, normalerweise programmiere ich alles mit Blitz3d. (4Gewinnt ist mittlerweile umgeschrieben und im BlitzBasic Forum / Codearchiv zu bewundern) |
||
Dreamora |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
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. |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group