Traveller Store CotI Features New Posts Mark Forums Read Register


Go Back TravellerRPG.com > Citizens of the Imperium > General Traveller Discussions > Software Solutions

Software Solutions Discussions on Traveller related software.

Reply
 
Thread Tools Display Modes
  #1  
Old August 11th, 2019, 03:00 PM
AndyW AndyW is offline
Citizen: SOC-9
 
Join Date: Jun 2019
Posts: 44
Gallery : 0
AndyW Citizen
Default How to incapacitate a Trekkie

Thought I'd share some otherwise useless eye candy for QB64 users.

Code:
_TITLE "OldMoses' 3D StarField (+ & - speed) (left/right arrows turn)"

a& = _NEWIMAGE(600, 600, 32)
SCREEN a&
DO: LOOP UNTIL _SCREENEXISTS
_SCREENMOVE 50, 50
TYPE star '                                                     define the star data type
    x AS INTEGER
    y AS INTEGER
    z AS INTEGER
    r AS INTEGER
    g AS INTEGER
    b AS INTEGER
    xa AS INTEGER
    ya AS INTEGER
END TYPE

DIM SHARED max AS INTEGER: max = 500
DIM SHARED vprt AS INTEGER: vprt = 600 '                        set the viewport setback from viewer's eye
DIM SHARED p(max) AS star '                                     dimension the star data array
DIM SHARED speed AS INTEGER: speed = 2 '                        warp factor
DIM SHARED xch AS _BYTE
DIM SHARED ych AS _BYTE

PopVoid '                                                       OldMoses said "Let there be light" and the universe was, is and ever shall be
WINDOW (-300, 300)-(300, -300) '                                create viewport window, Cap'n Kirk spends his days staring at this

DO '                                                            draw the stars
    x$ = INKEY$
    IF x$ = "" THEN
        xch = 0: ych = 0
    END IF
    IF x$ = CHR$(43) THEN speed = speed + 1
    IF x$ = CHR$(45) THEN speed = speed - 1
    IF x$ = CHR$(0) + CHR$(75) THEN xch = 1
    IF x$ = CHR$(0) + CHR$(77) THEN xch = -1
    'IF x$ = CHR$(0) + CHR$(72) THEN ych = 1
    'IF x$ = CHR$(0) + CHR$(80) THEN ych = -1
    CLS
    FOR x = 1 TO max '                                          iterate through all stars
        dst = Pythagorus(p(x)) '                                distance to star
        p(x).x = p(x).x + SinCalc(p(x).z, xch * 0.3)
        'p(x).y = p(x).y + CosCalc(p(x).z, ych * 0.3) '          <<<this just doesn't work
        p(x).xa = p(x).x / dst * vprt '                         get relative screen position from absolute position for x & y
        p(x).ya = p(x).y / dst * vprt
        IF ABS(p(x).xa) < 301 AND ABS(p(x).ya) < 301 THEN '     place the star if within the viewport
            fdf& = (dst - 12952) / 8
            IF fdf& < 0 THEN fdf& = 0
            SELECT CASE dst
                CASE IS > 7500
                    PSET (p(x).xa, p(x).ya), _RGBA32(p(x).r, p(x).g, p(x).b, 255 - fdf&)
                CASE ELSE
                    FCirc p(x).xa, p(x).ya, 1, _RGBA32(p(x).r, p(x).g, p(x).b, 255)
            END SELECT
        END IF
        p(x).z = p(x).z - speed '                               move the star closer to the viewer
        IF speed < 0 THEN
            IF p(x).z > 15000 THEN ReplaceStar x, 0
        ELSE
            IF p(x).z < 0 THEN ReplaceStar x, 15000 '                      add new stars as existing ones go behind the viewer
        END IF
    NEXT x
    _DISPLAY '                                                  eliminate screen flicker
    _LIMIT 500 '                                                smooth out the action
LOOP UNTIL _KEYDOWN(27)


SUB PopVoid '                                                   Do an initial population of stars

    FOR x = 1 TO max '                                          place a 'max' # of stars randomly in a 3D space
        RANDOMIZE TIMER
        p(x).x = INT(RND * 15000) - 7500
        p(x).y = INT(RND * 15000) - 7500
        p(x).z = INT(RND * 15000) + 1
        t% = INT(RND * 110) - 55
        ch = INT(RND * 6)
        IF ch < 4 THEN
            p(x).r = 200 + t%: p(x).b = 200 - t%
        ELSE
            p(x).r = 200 - t%: p(x).b = 200 + t%
        END IF
        p(x).g = 200
    NEXT x

END SUB 'PopVoid


FUNCTION Pythagorus (var1 AS star)

    horizontal = _HYPOT(ABS(var1.x), ABS(var1.y)) '             Use to find distance between star and origin (viewer)
    Pythagorus = _HYPOT(horizontal, ABS(var1.z))

END FUNCTION 'Pythagorus


SUB ReplaceStar (var AS INTEGER, insert AS INTEGER) '                              This replaces any star that goes behind the viewer

    RANDOMIZE TIMER
    p(var).x = INT(RND * 15000) - 7500 '                        New x,y,z but keep old color for simplicity sake
    p(var).y = INT(RND * 15000) - 7500
    p(var).z = insert

END SUB 'ReplaceStar

FUNCTION SinCalc (var1 AS _INTEGER64, var2 AS SINGLE)

    'Polar coordinate X finder
    'used to find X coordinate of a speed/distance (var1) and heading/azimuth (var2)
    SinCalc = var1 * SIN(_D2R(var2))

END FUNCTION 'SinCalc


FUNCTION CosCalc (var1 AS _INTEGER64, var2 AS SINGLE)

    'Polar coordinate Y finder
    'used to find Y coordinate of a speed/distance (var1) and heading/azimuth (var2)
    CosCalc = var1 * COS(_D2R(var2))

END FUNCTION 'CosCalc


SUB FCirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG)
    DIM R AS INTEGER, RError AS INTEGER
    DIM X AS INTEGER, Y AS INTEGER

    R = ABS(RR)
    RError = -R
    X = R
    Y = 0
    IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
    LINE (CX - X, CY)-(CX + X, CY), C, BF
    WHILE X > Y
        RError = RError + Y * 2 + 1
        IF RError >= 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
            RError = RError - 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 'FCirc

Last edited by AndyW; August 11th, 2019 at 04:31 PM..
Reply With Quote

Welcome!
To see more of this thread, please login or register.
Reply

Bookmarks

Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

This website and its contents are copyright ©2010- Far Future Enterprises. All rights reserved. Traveller is a registered trademark of Far Future Enterprises .
Powered by vBulletin® Version 3.8.4
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
Copyright (c) 2010-2013, Far Future Enterprises. All Rights Reserved.