qb643Dtest

SCREEN 12

DECLARE SUB pointt(xp, yp, zp, x, y, z, r, rh)
DECLARE FUNCTION dist(x1,y1,x2,y2)

xp = 0
yp = 0
zp = 0
r2 = 0
rh2 = 0
CONST pi = 3.141592653589793
'main
_MOUSEMOVE 320, 240
_MOUSEHIDE
DO
    ' c3 = c3 + 1

    c2 = c2 + 1
    IF c2 = 1 THEN
        ' CLS
        c = c + 2
        c2 = 0
    END IF

    ' IF c3 = 4 THEN
    '  CLS

    ' c3 = 0
    '  END IF


    CALL pointt(xp, yp, zp, 0, 0, 100, r, rh)
    CALL pointt(xp, yp, zp, 20, 0, 100, r, rh)
    CALL pointt(xp, yp, zp, 20, 20, 100, r, rh)
    CALL pointt(xp, yp, zp, 20, 20, 120, r, rh)
    CALL pointt(xp, yp, zp, 0, 20, 120, r, rh)
    CALL pointt(xp, yp, zp, 20, 0, 120, r, rh)
    CALL pointt(xp, yp, zp, 0, 0, 120, r, rh)
    CALL pointt(xp, yp, zp, 0, 20, 100, r, rh)

    CLS
    FOR i2 = -30 TO 30 STEP 3
        FOR i = 0 + (c MOD 10) TO 360 + (c MOD 10) STEP 10
            CALL pointt(xp, yp, zp, 30 * COS(i2 * 3 * pi / 180) * SIN(i * pi / 180), 30 * COS(i2 * 3 * pi / 180) * COS(i * pi / 180), 30 * COS(((i2 + 30) * 3) * pi / 180), r, rh)
        NEXT
    NEXT
    ' PRINT r2
    ' PRINT xp
    'PRINT yp

    a$ = "n"



    _DELAY 0.04




    a$ = INKEY$
    DO WHILE _MOUSEINPUT
        r2 = r2 + 0.01 * (320 - _MOUSEX)

        rh2 = rh2 - 0.01 * (240 - _MOUSEY)

        IF rh2 > 90 THEN rh2 = 90
        IF rh2 < -90 THEN rh2 = -90
        IF r2 > 360 THEN r2 = 0
        IF r2 < 0 THEN r2 = 360

    LOOP
    _MOUSEMOVE 320, 240

    IF a$ = "a" THEN
        xp = xp - 5 * SIN(r)
        yp = yp + 5 * COS(r)
    ELSEIF a$ = "e" THEN
        xp = xp + 5 * SIN(r)
        yp = yp - 5 * COS(r)
    ELSEIF a$ = "," THEN
        xp = xp + 5 * COS(r)
        yp = yp + 5 * SIN(r)
    ELSEIF a$ = "o" THEN
        xp = xp - 5 * COS(r)
        yp = yp - 5 * SIN(r)
    ELSEIF a$ = "p" THEN
        r2 = r2 + 2
    ELSEIF a$ = "u" THEN
        r2 = r2 - 2
    ELSEIF a$ = "y" THEN
        rh2 = rh2 + 2
    ELSEIF a$ = "i" THEN
        rh2 = rh2 - 2
    ELSEIF a$ = ";" THEN
        zp = zp + 5
    ELSEIF a$ = "j" THEN
        zp = zp - 5
    END IF
    IF r2 > 360 THEN r2 = 0
    IF r2 < 0 THEN r2 = 360
    r = (r2 / 180) * pi
    rh = (rh2 / 180) * pi

LOOP UNTIL a$ = "q"
'end main

SUB pointt (xp, yp, zp, xo, yo, zo, r, rh)
fov = pi / 2
xq = xp + COS(r)
yq = yp + SIN(r)
'PRINT SQR((xo - xp) ^ 2 + (yo - yp) ^ 2) - SQR((xq - xo) ^ 2 + (yq - yo) ^ 2)
IF SQR((xo - xp) ^ 2 + (yo - yp) ^ 2) > SQR((xo - xq) ^ 2 + (yo - yq) ^ 2) THEN
    xs = _ASIN(((xo - xp) * SIN(r) - (yo - yp) * COS(r)) / SQR((xo - xp) ^ 2 + (yo - yp) ^ 2)) * 640 / fov + 640 / 2

    ' ys = (ATN((zo - zp) / (SQR((xo - xp) ^ 2 + (yo - yp) ^ 2))) + rh) * 640 / fov + 320

    k = 1
    IF _ACOS((1 + dist(xp, yp, 0, xo, yo, 0) - dist(xo, yo, 0, xq, yq, 0)) / (2 * dist(xp, yp, 0, xo, yo, 0))) > 2 * pi THEN k = -1
    IF zo > zp THEN k = -1

    ys = _ASIN((SIN(rh) * SQR((xo - xp) ^ 2 + (yo - yp) ^ 2) - COS(rh) * (zo - zp)) / SQR((xo - xp) ^ 2 + (yo - yp) ^ 2 + (zo - zp) ^ 2)) * 640 / fov + 480 / 2
    'ys = k * (_ACOS(SQR((xo - xp) ^ 2 + (yo - yp) ^ 2) / SQR((xo - xp) ^ 2 + (yo - yp) ^ 2 + (zo - zp) ^ 2)) - rh) * 640 / fov + 320


    ' d = COS(r) * (xp - xo) + SIN(r) * (yp - yo)
    ' xl = xo * COS(r) + (xp - yp + yo) * SIN(r)
    ' yl = TAN(r) * (xl - xp) + yp
    ' IF (xl - xp) ^ 2 + (yl - yp) ^ 2 < (xl - xq) ^ 2 + (yl - yq) ^ 2 THEN
    ' d = -ABS(d)
    'ELSE d = ABS(d)
    'END IF
    ' ys = -_ASIN((d * SIN(rh) - COS(rh) * (zo - zp)) / SQR(d ^ 2 + (zo - zp) ^ 2)) * 640 / fov + 320

    '  xq = (xp - (dist(xp, yp, 0, xo, yo, 0) - 1) * xo) / dist(xp, yp, 0, xo, yo, 0)
    ' yq = (yp - (dist(xp, yp, 0, xo, yo, 0) - 1) * yo) / dist(xp, yp, 0, xo, yo, 0)
    ' alfa = _ACOS((1 + dist(xp, yp, zp, xo, yo, zo) ^ 2 - dist(xo, yo, zo, xq, yq, zp) ^ 2) / (2 * dist(xp, yp, zp, xo, yo, zo)))
    ' IF zo < zp THEN alfa = -alfa
    '  ys = (alfa - rh) * 640 / fov + 320



    LINE (xs, ys)-(xs + 5, ys + 5), 2, BF
END IF

END SUB
FUNCTION dist (x1, y1, z1, x2, y2, z2)
dist = SQR((x2 - x1) ^ 2 + (y2 - y1) ^ 2 + (z2 - z1) ^ 2)
END FUNCTION