superstrict
Include "Array_Pattern_Search.bmx"
AppTitle =  "Demo#1 Array Pattern Search by bob Nov. 2006"
Graphics 800,600
SeedRnd  MilliSecs()

Local myPat:tPattern
Local PatArray:tPattern[6]

'Create a new Pattern and keep it simple in demo 1
myPat = New tPattern.Create("0,0 ; 0,0")
PatArray[0] = myPat

 
'Rememer: a X marks the Spot
myPat = New tPattern.Create("9,?,9, ;  ?,9,? ;  9,?,9")
PatArray[1] = myPat

myPat = New tPattern.Create("9,7, ;  7,9")
PatArray[2] = myPat

'Search a Row
myPat = New tPattern.Create("1,2,3")
PatArray[3] = myPat


'Search a Column
myPat = New tPattern.Create("1;2;3")
PatArray[4] = myPat

'Again Row But nly the 6 will return  while rValue is set to 6

myPat = New tPattern.Create("5,6,7")
PatArray[5] = myPat
Local CurrentPat:Int = 0



'The Pattern what you looking for iss f.e. a TileMap in a Game
'Everytime you use a "?" as a searchvalue the Original Value is ignored.
'? is a wildcard for any Value so you caon search for Forms like a Cross made with "1" values


'Lets take a Lokk on it
'Parameter (1) is Optional. Meaning: Waitkey for Continue  Default=0

PatArray[CurrentPat].Draw(1)

Local counter:Int
Local x:Int,y:Int
Local RValue:String = "A"


While Not KeyHit(KEY_ESCAPE)
   Cls
   SetColor 255,255,255
   If KeyDown(KEY_ESCAPE ) Then Exit
   
   If KeyHit(KEY_NUMADD) then
      currentPat:+1
      If  currentPat> 5 then CurrentPat = 0
      PatArray[CurrentPat].Draw(1)
      Select currentPat
         Case 1
            RValue ="C"
         Case 5
            RValue ="6"

         Default
            RValue ="A"
      End Select
      
   endif
   

   'Create a random Arrays 
   Local RX:Int = Rand(15,20)
   Local RY:Int = Rand(15,20)
   Local Arr:Int[RX,RY]
   For y =0 To RY-1
      For x = 0 To RX-1
         Arr[x,y] = Rand(0,9)
         DrawText Arr[x,y], x*20,y*20
      Next
   Next
   counter:+1
   DrawText "Random Array No:# " + counter,400,0
   Flip
   
   
   Local Found:Int = False
   Local list:TList
   'Her you can Search the Pattern in the Array
   'If the Pattern is found you get a list:Tlist cointaing all Valus and Array Adesses (x,Y)
   'Take a look on the tPoint for more Informations
   '--------------------------------------------------------
   list = PatArray[CurrentPat].Search(Arr,0,0,RValue)
   '--------------------------------------------------------
   If Not list = Null Then
      SetColor 0,255,0
      DrawText "Pattern Found " ,400,20   
      DrawText "Press + To Change SearchPattern " ,400,40
      DrawText "Press F1 To Continue" ,400,60
      If rValue = "C" Then DrawText "(Only Center returns)",400,80
      If rValue <> "A" and rValue <>"C" Then DrawText "(Only " + rValue + " returns)",400,80
      For Local p:tPoint = EachIn list
         DrawText p.Value, P.x*20,p.y*20
      Next
      Flip
      Repeat
         If KeyHit(KEY_F1) then Exit
         If KeyDown(KEY_ESCAPE ) Then Exit

      Forever
   EndIf
   
Wend
End

'Array_Pattern_Search.bmx'


'Array Pattern Search by bob
'Find 2D Integer Patter (Array) in a larger 2D Integer Array
' Use "?" as Wildcard for any Value that shout be ignore
' returns a List containg tPoints Type with all values and koordinates from the Search Array

'Example 1
'Create a Pattern like This
'MyPat:tPattern = New tPattern.Create("0,0 ; 0,0 ")
'Creates a SearchPattern Looks Like
'0 0
'0 0
'Seperate Valus By ","
'Start a New Row by ";"

