Draw a 2D non geometric figure

[Joubarbe]

Oops, yes, you're right... That was the point of the Plot() section, because the color was therefore changed.

Will try without strings.

And what would be the best way to check if a pixel has already been checked ? I'm not usually forced to make the fastest procedure, but with this one, it's mandatory (it's indeed very very slow in the current state).

[Fig]

Code: Select all

;{ Open a window
;DisableDebugger
If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitNetwork()=0:MessageRequester("Error","Error DirectX",0):EndIf
ExamineDesktops()
#X=1000:#Y=1000 ;resolution X,Y
If OpenWindow(0,200,0,#X,#Y, "map test ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
    If OpenWindowedScreen(WindowID(0),0,0,#X,#Y,0,0,0,#PB_Screen_WaitSynchronization)=0
        MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
        End
    EndIf
EndIf

;}
;mouse sprite
CreateSprite(0,10,10)
StartDrawing(SpriteOutput(0))
Box(0,0,10,10,#Red)
StopDrawing()
#fillcolor=#Red
#sidecolor=#White
Structure xy
x.i
y.i
EndStructure
Global NewList cost.xy()

Procedure shape2(x,y)
NewList fringe.xy()
Dim mape(#x,#y)
ClearList(cost())
StartDrawing(ScreenOutput())
While Point(x,y)<>#sidecolor
x-1
Wend
AddElement(cost())
cost()\x=x
cost()\y=y
debx=x
deby=y
AddElement(fringe())
fringe()\x=x
fringe()\y=y
Repeat
x=fringe()\x
y=fringe()\y
DeleteElement(fringe())
For i=-1 To 1
For j=-1 To 1
If i=0 And j=0:Continue:EndIf
If mape(x+i,y+j)=0 And Point(x+i,y+j)=#sidecolor
    AddElement(cost())
    cost()\x=x+i
    cost()\y=y+j
    AddElement(fringe())
    fringe()\x=x+i
    fringe()\y=y+j
    mape(x+i,y+j)=1
EndIf
Next j
Next i
Until ListSize(fringe())=0
StopDrawing()
EndProcedure


Procedure shape(x,y)
Dim mape(#x,#y)
;Kinf of djikstra/fringe search
NewList fringe.xy()
AddElement(fringe())
fringe()\x=x
fringe()\y=y
StartDrawing(ScreenOutput())
While ListSize(fringe())<>0
x=fringe()\x
y=fringe()\y
DeleteElement(fringe())
;test 4 pixels
x+1
If Point(x,y)<>#White 
If mape(x,y)=0
AddElement(fringe())
fringe()\x=x
fringe()\y=y
mape(x,y)=1
EndIf
Else
AddElement(cost())
cost()\x=x
cost()\y=y
EndIf
x-2
If Point(x,y)<>#White 
If mape(x,y)=0
AddElement(fringe())
fringe()\x=x
fringe()\y=y
mape(x,y)=1
EndIf
Else
AddElement(cost())
cost()\x=x
cost()\y=y
EndIf
x+1:y-1
If Point(x,y)<>#White 
If mape(x,y)=0
AddElement(fringe())
fringe()\x=x
fringe()\y=y
mape(x,y)=1
EndIf
Else
AddElement(cost())
cost()\x=x
cost()\y=y
EndIf
y+2
If Point(x,y)<>#White 
If mape(x,y)=0
AddElement(fringe())
fringe()\x=x
fringe()\y=y
mape(x,y)=1
EndIf
Else
AddElement(cost())
cost()\x=x
cost()\y=y
EndIf
Wend
StopDrawing()
EndProcedure


Repeat
    WindowEvent()
    ExamineKeyboard()
    ExamineMouse()
    FlipBuffers()
    ClearScreen(#Black)
    StartDrawing(ScreenOutput())
    DrawingMode(#PB_2DDrawing_Outlined) 
    Circle(500,300,200)
    Circle(500,500,200)
    If ListSize(cost())
    ForEach cost()
        Plot(cost()\x,cost()\y,#fillcolor)
    Next
    EndIf
    StopDrawing()
    If KeyboardReleased(#PB_Key_Space)
    shape(MouseX(),MouseY()) ;color one country
    ;shape2(MouseX(),MouseY()) ;color all the shapes   
    EndIf
    DisplayTransparentSprite(0,MouseX(),MouseY())
Until KeyboardReleased(#PB_Key_Escape)

It should work like this... I did my own procedure.
Just point the inside of the circle and press [space] (not outside, it's not bulletproof)
The Shape() procedure was my initial try. It filled the shape, but it was too slow.
The shape2() procedure is fast enought probably. Tell me with your planisphere if it's ok.
To know which country is selected, you can use the number of pixel in the perimeter (listsize(Cost()) in my exemple.
Cost() contain all the envelop of the country selected.
If you are lucky each country should have a different number of pixel. (you said your map is a high res one so...)
You, of course, will use the fill instruction to color your countries.


[Edit] you should use Shape() instead of Shape2(). It will store the point in cost(), then you just save them on disk. The procedure doesn't need to be light fast (it takes 350ms on my computer).
Shape2() is faster but it colors all the countries if they are linked, so there is no interest.

[Joubarbe]

Thank you for this

I'll take a closer look into the code tomorrow ! Now it's time for beer.

[Fig]

A non recursive algo find in Rosetta code: (slow)

Code: Select all

  Procedure Floodfill(x,y,new_color)
    old_color = Point(x,y)
    NewList stack.POINT()
    AddElement(stack()):stack()\x = x : stack()\y = y 
    While(LastElement(stack())) 
      x = stack()\x  : y = stack()\y  
      DeleteElement(stack()) 
      If Point(x,y) = old_color      
         Plot(x, y, new_color)  
         AddElement(stack()):stack()\x = x    : stack()\y = y +1
         AddElement(stack()):stack()\x = x    : stack()\y = y -1
         AddElement(stack()):stack()\x = x +1 : stack()\y = y 
         AddElement(stack()):stack()\x = x -1 : stack()\y = y   
      EndIf  
    Wend    
  EndProcedure
 
  If OpenWindow(0, 0, 0, 200, 200, "Floodfill Beispiel", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    StartDrawing(WindowOutput(0))
      Box(0, 0, 200, 200, RGB(255, 255, 255))
      DrawingMode(#PB_2DDrawing_Outlined )
      Circle(100, 100, 90, RGB(255 ,0,0)): Circle(120, 80, 30, RGB(255 ,0,0)): Circle(200,200, 70, RGB(255 ,0,0))
 
      Floodfill(40,40,RGB(0 ,255,0))
 
    StopDrawing()
    Repeat
      Event = WaitWindowEvent()
    Until Event = #PB_Event_CloseWindow
  EndIf

[Joubarbe]

And this to get pixels at the edge of the circle :

Code: Select all

Procedure Floodfill(x,y,new_color)
  old_color = Point(x,y)
  NewList stack.POINT()
  NewList border.Point()
  AddElement(stack()):stack()\x = x : stack()\y = y 
  While(LastElement(stack())) 
    x = stack()\x  : y = stack()\y  
    DeleteElement(stack()) 
    If Point(x,y) = old_color      
      Plot(x, y, new_color)  
      AddElement(stack()):stack()\x = x    : stack()\y = y +1
      AddElement(stack()):stack()\x = x    : stack()\y = y -1
      AddElement(stack()):stack()\x = x +1 : stack()\y = y 
      AddElement(stack()):stack()\x = x -1 : stack()\y = y   
    ElseIf Point(x,y) <> new_color  
      AddElement(border()) : border()\x = x : border()\y = y
    EndIf  
  Wend    
  ForEach border()
    Plot(border()\x, border()\y, RGB(0, 0, 255))
  Next
EndProcedure

Working with this technique have some problems. First, I don't really know how to stock my pixels, except in an external file where I'd note every x,y of every pixels. But my map is 9446*5391 and even though it's doable for small countries, painting Russia is taking too much time (and I don't talk about the size of the file). I guess there's a proper way to do that, like FillArea() (I don't understand how this is done instantly with this function).

Working with sprites seemed easier at first. I can easily color all countries instantly, highlight borders and detect a selection. However, some countries are too big to be manageable by only one sprite, and the zooming quality is not as good as my 2D map (without Screen), for which I've created 4 different pre-zoomed maps. And playing with more than 190 sprites to build a proper world map, scroll and zoom seems very complex.

Well... That's just my thought at the moment

[Fig]

I solved your problem here: http://www.purebasic.fr/english/viewtop ... 13&t=59723