PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Create a map 2D with PB

https://www.purebasic.fr/english/viewtopic.php?t=59723

Page 1 of 2

Create a map 2D with PB

Posted: Tue Jun 24, 2014 12:38 pm
by Kwai chang caine
Hello at all

I ask to me, if it's possible for a beginner like me, to create a simple map 2D with regions.
The difficult is that i need to can change coulours of each regions and draw bold line on the some existing dotted lines.
And if it's possible can manage events (Clic, DblClic) on each regions, after i need to print this map in A3 format paper

Image

The better would be, if i can zoom and move on it...but it's perhaps too much asking for little KCC :oops:

Can you give to me the way (I think to canvas) or other ideas ???
Perhaps start to an existing picture like above, find and write in a text file the position of each point (Line, color, etc...) and writing over ???

Thanks for your advices and your always splendid ideas :D

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 1:45 pm
by wilbert
Each region is a polygon so you need to define all those polygons in order to draw the map.
The easiest way to check for events is probably to draw two images. One the way it needs to look like the image shown and one with a distinct color for each region so you can check what region the mouse is over by checking the color at that point.

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 1:54 pm
by Kwai chang caine
Hello WILBERT 8)
Thanks for your advice.

It's possible to do that with windows and gadget ?? like canvas ?
I hope, i'm not forcing to use the drawing mode :cry:

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 2:31 pm
by marc_256
Hi Kwaï chang caïne,

What you can do,

1) make a list with 2D points on the map.
2) Select the points you need for one polygon.
and so on, 01...88 polygons.
so you have a perfect overlapping, and you can draw lines between these points.

marc,

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 2:42 pm
by Kwai chang caine
Hello Marc_256
Yes ...good idea !!
I think you say, i can make this list with my mouse on the map, each clic i write the coordinate !! :D
After for zooming, i multiply or divide by X :wink:

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 5:27 pm
by RASHAD
Hi KCC
All what you need is a solid colors map (BMP format)
Even will get the region number intact without any effort
jpg format will not fit remember that

Right click to change color

Code: Select all

