Polygons to the world's end

Just starting out? Need help? Post your questions and find answers here.
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Polygons to the world's end

Post by BasicallyPure »

I have applied a new approach to the problem.
1. create a flat 2D map.
2. project each pixel one at a time to the sphere.
3. apply dithering as you go to prevent quantization patterns.

Try the 'Project Map' option and see what you think.

Code: Select all

; GlobeMap.pb
; drawing a 3D sphere with 2D graphics
; graphing latitude & longitude on sphere.
;
; by BasicallyPure, 1.24.2013
;
; map data and inspiration by Michael Vogal
;
; Windows, Linux
;

EnableExplicit

#winWidth = 850
#winHeight = 600
#imageWidth = 720
#imageHeight = 360
#LonSf = $80 / #PI ; scale factor to adjust longitude ($00 to $FF) to radians (-#PI to +#PI)
#LatSf = $100 / #PI ; scale factor to adjust latitude ($00 to $FF) to radians (-#PI/2 to +#PI/2)
#NumShapes = 132 ; number of separate areas contained in the data section.
#Scale = 2500

Declare DrawMap(grid,fill)
Declare GrabColorMap()
Declare ShowMap()
Declare ProjectMap()
Declare DrawGlobe()
Declare Grid()
Declare Rotate()
Declare ReColor()
Declare Verify(result, text.s)

Enumeration ;{
   #Canvas
   #ShowMap
   #projectMap
   #ShowGlobe
   #ShowGrid
   #Fill
   #TrkDistance
   #TrkPitch
   #TrkRoll
   #TrkYaw
   #ReColor
EndEnumeration ;}

