Polygons to the world's end

[Andre]

Very impressive! I'm very interested to follow this topic, even on the complete set (with full details). Maybe I contact you later personally....

To make your example work on MacOS I did some small extensions / changes (color definitions + keyboard shortcuts)...

Code: Select all

CompilerIf Not Defined(Gray, #PB_Constant)
  #Gray = $999999
CompilerEndIf
CompilerIf Not Defined(Blue, #PB_Constant)
  #Blue = $2222CC
CompilerEndIf
CompilerIf Not Defined(White, #PB_Constant)
  #White = $DDDDDD
CompilerEndIf
CompilerIf Not Defined(Black, #PB_Constant)
  #Black = 0
CompilerEndIf

Procedure Init()

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

   #Size=2*2*2*2*2*2*2*2*2
   #Dots=(2*2+3*3*11)*3*3
   #InvisibleFlag=5*5*5*5*5
   #Shapes=7*7

   Global RotX=0
   Global RotY=0
   Global Invisible

   Structure DotType
      x.i
      y.i
   EndStructure
   Structure ShapeType
      len.i
      start.i
   EndStructure

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

   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*#Size>>8
         Dots(count)\y*#Size>>8
         count+1
      Next j
   Next i

   DataSection
      Data.a $DC,$FD,$24,$FF,$25,$FE,$27,$FC,$28,$FA,$29,$F8,$2A,$F6,$2B,$F4
      Data.a $2C,$F4,$30,$F2,$33,$EF,$36,$F2,$2C,$F5,$28,$F2,$2A,$F0,$29,$EE
      Data.a $2C,$EA,$2B,$E6,$2C,$E1,$31,$E2,$33,$E4,$34,$E4,$38,$E2,$3F,$DE
      Data.a $42,$DB,$48,$DB,$4E,$DA,$4D,$D9,$4A,$D8,$47,$D6,$47,$D6,$4B,$D5
      Data.a $4E,$D7,$54,$D6,$57,$D5,$5B,$D4,$5E,$D1,$60,$D0,$61,$CD,$62,$CD
      Data.a $69,$CE,$70,$CB,$73,$C9,$6E,$C7,$73,$CA,$7E,$C7,$75,$C5,$69,$C3
      Data.a $66,$C0,$60,$BF,$61,$B9,$6A,$B9,$71,$B5,$6E,$B4,$67,$B4,$61,$B2
      Data.a $62,$B0,$5E,$AD,$5C,$A8,$5A,$A3,$55,$A2,$58,$A5,$5B,$A8,$5C,$AA
      Data.a $5F,$A9,$65,$A5,$6A,$A0,$6D,$9E,$6A,$9D,$65,$9C,$60,$9A,$5A,$98
      Data.a $58,$97,$54,$99,$50,$9A,$4C,$96,$4C,$94,$4B,$93,$48,$95,$46,$99
      Data.a $45,$9C,$42,$9B,$3D,$99,$3E,$98,$3F,$99,$40,$98,$3F,$96,$3E,$94
      Data.a $41,$94,$46,$91,$47,$90,$49,$8F,$48,$8C,$43,$8A,$3F,$8A,$42,$8C
      Data.a $45,$8C,$49,$8B,$46,$87,$41,$84,$42,$81,$46,$7E,$4C,$7A,$4A,$7A
      Data.a $44,$7F,$42,$7E,$3C,$7E,$3B,$81,$39,$83,$36,$84,$34,$86,$33,$86
      Data.a $2F,$88,$30,$87,$32,$89,$33,$8C,$32,$8F,$31,$8F,$2E,$91,$2D,$92
      Data.a $2B,$95,$2B,$92,$2A,$90,$2A,$8F,$27,$92,$23,$90,$22,$8F,$24,$8D
      Data.a $26,$8C,$28,$8D,$2A,$8D,$2C,$8C,$2D,$89,$31,$88,$2D,$87,$2B,$85
      Data.a $2D,$84,$2B,$84,$2A,$85,$29,$84,$28,$84,$27,$85,$26,$87,$25,$89
      Data.a $23,$89,$21,$8B,$20,$8C,$1F,$8D,$1D,$8E,$1D,$90,$1C,$92,$1B,$93
      Data.a $1C,$94,$1C,$97,$1D,$9B,$1F,$9D,$22,$98,$21,$99,$24,$9A,$24,$9C
      Data.a $23,$9F,$22,$A1,$1F,$A2,$20,$A6,$1E,$A7,$1F,$AB,$1E,$AE,$1D,$B0
      Data.a $1D,$B0,$1A,$B4,$19,$B4,$1D,$B3,$21,$B4,$21,$B6,$1E,$B7,$20,$B5
      Data.a $1D,$B5,$19,$B7,$1B,$B7,$19,$BB,$1B,$BC,$1A,$B9,$18,$BB,$17,$BD
      Data.a $16,$BF,$15,$C1,$14,$C2,$14,$C3,$14,$C4,$14,$C8,$13,$C9,$12,$CB
      Data.a $12,$CC,$13,$CD,$13,$CF,$13,$D1,$14,$D1,$15,$CF,$16,$CC,$18,$CE
      Data.a $17,$CF,$17,$D1,$17,$D4,$18,$D8,$18,$DA,$17,$DC,$18,$DC,$1A,$DE
      Data.a $1B,$E1,$1A,$E3,$1A,$E6,$19,$E8,$19,$E7,$1A,$EB,$1A,$EC,$1B,$F1
      Data.a $1B,$F4,$1D,$F7,$1D,$F9,$1D,$FF,$1D,$D5,$0A,$27,$0A,$29,$0B,$2B
      Data.a $0D,$2A,$0D,$2C,$0F,$2C,$10,$2E,$0E,$31,$0C,$32,$0D,$31,$0F,$30
      Data.a $11,$2F,$12,$2D,$13,$2B,$15,$28,$14,$2A,$14,$2C,$16,$2A,$17,$29
      Data.a $18,$2A,$1A,$2B,$1D,$2B,$1E,$2B,$1F,$2D,$20,$2D,$21,$2D,$21,$2E
      Data.a $22,$2F,$22,$31,$23,$31,$23,$32,$24,$34,$25,$36,$25,$37,$27,$38
      Data.a $28,$39,$29,$3A,$29,$3C,$27,$3C,$28,$3E,$28,$44,$29,$4A,$2A,$4D
      Data.a $2B,$4F,$2D,$53,$2F,$57,$2F,$5A,$31,$5E,$31,$5C,$30,$58,$2E,$53
      Data.a $30,$55,$31,$59,$33,$5C,$35,$61,$36,$65,$39,$68,$3C,$6A,$41,$6D
      Data.a $43,$72,$46,$75,$49,$77,$48,$7D,$47,$84,$46,$88,$49,$90,$4C,$97
      Data.a $4E,$A1,$4D,$A9,$4D,$B2,$4C,$B9,$4C,$BC,$4C,$C0,$4C,$C2,$4A,$C3
      Data.a $4B,$C4,$4B,$C7,$4C,$C9,$4D,$CB,$4E,$CB,$4F,$C7,$51,$C3,$52,$BD
      Data.a $52,$BA,$56,$B7,$57,$B1,$5B,$AF,$5D,$A7,$60,$A1,$63,$9F,$64,$96
      Data.a $66,$8E,$63,$84,$60,$82,$5D,$83,$5B,$81,$5A,$79,$56,$76,$54,$72
      Data.a $53,$71,$4F,$70,$4D,$73,$4D,$6F,$49,$74,$46,$73,$44,$6A,$41,$68
      Data.a $42,$62,$3E,$66,$3B,$62,$3A,$5D,$3B,$5A,$3B,$58,$3C,$57,$3D,$56
      Data.a $40,$56,$41,$55,$45,$56,$46,$5C,$46,$54,$48,$50,$4A,$4E,$4A,$4C
      Data.a $4A,$4A,$4A,$48,$4A,$4A,$4A,$48,$4B,$46,$4E,$45,$4E,$44,$4F,$42
      Data.a $50,$40,$53,$40,$52,$41,$54,$3F,$52,$3D,$50,$3A,$4F,$3B,$54,$38
      Data.a $58,$36,$57,$34,$56,$33,$56,$32,$54,$30,$54,$2E,$53,$2C,$52,$2A
      Data.a $50,$2D,$4E,$2C,$4E,$2B,$4C,$29,$4B,$28,$49,$27,$49,$2A,$48,$2C
      Data.a $4A,$30,$48,$34,$48,$37,$46,$36,$45,$31,$41,$30,$3E,$2E,$3D,$2B
      Data.a $3E,$28,$3F,$26,$3F,$25,$41,$25,$40,$22,$42,$21,$45,$22,$45,$1F
      Data.a $44,$1D,$43,$1E,$41,$1F,$3F,$1D,$3E,$1C,$3D,$1A,$3B,$1B,$3C,$1D
      Data.a $3D,$1E,$3C,$20,$3A,$1F,$37,$1F,$34,$1E,$34,$1F,$33,$20,$32,$20
      Data.a $30,$20,$2E,$1E,$2B,$1D,$28,$1D,$27,$1D,$25,$1C,$23,$1D,$22,$1D
      Data.a $20,$1E,$1D,$1D,$1A,$1C,$16,$1C,$13,$1B,$11,$1B,$0F,$1B,$0E,$1C
      Data.a $0C,$1D,$09,$1F,$0C,$21,$0E,$21,$0E,$22,$0C,$21,$09,$22,$0B,$24
      Data.a $0D,$24,$0C,$26,$42,$6D,$1E,$6F,$1D,$70,$1C,$6C,$1C,$6F,$1C,$70
      Data.a $1A,$6E,$19,$6F,$17,$70,$16,$71,$15,$71,$14,$71,$13,$72,$12,$71
      Data.a $11,$72,$0F,$71,$0E,$71,$0D,$76,$0C,$73,$0C,$6F,$0D,$70,$0B,$6A
      Data.a $0C,$6D,$0B,$6F,$0A,$6A,$0A,$68,$0A,$6A,$09,$65,$09,$65,$0A,$60
      Data.a $0A,$62,$0A,$61,$0B,$5E,$0B,$5C,$0C,$58,$0B,$57,$0C,$54,$0C,$51
      Data.a $0E,$52,$0E,$50,$0F,$4C,$11,$4F,$12,$4F,$13,$53,$14,$57,$15,$59
      Data.a $17,$59,$1A,$5C,$1C,$5C,$1D,$5C,$1F,$5A,$21,$5B,$24,$5C,$26,$5D
      Data.a $28,$5E,$29,$5F,$29,$60,$2B,$62,$29,$62,$27,$63,$25,$63,$23,$65
      Data.a $22,$66,$22,$68,$21,$69,$1F,$6A,$1F,$31,$46,$0E,$47,$0D,$4A,$0D
      Data.a $48,$0C,$47,$0D,$45,$0E,$45,$0D,$43,$0D,$44,$0D,$43,$0D,$41,$0D
      Data.a $40,$0D,$40,$0C,$43,$0B,$45,$0B,$46,$0B,$48,$0A,$4B,$0A,$50,$0A
      Data.a $52,$0A,$54,$0B,$50,$0C,$4F,$0C,$52,$0C,$4E,$0E,$4C,$0F,$49,$0F
      Data.a $4B,$0F,$49,$10,$4A,$10,$49,$11,$46,$12,$47,$14,$44,$14,$41,$13
      Data.a $42,$12,$41,$12,$43,$12,$45,$11,$43,$12,$44,$11,$44,$10,$42,$11
      Data.a $42,$10,$45,$10,$44,$0F,$43,$0E,$46,$0F,$46,$0E,$25,$8E,$52,$8A
      Data.a $52,$88,$4E,$85,$4B,$81,$4C,$7C,$4D,$79,$56,$74,$60,$74,$69,$75
      Data.a $6F,$76,$73,$79,$77,$80,$78,$84,$79,$87,$7B,$86,$81,$89,$8A,$89
      Data.a $93,$89,$9B,$8A,$A2,$8C,$AA,$8D,$B1,$91,$B1,$96,$AA,$99,$A3,$9A
      Data.a $9B,$9D,$95,$9C,$8E,$9C,$86,$A0,$7D,$A4,$73,$A1,$71,$9E,$6C,$9B
      Data.a $65,$99,$5C,$97,$54,$93,$53,$1A,$E5,$96,$E1,$96,$E1,$92,$DF,$91
      Data.a $DE,$91,$DC,$96,$DA,$94,$D8,$97,$D7,$9A,$D2,$9E,$D1,$A2,$D1,$A6
      Data.a $D2,$B0,$D6,$B0,$DD,$AD,$E0,$B1,$E2,$B0,$E3,$B2,$E7,$B6,$E9,$B7
      Data.a $EB,$B2,$ED,$AB,$EC,$A3,$EA,$9E,$E8,$99,$E6,$91,$17,$51,$26,$52
      Data.a $25,$50,$23,$52,$23,$54,$22,$51,$1F,$51,$1D,$4F,$1C,$4C,$1A,$4A
      Data.a $19,$47,$19,$44,$18,$44,$1B,$43,$18,$40,$1A,$43,$1C,$48,$1D,$4B
      Data.a $1E,$4B,$22,$49,$25,$4C,$25,$4E,$27,$51,$27,$0D,$90,$0E,$91,$0E
      Data.a $92,$0E,$93,$0E,$92,$0F,$91,$0F,$90,$0F,$8F,$0F,$90,$0F,$8E,$0F
      Data.a $8D,$0E,$8E,$0E,$8F,$0E,$10,$42,$0F,$43,$0F,$41,$10,$40,$10,$3E
      Data.a $11,$3E,$10,$3F,$0F,$3E,$0F,$3C,$0F,$3C,$0E,$3D,$0E,$3C,$0E,$3D
      Data.a $0D,$3F,$0D,$41,$0E,$42,$0E,$0F,$8D,$0F,$8E,$0F,$8E,$10,$8D,$12
      Data.a $8C,$13,$8A,$12,$8B,$12,$8B,$11,$8C,$10,$8A,$10,$89,$10,$88,$0F
      Data.a $89,$0F,$8A,$0F,$8C,$10,$10,$38,$1D,$37,$1D,$36,$1E,$33,$1E,$2F
      Data.a $1E,$2E,$1C,$2E,$1A,$2C,$1A,$2F,$18,$30,$18,$31,$19,$32,$18,$33
      Data.a $19,$34,$18,$36,$1A,$38,$1C,$0C,$7E,$38,$81,$37,$80,$34,$7E,$30
      Data.a $7D,$2E,$7C,$2D,$7C,$2F,$7C,$31,$7D,$30,$7D,$32,$7E,$34,$7D,$37
      Data.a $0A,$33,$14,$32,$13,$33,$14,$34,$15,$31,$16,$31,$15,$2F,$15,$2E
      Data.a $14,$2D,$14,$2E,$14,$0A,$AC,$13,$AF,$13,$B0,$14,$AB,$15,$A9,$16
      Data.a $A9,$17,$A7,$18,$A7,$17,$A8,$15,$AA,$14,$09,$E6,$85,$E2,$82,$DF
      Data.a $81,$DF,$84,$E0,$86,$E3,$8A,$E5,$8D,$E8,$8B,$EB,$8E,$09,$CF,$7D
      Data.a $D1,$7A,$D3,$77,$D4,$78,$D4,$7A,$D4,$7F,$D2,$85,$D0,$85,$CE,$81
      Data.a $07,$A2,$0E,$A3,$0E,$A4,$0E,$A4,$0D,$A3,$0D,$A2,$0D,$A2,$0E,$08
      Data.a $70,$24,$70,$23,$6F,$23,$70,$22,$71,$23,$73,$22,$75,$22,$75,$24
      Data.a $07,$2A,$21,$28,$22,$29,$23,$2A,$23,$2B,$23,$2C,$22,$2B,$22,$07
      Data.a $39,$14,$37,$14,$37,$15,$39,$15,$3A,$15,$3B,$14,$39,$13,$08,$41
      Data.a $15,$44,$15,$45,$14,$47,$15,$44,$16,$41,$16,$3F,$16,$3D,$14,$07
      Data.a $46,$3F,$44,$3E,$42,$40,$42,$45,$43,$40,$44,$42,$46,$40,$07,$FA
      Data.a $BA,$FC,$BB,$FB,$BD,$FA,$C0,$F8,$C2,$F7,$C1,$F8,$BF,$07,$2B,$19
      Data.a $2D,$17,$2A,$16,$27,$16,$27,$18,$27,$1A,$2A,$1A,$06,$31,$27,$2F
      Data.a $27,$2E,$27,$2E,$29,$2C,$29,$30,$29,$06,$FB,$B2,$FC,$B4,$FE,$B6
      Data.a $FE,$B8,$FC,$B9,$FC,$B4,$06,$39,$18,$38,$19,$3A,$1A,$3B,$19,$3B
      Data.a $17,$38,$17,$06,$A5,$4C,$A6,$47,$A5,$43,$A7,$40,$A2,$3F,$A3,$46
      Data.a $06,$90,$11,$91,$11,$91,$12,$90,$12,$8F,$12,$8F,$11,$06,$C8,$7D
      Data.a $C9,$7F,$CB,$85,$C9,$85,$C6,$7C,$C5,$79,$06,$7A,$32,$79,$34,$79
      Data.a $36,$7A,$37,$7C,$34,$7B,$31,$05,$A8,$18,$A9,$1B,$A7,$1C,$A6,$1B
      Data.a $A5,$19,$06,$E5,$48,$E3,$4F,$E0,$50,$DE,$4F,$E2,$4C,$E4,$45,$05
      Data.a $56,$3B,$59,$3D,$5A,$3C,$59,$3A,$58,$37,$05,$39,$10,$38,$11,$36
      Data.a $10,$35,$10,$37,$0F,$05,$4E,$E3,$4B,$E5,$4C,$E8,$46,$E8,$3B,$E7
      Data.a $05,$D7,$7F,$D6,$7F,$D7,$83,$D6,$85,$D5,$80,$04,$3B,$13,$3D,$13
      Data.a $3F,$13,$3F,$14,$05,$A4,$96,$A1,$A3,$9F,$9B,$A1,$96,$A3,$92,$04
      Data.a $05,$21,$04,$22,$03,$20,$01,$1F,$04,$3F,$17,$3E,$19,$3C,$19,$3C
      Data.a $17,$04,$44,$23,$47,$25,$44,$25,$42,$26,$04,$A0,$0D,$A0,$0E,$A1
      Data.a $0D,$A2,$0D,$04,$50,$CC,$50,$CE,$4E,$CD,$4E,$CC,$04,$3A,$33,$3C
      Data.a $38,$3A,$36,$3A,$33,$04,$E0,$DD,$D8,$DF,$D1,$DE,$CB,$DD,$04,$BB
      Data.a $DF,$B5,$E3,$AB,$E0,$A6,$DE,$03,$47,$61,$44,$60,$49,$61,$04,$D0
      Data.a $8C,$CC,$8A,$CD,$89,$D1,$8B,$04,$D7,$69,$D8,$6D,$D6,$6D,$D6,$66

   EndDataSection

EndProcedure
Procedure Dot3D(x.f,y.f,x_.f,y_.f,color)

   Protected x2.f,y2.f
   
   #Radiant=#PI/180

   x*#Radiant
   y*#Radiant
   x_*#Radiant
   y_*#Radiant
   x2=Sin(x-x_)*Cos(y)
   y2=Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_)
   
   If x2>=-1 And x2<=1
      If y2>=-1 And y2<=1
         If Invisible And Cos(x-x_)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<0
            color=#White
         EndIf
         Plot(x2*#Size/2+#Size/2,y2*#Size/2+#Size/2,color)
      EndIf
   EndIf

EndProcedure
Procedure View(a,b)

   Protected i
   Protected x.f,y.f
   Protected x_.f,y_.f

   #Radiant=#PI/180

   x_=a*#Radiant
   y_=b*#Radiant

   For i=0 To #Dots
      x=(Dots(i)\x/#Size*360-180)*#Radiant
      y=(Dots(i)\y/#Size*180-90)*#Radiant
      If (Invisible=1) And Cos(x-x_)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<0
         Dots3D(i)\x=#InvisibleFlag
      Else
         Dots3D(i)\x=(Sin(x-x_)*Cos(y))*#Size/2+#Size/2
         Dots3D(i)\y=(Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_))*#Size/2+#Size/2
      EndIf
   Next i

EndProcedure
Procedure World()

   Protected i,j

   StartDrawing(CanvasOutput(0))
   Circle(#Size/2,#Size/2,#Size/2,$F8F8F0)
   DrawingFont(FontID(0))
   DrawText(0,0,Str(rotx)+"/"+Str(roty)+"  ",#Black,#White)
   DrawingMode(#PB_2DDrawing_Transparent)

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


   i=-180
   While i<180
      i+30
      j=-91
      While j<90
         j+1
         Dot3D(i,j,RotX,RotY,#Gray)
      Wend
   Wend

   i=-90
   While i<90
      i+15
      j=-181
      While j<180
         j+1
         Dot3D(j,i,RotX,RotY,#Gray)
      Wend
   Wend

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

   View(RotX,RotY)

   For i=0 To #Shapes
      start=Shapes(i)\start
      stop=start+Shapes(i)\len-1

      If Dots3D(start)\x<>#InvisibleFlag And Dots3D(stop)\x<>#InvisibleFlag
         LineXY(Dots3D(stop)\x,Dots3D(stop)\y,Dots3D(start)\x,Dots3D(start)\y,#Blue)
      EndIf

      For j=start To stop-1
         If Dots3D(j)\x<>#InvisibleFlag And Dots3D(j+1)\x<>#InvisibleFlag
            LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Blue)
         EndIf
      Next j

   Next i

   StopDrawing()
   
EndProcedure


Enumeration 
  #Escape
  #x
  #XX
  #y
  #YY
  #Space
EndEnumeration
  
 
Procedure Main()

   Init()

   LoadFont(0,"Arial",8)
   OpenWindow(0,0,0,#Size+1,#Size+1,"My little World by Michael Vogel",#PB_Window_ScreenCentered)
   CanvasGadget(0,0,0,#Size+1,#Size+1)
   
   AddKeyboardShortcut(0, #PB_Shortcut_Escape, #Escape)
   AddKeyboardShortcut(0, #PB_Shortcut_X, #x)
   AddKeyboardShortcut(0, #PB_Shortcut_Shift|#PB_Shortcut_X, #XX)
   AddKeyboardShortcut(0, #PB_Shortcut_Y, #y)
   AddKeyboardShortcut(0, #PB_Shortcut_Shift|#PB_Shortcut_Y, #YY)
   AddKeyboardShortcut(0, #PB_Shortcut_Space, #Space)
   
   RotY=-40
   RotX=0

   World()

   Repeat
      Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
         End
      Case #PB_Event_Menu
         Select EventMenu()
         Case #Escape
            End
         Case #x
            RotX+5
            World()
         Case #XX
            RotX-5
            World()
         Case #y
            RotY+5
            World()
         Case #YY
            RotY-5
            World()
         Case #Space
            Invisible!1
            World()

         EndSelect
      EndSelect

   Until EndOfWorld

EndProcedure

Main()

[ts-soft]

@Andre

Defined() works only with CompilerIf, CompilerEndIf, CompilerCase ....
You have to change the first part of your code to:

Code: Select all

CompilerIf Not Defined(Gray, #PB_Constant)
  #Gray = $999999
CompilerEndIf
CompilerIf Not Defined(Blue, #PB_Constant)
  #Blue = $2222CC
CompilerEndIf
CompilerIf Not Defined(White, #PB_Constant)
  #White = $DDDDDD
CompilerEndIf
CompilerIf Not Defined(Black, #PB_Constant)
  #Black = 0
CompilerEndIf

Greetings - Thomas

[Andre]

@Thomas: thank you, have updated my posted code. (It worked here anyway, that's why I didn't recognized my fault... )

[kenmo]

You don't need the Defined() checks at all if you use the same values present on Windows.

Code: Select all

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

Then it works on Mac, and Windows PB won't complain since it wasn't re-defined with a different value. I think that's true for any constant.

[Michael Vogel]

I've found the issues for detecting visibility:
• I forgot to include the latitude when calculating the rotated longitude coordinate on the globe, now I have changed
Cos(x-x_) to Cos(x-x_)*Cos(y) which seems to work to get the correct z value then
• the second problem was easy to solve, I removed plotting of white points which could make (parts of) the grid invisible

So now I am ready to ask (again) for a possibility to do the trick with the polygons, here's a first (brute force) solution (windows only), which shows the resulting problems very quickly when rotating the world...
...so what's your ideas to make a better world?

Code: Select all

Procedure Init()

	; My little World Version 1.2_polytest
	; (c) 2013 by Michael Vogel

	#Size=2*2*2*2*2*2*2*2*2
	#Dots=(2*2+3*3*11)*3*3
	#Shapes=7*7
	#Shadow=0

	#GreenWorld=$80FF80
	#Gray  = $808080
	#Blue  = $FF0000
	#White = $FFFFFF
	#Black = $000000

	Global RotX=-25
	Global RotY=25
	Global Invisible=#True

	Structure DotType
		x.i
		y.i
		visible.i
	EndStructure
	Structure ShapeType
		len.i
		start.i
	EndStructure

	Global Dim Dots.DotType(#Dots)
	Global Dim Dots3D.DotType(#Dots)
	Global Dim Shapes.ShapeType(#Shapes)
	Global Dim Poly.l(666)

	Global PolyCount
	Global PolyDC

	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*#Size>>8
			Dots(count)\y*#Size>>8
			count+1
		Next j
	Next i

	DataSection
		Data.a $DC,$FD,$24,$FF,$25,$FE,$27,$FC,$28,$FA,$29,$F8,$2A,$F6,$2B,$F4
		Data.a $2C,$F4,$30,$F2,$33,$EF,$36,$F2,$2C,$F5,$28,$F2,$2A,$F0,$29,$EE
		Data.a $2C,$EA,$2B,$E6,$2C,$E1,$31,$E2,$33,$E4,$34,$E4,$38,$E2,$3F,$DE
		Data.a $42,$DB,$48,$DB,$4E,$DA,$4D,$D9,$4A,$D8,$47,$D6,$47,$D6,$4B,$D5
		Data.a $4E,$D7,$54,$D6,$57,$D5,$5B,$D4,$5E,$D1,$60,$D0,$61,$CD,$62,$CD
		Data.a $69,$CE,$70,$CB,$73,$C9,$6E,$C7,$73,$CA,$7E,$C7,$75,$C5,$69,$C3
		Data.a $66,$C0,$60,$BF,$61,$B9,$6A,$B9,$71,$B5,$6E,$B4,$67,$B4,$61,$B2
		Data.a $62,$B0,$5E,$AD,$5C,$A8,$5A,$A3,$55,$A2,$58,$A5,$5B,$A8,$5C,$AA
		Data.a $5F,$A9,$65,$A5,$6A,$A0,$6D,$9E,$6A,$9D,$65,$9C,$60,$9A,$5A,$98
		Data.a $58,$97,$54,$99,$50,$9A,$4C,$96,$4C,$94,$4B,$93,$48,$95,$46,$99
		Data.a $45,$9C,$42,$9B,$3D,$99,$3E,$98,$3F,$99,$40,$98,$3F,$96,$3E,$94
		Data.a $41,$94,$46,$91,$47,$90,$49,$8F,$48,$8C,$43,$8A,$3F,$8A,$42,$8C
		Data.a $45,$8C,$49,$8B,$46,$87,$41,$84,$42,$81,$46,$7E,$4C,$7A,$4A,$7A
		Data.a $44,$7F,$42,$7E,$3C,$7E,$3B,$81,$39,$83,$36,$84,$34,$86,$33,$86
		Data.a $2F,$88,$30,$87,$32,$89,$33,$8C,$32,$8F,$31,$8F,$2E,$91,$2D,$92
		Data.a $2B,$95,$2B,$92,$2A,$90,$2A,$8F,$27,$92,$23,$90,$22,$8F,$24,$8D
		Data.a $26,$8C,$28,$8D,$2A,$8D,$2C,$8C,$2D,$89,$31,$88,$2D,$87,$2B,$85
		Data.a $2D,$84,$2B,$84,$2A,$85,$29,$84,$28,$84,$27,$85,$26,$87,$25,$89
		Data.a $23,$89,$21,$8B,$20,$8C,$1F,$8D,$1D,$8E,$1D,$90,$1C,$92,$1B,$93
		Data.a $1C,$94,$1C,$97,$1D,$9B,$1F,$9D,$22,$98,$21,$99,$24,$9A,$24,$9C
		Data.a $23,$9F,$22,$A1,$1F,$A2,$20,$A6,$1E,$A7,$1F,$AB,$1E,$AE,$1D,$B0
		Data.a $1D,$B0,$1A,$B4,$19,$B4,$1D,$B3,$21,$B4,$21,$B6,$1E,$B7,$20,$B5
		Data.a $1D,$B5,$19,$B7,$1B,$B7,$19,$BB,$1B,$BC,$1A,$B9,$18,$BB,$17,$BD
		Data.a $16,$BF,$15,$C1,$14,$C2,$14,$C3,$14,$C4,$14,$C8,$13,$C9,$12,$CB
		Data.a $12,$CC,$13,$CD,$13,$CF,$13,$D1,$14,$D1,$15,$CF,$16,$CC,$18,$CE
		Data.a $17,$CF,$17,$D1,$17,$D4,$18,$D8,$18,$DA,$17,$DC,$18,$DC,$1A,$DE
		Data.a $1B,$E1,$1A,$E3,$1A,$E6,$19,$E8,$19,$E7,$1A,$EB,$1A,$EC,$1B,$F1
		Data.a $1B,$F4,$1D,$F7,$1D,$F9,$1D,$FF,$1D,$D5,$0A,$27,$0A,$29,$0B,$2B
		Data.a $0D,$2A,$0D,$2C,$0F,$2C,$10,$2E,$0E,$31,$0C,$32,$0D,$31,$0F,$30
		Data.a $11,$2F,$12,$2D,$13,$2B,$15,$28,$14,$2A,$14,$2C,$16,$2A,$17,$29
		Data.a $18,$2A,$1A,$2B,$1D,$2B,$1E,$2B,$1F,$2D,$20,$2D,$21,$2D,$21,$2E
		Data.a $22,$2F,$22,$31,$23,$31,$23,$32,$24,$34,$25,$36,$25,$37,$27,$38
		Data.a $28,$39,$29,$3A,$29,$3C,$27,$3C,$28,$3E,$28,$44,$29,$4A,$2A,$4D
		Data.a $2B,$4F,$2D,$53,$2F,$57,$2F,$5A,$31,$5E,$31,$5C,$30,$58,$2E,$53
		Data.a $30,$55,$31,$59,$33,$5C,$35,$61,$36,$65,$39,$68,$3C,$6A,$41,$6D
		Data.a $43,$72,$46,$75,$49,$77,$48,$7D,$47,$84,$46,$88,$49,$90,$4C,$97
		Data.a $4E,$A1,$4D,$A9,$4D,$B2,$4C,$B9,$4C,$BC,$4C,$C0,$4C,$C2,$4A,$C3
		Data.a $4B,$C4,$4B,$C7,$4C,$C9,$4D,$CB,$4E,$CB,$4F,$C7,$51,$C3,$52,$BD
		Data.a $52,$BA,$56,$B7,$57,$B1,$5B,$AF,$5D,$A7,$60,$A1,$63,$9F,$64,$96
		Data.a $66,$8E,$63,$84,$60,$82,$5D,$83,$5B,$81,$5A,$79,$56,$76,$54,$72
		Data.a $53,$71,$4F,$70,$4D,$73,$4D,$6F,$49,$74,$46,$73,$44,$6A,$41,$68
		Data.a $42,$62,$3E,$66,$3B,$62,$3A,$5D,$3B,$5A,$3B,$58,$3C,$57,$3D,$56
		Data.a $40,$56,$41,$55,$45,$56,$46,$5C,$46,$54,$48,$50,$4A,$4E,$4A,$4C
		Data.a $4A,$4A,$4A,$48,$4A,$4A,$4A,$48,$4B,$46,$4E,$45,$4E,$44,$4F,$42
		Data.a $50,$40,$53,$40,$52,$41,$54,$3F,$52,$3D,$50,$3A,$4F,$3B,$54,$38
		Data.a $58,$36,$57,$34,$56,$33,$56,$32,$54,$30,$54,$2E,$53,$2C,$52,$2A
		Data.a $50,$2D,$4E,$2C,$4E,$2B,$4C,$29,$4B,$28,$49,$27,$49,$2A,$48,$2C
		Data.a $4A,$30,$48,$34,$48,$37,$46,$36,$45,$31,$41,$30,$3E,$2E,$3D,$2B
		Data.a $3E,$28,$3F,$26,$3F,$25,$41,$25,$40,$22,$42,$21,$45,$22,$45,$1F
		Data.a $44,$1D,$43,$1E,$41,$1F,$3F,$1D,$3E,$1C,$3D,$1A,$3B,$1B,$3C,$1D
		Data.a $3D,$1E,$3C,$20,$3A,$1F,$37,$1F,$34,$1E,$34,$1F,$33,$20,$32,$20
		Data.a $30,$20,$2E,$1E,$2B,$1D,$28,$1D,$27,$1D,$25,$1C,$23,$1D,$22,$1D
		Data.a $20,$1E,$1D,$1D,$1A,$1C,$16,$1C,$13,$1B,$11,$1B,$0F,$1B,$0E,$1C
		Data.a $0C,$1D,$09,$1F,$0C,$21,$0E,$21,$0E,$22,$0C,$21,$09,$22,$0B,$24
		Data.a $0D,$24,$0C,$26,$42,$6D,$1E,$6F,$1D,$70,$1C,$6C,$1C,$6F,$1C,$70
		Data.a $1A,$6E,$19,$6F,$17,$70,$16,$71,$15,$71,$14,$71,$13,$72,$12,$71
		Data.a $11,$72,$0F,$71,$0E,$71,$0D,$76,$0C,$73,$0C,$6F,$0D,$70,$0B,$6A
		Data.a $0C,$6D,$0B,$6F,$0A,$6A,$0A,$68,$0A,$6A,$09,$65,$09,$65,$0A,$60
		Data.a $0A,$62,$0A,$61,$0B,$5E,$0B,$5C,$0C,$58,$0B,$57,$0C,$54,$0C,$51
		Data.a $0E,$52,$0E,$50,$0F,$4C,$11,$4F,$12,$4F,$13,$53,$14,$57,$15,$59
		Data.a $17,$59,$1A,$5C,$1C,$5C,$1D,$5C,$1F,$5A,$21,$5B,$24,$5C,$26,$5D
		Data.a $28,$5E,$29,$5F,$29,$60,$2B,$62,$29,$62,$27,$63,$25,$63,$23,$65
		Data.a $22,$66,$22,$68,$21,$69,$1F,$6A,$1F,$31,$46,$0E,$47,$0D,$4A,$0D
		Data.a $48,$0C,$47,$0D,$45,$0E,$45,$0D,$43,$0D,$44,$0D,$43,$0D,$41,$0D
		Data.a $40,$0D,$40,$0C,$43,$0B,$45,$0B,$46,$0B,$48,$0A,$4B,$0A,$50,$0A
		Data.a $52,$0A,$54,$0B,$50,$0C,$4F,$0C,$52,$0C,$4E,$0E,$4C,$0F,$49,$0F
		Data.a $4B,$0F,$49,$10,$4A,$10,$49,$11,$46,$12,$47,$14,$44,$14,$41,$13
		Data.a $42,$12,$41,$12,$43,$12,$45,$11,$43,$12,$44,$11,$44,$10,$42,$11
		Data.a $42,$10,$45,$10,$44,$0F,$43,$0E,$46,$0F,$46,$0E,$25,$8E,$52,$8A
		Data.a $52,$88,$4E,$85,$4B,$81,$4C,$7C,$4D,$79,$56,$74,$60,$74,$69,$75
		Data.a $6F,$76,$73,$79,$77,$80,$78,$84,$79,$87,$7B,$86,$81,$89,$8A,$89
		Data.a $93,$89,$9B,$8A,$A2,$8C,$AA,$8D,$B1,$91,$B1,$96,$AA,$99,$A3,$9A
		Data.a $9B,$9D,$95,$9C,$8E,$9C,$86,$A0,$7D,$A4,$73,$A1,$71,$9E,$6C,$9B
		Data.a $65,$99,$5C,$97,$54,$93,$53,$1A,$E5,$96,$E1,$96,$E1,$92,$DF,$91
		Data.a $DE,$91,$DC,$96,$DA,$94,$D8,$97,$D7,$9A,$D2,$9E,$D1,$A2,$D1,$A6
		Data.a $D2,$B0,$D6,$B0,$DD,$AD,$E0,$B1,$E2,$B0,$E3,$B2,$E7,$B6,$E9,$B7
		Data.a $EB,$B2,$ED,$AB,$EC,$A3,$EA,$9E,$E8,$99,$E6,$91,$17,$51,$26,$52
		Data.a $25,$50,$23,$52,$23,$54,$22,$51,$1F,$51,$1D,$4F,$1C,$4C,$1A,$4A
		Data.a $19,$47,$19,$44,$18,$44,$1B,$43,$18,$40,$1A,$43,$1C,$48,$1D,$4B
		Data.a $1E,$4B,$22,$49,$25,$4C,$25,$4E,$27,$51,$27,$0D,$90,$0E,$91,$0E
		Data.a $92,$0E,$93,$0E,$92,$0F,$91,$0F,$90,$0F,$8F,$0F,$90,$0F,$8E,$0F
		Data.a $8D,$0E,$8E,$0E,$8F,$0E,$10,$42,$0F,$43,$0F,$41,$10,$40,$10,$3E
		Data.a $11,$3E,$10,$3F,$0F,$3E,$0F,$3C,$0F,$3C,$0E,$3D,$0E,$3C,$0E,$3D
		Data.a $0D,$3F,$0D,$41,$0E,$42,$0E,$0F,$8D,$0F,$8E,$0F,$8E,$10,$8D,$12
		Data.a $8C,$13,$8A,$12,$8B,$12,$8B,$11,$8C,$10,$8A,$10,$89,$10,$88,$0F
		Data.a $89,$0F,$8A,$0F,$8C,$10,$10,$38,$1D,$37,$1D,$36,$1E,$33,$1E,$2F
		Data.a $1E,$2E,$1C,$2E,$1A,$2C,$1A,$2F,$18,$30,$18,$31,$19,$32,$18,$33
		Data.a $19,$34,$18,$36,$1A,$38,$1C,$0C,$7E,$38,$81,$37,$80,$34,$7E,$30
		Data.a $7D,$2E,$7C,$2D,$7C,$2F,$7C,$31,$7D,$30,$7D,$32,$7E,$34,$7D,$37
		Data.a $0A,$33,$14,$32,$13,$33,$14,$34,$15,$31,$16,$31,$15,$2F,$15,$2E
		Data.a $14,$2D,$14,$2E,$14,$0A,$AC,$13,$AF,$13,$B0,$14,$AB,$15,$A9,$16
		Data.a $A9,$17,$A7,$18,$A7,$17,$A8,$15,$AA,$14,$09,$E6,$85,$E2,$82,$DF
		Data.a $81,$DF,$84,$E0,$86,$E3,$8A,$E5,$8D,$E8,$8B,$EB,$8E,$09,$CF,$7D
		Data.a $D1,$7A,$D3,$77,$D4,$78,$D4,$7A,$D4,$7F,$D2,$85,$D0,$85,$CE,$81
		Data.a $07,$A2,$0E,$A3,$0E,$A4,$0E,$A4,$0D,$A3,$0D,$A2,$0D,$A2,$0E,$08
		Data.a $70,$24,$70,$23,$6F,$23,$70,$22,$71,$23,$73,$22,$75,$22,$75,$24
		Data.a $07,$2A,$21,$28,$22,$29,$23,$2A,$23,$2B,$23,$2C,$22,$2B,$22,$07
		Data.a $39,$14,$37,$14,$37,$15,$39,$15,$3A,$15,$3B,$14,$39,$13,$08,$41
		Data.a $15,$44,$15,$45,$14,$47,$15,$44,$16,$41,$16,$3F,$16,$3D,$14,$07
		Data.a $46,$3F,$44,$3E,$42,$40,$42,$45,$43,$40,$44,$42,$46,$40,$07,$FA
		Data.a $BA,$FC,$BB,$FB,$BD,$FA,$C0,$F8,$C2,$F7,$C1,$F8,$BF,$07,$2B,$19
		Data.a $2D,$17,$2A,$16,$27,$16,$27,$18,$27,$1A,$2A,$1A,$06,$31,$27,$2F
		Data.a $27,$2E,$27,$2E,$29,$2C,$29,$30,$29,$06,$FB,$B2,$FC,$B4,$FE,$B6
		Data.a $FE,$B8,$FC,$B9,$FC,$B4,$06,$39,$18,$38,$19,$3A,$1A,$3B,$19,$3B
		Data.a $17,$38,$17,$06,$A5,$4C,$A6,$47,$A5,$43,$A7,$40,$A2,$3F,$A3,$46
		Data.a $06,$90,$11,$91,$11,$91,$12,$90,$12,$8F,$12,$8F,$11,$06,$C8,$7D
		Data.a $C9,$7F,$CB,$85,$C9,$85,$C6,$7C,$C5,$79,$06,$7A,$32,$79,$34,$79
		Data.a $36,$7A,$37,$7C,$34,$7B,$31,$05,$A8,$18,$A9,$1B,$A7,$1C,$A6,$1B
		Data.a $A5,$19,$06,$E5,$48,$E3,$4F,$E0,$50,$DE,$4F,$E2,$4C,$E4,$45,$05
		Data.a $56,$3B,$59,$3D,$5A,$3C,$59,$3A,$58,$37,$05,$39,$10,$38,$11,$36
		Data.a $10,$35,$10,$37,$0F,$05,$4E,$E3,$4B,$E5,$4C,$E8,$46,$E8,$3B,$E7
		Data.a $05,$D7,$7F,$D6,$7F,$D7,$83,$D6,$85,$D5,$80,$04,$3B,$13,$3D,$13
		Data.a $3F,$13,$3F,$14,$05,$A4,$96,$A1,$A3,$9F,$9B,$A1,$96,$A3,$92,$04
		Data.a $05,$21,$04,$22,$03,$20,$01,$1F,$04,$3F,$17,$3E,$19,$3C,$19,$3C
		Data.a $17,$04,$44,$23,$47,$25,$44,$25,$42,$26,$04,$A0,$0D,$A0,$0E,$A1
		Data.a $0D,$A2,$0D,$04,$50,$CC,$50,$CE,$4E,$CD,$4E,$CC,$04,$3A,$33,$3C
		Data.a $38,$3A,$36,$3A,$33,$04,$E0,$DD,$D8,$DF,$D1,$DE,$CB,$DD,$04,$BB
		Data.a $DF,$B5,$E3,$AB,$E0,$A6,$DE,$03,$47,$61,$44,$60,$49,$61,$04,$D0
		Data.a $8C,$CC,$8A,$CD,$89,$D1,$8B,$04,$D7,$69,$D8,$6D,$D6,$6D,$D6,$66

	EndDataSection

EndProcedure
Procedure Dot3D(x.f,y.f,x_.f,y_.f,color)

	Protected x2.f,y2.f

	#Radiant=#PI/180

	x*#Radiant
	y*#Radiant
	x_*#Radiant
	y_*#Radiant
	x2=Sin(x-x_)*Cos(y)
	y2=Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_)

	If x2>=-1 And x2<=1
		If y2>=-1 And y2<=1
			If Invisible And Cos(x-x_)*Cos(y)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<0
				color=#White
			Else
				Plot(x2*#Size/2+#Size/2,y2*#Size/2+#Size/2,color)
			EndIf
		EndIf
	EndIf

EndProcedure
Procedure View(a,b)

	Protected i
	Protected x.f,y.f
	Protected x_.f,y_.f

	#Radiant=#PI/180

	x_=a*#Radiant
	y_=b*#Radiant

	For i=0 To #Dots
		x=(Dots(i)\x/#Size*360-180)*#Radiant
		y=(Dots(i)\y/#Size*180-90)*#Radiant
		If (Invisible=1) And Cos(x-x_)*Cos(y)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<-0
			Dots3D(i)\visible=#False
		Else
			Dots3D(i)\visible=#True
		EndIf
		Dots3D(i)\x=(Sin(x-x_)*Cos(y))*#Size/2
		Dots3D(i)\y=(Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_))*#Size/2
	Next i

EndProcedure
Procedure Polygon(x,y,mode)

	Enumeration
		#PolyReset
		#PolyAddPoint
	EndEnumeration

	Select mode
	Case #PolyReset
		PolyCount=0

	Case #PolyAddPoint
		Poly(PolyCount)=x
		PolyCount+1
		Poly(PolyCount)=y
		PolyCount+1

	Default; #PolyDraw

		mode=CreateSolidBrush_(mode)
		SelectObject_(PolyDC,mode)
		Polygon_(PolyDC,@Poly(),PolyCount>>1)
		DeleteObject_(mode)

	EndSelect


EndProcedure

Procedure World()

	Protected i,j,flag

	Enumeration
		#FlagInvisible
		#FlagInit
		#FlagVisible
	EndEnumeration

	PolyDC=StartDrawing(CanvasOutput(0))
	Circle(#Size/2,#Size/2,#Size/2,$F8F8F0)
	DrawingMode(#PB_2DDrawing_Transparent)

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

	View(RotX,RotY)

	For i=0 To #Shapes
		start=Shapes(i)\start
		stop=start+Shapes(i)\len-1

		flag=#False
		For j=start To stop
			If Dots3D(j)\visible=#False
				faktor.f=Sqr(Dots3D(j)\x*Dots3D(j)\x+Dots3D(j)\y*Dots3D(j)\y)
				If faktor
					faktor=#Size/faktor
					Dots3D(j)\x*faktor
					Dots3D(j)\y*faktor
				EndIf
			Else
				flag=#True
			EndIf
			Dots3D(j)\x+#Size/2
			Dots3D(j)\y+#Size/2
		Next j

		If flag
			LineXY(Dots3D(stop)\x,Dots3D(stop)\y,Dots3D(start)\x,Dots3D(start)\y,#Blue)
			Polygon(0,0,#PolyReset)
			Polygon(Dots3D(start)\x,Dots3D(start)\y,#PolyAddPoint)

			For j=start To stop-1
				LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Blue)
				Polygon(Dots3D(j+1)\x,Dots3D(j+1)\y,#PolyAddPoint)
			Next j

			Polygon(0,0,#GreenWorld)
		EndIf

	Next i


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

	#StepL=30;	30
	#StepS=1;	1

	i=-180-#StepL
	While i<180
		i+#StepL
		j=-90-#StepS
		While j<90
			j+#StepS
			Dot3D(i,j,RotX,RotY,#Gray)
		Wend
	Wend

	i=-90-#StepL
	While i<90
		i+#StepL
		j=-180-#StepS
		While j<180
			j+#StepS
			Dot3D(j,i,RotX,RotY,#Gray)
		Wend
	Wend


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

	DrawingMode(#PB_2DDrawing_AlphaBlend)
	DrawImage(ImageID(#Shadow),0,0)
	
	DrawingFont(FontID(0))
	DrawText(0,0,Str(rotx)+"/"+Str(roty)+" "+Left("*",Invisible)+"  ",$ff000000,#White)

	StopDrawing()

EndProcedure
Procedure Main()

	Init()

	LoadFont(0,"Arial",8)
	OpenWindow(0,0,0,#Size+1,#Size+1,"My little World by Michael Vogel",#PB_Window_ScreenCentered)
	CanvasGadget(0,0,0,#Size+1,#Size+1)

	CreateImage(#Shadow,#Size,#Size,32)
	StartDrawing(ImageOutput(#Shadow))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#Size,#Size,$ffffe0e0)
	DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AllChannels)

	BackColor($40FFFFFF)
	FrontColor($40000000)

	CircularGradient(#Size/3,#Size/3,#Size)
	Circle(#Size/2,#Size/2,#Size/2)

	DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
	Circle(#Size/2,#Size/2,#Size/2,$10000000)
	Circle(#Size/2,#Size/2,#Size/2+1,$10000000)
	StopDrawing()


	RotX=25
	RotY=-25
	
	World()

	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
		Case #WM_CHAR
			Select EventwParam()
			Case #ESC
				End
			Case 'x'
				RotX+5
				World()
			Case 'X'
				RotX-5
				World()
			Case 'y'
				RotY+5
				World()
			Case 'Y'
				RotY-5
				World()
			Case ' '
				Invisible!1
				World()

			EndSelect
		EndSelect

	Until EndOfWorld

EndProcedure

Main()

[BasicallyPure]

To say this is difficult would be an understatement.

Code: Select all

; GlobeMap.pb
; drawing a 3D sphere with 2D graphics
; graphing latitude & longitude on sphere.
;
; by BasicallyPure, 1.21.2013
;
; Windows, Linux
;
EnableExplicit

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

Declare DrawMap()
Declare DrawGlobe()
Declare Grid()
Declare Rotate()
Declare Verify(result, text.s)

Enumeration ;{
   #Canvas
   #ShowMap
   #ShowGlobe
   #ShowGrid
   #Fill
   #TrkDistance
   #TrkPitch
   #TrkRoll
   #TrkYaw
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,32),"CreateImage")
CanvasGadget(#Canvas,0,0,#imageWidth,#winHeight)
OptionGadget(#ShowMap,#imageWidth + 10,20,80,25,"show map")
OptionGadget(#ShowGlobe,#imageWidth + 10,50,80,25,"show globe")
CheckBoxGadget(#ShowGrid,#imageWidth + 10,85,80,25,"show grid")
CheckBoxGadget(#Fill,#imageWidth + 10,120,80,25,"fill")
flags = #PB_TrackBar_Vertical | #PB_TrackBar_Ticks
TrackBarGadget(#TrkPitch,#imageWidth +10 ,170,030,200,0,36,flags)
TrackBarGadget(#TrkYaw, #imageWidth + 50 ,170,030,200,0,36,flags)
TrackBarGadget(#TrkRoll,#imageWidth + 90 ,170,030,200,0,36,flags)
TrackBarGadget(#TrkDistance,#imageWidth +10 ,390,030,200,10,30,flags)

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, Yrot, Zrot
Global distance.d = 10 ; viewing distance
Global 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)

Define.d x, y, SumX, SumY
Define.i i, j, ShapePointCount

;{ 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
               DrawMap()
            Case #ShowGlobe
               DrawGlobe()
            Case #ShowGrid
               grid = GetGadgetState(#ShowGrid)
               If GetGadgetState(#ShowMap) = #True
                  DrawMap()
               Else
                  DrawGlobe()
               EndIf
            Case #Fill
               fill = GetGadgetState(#Fill)
               If GetGadgetState(#ShowMap) = #True
                  DrawMap()
               Else
                  DrawGlobe()
               EndIf
            Case #TrkDistance
               distance = GetGadgetState(#TrkDistance)
               DrawGlobe()
            Case #TrkPitch
               Xrot = Radian(GetGadgetState(#TrkPitch)*10)
               DrawGlobe()
            Case #TrkYaw
               Yrot = Radian(GetGadgetState(#TrkYaw)*10)
               DrawGlobe()
            Case #TrkRoll
               Zrot = Radian(GetGadgetState(#TrkRoll)*10)
               DrawGlobe()
         EndSelect
   EndSelect
   
ForEver ;}

Procedure DrawMap()
   Protected.d x, y, firstX, firstY, lastX, lastY
   Protected.i i
   StartDrawing(CanvasOutput(#Canvas))
   Box(0,0,#imageWidth,#winHeight,0)
   StopDrawing()
   StartDrawing(ImageOutput(0))
   Box(0,0,#imageWidth,#imageHeight,$FF0000)
   
   For i = 0 To #NumShapes
      FirstElement(shape(i)\pointList())
      firstX = shape(i)\pointList()\lng
      firstY = shape(i)\pointList()\lat
      firstX = Degree(firstX)+mid_imgX
      firstY = Degree(firstY)+mid_imgY
      lastX = firstX : lastY = firstY
      
      ForEach shape(i)\pointList()
         x = shape(i)\pointList()\lng
         y = shape(i)\pointList()\lat
         x = Degree(x) + mid_imgX
         y = Degree(y) + mid_imgY
         LineXY(lastX,lastY,x,y,$FF00)
         lastX = x : lastY = y
      Next
      
      LineXY(lastX,lastY,firstX,firstY,$FF00)
      
      If fill = #True 
         x = Degree(shape(i)\AvgLon) + mid_imgX
         y = Degree(shape(i)\AvgLat) + mid_imgY
         Select i
            Case 21,24,27 ; lakes
               FillArea(x,y,$FF00,$FF0000)
            Case 11,39 ; breaks if filled because x y point is outside of shape
               ; do nothing
            Default ; land area
               FillArea(x,y,$FF00,shape(i)\color)
         EndSelect
      EndIf
   Next i
   
   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()
   SetGadgetAttribute(#Canvas,#PB_Canvas_Image,ImageID(0))
EndProcedure

Procedure DrawGlobe()
   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)
   
   If fill
      Circle(mid_canvX,mid_canvY,#Scale/distance+3,$FF00)
   EndIf
   
   Circle(mid_canvX,mid_canvY,#Scale/distance,$8F271C)
   For i = 0 To #NumShapes
      flag = 0
      ForEach shape(i)\pointList()
         x = shape(i)\pointList()\lng / 2
         y = shape(i)\pointList()\lat / 2
         
         Project_to_3D_Sphere
         
         ;apply rotation
         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,$FF00)
            Xp = X2d : Yp = Y2d
         ElseIf flag > 1
            flag = 1
         EndIf
      Next
      If flag > 1 And Z3d > 0
         LineXY(Xp,Yp,firstX,firstY,$FF00) ; draw final line
         If fill = #True
            x = shape(i)\AvgLon / 2
            y = shape(i)\AvgLat / 2
            Project_to_3D_Sphere
            Rotate()
            Project_3D_to_2D
            FillArea(X2d,Y2d,$FF00,shape(i)\color)
         EndIf
      EndIf
   Next i
   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 X axis rotation
   c = Cos(Xrot) : s = Sin(Xrot)
   t = s * Y3d + c * Z3d
   Y3d = c * Y3d - s * Z3d
   Z3d = t
   
   ; do Y axix rotation
   c = Cos(Yrot) : s = Sin(Yrot)
   t = s * Z3d + c * X3d
   Z3d = c * Z3d - s * X3d
   X3d = t
   
   ; do Z axiS rotation
   c = Cos(Zrot) : s = Sin(Zrot)
   t = s * X3d + c * Y3d
   X3d = c * X3d - s * Y3d
   Y3d = t
   
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 $DC,$FD,$24,$FF,$25,$FE,$27,$FC,$28,$FA,$29,$F8,$2A,$F6,$2B,$F4
   Data.a $2C,$F4,$30,$F2,$33,$EF,$36,$F2,$2C,$F5,$28,$F2,$2A,$F0,$29,$EE
   Data.a $2C,$EA,$2B,$E6,$2C,$E1,$31,$E2,$33,$E4,$34,$E4,$38,$E2,$3F,$DE
   Data.a $42,$DB,$48,$DB,$4E,$DA,$4D,$D9,$4A,$D8,$47,$D6,$47,$D6,$4B,$D5
   Data.a $4E,$D7,$54,$D6,$57,$D5,$5B,$D4,$5E,$D1,$60,$D0,$61,$CD,$62,$CD
   Data.a $69,$CE,$70,$CB,$73,$C9,$6E,$C7,$73,$CA,$7E,$C7,$75,$C5,$69,$C3
   Data.a $66,$C0,$60,$BF,$61,$B9,$6A,$B9,$71,$B5,$6E,$B4,$67,$B4,$61,$B2
   Data.a $62,$B0,$5E,$AD,$5C,$A8,$5A,$A3,$55,$A2,$58,$A5,$5B,$A8,$5C,$AA
   Data.a $5F,$A9,$65,$A5,$6A,$A0,$6D,$9E,$6A,$9D,$65,$9C,$60,$9A,$5A,$98
   Data.a $58,$97,$54,$99,$50,$9A,$4C,$96,$4C,$94,$4B,$93,$48,$95,$46,$99
   Data.a $45,$9C,$42,$9B,$3D,$99,$3E,$98,$3F,$99,$40,$98,$3F,$96,$3E,$94
   Data.a $41,$94,$46,$91,$47,$90,$49,$8F,$48,$8C,$43,$8A,$3F,$8A,$42,$8C
   Data.a $45,$8C,$49,$8B,$46,$87,$41,$84,$42,$81,$46,$7E,$4C,$7A,$4A,$7A
   Data.a $44,$7F,$42,$7E,$3C,$7E,$3B,$81,$39,$83,$36,$84,$34,$86,$33,$86
   Data.a $2F,$88,$30,$87,$32,$89,$33,$8C,$32,$8F,$31,$8F,$2E,$91,$2D,$92
   Data.a $2B,$95,$2B,$92,$2A,$90,$2A,$8F,$27,$92,$23,$90,$22,$8F,$24,$8D
   Data.a $26,$8C,$28,$8D,$2A,$8D,$2C,$8C,$2D,$89,$31,$88,$2D,$87,$2B,$85
   Data.a $2D,$84,$2B,$84,$2A,$85,$29,$84,$28,$84,$27,$85,$26,$87,$25,$89
   Data.a $23,$89,$21,$8B,$20,$8C,$1F,$8D,$1D,$8E,$1D,$90,$1C,$92,$1B,$93
   Data.a $1C,$94,$1C,$97,$1D,$9B,$1F,$9D,$22,$98,$21,$99,$24,$9A,$24,$9C
   Data.a $23,$9F,$22,$A1,$1F,$A2,$20,$A6,$1E,$A7,$1F,$AB,$1E,$AE,$1D,$B0
   Data.a $1D,$B0,$1A,$B4,$19,$B4,$1D,$B3,$21,$B4,$21,$B6,$1E,$B7,$20,$B5
   Data.a $1D,$B5,$19,$B7,$1B,$B7,$19,$BB,$1B,$BC,$1A,$B9,$18,$BB,$17,$BD
   Data.a $16,$BF,$15,$C1,$14,$C2,$14,$C3,$14,$C4,$14,$C8,$13,$C9,$12,$CB
   Data.a $12,$CC,$13,$CD,$13,$CF,$13,$D1,$14,$D1,$15,$CF,$16,$CC,$18,$CE
   Data.a $17,$CF,$17,$D1,$17,$D4,$18,$D8,$18,$DA,$17,$DC,$18,$DC,$1A,$DE
   Data.a $1B,$E1,$1A,$E3,$1A,$E6,$19,$E8,$19,$E7,$1A,$EB,$1A,$EC,$1B,$F1
   Data.a $1B,$F4,$1D,$F7,$1D,$F9,$1D,$FF,$1D,$D5,$0A,$27,$0A,$29,$0B,$2B
   Data.a $0D,$2A,$0D,$2C,$0F,$2C,$10,$2E,$0E,$31,$0C,$32,$0D,$31,$0F,$30
   Data.a $11,$2F,$12,$2D,$13,$2B,$15,$28,$14,$2A,$14,$2C,$16,$2A,$17,$29
   Data.a $18,$2A,$1A,$2B,$1D,$2B,$1E,$2B,$1F,$2D,$20,$2D,$21,$2D,$21,$2E
   Data.a $22,$2F,$22,$31,$23,$31,$23,$32,$24,$34,$25,$36,$25,$37,$27,$38
   Data.a $28,$39,$29,$3A,$29,$3C,$27,$3C,$28,$3E,$28,$44,$29,$4A,$2A,$4D
   Data.a $2B,$4F,$2D,$53,$2F,$57,$2F,$5A,$31,$5E,$31,$5C,$30,$58,$2E,$53
   Data.a $30,$55,$31,$59,$33,$5C,$35,$61,$36,$65,$39,$68,$3C,$6A,$41,$6D
   Data.a $43,$72,$46,$75,$49,$77,$48,$7D,$47,$84,$46,$88,$49,$90,$4C,$97
   Data.a $4E,$A1,$4D,$A9,$4D,$B2,$4C,$B9,$4C,$BC,$4C,$C0,$4C,$C2,$4A,$C3
   Data.a $4B,$C4,$4B,$C7,$4C,$C9,$4D,$CB,$4E,$CB,$4F,$C7,$51,$C3,$52,$BD
   Data.a $52,$BA,$56,$B7,$57,$B1,$5B,$AF,$5D,$A7,$60,$A1,$63,$9F,$64,$96
   Data.a $66,$8E,$63,$84,$60,$82,$5D,$83,$5B,$81,$5A,$79,$56,$76,$54,$72
   Data.a $53,$71,$4F,$70,$4D,$73,$4D,$6F,$49,$74,$46,$73,$44,$6A,$41,$68
   Data.a $42,$62,$3E,$66,$3B,$62,$3A,$5D,$3B,$5A,$3B,$58,$3C,$57,$3D,$56
   Data.a $40,$56,$41,$55,$45,$56,$46,$5C,$46,$54,$48,$50,$4A,$4E,$4A,$4C
   Data.a $4A,$4A,$4A,$48,$4A,$4A,$4A,$48,$4B,$46,$4E,$45,$4E,$44,$4F,$42
   Data.a $50,$40,$53,$40,$52,$41,$54,$3F,$52,$3D,$50,$3A,$4F,$3B,$54,$38
   Data.a $58,$36,$57,$34,$56,$33,$56,$32,$54,$30,$54,$2E,$53,$2C,$52,$2A
   Data.a $50,$2D,$4E,$2C,$4E,$2B,$4C,$29,$4B,$28,$49,$27,$49,$2A,$48,$2C
   Data.a $4A,$30,$48,$34,$48,$37,$46,$36,$45,$31,$41,$30,$3E,$2E,$3D,$2B
   Data.a $3E,$28,$3F,$26,$3F,$25,$41,$25,$40,$22,$42,$21,$45,$22,$45,$1F
   Data.a $44,$1D,$43,$1E,$41,$1F,$3F,$1D,$3E,$1C,$3D,$1A,$3B,$1B,$3C,$1D
   Data.a $3D,$1E,$3C,$20,$3A,$1F,$37,$1F,$34,$1E,$34,$1F,$33,$20,$32,$20
   Data.a $30,$20,$2E,$1E,$2B,$1D,$28,$1D,$27,$1D,$25,$1C,$23,$1D,$22,$1D
   Data.a $20,$1E,$1D,$1D,$1A,$1C,$16,$1C,$13,$1B,$11,$1B,$0F,$1B,$0E,$1C
   Data.a $0C,$1D,$09,$1F,$0C,$21,$0E,$21,$0E,$22,$0C,$21,$09,$22,$0B,$24
   Data.a $0D,$24,$0C,$26,$42,$6D,$1E,$6F,$1D,$70,$1C,$6C,$1C,$6F,$1C,$70
   Data.a $1A,$6E,$19,$6F,$17,$70,$16,$71,$15,$71,$14,$71,$13,$72,$12,$71
   Data.a $11,$72,$0F,$71,$0E,$71,$0D,$76,$0C,$73,$0C,$6F,$0D,$70,$0B,$6A
   Data.a $0C,$6D,$0B,$6F,$0A,$6A,$0A,$68,$0A,$6A,$09,$65,$09,$65,$0A,$60
   Data.a $0A,$62,$0A,$61,$0B,$5E,$0B,$5C,$0C,$58,$0B,$57,$0C,$54,$0C,$51
   Data.a $0E,$52,$0E,$50,$0F,$4C,$11,$4F,$12,$4F,$13,$53,$14,$57,$15,$59
   Data.a $17,$59,$1A,$5C,$1C,$5C,$1D,$5C,$1F,$5A,$21,$5B,$24,$5C,$26,$5D
   Data.a $28,$5E,$29,$5F,$29,$60,$2B,$62,$29,$62,$27,$63,$25,$63,$23,$65
   Data.a $22,$66,$22,$68,$21,$69,$1F,$6A,$1F,$31,$46,$0E,$47,$0D,$4A,$0D
   Data.a $48,$0C,$47,$0D,$45,$0E,$45,$0D,$43,$0D,$44,$0D,$43,$0D,$41,$0D
   Data.a $40,$0D,$40,$0C,$43,$0B,$45,$0B,$46,$0B,$48,$0A,$4B,$0A,$50,$0A
   Data.a $52,$0A,$54,$0B,$50,$0C,$4F,$0C,$52,$0C,$4E,$0E,$4C,$0F,$49,$0F
   Data.a $4B,$0F,$49,$10,$4A,$10,$49,$11,$46,$12,$47,$14,$44,$14,$41,$13
   Data.a $42,$12,$41,$12,$43,$12,$45,$11,$43,$12,$44,$11,$44,$10,$42,$11
   Data.a $42,$10,$45,$10,$44,$0F,$43,$0E,$46,$0F,$46,$0E,$25,$8E,$52,$8A
   Data.a $52,$88,$4E,$85,$4B,$81,$4C,$7C,$4D,$79,$56,$74,$60,$74,$69,$75
   Data.a $6F,$76,$73,$79,$77,$80,$78,$84,$79,$87,$7B,$86,$81,$89,$8A,$89
   Data.a $93,$89,$9B,$8A,$A2,$8C,$AA,$8D,$B1,$91,$B1,$96,$AA,$99,$A3,$9A
   Data.a $9B,$9D,$95,$9C,$8E,$9C,$86,$A0,$7D,$A4,$73,$A1,$71,$9E,$6C,$9B
   Data.a $65,$99,$5C,$97,$54,$93,$53,$1A,$E5,$96,$E1,$96,$E1,$92,$DF,$91
   Data.a $DE,$91,$DC,$96,$DA,$94,$D8,$97,$D7,$9A,$D2,$9E,$D1,$A2,$D1,$A6
   Data.a $D2,$B0,$D6,$B0,$DD,$AD,$E0,$B1,$E2,$B0,$E3,$B2,$E7,$B6,$E9,$B7
   Data.a $EB,$B2,$ED,$AB,$EC,$A3,$EA,$9E,$E8,$99,$E6,$91,$17,$51,$26,$52
   Data.a $25,$50,$23,$52,$23,$54,$22,$51,$1F,$51,$1D,$4F,$1C,$4C,$1A,$4A
   Data.a $19,$47,$19,$44,$18,$44,$1B,$43,$18,$40,$1A,$43,$1C,$48,$1D,$4B
   Data.a $1E,$4B,$22,$49,$25,$4C,$25,$4E,$27,$51,$27,$0D,$90,$0E,$91,$0E
   Data.a $92,$0E,$93,$0E,$92,$0F,$91,$0F,$90,$0F,$8F,$0F,$90,$0F,$8E,$0F
   Data.a $8D,$0E,$8E,$0E,$8F,$0E,$10,$42,$0F,$43,$0F,$41,$10,$40,$10,$3E
   Data.a $11,$3E,$10,$3F,$0F,$3E,$0F,$3C,$0F,$3C,$0E,$3D,$0E,$3C,$0E,$3D
   Data.a $0D,$3F,$0D,$41,$0E,$42,$0E,$0F,$8D,$0F,$8E,$0F,$8E,$10,$8D,$12
   Data.a $8C,$13,$8A,$12,$8B,$12,$8B,$11,$8C,$10,$8A,$10,$89,$10,$88,$0F
   Data.a $89,$0F,$8A,$0F,$8C,$10,$10,$38,$1D,$37,$1D,$36,$1E,$33,$1E,$2F
   Data.a $1E,$2E,$1C,$2E,$1A,$2C,$1A,$2F,$18,$30,$18,$31,$19,$32,$18,$33
   Data.a $19,$34,$18,$36,$1A,$38,$1C,$0C,$7E,$38,$81,$37,$80,$34,$7E,$30
   Data.a $7D,$2E,$7C,$2D,$7C,$2F,$7C,$31,$7D,$30,$7D,$32,$7E,$34,$7D,$37
   Data.a $0A,$33,$14,$32,$13,$33,$14,$34,$15,$31,$16,$31,$15,$2F,$15,$2E
   Data.a $14,$2D,$14,$2E,$14,$0A,$AC,$13,$AF,$13,$B0,$14,$AB,$15,$A9,$16
   Data.a $A9,$17,$A7,$18,$A7,$17,$A8,$15,$AA,$14,$09,$E6,$85,$E2,$82,$DF
   Data.a $81,$DF,$84,$E0,$86,$E3,$8A,$E5,$8D,$E8,$8B,$EB,$8E,$09,$CF,$7D
   Data.a $D1,$7A,$D3,$77,$D4,$78,$D4,$7A,$D4,$7F,$D2,$85,$D0,$85,$CE,$81
   Data.a $07,$A2,$0E,$A3,$0E,$A4,$0E,$A4,$0D,$A3,$0D,$A2,$0D,$A2,$0E,$08
   Data.a $70,$24,$70,$23,$6F,$23,$70,$22,$71,$23,$73,$22,$75,$22,$75,$24
   Data.a $07,$2A,$21,$28,$22,$29,$23,$2A,$23,$2B,$23,$2C,$22,$2B,$22,$07
   Data.a $39,$14,$37,$14,$37,$15,$39,$15,$3A,$15,$3B,$14,$39,$13,$08,$41
   Data.a $15,$44,$15,$45,$14,$47,$15,$44,$16,$41,$16,$3F,$16,$3D,$14,$07
   Data.a $46,$3F,$44,$3E,$42,$40,$42,$45,$43,$40,$44,$42,$46,$40,$07,$FA
   Data.a $BA,$FC,$BB,$FB,$BD,$FA,$C0,$F8,$C2,$F7,$C1,$F8,$BF,$07,$2B,$19
   Data.a $2D,$17,$2A,$16,$27,$16,$27,$18,$27,$1A,$2A,$1A,$06,$31,$27,$2F
   Data.a $27,$2E,$27,$2E,$29,$2C,$29,$30,$29,$06,$FB,$B2,$FC,$B4,$FE,$B6
   Data.a $FE,$B8,$FC,$B9,$FC,$B4,$06,$39,$18,$38,$19,$3A,$1A,$3B,$19,$3B
   Data.a $17,$38,$17,$06,$A5,$4C,$A6,$47,$A5,$43,$A7,$40,$A2,$3F,$A3,$46
   Data.a $06,$90,$11,$91,$11,$91,$12,$90,$12,$8F,$12,$8F,$11,$06,$C8,$7D
   Data.a $C9,$7F,$CB,$85,$C9,$85,$C6,$7C,$C5,$79,$06,$7A,$32,$79,$34,$79
   Data.a $36,$7A,$37,$7C,$34,$7B,$31,$05,$A8,$18,$A9,$1B,$A7,$1C,$A6,$1B
   Data.a $A5,$19,$06,$E5,$48,$E3,$4F,$E0,$50,$DE,$4F,$E2,$4C,$E4,$45,$05
   Data.a $56,$3B,$59,$3D,$5A,$3C,$59,$3A,$58,$37,$05,$39,$10,$38,$11,$36
   Data.a $10,$35,$10,$37,$0F,$05,$4E,$E3,$4B,$E5,$4C,$E8,$46,$E8,$3B,$E7
   Data.a $05,$D7,$7F,$D6,$7F,$D7,$83,$D6,$85,$D5,$80,$04,$3B,$13,$3D,$13
   Data.a $3F,$13,$3F,$14,$05,$A4,$96,$A1,$A3,$9F,$9B,$A1,$96,$A3,$92,$04
   Data.a $05,$21,$04,$22,$03,$20,$01,$1F,$04,$3F,$17,$3E,$19,$3C,$19,$3C
   Data.a $17,$04,$44,$23,$47,$25,$44,$25,$42,$26,$04,$A0,$0D,$A0,$0E,$A1
   Data.a $0D,$A2,$0D,$04,$50,$CC,$50,$CE,$4E,$CD,$4E,$CC,$04,$3A,$33,$3C
   Data.a $38,$3A,$36,$3A,$33,$04,$E0,$DD,$D8,$DF,$D1,$DE,$CB,$DD,$04,$BB
   Data.a $DF,$B5,$E3,$AB,$E0,$A6,$DE,$03,$47,$61,$44,$60,$49,$61,$04,$D0
   Data.a $8C,$CC,$8A,$CD,$89,$D1,$8B,$04,$D7,$69,$D8,$6D,$D6,$6D,$D6,$66
   
EndDataSection ;}

[RASHAD]

Seem we will get some job here
@MV very good start

@BP Keep the good job
Only some glitches with fill color when rotating the object [Windows]

Thanks

[IdeasVacuum]

Until EndOfWorld

[citystate]

Until EndOfWorld

wasn't that last month?

[Michael Vogel]

I didn't have time do improve my code the last two days, but I think sorting the filled areas could improve the results. Here's a first approach for filling by enlarging (invisible) dots to outer space

To remove the drawing around the globe, change the line Box(0,0,#SizeCenter<<1,#SizeCenter<<1,$e0ffe0e0) to Box(0,0,#SizeCenter<<1,#SizeCenter<<1,$ffffe0e0)...

Code: Select all

Procedure Init()

	; My little World Version 1.3 test version
	; (c) 2013 by Michael Vogel

	#Size=2*2*2*2*2*2*2*2
	#SizeRadius=#Size>>1
	#SizeCenter=#Size
	#Dots=(2*2+3*3*11)*3*3
	#Shapes=7*7
	#Shadow=0

	#GreenWorld=$80FF80
	#Gray  = $808080
	#Blue  = $FF0000
	#White = $FFFFFF
	#Black = $000000

	Global RotX=35
	Global RotY=305
	Global Invisible=#True

	Structure DotType
		x.i
		y.i
		hidden.i
	EndStructure
	Structure ShapeType
		len.i
		start.i
	EndStructure

	Global Dim Dots.DotType(#Dots)
	Global Dim Dots3D.DotType(#Dots)
	Global Dim Shapes.ShapeType(#Shapes)
	Global Dim Poly.l(666)

	Global PolyCount
	Global PolyDC

	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*#Size>>8
			Dots(count)\y*#Size>>8
			count+1
		Next j
	Next i

	DataSection
		Data.a $DC,$FD,$24,$FF,$25,$FE,$27,$FC,$28,$FA,$29,$F8,$2A,$F6,$2B,$F4
		Data.a $2C,$F4,$30,$F2,$33,$EF,$36,$F2,$2C,$F5,$28,$F2,$2A,$F0,$29,$EE
		Data.a $2C,$EA,$2B,$E6,$2C,$E1,$31,$E2,$33,$E4,$34,$E4,$38,$E2,$3F,$DE
		Data.a $42,$DB,$48,$DB,$4E,$DA,$4D,$D9,$4A,$D8,$47,$D6,$47,$D6,$4B,$D5
		Data.a $4E,$D7,$54,$D6,$57,$D5,$5B,$D4,$5E,$D1,$60,$D0,$61,$CD,$62,$CD
		Data.a $69,$CE,$70,$CB,$73,$C9,$6E,$C7,$73,$CA,$7E,$C7,$75,$C5,$69,$C3
		Data.a $66,$C0,$60,$BF,$61,$B9,$6A,$B9,$71,$B5,$6E,$B4,$67,$B4,$61,$B2
		Data.a $62,$B0,$5E,$AD,$5C,$A8,$5A,$A3,$55,$A2,$58,$A5,$5B,$A8,$5C,$AA
		Data.a $5F,$A9,$65,$A5,$6A,$A0,$6D,$9E,$6A,$9D,$65,$9C,$60,$9A,$5A,$98
		Data.a $58,$97,$54,$99,$50,$9A,$4C,$96,$4C,$94,$4B,$93,$48,$95,$46,$99
		Data.a $45,$9C,$42,$9B,$3D,$99,$3E,$98,$3F,$99,$40,$98,$3F,$96,$3E,$94
		Data.a $41,$94,$46,$91,$47,$90,$49,$8F,$48,$8C,$43,$8A,$3F,$8A,$42,$8C
		Data.a $45,$8C,$49,$8B,$46,$87,$41,$84,$42,$81,$46,$7E,$4C,$7A,$4A,$7A
		Data.a $44,$7F,$42,$7E,$3C,$7E,$3B,$81,$39,$83,$36,$84,$34,$86,$33,$86
		Data.a $2F,$88,$30,$87,$32,$89,$33,$8C,$32,$8F,$31,$8F,$2E,$91,$2D,$92
		Data.a $2B,$95,$2B,$92,$2A,$90,$2A,$8F,$27,$92,$23,$90,$22,$8F,$24,$8D
		Data.a $26,$8C,$28,$8D,$2A,$8D,$2C,$8C,$2D,$89,$31,$88,$2D,$87,$2B,$85
		Data.a $2D,$84,$2B,$84,$2A,$85,$29,$84,$28,$84,$27,$85,$26,$87,$25,$89
		Data.a $23,$89,$21,$8B,$20,$8C,$1F,$8D,$1D,$8E,$1D,$90,$1C,$92,$1B,$93
		Data.a $1C,$94,$1C,$97,$1D,$9B,$1F,$9D,$22,$98,$21,$99,$24,$9A,$24,$9C
		Data.a $23,$9F,$22,$A1,$1F,$A2,$20,$A6,$1E,$A7,$1F,$AB,$1E,$AE,$1D,$B0
		Data.a $1D,$B0,$1A,$B4,$19,$B4,$1D,$B3,$21,$B4,$21,$B6,$1E,$B7,$20,$B5
		Data.a $1D,$B5,$19,$B7,$1B,$B7,$19,$BB,$1B,$BC,$1A,$B9,$18,$BB,$17,$BD
		Data.a $16,$BF,$15,$C1,$14,$C2,$14,$C3,$14,$C4,$14,$C8,$13,$C9,$12,$CB
		Data.a $12,$CC,$13,$CD,$13,$CF,$13,$D1,$14,$D1,$15,$CF,$16,$CC,$18,$CE
		Data.a $17,$CF,$17,$D1,$17,$D4,$18,$D8,$18,$DA,$17,$DC,$18,$DC,$1A,$DE
		Data.a $1B,$E1,$1A,$E3,$1A,$E6,$19,$E8,$19,$E7,$1A,$EB,$1A,$EC,$1B,$F1
		Data.a $1B,$F4,$1D,$F7,$1D,$F9,$1D,$FF,$1D,$D5,$0A,$27,$0A,$29,$0B,$2B
		Data.a $0D,$2A,$0D,$2C,$0F,$2C,$10,$2E,$0E,$31,$0C,$32,$0D,$31,$0F,$30
		Data.a $11,$2F,$12,$2D,$13,$2B,$15,$28,$14,$2A,$14,$2C,$16,$2A,$17,$29
		Data.a $18,$2A,$1A,$2B,$1D,$2B,$1E,$2B,$1F,$2D,$20,$2D,$21,$2D,$21,$2E
		Data.a $22,$2F,$22,$31,$23,$31,$23,$32,$24,$34,$25,$36,$25,$37,$27,$38
		Data.a $28,$39,$29,$3A,$29,$3C,$27,$3C,$28,$3E,$28,$44,$29,$4A,$2A,$4D
		Data.a $2B,$4F,$2D,$53,$2F,$57,$2F,$5A,$31,$5E,$31,$5C,$30,$58,$2E,$53
		Data.a $30,$55,$31,$59,$33,$5C,$35,$61,$36,$65,$39,$68,$3C,$6A,$41,$6D
		Data.a $43,$72,$46,$75,$49,$77,$48,$7D,$47,$84,$46,$88,$49,$90,$4C,$97
		Data.a $4E,$A1,$4D,$A9,$4D,$B2,$4C,$B9,$4C,$BC,$4C,$C0,$4C,$C2,$4A,$C3
		Data.a $4B,$C4,$4B,$C7,$4C,$C9,$4D,$CB,$4E,$CB,$4F,$C7,$51,$C3,$52,$BD
		Data.a $52,$BA,$56,$B7,$57,$B1,$5B,$AF,$5D,$A7,$60,$A1,$63,$9F,$64,$96
		Data.a $66,$8E,$63,$84,$60,$82,$5D,$83,$5B,$81,$5A,$79,$56,$76,$54,$72
		Data.a $53,$71,$4F,$70,$4D,$73,$4D,$6F,$49,$74,$46,$73,$44,$6A,$41,$68
		Data.a $42,$62,$3E,$66,$3B,$62,$3A,$5D,$3B,$5A,$3B,$58,$3C,$57,$3D,$56
		Data.a $40,$56,$41,$55,$45,$56,$46,$5C,$46,$54,$48,$50,$4A,$4E,$4A,$4C
		Data.a $4A,$4A,$4A,$48,$4A,$4A,$4A,$48,$4B,$46,$4E,$45,$4E,$44,$4F,$42
		Data.a $50,$40,$53,$40,$52,$41,$54,$3F,$52,$3D,$50,$3A,$4F,$3B,$54,$38
		Data.a $58,$36,$57,$34,$56,$33,$56,$32,$54,$30,$54,$2E,$53,$2C,$52,$2A
		Data.a $50,$2D,$4E,$2C,$4E,$2B,$4C,$29,$4B,$28,$49,$27,$49,$2A,$48,$2C
		Data.a $4A,$30,$48,$34,$48,$37,$46,$36,$45,$31,$41,$30,$3E,$2E,$3D,$2B
		Data.a $3E,$28,$3F,$26,$3F,$25,$41,$25,$40,$22,$42,$21,$45,$22,$45,$1F
		Data.a $44,$1D,$43,$1E,$41,$1F,$3F,$1D,$3E,$1C,$3D,$1A,$3B,$1B,$3C,$1D
		Data.a $3D,$1E,$3C,$20,$3A,$1F,$37,$1F,$34,$1E,$34,$1F,$33,$20,$32,$20
		Data.a $30,$20,$2E,$1E,$2B,$1D,$28,$1D,$27,$1D,$25,$1C,$23,$1D,$22,$1D
		Data.a $20,$1E,$1D,$1D,$1A,$1C,$16,$1C,$13,$1B,$11,$1B,$0F,$1B,$0E,$1C
		Data.a $0C,$1D,$09,$1F,$0C,$21,$0E,$21,$0E,$22,$0C,$21,$09,$22,$0B,$24
		Data.a $0D,$24,$0C,$26,$42,$6D,$1E,$6F,$1D,$70,$1C,$6C,$1C,$6F,$1C,$70
		Data.a $1A,$6E,$19,$6F,$17,$70,$16,$71,$15,$71,$14,$71,$13,$72,$12,$71
		Data.a $11,$72,$0F,$71,$0E,$71,$0D,$76,$0C,$73,$0C,$6F,$0D,$70,$0B,$6A
		Data.a $0C,$6D,$0B,$6F,$0A,$6A,$0A,$68,$0A,$6A,$09,$65,$09,$65,$0A,$60
		Data.a $0A,$62,$0A,$61,$0B,$5E,$0B,$5C,$0C,$58,$0B,$57,$0C,$54,$0C,$51
		Data.a $0E,$52,$0E,$50,$0F,$4C,$11,$4F,$12,$4F,$13,$53,$14,$57,$15,$59
		Data.a $17,$59,$1A,$5C,$1C,$5C,$1D,$5C,$1F,$5A,$21,$5B,$24,$5C,$26,$5D
		Data.a $28,$5E,$29,$5F,$29,$60,$2B,$62,$29,$62,$27,$63,$25,$63,$23,$65
		Data.a $22,$66,$22,$68,$21,$69,$1F,$6A,$1F,$31,$46,$0E,$47,$0D,$4A,$0D
		Data.a $48,$0C,$47,$0D,$45,$0E,$45,$0D,$43,$0D,$44,$0D,$43,$0D,$41,$0D
		Data.a $40,$0D,$40,$0C,$43,$0B,$45,$0B,$46,$0B,$48,$0A,$4B,$0A,$50,$0A
		Data.a $52,$0A,$54,$0B,$50,$0C,$4F,$0C,$52,$0C,$4E,$0E,$4C,$0F,$49,$0F
		Data.a $4B,$0F,$49,$10,$4A,$10,$49,$11,$46,$12,$47,$14,$44,$14,$41,$13
		Data.a $42,$12,$41,$12,$43,$12,$45,$11,$43,$12,$44,$11,$44,$10,$42,$11
		Data.a $42,$10,$45,$10,$44,$0F,$43,$0E,$46,$0F,$46,$0E,$25,$8E,$52,$8A
		Data.a $52,$88,$4E,$85,$4B,$81,$4C,$7C,$4D,$79,$56,$74,$60,$74,$69,$75
		Data.a $6F,$76,$73,$79,$77,$80,$78,$84,$79,$87,$7B,$86,$81,$89,$8A,$89
		Data.a $93,$89,$9B,$8A,$A2,$8C,$AA,$8D,$B1,$91,$B1,$96,$AA,$99,$A3,$9A
		Data.a $9B,$9D,$95,$9C,$8E,$9C,$86,$A0,$7D,$A4,$73,$A1,$71,$9E,$6C,$9B
		Data.a $65,$99,$5C,$97,$54,$93,$53,$1A,$E5,$96,$E1,$96,$E1,$92,$DF,$91
		Data.a $DE,$91,$DC,$96,$DA,$94,$D8,$97,$D7,$9A,$D2,$9E,$D1,$A2,$D1,$A6
		Data.a $D2,$B0,$D6,$B0,$DD,$AD,$E0,$B1,$E2,$B0,$E3,$B2,$E7,$B6,$E9,$B7
		Data.a $EB,$B2,$ED,$AB,$EC,$A3,$EA,$9E,$E8,$99,$E6,$91,$17,$51,$26,$52
		Data.a $25,$50,$23,$52,$23,$54,$22,$51,$1F,$51,$1D,$4F,$1C,$4C,$1A,$4A
		Data.a $19,$47,$19,$44,$18,$44,$1B,$43,$18,$40,$1A,$43,$1C,$48,$1D,$4B
		Data.a $1E,$4B,$22,$49,$25,$4C,$25,$4E,$27,$51,$27,$0D,$90,$0E,$91,$0E
		Data.a $92,$0E,$93,$0E,$92,$0F,$91,$0F,$90,$0F,$8F,$0F,$90,$0F,$8E,$0F
		Data.a $8D,$0E,$8E,$0E,$8F,$0E,$10,$42,$0F,$43,$0F,$41,$10,$40,$10,$3E
		Data.a $11,$3E,$10,$3F,$0F,$3E,$0F,$3C,$0F,$3C,$0E,$3D,$0E,$3C,$0E,$3D
		Data.a $0D,$3F,$0D,$41,$0E,$42,$0E,$0F,$8D,$0F,$8E,$0F,$8E,$10,$8D,$12
		Data.a $8C,$13,$8A,$12,$8B,$12,$8B,$11,$8C,$10,$8A,$10,$89,$10,$88,$0F
		Data.a $89,$0F,$8A,$0F,$8C,$10,$10,$38,$1D,$37,$1D,$36,$1E,$33,$1E,$2F
		Data.a $1E,$2E,$1C,$2E,$1A,$2C,$1A,$2F,$18,$30,$18,$31,$19,$32,$18,$33
		Data.a $19,$34,$18,$36,$1A,$38,$1C,$0C,$7E,$38,$81,$37,$80,$34,$7E,$30
		Data.a $7D,$2E,$7C,$2D,$7C,$2F,$7C,$31,$7D,$30,$7D,$32,$7E,$34,$7D,$37
		Data.a $0A,$33,$14,$32,$13,$33,$14,$34,$15,$31,$16,$31,$15,$2F,$15,$2E
		Data.a $14,$2D,$14,$2E,$14,$0A,$AC,$13,$AF,$13,$B0,$14,$AB,$15,$A9,$16
		Data.a $A9,$17,$A7,$18,$A7,$17,$A8,$15,$AA,$14,$09,$E6,$85,$E2,$82,$DF
		Data.a $81,$DF,$84,$E0,$86,$E3,$8A,$E5,$8D,$E8,$8B,$EB,$8E,$09,$CF,$7D
		Data.a $D1,$7A,$D3,$77,$D4,$78,$D4,$7A,$D4,$7F,$D2,$85,$D0,$85,$CE,$81
		Data.a $07,$A2,$0E,$A3,$0E,$A4,$0E,$A4,$0D,$A3,$0D,$A2,$0D,$A2,$0E,$08
		Data.a $70,$24,$70,$23,$6F,$23,$70,$22,$71,$23,$73,$22,$75,$22,$75,$24
		Data.a $07,$2A,$21,$28,$22,$29,$23,$2A,$23,$2B,$23,$2C,$22,$2B,$22,$07
		Data.a $39,$14,$37,$14,$37,$15,$39,$15,$3A,$15,$3B,$14,$39,$13,$08,$41
		Data.a $15,$44,$15,$45,$14,$47,$15,$44,$16,$41,$16,$3F,$16,$3D,$14,$07
		Data.a $46,$3F,$44,$3E,$42,$40,$42,$45,$43,$40,$44,$42,$46,$40,$07,$FA
		Data.a $BA,$FC,$BB,$FB,$BD,$FA,$C0,$F8,$C2,$F7,$C1,$F8,$BF,$07,$2B,$19
		Data.a $2D,$17,$2A,$16,$27,$16,$27,$18,$27,$1A,$2A,$1A,$06,$31,$27,$2F
		Data.a $27,$2E,$27,$2E,$29,$2C,$29,$30,$29,$06,$FB,$B2,$FC,$B4,$FE,$B6
		Data.a $FE,$B8,$FC,$B9,$FC,$B4,$06,$39,$18,$38,$19,$3A,$1A,$3B,$19,$3B
		Data.a $17,$38,$17,$06,$A5,$4C,$A6,$47,$A5,$43,$A7,$40,$A2,$3F,$A3,$46
		Data.a $06,$90,$11,$91,$11,$91,$12,$90,$12,$8F,$12,$8F,$11,$06,$C8,$7D
		Data.a $C9,$7F,$CB,$85,$C9,$85,$C6,$7C,$C5,$79,$06,$7A,$32,$79,$34,$79
		Data.a $36,$7A,$37,$7C,$34,$7B,$31,$05,$A8,$18,$A9,$1B,$A7,$1C,$A6,$1B
		Data.a $A5,$19,$06,$E5,$48,$E3,$4F,$E0,$50,$DE,$4F,$E2,$4C,$E4,$45,$05
		Data.a $56,$3B,$59,$3D,$5A,$3C,$59,$3A,$58,$37,$05,$39,$10,$38,$11,$36
		Data.a $10,$35,$10,$37,$0F,$05,$4E,$E3,$4B,$E5,$4C,$E8,$46,$E8,$3B,$E7
		Data.a $05,$D7,$7F,$D6,$7F,$D7,$83,$D6,$85,$D5,$80,$04,$3B,$13,$3D,$13
		Data.a $3F,$13,$3F,$14,$05,$A4,$96,$A1,$A3,$9F,$9B,$A1,$96,$A3,$92,$04
		Data.a $05,$21,$04,$22,$03,$20,$01,$1F,$04,$3F,$17,$3E,$19,$3C,$19,$3C
		Data.a $17,$04,$44,$23,$47,$25,$44,$25,$42,$26,$04,$A0,$0D,$A0,$0E,$A1
		Data.a $0D,$A2,$0D,$04,$50,$CC,$50,$CE,$4E,$CD,$4E,$CC,$04,$3A,$33,$3C
		Data.a $38,$3A,$36,$3A,$33,$04,$E0,$DD,$D8,$DF,$D1,$DE,$CB,$DD,$04,$BB
		Data.a $DF,$B5,$E3,$AB,$E0,$A6,$DE,$03,$47,$61,$44,$60,$49,$61,$04,$D0
		Data.a $8C,$CC,$8A,$CD,$89,$D1,$8B,$04,$D7,$69,$D8,$6D,$D6,$6D,$D6,$66

	EndDataSection

EndProcedure
Procedure Dot3D(x.f,y.f,x_.f,y_.f,color)

	Protected x2.f,y2.f

	#Radiant=#PI/180

	x*#Radiant
	y*#Radiant
	x_*#Radiant
	y_*#Radiant
	x2=Sin(x-x_)*Cos(y)
	y2=Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_)

	If x2>=-1 And x2<=1
		If y2>=-1 And y2<=1
			If Invisible And Cos(x-x_)*Cos(y)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<0
				color=#White
			Else
				Plot(x2*#SizeRadius+#SizeCenter,y2*#SizeRadius+#SizeCenter,color)
			EndIf
		EndIf
	EndIf

EndProcedure
Procedure View(a,b)

	Protected i
	Protected x.f,y.f
	Protected x_.f,y_.f

	#Radiant=#PI/180

	x_=a*#Radiant
	y_=b*#Radiant

	For i=0 To #Dots
		x=(Dots(i)\x/#Size*360-180)*#Radiant
		y=(Dots(i)\y/#Size*180-90)*#Radiant
		If (Invisible=1) And Cos(x-x_)*Cos(y)*Cos(RotY*#Radiant)+Sin(y)*Sin(RotY*#Radiant)<-0
			Dots3D(i)\hidden=#True
		Else
			Dots3D(i)\hidden=#False
		EndIf
		Dots3D(i)\x=(Sin(x-x_)*Cos(y))*#SizeRadius
		Dots3D(i)\y=(Sin(y)*Cos(y_)-Cos(x-x_)*Cos(y)*Sin(y_))*#SizeRadius
	Next i

EndProcedure
Procedure Polygon(x,y,mode)

	Enumeration
		#PolyReset
		#PolyAddPoint
	EndEnumeration

	Select mode
	Case #PolyReset
		PolyCount=0

	Case #PolyAddPoint
		Poly(PolyCount)=x
		PolyCount+1
		Poly(PolyCount)=y
		PolyCount+1

	Default; #PolyDraw

		mode=CreateSolidBrush_(mode)
		SelectObject_(PolyDC,mode)
		Polygon_(PolyDC,@Poly(),PolyCount>>1)
		DeleteObject_(mode)

	EndSelect


EndProcedure

Procedure World()

	Protected i,j,flag

	Enumeration
		#FlagInvisible
		#FlagInit
		#FlagVisible
	EndEnumeration

	PolyDC=StartDrawing(CanvasOutput(0))
	Circle(#SizeCenter,#SizeCenter,#SizeRadius,$F8F8F0)
	DrawingMode(#PB_2DDrawing_Transparent)

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

	View(RotX,RotY)

	;For i=1 To 1;#Shapes
	For i=0 To #Shapes
		start=Shapes(i)\start
		stop=start+Shapes(i)\len-1

		flag=#False
		For j=start To stop

			If Dots3D(j)\hidden
				faktor.f=Sqr(Dots3D(j)\x*Dots3D(j)\x+Dots3D(j)\y*Dots3D(j)\y)
				If faktor
					faktor=#Size/faktor
					;LineXY(Dots3D(j)\x+#SizeCenter,Dots3D(j)\y+#SizeCenter,Dots3D(j)\x*faktor+#SizeCenter,Dots3D(j)\y*faktor+#SizeCenter,$800000ff)
					Dots3D(j)\x*faktor
					Dots3D(j)\y*faktor
					If Sign(Dots3D(j)\x)=1
						Dots3D(j)\hidden+2
					EndIf
					If Sign(Dots3D(j)\y)=1
						Dots3D(j)\hidden+4
					EndIf
				EndIf
			Else
				flag+1
			EndIf
			Dots3D(j)\x+#SizeCenter
			Dots3D(j)\y+#SizeCenter
		Next j

		If flag

			LineXY(Dots3D(stop)\x,Dots3D(stop)\y,Dots3D(start)\x,Dots3D(start)\y,#Blue); kritisch
			Polygon(0,0,#PolyReset)
			Polygon(Dots3D(start)\x,Dots3D(start)\y,#PolyAddPoint)

			If Dots3D(start)\hidden
				flag=1
			Else
				flag=0
			EndIf

			For j=start To stop-1
				If Dots3D(j+1)\hidden
					flag+1
					If flag>1
						If Dots3D(j)\hidden=Dots3D(j+1)\hidden
							LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Blue)
						Else
							LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Red)
							Select (Dots3D(j)\hidden+Dots3D(j+1)\hidden)>>1-1
							Case 1
								Polygon(#SizeCenter,0,#PolyAddPoint)
							Case 2
								Polygon(0,#SizeCenter,#PolyAddPoint)
							Case 3
								dx=0
								dy=0
								If Dots3D(j)\x+Dots3D(j+1)\x>#SizeCenter
									dx=#SizeCenter<<1
								EndIf
								If Dots3D(j)\y+Dots3D(j+1)\y>#SizeCenter
									dy=#SizeCenter<<1
								EndIf
								Box(Dots3D(j)\x,Dots3D(j)\y,5,5,#Yellow)
								Box(Dots3D(j+1)\x,Dots3D(j+1)\y,5,5,#Yellow)
								Debug Str(j)+":"+StrF(Dots3D(j)\x,2)+"~"+StrF(Dots3D(j+1)\x,2)+", "+StrF(Dots3D(j)\y,2)+"~"+StrF(Dots3D(j+1)\y,2)
								Polygon(dx,dy,#PolyAddPoint); !!!
							Case 4
								Polygon(#SizeCenter<<1,#SizeCenter,#PolyAddPoint)
							Case 5
								Polygon(#SizeCenter,#SizeCenter<<1,#PolyAddPoint)
							Default
								Debug "PANIK "+Str(Dots3D(j)\hidden)+" - "+Str(Dots3D(j+1)\hidden)
							EndSelect

						EndIf
					Else
						LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Green)
					EndIf
				Else
					flag=0
					LineXY(Dots3D(j)\x,Dots3D(j)\y,Dots3D(j+1)\x,Dots3D(j+1)\y,#Black)
				EndIf
				Polygon(Dots3D(j+1)\x,Dots3D(j+1)\y,#PolyAddPoint)
			Next j

			Polygon(0,0,$80000000+#GreenWorld)
		EndIf

	Next i


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

	#StepL=30;	30
	#StepS=1;	1

	i=-180-#StepL
	While i<180
		i+#StepL
		j=-90-#StepS
		While j<90
			j+#StepS
			Dot3D(i,j,RotX,RotY,#Gray)
		Wend
	Wend

	i=-90-#StepL
	While i<90
		i+#StepL
		j=-180-#StepS
		While j<180
			j+#StepS
			Dot3D(j,i,RotX,RotY,#Gray)
		Wend
	Wend


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

	DrawingMode(#PB_2DDrawing_AlphaBlend)
	DrawImage(ImageID(#Shadow),0,0)

	DrawingFont(FontID(0))
	DrawText(0,0,Str(rotx)+"/"+Str(roty)+" "+Left("*",Invisible)+"  ",$ff000000,#White)

	StopDrawing()

EndProcedure
Procedure Main()

	Init()

	LoadFont(0,"Arial",8)
	OpenWindow(0,0,0,#SizeCenter<<1,#SizeCenter<<1,"My little World by Michael Vogel",#PB_Window_ScreenCentered)
	CanvasGadget(0,0,0,#SizeCenter<<1,#SizeCenter<<1)

	CreateImage(#Shadow,#SizeCenter<<1,#SizeCenter<<1,32)
	StartDrawing(ImageOutput(#Shadow))
	DrawingMode(#PB_2DDrawing_AllChannels)
	Box(0,0,#SizeCenter<<1,#SizeCenter<<1,$e0ffe0e0)
	DrawingMode(#PB_2DDrawing_Gradient|#PB_2DDrawing_AllChannels)

	BackColor($40FFFFFF)
	FrontColor($40000000)

	CircularGradient(#Size/3+#SizeCenter-#SizeRadius,#Size/3+#SizeCenter-#SizeRadius,#Size)
	Circle(#SizeCenter,#SizeCenter,#SizeRadius)

	DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
	Circle(#SizeCenter,#SizeCenter,#SizeRadius,$10000000)
	Circle(#SizeCenter,#SizeCenter,#SizeRadius+1,$10000000)
	StopDrawing()

	World()

	Repeat
		Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			End
		Case #WM_CHAR
			Select EventwParam()
			Case #ESC
				End
			Case 'x'
				RotX+5
				World()
			Case 'X'
				RotX-5
				World()
			Case 'y'
				RotY+5
				World()
			Case 'Y'
				RotY-5
				World()
			Case ' '
				Invisible!1
				World()

			EndSelect
		EndSelect

	Until EndOfWorld

EndProcedure

Main()

[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 ;}

[VB6_to_PBx]

BasicallyPure,

awesome code exampe !!! , thanks !

so many things , in such a short amount of code !

[Michael Vogel]

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
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...

[BasicallyPure]

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.

[Michael Vogel]

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 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()