Author Topic: 3D Revolving Disks (Read 7882 times)

bplus · « **on:** August 17, 2019, 04:57:57 pm »

Something found at JB forum modified by yours truly:

Code: QB64: [Select]

_TITLE "3D Revolving disks: any key toggles trails on/off " 'b+ trans start 2019-08-16
' mod from JB 2019-08-16 nice 3d effect by bluatigro fixed nice
' he called it "isometric 3d sprites" thread under games and graphics board
 
CONST xmax = 800, ymax = 600, pi = 3.141592654, nDisks = 300
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 20
TYPE obj
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    r AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
DIM SHARED b(nDisks) AS obj
 
'init
FOR i = 0 TO nDisks
    b(i).x = RND * xmax - xmax * .5
    b(i).y = RND * ymax - ymax * .5
    b(i).z = RND * xmax - xmax * .5
    b(i).r = RND * 5
    b(i).c = _RGB32(55 + RND * 200, 55 + RND * 200, 55 + RND * 200)
NEXT i
 
WHILE _KEYDOWN(27) = 0
    IF LEN(INKEY$) THEN toggle = 1 - toggle
    IF toggle THEN LINE (0, 0)-(xmax, ymax), _RGBA(0, 0, 0, 30), BF ELSE CLS
    'update positions
    FOR i = 0 TO nDisks
        rotate b(i).x, b(i).z, pi / 360
    NEXT i
    'sort on z
    QSort LBOUND(b), UBOUND(b)
 
    'draw b's
    FOR i = nDisks TO 0 STEP -1
        sx = xmax / 2 + b(i).x / (b(i).z + 1000) * 1000
        sy = ymax / 2 - b(i).y / (b(i).z + 1000) * 1000
        d = 100 / 2 / (b(i).z + 1000) * 1000
        fcirc sx - d, sy - d, b(i).r * d / 100, b(i).c
    NEXT i
 
    _DISPLAY
    _LIMIT 60
WEND
 
SUB QSort (Start AS INTEGER, Finish AS INTEGER) 'sa$ needs to be shared array
    DIM i AS INTEGER, j AS INTEGER, Zvalue
    i = Start
    j = Finish
    Zvalue = b(INT((i + j) / 2)).z
    WHILE i <= j
        WHILE b(i).z < Zvalue
            i = i + 1
        WEND
        WHILE b(j).z > Zvalue
            j = j - 1
        WEND
        IF i <= j THEN
            SWAP b(i), b(j)
            i = i + 1
            j = j - 1
        END IF
    WEND
    IF j > Start THEN QSort Start, j
    IF i < Finish THEN QSort i, Finish
END SUB
 
SUB rotate (x, z, angle)
    s = SIN(angle)
    c = COS(angle)
    newx = x * c - z * s
    newz = x * s + z * c
    x = newx
    z = newz
END SUB
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 
 

TempodiBasic · « **Reply #1 on:** August 17, 2019, 06:28:42 pm »

Bplus
What to say... Great, cool!

Thanks to share

Ps I must admit that this program has its neo.... it shows so many revolving balls :D
But if I think better in this program there is a great lesson that I try to learn.

bplus · « **Reply #2 on:** August 17, 2019, 07:20:04 pm »

Quote from: TempodiBasic on August 17, 2019, 06:28:42 pm

Bplus
What to say... Great, cool!

Thanks to share

Ps I must admit that this program has its neo.... it shows so many revolving balls :D
But if I think better in this program there is a great lesson that I try to learn.

shh... those aren't balls, those are disks :D

Thanks TempodiBasic, it may be a good entry level starter for 3D? I liked it, but now I am wondering if this is like Fellippe's flies thing from some time ago.

SierraKen · « **Reply #3 on:** August 17, 2019, 07:23:12 pm »

Pretty cool! I updated it to show big disco lights on your entire screen. I added a welcome page so people know to hit Esc to quit or any other key to change views. I'm just having fun with it, it won't be on my website.

Code: QB64: [Select]

_TITLE "3D Revolving disks: any key toggles trails on/off " 'b+ trans start 2019-08-16
' mod from JB 2019-08-16 nice 3d effect by bluatigro fixed nice
' he called it "isometric 3d sprites" thread under games and graphics board
' Updated again by Ken G. to make disco lights.
 
CLS
PRINT "                   Disco Lights On Your Entire Screen"
PRINT: PRINT: PRINT
PRINT: PRINT: PRINT
PRINT "     Press Esc to quit program or any other key to change the view."
PRINT: PRINT: PRINT
INPUT "                       Press Enter to start.", a$
CLS
 
CONST xmax = 800, ymax = 600, pi = 3.141592654, nDisks = 300
SCREEN _NEWIMAGE(xmax, ymax, 32)
'_SCREENMOVE 300, 20
_FULLSCREEN
TYPE obj
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    r AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
DIM SHARED b(nDisks) AS obj
 
'init
FOR i = 0 TO nDisks
    b(i).x = RND * xmax - xmax * .5
    b(i).y = RND * ymax - ymax * .5
    b(i).z = RND * xmax - xmax * .5
    b(i).r = RND * 5
    b(i).c = _RGB32(55 + RND * 200, 55 + RND * 200, 55 + RND * 200)
NEXT i
 
WHILE _KEYDOWN(27) = 0
    IF LEN(INKEY$) THEN toggle = 1 - toggle
    IF toggle THEN LINE (0, 0)-(xmax, ymax), _RGBA(0, 0, 0, 30), BF ELSE CLS
    'update positions
    FOR i = 0 TO nDisks
        rotate b(i).x, b(i).z, pi / 360
    NEXT i
    'sort on z
    QSort LBOUND(b), UBOUND(b)
 
    'draw b's
    FOR i = nDisks TO 0 STEP -1
        sx = xmax / 2 + b(i).x / (b(i).z + 1000) * 1000
        sy = ymax / 2 - b(i).y / (b(i).z + 1000) * 1000
        d = 100 / 2 / (b(i).z + 1000) * 1000
        fcirc sx - d, sy - d, b(i).r * d / 100, b(i).c
    NEXT i
 
    _DISPLAY
    _LIMIT 60
WEND
 
SUB QSort (Start AS INTEGER, Finish AS INTEGER) 'sa$ needs to be shared array
    DIM i AS INTEGER, j AS INTEGER, Zvalue
    i = Start
    j = Finish
    Zvalue = b(INT((i + j) / 2)).z
    WHILE i <= j
        WHILE b(i).z < Zvalue
            i = i + 1
        WEND
        WHILE b(j).z > Zvalue
            j = j - 1
        WEND
        IF i <= j THEN
            SWAP b(i), b(j)
            i = i + 1
            j = j - 1
        END IF
    WEND
    IF j > Start THEN QSort Start, j
    IF i < Finish THEN QSort i, Finish
