From 08e8a06008255539e53968a27d2a8e92817771ab Mon Sep 17 00:00:00 2001 From: gambix <=gambas.fr@gmail.com> Date: Thu, 19 Oct 2023 10:56:04 +0200 Subject: [PATCH] Bug on the tile ordering [GB.MAP] * BUG: _MapTile, Correction on bad file naming for tiles (curious artifact on httpClient.Tag). --- comp/src/gb.map/.icon.png | Bin 4928 -> 4365 bytes comp/src/gb.map/.src/Tests/Form7.class | 6 ++ comp/src/gb.map/.src/Tests/Form7.form | 3 +- comp/src/gb.map/.src/_MapTile.class | 140 +++++++++++++------------ 4 files changed, 83 insertions(+), 66 deletions(-) diff --git a/comp/src/gb.map/.icon.png b/comp/src/gb.map/.icon.png index b9dfb027328f21372cf84196f77c548d001c422d..4bb19602105d4024520a405af805733b4c68365e 100644 GIT binary patch literal 4365 zcmcIoXH=6-+I|vH5fl|giU=woAiar&j)EAa2n0f;C?LHky#xcuCmlfn4MOxK5=xMw zM5@3mh;->fOhD=V1ri|;a3{Mz_Q(F%-E+R3lXK>ICNq5MQ}OCLD1o5<12cWAupGx6jRF$TI*^L z4)%V}-bZ>N7i@X|fW?nK6V$Mhj*ll2ZoAcnJ5ki!lLfMMS}-F7fo1~L*r`v=@SJUB zvdsr&s{)GJc-(=3eS0p>n#m}sE>ycQ=6F?)=iC_*j$E<6JF27-apKYnipZ4T56u* zB#V18sgi|bbExs8M{vis_75(;mCluC-9-scKwcJx7w$+tm`U339#J(p6fNM|Hvi5g*m(Zo z$jm9|UPspZ!SpG*2w3BVs#rT3%9{d%_KHK;CN9WP2@VM+LI3X6pWcrZ5=E3chd!H| z>UUG>x!XMSUElIY!P2(_DSO8=f ztYp!*Z-n+O@AfvufG~np6eQ6^-_)XRZCu<@*?cNNnY)jCb1lTY|B#{jj-%z#hVQ+Z z4NDe!#=|)HEI0&q;Ov=<%{65W{?h}Pw`#RCKZIbFp`Z`e6 zFHX?ng`btC_3lozrh0ba)Maw-G3FN+2UslDLrk)&e7ra$>kP(iYlBMqouHl;h5ra~ zM3l7*h0K_2I~uEh8hj2OI^^l)b>onj_Q2#MVS0Kx*AD%gUNIFN4d>_QFRZGv85|s3 zV@9-hcO!#>$eN-wS)@3;tX)n)!Nb}4ih+RvHz%BXZw&6`OUnx)Dcf46xteJb$;ruD z+qhxi8h2iwJ9o|!jV>M?wY5Sb _fWV)1WKHPUJ1|spLU1RUCwOqTRrlv+{YcrNt zP&iAEn3$Ll78A36_^^Q$*>Fx)wlaLfXK;A9V}Wt@e%OUrh@ea%tLx~L)&{Q>5s5|| z92_`2KFeDwI4a%m0%?0=Wnp(`dwyZT0)wd^rBJM_t%=qS81+IOp2Dk8pQW1c;OuOH zg2P7=jb`7~)%9j_MnO()cDgHDSVUwX<>cjo(b1xW1a2}{-!a%Vi{Vm-;X(^yzzR+4 z>X|}^RKLhb`z!^!zOP@O{8}8z%efr<;FZ$BBUrV&6tbvR7$H$WalZ3~s;!O9Zo&m% ziK4g+8R^7a?9cXCR~ z{6L|_eN#r|`}YNTc?JtZCH|9fwJxakuC76fZ$rtiU%#F!{^h1tw7l$-oRma}(3U#{ z^Lx!?hT46MKy55j6PY0f1~I&%ng!p#e?MkQwgf=^TBa6zQ^+k55qIzEvt6gOVHfwa ztxSZoF?N|&UreLXo^SW4tE-32H!D)h}pJ8BByJ3yg|JDS{W+^rjrl#^6@bli`-tSP?Xc3 zKMZ9F2@Cf%HtKe^lD#SUpFbN~i<+&6XpYu}zQbi_J9P_iaRzMv^4@p$)4JdB#;eB# z1Q-CnRt&K&f?4s_zJBZbOx#9&PEL-ZT1SVrsRW<7ns73c!6TsH)}Mc~y|XjoHLC0Z z7d9~|DQUJl=kooH4Dqxt2)woF&~)&bo}&l$s%vVJYHDf-ozczJzUV$PvbPSp&9#y{ zRv&PP$bo<(@NqssALgeHUvm>u{J``0Q;q*jil|QHB3*iu1LhZRCQWcunxzZM`UC_# zGv%q_`p4MgLt>Y-J||@3aDAPf2WnvoO?tXnf})}+q1e*$a&r(c=wIsrK|!B2&4O8* zs{&hPW-7VF;$qJ>R3hLDN2LOJG`TG06%R1d<~ok`5NTm?G*}WZuu7j6D~!mUpZBn< z4f1YtZz?ZWCPTNQ?Vzl<4@`$!x6*$arxOVTiRr6)78VxDrTn_{AQ0k$w@Rz3F0?$A zFf}(f??hxuNlA^s{q}?Ftqw6Zm=Q9$5}`lkPi7W{3yzomeL<|N{Im*h) z8joWUhar;S2h80g2=;^x6MVPW>*QekpCRbI*RnUr*Ocjt$sPrk^>NfyEe&`MC= zTv)`hW5=3VTbr992~x(n@$vD`VbXGP&OD8h?C<#bTUcRrfw2CjZ{KV>*LNZt#xfFd z&*R3T5zUv!#18E3UyG~urT|U?$B5hsV_y~#W%ox-jjerYaN7)QYkND8KHKY}liDu} z-$9X5&xhCBdw(m7l83TRK?*_WoX#w)0TnhsKXH85tQxBvJs_%EH#RsHo^1*a}agEp@3qd-0->S{qzk zTB|g;+fR!>n>sK+;Mm9OC+n9b4k=`1Wf4ZN0CUhp91+{I!UR{q%!BXJ&Ea-Th(4Mu;ZxmH{bz#2;X#JXw$Asv7T3`U#HWtIs)2?5?9hpF>T21o^|A^sU0g?Z_YiQlw?HwdA2DbFh1+IIf|k<9u8#`AN{40fJw#x5 z_OjQnqiVNFe4LK_WpW4r)L^DO`n`MqS&(AN9_C_80z0=E7#QGbZ3O0h^-34S1h8`N z=j0P0k7?m~m~k2^zH#qfK8O%@%GjDJ<{1`dtE#FB2nj?(|G>brvr;Bx`qs1p+N>~?^$Qz>@Uc<2epmM4@c0rGpbmQuuh^!uvjt4m624#nG z66%HIF6K(ZpPX{I6Q3`Zq`(X#{l1fS`(yN7qS3YRMYu%4U8kr0;)2Dbx4m;m*vY<` z%g*_o9?xuv)!q?H;14ZUC#)*nYy0yETJR^YUb6JPnH24e!SiukgwI>;m((j4ElfU+ z&6)R!wnFKzUJ>*uluMI}n497p8pm+Lf3IuG|54ZMX*pNyX*rm`)ZR9;%h9F_rAu5c z)y>Wx>zkhb@KSV-&G{hM|9fqlqQLV}u$+HO{^ukY)=9tN>U+WRlQ~VjP^bJAMh87w zrT+UkY#NpH4Tp}qbP3dsTt*{s=w-9=e_LYj#|VGT)N%r4@YJF!4t8{Bbu`;}@**EM zR?_oZCe@{_-E=Y(s;knWVISw@a{TLm24JKyVN+-IQ=nbv`w|j+g7H<8D{u83qyGlf CNe(Fh literal 4928 zcmbVQc|6qX_kU)FF*G#DzRMC>vt(;bs4Q8Mq-@hf36-6YM%Hd586j)7x-FJ$Wosf! zc1mPRl$}xb48D*1z4zbyTjuqdIiGVr&vKUMyw91>9SgG)tStO20034aLjy|y5bzcO zFlb2Zyq;cygxSOJoHqb$?{~k5#Di=C0C4;=GB|1#kTySTf6~f-glUnslg1Y%E)-Sa z*ME$9FX!Rqvq}nXa$=nvr=*?-oz9RlS3Y%xRBcn3I_X+9{5`UME!&eD=veSi;as0Qv)%{x3shslvS3e^QEo(3{rj=PPA7p zc_v=sKcU(@usbeClbu^BC^mRG5m}>8=%0CXpyUAyxMCP5?ExE)s=Sox8+!~rEdd~`%>l(BGsG2n%g%#-BhbpFo9zld zJsfSw%p{FK@&XpzuL-*JUNJoH(+}RvJc12fsvaDoWJDI)3`qef0$&<~izb?Etijx6 zt^_FcM&yw9zydnqJS5!G2oiW2n?U}>3tGk{vJRnvCx-dpB4}dCC)Wux z+RtfKMb|Ebp*PC&-5909(WaQ^Cbrl1K^yCFY>0EBPAofdbSDl_szY#ps;yiHY{HUd zE~$RsJ4`Rk{!*q8hPaQ|U8L=BPM+E6ZA(m(17STvwT~GwJToxX%^+%eIzewAq1Hz% zo)Um(cDa9s2e?K)Q2C7g-us+e%jEf73^sd%ZidLvVlm5!{ewKd+LfpSc! zFZl=xfN&}9KL0oC1X-SKcMdRG_6jhGLLahb$4Y4Zsiq zS!*oWsc7l+!;3&7G(Gc`5Q-?@zaeu%34A7}XL>QBh-#2+QUccSsTV7XDB1IALsFEH zXgn%L7753dSc=Pv#_ro;bkeu1LxsvBBz%uM9^wTD?-z9Jxc}fWM`+50n&eY;5m)V! z1JZhQ$?h#LxGaT32`|rZDFFw`_H+@P3ew98xr4j(LRzZSc0j*rT^GNli6S6;rH_k- zD_?YG#gfl96DCC>?h7f!JXhx2=@G7KyuP|4_ozqr_7oQ{_z6v@S1M4L8jznacB4ya z>pJtIMA`g8EE!Rw$L8p{ylCp4{tY8FEPz%~8UWDN{nKO~5GSP@WP|`5prwX_PcY+PJA03-`>_2;UKFvpM-pxfD3_pq?B=z35oZA z8Rnbap;%5KJ&cGbas{Kdu1rS{z>%dBc=U1i$-x`eYjC4Od8>$A7H!=hENH4MbbP@D z@B#^0el(S3mnDH0P`MwnXzIaT_9Cd>eX4~f2*SxM|B%0}A@dY1CAjkL+Tp7Vpyo5L zRs#VQD-jt^&hs}+IJ?)B$Fg{(5N-EN9C~*-jfHt~`p=ysWo# zG-xKxc~Y9oCg=zV<&!BJ5fHgfZ*0+uw#qwa57^H|AqcrjXb=yP$bjV{z{$ky3WS-H z#hLaB%lT^v?l6y{K(Agj^0`}!q-BdH*aF-9cN@07CfZU?K^bEjupC|dRCx&#BmM7Wt6Iw~UKX z4V@Ve;HmBz>)+89V>tZekkikS?cuS@=0-#yK|}d%w{dpTqk4Uvw9$lL&t57J&RDkG zDyfWgZz@(Zy5qNgbEWreih|^mva&Mypcrl2geGRPA;eYj2xSnxuMvn^LfrT_fj7d7 zLg9!vWPn#mNy%$}nsD7WB`GN>C1vGMY4Z$G{+oVF`;%HDs;hM<6iQZZE`viM4?c76 zwThtWC~2JuDKz2Ujo-^MdXI5vCMI?)T3Ji$j}IS=cq8K%k1Q=MC1++fEibFyekTeD zeZKp6cyg*?4SOpBmq<)Z^w3Jjh6&bzX7FA@3pc_Eq+%P()}X~vgs@Hk zd9dPoPEiq#i;K&})%EsQT2#TT%!`Z{a30ChxUI7@=j~e&dwY8fI!wt_<;PoT?z=l)C~R1enqWD$y|uYcU+RRx8^1=|BW7V^6Mb`Y zHLoTE{yr`$Qo3fCoPUR?6y1s6#IDi4Mo|vUuUL5T0`W%d3fL^JJRc+d-SOja9-cY$i3Ry+VG&?ZmzCfpFc;= z4^~_puJpZ9*fi}!+FYG?adXo*H8maTgB$M#KPPAZ-&;EKqHDKSZGC)w8-^$R-`HUo zkQ#x@2aHWj9$!h>eDX<^H7_r3SAqK79e<5YC$JS&>a+76Fd zRh0nD?1d#YH8l;7QNY6T;;ph73@w|W#(fWOQ9-ud5pg2A9Uji599SSQL!-rMYwZy$ zx;m&{T3$Xd!%K%d=+H2JVeY*j>Yplz$!nnf2xk zpQNN@xpr4ROuF{=_Qe35){MKybJl;)7Jl@~=8%j+5LHkpl*#1x9V>f#p=ZyZt5nus z&r>zk_w`kqnVA{G?+p8Yg?S}ff2MnO(Sj(jo2Xja+MIqZCP@n4dh$%%&aa*jxk)*B z#YnM9)zrt&kMuF$ly9T*fpufZOM?rKEim=<_0~!8>X2X}^sJMPDiT3|IE5oDEG#)A zqr8$*nv#*xI65loj~>9Fs8ZtbnA`7&1Ln)cmU7(sO1uUV9L1IUU|Umk$57&SclW91 zt%g;Qpvkc?6eK@C?u3K{xPc!e(FWo}*dpeTJw(p6h2gtFZS(^BDv!DTVlGALZinBB zZ|PoVR&q(25SHFUH#!EkDPgf}Y}u8SfoE1M0zHsLcMPJotgWr}FvVk;XFn`^J$v@d zdZog00=kw&B8e}I!}Q=QknrW`EvU;kD~F~SWP`=Pn*Yl1cznh;;{)tyvZ>CEUlI%B zej4M~Uvl(j{29dCH4E1e?>1(qkp#YopPI*lP2yiwgUI=&U*6mE*#}sPQ=3~`?{2OS z4cSE=G)gxpQvq{f2qGtpqNhmb1g(v;*Wvv6M}Kc2!9p%BF2vMlv!oatxo;-lYDWKLa`iLS|)wqPEEBK$+X~+EbTxtR2~>H0}Go zEp1p@?vae+B%8h-z9xBmd~A#aZwBo@S)GAOc~lJ_P*kj_j43^+s2DXkUtWpbjR$kZ zAnV(&d!zRISG1&=Nte5SsRKp3wqwLbmo^{>?A-GMu-up}z5+ z92==3d{mtqu3AehJ3ZlvEMga9fY?kAxivI-edu+uPu!6zdv=(e+uI>SuRZrK1VNo{ zx2GQVrdRNx$?a2>_ww`eUpKXOwzXyDWi1xDz>J&_op2R;`Uz{I>&vovLL6n zHiHLICIi#F=4Yb-gnz?;W_L$N5e2)~#JehtlM@pj-|85bS5_Ksj?AuPKYonZ*w_%< zxf+ci>g!>wtgJ+F7>VHaAFWBAKgW*gK==tuteNZ1Iq^E+r?`S+ZQ7z*C;p#dHjzQIOyQ)nM2)YrYPgXW>p)!!ct zOO0QMz(vrXj6=fJPMKaoc7>$~-P#o2$x^kKm) zOm|o_o)#85K8t_Fgc5DlaeU`T8;Sk(%ge{#Kj+C4>G8F_9&ha6h!gtyDD`VY&0M-B z%HS2HU>0gqXM4RS!vE_{p8xh6o^NGON}7Hwa&G0G`%=Qx+uPgR*=asY%ULD?r#EzZ z@Z8WFPHn$ADwPT#@+#}-#6YJxGwpquSpSW1;li$-MgBAg_mS!p>DBKTG=UAL2OA~# z;YzMl^{aXZ_SHdfh27Kf6DO24HQ!`!F(~%<3NwM z#n1BsBUrg_Ar=qIIJ+vm)h{etKeu!BXUP)@CGfy!w+9Eekc<9i$mxo8z8xWICbw>o zF%l)pXqJh;slt7COPJaO3OpyRX5>Ti`#`YZ-G-1`zn7;|t@|i@*5wI*$ob{$IMBsf zSknG?jq*Q6{U3U3I3+nRi7|;onEK+Swlc|?&wyLmEie28W>&UnwH6@H=(X(E<5hY1 z`KS{@=36KsF;UHiA0QVAS)W_@qhFAmCvV-`{Qs%<@Y5Hv9*;`COrTn`RjJN4)(XOkKB_ diff --git a/comp/src/gb.map/.src/Tests/Form7.class b/comp/src/gb.map/.src/Tests/Form7.class index f5baf4d70..bc4418a15 100644 --- a/comp/src/gb.map/.src/Tests/Form7.class +++ b/comp/src/gb.map/.src/Tests/Form7.class @@ -1 +1,7 @@ ' Gambas class file + +Public Sub Form_Open() + + MapView1.Map.AddTile("OpenStreet", "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png", Null) + +End diff --git a/comp/src/gb.map/.src/Tests/Form7.form b/comp/src/gb.map/.src/Tests/Form7.form index 218ad0eb7..5bc147022 100644 --- a/comp/src/gb.map/.src/Tests/Form7.form +++ b/comp/src/gb.map/.src/Tests/Form7.form @@ -1,7 +1,8 @@ # Gambas Form File 3.0 { Form Form - MoveScaled(0,0,64,64) + MoveScaled(0,0,111,64) + Arrangement = Arrange.Fill { MapView1 MapView MoveScaled(0,2,64,61) } diff --git a/comp/src/gb.map/.src/_MapTile.class b/comp/src/gb.map/.src/_MapTile.class index 25b32d3a4..583154d7e 100644 --- a/comp/src/gb.map/.src/_MapTile.class +++ b/comp/src/gb.map/.src/_MapTile.class @@ -8,14 +8,14 @@ Property SubDomains As String[] 'Property Opacity As Float inherited '' Returns or sets Tile opacity. Property UseWebMapService As Boolean Property WMSArgs As Collection '' Defines the Static args for the server(build the url) -Property MaxBounds As MapBounds +Property MaxBounds As MapBounds Property CacheRefreshDelay As Integer '' Delay before refreshing an image in the cache. (By default 30 day) Property WMSProjection As String '' Set the projection used by the WMS server. Property Opacity As Float Property Header As String[] Use $aHeader Private $aStack As New String[] Private $aClients As New HttpClient[] -Private $iClientCount As Integer = 4 +Private $iClientCount As Integer = 10 Private $sCachePath As String ' = User.Home &/ ".cache/gb.map" Private $tmrGet As New Timer As "tmrGet" Private $aTiles As New String[] @@ -27,7 +27,7 @@ Private $aPreload As New String[] Private $bPreloadMode As Boolean Private $fGradStep As Float = 0.1 Private $bIsQuadKey As Boolean -Private $bLoading As Boolean +Private $bLoading As Boolean Private $iCli As Integer 'Private $iTileSource As Integer 'Property TileSource As Integer @@ -55,7 +55,7 @@ Public Sub _new(Optional CacheName As String) 'Dim hTable As Table 'db.Debug = True - + $prjLatLon = New Proj("epsg:4326") $sCachePath = Me._GetMap().DefaultCache @@ -71,28 +71,19 @@ Public Sub _new(Optional CacheName As String) Endif $sCachePath = sTempPath - - $aClients.Resize($iClientCount) - For i = 0 To $aClients.Max + + 'Init httpClient Array + For i = 0 To $iClientCount - 1 hClient = New HttpClient As "Client" - hClient.Async = True - With Me._GetMap() - If ._Proxy Then - hClient.Proxy.Auth = ._Proxy.Auth - hClient.Proxy.Type = ._Proxy.Type - hClient.Proxy.Host = ._Proxy.Host - hClient.Proxy.User = ._Proxy.User - hClient.Proxy.Password = ._Proxy.Password - Endif - End With - $aClients[i] = hClient - hClient.Timeout = 10 + $aClients.Add(hClient) Next + End ' svn checkout --username=gambix svn+ssh://gambas@svn.code.sf.net/p/gambas/code/gambas/trunk -' +' '' Draws the Maptile Layer + Public Sub Draw() Dim s As String @@ -118,7 +109,7 @@ Public Sub Draw() If hmap._ShowWithEffect Then Try Paint.DrawImage(hTile.Image, hTile.X * 256 - hMap.PixelBox.X, hTile.Y * 256 - hMap.PixelBox.Y,,, Min(hTile.Opacity, Me.Opacity)) '$fOpacity)) - If hTile.Opacity < Me.Opacity Then '$fOpacity Then + If hTile.Opacity < Me.Opacity Then '$fOpacity Then hTile.Opacity += $fGradStep Raise Refresh Endif @@ -166,7 +157,6 @@ Public Sub _Load() ' Dim sExec As String ' Dim bFirst As Boolean - '*********************************** mpFirst = Geo.PixelToMapPoint(Point(hMap.PixelBox.x, hMap.PixelBox.y), hmap.Zoom) @@ -190,7 +180,7 @@ Public Sub _Load() 'ptTileCenter = Geo.MapPointToTile(hMap.Center, hMap.Zoom) 'Print "Tile Center = " & ptTileCenter.x & " " & ptTileCenter.Y For Each sTileName In aTileOrder - ars = Split(sTileName, "/") + ars = Split(sTileName, "/") iY = CInt(ars[1]) iX = CInt(ars[2]) sTileName = Subst("&1-&2-&3-&4.png", hMap.Zoom, iY, iX, $iVersion) @@ -200,11 +190,11 @@ Public Sub _Load() hTile.Y = iY hTile.Z = hMap.Zoom hTile.Name = sTileName - If Exist($sCachePath &/ hTile.Name) Then + If Exist($sCachePath &/ hTile.Name) Then 'Print $db.Tables["tiles"] ' hresult = $db.Exec("Select * from tiles where name=&1", "toto") ' 'hresult = $DB.Find("tiles", "name=&1", hTile.Name) - ' + ' ' If hresult.Available And If $bCacheRefresh And If DateDiff(Now(), hresult!lastmodified, gb.Day) > $iCacheRefreshDelay Then ' ReLoadTile(hTile) ' Else @@ -215,7 +205,7 @@ Public Sub _Load() ' Else hTile.Status = _Tile.Normal Try hTile.Image = Image.Load($sCachePath &/ hTile.Name) - If Error Then + If Error Then 'Error "Image illisible -> " & hTile.Name ReLoadTile(hTile) Else @@ -246,7 +236,7 @@ Public Sub _Load() ' hTile.TryCount = 0 ' ReLoadTile(hTile) ' Endif - Endif + Endif $aTiles.Add(sTileName) Next @@ -255,8 +245,8 @@ Public Sub _Load() ' If hmap.Zoom > 1 Then ' ptFirst = Geo.MapPointToTile(mpFirst, hmap.Zoom - 1) ' ptLast = Geo.MapPointToTile(mpLast, hmap.Zoom - 1) - ' For iX = ptFirst.X To ptLast.X - ' For iY = ptFirst.Y To ptLast.Y + ' For iX = ptFirst.X To ptLast.X + ' For iY = ptFirst.Y To ptLast.Y ' sTileName = Subst("&1-&2-&3.png", hMap.Zoom - 1, iY, iX) ' If Exist($sCachePath &/ sTileName) Then Continue ' $aPreload.Push(sTileName) @@ -267,8 +257,8 @@ Public Sub _Load() ' If hmap.Zoom < 18 Then ' ptFirst = Geo.MapPointToTile(mpFirst, hmap.Zoom + 1) ' ptLast = Geo.MapPointToTile(mpLast, hmap.Zoom + 1) - ' For iX = ptFirst.X To ptLast.X - ' For iY = ptFirst.Y To ptLast.Y + ' For iX = ptFirst.X To ptLast.X + ' For iY = ptFirst.Y To ptLast.Y ' sTileName = Subst("&1-&2-&3.png", hMap.Zoom + 1, iY, iX) ' If Exist($sCachePath &/ sTileName) Then Continue ' $aPreload.Push(sTileName) @@ -288,14 +278,14 @@ Private Sub ReLoadTile(hTile As _Tile) 'Dim hresult As Result - If hTile.TryCount > 3 Then + If hTile.TryCount > 3 Then hTile.Status = _Tile.Error $tmrGet.Trigger Raise Refresh Return Endif 'If the tile exist then remove it - If Exist($sCachePath &/ hTile.Name) Then + If Exist($sCachePath &/ hTile.Name) Then Kill $sCachePath &/ hTile.Name Endif @@ -336,9 +326,9 @@ Catch End ' Private Function GetMap() As Map -' +' ' Return Object.Parent(Me) -' +' ' End Public Sub tmrGet_Timer() @@ -356,7 +346,7 @@ Public Sub tmrGet_Timer() sFile = $aPreload.Pop() Else $bLoading = $aStack.Count > 0 - If $aStack.count = 0 Then + If $aStack.count = 0 Then $bPreloadMode = True Return Endif @@ -377,15 +367,34 @@ End Private Sub GetClient() As HttpClient + Dim hClient As HttpClient For i As Integer = 0 To $aClients.max - If $aClients[i].Status = Net.Inactive Then Return $aClients[i] + If $aClients[i].Status = Net.Inactive Then + $aClients[i].Close + hClient = New HttpClient As "Client" + hClient.Async = True + hClient.Timeout = 10 + 'Setup proxy + With Me._GetMap() + If ._Proxy Then + hClient.Proxy.Auth = ._Proxy.Auth + hClient.Proxy.Type = ._Proxy.Type + hClient.Proxy.Host = ._Proxy.Host + hClient.Proxy.User = ._Proxy.User + hClient.Proxy.Password = ._Proxy.Password + Endif + End With + + $aClients[i] = hClient + Return hClient + Endif Next End Public Sub Client_Finished() - Dim hTile As _Tile + Dim hTile As _Tile 'Dim hresult As Result Dec $iCli @@ -393,7 +402,7 @@ Public Sub Client_Finished() hTile = $colTiles[Last.Tag] If Not hTile Then Goto Skip Try hTile.Image = Image.Load($sCachePath &/ hTile.Name) - If Error Then + If Error Then 'Error "Image illisible -> " & hTile.Name ReLoadTile(hTile) Return @@ -401,7 +410,7 @@ Public Sub Client_Finished() 'Print hTile.Name hTile.Status = _Tile.Normal 'If $bHaveCache Then $aNewTiles.Add(hTile.Name) - ' 'The tile have been loaded and the file is created so now + ' 'The tile have been loaded and the file is created so now ' 'we add an entry to the database ' hresult = $DB.Create("tiles") ' hresult!name = hTile.Name @@ -457,24 +466,24 @@ Private Function GetTileUrl(hTile As _Tile) As String End ' Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As String -' +' ' Dim hBound As MapBounds = Geo.TileBounds(X, Y, Z) ' Dim hbound2 As MapBounds ' ' Dim hbound2 As MapBounds = Geo.TileBounds(x + 1, y - 1, z) ' Dim hConv, hConv2 As MapBounds ' Dim sTemp As String ' Dim s As String -' +' ' If Not Me.MaxBounds.Collide(hbound) Then Return -' +' ' For Each s In $cWMSArgs -' -' sTemp &= "&" & $cWMSArgs.Key & "=" & s -' +' +' sTemp &= "&" & $cWMSArgs.Key & "=" & s +' ' Next -' -' If $cWMSArgs.Exist("bbox") Then -' +' +' If $cWMSArgs.Exist("bbox") Then +' ' 'Invertion de coordonée ' ' Print "de -> ", hbound.lat2, hbound.Lon, hbound.Lat, hbound.Lon2 ' ' hbound2 = $prjLatLon.TransformMBounds($prjWMS, hbound) @@ -491,7 +500,7 @@ End ' sTemp = Replace(sTemp, "{lon}", CStr(hbound.Lon)) ' sTemp = Replace(sTemp, "{lat2}", CStr(hbound.lat2)) ' sTemp = Replace(sTemp, "{lon2}", CStr(hbound.lon2)) -' +' ' Else ' If $cWMSArgs.Exist("tilerow") Or If $cWMSArgs.Exist("TILEROW") Then ' If InStr(sTemp, "{q}") Then @@ -500,32 +509,32 @@ End ' sTemp = Replace(sTemp, "{x}", CStr(X)) ' sTemp = Replace(sTemp, "{y}", CStr(Y)) ' sTemp = Replace(sTemp, "{z}", CStr(Z)) -' +' ' Endif ' Endif ' Endif -' -' 'sTemp = $sPattern & -' 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2 +' +' 'sTemp = $sPattern & +' 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2 ' Print sTemp ' Return $sPattern & "?" & sTemp -' +' ' End Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As String Dim hBound As MapBounds = Geo.TileBounds(X, Y, Z) ' Dim hbound2 As MapBounds = Geo.TileBounds(x + 1, y - 1, z) -' Dim hConv, hConv2 As MapBounds + ' Dim hConv, hConv2 As MapBounds Dim sTemp As String Dim s As String If Not Me.MaxBounds.Collide(hbound) Then Return For Each s In $cWMSArgs - sTemp &= "&" & $cWMSArgs.Key & "=" & s + sTemp &= "&" & $cWMSArgs.Key & "=" & s Next - If $cWMSArgs.Exist("bbox") Then + If $cWMSArgs.Exist("bbox") Then 'Print X, Y, Z, hbound.Lat, hbound.Lon, hbound.lat2, hbound.lon2 'Invertion de coordonée 'hbound = MapBounds(MapPoint(hBound.lat2, hBound.lon), MapPoint(hBound.lat, hBound.Lon2)) @@ -547,17 +556,17 @@ Private Function GetWMSTilept(X As Integer, Y As Integer, Z As Integer) As Strin sTemp = Replace(sTemp, "{x}", CStr(X)) sTemp = Replace(sTemp, "{y}", CStr(Y)) sTemp = Replace(sTemp, "{z}", CStr(Z)) - + Endif Endif Endif - 'sTemp = $sPattern & - 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2 + 'sTemp = $sPattern & + 'sTemp = $sPattern & "?bbox=" & hConv.Lat & "," & hConv.Lon & "," & hConv.Lat2 & "," & hConv.Lon2 'Print X, Y, Z, hbound.Lat, hbound.Lon, hbound.lat2, hbound.lon2 'Print X, Y, Z, Mid(sTemp, InStr(sTemp, "bbox")) - ' Print + ' Print ' Print Return $sPattern & "?" & sTemp @@ -569,7 +578,7 @@ Private Function GetTileUrlpt(X As Integer, Y As Integer, Z As Integer) As Strin Dim sTemp As String If $bUseWMS Then - sTemp = GetWMSTilept(X, Y, Z) + sTemp = GetWMSTilept(X, Y, Z) If Map.Debug Then Debug sTemp Return sTemp Else @@ -759,12 +768,13 @@ End '' Remove old files from cache. '' - iLastUse defines file age in days Public Sub ClearCache(Optional iLastUse As Integer) -'needs some testing... + 'needs some testing... + If $sCachePath = Null Or Len($sCachePath) < 5 Then Return If iLastUse Then Exec ["find", $sCachePath, "-mtime", "+" & Str(iLastUse), "-delete"] With ["PWD", $sCachePath] Else Exec ["rm", $sCachePath &/ "*"] Endif -End +End