It seems to me, that everything is falling from space to my head... :-D
TYPE ver
X AS SINGLE ' point position X in basic view
Y AS SINGLE ' Y
Z AS SINGLE ' Z
PiXY AS SINGLE 'start vector angle X/Y (JK!)
PiXZ AS SINGLE ' X/Z
PiYZ AS SINGLE ' Y/Z
Wx AS SINGLE ' working coordinate X (after rotation)
Wy AS SINGLE ' Y
Wz AS SINGLE ' Z
Rx AS SINGLE '3d radius. Is the same for all axis in block, block is symetric.
Cx AS SINGLE 'object rotation center X
Cy AS SINGLE ' Y
Cz AS SINGLE ' Z
END TYPE
TYPE K
start AS LONG
konec AS LONG
rotspeed AS SINGLE 'not used
deltaX AS SINGLE
deltaY AS SINGLE
deltaZ AS SINGLE
v AS ver
texture AS LONG
END TYPE
REDIM SHARED K(0) AS ver 'vertexes array
REDIM SHARED Soupis(0) AS K 'pointers array
DIM SHARED image(6) AS LONG 'textures array
image(0) = cimg&
image(1) = Hload("whiteball.png")
image(2) = Hload("papir.jpg")
image(3) = Hload("cihl_zed.jpg")
image(4) = Hload("dlaz2.jpg")
image(5) = Hload("14321.jpg")
image(6) = Hload("14324.jpg")
DIM SHARED TK(1000, 1000)
Insert_Text "QB64!"
FOR o = 164 TO UBOUND(tk, 1)
RANDOMIZE TIMER
IF RND * 10 > 6 THEN s = 1 ELSE s = -1
IF RND * 10 > 6 THEN t = 1 ELSE t = -1
TK(o, 0) = init_K(RND * t, RND * s, -100 - RND * 100)
RANDOMIZE TIMER
TK(0, o) = INT(1 + RND * 2.5)
NEXT o
image = _LOADIMAGE("space.jpg", 32)
SCREEN _NEWIMAGE(1024, 768, 32)
_PUTIMAGE , image
DO
f = f + .1
FOR d = 0 TO UBOUND(tk, 1)
SELECT CASE TK(0, d)
CASE 1: RotoYZ TK(d, 0), f
CASE 2: RotoXZ TK(d, 0), f
CASE 3: RotoXY TK(d, 0), f
END SELECT
Draw_k TK(d, 0)
uberZ d
NEXT d
_DISPLAY
_LIMIT 30
LOOP
SUB uberZ (nr AS LONG)
u = Soupis(nr).start
dcx = Soupis(nr).deltaX
dcy = Soupis(nr).deltaY
dcz = Soupis(nr).deltaZ
Reset_k u, K(u).Cx + dcx, K(u).Cy + dcy, (K(u).Cz + dcz)
IF K(u).Cz > 100 THEN
RANDOMIZE TIMER
IF RND * 10 > 6 THEN s = 1 ELSE s = -1
IF RND * 10 > 6 THEN t = 1 ELSE t = -1
Reset_k u, RND * 5 * s, RND * 5 * t, -100 - RND * 100
END IF
END SUB
SUB RotoXZ (record AS LONG, angle AS SINGLE)
r = Soupis(record).start
re = Soupis(record).konec
FOR s = r TO re
K(s).Wx = K(s).Cx + SIN(K(s).PiXZ + angle) * K(s).Rx
K(s).Wz = K(s).Cz + COS(K(s).PiXZ + angle) * K(s).Rx
NEXT s
END SUB
SUB RotoYZ (record AS LONG, angle AS SINGLE)
r = Soupis(record).start
re = Soupis(record).konec
FOR s = r TO re
K(s).Wy = K(s).Cy + SIN(K(s).PiYZ + angle) * K(s).Rx
K(s).Wz = K(s).Cz + COS(K(s).PiYZ + angle) * K(s).Rx
NEXT s
END SUB
SUB RotoXY (record AS LONG, angle AS SINGLE)
r = Soupis(record).start
re = Soupis(record).konec
FOR s = r TO re
K(s).Wx = K(s).Cx + SIN(K(s).PiXY + angle) * K(s).Rx
K(s).Wy = K(s).Cy + COS(K(s).PiXY + angle) * K(s).Rx
NEXT s
END SUB
SUB Draw_k (record AS LONG)
S = Soupis(record).start
konec = Soupis(record).konec
texture = image(Soupis(record).texture)
W = _WIDTH(texture)
H = _HEIGHT(texture)
FOR s2 = S TO konec STEP 4 'to by melo vykreslit vse najednou
_MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(K(s2).Wx, K(s2).Wy, K(s2).Wz)-(K(s2 + 1).Wx, K(s2 + 1).Wy, K(s2 + 1).Wz)-(K(s2 + 2).Wx, K(s2 + 2).Wy, K(s2 + 2).Wz)
_MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(K(s2 + 1).Wx, K(s2 + 1).Wy, K(s2 + 1).Wz)-(K(s2 + 2).Wx, K(s2 + 2).Wy, K(s2 + 2).Wz)-(K(s2 + 3).Wx, K(s2 + 3).Wy, K(s2 + 3).Wz)
NEXT
_MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(K(0 + S).Wx, K(0 + S).Wy, K(0 + S).Wz)-(K(4 + S).Wx, K(4 + S).Wy, K(4 + S).Wz)-(K(2 + S).Wx, K(2 + S).Wy, K(2 + S).Wz)
_MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(K(4 + S).Wx, K(4 + S).Wy, K(4 + S).Wz)-(K(2 + S).Wx, K(2 + S).Wy, K(2 + S).Wz)-(K(6 + S).Wx, K(6 + S).Wy, K(6 + S).Wz)
_MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(K(1 + S).Wx, K(1 + S).Wy, K(1 + S).Wz)-(K(5 + S).Wx, K(5 + S).Wy, K(5 + S).Wz)-(K(3 + S).Wx, K(3 + S).Wy, K(3 + S).Wz)
_MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(K(5 + S).Wx, K(5 + S).Wy, K(5 + S).Wz)-(K(3 + S).Wx, K(3 + S).Wy, K(3 + S).Wz)-(K(7 + S).Wx, K(7 + S).Wy, K(7 + S).Wz)
_MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(K(4 + S).Wx, K(4 + S).Wy, K(4 + S).Wz)-(K(5 + S).Wx, K(5 + S).Wy, K(5 + S).Wz)-(K(0 + S).Wx, K(0 + S).Wy, K(0 + S).Wz)
_MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(K(5 + S).Wx, K(5 + S).Wy, K(5 + S).Wz)-(K(0 + S).Wx, K(0 + S).Wy, K(0 + S).Wz)-(K(1 + S).Wx, K(1 + S).Wy, K(1 + S).Wz)
_MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(K(6 + S).Wx, K(6 + S).Wy, K(6 + S).Wz)-(K(7 + S).Wx, K(7 + S).Wy, K(7 + S).Wz)-(K(2 + S).Wx, K(2 + S).Wy, K(2 + S).Wz)
_MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(K(7 + S).Wx, K(7 + S).Wy, K(7 + S).Wz)-(K(2 + S).Wx, K(2 + S).Wy, K(2 + S).Wz)-(K(3 + S).Wx, K(3 + S).Wy, K(3 + S).Wz)
'see to scatch in init_K for view how it is done
END SUB
SUB Reset_k (u, cx, cy, cz)
K(u).X = cx - .5
K(u).Y = cy + .5
K(u).Z = cz - .5
K(u).PiXY = JK(cx, cy, K(u).X, K(u).Y, K(u).Rx)
K(u).PiXZ = JK(cx, cz, K(u).X, K(u).Z, K(u).Rx)
K(u).PiYZ = JK(cy, cz, K(u).Y, K(u).Z, K(u).Rx)
K(u + 1).X = cx + .5
K(u + 1).Y = cy + .5
K(u + 1).Z = cz - .5
K(u + 1).PiXY = JK(cx, cy, K(u + 1).X, K(u + 1).Y, K(u + 1).Rx)
K(u + 1).PiXZ = JK(cx, cz, K(u + 1).X, K(u + 1).Z, K(u + 1).Rx)
K(u + 1).PiYZ = JK(cy, cz, K(u + 1).Y, K(u + 1).Z, K(u + 1).Rx)
K(u + 2).X = cx - .5
K(u + 2).Y = cy - .5
K(u + 2).Z = cz - .5
K(u + 2).PiXY = JK(cx, cy, K(u + 2).X, K(u + 2).Y, K(u + 2).Rx)
K(u + 2).PiXZ = JK(cx, cz, K(u + 2).X, K(u + 2).Z, K(u + 2).Rx)
K(u + 2).PiYZ = JK(cy, cz, K(u + 2).Y, K(u + 2).Z, K(u + 2).Rx)
K(u + 3).X = cx + .5
K(u + 3).Y = cy - .5
K(u + 3).Z = cz - .5
K(u + 3).PiXY = JK(cx, cy, K(u + 3).X, K(u + 3).Y, K(u + 3).Rx)
K(u + 3).PiXZ = JK(cx, cz, K(u + 3).X, K(u + 3).Z, K(u + 3).Rx)
K(u + 3).PiYZ = JK(cy, cz, K(u + 3).Y, K(u + 3).Z, K(u + 3).Rx)
K(u + 4).X = cx - .5
K(u + 4).Y = cy + .5
K(u + 4).Z = cz + .5
K(u + 4).PiXY = JK(cx, cy, K(u + 4).X, K(u + 4).Y, K(u + 4).Rx)
K(u + 4).PiXZ = JK(cx, cz, K(u + 4).X, K(u + 4).Z, K(u + 4).Rx)
K(u + 4).PiYZ = JK(cy, cz, K(u + 4).Y, K(u + 4).Z, K(u + 4).Rx)
K(u + 5).X = cx + .5
K(u + 5).Y = cy + .5
K(u + 5).Z = cz + .5
K(u + 5).PiXY = JK(cx, cy, K(u + 5).X, K(u + 5).Y, K(u + 5).Rx)
K(u + 5).PiXZ = JK(cx, cz, K(u + 5).X, K(u + 5).Z, K(u + 5).Rx)
K(u + 5).PiYZ = JK(cy, cz, K(u + 5).Y, K(u + 5).Z, K(u + 5).Rx)
K(u + 6).X = cx - .5
K(u + 6).Y = cy - .5
K(u + 6).Z = cz + .5
K(u + 6).PiXY = JK(cx, cy, K(u + 6).X, K(u + 6).Y, K(u + 6).Rx)
K(u + 6).PiXZ = JK(cx, cz, K(u + 6).X, K(u + 6).Z, K(u + 6).Rx)
K(u + 6).PiYZ = JK(cy, cz, K(u + 6).Y, K(u + 6).Z, K(u + 6).Rx)
K(u + 7).X = cx + .5
K(u + 7).Y = cy - .5
K(u + 7).Z = cz + .5
K(u + 7).PiXY = JK(cx, cy, K(u + 7).X, K(u + 7).Y, K(u + 7).Rx)
K(u + 7).PiXZ = JK(cx, cz, K(u + 7).X, K(u + 7).Z, K(u + 7).Rx)
K(u + 7).PiYZ = JK(cy, cz, K(u + 7).Y, K(u + 7).Z, K(u + 7).Rx)
FOR n = u TO u + 7
K(n).Cx = cx
K(n).Cy = cy
K(n).Cz = cz
NEXT n
END SUB
FUNCTION init_K (cx, cy, cz)
' 0,4 1,5 'numbers are indexes used in Draw_k
' A,E B,F
'
'
' cx,cy,cz
' 2,6 3,7
' C,G D,H
'
'
'
u = UBOUND(k)
REDIM _PRESERVE K(u + 8) AS ver
u2 = UBOUND(soupis)
init_K = u2
Soupis(u2).start = u
Soupis(u2).konec = u + 7
Soupis(u2).rotspeed = (10 + RND * 100) / 80
Soupis(u2).deltaX = .01 + RND / 100
RANDOMIZE TIMER
Soupis(u2).deltaY = .01 + RND / 100
Soupis(u2).deltaZ = .3 + RND / 10
Soupis(u2).texture = RND * 6
IF RND * 10 < 5 THEN Soupis(u2).deltaX = Soupis(u2).deltaX ELSE Soupis(u2).deltaX = Soupis(u2).deltaX * -1
IF RND * 10 < 5 THEN Soupis(u2).deltaY = Soupis(u2).deltaY ELSE Soupis(u2).deltaY = Soupis(u2).deltaY * -1
REDIM _PRESERVE Soupis(u2 + 1) AS K
FOR n = u TO u + 7
K(n).Cx = cx
K(n).Cy = cy
K(n).Cz = cz
NEXT n
'-----------------------
FOR e = u TO u + 7
K(e).Wx = K(e).X
K(e).Wy = K(e).Y
K(e).Wz = K(e).Z
K(e).Rx = SQR((.5 ^ 2) + (.5 ^ 2))
NEXT e
K(u).X = cx - .5
K(u).Y = cy + .5
K(u).Z = cz - .5
K(u).PiXY = JK(cx, cy, K(u).X, K(u).Y, K(u).Rx)
K(u).PiXZ = JK(cx, cz, K(u).X, K(u).Z, K(u).Rx)
K(u).PiYZ = JK(cy, cz, K(u).Y, K(u).Z, K(u).Rx)
K(u + 1).X = cx + .5
K(u + 1).Y = cy + .5
K(u + 1).Z = cz - .5
K(u + 1).PiXY = JK(cx, cy, K(u + 1).X, K(u + 1).Y, K(u + 1).Rx)
K(u + 1).PiXZ = JK(cx, cz, K(u + 1).X, K(u + 1).Z, K(u + 1).Rx)
K(u + 1).PiYZ = JK(cy, cz, K(u + 1).Y, K(u + 1).Z, K(u + 1).Rx)
K(u + 2).X = cx - .5
K(u + 2).Y = cy - .5
K(u + 2).Z = cz - .5
K(u + 2).PiXY = JK(cx, cy, K(u + 2).X, K(u + 2).Y, K(u + 2).Rx)
K(u + 2).PiXZ = JK(cx, cz, K(u + 2).X, K(u + 2).Z, K(u + 2).Rx)
K(u + 2).PiYZ = JK(cy, cz, K(u + 2).Y, K(u + 2).Z, K(u + 2).Rx)
K(u + 3).X = cx + .5
K(u + 3).Y = cy - .5
K(u + 3).Z = cz - .5
K(u + 3).PiXY = JK(cx, cy, K(u + 3).X, K(u + 3).Y, K(u + 3).Rx)
K(u + 3).PiXZ = JK(cx, cz, K(u + 3).X, K(u + 3).Z, K(u + 3).Rx)
K(u + 3).PiYZ = JK(cy, cz, K(u + 3).Y, K(u + 3).Z, K(u + 3).Rx)
K(u + 4).X = cx - .5
K(u + 4).Y = cy + .5
K(u + 4).Z = cz + .5
K(u + 4).PiXY = JK(cx, cy, K(u + 4).X, K(u + 4).Y, K(u + 4).Rx)
K(u + 4).PiXZ = JK(cx, cz, K(u + 4).X, K(u + 4).Z, K(u + 4).Rx)
K(u + 4).PiYZ = JK(cy, cz, K(u + 4).Y, K(u + 4).Z, K(u + 4).Rx)
K(u + 5).X = cx + .5
K(u + 5).Y = cy + .5
K(u + 5).Z = cz + .5
K(u + 5).PiXY = JK(cx, cy, K(u + 5).X, K(u + 5).Y, K(u + 5).Rx)
K(u + 5).PiXZ = JK(cx, cz, K(u + 5).X, K(u + 5).Z, K(u + 5).Rx)
K(u + 5).PiYZ = JK(cy, cz, K(u + 5).Y, K(u + 5).Z, K(u + 5).Rx)
K(u + 6).X = cx - .5
K(u + 6).Y = cy - .5
K(u + 6).Z = cz + .5
K(u + 6).PiXY = JK(cx, cy, K(u + 6).X, K(u + 6).Y, K(u + 6).Rx)
K(u + 6).PiXZ = JK(cx, cz, K(u + 6).X, K(u + 6).Z, K(u + 6).Rx)
K(u + 6).PiYZ = JK(cy, cz, K(u + 6).Y, K(u + 6).Z, K(u + 6).Rx)
K(u + 7).X = cx + .5
K(u + 7).Y = cy - .5
K(u + 7).Z = cz + .5
K(u + 7).PiXY = JK(cx, cy, K(u + 7).X, K(u + 7).Y, K(u + 7).Rx)
K(u + 7).PiXZ = JK(cx, cz, K(u + 7).X, K(u + 7).Z, K(u + 7).Rx)
K(u + 7).PiYZ = JK(cy, cz, K(u + 7).Y, K(u + 7).Z, K(u + 7).Rx)
FOR e = u TO u + 7
K(e).Wx = K(e).X
K(e).Wy = K(e).Y
K(e).Wz = K(e).Z
NEXT e
END SUB
FUNCTION JK! (cx, cy, px, py, R!)
LenX! = cx - px
LenY! = cy - py
jR! = 1 / R!
jX! = LenX! * jR!
jY! = LenY! * jR!
sinusAlfa! = jX!
Alfa! = ABS(_ASIN(sinusAlfa!))
Q = 1
IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
IF px >= cx AND py <= cy THEN Q = 2
IF px <= cx AND py <= cy THEN Q = 3
IF px <= cx AND py >= cy THEN Q = 4
SELECT CASE Q
CASE 1: alfaB! = Alfa!
CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
CASE 3: alfaB! = _PI + Alfa!
CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
END SELECT
JK! = alfaB!
IF JK! = 0 THEN BEEP
END FUNCTION
FUNCTION cimg&
cimgs& = _NEWIMAGE(320, 320, 32)
a = _DEST
_DEST cimgs&
FOR s = 5 TO 0 STEP -1
LINE (5 - s, 5 - s)-(315 + s, 315 + s), &HFFFFFFFF, B
NEXT s
LINE (5, 5)-(315, 315), &H00000000, BF
_DEST a
cimg& = _COPYIMAGE(cimgs&, 33)
_FREEIMAGE cimgs&
END FUNCTION
SUB Insert_Text (t AS STRING)
TYPE v2
x AS SINGLE
y AS SINGLE
END TYPE
REDIM v2(0) AS v2
virt = _NEWIMAGE(800, 130, 256)
a = _DEST
_DEST virt
_PRINTMODE _KEEPBACKGROUND
COLOR 15
PRINT t$
FOR y = 0 TO 16
FOR x = 0 TO LEN(t) * 8
_SOURCE virt
IF POINT(x, y) THEN
v2(i).x = ((-LEN(t) * 4) + x) / 2
v2(i).y = (8 - y) / 2
i = i + 1
REDIM _PRESERVE v2(i) AS v2
END IF
NEXT x, y
p = LBOUND(tk, 1) + i - 1
styl = 1 + INT(RND * 2)
z = -50 - RND * 100
dz = 1.6
FOR ita = 0 TO p
TK(ita, 0) = init_K(v2(j).x, v2(j).y, z)
_DEST 0
Soupis(ita).texture = 3
Soupis(ita).deltaZ = .5
TK(0, ita) = 1
j = j + 1
NEXT
ERASE v2
END SUB
FUNCTION Hload (img AS STRING)
v = _LOADIMAGE(img, 32)
Hload = _COPYIMAGE(v, 33)
_FREEIMAGE v
END FUNCTION
Found and repaired bug it BAS file. BAS file in ZIP is NOT repaired! [SUB Draw_k - Texture Width and Texture Height was call before texture is loaded. Repaired]