END SUB
 
SUB rotate (x, z, angle)
    s = SIN(angle)
    c = COS(angle)
    newx = x * c - z * s
    newz = x * s + z * c
    x = newx
    z = newz
END SUB
 
SUB fcirc (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
    DIM Radius AS INTEGER, RadiusError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER
    Radius = ABS(R): RadiusError = -Radius: X = Radius: Y = 0
    IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RadiusError = RadiusError + Y * 2 + 1
        IF RadiusError >= 0 THEN
            IF X <> Y + 1 THEN
                LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
                LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            END IF
            X = X - 1
            RadiusError = RadiusError - X * 2
        END IF
        Y = Y + 1
        FOR cc = .25 TO X * 10 STEP .25
            CIRCLE (CX - X, CY - Y), cc, C
        NEXT cc
 
        'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    WEND
END SUB
 

bplus · « **Reply #4 on:** August 17, 2019, 07:48:33 pm »

Yikes! what you did to the circle fill sub is like spray painting the Mona Lisa

Code: QB64: [Select]

        FOR cc = .25 TO X * 10 STEP .25
            CIRCLE (CX - X, CY - Y), cc, C
        NEXT cc
 
        'LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        'LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
 

Ken for you, here is your circle fill you might live with:

Code: QB64: [Select]

'Ken's circleFill sub demo / tester
CONST xmax = 800, ymax = 600
SCREEN _NEWIMAGE(xmax, ymax, 32)
_SCREENMOVE 300, 60
 
PRINT "red circle fill at 100, 150 radius 30 and blue circle  fill at 300, 400 radius 100"
CircleFill 100, 150, 30, _RGB32(255, 0, 0)
CircleFill 300, 400, 100, _RGB32(0, 0, 255)
 
INPUT "press Enter for screen filled with circles... "; wait$
 
WHILE _KEYDOWN(27) = 0
    CircleFill RND * xmax, RND * ymax, RND * 80, _RGB32(RND * 255, RND * 255, RND * 255)
    lpCnt = lpCnt + 1
    IF lpCnt MOD 50 = 49 THEN CLS
    _DISPLAY
    _LIMIT 60
WEND
 
SUB CircleFill (centerX, centerY, circleRadius, circleColor AS _UNSIGNED LONG)
    FOR changeRadius = .25 TO circleRadius STEP .25
        CIRCLE (centerX, centerY), changeRadius, circleColor
    NEXT
END SUB

I have to admit I never thought CIRCLE could fill a disk area solidly without holes until I saw your method Ken.

You can copy and paste the SUB into any program you need a CircleFill and just call it up with:

Code: QB64: [Select]

CircleFill MyCenterX, MyCenterY, MyRadius, MyRGBColor

Here is your mod with YOUR CircleFill:

Code: QB64: [Select]

_TITLE "3D Revolving disks: any key toggles trails on/off " 'b+ trans start 2019-08-16
' mod from JB 2019-08-16 nice 3d effect by bluatigro fixed nice
' he called it "isometric 3d sprites" thread under games and graphics board
' Updated again by Ken G. to make disco lights.
' MOD by B+ with Ken G style CircleFill  
 
CLS
PRINT "                   Disco Lights On Your Entire Screen"
PRINT: PRINT: PRINT
PRINT: PRINT: PRINT
PRINT "     Press Esc to quit program or any other key to change the view."
PRINT: PRINT: PRINT
INPUT "                       Press Enter to start.", a$
CLS
 
CONST xmax = 800, ymax = 600, pi = 3.141592654, nDisks = 300
SCREEN _NEWIMAGE(xmax, ymax, 32)
'_SCREENMOVE 300, 20
_FULLSCREEN
TYPE obj
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
    r AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
DIM SHARED b(nDisks) AS obj
 
'init
FOR i = 0 TO nDisks
    b(i).x = RND * xmax - xmax * .5
    b(i).y = RND * ymax - ymax * .5
    b(i).z = RND * xmax - xmax * .5
    b(i).r = RND * 5
    b(i).c = _RGB32(55 + RND * 200, 55 + RND * 200, 55 + RND * 200)
NEXT i
 
WHILE _KEYDOWN(27) = 0
    IF LEN(INKEY$) THEN toggle = 1 - toggle
    IF toggle THEN LINE (0, 0)-(xmax, ymax), _RGBA(0, 0, 0, 30), BF ELSE CLS
    'update positions
    FOR i = 0 TO nDisks
        rotate b(i).x, b(i).z, pi / 360
    NEXT i
    'sort on z
    QSort LBOUND(b), UBOUND(b)
 
    'draw b's
    FOR i = nDisks TO 0 STEP -1
        sx = xmax / 2 + b(i).x / (b(i).z + 1000) * 1000
        sy = ymax / 2 - b(i).y / (b(i).z + 1000) * 1000
        d = 100 / 2 / (b(i).z + 1000) * 1000
        CircleFill sx - d, sy - d, b(i).r * d / 100, b(i).c
    NEXT i
 
    _DISPLAY
    _LIMIT 60
WEND
 
SUB QSort (Start AS INTEGER, Finish AS INTEGER) 'sa$ needs to be shared array
    DIM i AS INTEGER, j AS INTEGER, Zvalue
    i = Start
    j = Finish
    Zvalue = b(INT((i + j) / 2)).z
    WHILE i <= j
        WHILE b(i).z < Zvalue
            i = i + 1
        WEND
        WHILE b(j).z > Zvalue
            j = j - 1
        WEND
        IF i <= j THEN
            SWAP b(i), b(j)
            i = i + 1
            j = j - 1
        END IF
    WEND
    IF j > Start THEN QSort Start, j
    IF i < Finish THEN QSort i, Finish
END SUB
 
SUB rotate (x, z, angle)
    s = SIN(angle)
    c = COS(angle)
    newx = x * c - z * s
    newz = x * s + z * c
    x = newx
    z = newz
END SUB
 
SUB CircleFill (centerX, centerY, circleRadius, circleColor AS _UNSIGNED LONG)
    FOR changeRadius = .25 TO circleRadius STEP .25
        CIRCLE (centerX, centerY), changeRadius, circleColor
    NEXT
END SUB
 
 

You are now free to change Radii as you see fit, thanks for your consideration. :)

bplus · « **Reply #5 on:** August 17, 2019, 08:31:00 pm »

I found the code I was remembering Fellippe had posted, gave it a trails toggle like here. They are much alike!

Code: QB64: [Select]

'Fellippe had posted here:
' https://www.qb64.org/forum/index.php?topic=255.msg1387#msg1387
' 2019-08-17 B+ adds trails toggle, a trick he learned from this codes author
 
SCREEN _NEWIMAGE(600, 600, 32)
_DELAY .1
_TITLE "Particles: any key toggles trails on and off"
 
