My Best Globe So Far

[dcromley]

What a beautiful stand!
I had to mount my globe on it.
I'm following your precedent of no comments

Code: (Select All)

_Title "Globe by SierraKen"
Option _Explicit ' mod by dcromley
Screen _NewImage(800, 600, 32)
Const n = 5000, qw = Sqr(.999997), qx = .001, qy = .001, qz = .001
Dim Shared As Single w, x, y, z, axyz(n, 3)
Dim As Single r, sz, cc2
Dim As Long i, rg

For i = 1 To n
  x = -1 + 2 * Rnd: y = -1 + 2 * Rnd: z = -1 + 2 * Rnd
  r = Sqr(x * x + y * y + z * z)
  axyz(i, 1) = 150 * x / r
  axyz(i, 2) = 150 * y / r
  axyz(i, 3) = 150 * z / r
Next i

Do
  _Limit 200
  Cls
  Line (400 - 86.6, 200 + 86.6)-(400 + 86.6, 200 - 86.6), _RGB32(128, 128, 128)
  For i = 1 To n
    rotate i
    rg = 255 * (150 + x + y + z) / 300
    PSet (400 + x, 200 - y), _RGB32(rg, rg, 255)
  Next i

  cc2 = 100
  For sz = .1 To 100 Step .25
    cc2 = cc2 - .25
    Circle (400, 450), sz, _RGB32(100 + cc2, 100 + cc2, cc2), , , .5
  Next sz
  Line (400, 200)-(400, 450), _RGB32(255, 255, 255)
  _Display
Loop While InKey$ <> Chr$(27)
System

Sub rotate (i As Long)
  Dim As Single ww, xx, yy, zz
  w = qw: x = qx: y = qy: z = qz
  qrotate w, x, y, z, 0, axyz(i, 1), axyz(i, 2), axyz(i, 3)
  qrotate w, x, y, z, qw, -qx, -qy, -qz
  axyz(i, 1) = x: axyz(i, 2) = y: axyz(i, 3) = z
End Sub

Sub qrotate (w, x, y, z, qw, qx, qy, qz)
  Dim As Single ww, xx, yy, zz
  ww = w * qw - x * qx - y * qy - z * qz
  xx = w * qx + x * qw + y * qz - z * qy
  yy = w * qy - x * qz + y * qw + z * qx
  zz = w * qz + x * qy - y * qx + z * qw
  w = ww: x = xx: y = yy: z = zz
End Sub