WheelMouse zoom

and minors modifications in prefs and code cleaning
This commit is contained in:
djes
2016-08-05 11:20:08 +02:00
parent 2a25fd6e9f
commit 51524d0a33

173
PBMap.pb
View File

@@ -26,7 +26,6 @@ UsePNGImageEncoder()
DeclareModule PBMap
;-Show debug infos
Global Verbose = #False
;-Proxy ON/OFF
Global Proxy = #False
Declare InitPBMap()
Declare SetMapServer(ServerURL.s="http://tile.openstreetmap.org/",TileSize.l=256,ZoomMin.l=0,ZoomMax.l=18)
@@ -115,6 +114,10 @@ Module PBMap
CallBackPointer.i ; @Procedure(X.i, Y.i) to DrawPointer (you must use VectorDrawing lib)
EndStructure
Structure Option
WheelMouseRelative.i
EndStructure
;-PBMap Structure
Structure PBMap
Gadget.i ; Canvas Gadget Id
@@ -137,15 +140,17 @@ Module PBMap
HDDCachePath.S ; Path where to load and save tiles downloaded from server
MemCache.TileMemCach ; Images in memory cache
;
Moving.i
Moving.i ;
Dirty.i ; To signal that drawing need a refresh
;
MainDrawingThread.i
List TilesThreads.TileThread()
;
MainDrawingThread.i ;
List TilesThreads.TileThread() ;
;
List track.Location() ; To display a GPX track
List Marker.Marker() ; To diplay marker
EditMarkerIndex.l
EditMarkerIndex.l ;
;
Options.option ;
EndStructure
Global PBMap.PBMap, Null.i
@@ -163,7 +168,7 @@ Module PBMap
EndIf
EndProcedure
;- *** CURL specific ***
;- *** CURL specific
; (program has To be compiled in console format for curl debug infos)
IncludeFile "libcurl.pbi" ; https://github.com/deseven/pbsamples/tree/master/crossplatform/libcurl
@@ -239,31 +244,34 @@ Module PBMap
PBMap\Drawing\Semaphore = CreateSemaphore()
PBMap\EditMarkerIndex = -1 ;<- You must initialize with No Marker selected
PBMap\Font = LoadFont(#PB_Any, "Arial", 20, #PB_Font_Bold)
;- Proxy details
;-Options
PBMap\Options\WheelMouseRelative = #True
;-Preferences
;Use this to create and customize your preferences file for the first time
; Result = CreatePreferences(GetHomeDirectory() + "PBMap.prefs")
; If Proxy
; PreferenceGroup("PROXY")
; WritePreferenceString("ProxyURL", "myproxy.fr")
; WritePreferenceString("ProxyPort", "myproxyport")
; WritePreferenceString("ProxyUser", "myproxyname")
; EndIf
; If Result
; ClosePreferences()
; EndIf
Result = OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
; CreatePreferences(GetHomeDirectory() + "PBMap.prefs")
; ;Or this to modify
; ;OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
; ;Or this
; ;RunProgram("notepad.exe", GetHomeDirectory() + "PBMap.prefs", GetHomeDirectory())
; PreferenceGroup("PROXY")
; WritePreferenceInteger("Proxy", #True)
; WritePreferenceString("ProxyURL", "myproxy.fr")
; WritePreferenceString("ProxyPort", "myproxyport")
; WritePreferenceString("ProxyUser", "myproxyname")
; WritePreferenceString("ProxyPass", "myproxypass") ;TODO !Warning! !not encoded!
; ClosePreferences()
OpenPreferences(GetHomeDirectory() + "PBMap.prefs")
PreferenceGroup("PROXY")
Proxy = ReadPreferenceInteger("Proxy", #False)
If Proxy
PreferenceGroup("PROXY")
Global ProxyURL$ = ReadPreferenceString("ProxyURL", "") ;InputRequester("ProxyServer", "Do you use a Proxy Server? Then enter the full url:", "")
Global ProxyPort$ = ReadPreferenceString("ProxyPort", "") ;InputRequester("ProxyPort" , "Do you use a specific port? Then enter it", "")
Global ProxyUser$ = ReadPreferenceString("ProxyUser", "") ;InputRequester("ProxyUser" , "Do you use a user name? Then enter it", "")
Global ProxyPassword$ = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "")
Global ProxyPassword$ = InputRequester("ProxyPass", "Do you use a password ? Then enter it", "") ;TODO
EndIf
If Result
ClosePreferences()
EndIf
curl_global_init(#CURL_GLOBAL_WIN32);
;- Main drawing thread launching
ClosePreferences()
curl_global_init(#CURL_GLOBAL_WIN32)
;- Main drawing thread launching
PBMap\MainDrawingThread = CreateThread(@DrawingThread(), @PBMap\Drawing)
If PBMap\MainDrawingThread = 0
Error("MapGadget : can't create main drawing thread.")
@@ -573,18 +581,18 @@ Module PBMap
Next
EndProcedure
Procedure Pointer(x.i, y.i, color.l = #Red)
color=RGBA(255, 0, 0, 255)
Procedure Pointer(x.i, y.i, color.l = 0)
VectorSourceColor(color)
MovePathCursor(x, y)
AddPathLine(-8,-16,#PB_Path_Relative)
AddPathCircle(8,0,8,180,0,#PB_Path_Relative)
AddPathLine(-8,16,#PB_Path_Relative)
AddPathLine(-8, -16, #PB_Path_Relative)
AddPathCircle(8, 0, 8, 180, 0, #PB_Path_Relative)
AddPathLine(-8, 16, #PB_Path_Relative)
;FillPath(#PB_Path_Preserve)
;ClipPath(#PB_Path_Preserve)
AddPathCircle(0,-16,5,0,360,#PB_Path_Relative)
AddPathCircle(0, -16, 5, 0, 360, #PB_Path_Relative)
VectorSourceColor(color)
FillPath(#PB_Path_Preserve):VectorSourceColor(RGBA(0, 0, 0, 255)):StrokePath(1)
FillPath(#PB_Path_Preserve):VectorSourceColor(color);RGBA(0, 0, 0, 255))
StrokePath(1)
EndProcedure
Procedure TrackPointer(x.i, y.i,dist.l)
@@ -627,7 +635,7 @@ Module PBMap
StrokePath(10, #PB_Path_RoundEnd|#PB_Path_RoundCorner)
;Draw Distance
ForEach PBMap\track()
;-Test Distance
;Distance test
If ListIndex(PBMap\track())=0
Location\Latitude=PBMap\track()\Latitude
Location\Longitude=PBMap\track()\Longitude
@@ -707,7 +715,7 @@ Module PBMap
If PBMap\CallBackMainPointer > 0
CallFunctionFast(PBMap\CallBackMainPointer, Drawing\CenterX, Drawing\CenterY)
Else
Pointer(Drawing\CenterX, Drawing\CenterY, #Red)
Pointer(Drawing\CenterX, Drawing\CenterY, RGBA($FF, 0, 0, $FF))
EndIf
StopVectorDrawing()
;Redraw
@@ -818,7 +826,43 @@ Module PBMap
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndProcedure
EndProcedure
;Zoom on x, y position relative to the canvas gadget
Procedure SetZoomOnPosition(x, y, zoom)
Protected MouseX.d, MouseY.d
Protected OldPx.d, OldPy.d, OldMx.d, OldMy.d
;Fast and dirty code
OldPx = PBMap\Position\x : OldPy = PBMap\Position\y
OldMx = OldPx + GadgetWidth(PBMap\Gadget) / 2 - x
OldMy = OldPy + GadgetHeight(PBMap\Gadget) / 2 - y
PBMap\Zoom = PBMap\Zoom + zoom
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
;Centered Zoom
LockMutex(PBMap\Drawing\Mutex)
LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing)
;Convert X, Y in tile.decimal into real pixels
PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize
PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize
MouseX = PBMap\Position\x + GadgetWidth(PBMap\Gadget) / 2 - x
MouseY = PBMap\Position\y + GadgetHeight(PBMap\Gadget) / 2 - y
;Cross-multiply to get the new center
PBMap\Position\x = (OldPx * MouseX) / OldMx
PBMap\Position\y = (OldPy * MouseY) / OldMy
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
EndProcedure
Procedure SetCallBackLocation(CallBackLocation.i)
PBMap\CallBackLocation = CallBackLocation
@@ -855,9 +899,8 @@ Module PBMap
Procedure Event(Event.l)
Protected Gadget.i
Protected MouseX.i, MouseY.i, OldPx.d, OldPy.d, OldMx.d, OldMy.d
Protected MouseX.i, MouseY.i
Protected Marker.Position
Protected *Drawing.DrawingParameters
If IsGadget(PBMap\Gadget) And GadgetType(PBMap\Gadget) = #PB_GadgetType_Canvas
Select Event
Case #PB_Event_Gadget ;{
@@ -866,37 +909,13 @@ Module PBMap
Case PBMap\Gadget
Select EventType()
Case #PB_EventType_MouseWheel
;Absolute zoom (centered on the center of the map)
; SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta),#PB_Relative)
;Relative zoom (centered on the center of the mouse)
OldPx = PBMap\Position\x : OldPy = PBMap\Position\y
OldMx = OldPx + GadgetWidth(PBMap\Gadget) / 2 - GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
OldMy = OldPy + GadgetHeight(PBMap\Gadget) / 2 - GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
PBMap\Zoom = PBMap\Zoom + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta)
If PBMap\Zoom > PBMap\ZoomMax : PBMap\Zoom = PBMap\ZoomMax : EndIf
If PBMap\Zoom < PBMap\ZoomMin : PBMap\Zoom = PBMap\ZoomMin : EndIf
;-*** Fill parameters and signal the drawing thread
LockMutex(PBMap\Drawing\Mutex)
LatLon2XY(@PBMap\TargetLocation, @PBMap\Drawing)
;Convert X, Y in tile.decimal into real pixels
PBMap\Position\x = PBMap\Drawing\Position\x * PBMap\TileSize
PBMap\Position\y = PBMap\Drawing\Position\y * PBMap\TileSize
MouseX = PBMap\Position\x + GadgetWidth(PBMap\Gadget) / 2 - GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
MouseY = PBMap\Position\y + GadgetHeight(PBMap\Gadget) / 2 - GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
PBMap\Position\x = (OldPx * MouseX) / OldMx
PBMap\Position\y = (OldPy * MouseY) / OldMy
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
EndIf
If PBMap\Options\WheelMouseRelative
;Relative zoom (centered on the mouse)
SetZoomOnPosition(GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY), GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_WheelDelta))
Else
;Absolute zoom (centered on the center of the map)
SetZoom(GetGadgetAttribute(PBMap\Gadget,#PB_Canvas_WheelDelta), #PB_Relative)
EndIf
Case #PB_EventType_LeftButtonDown
;Check if we select a marker
MouseX = PBMap\Position\x - GadgetWidth(PBMap\Gadget) / 2 + GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
@@ -914,11 +933,12 @@ Module PBMap
PBMap\MoveStartingPoint\x = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX)
PBMap\MoveStartingPoint\y = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY)
Case #PB_EventType_MouseMove
;If a move has been initiated by a left click
If PBMap\MoveStartingPoint\x <> - 1
MouseX = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseX) - PBMap\MoveStartingPoint\x
MouseY = GetGadgetAttribute(PBMap\Gadget, #PB_Canvas_MouseY) - PBMap\MoveStartingPoint\y
PBMap\Moving = #True
;move Marker
;If it's marker move
If PBMap\EditMarkerIndex > -1
SelectElement(PBMap\Marker(), PBMap\EditMarkerIndex)
LatLon2XY(@PBMap\Marker()\Location, @Marker)
@@ -929,19 +949,17 @@ Module PBMap
;New move values
PBMap\Position\x - MouseX
PBMap\Position\y - MouseY
;-*** Fill parameters and signal the drawing thread
;Fill parameters and signal the drawing thread
LockMutex(PBMap\Drawing\Mutex)
;PBMap tile position in tile.decimal
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
PBMap\Drawing\PassNb = 1
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
EndIf
;Start drawing
SignalSemaphore(PBMap\Drawing\Semaphore)
;- ***
;If CallBackLocation send Location to function
If PBMap\CallBackLocation > 0
CallFunctionFast(PBMap\CallBackLocation, @PBMap\TargetLocation)
@@ -952,9 +970,11 @@ Module PBMap
Case #PB_EventType_LeftButtonUp
PBMap\Moving = #False
PBMap\MoveStartingPoint\x = - 1
;Stop marker move
If PBMap\EditMarkerIndex > -1
PBMap\EditMarkerIndex = -1
Else ;Move Map
Else
;Stop map move
LockMutex(PBMap\Drawing\Mutex)
PBMap\Drawing\Position\x = PBMap\Position\x / PBMap\TileSize
PBMap\Drawing\Position\y = PBMap\Position\y / PBMap\TileSize
@@ -962,7 +982,6 @@ Module PBMap
XY2LatLon(@PBMap\Drawing, @PBMap\TargetLocation)
UnlockMutex(PBMap\Drawing\Mutex)
EndIf
EndSelect
EndSelect
EndSelect
@@ -1114,8 +1133,8 @@ CompilerIf #PB_Compiler_IsMainFile
CompilerEndIf
; IDE Options = PureBasic 5.42 LTS (Windows - x86)
; CursorPosition = 28
; FirstLine = 19
; CursorPosition = 1120
; FirstLine = 1077
; Folding = ---------
; EnableUnicode
; EnableThread