QB64.org Forum
Active Forums => Programs => Topic started by: Petr on July 03, 2019, 04:32:45 pm
-
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]
-
Hi Petr,
Why are you throwing bricks at us? :)
-
Cool! I like it! Also, I got injured by the bricks. :D
-
I zink ve need a new vector, Victor. Ve ist ploomiting through ze masonry...
-
Hi Petr. I am getting an invalid handle error (line 397) when I run this. I am using QB64 ver 3.1
Any ideas what I'm doing wrong?
edit: oops! ver 1.3 - I am not from the future.
-
Hi. Check if you have the OUTPUT EXE TO SOURCE FOLDER option selected in the RUN menu, then, if is this selected and BAS file and all others files from ZIP file are in the same folder, click to code, press spacebar and try runing it again.
-
Fantastic! Thanks for that info.
Awesome demo, man. Makes my ASCII games look silly lol
-
edit: oops! ver 1.3 - I am not from the future.
:D Welcome back! glad you could join us here in the past :)
-
Very Cool Petr.
Synchronicity:
Just yesterday my son brings me to play with the bricks of a squared world that now is of Microsoft property. :-)
-
Awesome program Petr! With that kind of stuff someone could make a cool little 3D maze game.
-
Hey! Where are the Klingons? I do not see any Klingons!
Wait a minute.... Oh. I see.... Stoned Borg from the 70's... Cool
-
The Federation last reported Klingons on Uranus.
- Kirk out
-
The Federation last reported Klingons on Uranus.
- Kirk out
They now make a lotion for that.
-
Federation H?
Pete
-
SierraKen wrote:
Awesome program Petr! With that kind of stuff someone could make a cool little 3D maze game.
Hi. Yes. I'm working on it. Unfortunately, I've been doing this for a long time, far longer than I imagined at the beginning. So far I have a finished editor that can only build walls, floors and ceilings and put music in the rooms. The editor generates its own binary files named with the extension .MAP, this is my other custom format. The program that loads this map and then lets you walk in the maze I also have written .... but it still can not start music in the room. Where did I get stuck? The rooms are empty. I need to insert objects into the rooms. I'm solving this slowly. But when I write that slowly, it really means LONG slowly. I had to deal with what elements they would see and which they didn't, that I solved, but not as perfectly as STxAxTIC. Spatial mathematics (and now BPlus has shown me that even 2D mathematics) is not my strong point at all. Here's one room, it's a great-grandfather of a program that I now write:
https://www.qb64.org/forum/index.php?topic=300.msg102191#msg102191
For a more precise description, the object file I want to include must contain:
First, head to identify that this is the correct file format, keep detailed records (number of textures, sounds, vertices)
1) position on map
2) the number of individual object vertices
3) number of textures
4) texture names
5) record of binary data length of individual textures (to extract from object file)
6) if the object is to emit sound, this sound
7) if a sound effect is to be created, then its number
8) Position record (if the object is rotated, how many degrees in what axis)
9) special properties. For example, a door type object is passable for a limited period of time, a chair type object can be moved.
all this must be able to accept and process the main program. It's a lot of work for a long time.
I think, some next program with ROOM suppport mouse in both axis (and X/Y rotation from keyboard).
-
But someone could do a program like Lotus. I still think about it, but I don't have time, I have a lot of ideas, so for 3 lives...
-
That room you did awhile back is INCREDIBLE! That's probably 10 steps more than what I know how to do. Lately I've been thinking about an old 90's program someone posted on comp.lang.basic.misc that was a ray-traced 3D maze where you could walk through, although it was never finished. There was no texture of course, just lines. Last night I was thinking of a way I could possibly do something like that using sort of the same 2D maps I've been making except instead of drawing the map, re-create it in 3D as you walk through it in 2D with the variables. I might attempt it sometime. I'm really surprised QB64 can do what you are making. I tried a 3D star field the other day and the most stars that would flow smoothly at one time was only 2. But I know it must have been the way I made it because I do have someone else's QBasic star field that has a large amount of stars at once. I think mine just had too many loops. That's the thing with BASIC languages I think, since it's top to bottom, it can get snagged up on loops. And that might be why you can't hear music as you are walking through your maze, although I have never used the mp3 feature yet.