CreateImage(0,203,203)
StartDrawing(ImageOutput(0))
    Box(0,0,203,203,#Black)
    Box(1,1,100,100,#White)
    Box(102,1,100,100,#Red)
    Box(1,102,100,100,#Green)
    Box(102,102,100,100,#Blue)
    DrawText(40,140,"17",#Black,#Green)
StopDrawing()


OpenWindow(0,0,0,220,220,"Test",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
CanvasGadget(1,10,10,203,203)
StartDrawing(CanvasOutput(1))
   DrawImage(ImageID(0),0,0)
StopDrawing()
SetWindowColor(0,#Gray)

While WindowEvent() : Wend
Repeat
           
  Select WaitWindowEvent()
      
      Case #PB_Event_CloseWindow
            Quit = 1
                  
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 1
                  Select EventType()
                       Case  #PB_EventType_MouseMove 
                       x =  GetGadgetAttribute(1,#PB_Canvas_MouseX)
                       y =  GetGadgetAttribute(1,#PB_Canvas_MouseY)
                       
                  Case #PB_EventType_RightClick
                      StartDrawing(CanvasOutput(1))
                             If Point(x,y) = #Red
                                 FillArea(x,y,-1,#White)
                             ElseIf Point(x,y) = #Blue
                                 FillArea(x,y,-1,#Yellow)
                             ElseIf Point(x,y) = #White
                                 FillArea(x,y,-1,#Red)
                             ElseIf Point(x,y) = #Yellow
                                 FillArea(x,y,-1,#Blue)
                             ElseIf Point(x,y) = #Green
                                 FillArea(x,y,-1,#White)
                            EndIf
                             
                      StopDrawing()
          
                  EndSelect
          EndSelect
          
  EndSelect 

Until Quit = 1
End

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 5:43 pm
by Kwai chang caine
Waouuuh !!!
This is the first stone of my "magic" map 8)

Thanks my favorite egyptian of all the world !!!! :P

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 9:43 pm
by Fig
F*ck !! Someone was faster than me !!!
I just finished mine...

Edit: In fact mine may be more usefull... :wink:
Each department is a sprite: you can rotate, zoom, scroll as you want !!
I vectorised the map and the data file is really precious.

The data file: http://wordoxhelper.free.fr/datadepartements.DAT
The program:

Code: Select all

If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitNetwork()=0:MessageRequester("Error","Error DirectX",0):EndIf

If OpenWindow(0,0,0,870,801, "pathfinding Cooperatif ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
    If OpenWindowedScreen(WindowID(0),0,0,870,801,0,0,0,#PB_Screen_NoSynchronization)=0
        MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
        End
    EndIf
EndIf
CreateSprite(200,20,20)
StartDrawing(SpriteOutput(200))
Box(0,0,20,20,#Red)
Box(1,1,20,20,#Black)
StopDrawing()
CreateSprite(201,1,1,#PB_Sprite_PixelCollision)
StartDrawing(SpriteOutput(201))
Plot(0,0,#White)
StopDrawing()
Structure xy
x.i
y.i
EndStructure
Structure dep
numero.i
barycentreX.i
barycentreY.i
xmin.i
ymin.i
Map vecteur.xy()
EndStructure

Global NewList departement.dep()

;charge les departements
If OpenFile(0,"datadepartements.DAT")
    While Eof(0)=0
        AddElement(departement())
        departement()\numero=Val(StringField(ReadString(0),2,": "))
        departement()\barycentreX=Val(StringField(ReadString(0),2,": "))
        departement()\barycentreY=Val(StringField(ReadString(0),2,": "))
        departement()\xmin=Val(StringField(ReadString(0),2,": "))
        departement()\ymin=Val(StringField(ReadString(0),2,": "))
        nb_vecteur.i=Val(StringField(ReadString(0),2,": "))
        xmin=870:ymin=801:xmax=0:ymax=0:a=0
        For i=1 To nb_vecteur
            a+1
            a$=StringField(ReadString(0),2,": ")
            b$=StringField(ReadString(0),2,": ")
            AddMapElement(departement()\vecteur(),a$+"/"+b$)
            departement()\vecteur()\x=Val(a$)
            If departement()\vecteur()\x>xmax:xmax=departement()\vecteur()\x:EndIf
            If departement()\vecteur()\x<xmin:xmin=departement()\vecteur()\x:EndIf
            departement()\vecteur()\y=Val(b$)
            If departement()\vecteur()\y>ymax:ymax=departement()\vecteur()\y:EndIf
            If departement()\vecteur()\y<ymin:ymin=departement()\vecteur()\y:EndIf
        Next
        Debug a
        Debug nb_vecteur
        If CreateSprite(departement()\numero,xmax-xmin+1,ymax-ymin+1,#PB_Sprite_PixelCollision)
        StartDrawing(SpriteOutput(departement()\numero))
            a=0
            ForEach departement()\vecteur()
            a+1
            Plot(departement()\vecteur()\x-xmin,departement()\vecteur()\y-ymin,#Red)
            Next
            Debug a
            FillArea(departement()\barycentreX-xmin-1,departement()\barycentreY-ymin,-1,#White)
        StopDrawing()
        EndIf
    Wend
EndIf



Repeat
WindowEvent()
FlipBuffers()
ClearScreen(#Blue)
ExamineKeyboard()
ExamineMouse()
x=MouseX():y=MouseY()
test_souris.i=-1
ForEach departement()
    DisplayTransparentSprite(departement()\numero,departement()\xmin,departement()\ymin)
    If SpritePixelCollision(201,x,y,departement()\numero,departement()\xmin,departement()\ymin)
        test_souris=ListIndex(departement())
    EndIf
Next
   If test_souris>-1
      SelectElement(departement(),test_souris)
      StartDrawing(ScreenOutput())
         FillArea(departement()\barycentreX,departement()\barycentreY,-1,#Green)
         DrawText(departement()\barycentreX,departement()\barycentreY,Str(departement()\numero))
      StopDrawing()
   EndIf

;display mouse sprite
DisplayTransparentSprite(200,x,y)

Until KeyboardPushed(#PB_Key_Escape)
Just run the program in the directory with the data file.

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 10:01 pm
by Fig
For the record,I used this map:
Image
And this program to vectorise the departments as you can see you can add every data you need to your file for each department.
In fact, this program can also vectorise any geometric figure as far as it's close.
[space] Enter a new department
[S] Save a data file
[escape] End the prog.

Code: Select all

If InitSprite() = 0 Or InitKeyboard()=0 Or InitMouse()=0 Or InitNetwork()=0:MessageRequester("Error","Error DirectX",0):EndIf

If OpenWindow(0,0,0,870,801, "p ", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget)
    If OpenWindowedScreen(WindowID(0),0,0,870,801,0,0,0,#PB_Screen_NoSynchronization)=0
        MessageRequester("Erreur", "Impossible d'ouvrir un écran dans la fenêtre!", 0)
        End
    EndIf
EndIf
CreateSprite(0,20,20)
StartDrawing(SpriteOutput(0))
Box(0,0,20,20,#Red)
Box(1,1,20,20,#Black)
StopDrawing()
LoadSprite(1,"France Map.bmp")
Structure xy
x.i
y.i
EndStructure
Structure dep
numero.i
barycentreX.i
barycentreY.i
xmin.i
ymin.i
Map vecteur.xy()
EndStructure

Global NewList departement.dep()

Procedure Find_limit(x.i,y.i,numero_departement.i)
    AddElement(departement())
    Dim carte.i(870,801)
    NewList fringe.xy()
    AddElement(fringe())
    fringe()\x=x
    fringe()\y=y
    carte(x,y)=1
    StartDrawing(SpriteOutput(1))
    couleur.i=Point(x,y)
    Repeat
        For i=-1 To 1
            For j=-1 To 1
                If i=0 And j=0:Continue:EndIf
                xx=fringe()\x+i:yy=fringe()\y+j
                If carte(xx,yy):Continue:EndIf
                carte(xx,yy)=1
                If Point(xx,yy)<>couleur
                    AddMapElement(departement()\vecteur(),Str(xx)+"/"+Str(yy))
                    departement()\vecteur()\x=xx:departement()\vecteur()\y=yy
                    Continue
                EndIf
                AddElement(fringe())
                fringe()\x=xx:fringe()\y=yy
                PreviousElement(fringe())
            Next j  
        Next i
        DeleteElement(fringe())
    Until FirstElement(fringe())=0
    StopDrawing()
    ;fringe red display
    StartDrawing(SpriteOutput(1))
    xb=0:yb=0:a=0:xmin=870:ymin=801
    ForEach departement()\vecteur()
        a+1
        If departement()\vecteur()\x<xmin:xmin=departement()\vecteur()\x:EndIf
        If departement()\vecteur()\y<ymin:ymin=departement()\vecteur()\y:EndIf
        Plot(departement()\vecteur()\x,departement()\vecteur()\y,#Red)
        xb=departement()\vecteur()\x+xb
        yb=departement()\vecteur()\y+yb
    Next
    Debug a
    departement()\xmin=xmin
    departement()\ymin=ymin
    ;barycentre
    xb=xb/MapSize(departement()\vecteur())
    yb=yb/MapSize(departement()\vecteur())-2
    FillArea(xb,yb,-1,#Black)
    StopDrawing()
    departement()\barycentreX=xb:departement()\barycentreY=yb
    departement()\numero=numero_departement
EndProcedure

Repeat
WindowEvent()
FlipBuffers()
ClearScreen(#Black)
ExamineKeyboard()
ExamineMouse()
x=MouseX():y=MouseY()
;display map
DisplaySprite(1,0,0)
StartDrawing(ScreenOutput())
ForEach departement()
    DrawText(departement()\barycentreX-7,departement()\barycentreY-5,Str(departement()\numero))
Next
StopDrawing()
;display mouse sprite
DisplayTransparentSprite(0,x,y)

If KeyboardReleased(#PB_Key_Space) ;And carte(x,y)=0
    ;input department number
    numero_departement.i=Val(InputRequester("Numero du département","entrez le numéro du département",""))
    find_limit(x,y,numero_departement)
EndIf
;sauvegarde
If KeyboardReleased(#PB_Key_S) And CreateFile(0,"datadepartements.DAT")
ForEach departement()
    WriteStringN(0,"Numero departement: "+Str(departement()\numero))
    WriteStringN(0,"Barycentre X: "+Str(departement()\barycentreX))
    WriteStringN(0,"Barycentre Y: "+Str(departement()\barycentreY))
    WriteStringN(0,"Pt haut gauche X: "+Str(departement()\xmin))
    WriteStringN(0,"Pt haut gauche Y: "+Str(departement()\ymin))
    WriteStringN(0,"NB vecteur: "+Str(MapSize(departement()\vecteur())))
    a=0
    ForEach departement()\vecteur()
    a+1
    WriteStringN(0,"PT"+Str(a)+" X: "+Str(departement()\vecteur()\x))
    WriteStringN(0,"PT"+Str(a)+" Y: "+Str(departement()\vecteur()\y))
    Next
    Debug a
Next
CloseFile(0)
EndIf

Until KeyboardPushed(#PB_Key_Escape)

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 10:34 pm
by falsam
Very nice Fig :)

Re: Create a map 2D with PB

Posted: Tue Jun 24, 2014 11:01 pm
by RASHAD
Thanks Fig for the very fine France Map
- Convert the gif format to bmp format as "France_Map.bmp"
- Run the following code from the same path
Have fun

Code: Select all


LoadImage(0,"France_Map.bmp")

OpenWindow(0,0,0,ImageWidth(0)+20,ImageHeight(0)+20,"Test", #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
CanvasGadget(0,10,10,ImageWidth(0),ImageHeight(0))
StartDrawing(CanvasOutput(0))
   DrawImage(ImageID(0),0,0)
StopDrawing()
SetWindowColor(0,#Gray)

While WindowEvent() : Wend
Repeat
           
  Select WaitWindowEvent()
     
      Case #PB_Event_CloseWindow
            Quit = 1
                 
      Case #PB_Event_Gadget
          Select EventGadget()
           Case 0
                  Select EventType()
                       Case  #PB_EventType_MouseMove
                       x =  GetGadgetAttribute(0,#PB_Canvas_MouseX)
                       y =  GetGadgetAttribute(0,#PB_Canvas_MouseY)
                       
                  Case #PB_EventType_RightClick
                     Color = ColorRequester()
                      StartDrawing(CanvasOutput(0))                                 
                                 FillArea(x,y,-1,Color)                             
                      StopDrawing()                      
        
                  EndSelect
          EndSelect
         
  EndSelect

Until Quit = 1
End

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 1:07 am
by skywalk
haha, nice examples Fig and RASHAD. :)

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 10:00 am
by Kwai chang caine
Image

What word can i say ...when i see that ....
Perhaps ...
MIIIIIIIIAAAAAAOOOOUUUUUUuuuuu !!!

One million of thanks to you FIG and RASHAD !!!!
Now it's not a stone on my project that you put....but a menhir !!!! :shock:
Image

When i see that, i say to me i'm the more happy "programmer" in the world, to have real friends like you all 8) 8)

Really the one thing who make me sad :cry: , it's not can make to you a runny kiss !!! :mrgreen:
Image

Again thanks, i wish you the better day of the world !!!!

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 10:28 am
by Fig
I answer your question that disappeared...

Well you can see the second prog i posted... It's in the procedure Find_limit().
I expand every pixels from the point of the mouse to the fringe of the department. When the fringe is reached, i save the coordonates in a map. (it prevents to add several time the same pixel)

Each department is listed in a linkedlist.(departement())
Each element of this list contain a map vecteur() which contains coordonates of the fringe departement()\vecteur()\x and departement()\vecteur()\y

It's not a real vectorisation as i don't convert the dots into lines (but i could, if you need)... But really, it's not necessary.

Re: Create a map 2D with PB

Posted: Wed Jun 25, 2014 10:36 am
by Kwai chang caine
In fact i have delete the question, because even if i'm accustomed to pass for a waffer, and even if everybody believe i do that specially :oops:
I try to not put too much stupid questions....
Apparently it's again a time missed :lol:

I have see your second code save the same "datadepartements.DAT" that the first code use.
So in my little head i say to me perhaps the second code create the "datadepartements.DAT" for the first ???
I have try and see all the departements selectionned is saved in the "datadepartements.DAT"

And justly, my second stupid question is how you select all the department for create this data ?? :oops: http://wordoxhelper.free.fr/datadepartements.DAT
And i have see your answer....

Cool, with KCC, the answer come before the question...it's not magical that ??? :mrgreen:
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited