Author Topic: MAPTRIANGLE in 3D  (Read 817 times)

Offline Petr

  • I am instructed.
Re: MAPTRIANGLE in 3D: textured roller or cone
« Reply #15 on: November 27, 2018, 06:06:50 PM »
Hi.

In sample examples, textured blocks are already available. I was thinking about how to make a textured cylinder. Finally, the program can handle both a textured disk, a cylinder and a cone. The number of cone sides is determined by the Segments variable in the program. The higher Segments is, the body is finer and the texture is more faithful (and the program more demanding). The variables in the Celo0 and Celo1 fields contain the values ​​of the vertices of the individual triangles in the sense of rotation (because the object is a rotating body), celo0 is one untextured side of the cylinder, the cello1 is the second untextured side of the cylinder (bottom). Use the 1,2 keys to change the speed or direction of rotation, 3,4 to move the face to the X axis, 5,6 to move the Y axis, 7,8 to move the X axis to the second bottom, 9, Q to shift the Y axis of the second end, W, E for changing the diameter of the cylinder face, R, T for changing the diameter of the second face of the cylinder, A, S for the zoom, D, F for displacement in the Z axis of the first face, and G, H for the Z axis cell. A beautiful effect can be achieved by using the Stars image by Johnno56. I have one question for developers - why is this happening:

Use the T / R or W / E key to open the cone so that it is a hollow cylinder. Press C. This will enable the _CLOCKWISE parameter. The picture then has a lot of noise. Now close the cylinder (do the cone) (one radius is set to zero), the noise disappears. Why?


Code: [Select]
SCREEN _NEWIMAGE(800, 600, 32)

TYPE crc
    x AS SINGLE
    y AS SINGLE
END TYPE

DIM SHARED Segments, R1, R2, Z1, Z2, Efect, OldX, OldY

'Warning! Segments variable muss be dividible by 2!
Segments = 314: R1 = .1: R2 = 2: Z1 = -1: Z2 = -2
im = _LOADIMAGE("abcde 066.jpg", 32)

restart:
REDIM s(Segments + 1) AS LONG, celo0(Segments + 1) AS crc, celo1(Segments + 1) AS crc

divideimage s(), im
SETCelo R1, celo0()
SETCelo R2, celo1()
S = Segments
rd = .01
PrintIT = 1
DO
    Quad celo0(1).x, celo0(1).y, Z1, celo0(S).x, celo0(S).y, Z1, celo1(1).x, celo1(1).y, Z2, celo1(S).x, celo1(S).y, Z2, s(1)
    FOR d = 2 TO Segments
        Quad celo0(d - 1).x, celo0(d - 1).y, Z1, celo0(d).x, celo0(d).y, Z1, celo1(d - 1).x, celo1(d - 1).y, Z2, celo1(d).x, celo1(d).y, Z2, s(d)
    NEXT d


    i$ = INKEY$

    SELECT CASE UCASE$(i$)
        CASE "1": rd = rd + .001
        CASE "2": rd = rd - .001
        CASE "3": c0x = c0x + .01
        CASE "4": c0x = c0x - .01
        CASE "5": c0y = c0y + .01
        CASE "6": c0y = c0y - .01

        CASE "7": c1x = c1x + .01
        CASE "8": c1x = c1x - .01
        CASE "9": c1y = c1y + .01
        CASE "Q": c1y = c1y - .01

        CASE "W": R1 = R1 - .01: SETCelo R1, celo0()
        CASE "E": R1 = R1 + .01: SETCelo R1, celo0()
        CASE "R": R2 = R2 - .01: SETCelo R2, celo1()
        CASE "T": R2 = R2 + .01: SETCelo R2, celo1()


        CASE "A": Z1 = Z1 + .01: Z2 = Z2 + .01
        CASE "S": Z1 = Z1 - .01: Z2 = Z2 - .01

        CASE "D": Z1 = Z1 + .01
        CASE "F": Z1 = Z1 - .01

        CASE "G": Z2 = Z2 + .01
        CASE "H": Z2 = Z2 - .01

        CASE "C": IF Efect = 0 THEN Efect = 1 ELSE Efect = 0: _DELAY .2
        CASE CHR$(27):
            FOR freemem = 1 TO Segments
                _FREEIMAGE s(freemem)
            NEXT
            SYSTEM

    END SELECT


    i = 0: rot = rot + rd


    FOR f = 360 / Segments TO 360 STEP (360 / Segments)
        i = i + 1
        rad = _D2R(f)
        celo0(i).x = SIN(rad + rot) * R1 + c0x
        celo0(i).y = COS(rad + rot) * R1 + c0y

        celo1(i).x = SIN(rad + rot) * R2 + c1x
        celo1(i).y = COS(rad + rot) * R2 + c1y


    NEXT

    IF PrintIT THEN
        LOCATE 1
        _DISPLAYORDER _HARDWARE , _SOFTWARE
        _PRINTMODE _KEEPBACKGROUND
        PRINT "Press 1,2 for rotation, 3,4 for radius 1 X pos, 5,6 for radius 1 Y pos, 7,8 for radius 2 X pos, 9,Q for radius 2 Y pos, W,E for radius 1, R,T for radius 2, A,S for zoom, D,F for depth 1, G,H for depth 2"
        PRINT "Segments in use: "; Segments
        PrintIT = 0
    END IF

    _DISPLAY
    _LIMIT 55
