Alle angrenzenden Felder herrausfinden

Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Neue Antwort erstellen

mas93

Betreff: Alle angrenzenden Felder herrausfinden

 BeitragDo, Sep 25, 2008 20:11
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi Leute ich habe ein kleines Problem.
Ich hab ein Programm geschrieben indem es ein 10x10 große Array-Map gibt.
Diesem werden per zufall werte von 0 bis 2 zugewiesen.

Jetzt will ich, dass wenn ich mit der maus über ein feld fahre, alle anliegenden Felder mit dem gleichen Wert hervorgehoben werden...

Ich habe mir dazu auch 2 Funktionen geschrieben, jedoch hängt sich das Programm auf, sobald ich das erste Feld markiert habe...

hier mal die beiden Funktionen:

Code: [AUSKLAPPEN]
Function vorschau()
   For b:ball = EachIn BallList
      If rectsoverlap(MouseX(), MouseY(), 1, 1, b.x * 30, b.y * 30, 30, 30) Then
         
         If tx <> b.x Or ty <> b.y Then
            ClearList(CheckList)
            over = 0
         EndIf
         
         If over = 0 Then
            createcheck(b.x, b.y, b.art)
            over = 1
            tx = b.x
            ty = b.y
         End If
      EndIf
   Next
End Function

Function checkall()
   For c:check = EachIn CheckList
      If c.status = 0 Then
         'alle Richtungen checken
         
      
         
         'OBEN
         If c.y - 1 >= 0 Then
         If map[c.x, c.y - 1] = c.art Then
            For n:check = EachIn CheckList
            
               If n.x <> c.x Or n.y <> c.y - 1 Then
               
                  createcheck(c.x, c.y - 1, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         'Unten
         If c.y + 1 <= 9 Then
         If map[c.x, c.y + 1] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x Or n.y <> c.y + 1 Then
                  createcheck(c.x, c.y + 1, c.art)
                  Exit
               EndIf
            Next
         
         EndIf
         EndIf
         
         'Links
         If c.x - 1 >= 0 Then
         If map[c.x - 1, c.y] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x - 1 Or n.y <> c.y Then
                  createcheck(c.x - 1, c.y, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         'Rechts
         If c.x + 1 <= 9 Then
         If map[c.x + 1, c.y] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x + 1 Or n.y <> c.y Then
                  createcheck(c.x + 1, c.y, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         c.status = 1
      EndIf
      
      DrawRect c.x * 30 + 10, c.y * 30 + 10, 10, 10

      
      
   Next
End Function


wäre nett wenn ihr mir weiterhelfen könntet... ich komm einfach nich drauf...

mfg
mas93
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]
 

klepto2

 BeitragDo, Sep 25, 2008 21:48
Antworten mit Zitat
Benutzer-Profile anzeigen
Meinst du sowas?

Code: [AUSKLAPPEN]

Type TPlayMap
   Field Array:Int[10,10]
   
   Function Create:TPlayMap(Range:Int = 2)
      Local Map:TPlayMap = New TPlayMap
      Map.Fill(Range)
      Return Map
   End Function
   
   Method Fill(Range:Int)
      For Local X:Int = 0 To 9
         For Local Y:Int  = 0 To 9
            Array[X,Y] = Rand(0,Range)
         Next
      Next
   End Method
   
   Method Draw()
      For Local X:Int = 0 To 9
         For Local Y:Int  = 0 To 9
            DrawText Array[X,Y],X*20,Y*20
         Next
      Next
   End Method
   
   Method Check:Int(X:Int,Y:Int)
      Local TX:Int = X/20
      Local TY:Int = Y/20
      If TX > 9 Or TY > 9 Then Return -1
      If TX < 0 Or TY < 0 Then Return -1
      Return Array[TX,TY]
   End Method
   
   Method MarkNeighbors(X:Int,Y:Int)
      Local TX:Int = X/20
      Local TY:Int = Y/20
      If TX > 9 Or TY > 9 Then Return
      If TX < 0 Or TY < 0 Then Return
      Local Value:Int = Array[TX,TY]
      For Local XX:Int = -1 To 1
         For Local YY:Int = -1 To 1
            Local VX:Int = TX+XX
            Local VY:Int = TY+YY
            If VX < 0 Or VY < 0 Or VX > 9 Or VY > 9 Then Continue
            If Array[VX,VY] = Value Then
               SetColor 255,0,0
               If VX = TX And VY = TY Then SetColor 0,255,0
               DrawText Array[VX,VY],VX*20,VY*20
               SetColor 255,255,255
            End If
         Next
      Next
   End Method

End Type

Graphics 800,600,0,-1

Local M:TPlayMap = TPlayMap.Create(2)

While Not KeyHit(KEY_ESCAPE)
   Cls
   M.Draw()
   M.MarkNeighbors(MouseX(),MouseY())
   DrawText "Tile Value : " + M.Check(MouseX(),MouseY()),0,250
   Flip
Wend


Um ganze ehrlich zu sein, aus deinem Code werde ich nicht ganz schlau. Mir kommt er viel zu kompliziert vor, was daran liegen könnte, das man den Rest nicht sieht.
Matrix Screensaver
Console Modul für BlitzMax
KLPacker Modul für BlitzMax

HomePage : http://www.brsoftware.de.vu

mas93

 BeitragFr, Sep 26, 2008 14:23
Antworten mit Zitat
Benutzer-Profile anzeigen
hmm nein, das ist nicht ganz das was ich wollte. Hab mich n bisschen falsch ausgedrückt.

Ich will dass alle erreichbaren Felder angezeigt werden.
Angenommen eine Figur kann nur auf dem Wert 2 laufen... jetzt will ich alle erreichbaren 2er felder vom startfeld aus markieren.

Ich hoffe du weisst was ich meine, ansonsten kann ich auch noch schnell ein bild pixeln...

hier mal der gesamte code:

Code: [AUSKLAPPEN]

Graphics 640, 480
'SeedRnd MilliSecs()


Global map:Int[10, 10]

Type ball
Field x, y
Field art
End Type

Global BallList:TList = CreateList()

Type check
   Field x, y
   Field art
   Field status
End Type

Global CheckList:TList = CreateList()

'Bilder laden
Global ballpic = LoadImage("gfx\ball.png")



'die map füllen
For xx = 0 To 9
   For yy = 0 To 9
   a:Int = Rand(0, 2)
   Createball(xx, yy, a)
   map[xx, yy] = a
   Next
Next


Global over, tx, ty

'Hauptschleife


Repeat
Cls

If KeyHit(KEY_C) Then createcheck(4, 4, map[5, 5])


vorschau()
updateballs()
checkall()
Flip
Until KeyHit(KEY_ESCAPE)






Function vorschau()
   For b:ball = EachIn BallList
      If rectsoverlap(MouseX(), MouseY(), 1, 1, b.x * 30, b.y * 30, 30, 30) Then
         
         If tx <> b.x Or ty <> b.y Then
            ClearList(CheckList)
            over = 0
         EndIf
         
         If over = 0 Then
            createcheck(b.x, b.y, b.art)
            over = 1
            tx = b.x
            ty = b.y
         End If
      EndIf
   Next
End Function

Function checkall()
   For c:check = EachIn CheckList
      If c.status = 0 Then
         'alle Richtungen checken
         
      
         
         'OBEN
         If c.y - 1 >= 0 Then
         If map[c.x, c.y - 1] = c.art Then
            For n:check = EachIn CheckList
            
               If n.x <> c.x Or n.y <> c.y - 1 Then
               
                  createcheck(c.x, c.y - 1, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         'Unten
         If c.y + 1 <= 9 Then
         If map[c.x, c.y + 1] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x Or n.y <> c.y + 1 Then
                  createcheck(c.x, c.y + 1, c.art)
                  Exit
               EndIf
            Next
         
         EndIf
         EndIf
         
         'Links
         If c.x - 1 >= 0 Then
         If map[c.x - 1, c.y] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x - 1 Or n.y <> c.y Then
                  createcheck(c.x - 1, c.y, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         'Rechts
         If c.x + 1 <= 9 Then
         If map[c.x + 1, c.y] = c.art Then
            For n:check = EachIn CheckList
               If n.x <> c.x + 1 Or n.y <> c.y Then
                  createcheck(c.x + 1, c.y, c.art)
                  Exit
               EndIf
            Next
            
         EndIf
         EndIf
         
         c.status = 1
      EndIf
      
      DrawRect c.x * 30 + 10, c.y * 30 + 10, 10, 10

      
      
   Next
End Function


Function createcheck(x, y, art)
   Local c:check
   c = New check
   c.x = x
   c.y = y
   c.art = art
   ListAddLast(CheckList, c)
End Function


Function updateballs()
   For b:ball = EachIn BallList
   
      Select b.art
         Case 0
            SetColor(255, 0, 0)
         Case 1
            SetColor(0, 255, 0)
         Case 2
            SetColor(0, 0, 255)
      End Select
      
      DrawImage ballpic, b.x * 30, b.y * 30
      
      SetColor(255, 255, 255)
   Next
End Function

Function Createball(x, y, art)
   Local b:ball
   b = New ball
   b.x = x
   b.y = y
   b.art = art
   ListAddLast(BallList, b)
End Function

Function rectsoverlap(x1, y1, width1, height1, x2, y2, width2, height2)
   If x1 + width1 > x2 And y1 + height1 > y2 And x1 < x2 + width2 And y1 < y2 + height2 Then
      Return 1
   Else
      Return 0
   EndIf
End Function
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]
  • Zuletzt bearbeitet von mas93 am Fr, Sep 26, 2008 14:51, insgesamt einmal bearbeitet

Smily

 BeitragFr, Sep 26, 2008 14:25
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich habe mir den code jetzt nicht angesehen, aber ich vermute mal, dass, wenn du das erste feld berührst, dein programm versucht, das feld danneben, abzufragen, was natürlich zu einem Fehler führt.

ciao,
Smily0412
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets

"Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!"
stummi.org

mas93

 BeitragFr, Sep 26, 2008 14:32
Antworten mit Zitat
Benutzer-Profile anzeigen
nein, so klug war ich dann doch das einzubaun^^

Und außerdem kommt ja kein fehler, sondern das Programm hängt sich auf... (Keine Rückmeldung)
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]

Smily

 BeitragFr, Sep 26, 2008 14:33
Antworten mit Zitat
Benutzer-Profile anzeigen
ist der debugger an?
Lesestoff:
gegen Softwarepatente | Netzzensur | brain.exe | Unabhängigkeitserklärung des Internets

"Wir müssen die Rechte der Andersdenkenden selbst dann beachten, wenn sie Idioten oder schädlich sind. Wir müssen aufpassen. Wachsamkeit ist der Preis der Freiheit --- Keine Zensur!"
stummi.org

mas93

 BeitragFr, Sep 26, 2008 14:50
Antworten mit Zitat
Benutzer-Profile anzeigen
jop isser
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]

Bob

 BeitragFr, Sep 26, 2008 17:46
Antworten mit Zitat
Benutzer-Profile anzeigen
Hallo Mas93

ich würde das Problem mit nem kleinen Stack lösen.
Du müsstest deinen Code aber dann ein bißchen mehr OOP anlegen.

Der Code ist eine leicht modifizierte Variante von Klepto's Code.


Code: [AUSKLAPPEN]

SuperStrict

Global dirX:Int[4]
Global dirY:Int[4]

DirX[0] = 0      'N
DirX[1] = 1      'O
DirX[2] = 0      'S
DirX[3] = -1   'W

DirY[0] = -1   'N
DirY[1] = 0      'O
DirY[2] = 1      'S
DirY[3] = 0      'W

Type TPlayMap
   Field Array:tPoint[10,10]
   Field List:TList
   
      Function Create:TPlayMap(Range:Int = 2)
        Local Map:TPlayMap = New TPlayMap
        If Map.List = Null Then Map.list = New TList
      Map.Fill(Range)
        Return Map
   End Function
   
   
   Method OnMap:Int(X:Int,Y:Int)
      If X < 0 Then Return False
      If y < 0 Then Return False
      If x > 9 Then Return False
      If y > 9 Then Return False
      Return True
   End Method

   Method Fill(Range:Int)
      For Local X:Int = 0 To 9
         For Local Y:Int  = 0 To 9
         Local p:tpoint = New tpoint
         p.x = x
         p.y = y
         p.wert = Rand(0,Range)
         List.addlast(p)
         array[x,y] = p
      Next
      Next
   End Method
   
   Method Draw()
         For Local p:tPoint = EachIn List
            DrawText p.wert ,p.x*20,p.y * 20
         p.gefunden = False
       Next
   End Method
   
   Method Check:tPoint(X:Int,Y:Int)
    Local TX:Int = X/20
      Local TY:Int = Y/20
      If TX > 9 Or TY > 9 Then Return Null
      If TX < 0 Or TY < 0 Then Return Null
      Return Array[TX,TY]
   End Method
   
   Method MarkNeighbors(X:Int,Y:Int)

   
   
   Local p:tpoint =check(x,y)
   If Check(X,y) = Null Then Return
   Local openList:TList = New TList   
   Openlist.addlast(p)
   p.gefunden = True
   Local Suchwert:Int = p.wert
   Print "Suchwert " +Suchwert
   SetColor 0,255,0
   DrawText suchwert,p.x*20,p.y *20

   
   Local NX:Int, NY:Int
   While CountList(Openlist)>0
      p = tPoint(openlist.first())
      'Print "Hier"
      For Local r:Int = 0 To 3
         'Neue Pruefkoordinaten
         NX = p.x + dirX[r]
         NY = p.Y + dirY[r]
         If OnMap(NX,NY) = False Then Continue
         Local np:tpoint = array[nx,ny]
         If np.wert = Suchwert And np.gefunden = False Then
            np.gefunden = True
            openlist.addlast(np)
                  SetColor 255,0,0
                    DrawText np.wert,nX*20,nY*20
         EndIf
      Next
      openlist.remove(P)
   Wend
     SetColor 255,255,255
   
   End Method

End Type

Type tPoint
   Field X:Int, Y:Int, Wert:Int
   Field gefunden:Int
End Type   


Graphics 800,600,0,-1

Local M:TPlayMap = TPlayMap.Create(2)

While Not KeyHit(KEY_ESCAPE)
   Cls
   M.Draw()
   M.MarkNeighbors(MouseX(),MouseY())
   Flip
Wend
End
Er soll an den Spielen teilnehmen bis er spielend stirbt. MCP - TRON

mas93

 BeitragSa, Sep 27, 2008 19:21
Antworten mit Zitat
Benutzer-Profile anzeigen
Hey, vielen Dank, das ist genau das was ich wollte...
nur hab ich das OOP zeug noch nich so raus... somit ist dein code nur recht schwer für mich zu verstehen.
Trotzdem vielen Dank!
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]

