' 3D text
' made by Svjatoslav Agejenko
' in 2003.12
' H-Page: svjatoslav.eu
' E-Mail: svjatoslavagejenko@gmail.com
 
DECLARE SUB prn (x!, y!, a$)
DECLARE SUB pch (x!, y!, a$)
DECLARE SUB readfnt ()
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)
' kursor keys and to z, w - rotate
' <SPACE> - speed down
' q - quit

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 myx, myy, myz, mye, myk
DIM SHARED tpx(0 TO 10, 0 TO 255)
DIM SHARED tpy(0 TO 10, 0 TO 255)
DIM SHARED tl1(0 TO 10, 0 TO 255)
DIM SHARED tl2(0 TO 10, 0 TO 255)

myx = 0
myy = 0
myz = -100



start

nait3d

SUB getcor

xn(nump + 1) = -150
yn(nump + 1) = -125
zn(nump + 1) = -200

xn(nump + 2) = 150
yn(nump + 2) = -125
zn(nump + 2) = -200

xn(nump + 3) = 150
yn(nump + 3) = 125
zn(nump + 3) = -200

xn(nump + 4) = -150
yn(nump + 4) = 125
zn(nump + 4) = -200


xn(nump + 5) = -150
yn(nump + 5) = -125
zn(nump + 5) = 200

xn(nump + 6) = 150
yn(nump + 6) = -125
zn(nump + 6) = 200

xn(nump + 7) = 150
yn(nump + 7) = 125
zn(nump + 7) = 200

xn(nump + 8) = -150
yn(nump + 8) = 125
zn(nump + 8) = 200


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

point1(numl + 2) = nump + 2
point2(numl + 2) = nump + 3

point1(numl + 3) = nump + 3
point2(numl + 3) = nump + 4

point1(numl + 4) = nump + 4
point2(numl + 4) = nump + 1

point1(numl + 5) = nump + 5
point2(numl + 5) = nump + 6

point1(numl + 6) = nump + 6
point2(numl + 6) = nump + 7

point1(numl + 7) = nump + 7
point2(numl + 7) = nump + 8

point1(numl + 8) = nump + 8
point2(numl + 8) = nump + 5

point1(numl + 9) = nump + 5
point2(numl + 9) = nump + 1

point1(numl + 10) = nump + 6
point2(numl + 10) = nump + 2

point1(numl + 11) = nump + 7
point2(numl + 11) = nump + 3

point1(numl + 12) = nump + 8
point2(numl + 12) = nump + 4

nump = nump + 8
numl = numl + 12




xn(nump + 1) = -150
yn(nump + 1) = -125 + 201
zn(nump + 1) = 0

xn(nump + 2) = -150
yn(nump + 2) = -125 + 201
zn(nump + 2) = 89

xn(nump + 3) = -150
yn(nump + 3) = -125
zn(nump + 3) = 89

xn(nump + 4) = -150
yn(nump + 4) = -125
zn(nump + 4) = 0

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

point1(numl + 2) = nump + 2
point2(numl + 2) = nump + 3

point1(numl + 3) = nump + 3
point2(numl + 3) = nump + 4

point1(numl + 4) = nump + 4
point2(numl + 4) = nump + 1

nump = nump + 4
numl = numl + 4



prn 0, 0, "three dimensional "
prn 0, -3, "text example"
prn 0, -6, "etc etc etc"



END SUB

SUB kuus (x, y, z, s)

b = 0
f = .3925
FOR a = 0 + f TO 6 + f STEP 6.28 / 8
x1 = SIN(a) * s
y1 = COS(a) * s
b = b + 1

xn(nump + b) = x1 + x
yn(nump + b) = y
zn(nump + b) = y1 + z

NEXT a

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

point1(numl + 2) = nump + 2
point2(numl + 2) = nump + 3
col(numl + 2) = 12

point1(numl + 3) = nump + 3
point2(numl + 3) = nump + 4
col(numl + 3) = 12

point1(numl + 4) = nump + 4
point2(numl + 4) = nump + 5
col(numl + 4) = 12

point1(numl + 5) = nump + 5
point2(numl + 5) = nump + 6
col(numl + 5) = 12


point1(numl + 6) = nump + 6
point2(numl + 6) = nump + 7
col(numl + 6) = 12

point1(numl + 7) = nump + 7
point2(numl + 7) = nump + 8
col(numl + 7) = 12

point1(numl + 8) = nump + 8
point2(numl + 8) = nump + 1
col(numl + 8) = 12

nump = nump + b
numl = numl + 8
'LOCATE 1, 1
'PRINT b




END SUB

SUB nait3d