LOOP


SUB SETCelo (radius AS INTEGER, arr() AS crc)
    FOR f = 0 TO 360 STEP (360 / Segments)
        i = i + 1
        rad = _D2R(f)
        arr(i).x = SIN(rad) * radius
        arr(i).y = COS(rad) * radius
    NEXT
END SUB


SUB divideimage (s() AS LONG, source AS LONG) 'divide image to more images in X
    sir = _WIDTH(source) / UBOUND(S)
    FOR r = 0 TO Segments
        i = i + 1
        s(i) = _NEWIMAGE(sir, _HEIGHT(source), 32)
        _PUTIMAGE (0, 0)-(sir, _HEIGHT(source)), source, s(i), (sirka, 0)-(sirka + sir, _HEIGHT(source))
        s(i) = _COPYIMAGE(s(i), 33)
        sirka = sirka + sir
    NEXT r
END SUB

SUB Quad (dx1, dy1, dz1, dx2, dy2, dz2, dx3, dy3, dz3, dx4, dy4, dz4, imag&)
    W = _WIDTH(imag&)
    H = _HEIGHT(imag&)

    IF Efect THEN
        _MAPTRIANGLE _CLOCKWISE (0, 0)-(W, 0)-(0, H), imag& TO(dx1, dy1, dz1)-(dx2, dy2, dz2)-(dx3, dy3, dz3), 0
        _MAPTRIANGLE _CLOCKWISE (W, 0)-(0, H)-(W, H), imag& TO(dx2, dy2, dz2)-(dx3, dy3, dz3)-(dx4, dy4, dz4), 0
    ELSE
        _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), imag& TO(dx1, dy1, dz1)-(dx2, dy2, dz2)-(dx3, dy3, dz3), 0
        _MAPTRIANGLE (W, 0)-(0, H)-(W, H), imag& TO(dx2, dy2, dz2)-(dx3, dy3, dz3)-(dx4, dy4, dz4), 0
    END IF
END SUB
« Last Edit: November 27, 2018, 06:08:37 PM by Petr »

Offline Petr

  • I am instructed.
Re: MAPTRIANGLE in 3D - ROTATION
« Reply #16 on: January 06, 2019, 02:08:18 PM »
Hi. Next demo show rotation in 3D using MAPTRIANGLE 3D, none direct OpenGL statements.

Code: [Select]
_TITLE "Next MAPTRIANGLE 3D demo"

k = _PI(2) / 4

TYPE b
    x AS INTEGER
    y AS INTEGER
END TYPE

'------------
DIM SHARED texture AS LONG, rot
DIM i AS LONG, i2 AS LONG

TYPE T
    x AS SINGLE
    y AS SINGLE
    z AS SINGLE
END TYPE

DIM SHARED T(18 * 110) AS T

init
'---------------------



SCREEN _NEWIMAGE(800, 600, 32)
CLS , _RGB32(127, 127, 188)


DIM B(3) AS b


B(0).x = -1: B(0).y = -1
B(1).x = 1: B(1).y = -1
B(2).x = -1: B(2).y = -1
B(3).x = 1: B(3).y = -1

w = _WIDTH(i)
h = _HEIGHT(i)

DO
    IF i THEN _FREEIMAGE i
    j = _NEWIMAGE(150, 100, 32)
    _DEST j
    CLS , _RGBA32(0, 50, 127, 100)
    clock 0, 0
    _DEST 0

    i = _COPYIMAGE(j, 33)
    _FREEIMAGE j

    clock 0, 0

    texture& = i
    '--------------------

    FOR Ys = 0 TO 17
        zz2 = zz2 + .01
        FOR Xs = 0 TO 50
            IF T(i4).x > 0 THEN
                X = T(i4).x + 70
                Y = T(i4).y
                z = T(i4).z - 70
                kostka X - zz2, Y, z - 15 + zz2
            END IF
            i4 = i4 + 1
    NEXT Xs, Ys
    i4 = 0
    IF zz2 > 140 THEN zz2 = -50
    '-----------------------------


    Sx = (200 + 600) / 2: Rx = (600 - 200) / 2
    Sy = (400 + 200) / 2: Ry = (400 - 200) / 2
    rot = rot + .01

    Sx = 0
    Sz = -2.5
    Sy = -1


    Rx = 1
    Ry = -1
    Rz = 1
    ' info for rotation. To rotate the bodies, you must have all the points that are rotating in the same center. For this demo, it is easy to specify the radius of rotation,
    ' because all the points are just as far from the center as the cube is a symmetrical body. But if you want to write a 3D game, then if you want to write with MAPTRIANGLE,
    ' you need to map the floor using 4 triangles and calculate the radius for the points on the edges using the Pythagoras theorem:
    '
    '       A--------------------------B     x is your position, as you see, all points use different radius
    '       I\\\                   Y / I     Y is your triangle side 1, next is floor height - Y
    '       I   \\\\\\             Y/  I     X is your triangle side 2, next is floor width - X
    '       I          \\\\\\\\/// xXXXI     third sides calculate using Pythagoras.
    '       I       ////////////    \  I
    '       I //////                 \ I
    '       C--------------------------D
    '
    x1 = Sx + SIN(rot) * Rx: z1 = Sz + COS(rot) * Rz: y1R = Sy + SIN(rot) * Ry
    x2 = Sx + SIN(rot + k) * Rx: z2 = Sz + COS(rot + k) * Rz: y2R = Sy + SIN(rot + k) * Ry

    x4 = Sx + SIN((2 * k) + rot) * Rx: z4 = Sz + COS((2 * k) + rot) * Rz: y3R = Sy + SIN((3 * k) + rot) * Ry
    x3 = Sx + SIN((3 * k) + rot) * Rx: z3 = Sz + COS((3 * k) + rot) * Rz: y4R = Sy + SIN((4 * k) + rot) * Ry

    y1 = B(0).y
    y2 = B(1).y
    y4 = B(2).y
    y3 = B(3).y




    y5 = y1 + 1.5
    y6 = y2 + 1.5
    y7 = y3 + 1.5
    y8 = y4 + 1.5


    _MAPTRIANGLE (0, h)-(w, h)-(0, 0), i TO(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3) 'podlaha                 floor
    _MAPTRIANGLE (w, h)-(0, 0)-(w, 0), i TO(x2, y2, z2)-(x3, y3, z3)-(x4, y4, z4) 'podlaha


    _MAPTRIANGLE (0, h)-(w, h)-(0, 0), i TO(x1, y5, z1)-(x2, y6, z2)-(x3, y7, z3) 'strop                   roof
    _MAPTRIANGLE (w, h)-(0, 0)-(w, 0), i TO(x2, y6, z2)-(x3, y7, z3)-(x4, y8, z4) 'strop

    _MAPTRIANGLE (0, h)-(w, h)-(0, 0), i TO(x1, y1, z1)-(x2, y2, z2)-(x1, y5, z1) 'prava stena             right wall
    _MAPTRIANGLE (w, h)-(0, 0)-(w, 0), i TO(x2, y2, z2)-(x1, y5, z1)-(x2, y6, z2) 'prava stena


    _MAPTRIANGLE (w, h)-(0, h)-(w, 0), i TO(x3, y3, z3)-(x4, y4, z4)-(x3, y7, z3) 'leva stena              left wall
    _MAPTRIANGLE (0, h)-(w, 0)-(0, 0), i TO(x4, y4, z4)-(x3, y7, z3)-(x4, y8, z4) 'leva stena


    _MAPTRIANGLE (w, h)-(0, h)-(w, 0), i TO(x1, y1, z1)-(x3, y3, z3)-(x1, y5, z1) 'zadni stena             back wall
    _MAPTRIANGLE (0, h)-(w, 0)-(0, 0), i TO(x3, y3, z3)-(x1, y5, z1)-(x3, y7, z3) 'zadni stena


    _MAPTRIANGLE (0, h)-(w, h)-(0, 0), i TO(x2, y2, z2)-(x4, y4, z4)-(x2, y6, z2) 'predni stena            front wall
    _MAPTRIANGLE (w, h)-(0, 0)-(w, 0), i TO(x4, y4, z4)-(x2, y6, z2)-(x4, y8, z4) 'zadni stena


    _DISPLAY
    _LIMIT 50
