diff --git a/comp/src/gb.map/.info b/comp/src/gb.map/.info index e0989734d..87ff4d131 100644 --- a/comp/src/gb.map/.info +++ b/comp/src/gb.map/.info @@ -74,6 +74,10 @@ _ShowWithEffect v b +_Debug +V +b + :Refresh : @@ -349,57 +353,6 @@ tmrOnMove_Timer m -#Shapes - -C -Point -C -i -1 -MultiPoint -C -i -8 -Polyline -C -i -3 -Polygon -C -i -5 -Count -r -i - -Max -r -i - -AddMultiPoint -m - -(Data)MapPoint[];[(Id)s] -AddPoint -m - -(Data)MapPoint;[(Id)s] -AddPolyline -m - -(Data)MapPoint[];[(Id)s] -GetCenter -M -MapPoint -(hPoints)MapPoint[]; -AddPolygon -m - -(Data)MapPoint[][];[(Id)s] -_get -m -_ShapeItem -(Index)i #_ShapeItem C diff --git a/comp/src/gb.map/.list b/comp/src/gb.map/.list index a15e85fee..dddf91327 100644 --- a/comp/src/gb.map/.list +++ b/comp/src/gb.map/.list @@ -3,5 +3,4 @@ Map MapBounds MapPoint MapView -Shapes _ShapeItem diff --git a/comp/src/gb.map/.project b/comp/src/gb.map/.project index f97d1c2ff..047ec3caf 100644 --- a/comp/src/gb.map/.project +++ b/comp/src/gb.map/.project @@ -1,7 +1,7 @@ # Gambas Project File 3.0 # Compiled with Gambas 3.4.0 Title=gb.map -Startup=Form1 +Startup=FMain Icon=.hidden/control/mapview.png Version=3.4.0 VersionFile=1 diff --git a/comp/src/gb.map/.src/Map.class b/comp/src/gb.map/.src/Map.class index 7192b477a..6c13b3bb6 100644 --- a/comp/src/gb.map/.src/Map.class +++ b/comp/src/gb.map/.src/Map.class @@ -17,16 +17,14 @@ Private $iWidth As Integer Private $iHeight As Integer Private tmrLoad As New Timer As "tmrLoad" Private tmrDraw As New Timer As "tmrDraw" -Private $bNeedReload As Boolean Private $PixelBox As New Rect Private $Bounds As New MapBounds Private $PrevBox As Rect Private $iPrevent As Integer = 256 Private $aLayers As New _MapLayer[] Private $aLayerNames As New String[] -'Property Preload As Boolean -'Private $bPreload As Boolean Public _ShowWithEffect As Boolean +Static Public _Debug As Boolean Event Refresh Event Draw Private Function Top_Read() As Integer @@ -285,7 +283,6 @@ Public Function Grab(Bounds As MapBounds, iWidth As Integer, iHeight As Integer, Dim i As Integer Dim hBndCenter As MapPoint = MapPoint((Bounds.Lat + Bounds.Lat2) / 2, (Bounds.Lon + Bounds.Lon2) / 2) Dim hPix, hPix2 As Point - Dim hMpBounds As MapBounds Dim hImg As New Image(iWidth, iHeight, Color.Yellow) Dim bLoad As Boolean Dim hLayer As _MapLayer diff --git a/comp/src/gb.map/.src/MapView.class b/comp/src/gb.map/.src/MapView.class index 9af703d7a..5669384e7 100644 --- a/comp/src/gb.map/.src/MapView.class +++ b/comp/src/gb.map/.src/MapView.class @@ -18,7 +18,6 @@ Private $hCenter As MapPoint Private $hMap As New Map As "Map" Private $hView As DrawingArea Private $hPan As New Panel(Me) -Private hWatch As New Watcher(Me) As "Watcher" Private $pCurCenterPx As Point Private $iX As Integer Private $iY As Integer @@ -31,7 +30,6 @@ Private $fZoomEffect As Float = 1 Private $ZX As Integer Private $ZY As Integer Private $iZoomWay As Integer -Private $fZoomStep As Float Private $fSpeedX As Float Private $fSpeedY As Float Private $fInertia As Float = 0.90 diff --git a/comp/src/gb.map/.src/Shapes/Shapes.class b/comp/src/gb.map/.src/Shapes/Shapes.class deleted file mode 100644 index 223582c3a..000000000 --- a/comp/src/gb.map/.src/Shapes/Shapes.class +++ /dev/null @@ -1,121 +0,0 @@ -' Gambas class file - -Export -Public Const {Point} As Integer = 1 -Public Const MultiPoint As Integer = 8 -Public Const Polyline As Integer = 3 -Public Const Polygon As Integer = 5 -Property Read Count As Integer -Property Read Max As Integer - -Private Items As New _ShapeItem[] - -Private iType As New Integer[] -Private oData As New Object[] -Private $aBox As New RectF[] -Public Sub AddMultiPoint(Data As MapPoint[], Optional Id As String) - Dim hSItem As New _ShapeItem - hSItem.Id = Id - hSItem.Type = MultiPoint - hSItem.Data = Data - hSItem.Box = GetDataBox(data) - Items.Add(hSItem) -End - -Public Sub AddPoint(Data As MapPoint, Optional Id As String) -Dim hSItem As New _ShapeItem - hSItem.Id = Id - hSItem.Type = Shapes.Point - hSItem.Data = Data - hSItem.Box = RectF(Data.Lat, Data.lon, 1, 1) - Items.Add(hSItem) - 'RectF = GetDataBox(data) -End - -Public Sub AddPolyline(Data As MapPoint[], Optional Id As String) - Dim hSItem As New _ShapeItem - hSItem.Id = Id - hSItem.Type = Polyline - hSItem.Data = Data - hSItem.Box = GetDataBox(data) - Items.Add(hSItem) - hSItem.Center = GetCenter(Data) -End - -Public Sub AddPolygon(Data As MapPoint[][], Optional Id As String) - Dim hSItem As New _ShapeItem - hSItem.Id = Id - hSItem.Type = Polygon - hSItem.Data = Data - - hSItem.Box = GetDataBox(Data[0]) - - - 'hSItem.Box = GetDataBox(data) - Items.Add(hSItem) - hSItem.Center = GetCenter(Data[0]) - -End - - -Private Function GetDataBox(hMapPoints As MapPoint[]) As RectF - - Dim hPoint As MapPoint - Dim hRectF As New RectF - Dim X, Y, X2, Y2 As Float - X = hMapPoints[0].Lon - Y = hMapPoints[0].Lat - X2 = X - Y2 = Y - For Each hPoint In hMapPoints - X = Min(hPoint.lon, X) - Y = Min(hPoint.lat, Y) - X2 = Max(hPoint.lon, X2) - Y2 = Max(hPoint.lat, Y2) - Next - Return hRectF(X, Y, X2 - X, Y2 - Y) -End - -Public Sub _get(Index As Integer) As _ShapeItem - Return Items[Index] -End - -Private Function Count_Read() As Integer - - Return Items.Count - -End - -Private Function Max_Read() As Integer - - Return Items.Max - -End - -Static Public Function GetCenter(hPoints As MapPoint[]) As MapPoint - 'Dim PCenter As New FPoint[] - Dim tmpA, A, Gx, Gy As Float - Dim j, k As Integer - 'calcul du centre - 'fp = New FPoint - A = 0 - gx = 0 - Gy = 0 - For k = 0 To hPoints.Max - j = IIf(k + 1 <= hPoints.Max, k + 1, 0) - tmpA = (hPoints[k].Lon * hPoints[j].Lat) - (hPoints[j].Lon * hPoints[k].Lat) - A += tmpA - Gx += tmpA * (hPoints[k].Lon + hPoints[j].Lon) - Gy += tmpA * (hPoints[k].Lat + hPoints[j].Lat) - Next - A = A / 2 - gx = gx / (6 * A) - gy = gy / (6 * A) - - Return MapPoint(GY, GX) - Catch - -End - - - diff --git a/comp/src/gb.map/.src/Tests/FMain.class b/comp/src/gb.map/.src/Tests/FMain.class index 4b527f6e5..4d4a32a5f 100644 --- a/comp/src/gb.map/.src/Tests/FMain.class +++ b/comp/src/gb.map/.src/Tests/FMain.class @@ -71,8 +71,8 @@ Public Sub MapView1_MouseDown() MapView1.Map["NewShape"]["mypoly"].Selected = True Else MapView1.Map["NewShape"]["mypoly"].Points[0].Add(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)) - MapView1.Map["NewShape"]["mypoly"].Center = Shapes.GetCenter(MapView1.Map["NewShape"]["mypoly"].Points[0]) - + 'MapView1.Map["NewShape"]["mypoly"].Center = Shapes.GetCenter(MapView1.Map["NewShape"]["mypoly"].Points[0]) + MapView1.Map["NewShape"].Refresh Endif 'MapView1.Map["NewShape"].Points.AddPoint(Geo.PixelToMapPoint(point(MapView1.Map.PixelBox.X + Mouse.X, MapView1.Map.PixelBox.Y + Mouse.y), MapView1.Map.Zoom)) MapView1.Refresh @@ -180,38 +180,3 @@ Public Sub Panel3_MouseDown() End - -Public Function LoadShapes() As Shapes - - Dim hdoc As New XmlDocument - Dim el As XmlElement - Dim el2 As XmlElement - Dim hShapes As New Shapes - Dim hMP As New MapPoint[][] - Dim hmps As MapPoint[] - Dim mp As MapPoint - Dim s As String - - hdoc.Open("parcellaire.kml") - For Each el In hdoc.GetElementsByTagName("Polygon") - el.GetAttribute("index") - hmp = New MapPoint[][] - el2 = el.GetChildrenByTagName("Coordinates")[0] - hmps = New MapPoint[] - hMP.Add(hmps) - For Each s In Split(Replace(el2.TextContent, "\n", " "), " ") - mp = New MapPoint - mp.Lon = Split(s)[0] - mp.Lat = Split(s)[1] - hMP[0].Add(mp) - Next - - hShapes.AddPolygon(hmp) - - - - - Next - Return hShapes - -End diff --git a/comp/src/gb.map/.src/Tools/Geo.module b/comp/src/gb.map/.src/Tools/Geo.module index ea03f040a..dcaccfb1c 100644 --- a/comp/src/gb.map/.src/Tools/Geo.module +++ b/comp/src/gb.map/.src/Tools/Geo.module @@ -1,7 +1,7 @@ ' Gambas module file Export -Private halfPixelGlobeSize As Integer +'Private halfPixelGlobeSize As Integer Private $TileSize As Integer = 256 Private $initialResolution As Float = 2 * Pi * 6378137 / $tileSize diff --git a/comp/src/gb.map/.src/Tools/_MapTileCache.class b/comp/src/gb.map/.src/Tools/_MapTileCache.class deleted file mode 100644 index 909d29396..000000000 --- a/comp/src/gb.map/.src/Tools/_MapTileCache.class +++ /dev/null @@ -1,257 +0,0 @@ -' Gambas class file - -Private $sBaseCachePath As String = User.Home &/ ".cache/gambas3" -Private $sUrl As String -Private $colCache As New Collection -Private $aStack As New String[] -Private $aClients As New HttpClient[] -Private $iClientCount As Integer = 4 -Private $tmrClient As New Timer As "Timer" -Private $aPreloadStack As New String[] -' Private $aNoRetry As New String[] -Public Url As String -Public SubDomains As String[] -Private $colTry As New Collection -Static Public Debug As Boolean - -Event FileLoaded - -Public Sub _new(Optional CacheName As String) - - Dim sTempPath As String - Dim hClient As HttpClient - Dim i As Integer - - If CacheName Then - sTempPath = $sBaseCachePath &/ CacheName - Else - sTempPath = Temp() - Endif - - If Not Exist(sTempPath) Then - If MakeDir(sTempPath) Then Error.Raise("Cannot create Cache Path: \n" & sTempPath) - Endif - $sBaseCachePath = sTempPath - - $aClients.Resize($iClientCount) - For i = 0 To $aClients.Max - hClient = New HttpClient As "Client" - hClient.Async = True - $aClients[i] = hClient - Next - -End - -Public Function _get(X As Integer, Y As Integer, Z As Integer) As Image - - Dim sFileName As String = Subst("&1-&2-&3.png", Z, Y, X) - Dim hImage As Image - - 'If _MapTileCache.Debug Then Debug "Query : X=" & X & " Y=" & Y & " Z=" & Z - - 'Si l'image est dans le cache - If $colCache.Exist(sFileName) Then - Return $colCache[sFileName] - Else - 'Sinon - - 'Si le fichier est en cour de téléchargement on quitte - If IsLoading(sFileName) Then Return Null - 'Si le fichier existe dans le dossier de cache on essais de le charger - If Exist($sBaseCachePath &/ sFileName) Then - Try hImage = Image.Load($sBaseCachePath &/ sFileName) - If Error Then - ' 'L'image est défectueuse, on la supprime - If _MapTileCache.Debug Then Debug "Suppression de l'image : " & sFileName - Kill $sBaseCachePath &/ sFileName - If Not $colTry.Exist(sFileName) Then - - $colTry[sFileName] = 0 - Else - Inc $colTry[sFileName] - Endif - Return Null - Endif - $colCache[sFileName] = hImage - Return hImage - Else - 'Si le fichier ne peu être téléchargé - If $colTry.Exist(sFileName) And If $colTry[sFileName] > 3 Then Return Null - 'Sinon - GetFromWeb(sFileName, MakeUrl(X, Y, Z)) - Return Null - Endif - Endif - -End - -Private Function MakeDir(Path As String) As Boolean - - Dim ars As String[] - Dim sDir, s As String - - sDir = "/" - - ars = Split(Path, "/") - For Each s In ars - sDir &/= s - If Not Exist(sDir) Then - Mkdir sDir - Endif - - Next - - If _MapTileCache.Debug Then Debug "Création du Dossier: " & sDir - -Catch - Return True - -End - -Private Function MakeUrl(X As Integer, Y As Integer, z As Integer) As String - - Dim sTemp As String - - sTemp = Replace(Url, "{x}", CStr(X)) - sTemp = Replace(sTemp, "{y}", CStr(Y)) - sTemp = Replace(sTemp, "{z}", CStr(Z)) - sTemp = Replace(sTemp, "{s}", SubDomains[Round(Rnd(0, SubDomains.Max))]) - Return sTemp - -End - -Private Sub GetFromWeb(sFileName As String, sUrl As String) - - $aStack.Push(sFileName) - $aStack.Push(sUrl) - $tmrClient.Trigger - -End - -Public Sub Timer_Timer() - - Dim hClient As HttpClient - - Do - - If $aStack.Count = 0 And If $aPreloadStack.count = 0 Then - '$tmrClient.Stop - Return - Endif - - hClient = GetFreeClient() - - If hClient = Null Then Return - - If $aStack.Count > 0 Then - hClient.URL = $aStack.Pop() - hClient.Tag = $aStack.Pop() - Else - hClient.URL = $aPreloadStack.Pop() - hClient.Tag = $aPreloadStack.Pop() - Endif - If {Debug} Then Debug "download :";; hClient;; hClient.Tag - hClient.Get(Null, $sBaseCachePath &/ hClient.Tag) - - Loop - -End - -Public Sub GetFreeClient() As HttpClient - - Dim i As Integer - - For i = 0 To $aClients.Max - If $aClients[i].Status = Net.Inactive Then - Return $aClients[i] - Endif - Next - - Return Null - -End - -Public Sub ResetQueue() - - Dim hClient As HttpClient - - $tmrClient.Stop - For Each hClient In $aClients - hClient.Stop - Next - $colCache.Clear - $aStack.Clear - $aPreloadStack.Clear - $colTry.Clear - -End - -Public Function IsLoading(sFile As String) As Boolean - - Dim i As Integer - - If $aStack.Exist(sFile) Then Return True - For i = 0 To $aClients.Max - If $aClients[i].Tag = sFile Then Return True - Next - -End - -Public Sub Client_Finished() - - If _MapTileCache.Debug Then Debug "File successfully downloaded : " & Last.tag - Last.Tag = Null - Raise FileLoaded - $tmrClient.Trigger - -End - -Public Sub Client_Error() - - Last.Stop - If Not $colTry.Exist(Last.Tag) Then - $colTry[Last.Tag] = 0 - Else - Inc $colTry[Last.Tag] - Endif - Last.Tag = "" - $tmrClient.Trigger - -End - -Private Function Url_Read() As String - - Return $sUrl - -End - -Private Sub Url_Write(Value As String) - - $sUrl = Value - -End - -Private Function Domains_Read() As String[] - - Return - -End - -Private Sub Domains_Write(Value As String[]) - - $sUrl = Value - -End - -Public Sub AddToPreload(X As Integer, Y As Integer, Z As Integer) - - Dim sFileName As String = Subst("&1-&2-&3.png", Z, Y, X) - - If Exist($sBaseCachePath &/ sFileName) Then Return - $aPreloadStack.Push(sFileName) - $aPreloadStack.Push(MakeUrl(X, Y, Z)) - '$tmrClient.Start - -End - - diff --git a/comp/src/gb.map/.src/_MapShape.class b/comp/src/gb.map/.src/_MapShape.class index b4998d647..60488959e 100644 --- a/comp/src/gb.map/.src/_MapShape.class +++ b/comp/src/gb.map/.src/_MapShape.class @@ -12,11 +12,9 @@ Private $himgPoint As Image 'Property Points As Shapes Property {Color} As Integer Private $icolor As Integer -Private $sCurrent As String Private $colIDShape As New Collection Property Read Count As Integer Property Image As Image -Private $imgPointImage As Image Public Sub _new() @@ -79,7 +77,6 @@ End Public Sub _Draw() - Dim hItem As _ShapeItem Dim i, j As Integer Dim pt As Point Dim hMap As Map = GetMap() @@ -127,7 +124,7 @@ Public Sub _Draw() ' Paint.Fill ' Endif - Case Shapes.Polyline + Case Me.Polyline For j = 0 To $hShapes[i].Points.Max pt = Geo.MapPointToPixel($hShapes[i].Points[0][j], hMap.zoom) hPoly.Add(pt.x - hMap.PixelBox.X) @@ -198,7 +195,6 @@ End Private Function GetPointBounds(hMapPoints As MapPoint[]) As MapBounds Dim hPoint As MapPoint - Dim hBounds As New RectF Dim X, Y, X2, Y2 As Float X = hMapPoints[0].Lon Y = hMapPoints[0].Lat diff --git a/comp/src/gb.map/.src/_MapTile.class b/comp/src/gb.map/.src/_MapTile.class index 4235270d4..2b73263ee 100644 --- a/comp/src/gb.map/.src/_MapTile.class +++ b/comp/src/gb.map/.src/_MapTile.class @@ -242,7 +242,7 @@ Private Function MakeDir(Path As String) As Boolean Next - If _MapTileCache.Debug Then Debug "Création du Dossier: " & sDir + If Map._Debug Then Debug "Création du Dossier: " & sDir Catch diff --git a/comp/src/gb.map/.src/_ViewLayer.class b/comp/src/gb.map/.src/_ViewLayer.class index 328ff9084..27f5f3ebb 100644 --- a/comp/src/gb.map/.src/_ViewLayer.class +++ b/comp/src/gb.map/.src/_ViewLayer.class @@ -54,7 +54,6 @@ End Public Sub _MouseMove() Dim hMv As MapView = GetMapView() - Dim iMouse As Integer = hMv.Mouse Dim iZoom As Integer 'hMv.Mouse = Mouse.Default If $colSprite!plus.Rect.Contains(Mouse.X, Mouse.Y) Then diff --git a/comp/src/gb.map/.startup b/comp/src/gb.map/.startup index 0115ce168..4755ee41f 100644 --- a/comp/src/gb.map/.startup +++ b/comp/src/gb.map/.startup @@ -1,4 +1,4 @@ -Form1 +FMain gb.map 0 0