'Example 2
'MyPat:tPattern = New tPattern.Create("5,5,5 ;  5,9,5 ; 5,5,5")
'Looks Like:
' 5 5 5
' 5 9 5
' 5 5 5
'Can be a Monster in a Dungeon inside walls ? Bad Idee

'Use the ? for the 9 Returns all Patterns where any Value is inside the 5 Values
'MyPat:tPattern = New tPattern.Create("5,5,5 ;  5,?,5 ; 5,5,5")
'MyMonstersInWalls:tList = NewTlist
' Use the "C" parameter in Search
'MyMonstersInWalls = myPat.Search(DungeonArray,0,0,"C")
'Returns any Value (Monster NPC, PC, whatever) inside the 5 Values WHITOUTt the walls (5)

'using the ? Value u can define any Shape
'MyPat:tPattern = New tPattern.Create("1,?,?,?,1 ;  ?,1,?,1,? ;  ?,?,1,?,? ; ?,1,?,1,?  ; 1,?,?,?,1")
'MyTreasure = myPat.Search(DungeonArray,0,0,"C")
'Thats a X that marks the Spot and Only the Center will return
'
'1     1
' 1  1
'  1
' 1  1
'1     1




'Example 3
'MyPat:tPattern = New tPattern.Create("5,5,5 ;  5,9,5 ; 5,5,5")
'MyList = myPat.Search(DungeonArray,0,0)
'Returns all Patterns whit all Values matching Exactly

'MyPat:tPattern = New tPattern.Create("5,5,5 ;  5,?,5 ; 5,5,5")
'MyList = myPat.Search(DungeonArray,0,0)
'Returns all Patterns whit all Values matching Exactly by Value 5 and any Value on Position x1,y1

'MyPat:tPattern = New tPattern.Create("5,5,5 ;  5,?,5 ; 5,5,5")
'MyList = myPat.Search(DungeonArray,0,0,"C" )
'Returns all Patterns whit only any value on X1,Y1 but  that Inmatching Exactly by Value 5 and any Value on Position x1,y1


'This Mod is good for Building Levels whit a TileMap Editor
'U can make a Lot of Patterns for searching Water Tiles  next to Ground Tiles to Build a Coast
' Or find som Errors in your Map or.. or.. or..
'Me Use This Code in my Dungeon Generator to find the right Positions for Doors and  Stairs ....

