PBMap - Cartes OSM, Here, Geoserver dans un Canvas

Programmation d'applications complexes
Avatar de l’utilisateur
falsam
Messages : 7317
Inscription : dim. 22/août/2010 15:24
Localisation : IDF (Yvelines)
Contact :

Re: OpenStreetMap dans un Canvas

Message par falsam »

Ou trouve t'on http.pbi ? ^^
Configuration : Windows 11 Famille 64-bit - PB 6.20 x64 - AMD Ryzen 7 - 16 GO RAM
Vidéo NVIDIA GeForce GTX 1650 Ti - Résolution 1920x1080 - Mise à l'échelle 125%
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Le chargement ne fonctionne pas trop mal, c'est sympa, ça fluidifie bien :)
Par contre j'ai toujours des problèmes de calcul avec le zoom et le proxy. Je te laisse mettre au propre la partie chargement et je ferai un mix après si tu veux.
ça marche je suis dessus ... Je te poste le code des que j'ai finis :wink:
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Le chargement ne fonctionne pas trop mal, c'est sympa, ça fluidifie bien :)
Par contre j'ai toujours des problèmes de calcul avec le zoom et le proxy. Je te laisse mettre au propre la partie chargement et je ferai un mix après si tu veux.
Bon voilà j'ai fait un peu de nettoyage et j'ai réécrit ma routine de chargement par Thread pour que ce soir plus claire ... :? (en espérant que ça le sera)

Code : Tout sélectionner

;************************************************************** 
; Program:           OSM (OpenStreetMap Module) 
; Author:            Thyphoon And Djes
; Date:              Mai 17, 2016
; License:           Free, unrestricted, credit appreciated 
;                    but not required.
; Note:              Please share improvement !
; Thanks:            Progi1984, 
;************************************************************** 

InitNetwork()

CompilerIf #PB_Compiler_Thread=0
  MessageRequester("Warning !!","You must to Enable 'create ThreadSafe' in compiler option",#PB_MessageRequester_Ok )
  End
CompilerEndIf 

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d, longitude.d, zoom = 15)
  Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
  Declare ConstructMap()
  Declare DrawMap()
EndDeclareModule

Module OSM
  #USEPROXY = #True
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY = #False
    IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf

 Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.d
    Y.d
  EndStructure
  
  Structure Pixel
    X.i
    Y.i
  EndStructure
  
  Structure ImgMemCach
  nImage.i
  Zoom.i
  XTile.i
  YTile.i
EndStructure

Structure TileMemCach
  List Image.ImgMemCach()
  Mutex.i
  Semaphore.i
EndStructure
  
  Structure OSM
    Gadget.i                                ; Canvas Gadget Id 
    TargetLocation.Location                 ; Latitude and Longitude from focus point
    TargetTile.tile                         ; Focus Tile coord
    
    Position.Pixel                          ; Focus Point coord in Pixel
    
    ServerURL.s                             ; Web Url ex: http://tile.openstreetmap.org/
    ZoomMin.i                               ; Min Zoom supported by Server
    ZoomMax.i                               ; Max Zoom supported by Server
    Zoom.i                                  ; Current Zoom
    TileSize.i                              ; Tile Size downloaded on the server ex : 256
    
    HDDCachePath.S                          ; path where to load an save tile downloaded from server
    MemCache.TileMemCach                 ; to know image always in memory
    List MapImageIndex.ImgMemCach()           ; List of Index from MemCache\Image() to construct map
    MapImageMutex.i                           ; Mutex to lock
    MapImageSemaphore.i                       ; Semaphore to control Thread
    
    
    StartCursor.Pixel                       ; coord from start drag the map
    DeltaCursor.Pixel                       ; delta from curent position and the start position
  EndStructure
  
  Global OSM.OSM
    
  Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
    If Gadget = #PB_Any
      OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    Else
      OSM\Gadget = Gadget
      CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    EndIf 
  EndProcedure
  
  Procedure LatLon2XY(*Location.Location, *Tile.Tile)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatRad.d = Radian(*Location\Latitude)
    *Tile\X = n * ( (*Location\Longitude + 180.0) / 360.0)
    *Tile\Y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
    Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
    Debug "Tile X : " + Str(*Tile\X) + " ; Tile Y : " + Str(*Tile\Y)
  EndProcedure
  
  Procedure XY2LatLon(*Tile.Tile, *Location.Location)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatitudeRad.d
    *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
    LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\Y / n)))
    *Location\Latitude = Degree(LatitudeRad)
  EndProcedure
  
  Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i,nImage.i)
    Protected Index.i
    If IsImage(nImage)
      LockMutex(OSM\MemCache\Mutex)
      ;We add To the List And load it
      FirstElement(OSM\MemCache\Image())
      AddElement(OSM\MemCache\Image())
      Index=ListIndex(OSM\MemCache\Image())
      OSM\MemCache\Image()\XTile=XTile
      OSM\MemCache\Image()\YTile=YTile
      OSM\MemCache\Image()\Zoom=Zoom
      OSM\MemCache\Image()\nImage=nImage  
      UnlockMutex(OSM\MemCache\Mutex)
      ProcedureReturn Index
    Else
      Debug "NO ADD TILE TO MEM CACHE BECAUSE BAD IMAGE"
    EndIf 
  EndProcedure
  
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  LockMutex(OSM\MemCache\Mutex)
  ;Check if we have this Image in Memory
  ForEach OSM\MemCache\Image()
    If Zoom=OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\XTile=XTile And OSM\MemCache\Image()\YTile=YTile
      nImage=OSM\MemCache\Image()\nImage
      Debug "Load From MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+" IsImage:"+Str(IsImage(nImage))
      
      Break;
    ElseIf Zoom<>OSM\MemCache\Image()\Zoom
      DeleteElement(OSM\MemCache\Image())
    EndIf 
  Next 
  UnlockMutex(OSM\MemCache\Mutex)
  ProcedureReturn nImage