TYPE PARTICLE
    x AS SINGLE
    xs AS SINGLE
    y AS SINGLE
    ys AS SINGLE
    w AS SINGLE
    h AS SINGLE
    a AS SINGLE
    r AS SINGLE
    c AS _UNSIGNED LONG
END TYPE
 
DIM particle(100) AS PARTICLE
DIM SHARED r AS SINGLE
 
RANDOMIZE TIMER
createParticles particle()
 
DO
    IF LEN(INKEY$) THEN toggle = 1 - toggle
    IF toggle THEN LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(0, 0, 0, 50), BF ELSE CLS
    updateAndShowParticles particle()
    IF _MOUSEBUTTON(1) THEN
        IF r < 150 THEN r = r + 1 ELSE r = 0
        CIRCLE (_MOUSEX, _MOUSEY), r, _RGBA32(255, 255, 0, 150 - r)
    END IF
    _DISPLAY
    _LIMIT 30
LOOP
 
SUB createParticles (this() AS PARTICLE)
    FOR i = 0 TO UBOUND(this)
        this(i).x = RND * _WIDTH
        this(i).xs = 2 + RND * 3
        this(i).y = RND * _HEIGHT
        this(i).ys = 2 + RND * 3
        this(i).w = RND * (_WIDTH / 4)
        this(i).h = RND * (_WIDTH / 6)
        this(i).a = RND * _PI(2)
        this(i).r = RND * 3 + 1
        this(i).c = _RGBA32(RND * 255, RND * 255, RND * 255, RND * 150 + 155)
    NEXT
END SUB
 
SUB updateAndShowParticles (this() AS PARTICLE)
    WHILE _MOUSEINPUT: WEND
    FOR i = 0 TO UBOUND(this)
        this(i).a = this(i).a + .1
        IF this(i).a > _PI(2) THEN this(i).a = this(i).a - _PI(2)
 
        IF _MOUSEBUTTON(1) THEN
            IF this(i).y > _MOUSEY THEN this(i).y = this(i).y + r / 15
            IF this(i).y < _MOUSEY THEN this(i).y = this(i).y - r / 15
            IF this(i).x > _MOUSEX THEN this(i).x = this(i).x + r / 15
            IF this(i).x < _MOUSEX THEN this(i).x = this(i).x - r / 15
        ELSE
            r = 0
            IF this(i).y > _MOUSEY THEN this(i).y = this(i).y - this(i).ys
            IF this(i).y < _MOUSEY THEN this(i).y = this(i).y + this(i).ys
            IF this(i).x > _MOUSEX THEN this(i).x = this(i).x - this(i).xs
            IF this(i).x < _MOUSEX THEN this(i).x = this(i).x + this(i).xs
        END IF
 
        CircleFill this(i).x + COS(this(i).a) * this(i).w, this(i).y + SIN(this(i).a) * this(i).h, this(i).r, this(i).c
    NEXT
END SUB
 
SUB CircleFill (x AS LONG, y AS LONG, R AS LONG, C AS _UNSIGNED LONG)
    x0 = R
    y0 = 0
    e = 0
    DO WHILE y0 < x0
        IF e <= 0 THEN
            y0 = y0 + 1
            LINE (x - x0, y + y0)-(x + x0, y + y0), C, BF
            LINE (x - x0, y - y0)-(x + x0, y - y0), C, BF
            e = e + 2 * y0
        ELSE
            LINE (x - y0, y - x0)-(x + y0, y - x0), C, BF
            LINE (x - y0, y + x0)-(x + y0, y + x0), C, BF
            x0 = x0 - 1
            e = e - 2 * x0
        END IF
    LOOP
    LINE (x - R, y)-(x + R, y), C, BF
END SUB
 

OK so now I challenge!
Give the Mouse Particles / Flies code some 3D effect.

STxAxTIC · « **Reply #6 on:** August 17, 2019, 08:44:24 pm »

Fun demo!

This reminds me of when I realized I needed real math to achieve the 3D look - because when I wrote similar things, something bugged me about where the actual "point of view" is located, and I come here to say this is not quite the idea to be studying if people want to really advance into the third dimension. Follow me.

This demo is showing a rotating mass of balls - here is the kicker - as viewed from "infinity". (By "infinity" I mean the user's eye is very very far away from the thing being looked at.) When you look at this scene, every single ball is in front of you - the only reason to not see any particular ball is when it goes off the side of the screen, right? But this is an incomplete implementation of 3D... In other words, why aren't any balls disappearing as they get too close to the user's eye and pass outside of our cone of vision? That is, why doesn't it feel like I can "fly through" this thing? I'm always watching it from far away. Feel me? In other words, if you were to try to make, whatever, a Wolfenstein engine with this as a starting point, you would see the entire level at all times. You could never get the walls behind you.

Honestly it took me a few years to go from what you've got here to what you see in Sanctum. It all changed when I wrote this note to myself:

SierraKen · « **Reply #7 on:** August 17, 2019, 08:55:38 pm »

Wow thanks B+! I'm just starting to use _DISPLAY to stop the flickering, which is why I did the CIRCLE .25 loop still.

bplus · « **Reply #8 on:** August 17, 2019, 09:00:22 pm »

Man! STxAxTIC, I just get use to doing perspective sizing and layering with a Z sort and now you want to fly through the thing!

Man! OK, you got me thinking... :)

STxAxTIC · « **Reply #9 on:** August 17, 2019, 09:12:14 pm »

Phew! I thought you would take what I said as a dig - but along the lines of perspective sizing and z-sort...

If you pursue a more general approach, perspective sizing goes out the window and is handled automatically by field of view distance. In my old prototypes, the fudge factor variable I used was called "falsedepth", and was SO happy to erase it when I cracked the problem. (You are walking a 100% analogous path to the one I took...)

And if you go with my notation, Z sort is correctly replaced by N-sort, where N is the vector perpendicular to the screen.

Okay, shutting up now.

Petr · « **Reply #10 on:** August 18, 2019, 04:42:38 am »

It's getting going. :-) I solved the limitation of the size of the displayed field by means of the circular collision detection adjusted to the semicircle (for X / Z) and the circle for (X / Y). Just what is in front of the monitor or outside the set radius from the camera does not count at all. (the beginning of the vector is a spatial 3D point where the camera is standing, and the ending 3D point is the vertex in the field (further in my program it is already a point in the body or outside the body around which the body can rotate))
I calculate the size of the vector by the Pythagorean theorem and the angle of the vector in radians using the JK! Functions I wrote. This is available in the MAPTRIANGLE 3D thread. It is definitely very interesting to see the conversion of X and Y to Z using 2D commands.

SierraKen · « **Reply #11 on:** August 18, 2019, 08:54:46 pm »