Define flags = #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget
Verify(OpenWindow(0,0,0,#winWidth,#winHeight,"",flags),"OpenWindow")
SetWindowColor(0,$D5D6AE)
Verify(CreateImage(0,#imageWidth,#imageHeight,24),"CreateImage")
CanvasGadget(#Canvas,0,0,#imageWidth,#winHeight)
OptionGadget(#ShowMap,#imageWidth + 10,10,110,25,"show map")
OptionGadget(#projectMap,#imageWidth + 10,40,110,25,"Project Map")
OptionGadget(#ShowGlobe,#imageWidth + 10,70,110,25,"show globe")
CheckBoxGadget(#ShowGrid,#imageWidth + 10,105,110,25,"show grid")
CheckBoxGadget(#Fill,#imageWidth + 10,135,110,25,"fill")
flags = #PB_TrackBar_Vertical | #PB_TrackBar_Ticks
TrackBarGadget(#TrkPitch,#imageWidth +10 ,170,030,200,0,36,flags)
SetGadgetState(#TrkPitch,18)
TrackBarGadget(#TrkYaw, #imageWidth + 50 ,170,030,200,0,36,flags)
SetGadgetState(#TrkYaw,18)
TrackBarGadget(#TrkRoll,#imageWidth + 90 ,170,030,200,0,4,flags)
SetGadgetState(#TrkRoll,2)
TrackBarGadget(#TrkDistance,#imageWidth +10 ,390,030,200,10,30,flags)
ButtonGadget(#ReColor,#imageWidth + 50,390,80,30,"ReColor")

Global mid_imgX  = #imageWidth /2 - 1
Global mid_imgY  = #imageHeight/2 - 1
Global mid_canvX = #imageWidth /2 - 1
Global mid_canvY = #winHeight  /2 - 1
Global.d X3d, Y3d, Z3d, X2d, Y2d
Global.d Xrot = Radian(180), Yrot = Radian(180), Zrot = Radian(180)
Global distance.d = 10 ; viewing distance

Define.d x, y, SumX, SumY
Define.i i, j, ShapePointCount
Define.i grid = #False, fill = #False

Structure Pt
   lat.d
   lng.d
EndStructure

Structure Sh
   AvgLat.d
   AvgLon.d
   color.i
   List pointList.Pt()
EndStructure

Global Dim shape.Sh(#NumShapes)

Structure Cm
   color.i
   lon.d
   lat.d
EndStructure

Global Dim ColorMap.Cm(#imageWidth - 1, #imageHeight - 1)

;{ read in and scale the map data
Restore mapData
For i = 0 To #NumShapes
   Read.a ShapePointCount
   SumX = 0 : SumY = 0
   For j = 1 To ShapePointCount
      Read.a x : x = (x - $80)/#LonSf
      Read.a y : y = (y - $80)/#LatSf
      AddElement(shape(i)\pointList())
      shape(i)\pointList()\lng = x
      shape(i)\pointList()\lat = y
      SumX + x : SumY + y
   Next j
   shape(i)\AvgLon = SumX / ShapePointCount
   shape(i)\AvgLat = sumY / ShapePointCount
   shape(i)\color = $404040 + Random($808080)
Next i ;}

Macro Project_to_3D_Sphere
   X3d = Sin(x) * Cos(y)
   y3d = Sin(y)
   Z3d = Cos(x) * Cos(y)
EndMacro

Macro Project_3D_to_2D
   X2d = X3d / (distance - Z3d) * #Scale + mid_canvX
   Y2d = Y3d / (distance - Z3d) * #Scale + mid_canvY
EndMacro

Macro Plot_2D_Point()
   Project_to_3D_Sphere
   Rotate()
    ; only plot if located on the front hemisphere
   If Z3d >= 0
      Project_3D_to_2D
      Plot(X2d, Y2d, color)
   EndIf
EndMacro

SetGadgetState(#ShowGlobe,#True)
DrawGlobe()

;{ main loop
Repeat
   Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
         End
      Case #PB_Event_Gadget
         Select EventGadget()
            Case #ShowMap
               ShowMap()
            Case #projectMap
               GrabColorMap()
               ProjectMap()
            Case #ShowGlobe
               DrawGlobe()
            Case #ShowGrid
               grid = GetGadgetState(#ShowGrid)
               If GetGadgetState(#ShowMap) = #True
                  ShowMap()
               ElseIf GetGadgetState(#projectMap) = #True
                  ProjectMap()
               Else
                  DrawGlobe()
               EndIf
            Case #Fill
               fill = GetGadgetState(#Fill)
               If GetGadgetState(#ShowMap) = #True
                  ShowMap()
               ElseIf GetGadgetState(#projectMap) = #True
                  GrabColorMap() : ProjectMap()
               Else
                  DrawGlobe()
               EndIf
            Case #TrkDistance
               distance = GetGadgetState(#TrkDistance)
               If GetGadgetState(#projectMap) : ProjectMap() : Else
               DrawGlobe() : EndIf
            Case #TrkPitch
               Xrot = Radian(GetGadgetState(#TrkPitch)*10)
               If GetGadgetState(#projectMap) : ProjectMap() : Else
               DrawGlobe() : EndIf
            Case #TrkYaw
               Yrot = Radian(GetGadgetState(#TrkYaw)*10)
               If GetGadgetState(#projectMap) : ProjectMap() : Else
               DrawGlobe() : EndIf
            Case #TrkRoll
               Zrot = Radian(GetGadgetState(#TrkRoll)*90)
               If GetGadgetState(#projectMap) : ProjectMap() : Else
               DrawGlobe() : EndIf
            Case #ReColor
               Recolor()
         EndSelect
   EndSelect
   
ForEver ;}

Procedure ShowMap()
   Shared grid, fill
   StartDrawing(CanvasOutput(#Canvas))
      Box(0,0,#imageWidth,#winHeight,0)
      StopDrawing()
      DrawMap(grid, fill)
   SetGadgetAttribute(#Canvas,#PB_Canvas_Image,ImageID(0))
EndProcedure

Procedure DrawMap(grid,fill)
   Protected.d x, y, firstX, firstY, lastX, lastY
   Protected.i i
   Static  Antarctica = 82
   
   StartDrawing(ImageOutput(0))
   Box(0,0,#imageWidth,#imageHeight,$808080)
   
   For i = 0 To #NumShapes
      FirstElement(shape(i)\pointList())
      firstX = Degree(shape(i)\pointList()\lng)*2 + mid_imgX
      firstY = Degree(shape(i)\pointList()\lat)*2 + mid_imgY
      If i = Antarctica : firstX = 0 : firstY = #imageHeight : EndIf
      lastX = firstX : lastY = firstY
      
      ForEach shape(i)\pointList()
         x = Degree(shape(i)\pointList()\lng)*2 + mid_imgX
         y = Degree(shape(i)\pointList()\lat)*2 + mid_imgY
         LineXY(lastX,lastY,x,y,$FF00)
         lastX = x : lastY = y
      Next
      
      If i = Antarctica
         LineXY(lastX,lastY,#imageWidth,y,$FF00)
         x = #imageWidth : y = #imageHeight
      EndIf
      
      LineXY(x,y,firstX,firstY,$FF00)
      
      If fill = #True 
         x = Degree(shape(i)\AvgLon)*2 + mid_imgX
         y = Degree(shape(i)\AvgLat)*2 + mid_imgY
         FillArea(x,y,$FF00,shape(i)\color)
      EndIf
   Next i
   
   If fill : FillArea(0,0,$FF00,$FF0000) : EndIf ; ocean
   
   If grid = #True
      For i = 0 To #imageWidth Step 30
         LineXY(i,0,i,#imageHeight)
      Next i
      For i = 0 To #imageHeight Step 30
         LineXY(0,i,#imageWidth,i)
      Next i
   EndIf
   
   StopDrawing()
EndProcedure

Procedure GrabColorMap()
   Shared fill
   Protected x, y
   DrawMap(0, fill)
   StartDrawing(ImageOutput(0))
   For x = 0 To #imageWidth - 1
      For y = 0 To #imageHeight - 1
         ColorMap(x,y)\color = Point(x,y)
         ColorMap(x,y)\lon = Radian((x-360))/2.0 + Random(9) / (971.0)
         ColorMap(x,y)\lat = Radian((y-180))/2.0 + Random(9) / (1811.0)
      Next y
   Next x
   StopDrawing()
EndProcedure

Procedure ProjectMap()
   Shared grid
   Protected x.d, y.d, i, j
   StartDrawing(CanvasOutput(#Canvas))
   Box(0,0,#imageWidth,#winHeight,0)
   For i = 0 To #imageWidth -1
      For j = 0 To #imageHeight - 1
         x = ColorMap(i,j)\lon
         y = ColorMap(i,j)\lat
         Project_to_3D_Sphere
         Rotate()
         If Z3d > 0
            Project_3D_to_2D
            Plot(X2d,Y2d,ColorMap(i,j)\color)
         EndIf
      Next j
   Next i
   StopDrawing()
   If grid : grid() : EndIf
EndProcedure

Procedure DrawGlobe()
   Shared grid, fill
   Protected.i i, flag
   Protected.d firstX, firstY, Xp, Yp, x, y
   
   If GetGadgetState(#ShowGlobe) = #False : ProcedureReturn : EndIf
      
   StartDrawing(CanvasOutput(#Canvas))
   Box(0,0,#imageWidth,#winHeight,0)
   
   Circle(mid_canvX,mid_canvY,#Scale/distance,$FF4030)
   For i = 0 To #NumShapes
      flag = 0
      ForEach shape(i)\pointList()
         x = shape(i)\pointList()\lng
         y = shape(i)\pointList()\lat
         
         Project_to_3D_Sphere
         
         Rotate()
         
         If Z3d > 0
            Project_3D_to_2D
            
            If flag < 2
               If flag < 1 : firstX = X2d : firstY = Y2d : EndIf
               Xp = X2d : Yp = Y2d
               flag = 2
            EndIf
            
            LineXY(Xp,Yp,X2d,Y2d,0)
            Xp = X2d : Yp = Y2d
         ElseIf flag > 1
            flag = 1
         EndIf
      Next
      If flag > 1 And Z3d > 0
         LineXY(Xp,Yp,firstX,firstY,0) ; draw final line
         If fill = #True
            x = shape(i)\AvgLon
            y = shape(i)\AvgLat
            Project_to_3D_Sphere
            Rotate()
            Project_3D_to_2D
            FillArea(X2d,Y2d,0,shape(i)\color)
         EndIf
      EndIf
   Next i
   
   If fill = #True ; ocean fill
      For i = -240 To 120 Step 120
         If i = -240
            x = 0 : y = Radian(-90)
         Else
            x = Radian(i) : y = Radian(45)
         EndIf
         Project_to_3D_Sphere
         Rotate()
         Project_3D_to_2D
         If Z3d > 0
            FillArea(X2d,Y2d,0,$FF0000)
         EndIf
      Next i
   EndIf
   
   StopDrawing()
   If grid = #True : Grid() : EndIf
EndProcedure

Procedure Grid() ; draw grid
   Protected.d x, y, xi, yi
   Static color = $FFFFFF, init = #True
   Static.d x_lim_low, x_lim_high, y_lim_low, y_lim_high
   Static.d inc_1, inc_2
   
   If init = #True
      init = #False
      x_lim_low = Radian(-180)
      x_lim_high = Radian(179)
      y_lim_low = Radian(-90)
      y_lim_high = Radian(89)
      inc_1 = Radian(15)
      inc_2 = Radian(2)
   EndIf
   
   StartDrawing(CanvasOutput(#Canvas))
   x = x_lim_low
      Repeat ; draw latitude lines
         y = y_lim_low
         Repeat
            Plot_2D_Point()
            y + inc_1
         Until y > y_lim_high
         x + inc_2
      Until x > x_lim_high
      
      y = y_lim_low
      Repeat ; draw longitude lines
         x = x_lim_low
         Repeat
            Plot_2D_Point()
            x + inc_1
         Until x > x_lim_high
         y + inc_2
      Until y > y_lim_high
   StopDrawing()
EndProcedure

Procedure Rotate()
   Protected.d c, s, t
   ; do Z axiS rotation
   c = Cos(Zrot) : s = Sin(Zrot)
   t = s * X3d + c * Y3d
   X3d = c * X3d - s * Y3d
   Y3d = t
   
   ; do Y axix rotation
   c = Cos(Yrot) : s = Sin(Yrot)
   t = s * Z3d + c * X3d
   Z3d = c * Z3d - s * X3d
   X3d = t
   
   ; do X axis rotation
   c = Cos(Xrot) : s = Sin(Xrot)
   t = s * Y3d + c * Z3d
   Y3d = c * Y3d - s * Z3d
   Z3d = t
   
EndProcedure

Procedure Recolor()
   Protected i
   Shared fill
   SetGadgetState(#Fill, #True) : fill = #True
   
   For i = 0 To #NumShapes
      Select i
         Case 21,24,27 ; lakes
            shape(i)\color = $FF0000
         Default
            shape(i)\color = $404040 + Random($808080)
      EndSelect
   Next i
   
   If GetGadgetState(#ShowMap) = #True
      ShowMap()
   ElseIf GetGadgetState(#projectMap) = #True
      GrabColorMap() : ProjectMap()
   Else
      DrawGlobe()
   EndIf
   
EndProcedure

Procedure Verify(result, text.s)
   ;display message and terminate on error
   If result = 0
      MessageRequester("Error!", text + " failed to initalize")
      End
   EndIf
   ProcedureReturn result
EndProcedure

DataSection ;{
   mapData:
   Data.a 128,255,35,254,37,249,41,243,43,242,49,239,54,237,48,241,43,240,40,235,44,229,43,225,47,226,51,227,57,224,63,220,67,218,73,217,79,216,72,211,73,212,78,213,82,212,85,213,88,212,91,210,94,208,96,205
   Data.a 98,203,98,202,101,204,105,204,110,200,111,198,112,199,118,201,124,198,119,197,113,197,107,194,102,192,96,187,100,184,106,184,112,181,113,180,107,179,101,176,96,172,91,167,89,163,85,163,89,167,90
   Data.a 169,95,167,101,163,106,158,109,157,102,155,96,153,90,150,85,152,79,150,76,146,72,150,68,156,69,154,64,152,64,148,64,144,70,141,71,139,66,136,65,140,70,138,70,135,65,129,68,126,74,121,74,121,68,125
   Data.a 66,126,61,127,58,131,53,133,48,137,51,142,48,144,43,145,42,143,38,143,34,140,39,139,45,136,46,133,45,132,39,137,34,141,29,147,27,152,29,156,33,152,36,157,33,160,33,165,30,171,29,175,28,178,27,178
   Data.a 33,183,32,179,27,182,27,185,28,187,23,192,20,198,19,203,19,208,21,202,24,208,24,214,24,219,25,224,26,230,25,235,27,241,29,247,30,254,29,123,11,38,11,42,13,44,15,47,15,47,19,44,21,41,22,42,27,42
   Data.a 31,45,34,48,36,52,39,56,40,59,40,64,40,70,41,75,44,80,46,86,48,92,49,92,47,85,48,86,51,92,53,99,56,103,61,105,66,110,69,116,72,118,72,124,70,130,70,136,72,143,75,150,78,155,77,161,77,167,77,173
   Data.a 76,179,75,185,75,192,75,197,76,203,79,198,80,192,81,186,85,182,86,177,90,175,92,169,94,162,98,157,100,151,100,145,103,138,100,133,96,130,93,129,92,125,89,119,84,114,79,112,76,113,74,113,71,114,68
   Data.a 111,68,105,65,101,64,97,60,102,58,96,58,90,61,85,66,84,69,89,70,87,70,81,73,76,74,74,76,69,79,64,81,64,83,63,82,59,78,60,81,56,86,55,86,51,85,49,82,44,79,44,76,41,72,41,73,47,71,52,69,54,68,49,63
   Data.a 46,60,42,62,37,65,36,68,34,69,29,66,32,62,29,59,27,60,32,56,31,51,30,49,31,45,30,39,29,35,29,33,29,27,29,21,28,16,27,11,30,14,33,8,34,13,36,12,38,59,145,82,141,82,139,83,135,80,135,76,131,75,127
   Data.a 77,123,78,121,82,120,86,117,90,116,95,116,99,116,103,116,108,116,112,118,116,121,120,125,120,129,118,131,121,134,124,134,128,135,132,136,136,137,140,137,144,136,149,135,153,137,157,137,161,138,165
   Data.a 139,169,140,174,143,175,147,174,149,170,150,166,152,162,152,158,153,153,156,149,156,145,155,141,155,136,156,131,158,127,160,123,162,118,163,114,161,112,157,111,156,107,155,102,154,97,152,93,151
   Data.a 89,150,85,147,83,31,228,143,227,148,226,152,223,149,224,145,220,145,218,149,216,149,214,153,211,156,208,159,208,163,208,167,209,172,209,176,213,175,217,173,221,172,223,176,224,176,226,181,231,181
   Data.a 233,179,235,174,236,170,236,166,235,162,233,157,231,153,230,148,228,144,17,123,57,125,56,127,55,128,54,127,53,127,51,126,49,126,47,125,46,124,44,123,46,123,48,125,50,125,52,124,53,125,54,124,56
   Data.a 11,113,37,112,36,112,35,110,35,112,34,113,34,115,34,117,33,118,35,116,37,114,38,10,232,139,230,134,227,131,223,132,221,128,221,132,225,135,227,140,231,140,232,140,8,205,125,208,121,210,117,210,122
   Data.a 210,127,209,132,205,129,205,125,9,249,176,251,178,252,180,253,182,252,184,251,184,251,182,251,180,250,178,6,249,185,250,188,248,191,245,192,247,189,249,186,9,198,123,200,126,202,130,202,135,199
   Data.a 132,198,127,196,124,196,120,198,123,7,122,50,120,51,121,53,121,54,123,53,123,51,123,49,10,228,71,227,73,227,78,224,79,222,79,221,77,224,76,226,74,226,70,228,70,10,87,57,86,59,86,60,88,60,89,60,90
   Data.a 60,89,58,88,57,88,55,87,56,15,213,125,215,126,216,126,213,127,212,128,214,128,214,131,214,133,213,133,212,133,212,135,212,133,211,131,212,128,212,126,16,163,147,163,149,162,152,162,154,161,157,161
   Data.a 159,161,162,159,163,158,160,158,158,159,155,158,152,159,150,161,148,161,146,162,146,4,79,202,81,205,78,203,79,202,6,74,99,71,97,69,95,69,94,71,96,74,98,7,207,139,205,138,203,137,203,136,205,137
   Data.a 207,138,208,139,9,214,101,214,104,213,106,214,108,214,108,213,107,212,104,212,102,214,101,5,7,34,5,33,4,33,3,32,1,31,5,67,34,69,36,68,37,66,37,66,34,11,229,57,228,58,228,61,228,62,228,60,228,57
   Data.a 228,55,228,53,228,51,229,53,229,55,8,216,114,217,116,217,118,216,118,215,117,214,117,214,115,216,114,4,39,57,40,58,38,57,37,56,2,18,46,19,46,7,230,65,229,67,228,67,227,68,227,67,227,65,228,64,5
   Data.a 78,101,78,100,77,99,76,100,77,102,5,230,185,232,185,232,187,230,188,230,185,4,220,79,219,81,220,83,221,81,3,244,158,244,157,244,158,4,233,135,235,133,235,135,233,136,3,7,34,6,35,4,36,3,4,35,2,35
   Data.a 0,35,2,34,51,33,51,2,7,38,6,37,3,134,71,133,71,134,69,4,138,73,138,75,136,74,138,73,4,218,124,218,126,217,127,218,124,3,215,140,216,140,215,140,2,85,200,85,200,2,85,62,84,62,3,212,139,214,139,213
   Data.a 140,3,143,73,143,75,143,74,4,211,113,210,115,211,113,211,113,3,219,132,219,132,219,132,5,213,92,213,94,213,96,212,94,213,92,5,184,113,184,116,184,118,185,117,184,114,3,134,66,134,69,134,67,2,145
   Data.a 77,145,78,3,234,131,236,133,235,133,2,74,202,74,202,2,17,99,17,101,3,206,99,205,101,204,99,3,222,80,221,80,222,80,2,215,110,216,111,2,253,152,253,152,2,163,30,161,30,2,11,50,11,50,2,143,44,144,45
   Data.a 2,233,63,232,63,2,145,73,144,73,2,245,148,245,148,13,163,74,165,75,165,71,166,70,164,68,163,65,165,63,165,61,162,62,161,65,162,68,162,71,162,74,8,71,64,68,62,65,63,65,64,65,68,66,65,68,64,70,64
   Data.a 9,50,39,48,39,46,39,46,39,45,40,43,41,45,41,47,40,49,39,3,42,33,42,35,43,33,4,58,50,59,54,58,54,58,51,8,68,62,67,59,65,58,64,60,62,61,64,61,65,61,67,61,4,49,43,51,43,51,44,49,44,5,151,127,151,129
   Data.a 151,131,150,129,150,127,4,74,64,72,65,72,66,73,65,5,170,66,171,64,171,62,169,63,169,65,7,205,49,205,51,204,53,202,54,202,54,203,52,204,50,4,71,67,69,67,69,69,71,67,5,180,61,182,61,180,62,180,64
   Data.a 180,62,3,149,40,149,42,150,41,6,149,139,149,137,148,134,148,134,148,137,149,139,4,152,143,152,143,151,145,152,147,2,47,68,47,68,2,137,44,137,44,3,138,109,137,107,137,109,69,0,238,6,238,11,238,16
   Data.a 236,20,236,24,235,28,233,32,233,36,232,40,231,44,232,48,232,53,232,54,231,57,229,61,230,65,230,70,231,74,231,75,229,77,225,80,223,83,219,85,220,84,225,85,229,84,233,89,236,95,238,101,238,107,235
   Data.a 111,232,115,230,120,228,124,227,128,226,133,226,137,225,142,226,147,226,152,225,156,225,160,223,164,221,168,222,172,223,177,224,182,225,185,221,189,221,193,222,197,220,202,221,206,221,210,221,213
   Data.a 220,217,222,221,221,225,221,230,222,234,224,238,225,242,227,246,228,245,232,242,235,244,237,249,237,253,238,48,106,31,110,29,110,28,109,27,112,26,108,24,112,23,112,21,114,19,113,15,113,13,117,13
   Data.a 114,12,110,14,109,12,104,12,108,11,112,11,108,10,104,10,104,10,108,10,103,9,99,9,95,10,95,10,91,11,87,11,84,12,80,14,80,15,76,16,80,18,79,20,84,20,87,22,88,26,91,28,91,28,89,32,90,36,91,38,94,41
   Data.a 98,40,99,36,102,34,104,30,106,31,13,69,14,68,13,62,12,68,11,74,10,80,10,79,12,79,13,73,15,68,19,68,18,69,16,69,14,14,79,38,80,36,83,33,79,29,76,26,70,25,67,25,65,23,65,28,71,28,76,31,72,35,77,38
   Data.a 80,38,10,42,25,44,24,45,23,43,22,41,22,40,23,39,25,39,26,41,26,42,25,5,66,14,63,17,63,15,60,13,64,13,5,139,14,140,18,139,17,136,16,138,14,9,56,28,53,29,48,30,44,28,45,27,44,25,49,25,53,25,56,28
   Data.a 3,143,14,144,15,141,14,5,49,20,52,20,48,22,45,21,47,20,6,170,20,176,19,172,21,168,23,167,22,168,20,2,161,14,161,13,3,57,20,57,20,56,19,5,65,20,69,20,69,22,65,22,62,20,5,57,24,57,26,58,24,57,23,57
   Data.a 24,3,143,17,143,18,142,17,5,165,24,167,25,168,27,165,26,165,24,5,57,16,55,17,53,17,54,15,56,16,3,60,18,61,19,63,20,4,60,23,62,23,61,24,60,23,3,160,13,160,13,160,13,4,42,20,44,19,45,18,43,18,2,170
   Data.a 13,170,14,4,194,14,193,13,195,12,195,14,4,198,16,199,15,201,16,200,17,3,60,17,58,17,59,16,2,172,12,172,12,4,198,15,197,16,195,15,193,15,3,50,17,47,17,49,18,3,60,20,61,22,59,21,3,167,13,167,13,167
   Data.a 13,3,226,21,224,21,225,20,4,59,29,57,30,59,30,59,29,3,49,16,47,16,49,16,2,151,14,151,14,3,226,20,228,20,227,21,2,60,17,60,18,4,227,20,229,20,229,21,228,20,3,42,20,40,20,42,19,3,233,22,232,21,233
   Data.a 22,2,192,14,192,14,2,135,16,135,16,3,227,23,227,24,227,23,3,93,10,95,11,93,10,2,53,24,52,23,3,90,28,90,29,89,28,4,71,23,73,24,71,24,71,23,2,0,26,1,27,2,111,24,111,25,2,109,24,109,24,2,112,24,112,24
EndDataSection ;}
Last edited by BasicallyPure on Thu Jan 24, 2013 6:19 pm, edited 2 times in total.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
VB6_to_PBx
Enthusiast
Enthusiast
Posts: 627
Joined: Mon May 09, 2011 9:36 am

Re: Polygons to the world's end

Post by VB6_to_PBx »

BasicallyPure,

awesome code exampe !!! , thanks !

so many things , in such a short amount of code !
 
PureBasic .... making tiny electrons do what you want !

"With every mistake we must surely be learning" - George Harrison
User avatar
Michael Vogel
Addict
Addict
Posts: 2799
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Polygons to the world's end

Post by Michael Vogel »

BasicallyPure wrote:I have applied a new approach to the problem.
1. create a flat 2D map.
2. project each pixel one at a time to the sphere.
3. apply dithering as you go to prevent quantization patterns.

Try the 'Project Map' option and see what you think.
BasicallyPure, you are doing very interesting things :wink:
But as I understood it (by removing all randoms from your code), it's not easy to do the right filling, right? Depending on the rotation, I see same colors for parts of the sea and land or even the whole globe under water...

I made three things yesterday evening and the last one seems to work now:
1) sorting (shape parts) by their z values - absolute useless, brought nothing
2) splitting shapes to multiple shapes - when the dots of a shape show the pattern 'iiivviiiivvvvvii' (i=invisible, v=visible), I splitted it two polygons (ivvi and ivvvvvi): nice approach with good results, sometimes at least
3) removing 'useless' invisible points from a shape pattern, adding new one: 'iiivviiiivvvvvii' would remove the red 'i' and check, if the line between the remaining 'i' dots will go through the globe circle or not

So my code works now (hopefully), but has grown up and looks ugly - I have to go to work now, but will do some optical refreshes later on...
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Polygons to the world's end

Post by BasicallyPure »

Michael Vogel wrote:But as I understood it (by removing all randoms from your code), it's not easy to do the right filling, right? Depending on the rotation, I see same colors for parts of the sea and land or even the whole globe under water...
Right. I have given up on making the polygon fills work.
There are just too many problems.

I hope you succeed.

B.P.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
Michael Vogel
Addict
Addict
Posts: 2799
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Polygons to the world's end

Post by Michael Vogel »

BasicallyPure wrote: Right. I have given up on making the polygon fills work.
There are just too many problems.

I hope you succeed.

B.P.
My code seems to work 100% now (but I also was close to give up)...
I only added the flags (toggled with space, g, f and m) to see some internal things, the results don't look very nice :wink: If you want to see better, how it works, change the constant GlobeSize to 220 and replace the color of the box command from $FFffe0e0 to something like $A0ffe0e0. This will show that I move invisible dots out of the globe and sometimes even add additional dots there.

Code: Select all

Procedure Init()

	; My little World Version 1.5 – (c) 2013 by Michael Vogel

	#Dots=1054
	#Shapes=132

	#GlobeSize=400
	#GlobeWindow=480
	#GlobeRadius=#GlobeSize/2
	#GlobeCenter=#GlobeWindow/2
	#GlobePrecision=2<<28
	#GlobeSpace=#GlobeSize/1.33; ‹1.4142

	#Radiant=#PI/180
	#Rad090=#Radiant*90
	#Rad180=#Radiant*180
	#Rad360=#Radiant*360

	#Undefined=-#True

	#WhiteWorld=$F0FFFF
	#GreenWorld=$80FF80
	#BlueWorld=$F0F0FF
	#GrayWorld=$80808080

	#Gray  = $808080
	#Blue  = $FF0000
	#White = $FFFFFF
	#Black = $000000

	Protected i,j,count

	Global GlobeRotX=20
	Global GlobeRotY=-25

	Global FlagHidden=#True
	Global FlagMask=#True
	Global FlagFill=#True
	Global FlagGrid=#True


	; ~~ Data Structures ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	Structure DotType
		x.i
		y.i
		x_.i
		y_.i
		hidden.i
	EndStructure

	Structure ShapeType
		len.i
		start.i
	EndStructure

	Global Dim Dots.DotType(#Dots)
	Global Dim Shapes.ShapeType(#Shapes)

	Global Dim Polygon.l(666)
	Global PolygonCount
	Global PolygonDC


	; ~~ Read Simplified World ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	count=0
	For i=0 To #Shapes
		Shapes(i)\start=count
		Read.a Shapes(i)\len

		For j=1 To Shapes(i)\len
			Read.a Dots(count)\x
			Read.a Dots(count)\y
			Dots(count)\x=(Dots(count)\x/256.0*2-1)*#PI*#GlobePrecision
			Dots(count)\y=(Dots(count)\y/256.0-0.5)*#PI*#GlobePrecision
			count+1
		Next j
	Next i

	DataSection


		Data.a 128,255,35,254,37,249,41,243,43,242,49,239,54,237,48,241,43,240,40,235,44,229,43,225,47,226,51,227,57,224,63,220,67,218,73,217,79,216,72,211,73,212,78,213,82,212,85,213,88,212,91,210,94,208,96,205
		Data.a 98,203,98,202,101,204,105,204,110,200,111,198,112,199,118,201,124,198,119,197,113,197,107,194,102,192,96,187,100,184,106,184,112,181,113,180,107,179,101,176,96,172,91,167,89,163,85,163,89,167,90
		Data.a 169,95,167,101,163,106,158,109,157,102,155,96,153,90,150,85,152,79,150,76,146,72,150,68,156,69,154,64,152,64,148,64,144,70,141,71,139,66,136,65,140,70,138,70,135,65,129,68,126,74,121,74,121,68,125
		Data.a 66,126,61,127,58,131,53,133,48,137,51,142,48,144,43,145,42,143,38,143,34,140,39,139,45,136,46,133,45,132,39,137,34,141,29,147,27,152,29,156,33,152,36,157,33,160,33,165,30,171,29,175,28,178,27,178
		Data.a 33,183,32,179,27,182,27,185,28,187,23,192,20,198,19,203,19,208,21,202,24,208,24,214,24,219,25,224,26,230,25,235,27,241,29,247,30,254,29,123,11,38,11,42,13,44,15,47,15,47,19,44,21,41,22,42,27,42
		Data.a 31,45,34,48,36,52,39,56,40,59,40,64,40,70,41,75,44,80,46,86,48,92,49,92,47,85,48,86,51,92,53,99,56,103,61,105,66,110,69,116,72,118,72,124,70,130,70,136,72,143,75,150,78,155,77,161,77,167,77,173
		Data.a 76,179,75,185,75,192,75,197,76,203,79,198,80,192,81,186,85,182,86,177,90,175,92,169,94,162,98,157,100,151,100,145,103,138,100,133,96,130,93,129,92,125,89,119,84,114,79,112,76,113,74,113,71,114,68
		Data.a 111,68,105,65,101,64,97,60,102,58,96,58,90,61,85,66,84,69,89,70,87,70,81,73,76,74,74,76,69,79,64,81,64,83,63,82,59,78,60,81,56,86,55,86,51,85,49,82,44,79,44,76,41,72,41,73,47,71,52,69,54,68,49,63
		Data.a 46,60,42,62,37,65,36,68,34,69,29,66,32,62,29,59,27,60,32,56,31,51,30,49,31,45,30,39,29,35,29,33,29,27,29,21,28,16,27,11,30,14,33,8,34,13,36,12,38,59,145,82,141,82,139,83,135,80,135,76,131,75,127
		Data.a 77,123,78,121,82,120,86,117,90,116,95,116,99,116,103,116,108,116,112,118,116,121,120,125,120,129,118,131,121,134,124,134,128,135,132,136,136,137,140,137,144,136,149,135,153,137,157,137,161,138,165
		Data.a 139,169,140,174,143,175,147,174,149,170,150,166,152,162,152,158,153,153,156,149,156,145,155,141,155,136,156,131,158,127,160,123,162,118,163,114,161,112,157,111,156,107,155,102,154,97,152,93,151
		Data.a 89,150,85,147,83,31,228,143,227,148,226,152,223,149,224,145,220,145,218,149,216,149,214,153,211,156,208,159,208,163,208,167,209,172,209,176,213,175,217,173,221,172,223,176,224,176,226,181,231,181
		Data.a 233,179,235,174,236,170,236,166,235,162,233,157,231,153,230,148,228,144,17,123,57,125,56,127,55,128,54,127,53,127,51,126,49,126,47,125,46,124,44,123,46,123,48,125,50,125,52,124,53,125,54,124,56
		Data.a 11,113,37,112,36,112,35,110,35,112,34,113,34,115,34,117,33,118,35,116,37,114,38,10,232,139,230,134,227,131,223,132,221,128,221,132,225,135,227,140,231,140,232,140,8,205,125,208,121,210,117,210,122
		Data.a 210,127,209,132,205,129,205,125,9,249,176,251,178,252,180,253,182,252,184,251,184,251,182,251,180,250,178,6,249,185,250,188,248,191,245,192,247,189,249,186,9,198,123,200,126,202,130,202,135,199
		Data.a 132,198,127,196,124,196,120,198,123,7,122,50,120,51,121,53,121,54,123,53,123,51,123,49,10,228,71,227,73,227,78,224,79,222,79,221,77,224,76,226,74,226,70,228,70,10,87,57,86,59,86,60,88,60,89,60,90
		Data.a 60,89,58,88,57,88,55,87,56,15,213,125,215,126,216,126,213,127,212,128,214,128,214,131,214,133,213,133,212,133,212,135,212,133,211,131,212,128,212,126,16,163,147,163,149,162,152,162,154,161,157,161
		Data.a 159,161,162,159,163,158,160,158,158,159,155,158,152,159,150,161,148,161,146,162,146,4,79,202,81,205,78,203,79,202,6,74,99,71,97,69,95,69,94,71,96,74,98,7,207,139,205,138,203,137,203,136,205,137
		Data.a 207,138,208,139,9,214,101,214,104,213,106,214,108,214,108,213,107,212,104,212,102,214,101,5,7,34,5,33,4,33,3,32,1,31,5,67,34,69,36,68,37,66,37,66,34,11,229,57,228,58,228,61,228,62,228,60,228,57
		Data.a 228,55,228,53,228,51,229,53,229,55,8,216,114,217,116,217,118,216,118,215,117,214,117,214,115,216,114,4,39,57,40,58,38,57,37,56,2,18,46,19,46,7,230,65,229,67,228,67,227,68,227,67,227,65,228,64,5
		Data.a 78,101,78,100,77,99,76,100,77,102,5,230,185,232,185,232,187,230,188,230,185,4,220,79,219,81,220,83,221,81,3,244,158,244,157,244,158,4,233,135,235,133,235,135,233,136,3,7,34,6,35,4,36,3,4,35,2,35
		Data.a 0,35,2,34,51,33,51,2,7,38,6,37,3,134,71,133,71,134,69,4,138,73,138,75,136,74,138,73,4,218,124,218,126,217,127,218,124,3,215,140,216,140,215,140,2,85,200,85,200,2,85,62,84,62,3,212,139,214,139,213
		Data.a 140,3,143,73,143,75,143,74,4,211,113,210,115,211,113,211,113,3,219,132,219,132,219,132,5,213,92,213,94,213,96,212,94,213,92,5,184,113,184,116,184,118,185,117,184,114,3,134,66,134,69,134,67,2,145
		Data.a 77,145,78,3,234,131,236,133,235,133,2,74,202,74,202,2,17,99,17,101,3,206,99,205,101,204,99,3,222,80,221,80,222,80,2,215,110,216,111,2,253,152,253,152,2,163,30,161,30,2,11,50,11,50,2,143,44,144,45
		Data.a 2,233,63,232,63,2,145,73,144,73,2,245,148,245,148,13,163,74,165,75,165,71,166,70,164,68,163,65,165,63,165,61,162,62,161,65,162,68,162,71,162,74,8,71,64,68,62,65,63,65,64,65,68,66,65,68,64,70,64
		Data.a 9,50,39,48,39,46,39,46,39,45,40,43,41,45,41,47,40,49,39,3,42,33,42,35,43,33,4,58,50,59,54,58,54,58,51,8,68,62,67,59,65,58,64,60,62,61,64,61,65,61,67,61,4,49,43,51,43,51,44,49,44,5,151,127,151,129
		Data.a 151,131,150,129,150,127,4,74,64,72,65,72,66,73,65,5,170,66,171,64,171,62,169,63,169,65,7,205,49,205,51,204,53,202,54,202,54,203,52,204,50,4,71,67,69,67,69,69,71,67,5,180,61,182,61,180,62,180,64
		Data.a 180,62,3,149,40,149,42,150,41,6,149,139,149,137,148,134,148,134,148,137,149,139,4,152,143,152,143,151,145,152,147,2,47,68,47,68,2,137,44,137,44,3,138,109,137,107,137,109,69,0,238,6,238,11,238,16
		Data.a 236,20,236,24,235,28,233,32,233,36,232,40,231,44,232,48,232,53,232,54,231,57,229,61,230,65,230,70,231,74,231,75,229,77,225,80,223,83,219,85,220,84,225,85,229,84,233,89,236,95,238,101,238,107,235
		Data.a 111,232,115,230,120,228,124,227,128,226,133,226,137,225,142,226,147,226,152,225,156,225,160,223,164,221,168,222,172,223,177,224,182,225,185,221,189,221,193,222,197,220,202,221,206,221,210,221,213
		Data.a 220,217,222,221,221,225,221,230,222,234,224,238,225,242,227,246,228,245,232,242,235,244,237,249,237,253,238,48,106,31,110,29,110,28,109,27,112,26,108,24,112,23,112,21,114,19,113,15,113,13,117,13
		Data.a 114,12,110,14,109,12,104,12,108,11,112,11,108,10,104,10,104,10,108,10,103,9,99,9,95,10,95,10,91,11,87,11,84,12,80,14,80,15,76,16,80,18,79,20,84,20,87,22,88,26,91,28,91,28,89,32,90,36,91,38,94,41
		Data.a 98,40,99,36,102,34,104,30,106,31,13,69,14,68,13,62,12,68,11,74,10,80,10,79,12,79,13,73,15,68,19,68,18,69,16,69,14,14,79,38,80,36,83,33,79,29,76,26,70,25,67,25,65,23,65,28,71,28,76,31,72,35,77,38
		Data.a 80,38,10,42,25,44,24,45,23,43,22,41,22,40,23,39,25,39,26,41,26,42,25,5,66,14,63,17,63,15,60,13,64,13,5,139,14,140,18,139,17,136,16,138,14,9,56,28,53,29,48,30,44,28,45,27,44,25,49,25,53,25,56,28
		Data.a 3,143,14,144,15,141,14,5,49,20,52,20,48,22,45,21,47,20,6,170,20,176,19,172,21,168,23,167,22,168,20,2,161,14,161,13,3,57,20,57,20,56,19,5,65,20,69,20,69,22,65,22,62,20,5,57,24,57,26,58,24,57,23,57
		Data.a 24,3,143,17,143,18,142,17,5,165,24,167,25,168,27,165,26,165,24,5,57,16,55,17,53,17,54,15,56,16,3,60,18,61,19,63,20,4,60,23,62,23,61,24,60,23,3,160,13,160,13,160,13,4,42,20,44,19,45,18,43,18,2,170
		Data.a 13,170,14,4,194,14,193,13,195,12,195,14,4,198,16,199,15,201,16,200,17,3,60,17,58,17,59,16,2,172,12,172,12,4,198,15,197,16,195,15,193,15,3,50,17,47,17,49,18,3,60,20,61,22,59,21,3,167,13,167,13,167
		Data.a 13,3,226,21,224,21,225,20,4,59,29,57,30,59,30,59,29,3,49,16,47,16,49,16,2,151,14,151,14,3,226,20,228,20,227,21,2,60,17,60,18,4,227,20,229,20,229,21,228,20,3,42,20,40,20,42,19,3,233,22,232,21,233
		Data.a 22,2,192,14,192,14,2,135,16,135,16,3,227,23,227,24,227,23,3,93,10,95,11,93,10,2,53,24,52,23,3,90,28,90,29,89,28,4,71,23,73,24,71,24,71,23,2,0,26,1,27,2,111,24,111,25,2,109,24,109,24,2,112,24,112,24
	EndDataSection

EndProcedure
Procedure PolygonDot(x,y,mode=#True)

	If mode
		Polygon(PolygonCount)=x
		PolygonCount+1
		Polygon(PolygonCount)=y
		PolygonCount+1
		; DrawText(Polygon(PolygonCount-2),Polygon(PolygonCount-1)-10,Str(PolygonCount),#Black)
	Else
		PolygonCount=0
	EndIf

EndProcedure
Procedure PolygonCheck(x1,y1,x2,y2)

	Protected a1,a2
	Protected d1,d2
	Protected fall

	a1=ATan2(x1-#GlobeCenter,y1-#GlobeCenter)/#Radiant
	a2=ATan2(x2-#GlobeCenter,y2-#GlobeCenter)/#Radiant

	d1=Abs(a1-a2)

	If a1<0
		a1+360
	EndIf
	If a2<0
		a2+360
	EndIf

	d2=Abs(a1-a2)
	If d2>d1
		d2=#True
	Else
		d1=d2
		d2=#False
	EndIf

	If d1>090
		If d2
			If a1>180
				a1-360
			EndIf
			If a2>180
				a2-360
			EndIf
		EndIf

		y1=Sin((a1+a2)/2*#Radiant)*#GlobeSize+#GlobeCenter
		x1=Cos((a1+a2)/2*#Radiant)*#GlobeSize+#GlobeCenter
		PolygonDot(x1,y1)

	EndIf

EndProcedure
Procedure GlobeDot(x.f,y.f,color)

	Protected rx.f,ry.f
	Protected x_.f,y_.f

	rx=GlobeRotX*#Radiant
	ry=GlobeRotY*#Radiant

	x*#Radiant
	y*#Radiant

	x_=Sin(x-rx)*Cos(y)
	y_=Sin(y)*Cos(ry)-Cos(x-rx)*Cos(y)*Sin(ry)

	;	If x_>=-1 And x_<=1 And y_>=-1 And y_<=1
	If FlagHidden=0 Or Cos(x-rx)*Cos(y)*Cos(ry)+Sin(y)*Sin(ry)>=0
		Plot(x_*#GlobeRadius+#GlobeCenter,y_*#GlobeRadius+#GlobeCenter,color)
	EndIf
	;	EndIf

EndProcedure
Procedure GlobeDraw()

	Protected i,j,n,start,stop
	Protected x.f,y.f,rx.f,ry.f

	Enumeration
		#FlagInvisible
		#FlagInit
		#FlagVisible
	EndEnumeration


	; ~~ Calculate Dots ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	rx=GlobeRotX*#Radiant
	ry=GlobeRotY*#Radiant

	For i=0 To #Dots
		x=Dots(i)\x/#GlobePrecision
		y=Dots(i)\y/#GlobePrecision
		If FlagHidden And Cos(x-rx)*Cos(y)*Cos(ry)+Sin(y)*Sin(ry)<0
			Dots(i)\hidden=#True
		Else
			Dots(i)\hidden=#False
		EndIf
		Dots(i)\x_=(Sin(x-rx)*Cos(y))*#GlobeRadius
		Dots(i)\y_=(Sin(y)*Cos(ry)-Cos(x-rx)*Cos(y)*Sin(ry))*#GlobeRadius
	Next i


	; ~~ Draw Background ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	PolygonDC=StartDrawing(CanvasOutput(0))
	Circle(#GlobeCenter,#GlobeCenter,#GlobeRadius,#BlueWorld)
	DrawingMode(#PB_2DDrawing_Transparent)
	DrawingFont(FontID(0))


	; ~~ Shapes ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	Protected DotFirst,DotLast,DotMode

	If FlagFill

		For i=0 To #Shapes

			n=#False
			start=Shapes(i)\start
			stop=start+Shapes(i)\len-1

			For j=start To stop
				If Dots(j)\hidden
					x.f=Sqr(Dots(j)\x_*Dots(j)\x_+Dots(j)\y_*Dots(j)\y_)
					If x
						x=#GlobeSpace/x
						Dots(j)\x_*x
						Dots(j)\y_*x
					EndIf
				Else
					n+1
				EndIf
				Dots(j)\x_+#GlobeCenter
				Dots(j)\y_+#GlobeCenter
			Next j

			If n
				DotFirst=#Undefined;							n/a
				DotLast=#Undefined;							n/a
				DotMode=#True;								hidden dots

				PolygonDot(#Undefined,#Undefined,#False)

				For j=start To stop

					If Dots(j)\hidden; 							...[i]...
						If DotMode;							..i[i]...
							DotLast=j;											set second 'i' [i.....i]
						Else;									..v[i]...
							PolygonDot(Dots(j)\x_,Dots(j)\y_);				set dot (i)
							DotFirst=j;											set first 'i'
							DotLast=#Undefined;								= [i....?]
							DotMode=#True;									hidden
						EndIf

					Else;										...[v]...
						If DotLast>=0;						..i[v]...
							If DotFirst>=0;					.vi···i[v]...
								PolygonCheck(Dots(DotFirst)\x_,Dots(DotFirst)\y_,Dots(DotLast)\x_,Dots(DotLast)\y_)
							EndIf
							PolygonDot(Dots(DotLast)\x_,Dots(DotLast)\y_);	set dot(i)
						EndIf
						PolygonDot(Dots(j)\x_,Dots(j)\y_);					set dot (v)
						DotLast=#Undefined;									clear
						DotFirst=#Undefined;									= [?...?]
						DotMode=#False;										visible

					EndIf
				Next j

				If Dots(start)\hidden=#False;					[V]...
					If DotLast>=0;							[V]...VIi...i{i}
						PolygonCheck(Polygon(PolygonCount-2),Polygon(PolygonCount-1),Dots(stop)\x_,Dots(stop)\y_)
						PolygonDot(Dots(stop)\x_,Dots(stop)\y_)
					EndIf

				Else;											[i]...
					If DotMode=#False;						{I}iiIV....VVV
						PolygonDot(Dots(start)\x_,Dots(start)\y_)
						PolygonCheck(Polygon(0),Polygon(1),Dots(start)\x_,Dots(start)\y_)
					Else;										i..IV...VI...i
						PolygonCheck(Polygon(0),Polygon(1),Polygon(PolygonCount-2),Polygon(PolygonCount-1))
					EndIf
				EndIf

				If i<63
					n=#GreenWorld
				ElseIf i<82
					n=#BlueWorld
				Else
					n=#WhiteWorld
				EndIf

				n=CreateSolidBrush_(n)
				SelectObject_(PolygonDC,n)
				Polygon_(PolygonDC,@Polygon(),PolygonCount>>1)
				DeleteObject_(n)

				;DrawText(Dots(start)\x_,Dots(start)\y_,Str(i),#Red)

			EndIf

		Next i

	Else

		For i=0 To #Shapes
			start=Shapes(i)\start
			stop=start+Shapes(i)\len-1
			For j=start To stop-1
				If FlagHidden=0 Or Dots(j)\hidden+Dots(j+1)\hidden=#False
					LineXY(Dots(j)\x_+#GlobeCenter,Dots(j)\y_+#GlobeCenter,Dots(j+1)\x_+#GlobeCenter,Dots(j+1)\y_+#GlobeCenter,$FFFF0000)
					; If (j-start)%10=0
					;	Box(Dots(j)\x_+#GlobeCenter,Dots(j)\y_+#GlobeCenter,2,2,$80000000)
					;	DrawText(Dots(j)\x_+#GlobeCenter,Dots(j)\y_+#GlobeCenter,Str(j-start),$FF00FF00)
					; EndIf
				EndIf
			Next j
		Next i

	EndIf


	; ~~ Grid ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	If FlagGrid

		DrawingMode(#PB_2DDrawing_AlphaBlend)

		#GridLarge=15
		#GridSmall=1

		i=-180-#GridLarge
		While i<180
			i+#GridLarge
			j=-90-#GridSmall
			While j<90
				j+#GridSmall
				GlobeDot(i,j,#GrayWorld)
			Wend
		Wend

		i=-90-#GridLarge
		While i<90
			i+#GridLarge
			n=Abs(i)/30+1
			j=-180-n
			While j<180
				j+n
				GlobeDot(j,i,#GrayWorld)
			Wend
		Wend

	EndIf


	; ~~ Shadow ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	If FlagMask
		DrawingMode(#PB_2DDrawing_AlphaBlend)
		DrawImage(ImageID(0),0,0)
	EndIf


	; ~~ Info ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

	DrawingMode(#PB_2DDrawing_Default)
	DrawText(5,5," "+Str(GlobeRotX)+" / "+Str(GlobeRotY)+" Flags: "+Left("*",FlagHidden)+Left("F",FlagFill)+Left("G",FlagGrid)+Left("M",FlagMask)+"  ",$ff000000,#BlueWorld)

	StopDrawing()


EndProcedure

Procedure Main()

	Init()

	LoadFont(0,"Arial",8)
	OpenWindow(0,0,0,#GlobeCenter<<1,#GlobeCenter<<1,"World by Michael Vogel  •  use cursor keys, 'space', 'f', 'g' and 'm'...",#PB_Window_ScreenCentered)
	CanvasGadget(0,0,0,#GlobeCenter<<1,#GlobeCenter<<1)

	AddKeyboardShortcut(0,#PB_Shortcut_Escape,#PB_Shortcut_Escape)
	AddKeyboardShortcut(0,#PB_Shortcut_Left,#PB_Shortcut_Left)
	AddKeyboardShortcut(0,#PB_Shortcut_Right,#PB_Shortcut_Right)
	AddKeyboardShortcut(0,#PB_Shortcut_Up,#PB_Shortcut_Up)
	AddKeyboardShortcut(0,#PB_Shortcut_Down,#PB_Shortcut_Down)
	AddKeyboardShortcut(0,#PB_Shortcut_Space,#PB_Shortcut_Space)
	AddKeyboardShortcut(0,#PB_Shortcut_F,#PB_Shortcut_F)
	AddKeyboardShortcut(0,#PB_Shortcut_G,#PB_Shortcut_G)
	AddKeyboardShortcut(0,#PB_Shortcut_M,#PB_Shortcut_M)

	CreateImage(0,#GlobeWindow,#GlobeWindow,32)
	StartDrawing(ImageOutput(0))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#GlobeCenter<<1,#GlobeCenter<<1,$FFffe0e0)
	DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AllChannels)

	BackColor($40FFFFFF)
	GradientColor(0.2,$40FFFFFF)
	GradientColor(0.75,$40000000)
	FrontColor($40000000)

	CircularGradient(#GlobeSize/3+#GlobeCenter-#GlobeRadius,#GlobeSize/3+#GlobeCenter-#GlobeRadius,#GlobeSize)
	Circle(#GlobeCenter,#GlobeCenter,#GlobeRadius)

	DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
	Circle(#GlobeCenter,#GlobeCenter,#GlobeRadius,$10000000)
	Circle(#GlobeCenter,#GlobeCenter,#GlobeRadius+1,$10000000)
	StopDrawing()

	GlobeDraw()

	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
		Case #PB_Event_Menu
			Select EventGadget()
			Case #PB_Shortcut_Escape
				End
			Case #PB_Shortcut_Left
				GlobeRotX+5
			Case #PB_Shortcut_Right
				GlobeRotX-5
			Case #PB_Shortcut_Up
				GlobeRotY+5
			Case #PB_Shortcut_Down
				GlobeRotY-5
			Case #PB_Shortcut_Space
				FlagHidden!1
			Case #PB_Shortcut_F
				FlagFill!1
			Case #PB_Shortcut_G
				FlagGrid!1
			Case #PB_Shortcut_M
				FlagMask!1
			EndSelect
			GlobeDraw()

		EndSelect

	ForEver

EndProcedure

Main()
Nituvious
Addict
Addict
Posts: 1029
Joined: Sat Jul 11, 2009 4:57 am
Location: United States

Re: Polygons to the world's end

Post by Nituvious »

My brain has exploded. :shock:
So many cool things in this thread!
▓▓▓▓▓▒▒▒▒▒░░░░░
User avatar
Crusiatus Black
Enthusiast
Enthusiast
Posts: 389
Joined: Mon May 12, 2008 1:25 pm
Location: The Netherlands
Contact:

Re: Polygons to the world's end

Post by Crusiatus Black »

Nituvious wrote:My brain has exploded. :shock:
So many cool things in this thread!
I agree, so impressive! 0_o
Image
Bas Groothedde,
Imagine Programming

I live in a philosophical paradoxal randome filled with enigma's!
davido
Addict
Addict
Posts: 1890
Joined: Fri Nov 09, 2012 11:04 pm
Location: Uttoxeter, UK

Re: Polygons to the world's end

Post by davido »

Amazing :!:
DE AA EB
LuCiFeR[SD]
666
666
Posts: 1033
Joined: Mon Sep 01, 2003 2:33 pm

Re: Polygons to the world's end

Post by LuCiFeR[SD] »

indeed it is amazing :) I love cool stuff like this.
User avatar
BasicallyPure
Enthusiast
Enthusiast
Posts: 539
Joined: Thu Mar 24, 2011 12:40 am
Location: Iowa, USA

Re: Polygons to the world's end

Post by BasicallyPure »

Congratulations Michael, you did it!!!

I might mention for the benefit of others that Michael's code requires one of the new 5.1 betas to run.
PB 5.00 doesn't cut it.
At least that was my experience.

Michael, I see that you have improved the map data as well.
Antarctica is looking good now, I thought maybe it had melted away.

I have edited my previous code posting and installed the new map data plus a few small improvements in code.

This little project has really made me appreciate the nice 3D engine we have in PureBasic.

B.P.
BasicallyPure
Until you know everything you know nothing, all you have is what you believe.
User avatar
VB6_to_PBx
Enthusiast
Enthusiast
Posts: 627
Joined: Mon May 09, 2011 9:36 am

Re: Polygons to the world's end

Post by VB6_to_PBx »

How are you creating the Data Section from a Picture ?

What PB source code is being used to do this ?

Code: Select all

DataSection ;{
   mapData:
   Data.a 128,255,35,254,37,249,41,243,43,242,49,239,54,237,48,241,43,240,40,235,44,229,43,225,47,226,51,227,57,224,63,220,67,218,73,217,79,216,72,211,73,212,78,213,82,212,85,213,88,212,91,210,94,208,96,205
   Data.a 98,203,98,202,101,204,105,204,110,200,111,198,112,199,118,201,124,198,119,197,113,197,107,194,102,192,96,187,100,184,106,184,112,181,113,180,107,179,101,176,96,172,91,167,89,163,85,163,89,167,90
   Data.a 169,95,167,101,163,106,158,109,157,102,155,96,153,90,150,85,152,79,150,76,146,72,150,68,156,69,154,64,152,64,148,64,144,70,141,71,139,66,136,65,140,70,138,70,135,65,129,68,126,74,121,74,121,68,125
   Data.a 66,126,61,127,58,131,53,133,48,137,51,142,48,144,43,145,42,143,38,143,34,140,39,139,45,136,46,133,45,132,39,137,34,141,29,147,27,152,29,156,33,152,36,157,33,160,33,165,30,171,29,175,28,178,27,178
   Data.a 33,183,32,179,27,182,27,185,28,187,23,192,20,198,19,203,19,208,21,202,24,208,24,214,24,219,25,224,26,230,25,235,27,241,29,247,30,254,29,123,11,38,11,42,13,44,15,47,15,47,19,44,21,41,22,42,27,42
   Data.a 31,45,34,48,36,52,39,56,40,59,40,64,40,70,41,75,44,80,46,86,48,92,49,92,47,85,48,86,51,92,53,99,56,103,61,105,66,110,69,116,72,118,72,124,70,130,70,136,72,143,75,150,78,155,77,161,77,167,77,173
   Data.a 76,179,75,185,75,192,75,197,76,203,79,198,80,192,81,186,85,182,86,177,90,175,92,169,94,162,98,157,100,151,100,145,103,138,100,133,96,130,93,129,92,125,89,119,84,114,79,112,76,113,74,113,71,114,68
   Data.a 111,68,105,65,101,64,97,60,102,58,96,58,90,61,85,66,84,69,89,70,87,70,81,73,76,74,74,76,69,79,64,81,64,83,63,82,59,78,60,81,56,86,55,86,51,85,49,82,44,79,44,76,41,72,41,73,47,71,52,69,54,68,49,63
   Data.a 46,60,42,62,37,65,36,68,34,69,29,66,32,62,29,59,27,60,32,56,31,51,30,49,31,45,30,39,29,35,29,33,29,27,29,21,28,16,27,11,30,14,33,8,34,13,36,12,38,59,145,82,141,82,139,83,135,80,135,76,131,75,127
   Data.a 77,123,78,121,82,120,86,117,90,116,95,116,99,116,103,116,108,116,112,118,116,121,120,125,120,129,118,131,121,134,124,134,128,135,132,136,136,137,140,137,144,136,149,135,153,137,157,137,161,138,165
   Data.a 139,169,140,174,143,175,147,174,149,170,150,166,152,162,152,158,153,153,156,149,156,145,155,141,155,136,156,131,158,127,160,123,162,118,163,114,161,112,157,111,156,107,155,102,154,97,152,93,151
   Data.a 89,150,85,147,83,31,228,143,227,148,226,152,223,149,224,145,220,145,218,149,216,149,214,153,211,156,208,159,208,163,208,167,209,172,209,176,213,175,217,173,221,172,223,176,224,176,226,181,231,181
   Data.a 233,179,235,174,236,170,236,166,235,162,233,157,231,153,230,148,228,144,17,123,57,125,56,127,55,128,54,127,53,127,51,126,49,126,47,125,46,124,44,123,46,123,48,125,50,125,52,124,53,125,54,124,56
   Data.a 11,113,37,112,36,112,35,110,35,112,34,113,34,115,34,117,33,118,35,116,37,114,38,10,232,139,230,134,227,131,223,132,221,128,221,132,225,135,227,140,231,140,232,140,8,205,125,208,121,210,117,210,122
   Data.a 210,127,209,132,205,129,205,125,9,249,176,251,178,252,180,253,182,252,184,251,184,251,182,251,180,250,178,6,249,185,250,188,248,191,245,192,247,189,249,186,9,198,123,200,126,202,130,202,135,199
   Data.a 132,198,127,196,124,196,120,198,123,7,122,50,120,51,121,53,121,54,123,53,123,51,123,49,10,228,71,227,73,227,78,224,79,222,79,221,77,224,76,226,74,226,70,228,70,10,87,57,86,59,86,60,88,60,89,60,90
   Data.a 60,89,58,88,57,88,55,87,56,15,213,125,215,126,216,126,213,127,212,128,214,128,214,131,214,133,213,133,212,133,212,135,212,133,211,131,212,128,212,126,16,163,147,163,149,162,152,162,154,161,157,161
   Data.a 159,161,162,159,163,158,160,158,158,159,155,158,152,159,150,161,148,161,146,162,146,4,79,202,81,205,78,203,79,202,6,74,99,71,97,69,95,69,94,71,96,74,98,7,207,139,205,138,203,137,203,136,205,137
   Data.a 207,138,208,139,9,214,101,214,104,213,106,214,108,214,108,213,107,212,104,212,102,214,101,5,7,34,5,33,4,33,3,32,1,31,5,67,34,69,36,68,37,66,37,66,34,11,229,57,228,58,228,61,228,62,228,60,228,57
   Data.a 228,55,228,53,228,51,229,53,229,55,8,216,114,217,116,217,118,216,118,215,117,214,117,214,115,216,114,4,39,57,40,58,38,57,37,56,2,18,46,19,46,7,230,65,229,67,228,67,227,68,227,67,227,65,228,64,5
   Data.a 78,101,78,100,77,99,76,100,77,102,5,230,185,232,185,232,187,230,188,230,185,4,220,79,219,81,220,83,221,81,3,244,158,244,157,244,158,4,233,135,235,133,235,135,233,136,3,7,34,6,35,4,36,3,4,35,2,35
   Data.a 0,35,2,34,51,33,51,2,7,38,6,37,3,134,71,133,71,134,69,4,138,73,138,75,136,74,138,73,4,218,124,218,126,217,127,218,124,3,215,140,216,140,215,140,2,85,200,85,200,2,85,62,84,62,3,212,139,214,139,213
   Data.a 140,3,143,73,143,75,143,74,4,211,113,210,115,211,113,211,113,3,219,132,219,132,219,132,5,213,92,213,94,213,96,212,94,213,92,5,184,113,184,116,184,118,185,117,184,114,3,134,66,134,69,134,67,2,145
   Data.a 77,145,78,3,234,131,236,133,235,133,2,74,202,74,202,2,17,99,17,101,3,206,99,205,101,204,99,3,222,80,221,80,222,80,2,215,110,216,111,2,253,152,253,152,2,163,30,161,30,2,11,50,11,50,2,143,44,144,45
   Data.a 2,233,63,232,63,2,145,73,144,73,2,245,148,245,148,13,163,74,165,75,165,71,166,70,164,68,163,65,165,63,165,61,162,62,161,65,162,68,162,71,162,74,8,71,64,68,62,65,63,65,64,65,68,66,65,68,64,70,64
   Data.a 9,50,39,48,39,46,39,46,39,45,40,43,41,45,41,47,40,49,39,3,42,33,42,35,43,33,4,58,50,59,54,58,54,58,51,8,68,62,67,59,65,58,64,60,62,61,64,61,65,61,67,61,4,49,43,51,43,51,44,49,44,5,151,127,151,129
   Data.a 151,131,150,129,150,127,4,74,64,72,65,72,66,73,65,5,170,66,171,64,171,62,169,63,169,65,7,205,49,205,51,204,53,202,54,202,54,203,52,204,50,4,71,67,69,67,69,69,71,67,5,180,61,182,61,180,62,180,64
   Data.a 180,62,3,149,40,149,42,150,41,6,149,139,149,137,148,134,148,134,148,137,149,139,4,152,143,152,143,151,145,152,147,2,47,68,47,68,2,137,44,137,44,3,138,109,137,107,137,109,69,0,238,6,238,11,238,16
   Data.a 236,20,236,24,235,28,233,32,233,36,232,40,231,44,232,48,232,53,232,54,231,57,229,61,230,65,230,70,231,74,231,75,229,77,225,80,223,83,219,85,220,84,225,85,229,84,233,89,236,95,238,101,238,107,235
   Data.a 111,232,115,230,120,228,124,227,128,226,133,226,137,225,142,226,147,226,152,225,156,225,160,223,164,221,168,222,172,223,177,224,182,225,185,221,189,221,193,222,197,220,202,221,206,221,210,221,213
   Data.a 220,217,222,221,221,225,221,230,222,234,224,238,225,242,227,246,228,245,232,242,235,244,237,249,237,253,238,48,106,31,110,29,110,28,109,27,112,26,108,24,112,23,112,21,114,19,113,15,113,13,117,13
   Data.a 114,12,110,14,109,12,104,12,108,11,112,11,108,10,104,10,104,10,108,10,103,9,99,9,95,10,95,10,91,11,87,11,84,12,80,14,80,15,76,16,80,18,79,20,84,20,87,22,88,26,91,28,91,28,89,32,90,36,91,38,94,41
   Data.a 98,40,99,36,102,34,104,30,106,31,13,69,14,68,13,62,12,68,11,74,10,80,10,79,12,79,13,73,15,68,19,68,18,69,16,69,14,14,79,38,80,36,83,33,79,29,76,26,70,25,67,25,65,23,65,28,71,28,76,31,72,35,77,38
   Data.a 80,38,10,42,25,44,24,45,23,43,22,41,22,40,23,39,25,39,26,41,26,42,25,5,66,14,63,17,63,15,60,13,64,13,5,139,14,140,18,139,17,136,16,138,14,9,56,28,53,29,48,30,44,28,45,27,44,25,49,25,53,25,56,28
   Data.a 3,143,14,144,15,141,14,5,49,20,52,20,48,22,45,21,47,20,6,170,20,176,19,172,21,168,23,167,22,168,20,2,161,14,161,13,3,57,20,57,20,56,19,5,65,20,69,20,69,22,65,22,62,20,5,57,24,57,26,58,24,57,23,57
   Data.a 24,3,143,17,143,18,142,17,5,165,24,167,25,168,27,165,26,165,24,5,57,16,55,17,53,17,54,15,56,16,3,60,18,61,19,63,20,4,60,23,62,23,61,24,60,23,3,160,13,160,13,160,13,4,42,20,44,19,45,18,43,18,2,170
   Data.a 13,170,14,4,194,14,193,13,195,12,195,14,4,198,16,199,15,201,16,200,17,3,60,17,58,17,59,16,2,172,12,172,12,4,198,15,197,16,195,15,193,15,3,50,17,47,17,49,18,3,60,20,61,22,59,21,3,167,13,167,13,167
   Data.a 13,3,226,21,224,21,225,20,4,59,29,57,30,59,30,59,29,3,49,16,47,16,49,16,2,151,14,151,14,3,226,20,228,20,227,21,2,60,17,60,18,4,227,20,229,20,229,21,228,20,3,42,20,40,20,42,19,3,233,22,232,21,233
   Data.a 22,2,192,14,192,14,2,135,16,135,16,3,227,23,227,24,227,23,3,93,10,95,11,93,10,2,53,24,52,23,3,90,28,90,29,89,28,4,71,23,73,24,71,24,71,23,2,0,26,1,27,2,111,24,111,25,2,109,24,109,24,2,112,24,112,24
EndDataSection ;}
Thanks,
 
PureBasic .... making tiny electrons do what you want !

"With every mistake we must surely be learning" - George Harrison
User avatar
electrochrisso
Addict
Addict
Posts: 989
Joined: Mon May 14, 2007 2:13 am
Location: Darling River

Re: Polygons to the world's end

Post by electrochrisso »

I have been following this thread, great coding, thanks for the effort. :)
PureBasic! Purely the best 8)
User avatar
Michael Vogel
Addict
Addict
Posts: 2799
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Polygons to the world's end

Post by Michael Vogel »

B.P., looks like we don't have nothing to do, boring isn't it? :lol:

So what about optimizing (reducing) the map data? The original data contains around 60.000 points which would need a lot of memory and would slow down the calculation and drawing speed.
Eliminating as many points as possible without changing the charactaristics of a border is also a nice problem which I haven't solved for now.

Here's just a simple code snippet containing two data lines, ready for playing around and to think about a possibility to remove "useless" points and keep only the "important" points.

Any ideas?

Code: Select all

; Define

	DataSection
		
		; Eurasia
		Data.w 823, 32767,-11846, 32546,-11768, 32291,-11804, 32032,-11829, 32052,-11687, 32246,-11783, 32440,-11698, 32544,-11576, 32633,-11450, 32396,-11387, 32133,-11363, 31899,-11301, 31667,-11235, 31459,-11152, 31257,-11073, 31043,-11001, 30770,-11024, 30487,-11000, 30290,-10917, 30037,-10887, 29770,-10897, 29689,-10769, 29542,-10652, 29500,-10522, 29621,-10404, 29718,-10261, 29474,-10181, 29450,-10027, 29237, -9908, 29105, -9771, 28942, -9647, 28849, -9505, 28700, -9374, 28549, -9266, 28508, -9433, 28457, -9566, 28425, -9712, 28373, -9840, 28341,-10004, 28331,-10181, 28387,-10319, 28564,-10425, 28697,-10535, 28933,-10629, 29092,-10753, 29296,-10860, 29474,-10977, 29697,-11061, 29832,-11173, 29854,-11303, 29693,-11203, 29428,-11146, 29231,-11052, 29130,-11177, 28950,-11274, 28692,-11247, 28513,-11145, 28328,-11029, 28134,-10911, 28246,-10783, 27969,-10776, 27714,-10717, 27569,-10839, 27290,-10860, 27079,-10780, 26793,-10797, 26496,-10812, 26178,-10805, 25909,-10753, 25708,-10637, 25557,-10517, 25350,-10427, 25172,-10306, 25022,-10192, 24812,-10077, 24621, -9972, 24884, -9942, 24896, -9789, 25155, -9772, 25366, -9864, 25589, -9767, 25662, -9641, 25742, -9509, 25653, -9381, 25578, -9234, 25587, -9085, 25567, -8949, 25513, -8802, 25352, -8669, 25229, -8549, 25147, -8403, 25009, -8285, 24856, -8157, 24717, -8036, 24592, -7901, 24406, -7800, 24132, -7802, 23861, -7757, 23684, -7638, 23622, -7477, 23453, -7343, 23256, -7250, 23288, -7086, 23420, -6958, 23539, -6819, 23571, -6665, 23583, -6527, 23473, -6386, 23230, -6308, 22991, -6246, 23017, -6386, 23079, -6519, 23027, -6668, 23047, -6812, 22876, -6913, 22804, -7057, 22848, -7191, 22593, -7239, 22343, -7180, 22145, -7070, 22129, -7232, 22261, -7359, 21985, -7369, 21809, -7258, 21667, -7124, 21431, -7046, 21522, -6918, 21674, -6772, 21911, -6842, 22203, -6806, 22136, -6678, 21966, -6561, 21775, -6429, 21781, -6285, 21930, -6169, 21984, -6033, 22095, -5891, 22195, -5764, 21919, -5822, 22098, -5718, 22113, -5583, 21884, -5484, 22148, -5449, 22117, -5307, 22113, -5164, 21966, -5044, 21869, -4896, 21779, -4755, 21693, -4619, 21598, -4488, 21435, -4361, 21248, -4237, 21037, -4146, 20790, -4074, 20555, -3992, 20288, -3922, 20059, -3810, 19858, -3913, 19582, -3887, 19409, -3755, 19291, -3618, 19234, -3465, 19313, -3320, 19413, -3181, 19556, -3037, 19713, -2893, 19819, -2747, 19868, -2576, 19883, -2425, 19882, -2276, 19874, -2127, 19711, -2003, 19534, -1894, 19396, -1770, 19211, -1645, 19114, -1797, 18976, -1929, 18760, -2066, 18677, -2206, 18483, -2303, 18380, -2436, 18209, -2324, 18169, -2169, 18117, -1999, 18057, -1822, 18081, -1683, 18228, -1547, 18300, -1368, 18491, -1255, 18608, -1127, 18794,  -985, 18847,  -804, 18843,  -636, 18921,  -483, 18991,  -340, 18668,  -381, 18497,  -497, 18410,  -649, 18326,  -790, 18290,  -932, 18272, -1083, 18191, -1242, 18079, -1394, 17900, -1527, 17920, -1685, 17944, -1852, 17986, -2042, 17942, -2196, 17957, -2356, 17904, -2503, 17829, -2656, 17798, -2802, 17788, -2951, 17665, -3087, 17462, -2959, 17217, -2895, 17192, -3075, 17203, -3241, 17138, -3409, 17048, -3549, 16919, -3685, 16765, -3851, 16736, -3986, 16668, -4131, 16467, -4025, 16228, -3954, 15937, -3937, 15824, -3793, 15706, -3630, 15462, -3510, 15346, -3373, 15169, -3227, 14986, -3097, 14823, -2969, 14614, -2860, 14560, -2710, 14576, -2552, 14613, -2409, 14564, -2234, 14516, -2076, 14524, -1927, 14387, -1784, 14233, -1643, 14162, -1503, 13945, -1635, 13897, -1774, 13825, -1945, 13780, -2092, 13661, -2236, 13620, -2376, 13580, -2521, 13513, -2669, 13441, -2804, 13362, -2936, 13320, -3073, 13286, -3210, 13246, -3350, 13234, -3495, 13215, -3632, 13235, -3770, 13206, -3918, 13252, -4053, 13113, -3911, 12966, -3796, 12691, -3894, 12554, -4020, 12779, -4133, 12516, -4176, 12396, -4306, 12243, -4427, 12138, -4574, 11861, -4601, 11582, -4618, 11307, -4589, 11038, -4601, 10763, -4633, 10452, -4680, 10385, -4826, 10181, -4915,  9944, -4823,  9709, -4908,  9544, -5017,  9332, -5115,  9274, -5258,  9151, -5391,  8956, -5493,  8766, -5388,  8778, -5246,  8844, -5113,  8956, -4990,  9107, -4863,  9117, -4705,  9368, -4644,  9360, -4501,  9460, -4375,  9733, -4385,  9924, -4503, 10087, -4642, 10221, -4779, 10243, -4627, 10297, -4463, 10468, -4349, 10699, -4266, 10807, -4128, 10829, -3968, 10699, -3821, 10516, -3669, 10502, -3532, 10326, -3410, 10266, -3276, 10056, -3176,  9820, -3074,  9578, -2991,  9516, -2846,  9288, -2762,  9029, -2686,  8876, -2565,  8639, -2481,  8371, -2438,  8172, -2320,  7903, -2349,  7863, -2514,  7816, -2668,  7768, -2814,  7776, -2979,  7710, -3114,  7622, -3246,  7518, -3376,  7461, -3517,  7345, -3658,  7158, -3769,  7116, -3904,  7110, -4060,  7054, -4205,  6984, -4336,  6803, -4455,  6749, -4598,  6652, -4735,  6564, -4873,  6458, -5010,  6319, -5127,  6341, -5283,  6261, -5154,  6042, -5256,  5947, -5399,  5866, -5542,  5856, -5685,  6133, -5665,  6283, -5778,  6325, -5911,  6458, -6184,  6380, -6050,  6458, -6184,  6552, -6324,  6536, -6474,  6538, -6607,  6335, -6703,  6155, -6597,  5881, -6630,  5675, -6717,  5496, -6604,  5284, -6695,  5007, -6675,  4990, -6812,  4902, -6941,  4918, -7080,  4785, -7198,  4856, -7339,  5123, -7360,  5374, -7413,  5605, -7483,  5822, -7566,  6086, -7652,  6378, -7664,  6601, -7574,  6833, -7467,  7116, -7482,  7427, -7511,  7598, -7638,  7543, -7778,  7335, -7877,  7150, -8009,  6924, -8104,  6719, -8224,  6879, -8342,  6877, -8482,  7096, -8567,  6813, -8553,  6552, -8494,  6368, -8374,  6504, -8248,  6295, -8156,  6076, -8232,  6142, -8362,  5881, -8403,  5675, -8488,  5518, -8363,  5404, -8238,  5278, -8113,  5217, -7972,  5087, -7827,  5065, -7686,  5159, -7550,  4999, -7439,  4822, -7339,  4662, -7445,  4358, -7420,  4362, -7275,  4162, -7367,  4157, -7219,  4104, -7089,  4302, -6988,  4374, -6860,  4176, -6955,  3890, -6995,  3784, -7118,  3640, -7238,  3509, -7367,  3544, -7505,  3497, -7637,  3318, -7762,  3118, -7880,  2891, -7964,  2769, -8094,  2687, -8223,  2494, -8319,  2247, -8273,  2237, -8126,  2355, -7998,  2500, -7881,  2584, -7738,  2767, -7617,  3001, -7518,  3230, -7428,  3362, -7306,  3128, -7383,  3007, -7240,  3112, -7109,  2988, -6987,  2927, -7128,  2865, -7259,  2712, -7389,  2526, -7492,  2293, -7565,  2137, -7683,  1966, -7805,  1867, -7967,  1695, -8069,  1468, -7992,  1245, -7907,   969, -7891,   696, -7899,   587, -7718,   515, -7577,   274, -7481,    99, -7348,   -19, -7214,    19, -7080,   -71, -6951,  -218, -6835,  -340, -6699,  -605, -6691,  -886, -6634, -1129, -6712, -1400, -6747, -1570, -6868, -1559, -7005, -1677, -7130, -1597, -7271, -1556, -7429, -1565, -7582, -1566, -7718, -1644, -7855, -1416, -7956, -1099, -7930,  -814, -7907,  -545, -7899,  -276, -7893,  -206, -8023,  -181, -8184,  -184, -8330,  -300, -8467,  -296, -8599,  -539, -8655,  -784, -8718,  -758, -8853,  -482, -8856,  -276, -8944,   -19, -8974,   168, -9079,   308, -9195,   485, -9294,   740, -9349,   803, -9481,   888, -9623,  1065, -9718,  1340, -9702,  1553, -9781,  1610, -9914,  1570,-10054,  1468,-10191,  1510,-10362,  1733,-10428,  1858,-10312,  1843,-10177,  1741,-10056,  1779, -9921,  1956, -9815,  2205, -9882,  2473, -9844,  2734, -9859,  2976, -9923,  3230, -9984,  3416, -9887,  3623, -9977,  3815,-10083,  3818,-10221,  3837,-10350,  3949,-10483,  4192,-10433,  4424,-10497,  4455,-10631,  4268,-10734,  4437,-10832,  4691,-10853,  4958,-10826,  5197,-10894,  5478,-10909,  5230,-10981,  4977,-11020,  4710,-11007,  4452,-10952,  4207,-10906,  4011,-11012,  3865,-11121,  3887,-11249,  3855,-11376,  3935,-11501,  4157,-11574,  4345,-11691,  4485,-11799,  4598,-11913,  4399,-11992,  4132,-11998,  3934,-11917,  3855,-11791,  3795,-11665,  3607,-11573,  3374,-11505,  3230,-11397,  3138,-11274,  3097,-11142,  3124,-11015,  3349,-10948,  3262,-10819,  3005,-10845,  3303,-10806,  3116,-10701,  3022,-10580,  2984,-10442,  2926,-10303,  2687,-10234,  2566,-10095,  2309,-10171,  2309,-10314,  2173,-10447,  2116,-10573,  2014,-10703,  1921,-10850,  1775,-10743,  1576,-10643,  1354,-10561,  1107,-10624,  1095,-10760,  1153,-10891,  1271,-11022,  1055,-10938,   910,-11061,  1179,-11122,   931,-11157,  1024,-11276,  1114,-11397,  1374,-11471,  1585,-11551,  1839,-11541,  2065,-11620,  1828,-11574,  1880,-11701,  2083,-11789,  2249,-11888,  2392,-11994,  2416,-12132,  2599,-12222,  2827,-12286,  2892,-12408,  3146,-12434,  3194,-12562,  3429,-12619,  3639,-12708,  3893,-12738,  4148,-12777,  4389,-12824,  4616,-12886,  4534,-12763,  4735,-12862,  4998,-12900,  5257,-12897,  5503,-12856,  5322,-12766,  5524,-12684,  5777,-12684,  6020,-12623,  6297,-12601,  6568,-12580,  6795,-12518,  7007,-12429,  7257,-12383,  7471,-12311,  7495,-12160,  7298,-12065,  7047,-12028,  6781,-12055,  6481,-12088,  6241,-12149,  5982,-12192,  6112,-12076,  6333,-11991,  6318,-11842,  6405,-11713,  6662,-11647,  6947,-11633,  6772,-11727,  6724,-11862,  6986,-11800,  7227,-11752,  7266,-11891,  7436,-12011,  7665,-12082,  7936,-12060,  8108,-12173,  8015,-12305,  8041,-12437,  8328,-12463,  8497,-12345,  8252,-12306,  8348,-12180,  8613,-12169,  8724,-12285,  8950,-12353,  9180,-12412,  9449,-12467,  9702,-12493,  9924,-12556,  9830,-12436, 10095,-12477, 10381,-12484, 10640,-12548, 10797,-12446, 11030,-12521, 10984,-12660, 11237,-12697, 11490,-12678, 11753,-12630, 11976,-12570, 12247,-12508, 12430,-12416, 12582,-12532, 12392,-12626, 12171,-12700, 12253,-12831, 12149,-12952, 12381,-13031, 12500,-13152, 12609,-13267, 12887,-13264, 13177,-13244, 13181,-13099, 13181,-12968, 13234,-12841, 13229,-12714, 13191,-12582, 13363,-12488, 13311,-12347, 13139,-12248, 12942,-12167, 12747,-12086, 13040,-12068, 13266,-12134, 13444,-12232, 13605,-12342, 13548,-12477, 13802,-12542, 14049,-12483, 14060,-12347, 14314,-12294, 14110,-12372, 14154,-12503, 13925,-12581, 13627,-12574, 13432,-12667, 13482,-12799, 13441,-12927, 13354,-13053, 13578,-13125, 13608,-13253, 13765,-13153, 13741,-13013, 14002,-12955, 14275,-12914, 14038,-12997, 13836,-13083, 14107,-13068, 14269,-13169, 14529,-13154, 14773,-13080, 15032,-13053, 14992,-12928, 14971,-12790, 15241,-12809, 15165,-12936, 15209,-13061, 14977,-13116, 14741,-13184, 14669,-13309, 14855,-13402, 15141,-13407, 15391,-13421, 15650,-13441, 15762,-13556, 15945,-13649, 16164,-13716, 16404,-13760, 16661,-13770, 16864,-13844, 17122,-13828, 17376,-13856, 17986,-13920, 18259,-13916, 18416,-14014, 18621,-14087, 18866,-14132, 19136,-14112, 18980,-14006, 19229,-14027, 19482,-14012, 19318,-13917, 19593,-13926, 19834,-13963, 20094,-13966, 20347,-13934, 20534,-13847, 20670,-13735, 20498,-13639, 20260,-13597, 20007,-13536, 19789,-13458, 19544,-13399, 19303,-13327, 19074,-13245, 19330,-13272, 19573,-13316, 19821,-13347, 20066,-13389, 20255,-13476, 20518,-13417, 20728,-13345, 20986,-13400, 21267,-13398, 21524,-13386, 21734,-13300, 22007,-13280, 22262,-13278, 22429,-13389, 22673,-13429, 22923,-13391, 23174,-13380, 23419,-13336, 23552,-13227, 23465,-13102, 23574,-12977, 23794,-12898, 24035,-12956, 24123,-13084, 24334,-13000, 24579,-13038, 24850,-13020, 25095,-12958, 25342,-13002, 25469,-13124, 25669,-13208, 25936,-13234, 26216,-13227, 26491,-13207, 26260,-13138, 26543,-13154, 26382,-13054, 26643,-13096, 26858,-13174, 27117,-13157, 27314,-13079, 27527,-13002, 27726,-12904, 28009,-12910, 28294,-12914, 28571,-12927, 28828,-12919, 29058,-12857, 29081,-12729, 29307,-12662, 29561,-12687, 29824,-12695, 30077,-12669, 30346,-12651, 30615,-12665, 30788,-12572, 31029,-12533, 31054,-12664, 31285,-12740, 31534,-12714, 31809,-12713, 32086,-12705, 32337,-12655, 32608,-12603
		; UK
		Data.w 529, -1003, -9110, -1003, -9101,  -992, -9115,  -981, -9120,  -958, -9114,  -944, -9106,  -928, -9109,  -928, -9107,  -918, -9100,  -904, -9109,  -894, -9127,  -858, -9140,  -838, -9163,  -810, -9163,  -782, -9165,  -759, -9164,  -740, -9164,  -718, -9160,  -693, -9155,  -675, -9148,  -658, -9146,  -649, -9147,  -641, -9154,  -627, -9165,  -619, -9193,  -613, -9214,  -603, -9217,  -595, -9215,  -577, -9215,  -543, -9225,  -504, -9232,  -491, -9236,  -475, -9225,  -457, -9214,  -444, -9205,  -437, -9197,  -432, -9196,  -432, -9197,  -432, -9198,  -422, -9208,  -392, -9212,  -359, -9206,  -340, -9211,  -350, -9227,  -310, -9227,  -265, -9228,  -256, -9234,  -234, -9241,  -230, -9251,  -230, -9262,  -210, -9252,  -187, -9248,  -159, -9252,  -152, -9245,  -133, -9236,   -99, -9239,   -35, -9247,    -7, -9248,    31, -9242,    69, -9247,   127, -9258,   168, -9265,   192, -9271,   196, -9279,   236, -9295,   268, -9312,   276, -9334,   268, -9343,   221, -9344,   186, -9342,   146, -9344,   143, -9363,   127, -9376,   140, -9378,   162, -9383,   168, -9394,   184, -9406,   175, -9412,   158, -9417,   177, -9425,   199, -9431,   215, -9424,   242, -9429,   248, -9442,   244, -9449,   242, -9460,   258, -9459,   282, -9467,   308, -9486,   326, -9529,   330, -9560,   320, -9593,   290, -9619,   258, -9632,   232, -9638,   187, -9639,   146, -9633,   115, -9630,    97, -9613,    81, -9603,    67, -9611,    43, -9614,    25, -9616,    21, -9616,    21, -9617,    33, -9635,    52, -9646,    59, -9652,    74, -9664,    81, -9677,    81, -9696,    69, -9708,    49, -9722,    29, -9733,    19, -9744,     1, -9749,   -21, -9762,   -46, -9776,   -31, -9781,   -11, -9768,     5, -9760,     7, -9760,    11, -9760,    27, -9758,    47, -9756,    49, -9758,    41, -9789,    17, -9800,   -13, -9826,   -25, -9854,   -46, -9875,   -47, -9875,   -47, -9876,   -49, -9876,   -65, -9896,   -96, -9922,  -133, -9931,  -180, -9936,  -192, -9943,  -206, -9968,  -230, -9990,  -250,-10016,  -259,-10036,  -262,-10057,  -264,-10072,  -265,-10085,  -272,-10109,  -302,-10121,  -338,-10144,  -360,-10165,  -391,-10177,  -429,-10186,  -454,-10194,  -473,-10197,  -481,-10195,  -497,-10192,  -529,-10184,  -555,-10186,  -579,-10192,  -581,-10195,  -573,-10210,  -553,-10221,  -526,-10225,  -491,-10227,  -460,-10235,  -477,-10246,  -497,-10261,  -513,-10266,  -519,-10275,  -487,-10275,  -466,-10282,  -447,-10298,  -441,-10313,  -420,-10329,  -413,-10335,  -407,-10340,  -400,-10347,  -397,-10349,  -394,-10353,  -391,-10366,  -376,-10387,  -372,-10401,  -366,-10417,  -350,-10427,  -334,-10436,  -320,-10445,  -320,-10463,  -320,-10480,  -332,-10495,  -350,-10497,  -388,-10497,  -432,-10494,  -469,-10498,  -507,-10499,  -545,-10497,  -585,-10503,  -613,-10497,  -674,-10487,  -705,-10480,  -730,-10468,  -744,-10475,  -736,-10488,  -736,-10493,  -764,-10489,  -764,-10497,  -715,-10505,  -685,-10521,  -696,-10523,  -742,-10524,  -736,-10538,  -731,-10536,  -699,-10557,  -633,-10580,  -607,-10605,  -563,-10620,  -559,-10645,  -553,-10665,  -593,-10673,  -607,-10670,  -613,-10668,  -639,-10664,  -685,-10659,  -724,-10659,  -746,-10654,  -777,-10651,  -782,-10654,  -810,-10659,  -820,-10657,  -826,-10659,  -846,-10662,  -858,-10659,  -882,-10657,  -906,-10637,  -916,-10626,  -918,-10612,  -918,-10600,  -922,-10599,  -944,-10597,  -954,-10599,  -956,-10597,  -954,-10596,  -954,-10587,  -954,-10578,  -954,-10573,  -972,-10568,  -966,-10559,  -952,-10553,  -941,-10547,  -941,-10544,  -954,-10539,  -970,-10535,  -987,-10533, -1000,-10525, -1017,-10524, -1031,-10519, -1029,-10506, -1031,-10499, -1029,-10489, -1029,-10481, -1019,-10478, -1007,-10474, -1013,-10470, -1035,-10472, -1044,-10470, -1044,-10464, -1044,-10461, -1044,-10460, -1044,-10448, -1043,-10442, -1021,-10441,  -992,-10445,  -982,-10445,  -987,-10437, -1004,-10431,  -998,-10429,  -985,-10428,  -987,-10425, -1003,-10413, -1004,-10407, -1007,-10406, -1004,-10398, -1003,-10393, -1010,-10392, -1022,-10384, -1022,-10381, -1022,-10376, -1035,-10370, -1043,-10357, -1044,-10353, -1043,-10345, -1043,-10335, -1044,-10331, -1061,-10329, -1079,-10326, -1097,-10320, -1095,-10315, -1070,-10313, -1065,-10312, -1063,-10312, -1061,-10307, -1059,-10296, -1043,-10290, -1026,-10281, -1019,-10277, -1017,-10277, -1013,-10278, -1013,-10279, -1000,-10284,  -985,-10289,  -969,-10298,  -960,-10302,  -954,-10305,  -948,-10308,  -947,-10307,  -944,-10305,  -944,-10295,  -958,-10279,  -966,-10266,  -977,-10253,  -982,-10246,  -987,-10238,  -991,-10224,  -994,-10217,  -994,-10209, -1003,-10199, -1007,-10185, -1009,-10177, -1009,-10166, -1009,-10161,  -991,-10164,  -982,-10157,  -985,-10146,  -997,-10134, -1013,-10117, -1021,-10102, -1026,-10088, -1032,-10073, -1032,-10068, -1010,-10068, -1000,-10075,  -991,-10098,  -972,-10123,  -964,-10136,  -954,-10148,  -954,-10155,  -954,-10161,  -956,-10173,  -966,-10186,  -969,-10194,  -964,-10197,  -958,-10200,  -947,-10209,  -922,-10227,  -918,-10228,  -916,-10229,  -918,-10217,  -931,-10201,  -943,-10185,  -944,-10172,  -943,-10165,  -934,-10172,  -926,-10173,  -924,-10173,  -920,-10181,  -912,-10184,  -904,-10182,  -903,-10182,  -894,-10180,  -890,-10177,  -888,-10177,  -886,-10177,  -884,-10178,  -884,-10183,  -884,-10203,  -872,-10199,  -854,-10194,  -836,-10186,  -834,-10183,  -852,-10181,  -860,-10172,  -866,-10161,  -868,-10151,  -868,-10142,  -870,-10133,  -860,-10124,  -840,-10115,  -834,-10096,  -852,-10079,  -868,-10053,  -890,-10028,  -898,-10012,  -897, -9995,  -918,-10005,  -924, -9995,  -912, -9974,  -898, -9951,  -884, -9944,  -876, -9946,  -880, -9972,  -876, -9979,  -864, -9981,  -842, -9973,  -808, -9957,  -790, -9952,  -780, -9964,  -780, -9979,  -770, -9980,  -746, -9975,  -731, -9975,  -702, -9974,  -683, -9980,  -667, -9985,  -665, -9985,  -647, -9989,  -641, -9995,  -617,-10003,  -597,-10002,  -569,-10001,  -547, -9998,  -557, -9993,  -571, -9993,  -581, -9987,  -599, -9979,  -609, -9964,  -625, -9946,  -639, -9928,  -645, -9914,  -637, -9900,  -623, -9889,  -613, -9882,  -603, -9867,  -599, -9864,  -593, -9870,  -592, -9867,  -581, -9859,  -571, -9844,  -551, -9849,  -525, -9854,  -497, -9870,  -482, -9867,  -497, -9855,  -497, -9840,  -501, -9821,  -519, -9810,  -531, -9788,  -517, -9785,  -498, -9782,  -519, -9766,  -531, -9747,  -535, -9735,  -525, -9726,  -509, -9721,  -521, -9716,  -537, -9701,  -567, -9702,  -611, -9701,  -670, -9703,  -714, -9687,  -758, -9664,  -794, -9641,  -834, -9616,  -818, -9610,  -770, -9629,  -733, -9634,  -727, -9616,  -727, -9594,  -725, -9576,  -721, -9567,  -702, -9559,  -715, -9543,  -719, -9536,  -736, -9515,  -765, -9502,  -803, -9486,  -836, -9473,  -874, -9461,  -910, -9448,  -938, -9439,  -931, -9433,  -924, -9421,  -914, -9410,  -906, -9399,  -900, -9397,  -898, -9394,  -878, -9392,  -854, -9398,  -824, -9416,  -794, -9424,  -782, -9421,  -777, -9413,  -774, -9394,  -762, -9387,  -721, -9386,  -698, -9399,  -687, -9401,  -677, -9397,  -665, -9386,  -645, -9369,  -627, -9357,  -607, -9352,  -579, -9353,  -559, -9362,  -543, -9377,  -521, -9387,  -501, -9392,  -471, -9406,  -451, -9416,  -448, -9402,  -465, -9386,  -492, -9363,  -517, -9346,  -525, -9330,  -535, -9323,  -547, -9319,  -579, -9316,  -636, -9318,  -683, -9316,  -731, -9310,  -733, -9305,  -749, -9289,  -782, -9275,  -803, -9246,  -848, -9215,  -886, -9188,  -918, -9167,  -941, -9150,  -969, -9138,  -992, -9127, -1003, -9110

	EndDataSection

	Global x_=GetSystemMetrics_(#SM_CXFULLSCREEN)
	Global y_=GetSystemMetrics_(#SM_CYFULLSCREEN)

	s.s=""

	xo=0
	yo=0

	zoomx=2
	zoomy=2
	movex=-MulDiv_(x_,19,20)
	movey=0

; EndDefine
Procedure LinePlot(x1,y1,x2,y2,color1,color2,size=1)

	LineXY(x1,y1,x2,y2,color1)
	If x1>=0 And y1>=0 And x1<x_ And y1<y_
		Box(x1-size>>1,y1-size>>1,size,size,color2)
	EndIf
	If x2>=0 And y2>=0 And x2<x_ And y2<y_
		Box(x2-size>>1,y2-size>>1,size,size,color2)
	EndIf

EndProcedure

OpenWindow(0,0,0,x_,y_,"World",#PB_Window_BorderLess)
CanvasGadget(0,0,0,x_,y_)
StartDrawing(CanvasOutput(0))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_Outlined)

Read.w n

For i=1 To n

	Read.w x
	Read.w y

	If xo Or yo
		LinePlot(xo,yo,(x/32768.0+1)*x_/2*zoomx+movex,(y/16384.0+1)*y_/2*zoomy+movey,#Green,#Black,3)
	EndIf

	If i=1
		x0=x
		y0=y
	Else
		d=(x-x0)*(x-x0)+(y-y0)*(y-y0)-Pow(Abs(y0)/5.5,1.4)
		If d>58000 Or i>j+25 ;Or (i>135 And i<170 And d>1);FindString(".139.140.141.142.143.144.","."+Str(i)+".")
			s+","+Str(x0)+","+Str(y0)
			LinePlot((x0/32768.0+1)*x_/2*zoomx+movex,(y0/16384.0+1)*y_/2*zoomy+movey,(x/32768.0+1)*x_/2*zoomx+movex,(y/16384.0+1)*y_/2*zoomy+movey,#Red,#Blue)
			x0=x
			y0=y
			z+1
			j=i
		EndIf
	EndIf

	xo=(x/32768.0+1)*x_/2*zoomx+movex
	yo=(y/16384.0+1)*y_/2*zoomy+movey
Next i

s+","+Str(x0)+","+Str(y0)
s+","+Str(x)+","+Str(y)
s="Data.w "+Str(z+2)+s+#CRLF$

DrawText(0,0,Str(z)+" Dots",#Black,#White)

SetClipboardText(s)

StopDrawing()

Repeat
Until WaitWindowEvent()=#WM_CHAR
PS: the globe source should also run with PB version 5.0 :wink:
User avatar
Michael Vogel
Addict
Addict
Posts: 2799
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Polygons to the world's end

Post by Michael Vogel »

I'd like to add one more snippet here, which allows to reduce the number of points in a polygon using the Douglas-Peucker algorithm.

The example below shows three lines, the gray line represents the shape of the original data with all points, the red line uses a moderate tolerance value (50) to eliminate some points and the green line shows the results with a more aggresive value (250), which keeps only a few points then.

Code: Select all

; Define

	DataSection
		; Eurasia
		Data.w 823, 32767,-11846, 32546,-11768, 32291,-11804, 32032,-11829, 32052,-11687, 32246,-11783, 32440,-11698, 32544,-11576, 32633,-11450, 32396,-11387, 32133,-11363, 31899,-11301, 31667,-11235, 31459,-11152, 31257,-11073, 31043,-11001, 30770,-11024, 30487,-11000, 30290,-10917, 30037,-10887, 29770,-10897, 29689,-10769, 29542,-10652, 29500,-10522, 29621,-10404, 29718,-10261, 29474,-10181, 29450,-10027, 29237, -9908, 29105, -9771, 28942, -9647, 28849, -9505, 28700, -9374, 28549, -9266, 28508, -9433, 28457, -9566, 28425, -9712, 28373, -9840, 28341,-10004, 28331,-10181, 28387,-10319, 28564,-10425, 28697,-10535, 28933,-10629, 29092,-10753, 29296,-10860, 29474,-10977, 29697,-11061, 29832,-11173, 29854,-11303, 29693,-11203, 29428,-11146, 29231,-11052, 29130,-11177, 28950,-11274, 28692,-11247, 28513,-11145, 28328,-11029, 28134,-10911, 28246,-10783, 27969,-10776, 27714,-10717, 27569,-10839, 27290,-10860, 27079,-10780, 26793,-10797, 26496,-10812, 26178,-10805, 25909,-10753, 25708,-10637, 25557,-10517, 25350,-10427, 25172,-10306, 25022,-10192, 24812,-10077, 24621, -9972, 24884, -9942, 24896, -9789, 25155, -9772, 25366, -9864, 25589, -9767, 25662, -9641, 25742, -9509, 25653, -9381, 25578, -9234, 25587, -9085, 25567, -8949, 25513, -8802, 25352, -8669, 25229, -8549, 25147, -8403, 25009, -8285, 24856, -8157, 24717, -8036, 24592, -7901, 24406, -7800, 24132, -7802, 23861, -7757, 23684, -7638, 23622, -7477, 23453, -7343, 23256, -7250, 23288, -7086, 23420, -6958, 23539, -6819, 23571, -6665, 23583, -6527, 23473, -6386, 23230, -6308, 22991, -6246, 23017, -6386, 23079, -6519, 23027, -6668, 23047, -6812, 22876, -6913, 22804, -7057, 22848, -7191, 22593, -7239, 22343, -7180, 22145, -7070, 22129, -7232, 22261, -7359, 21985, -7369, 21809, -7258, 21667, -7124, 21431, -7046, 21522, -6918, 21674, -6772, 21911, -6842, 22203, -6806, 22136, -6678, 21966, -6561, 21775, -6429, 21781, -6285, 21930, -6169, 21984, -6033, 22095, -5891, 22195, -5764, 21919, -5822, 22098, -5718, 22113, -5583, 21884, -5484, 22148, -5449, 22117, -5307, 22113, -5164, 21966, -5044, 21869, -4896, 21779, -4755, 21693, -4619, 21598, -4488, 21435, -4361, 21248, -4237, 21037, -4146, 20790, -4074, 20555, -3992, 20288, -3922, 20059, -3810, 19858, -3913, 19582, -3887, 19409, -3755, 19291, -3618, 19234, -3465, 19313, -3320, 19413, -3181, 19556, -3037, 19713, -2893, 19819, -2747, 19868, -2576, 19883, -2425, 19882, -2276, 19874, -2127, 19711, -2003, 19534, -1894, 19396, -1770, 19211, -1645, 19114, -1797, 18976, -1929, 18760, -2066, 18677, -2206, 18483, -2303, 18380, -2436, 18209, -2324, 18169, -2169, 18117, -1999, 18057, -1822, 18081, -1683, 18228, -1547, 18300, -1368, 18491, -1255, 18608, -1127, 18794,  -985, 18847,  -804, 18843,  -636, 18921,  -483, 18991,  -340, 18668,  -381, 18497,  -497, 18410,  -649, 18326,  -790, 18290,  -932, 18272, -1083, 18191, -1242, 18079, -1394, 17900, -1527, 17920, -1685, 17944, -1852, 17986, -2042, 17942, -2196, 17957, -2356, 17904, -2503, 17829, -2656, 17798, -2802, 17788, -2951, 17665, -3087, 17462, -2959, 17217, -2895, 17192, -3075, 17203, -3241, 17138, -3409, 17048, -3549, 16919, -3685, 16765, -3851, 16736, -3986, 16668, -4131, 16467, -4025, 16228, -3954, 15937, -3937, 15824, -3793, 15706, -3630, 15462, -3510, 15346, -3373, 15169, -3227, 14986, -3097, 14823, -2969, 14614, -2860, 14560, -2710, 14576, -2552, 14613, -2409, 14564, -2234, 14516, -2076, 14524, -1927, 14387, -1784, 14233, -1643, 14162, -1503, 13945, -1635, 13897, -1774, 13825, -1945, 13780, -2092, 13661, -2236, 13620, -2376, 13580, -2521, 13513, -2669, 13441, -2804, 13362, -2936, 13320, -3073, 13286, -3210, 13246, -3350, 13234, -3495, 13215, -3632, 13235, -3770, 13206, -3918, 13252, -4053, 13113, -3911, 12966, -3796, 12691, -3894, 12554, -4020, 12779, -4133, 12516, -4176, 12396, -4306, 12243, -4427, 12138, -4574, 11861, -4601, 11582, -4618, 11307, -4589, 11038, -4601, 10763, -4633, 10452, -4680, 10385, -4826, 10181, -4915,  9944, -4823,  9709, -4908,  9544, -5017,  9332, -5115,  9274, -5258,  9151, -5391,  8956, -5493,  8766, -5388,  8778, -5246,  8844, -5113,  8956, -4990,  9107, -4863,  9117, -4705,  9368, -4644,  9360, -4501,  9460, -4375,  9733, -4385,  9924, -4503, 10087, -4642, 10221, -4779, 10243, -4627, 10297, -4463, 10468, -4349, 10699, -4266, 10807, -4128, 10829, -3968, 10699, -3821, 10516, -3669, 10502, -3532, 10326, -3410, 10266, -3276, 10056, -3176,  9820, -3074,  9578, -2991,  9516, -2846,  9288, -2762,  9029, -2686,  8876, -2565,  8639, -2481,  8371, -2438,  8172, -2320,  7903, -2349,  7863, -2514,  7816, -2668,  7768, -2814,  7776, -2979,  7710, -3114,  7622, -3246,  7518, -3376,  7461, -3517,  7345, -3658,  7158, -3769,  7116, -3904,  7110, -4060,  7054, -4205,  6984, -4336,  6803, -4455,  6749, -4598,  6652, -4735,  6564, -4873,  6458, -5010,  6319, -5127,  6341, -5283,  6261, -5154,  6042, -5256,  5947, -5399,  5866, -5542,  5856, -5685,  6133, -5665,  6283, -5778,  6325, -5911,  6458, -6184,  6380, -6050,  6458, -6184,  6552, -6324,  6536, -6474,  6538, -6607,  6335, -6703,  6155, -6597,  5881, -6630,  5675, -6717,  5496, -6604,  5284, -6695,  5007, -6675,  4990, -6812,  4902, -6941,  4918, -7080,  4785, -7198,  4856, -7339,  5123, -7360,  5374, -7413,  5605, -7483,  5822, -7566,  6086, -7652,  6378, -7664,  6601, -7574,  6833, -7467,  7116, -7482,  7427, -7511,  7598, -7638,  7543, -7778,  7335, -7877,  7150, -8009,  6924, -8104,  6719, -8224,  6879, -8342,  6877, -8482,  7096, -8567,  6813, -8553,  6552, -8494,  6368, -8374,  6504, -8248,  6295, -8156,  6076, -8232,  6142, -8362,  5881, -8403,  5675, -8488,  5518, -8363,  5404, -8238,  5278, -8113,  5217, -7972,  5087, -7827,  5065, -7686,  5159, -7550,  4999, -7439,  4822, -7339,  4662, -7445,  4358, -7420,  4362, -7275,  4162, -7367,  4157, -7219,  4104, -7089,  4302, -6988,  4374, -6860,  4176, -6955,  3890, -6995,  3784, -7118,  3640, -7238,  3509, -7367,  3544, -7505,  3497, -7637,  3318, -7762,  3118, -7880,  2891, -7964,  2769, -8094,  2687, -8223,  2494, -8319,  2247, -8273,  2237, -8126,  2355, -7998,  2500, -7881,  2584, -7738,  2767, -7617,  3001, -7518,  3230, -7428,  3362, -7306,  3128, -7383,  3007, -7240,  3112, -7109,  2988, -6987,  2927, -7128,  2865, -7259,  2712, -7389,  2526, -7492,  2293, -7565,  2137, -7683,  1966, -7805,  1867, -7967,  1695, -8069,  1468, -7992,  1245, -7907,   969, -7891,   696, -7899,   587, -7718,   515, -7577,   274, -7481,    99, -7348,   -19, -7214,    19, -7080,   -71, -6951,  -218, -6835,  -340, -6699,  -605, -6691,  -886, -6634, -1129, -6712, -1400, -6747, -1570, -6868, -1559, -7005, -1677, -7130, -1597, -7271, -1556, -7429, -1565, -7582, -1566, -7718, -1644, -7855, -1416, -7956, -1099, -7930,  -814, -7907,  -545, -7899,  -276, -7893,  -206, -8023,  -181, -8184,  -184, -8330,  -300, -8467,  -296, -8599,  -539, -8655,  -784, -8718,  -758, -8853,  -482, -8856,  -276, -8944,   -19, -8974,   168, -9079,   308, -9195,   485, -9294,   740, -9349,   803, -9481,   888, -9623,  1065, -9718,  1340, -9702,  1553, -9781,  1610, -9914,  1570,-10054,  1468,-10191,  1510,-10362,  1733,-10428,  1858,-10312,  1843,-10177,  1741,-10056,  1779, -9921,  1956, -9815,  2205, -9882,  2473, -9844,  2734, -9859,  2976, -9923,  3230, -9984,  3416, -9887,  3623, -9977,  3815,-10083,  3818,-10221,  3837,-10350,  3949,-10483,  4192,-10433,  4424,-10497,  4455,-10631,  4268,-10734,  4437,-10832,  4691,-10853,  4958,-10826,  5197,-10894,  5478,-10909,  5230,-10981,  4977,-11020,  4710,-11007,  4452,-10952,  4207,-10906,  4011,-11012,  3865,-11121,  3887,-11249,  3855,-11376,  3935,-11501,  4157,-11574,  4345,-11691,  4485,-11799,  4598,-11913,  4399,-11992,  4132,-11998,  3934,-11917,  3855,-11791,  3795,-11665,  3607,-11573,  3374,-11505,  3230,-11397,  3138,-11274,  3097,-11142,  3124,-11015,  3349,-10948,  3262,-10819,  3005,-10845,  3303,-10806,  3116,-10701,  3022,-10580,  2984,-10442,  2926,-10303,  2687,-10234,  2566,-10095,  2309,-10171,  2309,-10314,  2173,-10447,  2116,-10573,  2014,-10703,  1921,-10850,  1775,-10743,  1576,-10643,  1354,-10561,  1107,-10624,  1095,-10760,  1153,-10891,  1271,-11022,  1055,-10938,   910,-11061,  1179,-11122,   931,-11157,  1024,-11276,  1114,-11397,  1374,-11471,  1585,-11551,  1839,-11541,  2065,-11620,  1828,-11574,  1880,-11701,  2083,-11789,  2249,-11888,  2392,-11994,  2416,-12132,  2599,-12222,  2827,-12286,  2892,-12408,  3146,-12434,  3194,-12562,  3429,-12619,  3639,-12708,  3893,-12738,  4148,-12777,  4389,-12824,  4616,-12886,  4534,-12763,  4735,-12862,  4998,-12900,  5257,-12897,  5503,-12856,  5322,-12766,  5524,-12684,  5777,-12684,  6020,-12623,  6297,-12601,  6568,-12580,  6795,-12518,  7007,-12429,  7257,-12383,  7471,-12311,  7495,-12160,  7298,-12065,  7047,-12028,  6781,-12055,  6481,-12088,  6241,-12149,  5982,-12192,  6112,-12076,  6333,-11991,  6318,-11842,  6405,-11713,  6662,-11647,  6947,-11633,  6772,-11727,  6724,-11862,  6986,-11800,  7227,-11752,  7266,-11891,  7436,-12011,  7665,-12082,  7936,-12060,  8108,-12173,  8015,-12305,  8041,-12437,  8328,-12463,  8497,-12345,  8252,-12306,  8348,-12180,  8613,-12169,  8724,-12285,  8950,-12353,  9180,-12412,  9449,-12467,  9702,-12493,  9924,-12556,  9830,-12436, 10095,-12477, 10381,-12484, 10640,-12548, 10797,-12446, 11030,-12521, 10984,-12660, 11237,-12697, 11490,-12678, 11753,-12630, 11976,-12570, 12247,-12508, 12430,-12416, 12582,-12532, 12392,-12626, 12171,-12700, 12253,-12831, 12149,-12952, 12381,-13031, 12500,-13152, 12609,-13267, 12887,-13264, 13177,-13244, 13181,-13099, 13181,-12968, 13234,-12841, 13229,-12714, 13191,-12582, 13363,-12488, 13311,-12347, 13139,-12248, 12942,-12167, 12747,-12086, 13040,-12068, 13266,-12134, 13444,-12232, 13605,-12342, 13548,-12477, 13802,-12542, 14049,-12483, 14060,-12347, 14314,-12294, 14110,-12372, 14154,-12503, 13925,-12581, 13627,-12574, 13432,-12667, 13482,-12799, 13441,-12927, 13354,-13053, 13578,-13125, 13608,-13253, 13765,-13153, 13741,-13013, 14002,-12955, 14275,-12914, 14038,-12997, 13836,-13083, 14107,-13068, 14269,-13169, 14529,-13154, 14773,-13080, 15032,-13053, 14992,-12928, 14971,-12790, 15241,-12809, 15165,-12936, 15209,-13061, 14977,-13116, 14741,-13184, 14669,-13309, 14855,-13402, 15141,-13407, 15391,-13421, 15650,-13441, 15762,-13556, 15945,-13649, 16164,-13716, 16404,-13760, 16661,-13770, 16864,-13844, 17122,-13828, 17376,-13856, 17986,-13920, 18259,-13916, 18416,-14014, 18621,-14087, 18866,-14132, 19136,-14112, 18980,-14006, 19229,-14027, 19482,-14012, 19318,-13917, 19593,-13926, 19834,-13963, 20094,-13966, 20347,-13934, 20534,-13847, 20670,-13735, 20498,-13639, 20260,-13597, 20007,-13536, 19789,-13458, 19544,-13399, 19303,-13327, 19074,-13245, 19330,-13272, 19573,-13316, 19821,-13347, 20066,-13389, 20255,-13476, 20518,-13417, 20728,-13345, 20986,-13400, 21267,-13398, 21524,-13386, 21734,-13300, 22007,-13280, 22262,-13278, 22429,-13389, 22673,-13429, 22923,-13391, 23174,-13380, 23419,-13336, 23552,-13227, 23465,-13102, 23574,-12977, 23794,-12898, 24035,-12956, 24123,-13084, 24334,-13000, 24579,-13038, 24850,-13020, 25095,-12958, 25342,-13002, 25469,-13124, 25669,-13208, 25936,-13234, 26216,-13227, 26491,-13207, 26260,-13138, 26543,-13154, 26382,-13054, 26643,-13096, 26858,-13174, 27117,-13157, 27314,-13079, 27527,-13002, 27726,-12904, 28009,-12910, 28294,-12914, 28571,-12927, 28828,-12919, 29058,-12857, 29081,-12729, 29307,-12662, 29561,-12687, 29824,-12695, 30077,-12669, 30346,-12651, 30615,-12665, 30788,-12572, 31029,-12533, 31054,-12664, 31285,-12740, 31534,-12714, 31809,-12713, 32086,-12705, 32337,-12655, 32608,-12603
		; UK
		Data.w 529, -1003, -9110, -1003, -9101,  -992, -9115,  -981, -9120,  -958, -9114,  -944, -9106,  -928, -9109,  -928, -9107,  -918, -9100,  -904, -9109,  -894, -9127,  -858, -9140,  -838, -9163,  -810, -9163,  -782, -9165,  -759, -9164,  -740, -9164,  -718, -9160,  -693, -9155,  -675, -9148,  -658, -9146,  -649, -9147,  -641, -9154,  -627, -9165,  -619, -9193,  -613, -9214,  -603, -9217,  -595, -9215,  -577, -9215,  -543, -9225,  -504, -9232,  -491, -9236,  -475, -9225,  -457, -9214,  -444, -9205,  -437, -9197,  -432, -9196,  -432, -9197,  -432, -9198,  -422, -9208,  -392, -9212,  -359, -9206,  -340, -9211,  -350, -9227,  -310, -9227,  -265, -9228,  -256, -9234,  -234, -9241,  -230, -9251,  -230, -9262,  -210, -9252,  -187, -9248,  -159, -9252,  -152, -9245,  -133, -9236,   -99, -9239,   -35, -9247,    -7, -9248,    31, -9242,    69, -9247,   127, -9258,   168, -9265,   192, -9271,   196, -9279,   236, -9295,   268, -9312,   276, -9334,   268, -9343,   221, -9344,   186, -9342,   146, -9344,   143, -9363,   127, -9376,   140, -9378,   162, -9383,   168, -9394,   184, -9406,   175, -9412,   158, -9417,   177, -9425,   199, -9431,   215, -9424,   242, -9429,   248, -9442,   244, -9449,   242, -9460,   258, -9459,   282, -9467,   308, -9486,   326, -9529,   330, -9560,   320, -9593,   290, -9619,   258, -9632,   232, -9638,   187, -9639,   146, -9633,   115, -9630,    97, -9613,    81, -9603,    67, -9611,    43, -9614,    25, -9616,    21, -9616,    21, -9617,    33, -9635,    52, -9646,    59, -9652,    74, -9664,    81, -9677,    81, -9696,    69, -9708,    49, -9722,    29, -9733,    19, -9744,     1, -9749,   -21, -9762,   -46, -9776,   -31, -9781,   -11, -9768,     5, -9760,     7, -9760,    11, -9760,    27, -9758,    47, -9756,    49, -9758,    41, -9789,    17, -9800,   -13, -9826,   -25, -9854,   -46, -9875,   -47, -9875,   -47, -9876,   -49, -9876,   -65, -9896,   -96, -9922,  -133, -9931,  -180, -9936,  -192, -9943,  -206, -9968,  -230, -9990,  -250,-10016,  -259,-10036,  -262,-10057,  -264,-10072,  -265,-10085,  -272,-10109,  -302,-10121,  -338,-10144,  -360,-10165,  -391,-10177,  -429,-10186,  -454,-10194,  -473,-10197,  -481,-10195,  -497,-10192,  -529,-10184,  -555,-10186,  -579,-10192,  -581,-10195,  -573,-10210,  -553,-10221,  -526,-10225,  -491,-10227,  -460,-10235,  -477,-10246,  -497,-10261,  -513,-10266,  -519,-10275,  -487,-10275,  -466,-10282,  -447,-10298,  -441,-10313,  -420,-10329,  -413,-10335,  -407,-10340,  -400,-10347,  -397,-10349,  -394,-10353,  -391,-10366,  -376,-10387,  -372,-10401,  -366,-10417,  -350,-10427,  -334,-10436,  -320,-10445,  -320,-10463,  -320,-10480,  -332,-10495,  -350,-10497,  -388,-10497,  -432,-10494,  -469,-10498,  -507,-10499,  -545,-10497,  -585,-10503,  -613,-10497,  -674,-10487,  -705,-10480,  -730,-10468,  -744,-10475,  -736,-10488,  -736,-10493,  -764,-10489,  -764,-10497,  -715,-10505,  -685,-10521,  -696,-10523,  -742,-10524,  -736,-10538,  -731,-10536,  -699,-10557,  -633,-10580,  -607,-10605,  -563,-10620,  -559,-10645,  -553,-10665,  -593,-10673,  -607,-10670,  -613,-10668,  -639,-10664,  -685,-10659,  -724,-10659,  -746,-10654,  -777,-10651,  -782,-10654,  -810,-10659,  -820,-10657,  -826,-10659,  -846,-10662,  -858,-10659,  -882,-10657,  -906,-10637,  -916,-10626,  -918,-10612,  -918,-10600,  -922,-10599,  -944,-10597,  -954,-10599,  -956,-10597,  -954,-10596,  -954,-10587,  -954,-10578,  -954,-10573,  -972,-10568,  -966,-10559,  -952,-10553,  -941,-10547,  -941,-10544,  -954,-10539,  -970,-10535,  -987,-10533, -1000,-10525, -1017,-10524, -1031,-10519, -1029,-10506, -1031,-10499, -1029,-10489, -1029,-10481, -1019,-10478, -1007,-10474, -1013,-10470, -1035,-10472, -1044,-10470, -1044,-10464, -1044,-10461, -1044,-10460, -1044,-10448, -1043,-10442, -1021,-10441,  -992,-10445,  -982,-10445,  -987,-10437, -1004,-10431,  -998,-10429,  -985,-10428,  -987,-10425, -1003,-10413, -1004,-10407, -1007,-10406, -1004,-10398, -1003,-10393, -1010,-10392, -1022,-10384, -1022,-10381, -1022,-10376, -1035,-10370, -1043,-10357, -1044,-10353, -1043,-10345, -1043,-10335, -1044,-10331, -1061,-10329, -1079,-10326, -1097,-10320, -1095,-10315, -1070,-10313, -1065,-10312, -1063,-10312, -1061,-10307, -1059,-10296, -1043,-10290, -1026,-10281, -1019,-10277, -1017,-10277, -1013,-10278, -1013,-10279, -1000,-10284,  -985,-10289,  -969,-10298,  -960,-10302,  -954,-10305,  -948,-10308,  -947,-10307,  -944,-10305,  -944,-10295,  -958,-10279,  -966,-10266,  -977,-10253,  -982,-10246,  -987,-10238,  -991,-10224,  -994,-10217,  -994,-10209, -1003,-10199, -1007,-10185, -1009,-10177, -1009,-10166, -1009,-10161,  -991,-10164,  -982,-10157,  -985,-10146,  -997,-10134, -1013,-10117, -1021,-10102, -1026,-10088, -1032,-10073, -1032,-10068, -1010,-10068, -1000,-10075,  -991,-10098,  -972,-10123,  -964,-10136,  -954,-10148,  -954,-10155,  -954,-10161,  -956,-10173,  -966,-10186,  -969,-10194,  -964,-10197,  -958,-10200,  -947,-10209,  -922,-10227,  -918,-10228,  -916,-10229,  -918,-10217,  -931,-10201,  -943,-10185,  -944,-10172,  -943,-10165,  -934,-10172,  -926,-10173,  -924,-10173,  -920,-10181,  -912,-10184,  -904,-10182,  -903,-10182,  -894,-10180,  -890,-10177,  -888,-10177,  -886,-10177,  -884,-10178,  -884,-10183,  -884,-10203,  -872,-10199,  -854,-10194,  -836,-10186,  -834,-10183,  -852,-10181,  -860,-10172,  -866,-10161,  -868,-10151,  -868,-10142,  -870,-10133,  -860,-10124,  -840,-10115,  -834,-10096,  -852,-10079,  -868,-10053,  -890,-10028,  -898,-10012,  -897, -9995,  -918,-10005,  -924, -9995,  -912, -9974,  -898, -9951,  -884, -9944,  -876, -9946,  -880, -9972,  -876, -9979,  -864, -9981,  -842, -9973,  -808, -9957,  -790, -9952,  -780, -9964,  -780, -9979,  -770, -9980,  -746, -9975,  -731, -9975,  -702, -9974,  -683, -9980,  -667, -9985,  -665, -9985,  -647, -9989,  -641, -9995,  -617,-10003,  -597,-10002,  -569,-10001,  -547, -9998,  -557, -9993,  -571, -9993,  -581, -9987,  -599, -9979,  -609, -9964,  -625, -9946,  -639, -9928,  -645, -9914,  -637, -9900,  -623, -9889,  -613, -9882,  -603, -9867,  -599, -9864,  -593, -9870,  -592, -9867,  -581, -9859,  -571, -9844,  -551, -9849,  -525, -9854,  -497, -9870,  -482, -9867,  -497, -9855,  -497, -9840,  -501, -9821,  -519, -9810,  -531, -9788,  -517, -9785,  -498, -9782,  -519, -9766,  -531, -9747,  -535, -9735,  -525, -9726,  -509, -9721,  -521, -9716,  -537, -9701,  -567, -9702,  -611, -9701,  -670, -9703,  -714, -9687,  -758, -9664,  -794, -9641,  -834, -9616,  -818, -9610,  -770, -9629,  -733, -9634,  -727, -9616,  -727, -9594,  -725, -9576,  -721, -9567,  -702, -9559,  -715, -9543,  -719, -9536,  -736, -9515,  -765, -9502,  -803, -9486,  -836, -9473,  -874, -9461,  -910, -9448,  -938, -9439,  -931, -9433,  -924, -9421,  -914, -9410,  -906, -9399,  -900, -9397,  -898, -9394,  -878, -9392,  -854, -9398,  -824, -9416,  -794, -9424,  -782, -9421,  -777, -9413,  -774, -9394,  -762, -9387,  -721, -9386,  -698, -9399,  -687, -9401,  -677, -9397,  -665, -9386,  -645, -9369,  -627, -9357,  -607, -9352,  -579, -9353,  -559, -9362,  -543, -9377,  -521, -9387,  -501, -9392,  -471, -9406,  -451, -9416,  -448, -9402,  -465, -9386,  -492, -9363,  -517, -9346,  -525, -9330,  -535, -9323,  -547, -9319,  -579, -9316,  -636, -9318,  -683, -9316,  -731, -9310,  -733, -9305,  -749, -9289,  -782, -9275,  -803, -9246,  -848, -9215,  -886, -9188,  -918, -9167,  -941, -9150,  -969, -9138,  -992, -9127, -1003, -9110

	EndDataSection

	Global x_=GetSystemMetrics_(#SM_CXFULLSCREEN)
	Global y_=GetSystemMetrics_(#SM_CYFULLSCREEN)

	Structure PointType
		x.f
		y.f
	EndStructure

	Global Dim P.PointType(1000)
	Global Dim Q.PointType(1000)

	Global np,nq
	Global epsilon.f

; EndDefine

Procedure LinePlot(x1,y1,x2,y2,color1,color2,size=1)

	LineXY(x1,y1,x2,y2,color1)
	If x1>=0 And y1>=0 And x1<x_ And y1<y_
		Box(x1-size>>1,y1-size>>1,size,size,color2)
	EndIf
	If x2>=0 And y2>=0 And x2<x_ And y2<y_
		Box(x2-size>>1,y2-size>>1,size,size,color2)
	EndIf

EndProcedure
Procedure.d Distance(px.d,py.d, ax.d,ay.d, bx.d,by.d)

	Protected x0.d, y0.d, l.d, t.d

	x0 = bx-ax
	y0 = ay-by
	l = x0*x0 + y0*y0

	If l=0
		x0 = bx-px
		y0 = by-py
		ProcedureReturn Sqr(x0*x0+y0*y0)
	EndIf ; Error

	t = ((bx-px)*y0+(by-py)*x0)/l
	If t<0.0
		t = -t
	EndIf

	ProcedureReturn t*Sqr(l)

EndProcedure

Procedure ShapeRead()

	np=0

	Read.w np
	For i=1 To np
		Read.w P(i)\x
		Read.w P(i)\y
	Next i

EndProcedure
Procedure ShapeMaxima()

	Global minx.f=8e8
	Global miny.f=8e8
	Global maxx.f=-8e8
	Global maxy.f=-8e8

	For i=1 To np
		If p(i)\x<minx
			minx=p(i)\x
		EndIf
		If p(i)\x>maxx
			maxx=p(i)\x
		EndIf
		If p(i)\y<miny
			miny=p(i)\y
		EndIf
		If p(i)\y>maxy
			maxy=p(i)\y
		EndIf
	Next i

	#Border=32

	maxx-minx
	maxy-miny
	maxx/(x_-#Border)
	maxy/(y_-#Border)
	maxx=1/maxx
	maxy=1/maxy

	If maxx>maxy
		maxx=maxy
	Else
		maxy=maxx
	EndIf

	minx=minx*maxx-#Border>>1
	miny=miny*maxy-#Border>>1

EndProcedure
Procedure ShapeDraw(Array o.PointType(1),n,color,dots=0,ox=0,oy=0)

	Protected v

	o(n+1)\x=o(1)\x
	o(n+1)\y=o(1)\y

	v=dots>>1

	For i=1 To n
		LinePlot(o(i)\x*maxx-minx+ox,o(i)\y*maxy-miny+oy,o(i+1)\x*maxx-minx+ox,o(i+1)\y*maxy-miny+oy,color,#Blue)
		If dots
			Box(o(i)\x*maxx-minx-v+ox,o(i)\y*maxy-miny-v+oy,dots,dots,#Black)
		EndIf
	Next i

EndProcedure

Procedure ShapeAddPoint(n)

	nq+1
	q(nq)\x = p(n)\x;
	q(nq)\y = p(n)\y

EndProcedure
Procedure ShapeOptimize(first,last)

	Protected i.i,b.i
	Protected di.f,db.f,x.f,y.f

	If last > first + 1
		x = p(last)\x - p(first)\x;
		y = p(last)\y - p(first)\y;

		b = first+1;
		db = Distance(p(b)\x,p(b)\y,p(first)\x,p(first)\y,p(last)\x,p(last)\y)
		i = b + 1;
		While i < last
			di = Distance(p(i)\x,p(i)\y,p(first)\x,p(first)\y,p(last)\x,p(last)\y)
			If di >db
				b = i
				db = di
			EndIf
			i = i + 1
		Wend

		If db >= epsilon
			ShapeOptimize(first,b)
			ShapeAddPoint(b)
			ShapeOptimize(b,last)
		EndIf
	EndIf

EndProcedure
Procedure ShapeSimplify(tolerance.f)

	epsilon=tolerance
	nq=0

	ShapeAddPoint(1)
	ShapeOptimize(1,np)
	ShapeAddPoint(np)

EndProcedure

ShapeRead()
ShapeMaxima()

OpenWindow(0,0,0,x_,y_,"World Tuner",#PB_Window_BorderLess)
CanvasGadget(0,0,0,x_,y_)


StartDrawing(CanvasOutput(0))
Box(0,0,x_,y_,#White)
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_Outlined)
ShapeDraw(p(),np,#Gray,0)
DrawText(0,0,Str(np)+" Dots",#Gray)

ShapeSimplify(50)
ShapeDraw(q(),nq,#Red,2,0)
DrawText(0,30,Str(nq)+" Dots, e= "+Str(50),#Red)

ShapeSimplify(250)
ShapeDraw(q(),nq,#Green,2,0)
DrawText(0,60,Str(nq)+" Dots, e= "+Str(250),#Green)

StopDrawing()

Repeat
Until WaitWindowEvent()=#WM_CHAR
User avatar
glomph
User
User
Posts: 48
Joined: Tue Apr 27, 2010 1:43 am
Location: St. Elsewhere / Germany
Contact:

Re: Polygons to the world's end

Post by glomph »

Always wanting to do a globe, but having done only a map last year, with the data Michael Vogel found. Hard work to fix the holes. I used the code from BasicallyPure and my mapdatas and got it run without polyfill, 'cause on Mac i don't know, how to do by now.

Even if the diskussion got a new direction (great!), all should have a bigger database.
Purebasic source (runs on win & Mac) , some towns and a small, not finished coloring file you can get here.

https://www.dropbox.com/s/i6crq5hnty01w ... dglobe.zip

so feel free to have a look.

glomph

P.s.
the map could be seen here (sorry, all german, but the english version is in pereparition)
http://astroprozessor.eu/astrologieseit ... essor.html
Post Reply