EndProcedure

Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
  If FileSize(OSM\HDDCachePath + cacheFile) > 0
    nImage=LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
   
    If IsImage(nImage)
      Debug "Load From HDD Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+ "IsImage:"+Str(IsImage(nImage))
      AddTileToMemCache(Zoom, XTile, YTile,nImage)
      ProcedureReturn nImage
    EndIf 
    
    
  EndIf 
  ProcedureReturn #False
  EndProcedure
  
  Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
    Protected *Buffer
    Protected nImage.i
    Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
    Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
    ;Debug "DOWNLOAD : " + psURL
    CompilerIf #USEPROXY = #True
      Protected http.HTTP_Query
      HTTP_proxy(@http, "spxy.bpi.fr", 3128)
      HTTP_DownloadToMem(@http, TileURL)
      nImage=CatchImage(#PB_Any, http\data, MemorySize(http\data))
      If IsImage(nImage)
        AddTileToMemCache(Zoom, XTile, YTile,nImage)
        SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
        Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
      EndIf
    CompilerElse
      *Buffer = ReceiveHTTPMemory(TileURL)
      If *Buffer
        nImage=CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
        If IsImage(nImage)
          AddTileToMemCache(Zoom, XTile, YTile,nImage)
          SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
          Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
          FreeMemory(*Buffer)
        Else
          Debug "Can't catch image :" + TileURL
        EndIf
      Else
        Debug "Problem loading :" + TileURL
      EndIf
    CompilerEndIf
    
    ProcedureReturn nImage
  EndProcedure
  
  Procedure GetTile(Index.i)
    Protected Zoom.i, XTile.i, YTile.i
    LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    Zoom=OSM\MapImageIndex()\Zoom
    XTile=OSM\MapImageIndex()\XTile
    YTile=OSM\MapImageIndex()\YTile
    UnlockMutex(OSM\MapImageMutex)
    Protected nImage.i
    nImage=GetTileFromMem(Zoom, XTile, YTile)
    If nImage=0
      nImage=GetTileFromHDD(Zoom, XTile, YTile)
      If nImage=0
        nImage=GetTileFromWeb(Zoom, XTile, YTile)
        If nImage=0
          Debug "Error can't Load this Tile"
          ProcedureReturn #False
        EndIf
      EndIf
    EndIf 
   LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    OSM\MapImageIndex()\nImage=nImage
    UnlockMutex(OSM\MapImageMutex)
    SignalSemaphore(OSM\MapImageSemaphore)
  EndProcedure
  
  Procedure ConstructMap()
    Protected x.i, y.i
    Protected Index.i
    Protected mx.l = GadgetWidth(OSM\Gadget)
    Protected my.l = GadgetHeight(OSM\Gadget)
    Protected nx.i = mx/OSM\TileSize ;How many tiles
    Protected ny.i = my/OSM\TileSize
    mx/2 : my/2 ; Gadget center
    Protected tx.i = Int(OSM\TargetTile\X)
    Protected ty.i = Int(OSM\TargetTile\Y)
    LockMutex(OSM\MapImageMutex)
    ClearList(OSM\MapImageIndex())
    UnlockMutex(OSM\MapImageMutex)
   Debug ty + ny + ny - 1
    For y = ty - ny To ty + ny + ny - 1
      For x = tx - nx To tx + nx + nx - 1
        WaitSemaphore(OSM\MapImageSemaphore)
        LockMutex(OSM\MapImageMutex)
        LastElement(OSM\MapImageIndex())
        AddElement(OSM\MapImageIndex())
        Index=ListIndex(OSM\MapImageIndex())
        OSM\MapImageIndex()\XTile=x
        OSM\MapImageIndex()\YTile=y
        OSM\MapImageIndex()\Zoom=OSM\Zoom
        UnlockMutex(OSM\MapImageMutex)
        CreateThread(@GetTile(),Index)
      Next
    Next
  EndProcedure
  
 
  Procedure DrawMap()
    Protected x.i, y.i, nx.i, ny.i, mx.i, my.i, n.i = 0
    Protected deltaX.i, deltaY.i
    
    Protected nImage.i
    Protected x2.i, y2.i
    deltaX = OSM\TileSize*(OSM\TargetTile\X - Int(OSM\TargetTile\X))
    deltaY = OSM\TileSize*(OSM\TargetTile\Y - Int(OSM\TargetTile\Y))
    
    mx = GadgetWidth(OSM\Gadget)/2
    my = GadgetHeight(OSM\Gadget)/2
    
    nx = GadgetWidth(OSM\Gadget)/OSM\TileSize ;How many tiles
    ny = GadgetWidth(OSM\Gadget)/OSM\TileSize
    
    
    StartDrawing(CanvasOutput(OSM\Gadget))
    Box(0, 0, GadgetWidth(OSM\Gadget), GadgetHeight(OSM\Gadget), RGB(255, 255, 255))
    LockMutex(OSM\MapImageMutex)
    ResetList(OSM\MapImageIndex())
    For y = - ny To ny + ny - 1
      For x = - nx To nx + nx - 1
        If NextElement(OSM\MapImageIndex())
          
          x2 = x*256 + OSM\DeltaCursor\X   + mx -deltaX
          y2 = y*256 + OSM\DeltaCursor\Y   + my - deltaY
          nImage=OSM\MapImageIndex()\nImage
          If nimage=0
            DrawText( x2, y2+20, "Loading")
            
          ElseIf IsImage(nImage) And (x2 + 256) > 0 And (y2 + 256) > 0 And x2 < GadgetWidth(OSM\Gadget) And y2 < GadgetHeight(OSM\Gadget)
            
            DrawImage(ImageID(nImage), x2,y2, 254, 254)
            DrawText( x2, y2, Str(x) + ", " + Str(y))
          Else
            DrawText( x2, y2+20, "Error to Display Image")
          EndIf       
          
          n = n + 1
        Else
          Debug" ERROR"
          Break 2
        EndIf 
      Next
    Next
    UnlockMutex(OSM\MapImageMutex)
    Circle(GadgetWidth(OSM\Gadget)/2, GadgetHeight(OSM\Gadget)/2, 5, RGB(Random(255),Random(255),Random(255)))
    ;DrawText(0, 0, "DeltaCursorX : " + Str(OSM\DeltaCursor\X) + " deltaX : " + Str(deltaX) + " Tile X : " + StrD(OSM\TargetTile\X))
    DrawText(0, 16, Str(OSM\TargetTile\X + OSM\DeltaCursor\X) + " " + Str(OSM\TargetTile\Y + OSM\DeltaCursor\Y))
    StopDrawing()
  EndProcedure
  
  Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
    If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
    If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
    OSM\Zoom = zoom
    OSM\TargetLocation\Latitude = latitude
    OSM\TargetLocation\Longitude = longitude
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
  EndProcedure
  
  
  Procedure TileTranslate(*Tile.Tile, tx.d, ty.d)
    Debug " - move - "
    
    Protected pfValue.d
    If tx <> 0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
        
      EndIf
    EndIf
    
    If ty <> 0
      pfValue = *Tile\Y - ty
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
        
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
    Select mode
      Case #PB_Relative
        OSM\Zoom = OSM\Zoom + zoom
      Case #PB_Absolute
        OSM\Zoom = zoom
    EndSelect
    If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
    If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
    ConstructMap()
    DrawMap()
  EndProcedure
  
  Procedure InitOSM()
    Debug GetTemporaryDirectory()
    OSM\HDDCachePath = GetTemporaryDirectory()
    OSM\ServerURL = "http://tile.openstreetmap.org/"
    OSM\ZoomMin = 0
    OSM\ZoomMax = 18
    OSM\StartCursor\X = - 1
    OSM\TileSize = 256
    OSM\MemCache\Mutex=CreateMutex()
    ;OSM\MemCache\Semaphore=CreateSemaphore(1)
    OSM\MapImageMutex=CreateMutex()
    OSM\MapImageSemaphore=CreateSemaphore(8)
  EndProcedure
  
  Procedure Event(Event.l)
    Protected Gadget.i
    Protected tx.d, ty.d
    Protected OldX.i, OldY.i
    If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas 
      Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) 
                  OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) 
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>-1
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  tx=(OSM\DeltaCursor\X/256)
                  ty=(OSM\DeltaCursor\Y/256)
                  OSM\DeltaCursor\X=0
                  OSM\DeltaCursor\Y=0
                  OSM\StartCursor\X=-1
                  TileTranslate(@OSM\TargetTile,tx,ty)
                  XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                  ConstructMap()
              EndSelect
          EndSelect
          DrawMap()
      EndSelect
    Else
      MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
      End
    EndIf  
  EndProcedure
EndModule

Enumeration
  #Window_0
  #Map
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Combo_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #String_0
  #String_1
EndEnumeration