I took this idea and added it to my new Solar System Simulator. I'll post it also in the old Solar System thread. :) I didn't use the same code though, just trial and error figured it out. Use Mouse over the planets to I.D. them. Use Mouse Wheel to zoom in and out to all of the planets, and use Up and Down Arrow Keys to tilt the view.

Code: QB64: [Select]

'Ken G. made thie program on August 18, 2019,
'Thank you to STxAxTIC on the QB64.org forum for a little bit of help with The Moon orbit!
 
_TITLE "Solar System Simulator by Ken G. Use Mouse Over Planets, Mouse Wheel to Zoom, and Up and Down Arrow Keys To Tilt."
SCREEN _NEWIMAGE(800, 600, 32)
mercury = 0.241
venus = 0.6152
mars = 1.8809
jupiter = 11.8618
saturn = 29.457
uranus = 84.0205
neptune = 164.8
angle = 180
tilt = 1
one:
_LIMIT 500
mouseWheel = 0
DO WHILE _MOUSEINPUT
    mouseX = _MOUSEX
    mouseY = _MOUSEY
    mouseLeftButton = _MOUSEBUTTON(1)
    mouseRightButton = _MOUSEBUTTON(2)
    mouseMiddleButton = _MOUSEBUTTON(3)
    mouseWheel = mouseWheel + _MOUSEWHEEL
LOOP
IF mouseWheel < 0 THEN angle = angle - 10
IF mouseWheel > 0 THEN angle = angle + 10
 
IF mouseX > 385 AND mouseX < 415 AND mouseY > 285 AND mouseY < 315 THEN LOCATE 2, 49: PRINT "Sun    "
IF mouseX > x1 - 15 AND mouseX < x1 + 15 AND mouseY > y1 - 15 AND mouseY < y1 + 15 THEN LOCATE 2, 49: PRINT "Mercury"
IF mouseX > x2 - 15 AND mouseX < x2 + 15 AND mouseY > y2 - 15 AND mouseY < y2 + 15 THEN LOCATE 2, 49: PRINT "Venus  "
IF mouseX > x - 15 AND mouseX < x + 15 AND mouseY > y - 15 AND mouseY < y + 15 THEN LOCATE 2, 49: PRINT "Earth  "
IF mouseX > x3 - 15 AND mouseX < x3 + 15 AND mouseY > y3 - 15 AND mouseY < y3 + 15 THEN LOCATE 2, 49: PRINT "Mars   "
IF mouseX > x5 - 15 AND mouseX < x5 + 15 AND mouseY > y5 - 15 AND mouseY < y5 + 15 THEN LOCATE 2, 49: PRINT "Jupiter"
IF mouseX > x6 - 15 AND mouseX < x6 + 15 AND mouseY > y6 - 15 AND mouseY < y6 + 15 THEN LOCATE 2, 49: PRINT "Saturn "
IF mouseX > x7 - 15 AND mouseX < x7 + 15 AND mouseY > y7 - 15 AND mouseY < y7 + 15 THEN LOCATE 2, 49: PRINT "Uranus "
IF mouseX > x8 - 15 AND mouseX < x8 + 15 AND mouseY > y8 - 15 AND mouseY < y8 + 15 THEN LOCATE 2, 49: PRINT "Neptune"
 
a$ = INKEY$
IF a$ = CHR$(27) THEN END
IF a$ = CHR$(0) + CHR$(72) THEN tilt = tilt + 1
IF a$ = CHR$(0) + CHR$(80) THEN tilt = tilt - 1
IF angle > 360 THEN angle = 360
IF angle < 10 THEN angle = 10
IF tilt > 90 THEN tilt = 90
IF tilt < 1 THEN tilt = 1
seconds = seconds + .01
s1 = (60 - seconds) * 6 + 180 / mercury
s2 = (60 - seconds) * 6 + 180 / venus
s3 = (60 - seconds) * 6 + 180 'Earth and Moon
s4 = (60 - seconds) * 6 + 180 / mars
s5 = (60 - seconds) * 6 + 180 / jupiter
s6 = (60 - seconds) * 6 + 180 / saturn
s7 = (60 - seconds) * 6 + 180 / uranus
s8 = (60 - seconds) * 6 + 180 / neptune
 
'Mercury
x1 = INT(SIN(s1 / 45 * 3.141592) * angle / 4) + 400
y1 = INT(COS(s1 / 45 * 3.141592) * (angle / 4) / tilt) + 300
 
'Venus
x2 = INT(SIN(s2 / 90 * 3.141592) * angle / 2) + 400
y2 = INT(COS(s2 / 90 * 3.141592) * (angle / 2) / tilt) + 300
 
'Earth
x = INT(SIN(s3 / 180 * 3.141592) * angle) + 400
y = INT(COS(s3 / 180 * 3.141592) * angle / tilt) + 300
 
'Mars
x3 = INT(SIN(s4 / 270 * 3.141592) * angle * 1.5) + 400
y3 = INT(COS(s4 / 270 * 3.141592) * (angle * 1.5) / tilt) + 300
 
'Moon
x4 = INT(SIN(19 * s3 / 270 * 3.141592) * angle / 10) + x
y4 = INT(COS(19 * s3 / 270 * 3.141592) * (angle / 10) / tilt) + y
 
'Outer Planets
'Jupiter
x5 = INT(SIN(s5 / 450 * 3.141592) * angle * 3) + 400
y5 = INT(COS(s5 / 450 * 3.141592) * (angle * 3) / tilt) + 300
 
'Saturn
x6 = INT(SIN(s6 / 630 * 3.141592) * angle * 4.5) + 400
y6 = INT(COS(s6 / 630 * 3.141592) * (angle * 4.5) / tilt) + 300
 
'Uranus
x7 = INT(SIN(s7 / 810 * 3.141592) * angle * 6) + 400
y7 = INT(COS(s7 / 810 * 3.141592) * (angle * 6) / tilt) + 300
 
'Neptune
x8 = INT(SIN(s8 / 990 * 3.141592) * angle * 7.5) + 400
y8 = INT(COS(s8 / 990 * 3.141592) * (angle * 7.5) / tilt) + 300
 
'Mercury
CIRCLE (x1, y1), 5, _RGB32(120, 98, 102)
PAINT (x1, y1), _RGB32(120, 98, 102)
 
'Venus
CIRCLE (x2, y2), 5, _RGB32(161, 67, 39)
PAINT (x2, y2), _RGB32(161, 67, 39)
 
'Earth
CIRCLE (x, y), 5, _RGB32(0, 0, 255)
PAINT (x, y), _RGB32(0, 0, 255)
 
'Mars
CIRCLE (x3, y3), 5, _RGB32(240, 72, 22)
PAINT (x3, y3), _RGB32(240, 72, 22)
 
'Moon
CIRCLE (x4, y4), 2.5, _RGB32(179, 179, 181)
PAINT (x4, y4), _RGB32(179, 179, 181)
 
