Detect Runs of Matching Tiles In 2D Array

[kevin]

  Detect Runs of Matching Tiles In 2D Array

   This example creates a 2d array, fills it with some random values, then scans the array rows looking for runs of the matching tiles. Any run of the tiles i displayed in red in the output.


   (requires V1.64M)

PlayBASIC Code: [Select]

   LoadFOnt "courier",1,32,0
   makebitmapfont 1,$ffffffff,8
   Global Width   =20
   Global Height   =16

   Type tMapTile
         Tile
         Row_STartPos
         Row_Length
   EndType

   Dim Map(Width,Height) as TMapTile
   
   ResetMap()


   Do

      Cls
         
      ScanForRows()   

      DisplayMap(100,60)

      if SpaceKey()
         ResetMap()
      endif
   
      Sync
   loop



Function ResetMap()

   
   For Ylp=0 to Height-1
      For Xlp=0 to Width-1
            Map(xlp,ylp).tile=Rnd(9)
      next   
   next


EndFunction

Function DisplayMap(Xpos,ypos)

   lockbuffer
   For Ylp=0 to Height-1
      For Xlp=0 to Width-1
            X=Xpos+Xlp*30
            Y=Ypos+Ylp*30

            if Map(xlp,ylp).Row_StartPos=-1
               ink $ffffff
            else
               ink $ff0000
            endif
            text x,y,Chr$(asc("0")+Map(xlp,ylp).Tile)
      next   
   next
   unlockbuffer

EndFunction




Function Reset_Rows()

   For Ylp=0 to Height-1
      For Xlp=0 to Width-1
            Map(xlp,ylp).Row_STartpos=-1
      next   
   next


EndFunction
   



Function ScanForRows()

   Reset_Rows()

   For Ylp=0 to Height-1
   
      For Xlp=0 to Width-2

         CurrentTile   =Map(xlp,ylp).tile

         if CurrentTile=Map(xlp+1,ylp).tile
      
            RunStart=Xlp
            RunLength=0
            For runLp=Xlp to Width-1
               if CurrentTile=Map(runlp,ylp).tile
                  RunLength++
               else
                  exitfor runlp                                          
               endif            
            next

            ; Tag a row when it's longer than 1 tile long
            if RunLEngth>1
               For runLp=RunStart to RunStart+RunLength-1
                     Map(runlp,ylp).Row_StartPos=RunStart
                     Map(runlp,ylp).Row_Length   =RunLength                                                
               next      
               ; Skip X loop counter forward, past this run of tile sames      
               Xlp=RunLP-1
            endif
         endif         
      next   
   next

EndFUnction