;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
  
  OSM::InitOSM()
  LoadFont(0, "Wingdings", 12)
  LoadFont(1, "Arial", 12, #PB_Font_Bold)
  
  OSM::OSMGadget(#Map, 10, 10, 512, 512)
  
  TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
  ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
  ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
  ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
  ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
  TextGadget(#Text_2, 530, 160, 60, 15, "Zoom : ")
  ButtonGadget(#Button_4, 550, 180, 50, 30, " + ")      : SetGadgetFont(#Button_4, FontID(1)) 
  ButtonGadget(#Button_5, 600, 180, 50, 30, " - ")      : SetGadgetFont(#Button_5, FontID(1)) 
  TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
  StringGadget(#String_0, 600, 230, 90, 20, "")
  TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
  StringGadget(#String_1, 600, 250, 90, 20, "")
  
  Define Event.i, Gadget.i, Quit.b = #False
  Define pfValue.d
  OSM::SetLocation(49.04599, 2.03347, 17)
  OSM::ConstructMap()
  OSM::DrawMap()
  ;OSM::SetLocation(49.0361165, 2.0456982)
  
  Repeat
    Event = WaitWindowEvent()
    
    OSM::Event(Event)
    Select Event
      Case #PB_Event_CloseWindow : Quit = 1
      Case #PB_Event_Gadget ;{
        Gadget = EventGadget()
        Select Gadget
          Case #Button_4
            OSM::SetZoom(1)
          Case #Button_5
            OSM::SetZoom( - 1)
        EndSelect
    EndSelect
  Until Quit = #True
EndIf
  
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Le chargement ne fonctionne pas trop mal, c'est sympa, ça fluidifie bien :)
Par contre j'ai toujours des problèmes de calcul avec le zoom et le proxy. Je te laisse mettre au propre la partie chargement et je ferai un mix après si tu veux.
Bon voilà j'ai fait un peu de nettoyage et j'ai réécrit ma routine de chargement par Thread pour que ce soir plus claire ... :? (en espérant que ça le sera)

Code : Tout sélectionner

;************************************************************** 
; Program:           OSM (OpenStreetMap Module) 
; Author:            Thyphoon And Djes
; Date:              Mai 17, 2016
; License:           Free, unrestricted, credit appreciated 
;                    but not required.
; Note:              Please share improvement !
; Thanks:            Progi1984, 
;************************************************************** 

InitNetwork()

CompilerIf #PB_Compiler_Thread=0
  MessageRequester("Warning !!","You must to Enable 'create ThreadSafe' in compiler option",#PB_MessageRequester_Ok )
  End
CompilerEndIf 

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d, longitude.d, zoom = 15)
  Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
  Declare ConstructMap()
  Declare DrawMap()
EndDeclareModule

Module OSM
  #USEPROXY = #True
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY = #False
    IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf

 Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.d
    Y.d
  EndStructure
  
  Structure Pixel
    X.i
    Y.i
  EndStructure
  
  Structure ImgMemCach
  nImage.i
  Zoom.i
  XTile.i
  YTile.i
EndStructure

Structure TileMemCach
  List Image.ImgMemCach()
  Mutex.i
  Semaphore.i
EndStructure
  
  Structure OSM
    Gadget.i                                ; Canvas Gadget Id 
    TargetLocation.Location                 ; Latitude and Longitude from focus point
    TargetTile.tile                         ; Focus Tile coord
    
    Position.Pixel                          ; Focus Point coord in Pixel
    
    ServerURL.s                             ; Web Url ex: http://tile.openstreetmap.org/
    ZoomMin.i                               ; Min Zoom supported by Server
    ZoomMax.i                               ; Max Zoom supported by Server
    Zoom.i                                  ; Current Zoom
    TileSize.i                              ; Tile Size downloaded on the server ex : 256
    
    HDDCachePath.S                          ; path where to load an save tile downloaded from server
    MemCache.TileMemCach                 ; to know image always in memory
    List MapImageIndex.ImgMemCach()           ; List of Index from MemCache\Image() to construct map
    MapImageMutex.i                           ; Mutex to lock
    MapImageSemaphore.i                       ; Semaphore to control Thread
    
    
    StartCursor.Pixel                       ; coord from start drag the map
    DeltaCursor.Pixel                       ; delta from curent position and the start position
  EndStructure
  
  Global OSM.OSM
    
  Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
    If Gadget = #PB_Any
      OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    Else
      OSM\Gadget = Gadget
      CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    EndIf 
  EndProcedure
  
  Procedure LatLon2XY(*Location.Location, *Tile.Tile)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatRad.d = Radian(*Location\Latitude)
    *Tile\X = n * ( (*Location\Longitude + 180.0) / 360.0)
    *Tile\Y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
    Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
    Debug "Tile X : " + Str(*Tile\X) + " ; Tile Y : " + Str(*Tile\Y)
  EndProcedure
  
  Procedure XY2LatLon(*Tile.Tile, *Location.Location)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatitudeRad.d
    *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
    LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\Y / n)))
    *Location\Latitude = Degree(LatitudeRad)
  EndProcedure
  
  Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i,nImage.i)
    Protected Index.i
    If IsImage(nImage)
      LockMutex(OSM\MemCache\Mutex)
      ;We add To the List And load it
      FirstElement(OSM\MemCache\Image())
      AddElement(OSM\MemCache\Image())
      Index=ListIndex(OSM\MemCache\Image())
      OSM\MemCache\Image()\XTile=XTile
      OSM\MemCache\Image()\YTile=YTile
      OSM\MemCache\Image()\Zoom=Zoom
      OSM\MemCache\Image()\nImage=nImage  
      UnlockMutex(OSM\MemCache\Mutex)
      ProcedureReturn Index
    Else
      Debug "NO ADD TILE TO MEM CACHE BECAUSE BAD IMAGE"
    EndIf 
  EndProcedure
  
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  LockMutex(OSM\MemCache\Mutex)
  ;Check if we have this Image in Memory
  ForEach OSM\MemCache\Image()
    If Zoom=OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\XTile=XTile And OSM\MemCache\Image()\YTile=YTile
      nImage=OSM\MemCache\Image()\nImage
      Debug "Load From MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+" IsImage:"+Str(IsImage(nImage))
      
      Break;
    ElseIf Zoom<>OSM\MemCache\Image()\Zoom
      DeleteElement(OSM\MemCache\Image())
    EndIf 
  Next 
  UnlockMutex(OSM\MemCache\Mutex)
  ProcedureReturn nImage
EndProcedure

Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
  If FileSize(OSM\HDDCachePath + cacheFile) > 0
    nImage=LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
   
    If IsImage(nImage)
      Debug "Load From HDD Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+ "IsImage:"+Str(IsImage(nImage))
      AddTileToMemCache(Zoom, XTile, YTile,nImage)
      ProcedureReturn nImage
    EndIf 
    
    
  EndIf 
  ProcedureReturn #False
  EndProcedure
  
  Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
    Protected *Buffer
    Protected nImage.i
    Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
    Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
    ;Debug "DOWNLOAD : " + psURL
    CompilerIf #USEPROXY = #True
      Protected http.HTTP_Query
      HTTP_proxy(@http, "spxy.bpi.fr", 3128)
      HTTP_DownloadToMem(@http, TileURL)
      nImage=CatchImage(#PB_Any, http\data, MemorySize(http\data))
      If IsImage(nImage)
        AddTileToMemCache(Zoom, XTile, YTile,nImage)
        SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
        Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
      EndIf
    CompilerElse
      *Buffer = ReceiveHTTPMemory(TileURL)
      If *Buffer
        nImage=CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
        If IsImage(nImage)
          AddTileToMemCache(Zoom, XTile, YTile,nImage)
          SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
          Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
          FreeMemory(*Buffer)
        Else
          Debug "Can't catch image :" + TileURL
        EndIf
      Else
        Debug "Problem loading :" + TileURL
      EndIf
    CompilerEndIf
    
    ProcedureReturn nImage
  EndProcedure
  
  Procedure GetTile(Index.i)
    Protected Zoom.i, XTile.i, YTile.i
    LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    Zoom=OSM\MapImageIndex()\Zoom
    XTile=OSM\MapImageIndex()\XTile
    YTile=OSM\MapImageIndex()\YTile
    UnlockMutex(OSM\MapImageMutex)
    Protected nImage.i
    nImage=GetTileFromMem(Zoom, XTile, YTile)
    If nImage=0
      nImage=GetTileFromHDD(Zoom, XTile, YTile)
      If nImage=0
        nImage=GetTileFromWeb(Zoom, XTile, YTile)
        If nImage=0
          Debug "Error can't Load this Tile"
          ProcedureReturn #False
        EndIf
      EndIf
    EndIf 
   LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    OSM\MapImageIndex()\nImage=nImage
    UnlockMutex(OSM\MapImageMutex)
    SignalSemaphore(OSM\MapImageSemaphore)
  EndProcedure
  
  Procedure ConstructMap()
    Protected x.i, y.i
    Protected Index.i
    Protected mx.l = GadgetWidth(OSM\Gadget)
    Protected my.l = GadgetHeight(OSM\Gadget)
    Protected nx.i = mx/OSM\TileSize ;How many tiles
    Protected ny.i = my/OSM\TileSize
    mx/2 : my/2 ; Gadget center
    Protected tx.i = Int(OSM\TargetTile\X)
    Protected ty.i = Int(OSM\TargetTile\Y)
    LockMutex(OSM\MapImageMutex)
    ClearList(OSM\MapImageIndex())
    UnlockMutex(OSM\MapImageMutex)
   Debug ty + ny + ny - 1
    For y = ty - ny To ty + ny + ny - 1
      For x = tx - nx To tx + nx + nx - 1
        WaitSemaphore(OSM\MapImageSemaphore)
        LockMutex(OSM\MapImageMutex)
        LastElement(OSM\MapImageIndex())
        AddElement(OSM\MapImageIndex())
        Index=ListIndex(OSM\MapImageIndex())
        OSM\MapImageIndex()\XTile=x
        OSM\MapImageIndex()\YTile=y
        OSM\MapImageIndex()\Zoom=OSM\Zoom
        UnlockMutex(OSM\MapImageMutex)
        CreateThread(@GetTile(),Index)
      Next
    Next
  EndProcedure
  
 
  Procedure DrawMap()
    Protected x.i, y.i, nx.i, ny.i, mx.i, my.i, n.i = 0
    Protected deltaX.i, deltaY.i
    
    Protected nImage.i
    Protected x2.i, y2.i
    deltaX = OSM\TileSize*(OSM\TargetTile\X - Int(OSM\TargetTile\X))
    deltaY = OSM\TileSize*(OSM\TargetTile\Y - Int(OSM\TargetTile\Y))
    
    mx = GadgetWidth(OSM\Gadget)/2
    my = GadgetHeight(OSM\Gadget)/2
    
    nx = GadgetWidth(OSM\Gadget)/OSM\TileSize ;How many tiles
    ny = GadgetWidth(OSM\Gadget)/OSM\TileSize
    
    
    StartDrawing(CanvasOutput(OSM\Gadget))
    Box(0, 0, GadgetWidth(OSM\Gadget), GadgetHeight(OSM\Gadget), RGB(255, 255, 255))
    LockMutex(OSM\MapImageMutex)
    ResetList(OSM\MapImageIndex())
    For y = - ny To ny + ny - 1
      For x = - nx To nx + nx - 1
        If NextElement(OSM\MapImageIndex())
          
          x2 = x*256 + OSM\DeltaCursor\X   + mx -deltaX
          y2 = y*256 + OSM\DeltaCursor\Y   + my - deltaY
          nImage=OSM\MapImageIndex()\nImage
          If nimage=0
            DrawText( x2, y2+20, "Loading")
            
          ElseIf IsImage(nImage) And (x2 + 256) > 0 And (y2 + 256) > 0 And x2 < GadgetWidth(OSM\Gadget) And y2 < GadgetHeight(OSM\Gadget)
            
            DrawImage(ImageID(nImage), x2,y2, 254, 254)
            DrawText( x2, y2, Str(x) + ", " + Str(y))
          Else
            DrawText( x2, y2+20, "Error to Display Image")
          EndIf       
          
          n = n + 1
        Else
          Debug" ERROR"
          Break 2
        EndIf 
      Next
    Next
    UnlockMutex(OSM\MapImageMutex)
    Circle(GadgetWidth(OSM\Gadget)/2, GadgetHeight(OSM\Gadget)/2, 5, RGB(Random(255),Random(255),Random(255)))
    ;DrawText(0, 0, "DeltaCursorX : " + Str(OSM\DeltaCursor\X) + " deltaX : " + Str(deltaX) + " Tile X : " + StrD(OSM\TargetTile\X))
    DrawText(0, 16, Str(OSM\TargetTile\X + OSM\DeltaCursor\X) + " " + Str(OSM\TargetTile\Y + OSM\DeltaCursor\Y))
    StopDrawing()
  EndProcedure
  
  Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
    If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
    If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
    OSM\Zoom = zoom
    OSM\TargetLocation\Latitude = latitude
    OSM\TargetLocation\Longitude = longitude
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
  EndProcedure
  
  
  Procedure TileTranslate(*Tile.Tile, tx.d, ty.d)
    Debug " - move - "
    
    Protected pfValue.d
    If tx <> 0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
        
      EndIf
    EndIf
    
    If ty <> 0
      pfValue = *Tile\Y - ty
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
        
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
    Select mode
      Case #PB_Relative
        OSM\Zoom = OSM\Zoom + zoom
      Case #PB_Absolute
        OSM\Zoom = zoom
    EndSelect
    If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
    If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
    ConstructMap()
    DrawMap()
  EndProcedure
  
  Procedure InitOSM()
    Debug GetTemporaryDirectory()
    OSM\HDDCachePath = GetTemporaryDirectory()
    OSM\ServerURL = "http://tile.openstreetmap.org/"
    OSM\ZoomMin = 0
    OSM\ZoomMax = 18
    OSM\StartCursor\X = - 1
    OSM\TileSize = 256
    OSM\MemCache\Mutex=CreateMutex()
    ;OSM\MemCache\Semaphore=CreateSemaphore(1)
    OSM\MapImageMutex=CreateMutex()
    OSM\MapImageSemaphore=CreateSemaphore(8)
  EndProcedure
  
  Procedure Event(Event.l)
    Protected Gadget.i
    Protected tx.d, ty.d
    Protected OldX.i, OldY.i
    If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas 
      Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) 
                  OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) 
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>-1
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  tx=(OSM\DeltaCursor\X/256)
                  ty=(OSM\DeltaCursor\Y/256)
                  OSM\DeltaCursor\X=0
                  OSM\DeltaCursor\Y=0
                  OSM\StartCursor\X=-1
                  TileTranslate(@OSM\TargetTile,tx,ty)
                  XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                  ConstructMap()
              EndSelect
          EndSelect
          DrawMap()
      EndSelect
    Else
      MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
      End
    EndIf  
  EndProcedure
EndModule

Enumeration
  #Window_0
  #Map
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Combo_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #String_0
  #String_1
EndEnumeration

;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
  
  OSM::InitOSM()
  LoadFont(0, "Wingdings", 12)
  LoadFont(1, "Arial", 12, #PB_Font_Bold)
  
  OSM::OSMGadget(#Map, 10, 10, 512, 512)
  
  TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
  ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
  ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
  ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
  ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
  TextGadget(#Text_2, 530, 160, 60, 15, "Zoom : ")
  ButtonGadget(#Button_4, 550, 180, 50, 30, " + ")      : SetGadgetFont(#Button_4, FontID(1)) 
  ButtonGadget(#Button_5, 600, 180, 50, 30, " - ")      : SetGadgetFont(#Button_5, FontID(1)) 
  TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
  StringGadget(#String_0, 600, 230, 90, 20, "")
  TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
  StringGadget(#String_1, 600, 250, 90, 20, "")
  
  Define Event.i, Gadget.i, Quit.b = #False
  Define pfValue.d
  OSM::SetLocation(49.04599, 2.03347, 17)
  OSM::ConstructMap()
  OSM::DrawMap()
  ;OSM::SetLocation(49.0361165, 2.0456982)
  
  Repeat
    Event = WaitWindowEvent()
    
    OSM::Event(Event)
    Select Event
      Case #PB_Event_CloseWindow : Quit = 1
      Case #PB_Event_Gadget ;{
        Gadget = EventGadget()
        Select Gadget
          Case #Button_4
            OSM::SetZoom(1)
          Case #Button_5
            OSM::SetZoom( - 1)
        EndSelect
    EndSelect
  Until Quit = #True
EndIf
  
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Yeah, le zoom fonctionne maintenant, et ça tourne bien ! :)
Par contre j'ai un plantage dès que je vais un peu loin. Je vais regarder (enfin, demain), c'est mon tour :)
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

J'ai l'impression que le zoom et le deplacement marche bien chez moi. ça donne quoi chez toi ?

Code : Tout sélectionner

;************************************************************** 
; Program:           OSM (OpenStreetMap Module) 
; Author:            Thyphoon And Djes
; Date:              Mai 17, 2016
; License:           Free, unrestricted, credit appreciated 
;                    but not required.
; Note:              Please share improvement !
; Thanks:            Progi1984, 
;************************************************************** 

InitNetwork()

CompilerIf #PB_Compiler_Thread=0
  MessageRequester("Warning !!","You must to Enable 'create ThreadSafe' in compiler option",#PB_MessageRequester_Ok )
  End
CompilerEndIf 

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d, longitude.d, zoom = 15)
  Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
  Declare ConstructMap()
  Declare DrawMap()
EndDeclareModule

Module OSM
  #USEPROXY = #True
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY = #True
    IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf

 Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.d
    Y.d
  EndStructure
  
  Structure Pixel
    X.i
    Y.i
  EndStructure
  
  Structure ImgMemCach
  nImage.i
  Zoom.i
  XTile.i
  YTile.i
EndStructure

Structure TileMemCach
  List Image.ImgMemCach()
  Mutex.i
  Semaphore.i
EndStructure
  
  Structure OSM
    Gadget.i                                ; Canvas Gadget Id 
    TargetLocation.Location                 ; Latitude and Longitude from focus point
    TargetTile.tile                         ; Focus Tile coord
    
    Position.Pixel                          ; Focus Point coord in Pixel
    
    ServerURL.s                             ; Web Url ex: http://tile.openstreetmap.org/
    ZoomMin.i                               ; Min Zoom supported by Server
    ZoomMax.i                               ; Max Zoom supported by Server
    Zoom.i                                  ; Current Zoom
    TileSize.i                              ; Tile Size downloaded on the server ex : 256
    
    HDDCachePath.S                          ; path where to load an save tile downloaded from server
    MemCache.TileMemCach                 ; to know image always in memory
    List MapImageIndex.ImgMemCach()           ; List of Index from MemCache\Image() to construct map
    MapImageMutex.i                           ; Mutex to lock
    MapImageSemaphore.i                       ; Semaphore to control Thread
    
    
    StartCursor.Pixel                       ; coord from start drag the map
    DeltaCursor.Pixel                       ; delta from curent position and the start position
  EndStructure
  
  Global OSM.OSM
    
  Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
    If Gadget = #PB_Any
      OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    Else
      OSM\Gadget = Gadget
      CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    EndIf 
  EndProcedure
  
  Procedure LatLon2XY(*Location.Location, *Tile.Tile)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatRad.d = Radian(*Location\Latitude)
    *Tile\X = n * ( (*Location\Longitude + 180.0) / 360.0)
    *Tile\Y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
    Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
    Debug "Tile X : " + Str(*Tile\X) + " ; Tile Y : " + Str(*Tile\Y)
  EndProcedure
  
  Procedure XY2LatLon(*Tile.Tile, *Location.Location)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatitudeRad.d
    *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
    LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\Y / n)))
    *Location\Latitude = Degree(LatitudeRad)
  EndProcedure
  
  Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i,nImage.i)
    Protected Index.i
    If IsImage(nImage)
      LockMutex(OSM\MemCache\Mutex)
      ;We add To the List And load it
      FirstElement(OSM\MemCache\Image())
      AddElement(OSM\MemCache\Image())
      Index=ListIndex(OSM\MemCache\Image())
      OSM\MemCache\Image()\XTile=XTile
      OSM\MemCache\Image()\YTile=YTile
      OSM\MemCache\Image()\Zoom=Zoom
      OSM\MemCache\Image()\nImage=nImage  
      UnlockMutex(OSM\MemCache\Mutex)
      ProcedureReturn Index
    Else
      Debug "NO ADD TILE TO MEM CACHE BECAUSE BAD IMAGE"
    EndIf 
  EndProcedure
  
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  LockMutex(OSM\MemCache\Mutex)
  ;Check if we have this Image in Memory
  ForEach OSM\MemCache\Image()
    If Zoom=OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\XTile=XTile And OSM\MemCache\Image()\YTile=YTile
      nImage=OSM\MemCache\Image()\nImage
      Debug "Load From MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+" IsImage:"+Str(IsImage(nImage))
      
      Break;
    ElseIf Zoom<>OSM\MemCache\Image()\Zoom
      DeleteElement(OSM\MemCache\Image())
    EndIf 
  Next 
  UnlockMutex(OSM\MemCache\Mutex)
  ProcedureReturn nImage
EndProcedure

Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
  If FileSize(OSM\HDDCachePath + cacheFile) > 0
    nImage=LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
   
    If IsImage(nImage)
      Debug "Load From HDD Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+ "IsImage:"+Str(IsImage(nImage))
      AddTileToMemCache(Zoom, XTile, YTile,nImage)
      ProcedureReturn nImage
    EndIf 
    
    
  EndIf 
  ProcedureReturn #False
  EndProcedure
  
  Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
    Protected *Buffer
    Protected nImage.i
    Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
    Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
    ;Debug "DOWNLOAD : " + psURL
    CompilerIf #USEPROXY = #True
      Protected http.HTTP_Query
      HTTP_proxy(@http, "spxy.bpi.fr", 3128)
      HTTP_DownloadToMem(@http, TileURL)
      nImage=CatchImage(#PB_Any, http\data, MemorySize(http\data))
      If IsImage(nImage)
        AddTileToMemCache(Zoom, XTile, YTile,nImage)
        SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
        Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
      EndIf
    CompilerElse
      *Buffer = ReceiveHTTPMemory(TileURL)
      If *Buffer
        nImage=CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
        If IsImage(nImage)
          AddTileToMemCache(Zoom, XTile, YTile,nImage)
          SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
          Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
          FreeMemory(*Buffer)
        Else
          Debug "Can't catch image :" + TileURL
        EndIf
      Else
        Debug "Problem loading :" + TileURL
      EndIf
    CompilerEndIf
    
    ProcedureReturn nImage
  EndProcedure
  
  Procedure GetTile(Index.i)
    Protected Zoom.i, XTile.i, YTile.i
    LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    Zoom=OSM\MapImageIndex()\Zoom
    XTile=OSM\MapImageIndex()\XTile
    YTile=OSM\MapImageIndex()\YTile
    UnlockMutex(OSM\MapImageMutex)
    Protected nImage.i
    nImage=GetTileFromMem(Zoom, XTile, YTile)
    If nImage=0
      nImage=GetTileFromHDD(Zoom, XTile, YTile)
      If nImage=0
        nImage=GetTileFromWeb(Zoom, XTile, YTile)
        If nImage=0
          Debug "Error can't Load this Tile"
          ProcedureReturn #False
        EndIf
      EndIf
    EndIf 
   LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    OSM\MapImageIndex()\nImage=nImage
    UnlockMutex(OSM\MapImageMutex)
    SignalSemaphore(OSM\MapImageSemaphore)
  EndProcedure
  
  Procedure ThreadConstructMap(z.i)
    Protected x.i, y.i
    Protected Index.i
    Protected mx.l = GadgetWidth(OSM\Gadget)
    Protected my.l = GadgetHeight(OSM\Gadget)
    Protected nx.i = mx/OSM\TileSize ;How many tiles
    Protected ny.i = my/OSM\TileSize
    mx/2 : my/2 ; Gadget center
    Protected tx.i = Int(OSM\TargetTile\X)
    Protected ty.i = Int(OSM\TargetTile\Y)
    LockMutex(OSM\MapImageMutex)
    ClearList(OSM\MapImageIndex())
    UnlockMutex(OSM\MapImageMutex)
   Debug ty + ny + ny - 1
    For y = ty - ny To ty + ny + ny - 1
      For x = tx - nx To tx + nx + nx - 1
        WaitSemaphore(OSM\MapImageSemaphore)
        LockMutex(OSM\MapImageMutex)
        LastElement(OSM\MapImageIndex())
        AddElement(OSM\MapImageIndex())
        Index=ListIndex(OSM\MapImageIndex())
        OSM\MapImageIndex()\XTile=x
        OSM\MapImageIndex()\YTile=y
        OSM\MapImageIndex()\Zoom=OSM\Zoom
        UnlockMutex(OSM\MapImageMutex)
        CreateThread(@GetTile(),Index)
      Next
    Next
  EndProcedure
  
  Procedure ConstructMap()
      CreateThread(@ThreadConstructMap(),0)
  EndProcedure
 
  Procedure DrawMap()
    Protected x.i, y.i, nx.i, ny.i, mx.i, my.i, n.i = 0
    Protected deltaX.i, deltaY.i
    
    Protected nImage.i
    Protected x2.i, y2.i
    deltaX = OSM\TileSize*(OSM\TargetTile\X - Int(OSM\TargetTile\X))
    deltaY = OSM\TileSize*(OSM\TargetTile\Y - Int(OSM\TargetTile\Y))
    
    mx = GadgetWidth(OSM\Gadget)/2
    my = GadgetHeight(OSM\Gadget)/2
    
    nx = GadgetWidth(OSM\Gadget)/OSM\TileSize ;How many tiles
    ny = GadgetWidth(OSM\Gadget)/OSM\TileSize
    
    
    StartDrawing(CanvasOutput(OSM\Gadget))
    Box(0, 0, GadgetWidth(OSM\Gadget), GadgetHeight(OSM\Gadget), RGB(255, 255, 255))
    LockMutex(OSM\MapImageMutex)
    ResetList(OSM\MapImageIndex())
    For y = - ny To ny + ny - 1
      For x = - nx To nx + nx - 1
        If NextElement(OSM\MapImageIndex())
          
          x2 = x*256 + OSM\DeltaCursor\X   + mx -deltaX
          y2 = y*256 + OSM\DeltaCursor\Y   + my - deltaY
          nImage=OSM\MapImageIndex()\nImage
          If nimage=0
            DrawText( x2, y2+20, "Loading")
            
          ElseIf IsImage(nImage) And (x2 + 256) > 0 And (y2 + 256) > 0 And x2 < GadgetWidth(OSM\Gadget) And y2 < GadgetHeight(OSM\Gadget)
            
            DrawImage(ImageID(nImage), x2,y2, 254, 254)
            DrawText( x2, y2, Str(x) + ", " + Str(y))
          Else
            DrawText( x2, y2+20, "Error to Display Image")
          EndIf       
          
          n = n + 1
        Else
          Debug" ERROR"
          Break 2
        EndIf 
      Next
    Next
    UnlockMutex(OSM\MapImageMutex)
    Circle(GadgetWidth(OSM\Gadget)/2, GadgetHeight(OSM\Gadget)/2, 5, RGB(Random(255),Random(255),Random(255)))
    ;DrawText(0, 0, "DeltaCursorX : " + Str(OSM\DeltaCursor\X) + " deltaX : " + Str(deltaX) + " Tile X : " + StrD(OSM\TargetTile\X))
    DrawText(0, 16, Str(OSM\TargetTile\X + OSM\DeltaCursor\X) + " " + Str(OSM\TargetTile\Y + OSM\DeltaCursor\Y))
    StopDrawing()
  EndProcedure
  
  Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
    If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
    If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
    OSM\Zoom = zoom
    OSM\TargetLocation\Latitude = latitude
    OSM\TargetLocation\Longitude = longitude
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
  EndProcedure
  
  
  Procedure TileTranslate(*Tile.Tile, tx.d, ty.d)
    Debug " - move - "
    
    Protected pfValue.d
    If tx <> 0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
        
      EndIf
    EndIf
    
    If ty <> 0
      pfValue = *Tile\Y - ty
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
        
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
    Select mode
      Case #PB_Relative
        OSM\Zoom = OSM\Zoom + zoom
      Case #PB_Absolute
        OSM\Zoom = zoom
    EndSelect
    If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
    If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
    ConstructMap()
    DrawMap()
  EndProcedure
  
  Procedure InitOSM()
    Debug GetTemporaryDirectory()
    OSM\HDDCachePath = GetTemporaryDirectory()
    OSM\ServerURL = "http://tile.openstreetmap.org/"
    OSM\ZoomMin = 0
    OSM\ZoomMax = 18
    OSM\StartCursor\X = - 1
    OSM\TileSize = 256
    OSM\MemCache\Mutex=CreateMutex()
    ;OSM\MemCache\Semaphore=CreateSemaphore(1)
    OSM\MapImageMutex=CreateMutex()
    OSM\MapImageSemaphore=CreateSemaphore(8)
  EndProcedure
  
  Procedure Event(Event.l)
    Protected Gadget.i
    Protected tx.d, ty.d
    Protected OldX.i, OldY.i
    If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas 
      Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) 
                  OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) 
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>-1
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  tx=(OSM\DeltaCursor\X/256)
                  ty=(OSM\DeltaCursor\Y/256)
                  OSM\DeltaCursor\X=0
                  OSM\DeltaCursor\Y=0
                  OSM\StartCursor\X=-1
                  TileTranslate(@OSM\TargetTile,tx,ty)
                  XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                  ConstructMap()
              EndSelect
          EndSelect
          DrawMap()
      EndSelect
    Else
      MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
      End
    EndIf  
  EndProcedure
EndModule

Enumeration
  #Window_0
  #Map
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Combo_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #String_0
  #String_1
EndEnumeration

;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
  
  OSM::InitOSM()
  LoadFont(0, "Wingdings", 12)
  LoadFont(1, "Arial", 12, #PB_Font_Bold)
  
  OSM::OSMGadget(#Map, 10, 10, 512, 512)
  
  TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
  ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
  ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
  ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
  ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
  TextGadget(#Text_2, 530, 160, 60, 15, "Zoom : ")
  ButtonGadget(#Button_4, 550, 180, 50, 30, " + ")      : SetGadgetFont(#Button_4, FontID(1)) 
  ButtonGadget(#Button_5, 600, 180, 50, 30, " - ")      : SetGadgetFont(#Button_5, FontID(1)) 
  TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
  StringGadget(#String_0, 600, 230, 90, 20, "")
  TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
  StringGadget(#String_1, 600, 250, 90, 20, "")
  
  Define Event.i, Gadget.i, Quit.b = #False
  Define pfValue.d
  OSM::SetLocation(49.04599, 2.03347, 17)
  OSM::ConstructMap()
  OSM::DrawMap()
  ;OSM::SetLocation(49.0361165, 2.0456982)
  
  Repeat
    Event = WaitWindowEvent()
    
    OSM::Event(Event)
    Select Event
      Case #PB_Event_CloseWindow : Quit = 1
      Case #PB_Event_Gadget ;{
        Gadget = EventGadget()
        Select Gadget
          Case #Button_4
            OSM::SetZoom(1)
          Case #Button_5
            OSM::SetZoom( - 1)
        EndSelect
    EndSelect
  Until Quit = #True
EndIf
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Non, dès que j'avance un peu trop, boum, ERROR dans le debug. Mais j'aime bien le nouveau code :)
Avatar de l’utilisateur
MetalOS
Messages : 1498
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Re: OpenStreetMap dans un Canvas

Message par MetalOS »

Votre code et bien cool je vais le tester sur mac et linux pour voir le résultat. Je vais essayé d'y apporter ma contribution même si je suis loin de vôtres niveau.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

djes a écrit :Yeah, le zoom fonctionne maintenant, et ça tourne bien ! :)
Par contre j'ai un plantage dès que je vais un peu loin. Je vais regarder (enfin, demain), c'est mon tour :)
Je crois que j'ai réglé le plantage dans le dernier code. Apres si tu as du blanc et le mot ERROR qui apparait dans le Debug c'est qu'il n'arrive pas a charger l'image. ça peut venir de la constante

Code : Tout sélectionner

#USEPROXY = #False
et du fait que j'ai réglé le proxy pour moi :oops: ça serait vraiment bien qu'ils intègrent le proxy dans PB car avec un module tu peux difficilement utiliser un autre module dans le module...

J'ai rajouter dans le code une fonction pour charger un fichier GPX (suit de point d'une randonnée) bon ça sert pas a grand chose pour l'instant mais la fonction est là :p
Avatar de l’utilisateur
djes
Messages : 4252
Inscription : ven. 11/févr./2005 17:34
Localisation : Arras, France

Re: OpenStreetMap dans un Canvas

Message par djes »

Non j'ai testé sans le proxy, tu es allé un peu plus loin ?
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

MetalOS a écrit :Votre code et bien cool je vais le tester sur mac et linux pour voir le résultat. Je vais essayé d'y apporter ma contribution même si je suis loin de vôtres niveau.
toute contribution est la bienvenu ! faut encore qu'on stabilise quelques trucs. mais ça prend forme.
Djes a écrit :Non j'ai testé sans le proxy, tu es allé un peu plus loin ?
j'ai plus de plantage avec la dernière version du code que j'ai posté un peu plus haut. J'ai pas avancé plus que ça ce soir... j'avais une rando en roller :P

Edit du matin ! Effectivement Il y a un plantage lorsqu'on zoom en arrière ... Mais je comprends pas a quoi c'est du.

sinon je cherche a faire une fonction pour récupérer la distance en pixel du point ciblé d'un autre point en fonction de sa Latitude et Longitude. Mais j'ai pas trouvé encore la bonne formule.

Code : Tout sélectionner

  Procedure getPixelCoorfromLocation(*Location.Location,*Pixel.Pixel)
    Protected Tile.Tile
    LatLon2XY(@*Location, @Tile.Tile)
    Protected tx.d,ty.d
    tx=(OSM\TargetTile\X-Tile\X)
    ty=(OSM\TargetTile\Y-Tile\Y)
    *Pixel\X= ????
    *Pixel\Y= ????

  EndProcedure
Si j'ai du temps dans la journée je regarderai si je trouve le problème du zoom qui plante...
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

Bon j'ai réussi a contourner les erreurs mais elles sont toujours là mais au moins ça ne plante plus.
j'ai remarqué que lorsqu'on qu'on bouge la souris au dessus du canvas ça provoque des Erreurs au moment du chargement des images web... Faut que je regarde ça
Sinon j'ai réussi a faire ma procédure getPixelCoorfromLocation(*Location.Location,*Pixel.Pixel)

voici un un fichier GPX (Ma balade d'hier soir en roller) et voir son tracé ... Je regarderai ce midi si j'arrive a corriger des bugs.
https://drive.google.com/open?id=0Bxy0h ... lFTTm84Njg

Code : Tout sélectionner

;************************************************************** 
; Program:           OSM (OpenStreetMap Module) 
; Author:            Thyphoon And Djes
; Date:              Mai 17, 2016
; License:           Free, unrestricted, credit appreciated 
;                    but not required.
; Note:              Please share improvement !
; Thanks:            Progi1984, 
;************************************************************** 

InitNetwork()

CompilerIf #PB_Compiler_Thread=0
  MessageRequester("Warning !!","You must to Enable 'create ThreadSafe' in compiler option",#PB_MessageRequester_Ok )
  End
CompilerEndIf 

DeclareModule OSM
  Declare InitOSM()
  Declare OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
  Declare Event(Event.l)
  Declare SetLocation(latitude.d, longitude.d, zoom = 15)
  Declare SetZoom(Zoom.i, mode.i = #PB_Relative)
  Declare ConstructMap()
  Declare DrawMap()
  Declare LoadGpxFile(file.s);
EndDeclareModule

Module OSM
  #USEPROXY = #True
  UsePNGImageDecoder()
  UsePNGImageEncoder()
  
  CompilerIf #USEPROXY = #True
    IncludeFile("C:\Users\lebrun_y_413\Documents\Developpement\Purebasic\includes Share\http.pbi")
  CompilerEndIf

 Structure Location
    Longitude.d
    Latitude.d
  EndStructure
  
  Structure Tile
    X.d
    Y.d
  EndStructure
  
  Structure Pixel
    X.i
    Y.i
  EndStructure
  
  Structure ImgMemCach
  nImage.i
  Zoom.i
  XTile.i
  YTile.i
EndStructure

Structure TileMemCach
  List Image.ImgMemCach()
  Mutex.i
  Semaphore.i
EndStructure
  
  Structure OSM
    Gadget.i                                ; Canvas Gadget Id 
    TargetLocation.Location                 ; Latitude and Longitude from focus point
    TargetTile.Tile                         ; Focus Tile coord
    
    Position.Pixel                          ; Focus Point coord in Pixel
    
    ServerURL.s                             ; Web Url ex: http://tile.openstreetmap.org/
    ZoomMin.i                               ; Min Zoom supported by Server
    ZoomMax.i                               ; Max Zoom supported by Server
    Zoom.i                                  ; Current Zoom
    TileSize.i                              ; Tile Size downloaded on the server ex : 256
    
    HDDCachePath.S                          ; path where to load an save tile downloaded from server
    MemCache.TileMemCach                 ; to know image always in memory
    List MapImageIndex.ImgMemCach()           ; List of Index from MemCache\Image() to construct map
    MapImageMutex.i                           ; Mutex to lock
    MapImageSemaphore.i                       ; Semaphore to control Thread
    
    
    StartCursor.Pixel                       ; coord from start drag the map
    DeltaCursor.Pixel                       ; delta from curent position and the start position
    
    
    List track.Location()                   ;to display a track GPX on card
    
    
  EndStructure
  
  Global OSM.OSM
    
  Procedure OSMGadget(Gadget.i, X.i, Y.i, Width.i, Height.i)
    If Gadget = #PB_Any
      OSM\Gadget = CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    Else
      OSM\Gadget = Gadget
      CanvasGadget(OSM\Gadget, X, Y, Width, Height)
    EndIf 
  EndProcedure
  
  Procedure LatLon2XY(*Location.Location, *Tile.Tile)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatRad.d = Radian(*Location\Latitude)
    *Tile\X = n * ( (*Location\Longitude + 180.0) / 360.0)
    *Tile\Y = n * ( 1.0 - Log(Tan(LatRad) + 1.0/Cos(LatRad)) / #PI ) / 2.0
    ;Debug "Latitude : " + StrD(*Location\Latitude) + " ; Longitude : " + StrD(*Location\Longitude)
    ;Debug "Tile X : " + Str(*Tile\X) + " ; Tile Y : " + Str(*Tile\Y)
  EndProcedure
  
  Procedure XY2LatLon(*Tile.Tile, *Location.Location)
    Protected n.d = Pow(2.0, OSM\Zoom)
    Protected LatitudeRad.d
    *Location\Longitude  = *Tile\X / n * 360.0 - 180.0
    LatitudeRad = ATan(SinH(#PI * (1.0 - 2.0 * *Tile\Y / n)))
    *Location\Latitude = Degree(LatitudeRad)
  EndProcedure
  
  Procedure getPixelCoorfromLocation(*Location.Location,*Pixel.Pixel) ; TODO to Optimize 
    Protected mapWidth.l    = Pow(2,OSM\Zoom+8)
    Protected mapHeight.l   = Pow(2,OSM\Zoom+8)
    Protected x1.l,y1.l
    ; get x value
    x1 = (*Location\Longitude+180)*(mapWidth/360)
    ; convert from degrees To radians
    Protected latRad.d = *Location\Latitude*#PI/180;

    Protected mercN.d = Log(Tan((#PI/4)+(latRad/2)));
    y1     = (mapHeight/2)-(mapWidth*mercN/(2*#PI)) ;
    
    Protected x2.l,y2.l
    ; get x value
    x2 = (OSM\TargetLocation\Longitude+180)*(mapWidth/360)
    ; convert from degrees To radians
    latRad = OSM\TargetLocation\Latitude*#PI/180;
                                                ; get y value
    mercN = Log(Tan((#PI/4)+(latRad/2)))        ;
    y2     = (mapHeight/2)-(mapWidth*mercN/(2*#PI));
    
    *Pixel\X=GadgetWidth(OSM\Gadget)/2-(x2-x1)+ OSM\DeltaCursor\X
    *Pixel\Y=GadgetHeight(OSM\Gadget)/2-(y2-y1)+ OSM\DeltaCursor\Y
  EndProcedure
  
 Procedure LoadGpxFile(file.s)
    If LoadXML(0, file.s)
      Protected Message.s
      If XMLStatus(0) <> #PB_XML_Success
        Message = "Error in the XML file:" + Chr(13)
        Message + "Message: " + XMLError(0) + Chr(13)
        Message + "Line: " + Str(XMLErrorLine(0)) + "   Character: " + Str(XMLErrorPosition(0))
        MessageRequester("Error", Message)
      EndIf
      Protected *MainNode,*subNode,*child,child.l
      *MainNode=MainXMLNode(0)
      *MainNode=XMLNodeFromPath(*MainNode,"/gpx/trk/trkseg")
      ClearList(OSM\track())
      For child = 1 To XMLChildCount(*MainNode)
        *child = ChildXMLNode(*MainNode, child)
        AddElement(OSM\track())
        If ExamineXMLAttributes(*child)
          While NextXMLAttribute(*child)
            Select XMLAttributeName(*child)
              Case "lat"
                OSM\track()\Latitude=ValD(XMLAttributeValue(*child))
              Case "lon"
                OSM\track()\Longitude=ValD(XMLAttributeValue(*child))
            EndSelect
          Wend
        EndIf
      Next 
    EndIf
  EndProcedure
  
  Procedure AddTileToMemCache(Zoom.i, XTile.i, YTile.i,nImage.i)
    Protected Index.i
    If IsImage(nImage)
      LockMutex(OSM\MemCache\Mutex)
      ;We add To the List And load it
      FirstElement(OSM\MemCache\Image())
      AddElement(OSM\MemCache\Image())
      Index=ListIndex(OSM\MemCache\Image())
      OSM\MemCache\Image()\XTile=XTile
      OSM\MemCache\Image()\YTile=YTile
      OSM\MemCache\Image()\Zoom=Zoom
      OSM\MemCache\Image()\nImage=nImage  
      UnlockMutex(OSM\MemCache\Mutex)
      ProcedureReturn Index
    Else
      Debug "NO ADD TILE TO MEM CACHE BECAUSE BAD IMAGE"
    EndIf 
  EndProcedure
  
Procedure.i GetTileFromMem(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  LockMutex(OSM\MemCache\Mutex)
  ;Check if we have this Image in Memory
  ForEach OSM\MemCache\Image()
    If Zoom=OSM\MemCache\Image()\Zoom And OSM\MemCache\Image()\XTile=XTile And OSM\MemCache\Image()\YTile=YTile
      nImage=OSM\MemCache\Image()\nImage
      Debug "Load From MEM Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+" IsImage:"+Str(IsImage(nImage))
      
      Break;
    ElseIf Zoom<>OSM\MemCache\Image()\Zoom
      DeleteElement(OSM\MemCache\Image())
    EndIf 
  Next 
  UnlockMutex(OSM\MemCache\Mutex)
  ProcedureReturn nImage
EndProcedure

Procedure.i GetTileFromHDD(Zoom.i, XTile.i, YTile.i)
  Protected nImage.i
  Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
  If FileSize(OSM\HDDCachePath + cacheFile) > 0
    nImage=LoadImage(#PB_Any, OSM\HDDCachePath + CacheFile)
   
    If IsImage(nImage)
      Debug "Load From HDD Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)+ "IsImage:"+Str(IsImage(nImage))
      AddTileToMemCache(Zoom, XTile, YTile,nImage)
      ProcedureReturn nImage
    EndIf 
    
    
  EndIf 
  ProcedureReturn #False
  EndProcedure
  
  Procedure.i GetTileFromWeb(Zoom.i, XTile.i, YTile.i)
    Protected *Buffer
    Protected nImage.i
    Protected CacheFile.s = "OSM_" + Str(Zoom) + "_" + Str(XTile) + "_" + Str(YTile) + ".png"
    Protected TileURL.s = OSM\ServerURL + Str(Zoom) + "/" + Str(XTile) + "/" + Str(YTile) + ".png"
    ;Debug "DOWNLOAD : " + psURL
    CompilerIf #USEPROXY = #True
      Protected http.HTTP_Query
      HTTP_proxy(@http, "spxy.bpi.fr", 3128)
      HTTP_DownloadToMem(@http, TileURL)
      nImage=CatchImage(#PB_Any, http\data, MemorySize(http\data))
      If IsImage(nImage)
        AddTileToMemCache(Zoom, XTile, YTile,nImage)
        SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
        Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
      EndIf
    CompilerElse
      *Buffer = ReceiveHTTPMemory(TileURL)
      If *Buffer
        nImage=CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
        If IsImage(nImage)
          AddTileToMemCache(Zoom, XTile, YTile,nImage)
          SaveImage(nImage, OSM\HDDCachePath + CacheFile, #PB_ImagePlugin_PNG)
          Debug "Load From WEB Tile X : " + Str(XTile) + " ; Tile Y : " + Str(YTile)
          FreeMemory(*Buffer)
        Else
          Debug "Can't catch image :" + TileURL
        EndIf
      Else
        Debug "Problem loading :" + TileURL
      EndIf
    CompilerEndIf
    
    ProcedureReturn nImage
  EndProcedure
  
  Procedure GetTile(Index.i)
    Protected Zoom.i, XTile.i, YTile.i
    LockMutex(OSM\MapImageMutex)
    SelectElement(OSM\MapImageIndex(),Index)
    Zoom=OSM\MapImageIndex()\Zoom
    XTile=OSM\MapImageIndex()\XTile
    YTile=OSM\MapImageIndex()\YTile
    UnlockMutex(OSM\MapImageMutex)
    Protected nImage.i
    nImage=GetTileFromMem(Zoom, XTile, YTile)
    If nImage=0
      nImage=GetTileFromHDD(Zoom, XTile, YTile)
      If nImage=0
        nImage=GetTileFromWeb(Zoom, XTile, YTile)
        If nImage=0
          Debug "Error GetTile Procedure : can't Load this Tile" ; TODO Check Why !!!
          ProcedureReturn #False
        EndIf
      EndIf
    EndIf 
   LockMutex(OSM\MapImageMutex)
    If SelectElement(OSM\MapImageIndex(),Index)
      OSM\MapImageIndex()\nImage=nImage
    Else
      Debug "ERROR GetTile Procedure : List doesn'h have current element" ; TODO Check Why !!!
    EndIf 
    UnlockMutex(OSM\MapImageMutex)
    SignalSemaphore(OSM\MapImageSemaphore)
  EndProcedure
  
  Procedure ThreadConstructMap(z.i)
    Protected x.i, y.i
    Protected Index.i
    Protected mx.l = GadgetWidth(OSM\Gadget)
    Protected my.l = GadgetHeight(OSM\Gadget)
    Protected nx.i = mx/OSM\TileSize ;How many tiles
    Protected ny.i = my/OSM\TileSize
    mx/2 : my/2 ; Gadget center
    Protected tx.i = Int(OSM\TargetTile\X)
    Protected ty.i = Int(OSM\TargetTile\Y)
    LockMutex(OSM\MapImageMutex)
    ClearList(OSM\MapImageIndex())
    UnlockMutex(OSM\MapImageMutex)
   Debug ty + ny + ny - 1
    For y = ty - ny To ty + ny + ny - 1
      For x = tx - nx To tx + nx + nx - 1
        WaitSemaphore(OSM\MapImageSemaphore)
        LockMutex(OSM\MapImageMutex)
        LastElement(OSM\MapImageIndex())
        AddElement(OSM\MapImageIndex())
        Index=ListIndex(OSM\MapImageIndex())
        OSM\MapImageIndex()\XTile=x
        OSM\MapImageIndex()\YTile=y
        OSM\MapImageIndex()\Zoom=OSM\Zoom
        UnlockMutex(OSM\MapImageMutex)
        CreateThread(@GetTile(),Index)
      Next
    Next
  EndProcedure
  
  Procedure ConstructMap()
      CreateThread(@ThreadConstructMap(),0)
  EndProcedure
 
  Procedure DrawMap()
    Protected x.i, y.i, nx.i, ny.i, mx.i, my.i, n.i = 0
    Protected deltaX.i, deltaY.i
    
    Protected nImage.i
    Protected x2.i, y2.i
    deltaX = OSM\TileSize*(OSM\TargetTile\X - Int(OSM\TargetTile\X))
    deltaY = OSM\TileSize*(OSM\TargetTile\Y - Int(OSM\TargetTile\Y))
    
    mx = GadgetWidth(OSM\Gadget)/2
    my = GadgetHeight(OSM\Gadget)/2
    
    nx = GadgetWidth(OSM\Gadget)/OSM\TileSize ;How many tiles
    ny = GadgetWidth(OSM\Gadget)/OSM\TileSize
    
    
    StartDrawing(CanvasOutput(OSM\Gadget))
    Box(0, 0, GadgetWidth(OSM\Gadget), GadgetHeight(OSM\Gadget), RGB(255, 255, 255))
    LockMutex(OSM\MapImageMutex)
    ResetList(OSM\MapImageIndex())
    For y = - ny To ny + ny - 1
      For x = - nx To nx + nx - 1
        If NextElement(OSM\MapImageIndex())
          
          x2 = x*256 + OSM\DeltaCursor\X   + mx -deltaX
          y2 = y*256 + OSM\DeltaCursor\Y   + my - deltaY
          nImage=OSM\MapImageIndex()\nImage
          If nimage=0
            DrawText( x2, y2+20, "Loading")
            
          ElseIf IsImage(nImage) And (x2 + 256) > 0 And (y2 + 256) > 0 And x2 < GadgetWidth(OSM\Gadget) And y2 < GadgetHeight(OSM\Gadget)
            
            DrawImage(ImageID(nImage), x2,y2, 254, 254)
            DrawText( x2, y2, Str(x) + ", " + Str(y))
          Else
            DrawText( x2, y2+20, "Error to Display Image")
          EndIf       
          
          n = n + 1
        Else
          Debug" ERROR"
          Break 2
        EndIf 
      Next
    Next
    UnlockMutex(OSM\MapImageMutex)
    Circle(GadgetWidth(OSM\Gadget)/2, GadgetHeight(OSM\Gadget)/2, 5, RGB(Random(255),Random(255),Random(255)))
    ;DrawText(0, 0, "DeltaCursorX : " + Str(OSM\DeltaCursor\X) + " deltaX : " + Str(deltaX) + " Tile X : " + StrD(OSM\TargetTile\X))
    DrawText(0, 16, Str(OSM\TargetTile\X + OSM\DeltaCursor\X) + " " + Str(OSM\TargetTile\Y + OSM\DeltaCursor\Y))
    
    ; Draw Track
    Protected Pixel.Pixel
    Protected Location.Location
    n=0;
    ForEach OSM\track()
      n=n+1
      If @OSM\TargetLocation\Latitude<>0 And  @OSM\TargetLocation\Longitude<>0
      getPixelCoorfromLocation(@OSM\track(),@Pixel)
      x=Pixel\X
      y=Pixel\Y
      If x>0 And y>0 And x<GadgetWidth(OSM\Gadget) And y<GadgetHeight(OSM\Gadget)
        Circle(x,y,2,#Green)
      EndIf
      EndIf 
      
    Next
    StopDrawing()
  EndProcedure
  
  

  
  Procedure SetLocation(latitude.d, longitude.d, zoom = 15)
    If zoom > OSM\ZoomMax : zoom = OSM\ZoomMax : EndIf
    If zoom < OSM\ZoomMin : zoom = OSM\ZoomMin : EndIf
    OSM\Zoom = zoom
    OSM\TargetLocation\Latitude = latitude
    OSM\TargetLocation\Longitude = longitude
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
  EndProcedure
  
  
  Procedure TileTranslate(*Tile.Tile, tx.d, ty.d)
    Debug " - move - "
    
    Protected pfValue.d
    If tx <> 0
      pfValue = *Tile\X - tx
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\X = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\X = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\X = pfValue
        
      EndIf
    EndIf
    
    If ty <> 0
      pfValue = *Tile\Y - ty
      If pfValue > Pow(2, OSM\Zoom) - 1
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      ElseIf pfValue < 0 
        *Tile\Y = Pow(2, OSM\Zoom) - 2
      Else
        *Tile\Y = pfValue
        
      EndIf
    EndIf
  EndProcedure
  
  Procedure SetZoom(Zoom.i, mode.i = #PB_Relative)
    Select mode
      Case #PB_Relative
        OSM\Zoom = OSM\Zoom + zoom
      Case #PB_Absolute
        OSM\Zoom = zoom
    EndSelect
    If OSM\Zoom > OSM\ZoomMax : OSM\Zoom = OSM\ZoomMax : EndIf
    If OSM\Zoom < OSM\ZoomMin : OSM\Zoom = OSM\ZoomMin : EndIf
    LatLon2XY(@OSM\TargetLocation, @OSM\TargetTile)
    OSM\Position\X = OSM\TargetTile\X * OSM\TileSize ;Convert X, Y in tile.decimal into real pixels
    OSM\Position\Y = OSM\TargetTile\Y * OSM\TileSize 
    ConstructMap()
    DrawMap()
  EndProcedure
  
  Procedure InitOSM()
    Debug GetTemporaryDirectory()
    OSM\HDDCachePath = GetTemporaryDirectory()
    OSM\ServerURL = "http://tile.openstreetmap.org/"
    OSM\ZoomMin = 0
    OSM\ZoomMax = 18
    OSM\StartCursor\X = - 1
    OSM\TileSize = 256
    OSM\MemCache\Mutex=CreateMutex()
    ;OSM\MemCache\Semaphore=CreateSemaphore(1)
    OSM\MapImageMutex=CreateMutex()
    OSM\MapImageSemaphore=CreateSemaphore(1)
  EndProcedure
  
  Procedure Event(Event.l)
    Protected Gadget.i
    Protected tx.d, ty.d
    Protected OldX.i, OldY.i
    If IsGadget(OSM\Gadget) And GadgetType(OSM\Gadget) = #PB_GadgetType_Canvas 
      Select Event
        Case #PB_Event_Gadget ;{
          Gadget = EventGadget()
          Select Gadget
            Case OSM\Gadget
              Select EventType()
                Case #PB_EventType_LeftButtonDown
                  ;Mem cursor Coord
                  OSM\StartCursor\X = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX) 
                  OSM\StartCursor\Y = GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY) 
                Case #PB_EventType_MouseMove 
                  If OSM\StartCursor\X<>-1
                    OSM\DeltaCursor\X=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseX)-OSM\StartCursor\X
                    OSM\DeltaCursor\Y=GetGadgetAttribute(OSM\Gadget, #PB_Canvas_MouseY)-OSM\StartCursor\Y
                  EndIf 
                Case #PB_EventType_LeftButtonUp
                  tx=(OSM\DeltaCursor\X/256)
                  ty=(OSM\DeltaCursor\Y/256)
                  OSM\DeltaCursor\X=0
                  OSM\DeltaCursor\Y=0
                  OSM\StartCursor\X=-1
                  TileTranslate(@OSM\TargetTile,tx,ty)
                  XY2LatLon(@OSM\TargetTile,@OSM\TargetLocation)
                  ConstructMap()
              EndSelect
          EndSelect
          DrawMap()
      EndSelect
    Else
      MessageRequester("Module OSM", "You must use OSMGadget before", #PB_MessageRequester_Ok )
      End
    EndIf  
  EndProcedure
EndModule

Enumeration
  #Window_0
  #Map
  #Button_0
  #Button_1
  #Button_2
  #Button_3
  #Button_4
  #Button_5
  #Combo_0
  #Text_0
  #Text_1
  #Text_2
  #Text_3
  #Text_4
  #String_0
  #String_1
EndEnumeration

;- Main
If OpenWindow(#Window_0, 260, 225, 700, 571, "OpenStreetMap",  #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_TitleBar | #PB_Window_ScreenCentered )
  
  OSM::InitOSM()
  LoadFont(0, "Wingdings", 12)
  LoadFont(1, "Arial", 12, #PB_Font_Bold)
  
  OSM::OSMGadget(#Map, 10, 10, 512, 512)
  
  TextGadget(#Text_1, 530, 50, 60, 15, "Movements : ")
  ButtonGadget(#Button_0, 550, 100, 30, 30, Chr($E7))  : SetGadgetFont(#Button_0, FontID(0)) 
  ButtonGadget(#Button_1, 610, 100, 30, 30, Chr($E8))  : SetGadgetFont(#Button_1, FontID(0)) 
  ButtonGadget(#Button_2, 580, 070, 30, 30, Chr($E9))  : SetGadgetFont(#Button_2, FontID(0)) 
  ButtonGadget(#Button_3, 580, 130, 30, 30, Chr($EA))  : SetGadgetFont(#Button_3, FontID(0)) 
  TextGadget(#Text_2, 530, 160, 60, 15, "Zoom : ")
  ButtonGadget(#Button_4, 550, 180, 50, 30, " + ")      : SetGadgetFont(#Button_4, FontID(1)) 
  ButtonGadget(#Button_5, 600, 180, 50, 30, " - ")      : SetGadgetFont(#Button_5, FontID(1)) 
  TextGadget(#Text_3, 530, 230, 60, 15, "Latitude : ")
  StringGadget(#String_0, 600, 230, 90, 20, "")
  TextGadget(#Text_4, 530, 250, 60, 15, "Longitude : ")
  StringGadget(#String_1, 600, 250, 90, 20, "")
  
  Define Event.i, Gadget.i, Quit.b = #False
  Define pfValue.d
  ;OSM::SetLocation(49.04599, 2.03347, 17)
  OSM::SetLocation(49.0346374511718750,2.0787782669067383,17)
  OSM::ConstructMap()
  OSM::DrawMap()
  
  OSM::LoadGpxFile("Roller.gpx")
  
  Repeat
    Event = WaitWindowEvent()
    
    OSM::Event(Event)
    Select Event
      Case #PB_Event_CloseWindow : Quit = 1
      Case #PB_Event_Gadget ;{
        Gadget = EventGadget()
        Select Gadget
          Case #Button_4
            OSM::SetZoom(1)
          Case #Button_5
            OSM::SetZoom( - 1)
        EndSelect
    EndSelect
  Until Quit = #True
EndIf
  
Avatar de l’utilisateur
MetalOS
Messages : 1498
Inscription : mar. 20/juin/2006 22:17
Localisation : Lorraine
Contact :

Re: OpenStreetMap dans un Canvas

Message par MetalOS »

J'ai le même problème que toi sur Mac en passant la sourie sur le canvas.

Par contre pas d'affichage de tuiles.
Avatar de l’utilisateur
Thyphoon
Messages : 2706
Inscription : mer. 25/août/2004 6:31
Localisation : Eragny
Contact :

Re: OpenStreetMap dans un Canvas

Message par Thyphoon »

MetalOS a écrit :J'ai le même problème que toi sur Mac en passant la sourie sur le canvas.

Par contre pas d'affichage de tuiles.
Tu as bien mis #USEPROXY = #False ?
Répondre