'Outer Planets
'Jupiter
CIRCLE (x5, y5), 5, _RGB32(255, 166, 127)
PAINT (x5, y5), _RGB32(255, 166, 127)
 
'Saturn
CIRCLE (x6, y6), 5, _RGB32(255, 127, 127)
PAINT (x6, y6), _RGB32(255, 127, 127)
FOR rings = 1 TO 2
    CIRCLE (x6, y6), 7 + rings, _RGB32(255, 127, 127), , , .65
NEXT rings
 
'Uranus
CIRCLE (x7, y7), 5, _RGB32(127, 166, 255)
PAINT (x7, y7), _RGB32(127, 166, 255)
 
'Neptune
CIRCLE (x8, y8), 5, _RGB32(0, 78, 255)
PAINT (x8, y8), _RGB32(0, 78, 255)
 
'Sun
CIRCLE (400, 300), 5, _RGB32(249, 240, 22)
PAINT (400, 300), _RGB32(249, 240, 22)
_DISPLAY
IF seconds > 99999 THEN
    CLS
    seconds = 0
    GOTO one:
END IF
CLS
GOTO one:
 

bplus · « **Reply #12 on:** August 18, 2019, 09:30:41 pm »

Hi Ken,

I like the tilt but not quite there with Zorder, what is drawn in front of what, ie the sun is always in front.

Nor quite there with near and far sizing for perspective.

Still, you worked out the tilt! :)

SierraKen · « **Reply #13 on:** August 19, 2019, 01:22:33 am »

Yeah I wasn't even thinking of these things earlier, but thanks for telling me. I tried all kinds of ways tonight to make the Sun disappear and reappear, etc. etc. etc. I finally did it the only way I know how, to make the planets disappear if X increases and starts going behind the Sun, then reappears when they come back around. This only happens when you tilt the planets to a certain degree. I also made the Sun smaller so you could see more of the planets. Making them disappear and reappear also makes the illusion of them leaving and come back, which is your other thing you mentioned. Just know that I've never worked that much with the Z axis except in CAD type drawings. I use DIM z(10) so the planets would stay the way they were until they were needed to change. Tonight and 1 or 2 other times I've noticed a difference in QB64 and QBasic (I think) in that when you are using a main loop and you just want to skip over some code to not do it in that certain loop, the graphics you want to not-make, still happens. I think because the loop goes so fast that it doesn't give the user time to see it disappear. So, I use an array instead sometimes to deal with certain times when things need to be off or on. In this program z(1) = 1 means that Mercury is going to hide until it comes back around. :)

Note: I was about to head to bed and I immediately figured out how to make this better, please go to my next post, thank you.

Code: QB64: [Select]

'Ken G. made thie program on August 18, 2019,
'Thank you to STxAxTIC on the QB64.org forum for a little bit of help with The Moon orbit!
 
_TITLE "Solar System Simulator by Ken G. Use Mouse Over Planets, Mouse Wheel to Zoom, and Up and Down Arrow Keys To Tilt."
SCREEN _NEWIMAGE(800, 600, 32)
DIM z(10)
mercury = 0.241
venus = 0.6152
mars = 1.8809
jupiter = 11.8618
saturn = 29.457
uranus = 84.0205
neptune = 164.8
angle = 180
tilt = 1
one:
_LIMIT 500
mouseWheel = 0
DO WHILE _MOUSEINPUT
    mouseX = _MOUSEX
    mouseY = _MOUSEY
    mouseLeftButton = _MOUSEBUTTON(1)
    mouseRightButton = _MOUSEBUTTON(2)
    mouseMiddleButton = _MOUSEBUTTON(3)
    mouseWheel = mouseWheel + _MOUSEWHEEL
LOOP
IF mouseWheel < 0 THEN angle = angle - 10
IF mouseWheel > 0 THEN angle = angle + 10
 
IF mouseX > 385 AND mouseX < 415 AND mouseY > 285 AND mouseY < 315 THEN LOCATE 2, 49: PRINT "Sun    "
IF mouseX > x1 - 15 AND mouseX < x1 + 15 AND mouseY > y1 - 15 AND mouseY < y1 + 15 THEN LOCATE 2, 49: PRINT "Mercury"
IF mouseX > x2 - 15 AND mouseX < x2 + 15 AND mouseY > y2 - 15 AND mouseY < y2 + 15 THEN LOCATE 2, 49: PRINT "Venus  "
IF mouseX > x - 15 AND mouseX < x + 15 AND mouseY > y - 15 AND mouseY < y + 15 THEN LOCATE 2, 49: PRINT "Earth  "
IF mouseX > x3 - 15 AND mouseX < x3 + 15 AND mouseY > y3 - 15 AND mouseY < y3 + 15 THEN LOCATE 2, 49: PRINT "Mars   "
IF mouseX > x5 - 15 AND mouseX < x5 + 15 AND mouseY > y5 - 15 AND mouseY < y5 + 15 THEN LOCATE 2, 49: PRINT "Jupiter"
IF mouseX > x6 - 15 AND mouseX < x6 + 15 AND mouseY > y6 - 15 AND mouseY < y6 + 15 THEN LOCATE 2, 49: PRINT "Saturn "
IF mouseX > x7 - 15 AND mouseX < x7 + 15 AND mouseY > y7 - 15 AND mouseY < y7 + 15 THEN LOCATE 2, 49: PRINT "Uranus "
IF mouseX > x8 - 15 AND mouseX < x8 + 15 AND mouseY > y8 - 15 AND mouseY < y8 + 15 THEN LOCATE 2, 49: PRINT "Neptune"
 
a$ = INKEY$
IF a$ = CHR$(27) THEN END
IF a$ = CHR$(0) + CHR$(72) THEN tilt = tilt + 1
IF a$ = CHR$(0) + CHR$(80) THEN tilt = tilt - 1
IF angle > 360 THEN angle = 360
IF angle < 10 THEN angle = 10
IF tilt > 30 THEN tilt = 30
IF tilt < 1 THEN tilt = 1
seconds = seconds + .01
s1 = (60 - seconds) * 6 + 180 / mercury
s2 = (60 - seconds) * 6 + 180 / venus
s3 = (60 - seconds) * 6 + 180 'Earth and Moon
s4 = (60 - seconds) * 6 + 180 / mars
s5 = (60 - seconds) * 6 + 180 / jupiter
s6 = (60 - seconds) * 6 + 180 / saturn
s7 = (60 - seconds) * 6 + 180 / uranus
s8 = (60 - seconds) * 6 + 180 / neptune
 
 
'Mercury
oldx1 = x1
x1 = INT(SIN(s1 / 45 * 3.141592) * angle / 4) + 400
y1 = INT(COS(s1 / 45 * 3.141592) * (angle / 4) / tilt) + 300
 