Bob

 BeitragSo, Sep 28, 2008 13:21
Antworten mit Zitat
Benutzer-Profile anzeigen
Das mit dem oop ist am Anfang auch nicht alles so leicht zu verstehen.
Es lohnt sich aber gewaltig.

Hier noch ein Kleiner denkanstoss.

Stell dir vor in deinem Array Map[10,10] wäre nicht die Art des Balls, also 0 1 oder 2 als Integer gespeichert, sondern die Map ist direkt vom Type Ball

Map:Ball[10,10]

Dann könttest du deine Funktion Vorschau, die ja deine ganze Liste abarbeiten muss, mit wenige Zeilen umbauen.

.


Function vorschau:Ball()
TX:Int = MouseX() / 30
TY:Int = MouseY() / 30
'Pruefen das sich die Koordinaten auch im array befinden
If TX<0 Or ty<0 Or ty> 9 Or tx > 9 Then Return NULL
Local B:tball = map[tx,ty]
Return B
End Function

Wen du das so machst kommst du schnell auf den Trichter wie man das noch weiter ausbauen kann.

Den Type Check kannst du dir auch komplett einsparen.
Übergib an die Function CheckBall den gefunden Ball aus der Function Vorschau.
Trag diesen in die "OpenList" als erstes ein und starte deine Suche von diesem Ball aus.