LOOP

SUB kostka (x, y, z) 'zadavas levy horni predni roh ,udela kostku v zadane x,y,z                         x y z are coordinates for left upper corner, do cube on this place


    W = _WIDTH(texture&)
    H = _HEIGHT(texture&)

    '                g                       h                                e                  f
    MAPQUAD x + -1.5, y + 1.5, z + -1.5, x + .5, y + 1.5, z + -1.5, x + -1.5, y + -.5, z + -1.5, x + .5, y + -.5, z - 1.5, texture&
    MAPQUAD x + -1, y + 1, z + -1, x + 1, y + 1, z + -1, x + -1.5, y + 1.5, z + -1.5, x + .5, y + 1.5, z + -1.5, texture&
    MAPQUAD x + -1.5, y + -.5, z + -1.5, x + .5, y + -.5, z - 1.5, x + -1, y + -1, z + -1, x + 1, y - 1, z - 1, texture& '
    MAPQUAD x + -1, y + 1, z + -1, x + -1.5, y + 1.5, z + -1.5, x + -1, y + -1, z + -1, x + -1.5, y + -.5, z + -1.5, texture&
    MAPQUAD x + .5, y + 1.5, z + -1.5, x + .5, y + -.5, z - 1.5, x + 1, y - 1, z - 1, x + 1, y + 1, z + -1, texture&
    '                a                     b                    c                       d
    MAPQUAD x + -1, y + 1, z + -1, x + 1, y + 1, z + -1, x + -1, y + -1, z + -1, x + 1, y - 1, z - 1, texture&

END SUB




SUB MAPQUAD (x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4, texture AS LONG)
    W = _WIDTH(texture&)
    H = _HEIGHT(texture&)
    GOTO nerot 'comment it for show, how it hat not to see...

    po = _PI(2) / 4

    s1 = SIN(rot + (1 * po)) * x1
    c1 = COS(rot + (1 * po)) * y1

    s2 = SIN(rot + (2 * po)) * x2
    c2 = COS(rot + (2 * po)) * y2

    s3 = SIN(rot + (3 * po)) * x3
    c3 = COS(rot + (3 * po)) * y3

    s4 = SIN(rot + (4 * po)) * x4
    c4 = COS(rot + (4 * po)) * y4

    x1 = x1 + s1: y1 = y1 + c1
    x3 = x3 + s3: y3 = y3 + c3

    x2 = x2 + s2: y2 = y2 + c2
    x4 = x4 + s4: y4 = y4 + c4

    nerot:
    _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture& TO(x1, y1, z1)-(x2, y2, z2)-(x3, y3, z3)
    _MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture& TO(x2, y2, z2)-(x3, y3, z3)-(x4, y4, z4)
END SUB

SUB init
    text$ = " Petr" 'width = 32 pixels (records)

    virtual& = _NEWIMAGE(100, 100, 256)
    _DEST virtual&
    PRINT text$
    _SOURCE virtual&
    i = 0
    FOR Y = 17 TO 0 STEP -1
        FOR X = 0 TO 50
            IF POINT(X, Y) <> 0 THEN
                T(i).x = (-8.5 + X)
                T(i).y = -18 + (16 - Y) * 2
                T(i).z = -5 - X
            END IF
            i = i + 1
    NEXT X, Y
    _DEST 0: _SOURCE 0: _FREEIMAGE virtual&
    i = 0
