CHDIR ".\qbasicapps\math\3D graph\"


' 3D formula explorer
' made by Svjatoslav Agejenko
' in 2002
' homepage: svjatoslav.eu
' email: 	svjatoslav@svjatoslav.eu
 
' use:
' cursor keys - move around
' -           - fly up
' +           - fly down
' ESC         - exit program

' Type your formula to sub module "valem".
' X & Y are surface coordinates. Z must be formula
' result, indicating height. "tm" variable counts
' frames. Use it in your formula to make graph moving in time.


DECLARE SUB valem (x!, y!, z!)
DECLARE SUB graaf ()
DECLARE SUB mkgr3 (x1!, y1!, z1!)
DECLARE SUB mkgr2 (x1!, y1!, z1!)
DECLARE SUB mkgr (x1!, y1!, z1!)
DECLARE SUB ruut2 (x!, y!, z!, s!)
DECLARE SUB ruut (x!, y!, z!, s!)
DECLARE SUB kuus (x, y, z, s)
DECLARE SUB porand ()
DECLARE SUB addp (x, y, z)
DECLARE SUB start ()
DECLARE SUB addsq (x1%, y1%, z1%)
DECLARE SUB getcor ()
DECLARE SUB mulcor ()
DECLARE SUB nait3d ()
DECLARE SUB calcsin ()
DIM SHARED xn(4000), yn(4000), zn(4000)
DIM SHARED x(4000), y(4000), z(4000)

DIM SHARED xo(4000), yo(4000), zo(4000)
DIM SHARED point1(4000), point2(4000)
DIM SHARED col(4000)
DIM SHARED nump, numl
DIM SHARED tmnump, tmnuml, tm
DIM SHARED myx, myy, myz, mye, myk

myx = 520
myy = -250
myz = -1000
tm = 0

ON ERROR GOTO 3
start

nait3d

3
PRINT "Kuskil programmis l�ks mingi arv �le lubatud piiride!!!"
RESUME

SUB getcor
c = 12

mkgr -500, 0, 0
mkgr2 0, 0, 500
mkgr3 0, -500, 0

xn(nump + 1) = 0
yn(nump + 1) = -500
zn(nump + 1) = 0

xn(nump + 2) = 0
yn(nump + 2) = 500
zn(nump + 2) = 0

xn(nump + 3) = -500
yn(nump + 3) = 0
zn(nump + 3) = 0

xn(nump + 4) = 500
yn(nump + 4) = 0
zn(nump + 4) = 0

xn(nump + 5) = 0
yn(nump + 5) = 0
zn(nump + 5) = -500

xn(nump + 6) = 0
yn(nump + 6) = 0
zn(nump + 6) = 500

point1(numl + 1) = nump + 1
point2(numl + 1) = nump + 2
col(numl + 1) = c

point1(numl + 2) = nump + 3
point2(numl + 2) = nump + 4
col(numl + 2) = c

point1(numl + 3) = nump + 5
point2(numl + 3) = nump + 6
col(numl + 3) = c

nump = nump + 6
numl = numl + 3
tmnump = nump
tmnuml = numl
END SUB

SUB graaf

c = 14

d = 0
e = 0
FOR x = -500 TO 500 STEP 50
    FOR z = -500 TO 500 STEP 50

        d = d + 1
        xn(nump + d) = x
        valem x / 50, z / 50, y
        yn(nump + d) = y * 50
        zn(nump + d) = z
        IF z > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 1
            col(numl + e) = c
        END IF

        IF x > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 21
            col(numl + e) = c
        END IF

    NEXT z
NEXT x
nump = nump + d
numl = numl + e

END SUB

SUB mkgr (x1, y1, z1)
c = 3

d = 0
e = 0
FOR z = -500 TO 500 STEP 100
    FOR y = -500 TO 500 STEP 100

        d = d + 1
        xn(nump + d) = x1
        yn(nump + d) = y1 + y
        zn(nump + d) = z1 + z
        IF y > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 1
            col(numl + e) = c
        END IF

        IF z > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 11
            col(numl + e) = c
        END IF

    NEXT y
NEXT z
nump = nump + d
numl = numl + e

END SUB

SUB mkgr2 (x1, y1, z1)

c = 3

d = 0
e = 0
FOR x = -500 TO 500 STEP 100
    FOR y = -500 TO 500 STEP 100

        d = d + 1
        xn(nump + d) = x1 + x
        yn(nump + d) = y1 + y
        zn(nump + d) = z1
        IF y > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 1
            col(numl + e) = c
        END IF

        IF x > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 11
            col(numl + e) = c
        END IF

    NEXT y
NEXT x
nump = nump + d
numl = numl + e


END SUB

SUB mkgr3 (x1, y1, z1)

c = 3