1

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

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 - 1

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

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

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

CASE "+"
myy = myy + 3

CASE "-"
myy = myy - 3

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

CASE "q"
SYSTEM

CASE CHR$(27)
SYSTEM

END SELECT
END IF

GOTO 1
END SUB

SUB pch (x, y, a$)


b = ASC(a$)
up = 0
ul = 0

FOR c = 0 TO 100
IF tpx(c, b) = 999 THEN GOTO 4
up = up + 1
xn(nump + up) = x + tpx(c, b)
yn(nump + up) = y - tpy(c, b)
zn(nump + up) = 0
NEXT c
4

FOR c = 0 TO 100
IF tl1(c, b) = 999 THEN GOTO 5
ul = ul + 1
point1(numl + ul) = tl1(c, b) + nump + 1
point2(numl + ul) = tl2(c, b) + nump + 1
col(numl + ul) = 4
NEXT c
5



nump = nump + up
numl = numl + ul


END SUB

SUB porand

FOR x = -100 TO 0 STEP 12.067 + .3
FOR z = -100 TO 0 STEP 12.067 + .3
kuus x, -125, z, 6.53
ruut x + 6.033 + .15, -125, z + 6.033 + .15, 3.111 + .3
NEXT z
NEXT x

FOR y = -100 TO 0 STEP 20.3
FOR x = -100 TO 0 STEP 20.3
ruut2 x, y, 200, 10
NEXT x
NEXT y


END SUB

SUB prn (x, y, a$)

FOR b = 1 TO LEN(a$)
c$ = RIGHT$(LEFT$(a$, b), 1)
pch x + b * 3, y, c$
NEXT b
END SUB

SUB readfnt
OPEN "font.dat" FOR INPUT AS #1
3
IF EOF(1) <> 0 THEN GOTO 2
LINE INPUT #1, a$
IF LEFT$(a$, 1) = "#" THEN
chr = ASC(RIGHT$(LEFT$(a$, 3), 1))
pp = 0
lp = 0
END IF
IF LEFT$(a$, 1) = "p" THEN
tpx(pp, chr) = VAL(RIGHT$(LEFT$(a$, 3), 1))
tpy(pp, chr) = VAL(RIGHT$(LEFT$(a$, 5), 1))
pp = pp + 1
END IF
IF LEFT$(a$, 1) = "l" THEN
tl1(lp, chr) = VAL(RIGHT$(LEFT$(a$, 3), 1))
tl2(lp, chr) = VAL(RIGHT$(LEFT$(a$, 5), 1))
lp = lp + 1
END IF

GOTO 3
2
CLOSE #1


END SUB

SUB ruut (x, y, z, s)
xn(nump + 1) = x
yn(nump + 1) = y
zn(nump + 1) = z + s

xn(nump + 2) = x + s
yn(nump + 2) = y
zn(nump + 2) = z

xn(nump + 3) = x
yn(nump + 3) = y
zn(nump + 3) = z - s

xn(nump + 4) = x - s
yn(nump + 4) = y
zn(nump + 4) = z

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

point1(numl + 2) = nump + 2
point2(numl + 2) = nump + 3
col(numl + 2) = 10

point1(numl + 3) = nump + 3
point2(numl + 3) = nump + 4
col(numl + 3) = 10

point1(numl + 4) = nump + 4
point2(numl + 4) = nump + 1
col(numl + 4) = 10

nump = nump + 4
numl = numl + 4
END SUB

SUB ruut2 (x, y, z, s)
xn(nump + 1) = x - s
yn(nump + 1) = y - s
zn(nump + 1) = z

xn(nump + 2) = x + s
yn(nump + 2) = y - s
zn(nump + 2) = z

xn(nump + 3) = x + s
yn(nump + 3) = y + s
zn(nump + 3) = z

xn(nump + 4) = x - s
yn(nump + 4) = y + s
zn(nump + 4) = z

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

point1(numl + 2) = nump + 2
point2(numl + 2) = nump + 3
col(numl + 2) = 14

point1(numl + 3) = nump + 3
point2(numl + 3) = nump + 4
col(numl + 3) = 14

point1(numl + 4) = nump + 4
point2(numl + 4) = nump + 1
col(numl + 4) = 14

nump = nump + 4
numl = numl + 4

END SUB

SUB start
SCREEN 12
CLS

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

nump = 0
numl = 0
FOR a = 0 TO 255
FOR b = 0 TO 10
tpx(b, a) = 999
tpy(b, a) = 999
tl1(b, a) = 999
tl2(b, a) = 999
NEXT b
NEXT a


readfnt
getcor

END SUB