END SUB


SUB clock (x, y)
    de = _DEST
    clocka& = _NEWIMAGE(100, 100, 32)
    _DEST clocka&
    vterina = VAL(RIGHT$(TIME$, 2))
    hodina = VAL(LEFT$(TIME$, 2))
    minuta = VAL(MID$(TIME$, 4, 2))

    IF hodina > 12 THEN hodina = hodina - 12
    hodina = hodina + (1 / 59) * minuta


    vt = vterina + 45
    ho = hodina + 45
    mi = minuta + 45

    pozicevterina = _PI(2) / 60 * vt
    poziceminuta = _PI(2) / 60 * ho * 5
    pozicehodina = _PI(2) / 60 * mi

    xs = 50 + COS(pozicevterina) * 30
    ys = 50 + SIN(pozicevterina) * 30

    xm = 50 + COS(poziceminuta) * 35
    ym = 50 + SIN(poziceminuta) * 35

    xh = 50 + COS(pozicehodina) * 40
    yh = 50 + SIN(pozicehodina) * 40

    FOR n = 1 TO 100
        LINE (n, 0)-(n, 99), _RGB32(127 - n, n, 27 + n), BF
    NEXT n
    LINE (0, 0)-(99, 99), _RGB32(255, 255, 255), B

    COLOR _RGBA32(127, 127, 127, 150)
    _PRINTMODE _KEEPBACKGROUND
    _PRINTSTRING (35, 45), "QB64"
    COLOR _RGB32(255, 255, 255)


    LINE (50, 50)-(xh, yh), _RGB32(255, 255, 0)
    LINE (50, 50)-(xm, ym), _RGB32(255, 255, 0)
    LINE (50, 50)-(xs, ys), _RGB32(0, 255, 255)
    m = 0
    FOR kruh = 0 TO _PI(2) STEP _PI(2) / 60
        PSET (50 + COS(kruh) * 47, 50 + SIN(kruh) * 47)
        IF m MOD 5 = 0 THEN LINE (50 + COS(kruh) * 47, 50 + SIN(kruh) * 47)-(50 + COS(kruh) * 44, 50 + SIN(kruh) * 44), , BF
        m = m + 1
    NEXT kruh
    _DEST de
    _SETALPHA 100, , clocka&
    _PUTIMAGE (x, y), clocka&, de
    _FREEIMAGE clocka&
END SUB


Offline Ashish

  • The joy of coding is endless.
Re: MAPTRIANGLE in 3D
« Reply #17 on: January 09, 2019, 08:37:38 AM »
Hi Petr! It is nicely done... 3D Text Effect is awesome! I like how the texture changes in real-time.
if (Me.success) {Me.improve()} else {Me.tryAgain()}


aKFrameWork - http://bit.ly/aKFrameWork
Menu System - http://bit.ly/guiMenuBar
p5.js in QB64 - http://bit.ly/p5jsbas

@KingOfCoders

Offline Petr

  • I am instructed.
Re: MAPTRIANGLE in 3D
« Reply #18 on: January 09, 2019, 01:51:04 PM »
Thank you, Ashish. I'm glad you like it.

Online FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: MAPTRIANGLE in 3D
« Reply #19 on: January 09, 2019, 02:11:00 PM »
Oh! No SUB _GL! That's impressive.

Offline johnno56

  • Live long and prosper.
Re: MAPTRIANGLE in 3D
« Reply #20 on: January 09, 2019, 06:23:49 PM »
Petr,

Most of 'how that works' is WAY over my head... I, for one, didn't think these types of effects could be done using only Basic. Well done! I'm impressed! Brilliant!

J
Logic is the beginning of wisdom.

Re: MAPTRIANGLE in 3D
« Reply #21 on: January 09, 2019, 11:54:35 PM »
Another awesome effort Petr, I like how you made block letters from a 2D print and used live clocks for a texture.
B = B + ...

Offline Petr

  • I am instructed.
Re: MAPTRIANGLE in 3D
« Reply #22 on: January 10, 2019, 06:52:11 PM »
Thank you all very much for your feedback. :-D

Re: MAPTRIANGLE in 3D
« Reply #23 on: January 13, 2019, 03:22:46 PM »
very cool this 3d demo (more the last without gl)