Caching mechanism enhanced + better downloading wip

This commit is contained in:
djes
2017-06-09 13:49:29 +02:00
parent bbf5be2efd
commit 1de62dfb16

222
PBMap.pb
View File

@@ -124,7 +124,7 @@ Module PBMap
URL.s URL.s
CacheFile.s CacheFile.s
GetImageThread.i GetImageThread.i
RetryNb.i Download.i
EndStructure EndStructure
Structure BoundingBox Structure BoundingBox
@@ -288,6 +288,7 @@ Module PBMap
Redraw.i Redraw.i
Dragging.i Dragging.i
Dirty.i ; To signal that drawing need a refresh Dirty.i ; To signal that drawing need a refresh
MemoryCacheManagement.i ; To pause web loading threads
List TracksList.Tracks() ; To display a GPX track List TracksList.Tracks() ; To display a GPX track
List Markers.Marker() ; To diplay marker List Markers.Marker() ; To diplay marker
@@ -881,7 +882,7 @@ Module PBMap
PreferenceGroup("OPTIONS") PreferenceGroup("OPTIONS")
\WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True) \WheelMouseRelative = ReadPreferenceInteger("WheelMouseRelative", #True)
\MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory \MaxMemCache = ReadPreferenceInteger("MaxMemCache", 20480) ;20 MiB, about 80 tiles in memory
\MaxThreads = ReadPreferenceInteger("MaxThreads", 40) \MaxThreads = ReadPreferenceInteger("MaxThreads", 10)
\TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited \TileLifetime = ReadPreferenceInteger("TileLifetime", 1209600) ;about 2 weeks ; -1 = unlimited
\Verbose = ReadPreferenceInteger("Verbose", #False) \Verbose = ReadPreferenceInteger("Verbose", #False)
\Warning = ReadPreferenceInteger("Warning", #False) \Warning = ReadPreferenceInteger("Warning", #False)
@@ -900,7 +901,7 @@ Module PBMap
\ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255)) \ColourFocus = ReadPreferenceInteger("ColourFocus", RGBA(255, 255, 0, 255))
\ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255)) \ColourSelected = ReadPreferenceInteger("ColourSelected", RGBA(225, 225, 0, 255))
\ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150)) \ColourTrackDefault = ReadPreferenceInteger("ColourTrackDefault", RGBA(0, 255, 0, 150))
\TimerInterval = 20 \TimerInterval = 12
ClosePreferences() ClosePreferences()
EndWith EndWith
SetOptions() SetOptions()
@@ -1030,12 +1031,52 @@ Module PBMap
ProcedureReturn PBMap\Layers(Name)\Alpha ProcedureReturn PBMap\Layers(Name)\Alpha
EndProcedure EndProcedure
Procedure MemoryCacheManagement()
; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack)
Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
Protected CacheLimit = PBMap\Options\MaxMemCache * 1024
MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
If CacheSize > CacheLimit
PBMap\MemoryCacheManagement = #True
MyDebug(" Cache full. Trying cache cleaning", 5)
ResetList(PBMap\MemCache\ImagesTimeStack())
; Try to free half the cache memory (one pass)
While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > (CacheLimit / 2) ; /2 = half
Protected CacheMapKey.s = PBMap\MemCache\ImagesTimeStack()\MapKey
Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage
If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running
MyDebug(" Delete " + CacheMapKey, 5)
If IsImage(Image) ; Check if the image is valid
FreeImage(Image)
MyDebug(" and free image nb " + Str(Image), 5)
EndIf
DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey)
DeleteElement(PBMap\MemCache\ImagesTimeStack())
Else
; If the thread is running, try to abort the download
If PBMap\MemCache\Images(CacheMapKey)\Tile\Download
AbortHTTP(PBMap\MemCache\Images(CacheMapKey)\Tile\Download)
EndIf
EndIf
CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
Wend
PBMap\MemoryCacheManagement = #False
MyDebug(" New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
If CacheSize > CacheLimit
MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5)
ProcedureReturn 0
EndIf
EndIf
EndProcedure
;-*** These are threaded ;-*** These are threaded
Threaded nImage.i, LifeTime.i, MaxLifeTime.i
Procedure.i GetTileFromHDD(CacheFile.s) Procedure.i GetTileFromHDD(CacheFile.s)
Protected nImage.i, LifeTime.i, MaxLifeTime.i = PBMap\Options\TileLifetime MaxLifeTime.i = PBMap\Options\TileLifetime
If FileSize(CacheFile) > 0 ;<> -1 If FileSize(CacheFile) > 0 ;<> -1
;Manage tile file lifetime ; Manage tile file lifetime
If MaxLifeTime <> -1 If MaxLifeTime <> -1
LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created LifeTime = Date() - GetFileDate(CacheFile, #PB_Date_Modified) ;There's a bug with #PB_Date_Created
If LifeTime > MaxLifeTime If LifeTime > MaxLifeTime
@@ -1063,83 +1104,66 @@ Module PBMap
ProcedureReturn 0 ProcedureReturn 0
EndProcedure EndProcedure
; Procedure.i GetTileFromWeb(TileURL.s, CacheFile.s) ; **** OLD IMPORTANT NOTICE (please not remove)
; ;Debug TileURL ; This original catchimage/saveimage method is a double operation (uncompress/recompress PNG)
; If ReceiveHTTPFile(TileURL, CacheFile, #PB_HTTP_Asynchronous) ; and is modifying the original PNG image which could lead to PNG error (Idle has spent hours debunking the 1 bit PNG bug)
; MyDebug(" Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) ;Protected *Buffer
; ; Debug TileURL + " OK" ;Protected nImage.i = -1
; ProcedureReturn GetTileFromHDD(CacheFile) ;Protected timg
; Else ; *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous
; MyDebug(" Problem receving from web " + TileURL + " as CacheFile " + CacheFile, 3) ; If *Buffer
; ; Debug TileURL + " NOT OK" ; nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer))
; ProcedureReturn -1 ; If IsImage(nImage)
; EndIf ; If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;The 32 is needed !!!!
; **** (OLD) IMPORTANT NOTICE (please not remove) ; MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3)
; I'm (djes) now using Curl (actually, just normal pb) only, as this original catchimage/saveimage method is a double operation (uncompress/recompress PNG) ; Else
; and is modifying the original PNG image which could lead to PNG error (Idle has spent hours debunking the 1 bit PNG bug) ; MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3)
; More than that, the original Purebasic Receive library is still not Proxy enabled. ; EndIf
;Protected *Buffer ; FreeMemory(*Buffer)
;Protected nImage.i = -1 ; Else
;Protected timg ; MyDebug("Can't catch image loaded from web " + TileURL, 3)
; *Buffer = ReceiveHTTPMemory(TileURL) ;TODO to thread by using #PB_HTTP_Asynchronous ; nImage = -1
; If *Buffer ; EndIf
; nImage = CatchImage(#PB_Any, *Buffer, MemorySize(*Buffer)) ; Else
; If IsImage(nImage) ; MyDebug(" Problem loading from web " + TileURL, 3)
; If SaveImage(nImage, CacheFile, #PB_ImagePlugin_PNG, 0, 32) ;The 32 is needed !!!! ; EndIf
; MyDebug("Loaded from web " + TileURL + " as CacheFile " + CacheFile, 3) ; ****
; Else
; MyDebug("Loaded from web " + TileURL + " but cannot save to CacheFile " + CacheFile, 3) Threaded Progress = 0, Size = 0
; EndIf
; FreeMemory(*Buffer)
; Else
; MyDebug("Can't catch image loaded from web " + TileURL, 3)
; nImage = -1
; EndIf
; Else
; MyDebug(" Problem loading from web " + TileURL, 3)
; EndIf
; ****
; EndProcedure
Procedure GetImageThread(*Tile.Tile) Procedure GetImageThread(*Tile.Tile)
Protected Download, Progress, Size MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 5)
MyDebug("Thread starting for image " + *Tile\CacheFile + "(" + *Tile\key + ")", 3) *Tile\Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous)
Download = ReceiveHTTPFile(*Tile\URL, *Tile\CacheFile, #PB_HTTP_Asynchronous) If *Tile\Download
If Download
Repeat Repeat
Progress = HTTPProgress(Download) If PBMap\MemoryCacheManagement = #False ; Wait until cache cleaning is done
Select Progress Progress = HTTPProgress(*Tile\Download)
Case #PB_Http_Success Select Progress
Size = FinishHTTP(Download) Case #PB_Http_Success
MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 3) Size = FinishHTTP(*Tile\Download)
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread MyDebug(" Thread for image " + *Tile\CacheFile + " finished. Size : " + Str(Size), 5)
ProcedureReturn PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread
Case #PB_Http_Failed *Tile\Download = 0
MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 3) ProcedureReturn #True
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread Case #PB_Http_Failed
ProcedureReturn FinishHTTP(*Tile\Download)
Case #PB_Http_Aborted MyDebug(" Thread for image " + *Tile\CacheFile + " failed.", 5)
MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 3) PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread *Tile\Download = 0
ProcedureReturn ProcedureReturn #False
Default Case #PB_Http_Aborted
MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 3) FinishHTTP(*Tile\Download)
EndSelect MyDebug(" Thread for image " + *Tile\CacheFile + " aborted.", 5)
PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread
*Tile\Download = 0
ProcedureReturn #False
Default
MyDebug(" Thread for image " + *Tile\CacheFile + " downloading " + Str(Progress) + " bytes", 5)
EndSelect
EndIf
Delay(500) ; Frees CPU Delay(500) ; Frees CPU
ForEver ForEver
EndIf EndIf
; Repeat
; *Tile\nImage = GetTileFromWeb(*Tile\URL, *Tile\CacheFile)
; If *Tile\nImage <> -1
; *Tile\RetryNb = 0
; Else
; Delay(2000)
; *Tile\RetryNb - 1
; EndIf
; Until *Tile\RetryNb <= 0
; MyDebug(" Thread for image key " + *Tile\key + " finished", 3)
; *Tile\RetryNb = -2 ;End of the thread
; PostEvent(#PB_Event_Gadget, PBMap\Window, PBmap\Gadget, #PB_MAP_TILE_CLEANUP, *Tile) ;To free memory outside the thread
EndProcedure EndProcedure
;-*** ;-***
@@ -1148,9 +1172,9 @@ Module PBMap
; HDD, or launch a web loading thread, and try again on the next drawing loop. ; HDD, or launch a web loading thread, and try again on the next drawing loop.
Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key) Protected *timg.ImgMemCach = FindMapElement(PBMap\MemCache\Images(), key)
If *timg If *timg
MyDebug("Key : " + key + " found in memory cache", 3) MyDebug("Key : " + key + " found in memory cache", 5)
If *timg\nImage If *timg\nImage
MyDebug(" as image " + *timg\nImage, 3) MyDebug(" as image " + *timg\nImage, 5)
;*** Cache management ;*** Cache management
; Retrieves the image in the time stack, push it to the end (to say it's the lastly used) ; Retrieves the image in the time stack, push it to the end (to say it's the lastly used)
ChangeCurrentElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPtr) ChangeCurrentElement(PBMap\MemCache\ImagesTimeStack(), *timg\TimeStackPtr)
@@ -1158,36 +1182,10 @@ Module PBMap
;*timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack()) ;*timg\TimeStackPtr = LastElement(PBMap\MemCache\ImagesTimeStack())
;*** ;***
ProcedureReturn *timg ProcedureReturn *timg
Else
MyDebug(" but not the image.", 5)
EndIf EndIf
Else Else
;*** Cache management
; If cache size exceeds limit, try to delete the oldest tiles used (first in the time stack)
Protected CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 5 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
Protected CacheLimit = PBMap\Options\MaxMemCache * 1024
MyDebug("Cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
If CacheSize > CacheLimit
MyDebug(" Cache full. Trying cache cleaning", 5)
ResetList(PBMap\MemCache\ImagesTimeStack())
; Try to free half the cache memory (one pass)
While NextElement(PBMap\MemCache\ImagesTimeStack()) And CacheSize > (CacheLimit / 2) ; /2 = half
Protected CacheMapKey.s = PBMap\MemCache\ImagesTimeStack()\MapKey
Protected Image = PBMap\MemCache\Images(CacheMapKey)\nImage
If PBMap\MemCache\Images(CacheMapKey)\Tile = 0 ; Check if a loading thread is not already running
If IsImage(Image) ; Check if the image is valid
FreeImage(Image)
EndIf
DeleteMapElement(PBMap\MemCache\Images(), CacheMapKey)
DeleteElement(PBMap\MemCache\ImagesTimeStack())
MyDebug(" Delete " + CacheMapKey + " as image nb " + Str(Image), 5)
EndIf
CacheSize = MapSize(PBMap\MemCache\Images()) * Pow(PBMap\TileSize, 2) * 4 ; Size of a tile = TileSize * TileSize * 4 bytes (RGBA)
Wend
MyDebug(" New cache size : " + Str(CacheSize/1024) + " / CacheLimit : " + Str(CacheLimit/1024), 5)
If CacheSize > CacheLimit
MyDebug(" Cache cleaning unsuccessfull, can't add new tiles.", 5)
ProcedureReturn 0
EndIf
EndIf
; Creates a new cache element ; Creates a new cache element
*timg = AddMapElement(PBMap\MemCache\Images(), key) *timg = AddMapElement(PBMap\MemCache\Images(), key)
If *timg = 0 If *timg = 0
@@ -1228,7 +1226,6 @@ Module PBMap
\key = key \key = key
\URL = URL \URL = URL
\CacheFile = CacheFile \CacheFile = CacheFile
\RetryNb = 5
\nImage = 0 \nImage = 0
\GetImageThread = CreateThread(@GetImageThread(), *NewTile) \GetImageThread = CreateThread(@GetImageThread(), *NewTile)
If \GetImageThread If \GetImageThread
@@ -2424,6 +2421,7 @@ Module PBMap
; Redraws at regular intervals ; Redraws at regular intervals
Procedure TimerEvents() Procedure TimerEvents()
If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty) If EventTimer() = PBMap\Timer And (PBMap\Redraw Or PBMap\Dirty)
MemoryCacheManagement()
Drawing() Drawing()
EndIf EndIf
EndProcedure EndProcedure
@@ -2451,13 +2449,13 @@ Module PBMap
Procedure Quit() Procedure Quit()
PBMap\Drawing\End = #True PBMap\Drawing\End = #True
PBMap\MemoryCacheManagement = #True ; Tells web loading threads to pause
;Wait for loading threads to finish nicely. Passed 2 seconds, kills them. ;Wait for loading threads to finish nicely. Passed 2 seconds, kills them.
Protected TimeCounter = ElapsedMilliseconds() Protected TimeCounter = ElapsedMilliseconds()
Repeat Repeat
ForEach PBMap\MemCache\Images() ForEach PBMap\MemCache\Images()
If PBMap\MemCache\Images()\Tile <> 0 If PBMap\MemCache\Images()\Tile <> 0
If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread) If IsThread(PBMap\MemCache\Images()\Tile\GetImageThread)
PBMap\MemCache\Images()\Tile\RetryNb = 0
If ElapsedMilliseconds() - TimeCounter > 2000 If ElapsedMilliseconds() - TimeCounter > 2000
;Should not occur ;Should not occur
KillThread(PBMap\MemCache\Images()\Tile\GetImageThread) KillThread(PBMap\MemCache\Images()\Tile\GetImageThread)
@@ -2657,8 +2655,8 @@ CompilerIf #PB_Compiler_IsMainFile
;Our main gadget ;Our main gadget
PBMap::InitPBMap(#Window_0) PBMap::InitPBMap(#Window_0)
PBMap::SetOption("ShowDegrees", "1") : Degrees = 0 PBMap::SetOption("ShowDegrees", "1") : Degrees = 0
PBMap::SetOption("ShowDebugInfos", "0") PBMap::SetOption("ShowDebugInfos", "1")
PBMap::SetOption("Verbose", "0") PBMap::SetOption("Verbose", "1")
PBMap::SetOption("ShowScale", "1") PBMap::SetOption("ShowScale", "1")
PBMap::SetOption("Warning", "1") PBMap::SetOption("Warning", "1")
PBMap::SetOption("ShowMarkersLegend", "1") PBMap::SetOption("ShowMarkersLegend", "1")
@@ -2801,8 +2799,8 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf CompilerEndIf
; IDE Options = PureBasic 5.60 (Windows - x64) ; IDE Options = PureBasic 5.60 (Windows - x64)
; CursorPosition = 871 ; CursorPosition = 893
; FirstLine = 858 ; FirstLine = 894
; Folding = ------------------- ; Folding = -------------------
; EnableThread ; EnableThread
; EnableXP ; EnableXP