http://www.io-warnemuende.de/tl_files/s ... /rangs.pdf
Rangs is composed of 1° x 1° cells covering the globe with a resolution of 100m
mod rangs returns a list of nodes from the given region of interest specified with
longitude and latitudes as -180 west, 89 north , 180 east ,-90 south
It has 5 resolutions included: 0 < 100m : 1 = 200m : 2 = 1km :3 = 5km : 4 = 25km
usage
*ls.Rangs::NodeList = RANGS::Get_NodeList(lon1,lat1,lon2,lat2)
Each node in the list is either a start point, line segment or fill closing point, coordinates are in degrees
drawing is left up to the user
No license is specified for Rangs so assume it's public domain or gpl
Download ~85mb
https://www.dropbox.com/s/k6c7oqvqppn27 ... s.zip?dl=0
To do
add common map projection transforms
get a view centred node list from a given longitude latitude by view arc degrees longitude / latitude
To run the example make sure you set the compiler to create executable in source directory
Code: Select all
;MOD_RANGS (Regionally Accessible Nested Global Shorelines)
;Version 1.0 5/8/16 crossplatform in memory
;PB 5.42 LTS
;Author Idle
;RANGS (Regionally Accessible Nested Global Shorelines)
;A binary file set RANGS (Regionally Accessible Nested Global Shorelines)
;based on GSHHS (Global Self-consistent Hierarchical High-resolution Shorelines) Data.
;http://www.io-warnemuende.de/tl_files/staff/rfeistel/download/rangs.pdf
;download index
;http://www.io-warnemuende.de/rainer-feistel-downloads-de.html
;download files 0 to 4
;http://www.io-warnemuende.de/tl_files/staff/rfeistel/download/rangs(0).zip
;http://www.io-warnemuende.de/tl_files/staff/rfeistel/download/gshhs(0).zip
;unzip files to the source directory
;and set compiler option to create temporary executable in source folder
;Rangs is composed of 1°x 1° cells covering the globe
;mod rangs returns a list of nodes from the given region of interest
;specified with the longitude And latitudes as -180 west, 89 north , 180 east ,-90 south
;usage
;*ls.Rangs::NodeList = RANGS::Get_NodeList(lon1,lat1,lon2,lat2)
;Each node in the list is either a start point, line segment or fill closing point, coordinates are in degrees
;drawing is left up to the user
;No license is specified for Rangs so assume it's public domain or gpl
EnableExplicit
DeclareModule RANGS
Global OCEAN_COL.l
Global LAND_COL.l
Global LAKE_COL.l
Global ISLAND_COL.l
Global POND_COL.l
#OCEAN = 1
#LAND = 2
#LAKE = 4
#ISLAND = 8
#POND = 16
#POINT = 9
#LINE = 10
#FILL = 11
#ALL = #OCEAN | #LAND | #LAKE | #ISLAND | #POND
Structure Coordinates
x.f
y.f
EndStructure
Structure Node
NodeType.l ;#POINT,#LINE,#FILL
Color.l
StructureUnion
point.Coordinates ;start path
line.Coordinates ;line in path
fill.Coordinates ;close path
EndStructureUnion
EndStructure
Structure NodeList
List Nodes.Node()
EndStructure
Declare Get_NodeList(lon1, lat1, lon2, lat2, Resolution=0,ExtractItems=#ALL)
Declare Free_NodeList(*NodeList.NodeList)
Declare Init_Rangs()
Declare Free_Rangs()
EndDeclareModule
Module RANGS
EnableExplicit
Global hCEL.i
Global hCAT.i
Global *pRim.long
Global Dim *hRIM(5)
OCEAN_COL = RGBA(64,64,127,255)
LAND_COL = RGBA(0,127,0,255)
LAKE_COL = RGBA(0,64,127,255)
ISLAND_COL = RGBA(0,0,196,255)
POND_COL = RGBA(0,64,127,255)
Structure RANG_CAT
celaddress.l[0]
EndStructure
Procedure GetPolygons(*NodeList.NodeList,flags.i,diff.i,resolution=0)
Protected PolygonByte.a,SegmentByte.a,nPoints.i,PolyID.l,pt.l,addrim.l
Protected nnPoints.l,k.l,First.l,clr,x.l,y.l
Protected flg,xpnt.f,ypnt.f
First = 1
PolyID = PeekL(hCEL)
hcel+4
Repeat
segmentByte = PeekA(hCEL)
hcel+1
nPoints = SegmentByte & 7
Select nPoints
Case 0
Break
Case 1 To 6
For Pt = 1 To nPoints
x = PeekL(hcel)
hcel+4
y = PeekL(hcel)
hcel+4
If (flags & 1)
flg = (1 << (SegmentByte >> 4))
If (flags & flg)
xpnt = ((x * 0.000001)) + diff
ypnt = ((y * 0.000001))
If first
Select flg
Case #OCEAN
clr = OCEAN_COL
Case #LAND
clr = LAND_COL
Case #LAKE
clr = LAKE_COL
Case #ISLAND
clr = ISLAND_COL
Case #POND
clr = POND_COL
Default
clr = OCEAN_COL
EndSelect
AddElement(*NodeList\Nodes())
*NodeList\Nodes()\NodeType = #POINT
*NodeList\Nodes()\point\x = xpnt
*NodeList\Nodes()\point\y = ypnt
*NodeList\Nodes()\Color = clr
first = 0
Else
AddElement(*NodeList\Nodes())
*NodeList\Nodes()\NodeType = #LINE
*NodeList\Nodes()\line\x = xpnt
*NodeList\Nodes()\line\y = ypnt
*NodeList\Nodes()\Color = clr
EndIf
EndIf
EndIf
Next Pt
Case 7
addrim = PeekL(hcel)
hcel+4
nnPoints = PeekL(hcel)
hcel+4
If nnPoints
*prim = *hrim(resolution) + (addrim-1)
For k = 1 To nnPoints
x = *prim\l
*prim+4
y = *prim\l
*prim+4
flg = (1 << (SegmentByte >> 4))
If (flags & flg)
xpnt = ((x * 0.000001)) + diff
ypnt = ((y * 0.000001))
If first
Select flg
Case #OCEAN
clr = OCEAN_COL
Case #LAND
clr = LAND_COL
Case #LAKE
clr = LAKE_COL
Case #ISLAND
clr = ISLAND_COL
Case #POND
clr = POND_COL
Default
clr = OCEAN_COL
EndSelect
AddElement(*NodeList\Nodes())
*NodeList\Nodes()\NodeType = #POINT
*NodeList\Nodes()\point\x = xpnt
*NodeList\Nodes()\point\y = ypnt
*NodeList\Nodes()\Color = clr
first = 0
Else
AddElement(*NodeList\Nodes())
*NodeList\Nodes()\NodeType = #LINE
*NodeList\Nodes()\line\x = xpnt
*NodeList\Nodes()\line\y = ypnt
*NodeList\Nodes()\Color = clr
EndIf
EndIf
Next
EndIf
EndSelect
ForEver
If Not First
AddElement(*NodeList\Nodes())
*NodeList\Nodes()\NodeType = #FILL
*NodeList\Nodes()\fill\x = xpnt
*NodeList\Nodes()\fill\y = ypnt
*NodeList\Nodes()\Color = clr
EndIf
Repeat
PolygonByte = PeekA(hcel)
hcel + 1
If PolygonByte
GetPolygons(*NodeList,flags,diff,resolution)
EndIf
Until Not PolygonByte
EndProcedure
Procedure Get_NodeList(lon1, lat1, lon2, lat2, Resolution=0,ExtractItems=#ALL)
Protected PolygonByte.a,*addr.RANG_CAT,cel.i,lat.l,lon.l,lon0.l,diff.l
Protected *NodeList.NodeList
*NodeList = AllocateStructure(NodeList)
Select Resolution
Case 0
*addr = ?RANGS_CAT0
Cel = ?RANGS_CEL0
Case 1
*addr = ?RANGS_CAT1
Cel = ?RANGS_CEL1
Case 2
*addr = ?RANGS_CAT2
Cel = ?RANGS_CEL2
Case 3
*addr = ?RANGS_CAT3
Cel = ?RANGS_CEL3
Case 4
*addr = ?RANGS_CAT4
Cel = ?RANGS_CEL4
Default
*addr = ?RANGS_CAT0
Cel = ?RANGS_CEL0
EndSelect
For Lat = lat1 To lat2 Step -1
For lon = lon1 To lon2
lon0 = (lon + 360) % 360
diff = lon - lon0
hCel = (cel + *addr\celaddress[((89 - Lat) * 360 + lon0)]) -1
PolygonByte = PeekA(hcel)
hcel+1
If PolygonByte
GetPolygons(*NodeList,ExtractItems,diff,resolution)
EndIf
Next lon
Next Lat
ProcedureReturn *NodeList
EndProcedure
Procedure Init_Rangs()
Protected a,error.s
Protected Dim frim.i(5)
frim(0) = ReadFile(#PB_Any,"gshhs(0).rim")
frim(1) = ReadFile(#PB_Any,"gshhs(1).rim")
frim(2) = ReadFile(#PB_Any,"gshhs(2).rim")
frim(3) = ReadFile(#PB_Any,"gshhs(3).rim")
frim(4) = ReadFile(#PB_Any,"gshhs(4).rim")
For a = 0 To 4
If IsFile(frim(a))
*hrim(a) = AllocateMemory(Lof(frim(a)))
If *hrim(a)
If ReadData(frim(a),*hrim(a),Lof(frim(a))) <> Lof(frim(a))-1
CloseFile(frim(a))
Else
error.s = "couldn't read rim file " + Str(a)
Goto READFILE_ERROR
EndIf
Else
error.s = "couldn't allocate memory for rim file " + Str(a)
Goto READFILE_ERROR
EndIf
Else
error.s = "couldn't open rim file " + Str(a)
Goto READFILE_ERROR
EndIf
Next
ProcedureReturn
READFILE_ERROR:
For a = 0 To 4
If IsFile(frim(a))
CloseFile(frim(a))
EndIf
Next
MessageRequester("Rangs Error",error)
End
EndProcedure
Procedure Free_Rangs()
Protected a
For a = 0 To 4
FreeMemory(*hrim(a))
Next
EndProcedure
Procedure Free_NodeList(*NodeList.NodeList)
FreeStructure(*NodeList)
EndProcedure
DataSection
RANGS_CAT0:
IncludeBinary "rangs(0).cat"
RANGS_CAT1:
IncludeBinary "rangs(1).cat"
RANGS_CAT2:
IncludeBinary "rangs(2).cat"
RANGS_CAT3:
IncludeBinary "rangs(3).cat"
RANGS_CAT4:
IncludeBinary "rangs(4).cat"
RANGS_CEL0:
IncludeBinary "rangs(0).cel"
RANGS_CEL1:
IncludeBinary "rangs(1).cel"
RANGS_CEL2:
IncludeBinary "rangs(2).cel"
RANGS_CEL3:
IncludeBinary "rangs(3).cel"
RANGS_CEL4:
IncludeBinary "rangs(4).cel"
RANGS_EOF:
EndDataSection
EndModule
CompilerIf #PB_Compiler_IsMainFile
Procedure DrawMap(Image,Lon1,Lat1,Lon2,Lat2,Resolution=0,ExtractItems=rangs::#ALL)
Protected ScaleLeft.i,ScaleTop.i
Protected Sfx.f,Svx.f,Sfy.f,Svy.f,Count.i
sfx = (1-360) / Abs(lon2-lon1)
svx = (1-ImageWidth(image)) / (1-360.0)
ScaleLeft = lon1
sfy.f = (89--90) / (lat2-lat1)
svy.f = (1-ImageHeight(image)) / (89--90)
ScaleTop = lat1
Protected *ls.Rangs::NodeList = RANGS::Get_NodeList(lon1,lat1,lon2,lat2,resolution,ExtractItems)
If *ls
StartVectorDrawing(ImageVectorOutput(image))
ForEach *ls\Nodes()
If *ls\Nodes()\NodeType = RANGS::#POINT
MovePathCursor((Scaleleft-*ls\Nodes()\point\x)*sfx*svx,(ScaleTop-*ls\Nodes()\point\y)*sfy*svy)
ElseIf *ls\Nodes()\NodeType = RANGS::#fill
ClosePath()
VectorSourceColor(RGBA(0,0,0,255))
StrokePath(1,#PB_Path_Preserve)
VectorSourceColor(*ls\Nodes()\Color)
FillPath()
ElseIf *ls\Nodes()\NodeType = RANGS::#line
AddPathLine((Scaleleft-*ls\Nodes()\line\x)*sfx*svx,(ScaleTop-*ls\Nodes()\line\y)*sfy*svy)
EndIf
Next
StopVectorDrawing()
count = ListSize(*ls\Nodes())
RANGS::Free_NodeList(*ls)
ProcedureReturn count
EndIf
EndProcedure
Procedure Pan(image)
Protected a ,count,st,nt,srt,nrt
a = 0
nt = ElapsedMilliseconds()
While a <> 340
If ElapsedMilliseconds() > nt
StartDrawing(ImageOutput(image))
Box(0,0,ImageWidth(image),ImageHeight(image),0)
StopDrawing()
srt = ElapsedMilliseconds()
count = DrawMap(image,a,60,((a+40)),40,2)
nrt = ElapsedMilliseconds() - srt
StartDrawing(ImageOutput(image))
DrawText(50,50,Str(a) + " Degrees " + Str(count) + " nodes " + Str(nrt) + " ms")
StopDrawing()
SetGadgetState(1,ImageID(image))
a+1
nt = ElapsedMilliseconds() + (20)
Else
Delay(0)
EndIf
Wend
EndProcedure
Define output,EV
rangs::Init_Rangs()
output=CreateImage(#PB_Any,1020,570,32)
Drawmap(output,174,-36,176,-37,0) ;idles play ground
;DrawMap(output,0,89,360,-90,4) ;world level 4
;DrawMap(output,-15,60,15,50,1, rangs::#OCEAN| rangs::#LAND);uk
;DrawMap(output,-15,60,15,50,1) : uk all features
OpenWindow(0,0,0,1020,570,"Rangs")
ImageGadget(1,0,0,1020,570,ImageID(output))
;CreateThread(@Pan(),output) ;pan across northern hemisphere
Repeat
Ev = WaitWindowEvent()
Until EV = #PB_Event_CloseWindow
rangs::Free_Rangs()
End
CompilerEndIf
)