'Venus
oldx2 = x2
x2 = INT(SIN(s2 / 90 * 3.141592) * angle / 2) + 400
y2 = INT(COS(s2 / 90 * 3.141592) * (angle / 2) / tilt) + 300
 
'Earth
oldx = x
x = INT(SIN(s3 / 180 * 3.141592) * angle) + 400
y = INT(COS(s3 / 180 * 3.141592) * angle / tilt) + 300
 
'Mars
oldx3 = x3
x3 = INT(SIN(s4 / 270 * 3.141592) * angle * 1.5) + 400
y3 = INT(COS(s4 / 270 * 3.141592) * (angle * 1.5) / tilt) + 300
 
'Moon
x4 = INT(SIN(19 * s3 / 270 * 3.141592) * angle / 10) + x
y4 = INT(COS(19 * s3 / 270 * 3.141592) * (angle / 10) / tilt) + y
 
'Outer Planets
'Jupiter
oldx5 = x5
x5 = INT(SIN(s5 / 450 * 3.141592) * angle * 3) + 400
y5 = INT(COS(s5 / 450 * 3.141592) * (angle * 3) / tilt) + 300
 
'Saturn
oldx6 = x6
x6 = INT(SIN(s6 / 630 * 3.141592) * angle * 4.5) + 400
y6 = INT(COS(s6 / 630 * 3.141592) * (angle * 4.5) / tilt) + 300
 
'Uranus
oldx7 = x7
x7 = INT(SIN(s7 / 810 * 3.141592) * angle * 6) + 400
y7 = INT(COS(s7 / 810 * 3.141592) * (angle * 6) / tilt) + 300
 
'Neptune
oldx8 = x8
x8 = INT(SIN(s8 / 990 * 3.141592) * angle * 7.5) + 400
y8 = INT(COS(s8 / 990 * 3.141592) * (angle * 7.5) / tilt) + 300
 
 
'Sun
CIRCLE (400, 300), 2, _RGB32(249, 240, 22)
PAINT (400, 300), _RGB32(249, 240, 22)
 
IF tilt > 6 THEN
    IF x1 > oldx1 THEN z(1) = 1
    IF x2 > oldx2 THEN z(2) = 1
    IF x3 > oldx3 THEN z(3) = 1
    IF x5 > oldx5 THEN z(4) = 1
    IF x6 > oldx6 THEN z(5) = 1
    IF x7 > oldx7 THEN z(6) = 1
    IF x8 > oldx8 THEN z(7) = 1
    IF x > oldx THEN z(8) = 1
    IF x1 < oldx1 THEN z(1) = 0
    IF x2 < oldx2 THEN z(2) = 0
    IF x3 < oldx3 THEN z(3) = 0
    IF x5 < oldx5 THEN z(4) = 0
    IF x6 < oldx6 THEN z(5) = 0
    IF x7 < oldx7 THEN z(6) = 0
    IF x8 < oldx8 THEN z(7) = 0
    IF x < oldx THEN z(8) = 0
 
    IF z(1) = 0 THEN
        'Mercury
        CIRCLE (x1, y1), 5, _RGB32(120, 98, 102)
        PAINT (x1, y1), _RGB32(120, 98, 102)
    END IF
 
    IF z(2) = 0 THEN
        'Venus
        CIRCLE (x2, y2), 5, _RGB32(161, 67, 39)
        PAINT (x2, y2), _RGB32(161, 67, 39)
    END IF
 
    IF z(8) = 0 THEN
        'Earth
        CIRCLE (x, y), 5, _RGB32(0, 0, 255)
        PAINT (x, y), _RGB32(0, 0, 255)
        'Moon
        CIRCLE (x4, y4), 2.5, _RGB32(179, 179, 181)
        PAINT (x4, y4), _RGB32(179, 179, 181)
    END IF
    IF z(3) = 0 THEN
        'Mars
        CIRCLE (x3, y3), 5, _RGB32(240, 72, 22)
        PAINT (x3, y3), _RGB32(240, 72, 22)
    END IF
    IF z(4) = 0 THEN
        'Outer Planets
        'Jupiter
        CIRCLE (x5, y5), 5, _RGB32(255, 166, 127)
        PAINT (x5, y5), _RGB32(255, 166, 127)
    END IF
    IF z(5) = 0 THEN
        'Saturn
        CIRCLE (x6, y6), 5, _RGB32(255, 127, 127)
        PAINT (x6, y6), _RGB32(255, 127, 127)
        FOR rings = 1 TO 2
            CIRCLE (x6, y6), 7 + rings, _RGB32(255, 127, 127), , , .65
        NEXT rings
    END IF
    IF z(6) = 0 THEN
        'Uranus
        CIRCLE (x7, y7), 5, _RGB32(127, 166, 255)
        PAINT (x7, y7), _RGB32(127, 166, 255)
    END IF
    IF z(7) = 0 THEN
        'Neptune
        CIRCLE (x8, y8), 5, _RGB32(0, 78, 255)
        PAINT (x8, y8), _RGB32(0, 78, 255)
    END IF
 
ELSE
 
    'Mercury
    CIRCLE (x1, y1), 5, _RGB32(120, 98, 102)
    PAINT (x1, y1), _RGB32(120, 98, 102)
 
    'Venus
    CIRCLE (x2, y2), 5, _RGB32(161, 67, 39)
    PAINT (x2, y2), _RGB32(161, 67, 39)
 
    'Earth
    CIRCLE (x, y), 5, _RGB32(0, 0, 255)
    PAINT (x, y), _RGB32(0, 0, 255)
    'Moon
    CIRCLE (x4, y4), 2.5, _RGB32(179, 179, 181)
    PAINT (x4, y4), _RGB32(179, 179, 181)
 
    'Mars
    CIRCLE (x3, y3), 5, _RGB32(240, 72, 22)
    PAINT (x3, y3), _RGB32(240, 72, 22)
 
    'Outer Planets
    'Jupiter
    CIRCLE (x5, y5), 5, _RGB32(255, 166, 127)
    PAINT (x5, y5), _RGB32(255, 166, 127)
 
    'Saturn
    CIRCLE (x6, y6), 5, _RGB32(255, 127, 127)
    PAINT (x6, y6), _RGB32(255, 127, 127)
    FOR rings = 1 TO 2
        CIRCLE (x6, y6), 7 + rings, _RGB32(255, 127, 127), , , .65
    NEXT rings
 
    'Uranus
    CIRCLE (x7, y7), 5, _RGB32(127, 166, 255)
    PAINT (x7, y7), _RGB32(127, 166, 255)
 
    'Neptune
    CIRCLE (x8, y8), 5, _RGB32(0, 78, 255)
    PAINT (x8, y8), _RGB32(0, 78, 255)
 
