' 3D stars


DECLARE SUB pal ()


DECLARE SUB RotateX (c AS ANY)
DECLARE SUB RotateY (c AS ANY)
DECLARE SUB RotateZ (c AS ANY)
DECLARE SUB Screen3D (c AS ANY)
CLS
RANDOMIZE TIMER
Pi# = ATN(1) * 4
TYPE coord
        X AS SINGLE
        Y AS SINGLE
        Z AS SINGLE
END TYPE

TYPE pixel
        X AS INTEGER
        Y AS INTEGER
        Colour AS INTEGER
END TYPE

CLS
PRINT "Escape quits"
PRINT "Space Toggles Z rotation on/off (Yuck!)"
PRINT
INPUT "# Stars:", n%
pal

CLS
DIM SHARED perspective, Rot AS coord, Pix AS pixel, PT(n%) AS pixel, p(n%) AS pixel
DIM Target AS coord, Camera AS coord, Points(n%) AS coord, T(n%) AS coord
perspective = 350
DIM SHARED CosX, SinX, CosY, SinY, CosZ, SinZ


start:
FOR a% = 1 TO n%
j:
    X = 200 - RND * 400
    Y = 200 - RND * 400
    Z = 200 - RND * 400
    IF X * X + Y * Y + Z * Z > 1000000 THEN GOTO j
    Points(a%).X = X
    Points(a%).Y = Y
    Points(a%).Z = Z
LOCATE 1, 1: PRINT a%
NEXT a%
CLS
top:
i& = i& + 1
Camera.X = SIN(i& / 35.54) * 200
Camera.Y = COS(i& / 51.312) * 200
Camera.Z = SIN(i& / 23.45) * 200

Target.X = SIN(i& / 45.689) * 50
Target.Y = SIN(i& / 35.624) * 50
Target.Z = SIN(i& / 41.12) * 50

DX = Target.X - Camera.X: IF ABS(DX) < .01 THEN DX = .01
DY = Target.Y - Camera.Y: IF ABS(DY) < .01 THEN DY = .01
DZ = Target.Z - Camera.Z: IF ABS(DZ) < .01 THEN DZ = .01
XRot = ATN(DY / SQR(DX * DX + DZ * DZ))
IF DZ > 0 THEN
        YRot = ATN(DX / DZ)
        ELSE YRot = Pi# - ATN(DX / -DZ)
END IF

'ZRot=Waste of time except for vomity tilts
Zrot = Zrot + ZI

i$ = INKEY$
IF INKEY$ = CHR$(27) THEN END
IF i$ = " " THEN IF ZI = .1 THEN ZI = 0 ELSE ZI = .1
CosX = COS(XRot): SinX = SIN(XRot)
CosY = COS(YRot): SinY = SIN(YRot)
CosZ = COS(Zrot): SinZ = SIN(Zrot)


FOR a% = 1 TO n%
        T(a%).X = Points(a%).X - Camera.X
        T(a%).Y = Points(a%).Y - Camera.Y
        T(a%).Z = Points(a%).Z - Camera.Z
        RotateY T(a%): T(a%) = Rot
        RotateX T(a%): T(a%) = Rot
        RotateZ T(a%)
        PT(a%) = p(a%)
        Screen3D Rot
        p(a%) = Pix
        IF Pix.Colour < 0 THEN p(a%).Colour = 0


NEXT a%
FOR a% = 1 TO n%
        PSET (PT(a%).X, PT(a%).Y), 0
        PSET (p(a%).X, p(a%).Y), p(a%).Colour
NEXT a%
GOTO top

SUB pal
SCREEN 12
PALETTE 15, 4144959
COLOR 15

PRINT "Paletterification currently going on!"
FOR j% = 0 TO 15
PALETTE j%, j% * 4 + j% * 4 * 256 + j% * 65536 * 4
NEXT j%
END SUB

SUB RotateX (c AS coord)
Rot.X = c.X
Rot.Y = c.Y * CosX - c.Z * SinX
Rot.Z = c.Y * SinX + c.Z * CosX
END SUB

SUB RotateY (c AS coord)
Rot.X = c.X * CosY - c.Z * SinY
Rot.Y = c.Y
Rot.Z = c.X * SinY + c.Z * CosY
END SUB

SUB RotateZ (c AS coord)
Rot.X = c.X * CosZ - c.Y * SinZ
Rot.Y = c.X * SinZ + c.Y * CosZ
Rot.Z = c.Z
END SUB

SUB Screen3D (c AS coord)
Distance = c.X * c.X + c.Y * c.Y + c.Z * c.Z
mag = SQR(Distance) / perspective
IF mag > .01 AND c.Z >= 0 THEN
        Pix.X = 320 + (c.X / mag) * 1.3
        Pix.Y = 240 - (c.Y / mag)
        Pix.Colour = 300000 / Distance
END IF
END SUB