Viel Glück
Er soll an den Spielen teilnehmen bis er spielend stirbt. MCP - TRON

mas93

 BeitragSo, Sep 28, 2008 14:03
Antworten mit Zitat
Benutzer-Profile anzeigen
hmm, ich denk da muss ich mich erst noch besser einarbeiten.
Sowas wie z.b.: map:ball[10,10] hab ich noch nie gemacht.... und weiss somit auch nich wirklich was das ganze bewirkt...

gibts denn nicht irgendwo ein tutorial, das einem das ganze OOP zeugs n bisschen näher bringt?

Achja und nochmal danke für deine Hilfe!
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]
 

Schnuff

 BeitragSo, Sep 28, 2008 14:11
Antworten mit Zitat
Benutzer-Profile anzeigen
https://www.blitzforum.de/foru...hp?t=18397

zu Anfang ist es etwas verwirrend (vor allem wenn man bei BB die types noch nicht verstanden hat)
aber wenn man das dann kann, ist es eine der großartigsten Neuerungen von BMax.
Programmers dont die. They gosub without return...

mas93

 BeitragSo, Sep 28, 2008 14:24
Antworten mit Zitat
Benutzer-Profile anzeigen
Vielen Dank!
Das bringt mich echt um eniges weiter!
Vorallem ist das ja auch total praktisch!
www.lpbase.de
Meine Linkin Park Fanseite[Noch im Aufbau]

Neue Antwort erstellen


Übersicht BlitzMax, BlitzMax NG Beginners-Corner

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group