END IF
_DISPLAY
IF seconds > 99999 THEN
    CLS
    seconds = 0
    GOTO one:
END IF
CLS
GOTO one:
 

SierraKen · « **Reply #14 on:** August 19, 2019, 02:59:36 am »

Here is a much nicer version. The planets stay appeared until right before they go behind the Sun. I also made Saturn look better. I was able to do this by adding some more info on the IF/THEN statements to see where the coordinates are exactly. I added this to the ones that see if the planets are going right or left so I know where they are headed. Check this one out. :) Also, I didn't mean to hijack your thread here. I would make my own thread but I already have this in 1 other thread as well lol.
Oh, and don't ask about the Moon orbit. I tried hiding that behind the Earth and couldn't do it. It's just barely noticeable anyway. :)

Code: QB64: [Select]

'Ken G. made thie program on August 18, 2019,
'Thank you to STxAxTIC on the QB64.org forum for a little bit of help with The Moon orbit!
 
_TITLE "Solar System Simulator by Ken G. Use Mouse Over Planets, Mouse Wheel to Zoom, and Up and Down Arrow Keys To Tilt."
SCREEN _NEWIMAGE(800, 600, 32)
DIM z(10)
mercury = 0.241
venus = 0.6152
mars = 1.8809
jupiter = 11.8618
saturn = 29.457
uranus = 84.0205
neptune = 164.8
angle = 180
tilt = 1
one:
_LIMIT 500
mouseWheel = 0
DO WHILE _MOUSEINPUT
    mouseX = _MOUSEX
    mouseY = _MOUSEY
    mouseLeftButton = _MOUSEBUTTON(1)
    mouseRightButton = _MOUSEBUTTON(2)
    mouseMiddleButton = _MOUSEBUTTON(3)
    mouseWheel = mouseWheel + _MOUSEWHEEL
LOOP
IF mouseWheel < 0 THEN angle = angle - 10
IF mouseWheel > 0 THEN angle = angle + 10
 
IF mouseX > 385 AND mouseX < 415 AND mouseY > 285 AND mouseY < 315 THEN LOCATE 2, 49: PRINT "Sun    "
IF mouseX > x1 - 15 AND mouseX < x1 + 15 AND mouseY > y1 - 15 AND mouseY < y1 + 15 THEN LOCATE 2, 49: PRINT "Mercury"
IF mouseX > x2 - 15 AND mouseX < x2 + 15 AND mouseY > y2 - 15 AND mouseY < y2 + 15 THEN LOCATE 2, 49: PRINT "Venus  "
IF mouseX > x - 15 AND mouseX < x + 15 AND mouseY > y - 15 AND mouseY < y + 15 THEN LOCATE 2, 49: PRINT "Earth  "
IF mouseX > x3 - 15 AND mouseX < x3 + 15 AND mouseY > y3 - 15 AND mouseY < y3 + 15 THEN LOCATE 2, 49: PRINT "Mars   "
IF mouseX > x5 - 15 AND mouseX < x5 + 15 AND mouseY > y5 - 15 AND mouseY < y5 + 15 THEN LOCATE 2, 49: PRINT "Jupiter"
IF mouseX > x6 - 15 AND mouseX < x6 + 15 AND mouseY > y6 - 15 AND mouseY < y6 + 15 THEN LOCATE 2, 49: PRINT "Saturn "
IF mouseX > x7 - 15 AND mouseX < x7 + 15 AND mouseY > y7 - 15 AND mouseY < y7 + 15 THEN LOCATE 2, 49: PRINT "Uranus "
IF mouseX > x8 - 15 AND mouseX < x8 + 15 AND mouseY > y8 - 15 AND mouseY < y8 + 15 THEN LOCATE 2, 49: PRINT "Neptune"
 
a$ = INKEY$
IF a$ = CHR$(27) THEN END
IF a$ = CHR$(0) + CHR$(72) THEN tilt = tilt + 1
IF a$ = CHR$(0) + CHR$(80) THEN tilt = tilt - 1
IF angle > 360 THEN angle = 360
IF angle < 10 THEN angle = 10
IF tilt > 50 THEN tilt = 50
IF tilt < 1 THEN tilt = 1
seconds = seconds + .01
s1 = (60 - seconds) * 6 + 180 / mercury
s2 = (60 - seconds) * 6 + 180 / venus
s3 = (60 - seconds) * 6 + 180 'Earth and Moon
s4 = (60 - seconds) * 6 + 180 / mars
s5 = (60 - seconds) * 6 + 180 / jupiter
s6 = (60 - seconds) * 6 + 180 / saturn
s7 = (60 - seconds) * 6 + 180 / uranus
s8 = (60 - seconds) * 6 + 180 / neptune
 
 
'Mercury
oldx1 = x1
x1 = INT(SIN(s1 / 45 * 3.141592) * angle / 4) + 400
y1 = INT(COS(s1 / 45 * 3.141592) * (angle / 4) / tilt) + 300
 
'Venus
oldx2 = x2
x2 = INT(SIN(s2 / 90 * 3.141592) * angle / 2) + 400
y2 = INT(COS(s2 / 90 * 3.141592) * (angle / 2) / tilt) + 300
 
'Earth
oldx = x
x = INT(SIN(s3 / 180 * 3.141592) * angle) + 400
y = INT(COS(s3 / 180 * 3.141592) * angle / tilt) + 300
 
'Mars
oldx3 = x3
x3 = INT(SIN(s4 / 270 * 3.141592) * angle * 1.5) + 400
y3 = INT(COS(s4 / 270 * 3.141592) * (angle * 1.5) / tilt) + 300
 
'Moon
x4 = INT(SIN(19 * s3 / 270 * 3.141592) * angle / 10) + x
y4 = INT(COS(19 * s3 / 270 * 3.141592) * (angle / 10) / tilt) + y
 
'Outer Planets
'Jupiter
oldx5 = x5
x5 = INT(SIN(s5 / 450 * 3.141592) * angle * 3) + 400
y5 = INT(COS(s5 / 450 * 3.141592) * (angle * 3) / tilt) + 300
 
'Saturn
oldx6 = x6
x6 = INT(SIN(s6 / 630 * 3.141592) * angle * 4.5) + 400
y6 = INT(COS(s6 / 630 * 3.141592) * (angle * 4.5) / tilt) + 300
 
'Uranus
oldx7 = x7
x7 = INT(SIN(s7 / 810 * 3.141592) * angle * 6) + 400
y7 = INT(COS(s7 / 810 * 3.141592) * (angle * 6) / tilt) + 300
 
'Neptune
oldx8 = x8
x8 = INT(SIN(s8 / 990 * 3.141592) * angle * 7.5) + 400
y8 = INT(COS(s8 / 990 * 3.141592) * (angle * 7.5) / tilt) + 300
 
 
'Sun
CIRCLE (400, 300), 5, _RGB32(249, 240, 22)
PAINT (400, 300), _RGB32(249, 240, 22)
 
