' 3D starfield
' made by Svjatoslav Agejenko
' in 2003.03
' H-Page: svjatoslav.eu
' E-Mail: svjatoslav@svjatoslav.eu

DECLARE SUB setstar (x2!, y2!, z2!)
DECLARE SUB galaxy ()
Dim Shared mitu
Dim Shared mituv


Randomize Timer
mituv = 2000
mitu = mituv
rns = 500
wl = 0

Dim Shared px(1 To mitu + 1000)
Dim Shared py(1 To mitu + 1000)
Dim Shared pz(1 To mitu + 1000)

For a = 1 To mitu
    pz(a) = Rnd * 500 + 20
    n = Rnd * 100
    px(a) = Sin(n) * 20
    py(a) = Cos(n) * 20
Next a


Screen 13


frm = 10
1
fps = fps + 1
If tm$ <> Time$ Then
    'LOCATE 1, 1
    'PRINT fps
    If fps > 20 Then wl = wl + 2 Else wl = wl - 1
    If wl < 0 Then wl = 0
    fps = 0
    tm$ = Time$
End If
frm = frm + 1
xp = Sin(frm / 21) * 3
yp = Sin(frm / 18) * 3

nrk = (3.1412) / 2 + Sin(frm / 35) / 100 + Sin(frm / 21) / 100
rs1 = Sin(nrk)
rc1 = Cos(nrk)

For a = 1 To mitu
    x = px(a)
    y = py(a)
    z = pz(a)
    x1 = x / z * 160 + 160
    y1 = y / z * 100 + 100
    PSet (x1, y1), 0

    x5 = x * rs1 - y * rc1
    y5 = x * rc1 + y * rs1

    x = x5
    y = y5

    z = z - 3
    x = x + xp
    y = y + yp
    If z < 10 Then
        z = Rnd * 300 + 400
        x = Rnd * 800 - 400
        y = Rnd * 800 - 400
    End If

    x1 = x / z * 160 + 160
    y1 = y / z * 100 + 100
    c = 3000 / z + 15
    If c > 31 Then c = 31
    PSet (x1, y1), c

    px(a) = x
    py(a) = y
    pz(a) = z
Next a


If mituv - mitu > rns Then galaxy: rns = Rnd * 800 + 100

For a = 1 To 2
    b = Rnd * (mitu - 10) + 1
    Swap px(mitu), px(b)
    Swap py(mitu), py(b)
    Swap pz(mitu), pz(b)

    x = px(mitu)
    y = py(mitu)
    z = pz(mitu)
    x1 = x / z * 160 + 160
    y1 = y / z * 100 + 100
    PSet (x1, y1), 0
    mitu = mitu - 1
Next a

'LOCATE 2, 1
'PRINT wl
For a = 0 To wl
    For b = 0 To 1000
        c = c / 100
    Next b
Next a

If InKey$ <> "" Then System
sound 0,1
GoTo 1

Sub galaxy

    xf = Rnd * 4 - 2
    yf = Rnd * 4 - 2
    xp = Rnd * 200 - 100
    yp = Rnd * 200 - 100

    For a = 1 To Rnd * 15 + 10 Step .04
        x = Sin(a) * a * a / 10
        y = Cos(a) * a * a / 10
        setstar x + Rnd * a * a / 30 + xp, y + Rnd * a * a / 30 + yp, 700 + Rnd * a * a / 30 + (x * xf) + (y * yf)
    Next a

    'SOUND 1000, 1
End Sub

Sub setstar (x2, y2, z2)
    mitu = mitu + 1
    s = mitu

    px(s) = x2
    py(s) = y2
    pz(s) = z2
End Sub