Make Occupied Map From 2 Colour image

[kevin]

  Make Occupied Map From 2 Colour image

  This example computes map of 'occupied' rects from the 2 colour image.  The Image is expected to be either black (rgb=0 ) or pure white (rgb=$ffffff).  The user can draw circles with the mouse to fill the frame in.    The occupied Map is drawn behind it in GREEN and RED blocks in real time.    

PlayBASIC Code: [Select]

TileSize=10

   Screen=NewIMage(800,600,2)
   Dim Map(810/TileSize, (610/TileSize))
   

   Mr=10
   
   Do
      setcursor 0,0   
   
      mx=mousex()   
      my=mousey()   

      mz=mousemovez()
      if mz
            Mr=cliprange(mr+mz,10,100)
      endif

      rendertoimage screen
      if LeftMouseButton()
            circle mx,my,mr,true
      Endif
   
      if Spacekey()
            Cls 0
      endif
   
      rendertoscreen

      ; Scan the screen and build a map of it
      MapImage(Screen,tilesize)

      ; draw the map as shade boxes      
      DrawMapArray(0,0,TileSize)      

      ; draw the screen over it      
      drawimage screen,0,0,true

      ; draw the users render circle 
      circle mx,my,mr,true

      ; controls
      print "Mouse To Draw"
      print "Space to reset"


      Sync
   loop



Psub DrawMapArray(Xbase,Ybase,TileSize)

   lockbuffer
   For ylp=0 to GetArrayElements(Map(),2)-1
      Ypos=Ybase+ylp*TileSize
      Ypos2=Ypos+TileSize

      For xlp=0 to GetArrayElements(Map(),1)-1
            if Map(xlp,ylp)
                  Col=$660000
            else
                  Col=$6600
            endif                      
            Xpos=xlp*tileSize
            shadebox Xpos,Ypos,Xpos+TileSize,Ypos2,col,0,0,0
      next
   next
   unlockbuffer


EndPsub

Psub MapImage(image,tilesize)

   rendertoimage Image

   ClearArray Map(),0
   
   Width   =GetImageWidth(image)
   Height=GetImageHeight(image)

   Width2=Width-1
   lockbuffer 
      ThisRgb=Point(0,0)

      For ylp=0 to Height-1

         Row=Ylp/TIleSize
   
         Xpos=0
         repeat         
            ThisRGb=Fastpoint(Xpos,ylp)
            RunSize=PixelRunLength(Xpos,ylp, 1, 0, ThisRGB)

            Xpos2=Xpos+RunSize

            if ThisRGB
               For Xlp=Xpos/TileSize to Xpos2/TileSize
                     Map(Xlp,Row)=1   
               next
            endif
            
            Xpos+=RunSize
         until Xpos=>Width2
               
;         next
      next
   unlockbuffer
   
   rendertoscreen   
   
EndPsub

[ATLUS]

Nice code!

[kevin]

   Make Occupied Map From 2 Colour image - Map Version

   This is variant of the routine above, the only difference being in this version, it that it uses PlayBASIC maps to render the grid and map, rather than doing it manually.   Moving to maps removes most of the brute force stuff from the runtime and moves the work into the command set giving a better performance.    This version can map on one a 1 to 1 ratio in real time.  

PlayBASIC Code: [Select]

   TileSize=5

   Screen=NewIMage(800,600,2)
   
   global Map      =NewMap(10)
   global Level   =NewLevel(Map,810/TileSize,610/TileSize) 
   
   Make_Map_Files(Screen,TileSize)


   Mr=10
   
   Do
      setcursor 0,0   
   
      mx=mousex()   
      my=mousey()   

      mz=mousemovez()
      if mz
            Mr=cliprange(mr+mz,10,100)
      endif

      rendertoimage screen
      if LeftMouseButton()
            circle mx,my,mr,true
      Endif
   
      if Spacekey()
            Cls 0
      endif
   
      rendertoscreen

      ; Scan the screen and build a map of it
      MapImage(Screen,tilesize)

      ; draw the map as shade boxes      
      drawmap Map,level,0,0

      ; draw the screen over it      
      drawimage screen,0,0,true

      ; draw the users render circle 
      circle mx,my,mr,true

      ; controls
      print "Mouse To Draw"
      print "Space to reset"


      Sync
   loop





Psub Make_Map_Files(Screen,TileSize)
   
   CreateMapGfx  Map,TileSize,TIleSize,5,0,2

   rendertoimage screen
   ShadeBox 0,0,TileSize,TileSize,$ff00,0,0,0
   GetMapBLK  Map,0,0,0

   ShadeBox 0,0,TileSize,TIleSize,$ff0000,0,0,0
   GetMapBLK  Map,1,0,0   

   LevelSolid Map,Level 
   filllevel Map,level,0,0,100,100,0

   cls 0
   rendertoscreen
   
EndPsub




Psub MapImage(image,tilesize)

   rendertoimage Image

   ClearLevel Map,Level,0
   
   Width   =GetImageWidth(image)
   Height=GetImageHeight(image)

   Width2=Width-1
   lockbuffer 
      ThisRgb=Point(0,0)

      For ylp=0 to Height-1

         Row=Ylp/TIleSize
   
         Xpos=0
         repeat         
            ThisRGb=Fastpoint(Xpos,ylp)
            RunSize=PixelRunLength(Xpos,ylp, 1, 0, ThisRGB)

            Xpos2=Xpos+RunSize
            if ThisRGB
               FillLevel Map,Level,Xpos/TileSize,Row,Xpos2/TileSize,Row,1
            endif
            
            Xpos=Xpos2
         until Xpos=>Width2
               
      next
   unlockbuffer
   
   rendertoscreen   
   

EndPsub