IF tilt > 6 THEN
    IF x1 > oldx1 AND x1 > 375 AND x1 < 425 THEN z(1) = 1
    IF x2 > oldx2 AND x2 > 375 AND x2 < 425 THEN z(2) = 1
    IF x3 > oldx3 AND x3 > 375 AND x3 < 425 THEN z(3) = 1
    IF x5 > oldx5 AND x5 > 375 AND x5 < 425 THEN z(4) = 1
    IF x6 > oldx6 AND x6 > 375 AND x6 < 425 THEN z(5) = 1
    IF x7 > oldx7 AND x7 > 375 AND x7 < 425 THEN z(6) = 1
    IF x8 > oldx8 AND x8 > 375 AND x8 < 425 THEN z(7) = 1
    IF x > oldx AND x > 375 AND x < 425 THEN z(8) = 1
 
    IF x1 > oldx1 AND x1 > 424 THEN z(1) = 0
    IF x2 > oldx2 AND x2 > 424 THEN z(2) = 0
    IF x3 > oldx3 AND x3 > 424 THEN z(3) = 0
    IF x5 > oldx5 AND x5 > 424 THEN z(4) = 0
    IF x6 > oldx6 AND x6 > 424 THEN z(5) = 0
    IF x7 > oldx7 AND x7 > 424 THEN z(6) = 0
    IF x8 > oldx8 AND x8 > 424 THEN z(7) = 0
    IF x > oldx AND x > 424 THEN z(8) = 0
 
 
    IF x1 < oldx1 THEN z(1) = 0
    IF x2 < oldx2 THEN z(2) = 0
    IF x3 < oldx3 THEN z(3) = 0
    IF x5 < oldx5 THEN z(4) = 0
    IF x6 < oldx6 THEN z(5) = 0
    IF x7 < oldx7 THEN z(6) = 0
    IF x8 < oldx8 THEN z(7) = 0
    IF x < oldx THEN z(8) = 0
 
    IF z(1) = 0 THEN
        'Mercury
        CIRCLE (x1, y1), 5, _RGB32(120, 98, 102)
        PAINT (x1, y1), _RGB32(120, 98, 102)
    END IF
 
    IF z(2) = 0 THEN
        'Venus
        CIRCLE (x2, y2), 5, _RGB32(161, 67, 39)
        PAINT (x2, y2), _RGB32(161, 67, 39)
    END IF
 
    IF z(8) = 0 THEN
        'Earth
        CIRCLE (x, y), 5, _RGB32(0, 0, 255)
        PAINT (x, y), _RGB32(0, 0, 255)
        'Moon
        CIRCLE (x4, y4), 2.5, _RGB32(179, 179, 181)
        PAINT (x4, y4), _RGB32(179, 179, 181)
    END IF
    IF z(3) = 0 THEN
        'Mars
        CIRCLE (x3, y3), 5, _RGB32(240, 72, 22)
        PAINT (x3, y3), _RGB32(240, 72, 22)
    END IF
    IF z(4) = 0 THEN
        'Outer Planets
        'Jupiter
        CIRCLE (x5, y5), 5, _RGB32(255, 166, 127)
        PAINT (x5, y5), _RGB32(255, 166, 127)
    END IF
    IF z(5) = 0 THEN
        'Saturn
        CIRCLE (x6, y6), 5, _RGB32(255, 127, 127)
        PAINT (x6, y6), _RGB32(255, 127, 127)
        FOR rings = 4 TO 5
            CIRCLE (x6, y6), 7 + rings, _RGB32(255, 127, 127), , , .2
        NEXT rings
    END IF
    IF z(6) = 0 THEN
        'Uranus
        CIRCLE (x7, y7), 5, _RGB32(127, 166, 255)
        PAINT (x7, y7), _RGB32(127, 166, 255)
    END IF
    IF z(7) = 0 THEN
        'Neptune
        CIRCLE (x8, y8), 5, _RGB32(0, 78, 255)
        PAINT (x8, y8), _RGB32(0, 78, 255)
    END IF
 
ELSE
 
    'Mercury
    CIRCLE (x1, y1), 5, _RGB32(120, 98, 102)
    PAINT (x1, y1), _RGB32(120, 98, 102)
 
    'Venus
    CIRCLE (x2, y2), 5, _RGB32(161, 67, 39)
    PAINT (x2, y2), _RGB32(161, 67, 39)
 
    'Earth
    CIRCLE (x, y), 5, _RGB32(0, 0, 255)
    PAINT (x, y), _RGB32(0, 0, 255)
    'Moon
    CIRCLE (x4, y4), 2.5, _RGB32(179, 179, 181)
    PAINT (x4, y4), _RGB32(179, 179, 181)
 
    'Mars
    CIRCLE (x3, y3), 5, _RGB32(240, 72, 22)
    PAINT (x3, y3), _RGB32(240, 72, 22)
 
    'Outer Planets
    'Jupiter
    CIRCLE (x5, y5), 5, _RGB32(255, 166, 127)
    PAINT (x5, y5), _RGB32(255, 166, 127)
 
    'Saturn
    CIRCLE (x6, y6), 5, _RGB32(255, 127, 127)
    PAINT (x6, y6), _RGB32(255, 127, 127)
    FOR rings = 1 TO 2
        CIRCLE (x6, y6), 7 + rings, _RGB32(255, 127, 127), , , .65
    NEXT rings
 
    'Uranus
    CIRCLE (x7, y7), 5, _RGB32(127, 166, 255)
    PAINT (x7, y7), _RGB32(127, 166, 255)
 
    'Neptune
    CIRCLE (x8, y8), 5, _RGB32(0, 78, 255)
    PAINT (x8, y8), _RGB32(0, 78, 255)
 
END IF
_DISPLAY
IF seconds > 99999 THEN
    CLS
    seconds = 0
    GOTO one:
END IF
CLS
GOTO one:
 
 

News:

Author Topic: 3D Revolving Disks (Read 7882 times)

bplus

3D Revolving Disks

TempodiBasic

Re: 3D Revolving Disks

bplus

Re: 3D Revolving Disks

SierraKen

Re: 3D Revolving Disks

bplus

Re: 3D Revolving Disks

bplus

Re: 3D Revolving Disks

STxAxTIC

Re: 3D Revolving Disks

SierraKen

Re: 3D Revolving Disks

bplus

Re: 3D Revolving Disks

STxAxTIC

Re: 3D Revolving Disks

Petr

Re: 3D Revolving Disks

SierraKen

Re: 3D Revolving Disks

bplus

Re: 3D Revolving Disks

SierraKen

Re: 3D Revolving Disks

SierraKen

Re: 3D Revolving Disks