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.
