Käsekästchen - Jetzt mit quasi-Editor
Übersicht

![]() |
SpionAtomBetreff: Käsekästchen - Jetzt mit quasi-Editor |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ich hab zuviel Zeit...
Code: [AUSKLAPPEN] ;Käsekästchen
; ;Das beliebte Schulklassenspiel für zwei Spieler. Abwechselnd setzen die beiden Spieler Linien auf das Feld. ;Schließt ein Spieler dadurch ein Kästchen, so bekommt er einen Punkt und ist nochmal dran mit setzen. ; ;Have Fun, SpionAtom - August 2006 ;Feld-Ausmaße können hier bestimmt werden Global feld_breite = 12, feld_hoehe = 8, Kaestchen_groesse = 60, feld_abx = 10, feld_aby = 10 Type Feld Field x, y Field o, u, l, r Field owner End Type Global F.Feld Graphics 800, 600, 0, 2 AppTitle("Käsekästchen") SetBuffer BackBuffer() HidePointer Global mouse_x, mouse_y Global istDran = 0 createFeld Dim punkte(2) Repeat mouse_x = MouseX() mouse_y = MouseY() m = 0 If MouseHit(1) Then m = 1 Cls drawFeld checkMouse m drawPoints drawMouse Flip(0) Until KeyDown(1) End Function createFeld() For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 F.Feld = New Feld F\x = feld_abx + x * kaestchen_groesse F\y = feld_aby + y * kaestchen_groesse F\owner = 0 If y > 0 Then F\o = 0 Else F\o = 1 If y < feld_hoehe - 1 Then F\u = 0 Else F\u = 1 If x > 0 Then F\l = 0 Else F\l = 1 If x < feld_breite - 1 Then F\r = 0 Else F\r = 1 Next Next End Function Function drawFeld() t = 2 For F.Feld = Each Feld Color 150, 150, 150 Rect F\x, F\y, kaestchen_groesse, kaestchen_groesse, 0 If f\owner = 0 Then Color 200, 200, 200 If f\owner = 1 Then Color 255, 200, 155 If f\owner = 2 Then Color 200, 255, 155 Rect F\x + 1, F\y + 1, kaestchen_groesse - 2, kaestchen_groesse - 2, 1 Color 55, 55, 255 If F\o = 1 Then Rect F\x + t, F\y - t, kaestchen_groesse - 2 * t, 2 * t, 1 If F\u = 1 Then Rect F\x + t, F\y + kaestchen_groesse - t, kaestchen_groesse - 2 * t, 2 * t, 1 If F\l = 1 Then Rect F\x - t, F\y + t, 2 * t, kaestchen_groesse - 2 * t, 1 If F\r = 1 Then Rect F\x + kaestchen_groesse - t, F\y + t, 2 * t, kaestchen_groesse - 2 * t, 1 Next anz = 0 For F.Feld = Each Feld Color 55, 55, 255 If F\o = 1 Then Rect F\x + t, F\y - t, kaestchen_groesse - 2 * t, 2 * t, 1 If F\u = 1 Then Rect F\x + t, F\y + kaestchen_groesse - t, kaestchen_groesse - 2 * t, 2 * t, 1 If F\l = 1 Then Rect F\x - t, F\y + t, 2 * t, kaestchen_groesse - 2 * t, 1 If F\r = 1 Then Rect F\x + kaestchen_groesse - t, F\y + t, 2 * t, kaestchen_groesse - 2 * t, 1 Next End Function Function drawPoints() Color 150, 150, 150 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 1 L1 = (feld_breite * kaestchen_groesse) * (Punkte(1) / Float(feld_breite * feld_hoehe)) L2 = (feld_breite * kaestchen_groesse) * (Punkte(2) / Float(feld_breite * feld_hoehe)) Color 255, 200, 155 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, L1, 30, 1 Color 200, 255, 155 Rect feld_abx + feld_breite * kaestchen_groesse - L2, feld_aby + feld_hoehe * kaestchen_groesse + 10, L2, 30, 1 Color 55, 55, 55 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 0 txt1$ = Str$(Punkte(1)): txt2$ = Str$(Punkte(2)) Text feld_abx + 10, feld_aby + feld_hoehe * kaestchen_groesse + 18, txt1$ Text feld_abx + feld_breite * kaestchen_groesse - 10 - StringWidth(txt2$), feld_aby + feld_hoehe * kaestchen_groesse + 18, txt2$ End Function Function checkMouse(m) t1 = 10 t2 = 4 spielerwechsel = 0 keinSpielerwechsel = 0 For F.Feld = Each Feld checkKaestchen = 0 If F\o = 0 Then If mouseInRect(F\x + t1, F\y - t1, kaestchen_groesse - 2 * t1, 2 * t1) Then Rect F\x + t2, F\y - t2, kaestchen_groesse - 2 * t2, 2 * t2, 0 If m = 1 Then F\o = m: checkKaestchen = m End If If F\u = 0 Then If mouseInRect(F\x + t1, F\y + kaestchen_groesse - t1, kaestchen_groesse - 2 * t1, 2 * t1) Then Rect F\x + t2, F\y + kaestchen_groesse - t2, kaestchen_groesse - 2 * t2, 2 * t2, 0 If m = 1 Then F\u = m:checkKaestchen = m End If If F\l = 0 Then If mouseInRect(F\x - t1, F\y + t1, 2 * t1, kaestchen_groesse - 2 * t1) Then Rect F\x - t2, F\y + t2, 2 * t2, kaestchen_groesse - 2 * t2, 0 If m = 1 Then F\l = m: checkKaestchen = m End If If F\r = 0 Then If mouseInRect(F\x + kaestchen_groesse - t1, F\y + t1, 2 * t1, kaestchen_groesse - 2 * t1) Then Rect F\x + kaestchen_groesse - t2, F\y + t2, 2 * t2, kaestchen_groesse - 2 * t2, 0 If m = 1 Then F\r = m: checkKaestchen = m End If If checkKaestchen = 1 Then If F\o + F\u + F\l + F\r = 4 Then F\owner = istDran + 1: punkte(istDran + 1) = punkte(istDran + 1) + 1 keinSpielerwechsel = 1 End If spielerwechsel = 1 End If Next If keinSpielerwechsel = 0 And spielerwechsel = 1 Then istDran = 1 - istDran End Function Function drawMouse() t1 = 10 t2 = 4 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Color 255, 255, 255 Rect mouse_x - t2, mouse_y - t1, 2 * t2, 2 * t1, 1 Rect mouse_x - t1, mouse_y - t2, 2 * t1, 2 * t2, 1 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Rect mouse_x - t2 + 1, mouse_y - t1 + 1, 2 * t2 - 2, 2 * t1 - 2, 1 Rect mouse_x - t1 + 1, mouse_y - t2 + 1, 2 * t1 - 2, 2 * t2 - 2, 1 End Function Function mouseInRect(x, y, w, h) If mouse_x <= x Then Return False If mouse_y <= y Then Return False If mouse_x >= x + w Then Return False If mouse_y >= y + h Then Return False Return True End Function |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
- Zuletzt bearbeitet von SpionAtom am Fr, Aug 25, 2006 16:21, insgesamt einmal bearbeitet
![]() |
StepTigerBetreff: Re: Käsekästchen |
![]() Antworten mit Zitat ![]() |
---|---|---|
SpionAtom hat Folgendes geschrieben: Ich hab zuviel Zeit...
definitiv ^^ aber ganz nett das Spiel ![]() |
||
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer: AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t Gewinner: BP Code Compo #2 Π=3.141592653589793238...<--- und das aus dem kopf ![]() Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser. |
![]() |
Hip Teen |
![]() Antworten mit Zitat ![]() |
---|---|---|
Wäre cool, wenn die Striche der Spieler eine unterschiedliche Farbe hätten und man mitbekommt, wer gerade dran ist. Sonst ganz nett. | ||
Spruch der Woche: "Ahh, ein neues Gesicht?!" - "Nein, das hab ich schon länger" |
![]() |
SpionAtom |
![]() Antworten mit Zitat ![]() |
---|---|---|
Hip Teen hat Folgendes geschrieben: Wäre cool, wenn die Striche der Spieler eine unterschiedliche Farbe hätten und man mitbekommt, wer gerade dran ist. Sonst ganz nett.
Das wollte ich ja mit der Maus bewirken. Hmm... vielleicht mach ich es noch etwas auffälliger ![]() |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
![]() |
StepTiger |
![]() Antworten mit Zitat ![]() |
---|---|---|
bekommt man doch mit
siehe kreuz *edit* Mist! Warst schneller |
||
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer: AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t Gewinner: BP Code Compo #2 Π=3.141592653589793238...<--- und das aus dem kopf ![]() Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser. |
![]() |
Hip Teen |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ah, ist mir ehrlich gesagt gar nicht aufgefallen. Nun, das müsste reichen, wenn man es denn weiß ![]() ![]() |
||
Spruch der Woche: "Ahh, ein neues Gesicht?!" - "Nein, das hab ich schon länger" |
![]() |
StepTiger |
![]() Antworten mit Zitat ![]() |
---|---|---|
eigentlich nicht
die striche sind ja egal, wer die gelegt hat, denn jeder kann sie benutzen. KI wär mal ne lustige Idee |
||
Noch gestern standen wir am Abgrund, doch heute sind wir schon einen Schritt weiter.
Computer: AMD Sempron 3000+; ATI Radeon 9800 Pro; 512 MB DDR RAM 400Mhz; Asus E7N8X-E Deluxe; Samsung 200GB HD 5.4ns acces t Gewinner: BP Code Compo #2 Π=3.141592653589793238...<--- und das aus dem kopf ![]() Seit der Earthlings-Diskussion überzeugter Fleisch(fr)esser. |
![]() |
Christoph |
![]() Antworten mit Zitat ![]() |
---|---|---|
Zitat: KI wär mal ne lustige Idee
![]() ![]() |
||
![]() |
SpionAtom |
![]() Antworten mit Zitat ![]() |
---|---|---|
Hip Teen hat Folgendes geschrieben: Ah, ist mir ehrlich gesagt gar nicht aufgefallen. Nun, das müsste reichen, wenn man es denn weiß
![]() ![]() Christoph hat Folgendes geschrieben: Zitat:
KI wär mal ne lustige Idee
![]() ![]() Haut rein, ist Open Source!! |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
![]() |
5k41 |
![]() Antworten mit Zitat ![]() |
---|---|---|
schon sehr gut, aber es fehlen noch levels! Ich mein die Karte muss ja nicht vier eckig sein, sondern kann auch ne beule haben etc. so spielen wir das immer... macht es noch ein bisschen interessanter!
MfG |
||
Projekte:
For a better World - Gesellschaftsspiel ( 100%) User posted image |
![]() |
Cardonic |
![]() Antworten mit Zitat ![]() |
---|---|---|
Das Spiel ist echt gut gelungen; ein Lob an dich, SpionAtom. Bin leider im Moment alleine ![]() Man könnte vielleicht noch am Anfang ein paar zufällige Striche erstellen, oder durch Striche vordefinierte Levels machen. mfg Cardonic |
||
If you should go skating on the thin ice of modern life, dragging behind you the silent reproach of a million tear-stained eyes, don't be surprised when a crack in the ice appears under your feet. |
BIG BUG |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
Ui, so was wollte ich auch unbedingt mal machen. Müsste dann aber natürlich KI und Internetunterstützung haben...
Hatte damals mal einen Klassenkameraden so geplättet, dass er mitten im Unterricht laut "Scheisse" rief, als sein vermeintlich erster Sieg gegen mich dahin war... ![]() |
||
B3D-Exporter für Cinema4D!(V1.4)
MD2-Exporter für Cinema4D!(final) |
![]() |
Schranz0r |
![]() Antworten mit Zitat ![]() |
---|---|---|
Joop nice work!!!
Coole Sache das Game, errinnert mich auch an meine Schulzeit..... Ist ja auch schon wieder 7 Jahre her ![]() |
||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!HAUPTSACH et kost VIEL!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
![]() |
Mr.Keks |
![]() Antworten mit Zitat ![]() |
---|---|---|
grml, wollte gerade mal nachschaun, ob ich ne ki einbaun kann (die logik ist ja halbwegs simpel ^^), aber leider ist die info ziemlich doof für ne ki strukturiert. (ob ein strich besteht, steht in zwei verschiedenen, unverlinkten types und so ..) da ich keine lust hatte, alles umzustrukturieren ("da schreib ich doch lieber gleich von grund auf neu!"), wird's jetzt wohl erstmal von meiner seite nichts mit einer ki.
es gibt zwei lösungsansätze. 1. die rekursive schachki: man gehe jeden strich durch und simuliere, dass er gesetzt werde. danach nehme man jeden anderen möglichen gesetzten strich an und vielleicht noch ein paar rekursionsebenen weiter. aber ich denke, bei so einem simplen game reich es, wenn man zwei oder drei züge im voraus berechnet. 2. die menschenähnliche ki: wenn man irgendwo einen punkt holen kann, holt man ihn. wenn es keinen punkt zu holen gibt, sucht man mit einer simplen schleife einen strich, durch den man dem gegner keinen punkt ermöglicht. gibt es keinen solchen strich, muss man den suchen, der die wenigsten punkte ermöglicht, wobei letzteres wohl der komplizierteste teilalgo ist. es sind aber sehr simple schleifen und ifs. eigentlich sollte das kein problem sein, wenn die daten etwas schlauer organisiert wären. |
||
MrKeks.net |
BIG BUG |
![]() Antworten mit Zitat ![]() |
|
---|---|---|
@Inarie
für eine gute KI ist das gar nicht so einfach, denn je nachdem wie lang diverse Gänge gebaut sind, ist es oft sinnvoller kleinere Kästchengruppen abzugeben und erst bei den ganz dicken Brocken zuzuschlagen. Natürlich darf man wiederum nicht zuviel abgeben, sonst reicht der dicke Schlußbrocken eventuell gar nicht aus... 2 bis 3 Züge im Vorraus ist für ein gutes Spielniveau zu wenig, andererseits sollte die KI natürlich auch nicht unschlagbar sein... Merke: geschlossene Gänge ab 4 Kästchen lassen sich "abwehren", offene Gänge bereits ab 2 Kästchen. Hui, vielleicht muss ich mich jetzt doch auch mal an sowas setzen(maybe in 3d?)... |
||
B3D-Exporter für Cinema4D!(V1.4)
MD2-Exporter für Cinema4D!(final) |
![]() |
SpionAtom |
![]() Antworten mit Zitat ![]() |
---|---|---|
An KI hatte ich auch schon gedacht. Genau genommen an die 2. Methode von Inarie. Aber so ein richtiger Algorithmus, der immer den optimalen Strich liefert, müsste es imho eigentlich schon geben...
EDIT: Und hier die neue Version!!! Mit Vorbereitungsphase, um sein eigenes Feld zu bauen. Und auf einem Array basierend, damits leichter ist, KI dort einzubauen (ist aber noch keine drin) Und Fehler bitte melden (hab aber noch keine gefunden). Code: [AUSKLAPPEN] ;Käsekästchen
; ;Das beliebte Schulklassenspiel für zwei Spieler. Abwechselnd setzen die beiden Spieler Linien auf das Feld. ;Schließt ein Spieler dadurch ein Kästchen, so bekommt er einen Punkt und ist nochmal dran mit setzen. ; ;Have Fun, SpionAtom - August 2006 ;Feld-Ausmaße können hier bestimmt werden Global feld_breite = 12, feld_hoehe = 8, Kaestchen_groesse = 60, feld_abx = 10, feld_aby = 50 Dim feld(feld_breite, feld_hoehe, 2) ; +--(0)-Wagerechten ; +--(1)-Senkrechten ; +--(2)-Wert Graphics 800, 600, 0, 2 AppTitle("Käsekästchen") SetBuffer BackBuffer() HidePointer Global mouse_x, mouse_y Global phase = 1 Global neutralPoints = 0 Global istDran = 0 Dim punkte(2) Repeat mouse_x = MouseX() mouse_y = MouseY() m = 0 If MouseHit(1) Then m = 1 If MouseHit(2) And phase = 1 Then createFeld phase = 2 End If Cls drawInfoText drawFeld checkMouse m If phase = 2 Then drawPoints drawMouse Color 255, 255, 255 Text 750,0,b Flip(0) Until KeyDown(1) End Function createFeld() For x = 0 To feld_breite For y = 0 To feld_hoehe If (x = 0 Or x = feld_breite) And (y < feld_hoehe) Then feld(x,y,1) = 1 If (y = 0 Or y = feld_hoehe) And (x < feld_breite) Then feld(x,y,0) = 1 If feld(x,y,2) = 3 Then feld(x,y,0) = 1 feld(x,y,1) = 1 feld(x,y+1,0) = 1 feld(x+1,y,1) = 1 End If Next Next For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 If y > 0 Then checkPoint(x,y,0) If x > 0 checkPoint(x,y,1) Next Next neutralPoints = 0 For x = 0 To feld_breite For y = 0 To feld_hoehe If feld(x,y,2) = 3 Then neutralPoints = neutralPoints + 1 Next Next End Function Function checkMouse(m) If phase = 1 Then fx = (mouse_x - feld_abx) / kaestchen_groesse fy = (mouse_y - feld_aby) / kaestchen_groesse Text 750, 20, fx + "," + fy If m = 1 Then If feld(fx,fy,2) = 0 Then feld(fx,fy,2) = 3 Else feld(fx,fy,2) = 0 End If If phase = 2 Then t1 = 10 ;Mouseover-dicke t2 = 4 ;Mouseoverzeichen-dicke setLine = False For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 px = feld_abx + x * kaestchen_groesse py = feld_aby + y * kaestchen_groesse Color 55, 55, 255 If feld(x,y,0) = 0 And mouseInRect(px + t1, py - t1, kaestchen_groesse - 2 * t1, 2 * t1) Then Rect px + t2, py - t2, kaestchen_groesse - 2 * t2, 2 * t2, 0 If m = 1 Then setLine = True feld(x,y,0) = 1 gotPoint = checkPoint(x,y,0) End If End If If feld(x,y,1) = 0 And mouseInRect(px - t1, py + t1, 2 * t1, kaestchen_groesse - 2 * t1) Then Rect px - t2, py + t2, 2 * t2, kaestchen_groesse - 2 * t2, 0 If m = 1 Then setLine = True feld(x,y,1) = 1 gotPoint = checkPoint(x,y,1) End If End If Next Next If setLine And (Not gotPoint) Then istDran = 1 - istDran End If End If End Function Function checkPoint(x, y, s) gp = False If s = 0 Then If feld(x,y,0) + feld(x,y-1,0) + feld(x,y-1,1) + feld(x+1,y-1,1) = 4 Then gp = True If phase = 1 Then feld(x,y-1,2) = 3 Else feld(x,y-1,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 End If End If If feld(x,y,0) + feld(x,y,1) + feld(x,y+1,0) + feld(x+1,y,1) = 4 Then gp = True If phase = 1 Then feld (x,y,2) = 3 Else feld (x,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 End If End If End If If s = 1 Then If feld(x,y,1) + feld(x-1,y,0) + feld(x-1,y,1) + feld(x-1,y+1,0) = 4 Then gp = True If phase = 1 Then feld(x-1,y,2) = 3 Else feld(x-1,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 End If End If If feld(x,y,1) + feld(x,y,0) + feld(x,y+1,0) + feld(x+1,y,1) = 4 Then gp = True If phase = 1 Then feld(x,y,2) = 3 Else feld(x,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 End If End If End If Return gp End Function Function drawFeld() t = 2 ;Liniendicke For x = 0 To feld_breite For y = 0 To feld_hoehe px = feld_abx + x * kaestchen_groesse py = feld_aby + y * kaestchen_groesse ;Felder einfärben Color 150, 150, 150 If x < feld_breite And y < feld_hoehe Then Rect px, py, kaestchen_groesse, kaestchen_groesse, 1 If feld(x,y,2) = 0 Then Color 200, 200, 200 If feld(x,y,2) = 1 Then Color 255, 200, 155 If feld(x,y,2) = 2 Then Color 200, 255, 155 If feld(x,y,2) = 3 Then Color 55, 55, 55 If x < feld_breite And y < feld_hoehe Then Rect px + 1, py + 1, kaestchen_groesse - 2, kaestchen_groesse - 2, 1 ;Linien einzeichnen If phase = 2 Then Color 55, 55, 255 If feld(x,y,0) = 1 Then Rect px + t, py - t, kaestchen_groesse - 2 * t, 2 * t, 1 If feld(x,y,1) = 1 Then Rect px - t, py + t, 2 * t, kaestchen_groesse - 2 * t, 1 End If Next Next End Function Function drawMouse() t1 = 10 t2 = 4 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Color 255, 255, 255 Rect mouse_x - t2, mouse_y - t1, 2 * t2, 2 * t1, 1 Rect mouse_x - t1, mouse_y - t2, 2 * t1, 2 * t2, 1 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Rect mouse_x - t2 + 1, mouse_y - t1 + 1, 2 * t2 - 2, 2 * t1 - 2, 1 Rect mouse_x - t1 + 1, mouse_y - t2 + 1, 2 * t1 - 2, 2 * t2 - 2, 1 End Function Function drawPoints() Color 150, 150, 150 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 1 L1 = (feld_breite * kaestchen_groesse) * (Punkte(1) / Float((feld_breite * feld_hoehe) - neutralPoints)) L2 = (feld_breite * kaestchen_groesse) * (Punkte(2) / Float((feld_breite * feld_hoehe) - neutralPoints)) Color 255, 200, 155 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, L1, 30, 1 Color 200, 255, 155 Rect feld_abx + feld_breite * kaestchen_groesse - L2, feld_aby + feld_hoehe * kaestchen_groesse + 10, L2, 30, 1 Color 55, 55, 55 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 0 txt1$ = Str$(Punkte(1)): txt2$ = Str$(Punkte(2)) Text feld_abx + 10, feld_aby + feld_hoehe * kaestchen_groesse + 18, txt1$ Text feld_abx + feld_breite * kaestchen_groesse - 10 - StringWidth(txt2$), feld_aby + feld_hoehe * kaestchen_groesse + 18, txt2$ End Function Function drawInfoText() If phase = 1 Then Center 5, "Feld kreieren": Center 20, "Linksklick um Block zu setzen, Rechtsklick um anzufangen" If phase = 2 Then Center 5, "Spiel": Center 20, "Linksklick um Strich zu setzen" End Function Function Center(y, t$) Text (800 - StringWidth(t$)) / 2, y, t$ End Function Function mouseInRect(x, y, w, h) If mouse_x <= x Then Return False If mouse_y <= y Then Return False If mouse_x >= x + w Then Return False If mouse_y >= y + h Then Return False Return True End Function |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
![]() |
FireballFlame |
![]() Antworten mit Zitat ![]() |
---|---|---|
Ich hab nen Fehler (EDIT:)gefunden.
Einfach ein paar Kästchen schwarz gemacht und rechtsgeklickt. ==> "Array index out of bounds". Hab aber jetzt keine Zeit, mir den Code anzuschaun... |
||
PC: Intel Core i7 @ 4x2.93GHz | 6 GB RAM | Nvidia GeForce GT 440 | Desktop 2x1280x1024px | Windows 7 Professional 64bit
Laptop: Intel Core i7 @ 4x2.00GHz | 8 GB RAM | Nvidia GeForce GT 540M | Desktop 1366x768px | Windows 7 Home Premium 64bit |
![]() |
Silver_Knee |
![]() Antworten mit Zitat ![]() |
---|---|---|
So ich habe eine erste form von ki!!! einfach, nutzt nur chansen die man ihr schenkt gibt selbst welche ohne nachzudenken. hab trotzdem beim ersten spiel gegen sie verloren^^ Der Code: [AUSKLAPPEN] ;Käsekästchen
Die ki springt für den 2. spieler automatisch ein.
; ;Das beliebte Schulklassenspiel für zwei Spieler. Abwechselnd setzen die beiden Spieler Linien auf das Feld. ;Schließt ein Spieler dadurch ein Kästchen, so bekommt er einen Punkt und ist nochmal dran mit setzen. ; ;Have Fun, SpionAtom - August 2006 ;Feld-Ausmaße können hier bestimmt werden Global feld_breite = 12, feld_hoehe = 8, Kaestchen_groesse = 60, feld_abx = 10, feld_aby = 50 Graphics 800, 600, 0, 2 AppTitle("Käsekästchen") SetBuffer BackBuffer() HidePointer .start Global mouse_x, mouse_y Global phase = 1 Global neutralPoints = 0 Global istDran = 0 Dim feld(feld_breite, feld_hoehe, 2) ; +--(0)-Wagerechten ; +--(1)-Senkrechten ; +--(2)-Wert Dim punkte(2) Dim bed(4) Repeat mouse_x = MouseX() mouse_y = MouseY() ki m = 0 If MouseHit(1) Then m = 1 If MouseHit(2) And phase = 1 Then createFeld phase = 2 EndIf Cls drawInfoText drawFeld checkMouse m If phase = 2 Then drawPoints drawMouse Color 255, 255, 255 Text 750,0,b Flip If punkte(1)+punkte(2)=feld_breite*feld_hoehe Then Goto start Until KeyDown(1) End Function ki() If istDran=1 Repeat setx=Rand(0,feld_breite - 1) sety=Rand(0,feld_hoehe - 1) setmode=Rand(0,1) If setx=0 setmode=0 If sety=0 setmode=1 Until feld(setx,sety,setmode)=0 And (Not (setx=0 And sety=0)) For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 For mode = 0 To 1 bed(1)=feld(x,y,0) bed(2)=feld(x,y,1) bed(3)=feld(x+1,y,1) bed(4)=feld(x,y+1,0) xcount=0 For count= 1 To 4 If bed(count)=0 xcount=xcount+1 EndIf Next If xcount=1 For count= 1 To 4 If bed(count)=0 Select count Case 1 setx=x sety=y setmode=0 Case 2 setx=x sety=y setmode=1 Case 3 setx=x+1 sety=y setmode=1 Case 4 setx=x sety=y+1 setmode=0 End Select EndIf Next EndIf Next Next Next feld(setx,sety,setmode) = 1 gotPoint = checkPoint(setx,sety,setmode) If gotPoint=0 istDran=0 EndIf EndIf End Function Function createFeld() For x = 0 To feld_breite For y = 0 To feld_hoehe If (x = 0 Or x = feld_breite) And (y < feld_hoehe) Then feld(x,y,1) = 1 If (y = 0 Or y = feld_hoehe) And (x < feld_breite) Then feld(x,y,0) = 1 If feld(x,y,2) = 3 Then feld(x,y,0) = 1 feld(x,y,1) = 1 feld(x,y+1,0) = 1 feld(x+1,y,1) = 1 EndIf Next Next For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 If y > 0 Then checkPoint(x,y,0) If x > 0 checkPoint(x,y,1) Next Next neutralPoints = 0 For x = 0 To feld_breite For y = 0 To feld_hoehe If feld(x,y,2) = 3 Then neutralPoints = neutralPoints + 1 Next Next End Function Function checkMouse(m) If phase = 1 Then fx = (mouse_x - feld_abx) / kaestchen_groesse fy = (mouse_y - feld_aby) / kaestchen_groesse Text 750, 20, fx + "," + fy If m = 1 Then If feld(fx,fy,2) = 0 Then feld(fx,fy,2) = 3 Else feld(fx,fy,2) = 0 EndIf If phase = 2 Then t1 = 10 ;Mouseover-dicke t2 = 4 ;Mouseoverzeichen-dicke setLine = False For x = 0 To feld_breite - 1 For y = 0 To feld_hoehe - 1 px = feld_abx + x * kaestchen_groesse py = feld_aby + y * kaestchen_groesse Color 55, 55, 255 If feld(x,y,0) = 0 And mouseInRect(px + t1, py - t1, kaestchen_groesse - 2 * t1, 2 * t1) Then Rect px + t2, py - t2, kaestchen_groesse - 2 * t2, 2 * t2, 0 If m = 1 Then setLine = True feld(x,y,0) = 1 gotPoint = checkPoint(x,y,0) EndIf EndIf If feld(x,y,1) = 0 And mouseInRect(px - t1, py + t1, 2 * t1, kaestchen_groesse - 2 * t1) Then Rect px - t2, py + t2, 2 * t2, kaestchen_groesse - 2 * t2, 0 If m = 1 Then setLine = True feld(x,y,1) = 1 gotPoint = checkPoint(x,y,1) EndIf EndIf Next Next If setLine And (Not gotPoint) Then istDran = 1 - istDran EndIf EndIf End Function Function checkPoint(x, y, s) gp = False If s = 0 Then If feld(x,y,0) + feld(x,y-1,0) + feld(x,y-1,1) + feld(x+1,y-1,1) = 4 Then gp = True If phase = 1 Then feld(x,y-1,2) = 3 Else feld(x,y-1,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 EndIf EndIf If feld(x,y,0) + feld(x,y,1) + feld(x,y+1,0) + feld(x+1,y,1) = 4 Then gp = True If phase = 1 Then feld (x,y,2) = 3 Else feld (x,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 EndIf EndIf EndIf If s = 1 Then If feld(x,y,1) + feld(x-1,y,0) + feld(x-1,y,1) + feld(x-1,y+1,0) = 4 Then gp = True If phase = 1 Then feld(x-1,y,2) = 3 Else feld(x-1,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 EndIf EndIf If feld(x,y,1) + feld(x,y,0) + feld(x,y+1,0) + feld(x+1,y,1) = 4 Then gp = True If phase = 1 Then feld(x,y,2) = 3 Else feld(x,y,2) = istDran + 1 Punkte(istDran + 1) = Punkte(istDran + 1) + 1 EndIf EndIf EndIf Return gp End Function Function drawFeld() t = 2 ;Liniendicke For x = 0 To feld_breite For y = 0 To feld_hoehe px = feld_abx + x * kaestchen_groesse py = feld_aby + y * kaestchen_groesse ;Felder einfärben Color 150, 150, 150 If x < feld_breite And y < feld_hoehe Then Rect px, py, kaestchen_groesse, kaestchen_groesse, 1 If feld(x,y,2) = 0 Then Color 200, 200, 200 If feld(x,y,2) = 1 Then Color 255, 200, 155 If feld(x,y,2) = 2 Then Color 200, 255, 155 If feld(x,y,2) = 3 Then Color 55, 55, 55 If x < feld_breite And y < feld_hoehe Then Rect px + 1, py + 1, kaestchen_groesse - 2, kaestchen_groesse - 2, 1 ;Linien einzeichnen If phase = 2 Then Color 55, 55, 255 If feld(x,y,0) = 1 Then Rect px + t, py - t, kaestchen_groesse - 2 * t, 2 * t, 1 If feld(x,y,1) = 1 Then Rect px - t, py + t, 2 * t, kaestchen_groesse - 2 * t, 1 EndIf Next Next End Function Function drawMouse() t1 = 10 t2 = 4 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Color 255, 255, 255 Rect mouse_x - t2, mouse_y - t1, 2 * t2, 2 * t1, 1 Rect mouse_x - t1, mouse_y - t2, 2 * t1, 2 * t2, 1 If (istDran + 1) = 1 Then Color 255, 200, 155 If (istDran + 1) = 2 Then Color 200, 255, 155 Rect mouse_x - t2 + 1, mouse_y - t1 + 1, 2 * t2 - 2, 2 * t1 - 2, 1 Rect mouse_x - t1 + 1, mouse_y - t2 + 1, 2 * t1 - 2, 2 * t2 - 2, 1 End Function Function drawPoints() Color 150, 150, 150 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 1 L1 = (feld_breite * kaestchen_groesse) * (Punkte(1) / Float((feld_breite * feld_hoehe) - neutralPoints)) L2 = (feld_breite * kaestchen_groesse) * (Punkte(2) / Float((feld_breite * feld_hoehe) - neutralPoints)) Color 255, 200, 155 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, L1, 30, 1 Color 200, 255, 155 Rect feld_abx + feld_breite * kaestchen_groesse - L2, feld_aby + feld_hoehe * kaestchen_groesse + 10, L2, 30, 1 Color 55, 55, 55 Rect feld_abx, feld_aby + feld_hoehe * kaestchen_groesse + 10, feld_breite * kaestchen_groesse, 30, 0 txt1$ = Str$(Punkte(1)): txt2$ = Str$(Punkte(2)) Text feld_abx + 10, feld_aby + feld_hoehe * kaestchen_groesse + 18, txt1$ Text feld_abx + feld_breite * kaestchen_groesse - 10 - StringWidth(txt2$), feld_aby + feld_hoehe * kaestchen_groesse + 18, txt2$ End Function Function drawInfoText() If phase = 1 Then Center 5, "Feld kreieren": Center 20, "Linksklick um Block zu setzen, Rechtsklick um anzufangen" If phase = 2 Then Center 5, "Spiel": Center 20, "Linksklick um Strich zu setzen" End Function Function Center(y, t$) Text (800 - StringWidth(t$)) / 2, y, t$ End Function Function mouseInRect(x, y, w, h) If mouse_x <= x Then Return False If mouse_y <= y Then Return False If mouse_x >= x + w Then Return False If mouse_y >= y + h Then Return False Return True End Function |
||
![]() |
SpionAtom |
![]() Antworten mit Zitat ![]() |
---|---|---|
@FireballFlame: Gib mir bitte mal eine genaue Anleitung darüber, wie der Fehler zustande kam.
@FTC: Noch etwas unbeholfen, aber vielleicht wirds noch was. Es wäre gut, wenn beim KI-Zug irgendein Signal am Bildschirm erscheint, denn sonst ist es nicht immer leicht zu sehen, wo hingesetzt wurde. Vielleicht setzt du einfach ein Blinken an die Stelle.... |
||
os: Windows 10 Home cpu: Intel Core i7 6700K 4.00Ghz gpu: NVIDIA GeForce GTX 1080 |
![]() |
FireballFlame |
![]() Antworten mit Zitat ![]() |
---|---|---|
Keine Ahnung... einfach zufällig eine ausreichende Menge Kästchen schwärzen und dann Rechtsklick.
Dann passiert das: http://img234.imageshack.us/im...lermc3.png |
||
PC: Intel Core i7 @ 4x2.93GHz | 6 GB RAM | Nvidia GeForce GT 440 | Desktop 2x1280x1024px | Windows 7 Professional 64bit
Laptop: Intel Core i7 @ 4x2.00GHz | 8 GB RAM | Nvidia GeForce GT 540M | Desktop 1366x768px | Windows 7 Home Premium 64bit |
Übersicht


Powered by phpBB © 2001 - 2006, phpBB Group