'Have Fun
'************************* Type tPattern *****************************************************************
Type tPattern
   Field sArr:String[,]
   Field DimX:Int
   Field DimY:Int
   
   '-----------------------------------------------------------------------------
   Function Create:tPattern(Values:String ="")
      Local M:tPattern = New tPattern
      If Values <>"" Then
         M.ParseValues(Values)
      EndIf
      Return M
   End Function
   
   '-----------------------------------------------------------------------------   
   Method ParseValues(Values:String)
      'Translete the Value String into an Array.
      'Clean up the String
      Values = Replace(Values," ","")                   'Remove Spaces
      While Right(Values,1) = ";" Or Right(Values,1) = "," 'Remove ";" or "," if it is at last
         Values = Left(Values,(Len(Values)-1))
      Wend
         'Make Sure the Last Character NOW is a ";" to pharse right Dimensions
      Values = Values + ";"
      'Find Dimensions, Values and Koordinates
      Local D1:String
      Local dCounter:Int
      Local vCounter:Int
      Local vList:TList = New TList
      Local p:tPoint
      
      For Local i:Int = 1 To Len(Values)
         D1 = Mid(Values,i,1)
         If D1 = ";"   Then
            DcOunter:+1
            vCounter = 0
         EndIf
         
         If D1 <>"," And D1 <>";" Then
            p = New tPoint.Create(vCounter,dCounter,D1)
            vList.AddLast(P)
            vCounter:+1
            p.Draw
         EndIf
      Next
      'The Last current tPoint contains the Dimensions that we need
      DimX = p.X+1
      DimY = p.Y+1
      'DebugLog "DimX Y " + dimX + " " + DimY
      sArr = New String [DimX,DimY]
      'Fill Arrays With Values
      For  p = EachIn vList
         sArr[p.x,p.y]=p.Value
      Next
      ClearList(vList)
      'Thats it .... :-)
   End Method
   

   '-----------------------------------------------------------------------------   
   Method Search:TList(zArr:int[,], StartX:Int=0, StartY:Int=0, ReturnValues:String="A")
      Local FinalList:TList = New TList   'This List will be return
      Local maxx:Int =  zArr.Dimensions()[0]-1
      Local maxy:Int =  zArr.Dimensions()[1]-1
      Local FoundList:TList=Null
      
      If DimX-1 >maxx or DimY-1>maxy then Return Null
      
      For Local y:Int = StartY to maxy
         For Local x:Int = StartX To maxx
            FoundList =SubSearch(zArr,x,y,ReturnValues)
            If Not FoundList = Null then
               For Local p:tPoint = eachin FoundList
                  FinalList.AddLast(p)
               Next
               ClearList(FoundList)
               FoundList = NUll
            Endif
         Next
      Next
      If CountList(FinalList) = 0 then Return Null
      Return FinalList
   End Method
   
   Method SubSearch:TList(zArr:Int[,],StartX:Int,StartY:Int,ReturnValues:String)
      Local FoundPosition:Int = False      'The List wil be filled up only FoundPosition is True
      Local FoundList:TList = New TList   'This List will be filled with Values that be found
      Local TrueCounter:Int = 0         'Counts +1 If a Value is Found
      Local TrueValue:Int = DimX*DimY      'A Point List only Returns if TrueCounter = TrueValue
      If DimY = 0 Then TrueValue = DimX   'Correct True Value if Search Array is not 2D
      Local XX:Int = StartX            'Offset X
      Local YY:Int = StartY               'Offset Y
      Local Center:int = sArr.length / 2   'Center of the Pattern you Search
      If Not (sArr.length / 2) Mod 2 = 0 then
         Center:+1                     
      End If


      For Local y:Int =0 To DimY-1
         For Local x:Int =0 To DimX-1
            if XX>zArr.Dimensions()[0]-1 then Return Null
            if YY>zArr.Dimensions()[1]-1 then Return Null

            Select sArr[x,y]
               Case "?"
                  FoundPosition = True
               Default
                  If zArr[XX,YY] <> sArr[x,y] Then Return Null
                  FoundPosition = True
            End Select
               
            TrueCounter:+1
            If FoundPosition Then
               FoundPosition  = False
               Select ReturnValues
                  Case "C"  ' Only Center will Return
                     If TrueCounter = Center then FoundPosition =True   
                  Case "A"  'All
                     FoundPosition =True   
                  Default  'Looking for any given value
                     If sArr[x,y] = Int(ReturnValues) then FoundPosition = True
               End Select
               
               If FoundPosition  then
                  Local p:tPoint = New tPoint.Create(XX , YY ,zArr[XX,YY])
                  FoundList.AddLast(P)
               Endif
               
            Endif
         
            XX:+1
         Next
         xx = StartX
         YY:+1
      Next
      Return FoundList
   End Method
   '-----------------------------------------------------------------------------
   Method Draw(Wait:Int=False)
      'Only for debugging ----
      Cls
      Local Y:Int,X:Int
      For Y = 0 To DimY-1
         For X = 0 To DimX-1
            SetColor 255,255,255
            DrawRect x*20,y*20,20,20
            SetColor 0,0,0
            DrawRect x*20+1,y*20+1,18,18
            SetColor 255,255,255
            DrawText sArr[x,y],x*20+2,y*20+2
         Next
      Next
      
      If Wait=True Then
         DrawText "You are looking for:",0,y*20+20
         DrawText "Press Key to Continue",0,y*20+40
         Flip
         WaitKey
         Return
      EndIf
      Flip   
   End Method
End Type


'************************* Type Point *****************************************************************
Type tPoint
   Field X:Int
   Field Y:Int
   Field Value:String
   
   Function Create:tPoint(XPos:Int,YPos:Int,Value:String)
      Local p:tPoint = New tPoint
      p.X = XPos
      p.Y = YPos
      P.Value = Value
      Return P
   End Function
   
   Method Draw()
      DebugLog "Value: " + Value + " X|Y: " + x + " | " + y
   End Method
End Type