d = 0
e = 0
FOR x = -500 TO 500 STEP 100
    FOR z = -500 TO 500 STEP 100

        d = d + 1
        xn(nump + d) = x1 + x
        yn(nump + d) = y1 + y
        zn(nump + d) = z
        IF z > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 1
            col(numl + e) = c
        END IF

        IF x > -500 THEN
            e = e + 1
            point1(numl + e) = nump + d
            point2(numl + e) = nump + d - 11
            col(numl + e) = c
        END IF

    NEXT z
NEXT x
nump = nump + d
numl = numl + e



END SUB

SUB nait3d

1
nump = tmnump
numl = tmnuml
tm = tm + 1
graaf


myx = myx + SIN(deg1) * mye
myz = myz + COS(deg1) * mye
   
myx = myx + COS(deg1) * myk
myz = myz - SIN(deg1) * myk

myy = myy + myyp

deg1 = deg1 + d1
Deg2 = Deg2 + d2
  
C1 = COS(deg1): S1 = SIN(deg1)
C2 = COS(Deg2): S2 = SIN(Deg2)
 
FOR a = 1 TO nump

    xo = xn(a) - myx
    yo = -yn(a) - myy
    zo = zn(a) - myz
      
    x1 = (xo * C1 - zo * S1)
    z1 = (xo * S1 + zo * C1)
       
    y1 = (yo * C2 - z1 * S2)
    z2 = (yo * S2 + z1 * C2)
       

    xo(a) = x(a)
    yo(a) = y(a)
    IF z2 < 20 THEN
        x(a) = -1
    ELSE
        x(a) = 320 + (x1 / z2 * 500)
        y(a) = 240 + (y1 / z2 * 500)
    END IF
NEXT
     

FOR a = 1 TO numl
    p1 = point1(a)
    p2 = point2(a)
    IF xo(p1) = -1 OR xo(p2) = -1 THEN ELSE LINE (xo(p1), yo(p1))-(xo(p2), yo(p2)), 0

    IF x(p1) = -1 OR x(p2) = -1 THEN ELSE LINE (x(p1), y(p1))-(x(p2), y(p2)), col(a)
NEXT
  

K$ = INKEY$
IF K$ <> "" THEN

    SELECT CASE K$

        CASE CHR$(0) + "P"
            mye = mye - 3

        CASE CHR$(0) + "H"
            mye = mye + 3

        CASE CHR$(0) + "M"
            myk = myk + 3

        CASE CHR$(0) + "K"
            myk = myk - 3

        CASE "+"
            myyp = myyp + 5

        CASE "-"
            myyp = myyp - 5

        CASE "6"
            d1 = d1 + .01

        CASE "4"
            d1 = d1 - .01

        CASE "8"
            d2 = d2 - .01

        CASE "2"
            d2 = d2 + .01


        CASE " "
            d1 = d1 / 2
            d2 = d2 / 2
            d3 = d3 / 2
            mye = mye / 2
            myk = myk / 2
            myyp = myyp / 2
        CASE "q"
            SYSTEM

        CASE CHR$(27)
            SYSTEM

    END SELECT
END IF

_LIMIT (30)

GOTO 1
END SUB

SUB start
SCREEN 12
CLS

FOR a = 1 TO 4000
    col(a) = 15
NEXT a

nump = 0
numl = 0


getcor

END SUB

SUB valem (x, y, z)
z = 0
v = SQR(x * x + y * y) ' v = distance from center, some formulas needs it.

z = z + SIN(x + y) * SIN(tm / 10) ' diagonal lines
z = z + (SQR((15 + v) * (15 - v)) - 10) ' top of the ball
' here I mixed 2 formulas.

'z = z + RND * 1                                ' noise
'z = z + SIN((y + tm) / 2)                      ' forward moving wave
'z = z + SIN(v / 2) * 2                         ' circular waves
'z = z - SQR(v * 6)                             ' sharp

'z = z + SIN(y / 1.5) / 1.5 + COS(x / 1.5) / 1.5' custom 1
'z = z + SIN(y / 1.5) * COS(x / 1.5) / 1.5      ' custom 2
'z = z + INT(SIN(1.5 * x * SIN(tm / 10))) * 3   ' custom 3
'z = z - INT(v / 5) * 3 + 3                     ' custom 4
'z = z + 3 * ((-INT((x - .3) / 20) * INT((23 + x - ABS(y * 1.2)) / 15)) + -INT(-y / 20) * -INT(-x / 20) * INT(-((x - 2) * (x - 2) + (y * 1.2 - 4) * (y * 1.2 - 4)) / 2000 + 1.01) + -INT(y / 20) * -INT(-x / 20) * INT(-((x - 2) * (x - 2) + (y * 1.2 + 4) * (y * 1.2 + 4)) / 2000 + 1.01)) ' heart


END SUB