My Best Globe So Far

[SierraKen]

This isn't animated, but by trial and error and a bit of experience, I made this PSET globe. 

Code: (Select All)

_Title "Globe by SierraKen"
Screen _NewImage(800, 600, 32)
start:
t = 100 * (2 * _Pi)
cc = 50
w = 10
cc3 = 50

_Limit 20
While _MouseInput: Wend
If t < 0 Then GoTo start:
For l = -100 To 100 Step .025
    cc3 = cc3 + .1
    If cc3 > 255 Then cc3 = 50
    x = (Sin(t) * 100) * (_Pi / 2) + 400
    y = (Cos(t) * l) * (_Pi / 2) + 200
    t = t - (.25 + w / 10)
    PSet (x, y), _RGB32(cc3, cc3, 100 + cc3)
Next l
For l = -100 To 100 Step .025
    cc = cc + .1
    If cc > 255 Then cc = 50
    x = (Sin(t) * l) * (_Pi / 2) + 400
    y = (Cos(t) * 100) * (_Pi / 2) + 200
    t = t - (.25 + w / 10)
    PSet (x, y), _RGB32(cc, cc, 100 + cc)
Next l
t = t - .025
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)
Do: Loop Until InKey$ = Chr$(27)

[James D Jarvis]

It is indeed a pset globe. I'll admit it, I modified it to have a variable radius before I saved it to my computer.

[SierraKen]

Yeah I tried a few ways to make it rotate and I had some wild looking 2D rotations lol, but no luck. I would have to make each dot its own variable array number I think, if it's even possible. Another way to do it is to use code from my anemometer wind gauge and just make a BUNCH of the round circles but much smaller. So we'll see, I may try it sometime.

[madscijr]

It is indeed a pset globe. I'll admit it, I modified it to have a variable radius before I saved it to my computer.

It's amazing that that could be done with such little code!

[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

[SierraKen]

DCromley, that's INCREDIBLE!!! Great job! Also am glad you like my stand. Bplus told me how to make colors like that a few years ago.

---

Thanks Madscijr. Am still going to attempt my own version of a rotating one, if I can.

[bplus]

Nice mod @dcromley!