_TITLE "OldMoses' 3D StarField V.2 (h to toggle help menu)"
TYPE star
' define the star data type xa
AS INTEGER ' apparent x position on screen ya
AS INTEGER ' apparent y position on screen
DIM SHARED p
(starcount
) AS star
' dimension the star data array
'lets try a fullscreen version.
PopVoid ' OldMoses said "Let there be light" and the universe was, is and ever shall be
WINDOW (-scrw
/ 2, scrh
/ 2)-(scrw
/ 2, -scrh
/ 2) ' create viewport window, Cap'n Kirk spends his days staring at this IF x&
= 104 THEN hlptog
= NOT hlptog
' toggle help menu IF x&
= 100 THEN dattog
= NOT dattog
' toggle data bar IF x&
= 43 THEN speed
= speed
+ 1 ' increase speed IF x&
= 45 THEN speed
= speed
- 1 ' decrease speed IF x&
= 19200 THEN xch
= 1 ' turn left IF x&
= 19712 THEN xch
= -1 ' turn right IF x&
= 18432 THEN ych
= -1 ' turn up IF x&
= 20480 THEN ych
= 1 ' turn down IF x&
= 122 THEN vwport
= vwport
* 2 ' zoom x 2 IF x&
= 120 THEN vwport
= 1200 ' zoom normal starcount = starcount + 1 '
AddStar starcount '
starcount = starcount - 1 ' subtract stars
FOR x
= 1 TO starcount
' iterate through all stars
IF xch
<> 0 OR ych
<> 0 THEN ' not actually a proper transformation p
(x
).x
= p
(x
).x
+ p
(x
).z
* SIN(_D2R(xch
* 0.3)) ' slew stars for left/right turns p
(x
).y
= p
(x
).y
+ p
(x
).z
* SIN(_D2R(ych
* 0.3)) ' slew stars for up/down pitch
IF p
(x
).z
> 0 THEN 'ignore those behind, change to a dot product test if a facing vector is later added p(x).xa = p(x).x / p(x).z * vwport ' get relative screen position from absolute position for x & y
p(x).ya = p(x).y / p(x).z * vwport
IF ABS(p
(x
).xa
) < ABS(scrw
/ 2) AND ABS(p
(x
).ya
) < ABS(scrh
/ 2) THEN 'place the star if within the viewport dst&
= (_HYPOT(_HYPOT(ABS(p
(x
).x
), ABS(p
(x
).y
)), ABS(p
(x
).z
))) / (vwport
/ 1200) 'distance to star / zoom fdf& = (dst& - 25904) / 16 ' far fade in factor;
fdn& = (dst& - 6806) / 32 ' near fade in factor; mid-field swell
fdp& = (dst& - 938) / 12 ' proximity swell
FCirc p
(x
).xa
, p
(x
).ya
, bsrad
+ 1, _RGBA32(p
(x
).r
, p
(x
).g
, p
(x
).b
, 255 - fdp&
) 'proximity star plot FCirc p
(x
).xa
, p
(x
).ya
, bsrad
, _RGBA32(p
(x
).r
, p
(x
).g
, p
(x
).b
, 255) FCirc p
(x
).xa
, p
(x
).ya
, bsrad
, _RGBA32(p
(x
).r
, p
(x
).g
, p
(x
).b
, 255 - fdn&
) 'near star plot PSET (p
(x
).xa
, p
(x
).ya
), _RGBA32(p
(x
).r
, p
(x
).g
, p
(x
).b
, 255) PSET (p
(x
).xa
, p
(x
).ya
), _RGBA32(p
(x
).r
, p
(x
).g
, p
(x
).b
, 255 - fdf&
) 'far star plot
p(x).z = p(x).z - speed ' move the star closer to the viewer
ReplaceStar x, p(x).z - 30000 ' add new stars as existing ones fade to black (reverse)
ReplaceStar x, p(x).z + 30000 ' add new stars as existing ones go behind the viewer (forward)
xch = 0: ych = 0
_LIMIT 500 ' smooth out the action
SUB PopVoid
' Do an initial population of stars
FOR x
= 1 TO starcount
' place a 'starcount' # of stars randomly in a 3D space p
(x
).x
= INT(RND * 60000) - 30000 p
(x
).y
= INT(RND * 60000) - 30000 p
(x
).z
= INT(RND * 60000) - 30000 t%
= INT(RND * 110) - 55 ' star spectrum/color p(x).r = 200 + t%: p(x).b = 200 - t%
p(x).r = 200 - t%: p(x).b = 200 + t%
p(x).g = 200 + gi% ^ 2
p(x).g = 200
p
(var
).x
= INT(RND * 60000) - 30000 ' New x,y,z but keep old color for simplicity sake p
(var
).y
= INT(RND * 60000) - 30000 p(var).z = p(var).z + insert
RError = -R
X = R
Y = 0
LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RError = RError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RError = RError - X * 2
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
p
(x
).x
= INT(RND * 60000) - 30000 p
(x
).y
= INT(RND * 60000) - 30000 p(x).z = 30000
p(x).z = -30000
p(x).r = 200 + t%: p(x).b = 200 - t%
p(x).r = 200 - t%: p(x).b = 200 + t%
p(x).g = 200 + gi% ^ 2
p(x).g = 200
mi = (scrh / 2) - (13 * 16 / 2) ' change ...(x * 16 / 2) to x= number of items in menu
_PRINTSTRING (scrw
/ 2 - 150, mi
+ 16), "<-> decrease speed", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 32), "<left arrow> turn left", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 48), "<right arrow> turn right", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 64), "<up arrow> pitch up", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 80), "<down arrow> pitch down", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 112), "<x> zoom original", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 144), "<s> subtract stars", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 160), "<h> toggle this list on/off", 0 _PRINTSTRING (scrw
/ 2 - 150, mi
+ 176), "<d> toggle data bar", 0
_PRINTSTRING (scrw
- 100, scrh
- 60), "Mag. x" + STR$(vwport
/ 1200), 0 ' magnification factor