« previous next »
Pages: [1] 2   Go Down

Author Topic: Deformed Sphere (3D)  (Read 6341 times)

0 Members and 1 Guest are viewing this topic.

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Deformed Sphere (3D)
« on: July 06, 2019, 07:40:07 am »
Hi guys. I muss go out, but have problem. It is most for 3D programmers. Why my attempt for sphere draws something als baseball ball but not sphere? Is used MAPTRINGLE 3D again:
I look back in the evening, or maybe tomorrow, I'm go to celebrate friends daughter's birthday with our kids. If someone reveals the reason for the error, I will be very happy. Thank you.

Program idea is - draw circles in space, from zero radius for first circle in foreground to full radius in middle and then from middle with full radius to zero radius in background.
I know about _gluSphere, but i try solving it with _MAPTRIANGLE.

Code: QB64: [Select]
  1. 'cilem programu je rotujici koule pomoci maptriangle.
  3.     cX AS SINGLE
  4.     cY AS SINGLE
  5.     cZ AS SINGLE
  6.     X AS SINGLE
  7.     Y AS SINGLE
  8.     Z AS SINGLE
  9.     R AS SINGLE
  10.     Pi AS SINGLE
  11.     Pi2 AS SINGLE
  13. REDIM SHARED v(0) AS V
  14.  
  15.  
  16. texture& = Textur&
  17. init_Sphere 0.1, 0.1, -15, 10
  18.  
  19.  
  20. 'test
  22.     RotoXZ
  23.     draw_Sphere texture&
  24.     _DISPLAY
  26.  
  27.  
  28.  
  29. SUB test
  30.     FOR t = LBOUND(v) TO UBOUND(v)
  31.         PRINT v(t).Z; v(t).R; t
  32.         SLEEP
  33.     NEXT
  35.  
  36.  
  37.  
  38.  
  39.  
  40. SUB init_Sphere (cx AS SINGLE, cy AS SINGLE, cz AS SINGLE, radius AS SINGLE)
  41.  
  42.     'one circle circuit is set here as 8 steps (6.28/8)
  43.  
  44.     O = radius / 8 'step on circle circuit
  45.     Hl = radius / 16 'depth step in Z axis
  46.     nz = cz + radius 'nz = new Z = new depth
  47.  
  48.     FOR r1 = 0 TO radius STEP O 'udelej 8 kruznic
  49.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  50.             nX = cx + (SIN(c1) * r1)
  51.             nY = cy + (COS(c1) * r1)
  52.             tz = cz + COS(c1) * r1
  53.             '            pi = JK(cy, cz, nY, nz, r1)
  54.             '           pi2 = JK(cx, cz, nX, nz, r1)
  55.             v(i).X = nX
  56.             v(i).Y = nY
  57.             v(i).Z = nz
  58.             v(i).cZ = cz
  59.             v(i).cY = cy
  60.             v(i).cX = cx
  61.             '    v(i).Pi = pi
  62.             '    v(i).Pi2 = pi2
  63.  
  64.             radius3D = SQR((cx - nX) ^ 2 + (cy - nY) ^ 2 + (cz - nz) ^ 2)
  65.  
  66.             v(i).R = radius3D
  67.  
  68.             pi = JK(cy, cz, nY, nz, radius3D)
  69.             pi2 = JK(cx, cz, nX, nz, radius3D)
  70.  
  71.             v(i).Pi = pi
  72.             v(i).Pi2 = pi2
  73.  
  74.             i = i + 1
  75.             REDIM _PRESERVE v(i) AS V
  76.  
  77.         NEXT c1
  78.  
  79.         nz = nz - Hl
  80.  
  81.     NEXT r1
  82.  
  83.  
  84.     FOR r1 = radius - O TO 0 STEP -O
  85.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  86.             nX = cx + (SIN(c1) * r1)
  87.             nY = cy + (COS(c1) * r1)
  88.             tz = cz + COS(c1) * r1
  89.             ' pi = JK(cy, cz, nY, nz, r1)
  90.             'pi2 = JK(cx, cz, nX, nz, r1)
  91.             v(i).X = nX
  92.             v(i).Y = nY
  93.             v(i).Z = nz
  94.             v(i).cZ = cz
  95.             v(i).cY = cy
  96.             v(i).cX = cx
  97.             '            v(i).Pi = pi
  98.             '            v(i).Pi2 = pi2
  99.  
  100.             radius3D = SQR((cx - nX) ^ 2 + (cy - nY) ^ 2 + (cz - nz) ^ 2)
  101.             v(i).R = radius3D
  102.  
  103.             pi = JK(cy, cz, nY, nz, radius3D)
  104.             pi2 = JK(cx, cz, nX, nz, radius3D)
  105.  
  106.             v(i).Pi = pi
  107.             v(i).Pi2 = pi2
  108.             i = i + 1
  109.             REDIM _PRESERVE v(i) AS V
  110.         NEXT c1
  111.         nz = nz - Hl
  112.     NEXT r1
  113.     i = i - 1
  114.     REDIM _PRESERVE v(i) AS V
  115.  
  117.  
  118. SUB draw_Sphere (texture AS LONG)
  119.     'je to po osmi zaznamech na jeden obvod   'every one circle circuit contains 8 steps (so one radius is not circle, but 8-angle)
  120.     W = _WIDTH(texture)
  121.     H = _HEIGHT(texture)
  122.  
  123.     c = 1
  124.     DO UNTIL c >= UBOUND(v) - 8
  125.         FOR i = c TO c + 7
  126.             i2 = 9 + i
  127.             _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(v(i - 1).X, v(i - 1).Y, v(i - 1).Z)-(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)
  128.             _MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)-(v(i2).X, v(i2).Y, v(i2).Z)
  129.         NEXT i
  130.         c = c + 9
  131.     LOOP
  132.  
  134.  
  135.  
  136.  
  137. SUB RotoXZ
  138.     SHARED angle
  139.     angle = angle + .0001
  140.     FOR r = LBOUND(v) TO UBOUND(v)
  141.         cx = v(r).cX
  142.         cz = v(r).cZ
  143.         pi = v(r).Pi2
  144.         radius = v(r).R
  145.         nx = cx + SIN(pi + angle) * radius
  146.         nz = cz + COS(pi + angle) * radius
  147.         v(r).Z = nz
  148.         v(r).X = nx
  149.         REM        PRINT nx, ny, nz
  150.     NEXT r
  152.  
  153.  
  154. SUB RotoYZ
  155.     SHARED angle
  156.     angle = angle + .001
  157.     FOR r = LBOUND(v) TO UBOUND(v)
  158.         cy = v(r).cY
  159.         cz = v(r).cZ
  160.         pi = v(r).Pi
  161.         radius = v(r).R
  162.         nz = cz + SIN(pi + angle) * radius
  163.         ny = cy + COS(pi + angle) * radius
  164.         v(r).Z = nz
  165.         v(r).Y = ny
  166.         REM        PRINT nx, ny, nz
  167.     NEXT r
  169.  
  170.  
  171. FUNCTION JK! (cx, cy, px, py, R!) 'return vector angle
  172.     LenX! = cx - px
  173.     LenY! = cy - py
  174.     jR! = 1 / R!
  175.  
  176.     jX! = LenX! * jR!
  177.     jY! = LenY! * jR!
  178.  
  179.     sinusAlfa! = jX!
  180.     Alfa! = ABS(_ASIN(sinusAlfa!))
  181.  
  182.     Q = 1
  183.     IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
  184.     IF px >= cx AND py <= cy THEN Q = 2
  185.     IF px <= cx AND py <= cy THEN Q = 3
  186.     IF px <= cx AND py >= cy THEN Q = 4
  187.     SELECT CASE Q
  188.         CASE 1: alfaB! = Alfa!
  189.         CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
  190.         CASE 3: alfaB! = _PI + Alfa!
  191.         CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
  192.     END SELECT
  193.     JK! = alfaB!
  194.     IF JK! = 0 THEN BEEP
  196.  
  197.  
  198. FUNCTION Textur&
  199.     text = _NEWIMAGE(100, 100, 32)
  200.     a = _DEST
  201.     _DEST text
  202.     FOR f = 5 TO 0 STEP -1
  203.         LINE (f, f)-(100 - f, 100 - f), &HFFFFFFFF, B
  204.     NEXT f
  205.     LINE (5, 5)-(95, 95), &H00000000, BF
  206.     Textur& = _COPYIMAGE(text, 33)
  207.     _DEST a
  208.     _FREEIMAGE text
  210.  
  211.  

preview.JPG
* preview.JPG (Filesize: 83.21 KB, Dimensions: 655x438, Views: 178)
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #1 on: July 06, 2019, 11:51:45 am »
It looks like you're trying to build a golf net... Can I help?

All that 3-D effect in under 200 lines of code, wow! I hope you get some non-SCREEN 0 guru to tweak the math so you get  that  sphere shape you want out of it. Apparently _maptriangle likes to create geometric shapes in it's own image?

Oh well, sorry I am of no use at all when it comes to graphics, but I did run the program and posted this reply because I'm impressed with the 3-D effects in general. Back in the old QB days, it took more lines to rotate a simple 3-D cube outline on one axis.

EDIT: Well, I can't just sit around on my ASCII and do nothing, so I fiddled with one line. This change does improve the shape, making it have a more spherical appearance, but I have no idea if it is close enough to what you are looking for or if other areas of the code need to be modified to further improve the effect.

So, try: init_Sphere 0, 0, -6, 6

Pete
« Last Edit: July 06, 2019, 12:11:09 pm by Pete »
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #2 on: July 07, 2019, 09:56:43 am »
Hi Petr! You are doing everything fine, but I see that you are not using correct equation for sphere in init_sphere() subroutine.
This is the actual equation for the sphere which I found according to wikipedia -

Screenshot_1.png


I write a little demo using these equation. It is in OpenGL (I'm not good at _maptriangle)
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(600, 600, 32)
  2. TYPE vec3
  3.     x AS SINGLE
  4.     y AS SINGLE
  5.     z AS SINGLE
  8.     _DELAY 0.05
  10.  
  11. SUB _GL ()
  12.     DIM center AS vec3, vertex AS vec3, radius
  13.     center.x = 0
  14.     center.y = 0
  15.     center.z = 0
  16.     radius = 1
  17.     _glPointSize 5.0
  18.     _glRotatef TIMER * 30, 1, 2, 0
  19.     _glBegin _GL_POINTS
  20.     FOR theta = 0 TO _PI STEP _PI / 50
  21.         FOR phi = 0 TO _PI(2) STEP _PI(2) / 100
  22.             vertex.x = center.x + SIN(theta) * COS(phi) * radius
  23.             vertex.y = center.y + SIN(theta) * SIN(phi) * radius
  24.             vertex.z = center.z + COS(theta) * radius
  25.  
  26.             _glVertex3f vertex.x, vertex.y, vertex.z
  27.         NEXT phi
  28.     NEXT theta
  29.     _glEnd
  31.  
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Deformed Sphere (3D)
« Reply #3 on: July 07, 2019, 10:04:33 am »
Hi Ashish,

WOW OpenGL does it again!

Is there a way to differentiate one hemisphere and pole from the other, like make the dots of closer one larger and/or farther one darker in shade?
Logged

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #4 on: July 07, 2019, 10:16:31 am »
Yes, why not?
I used shading method for differentiating hemisphere and poles.
Code: QB64: [Select]
  1. SCREEN _NEWIMAGE(600, 600, 32)
  2. TYPE vec3
  3.     x AS SINGLE
  4.     y AS SINGLE
  5.     z AS SINGLE
  8.     _DELAY 0.05
  10.  
  11. SUB _GL ()
  12.     DIM center AS vec3, vertex AS vec3, radius
  13.     center.x = 0
  14.     center.y = 0
  15.     center.z = 0
  16.     radius = 1
  17.     _glPointSize 5.0
  18.     _glRotatef TIMER * 30, 1, 2, 0
  19.     _glBegin _GL_POINTS
  20.     FOR theta = 0 TO _PI STEP _PI / 50
  21.         FOR phi = 0 TO _PI(2) STEP _PI(2) / 100
  22.             vertex.x = center.x + SIN(theta) * COS(phi) * radius
  23.             vertex.y = center.y + SIN(theta) * SIN(phi) * radius
  24.             vertex.z = center.z + COS(theta) * radius
  25.             c = ABS(COS(theta))
  26.             _glColor3f c, c, c
  27.             _glVertex3f vertex.x, vertex.y, vertex.z
  28.         NEXT phi
  29.     NEXT theta
  30.     _glEnd
  32.  
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Deformed Sphere (3D)
« Reply #5 on: July 07, 2019, 12:39:11 pm »
So. Guys. Thank you very much for your interest and your patince with me.

What I did. Flat disk. Something that can be called a 3D satellite with a little imagination. Shape that can be used on a 3D submarine (cigar shape). Something that can be used as a cannon when properly textured. I have achieved everything possible. With the idea that the regular round circuit will be supplemented by another sum of SIN or COS to achieve an oval (and irregular) shape, I can texture the meteorites. BUT PERFECT BALLS I CAN NOT DO! I attach the source. Play with the variables O, Hl, Nz, PIN in the init_sphere sub, to get a variety of 3D things. This is fun!
Ashish, thank you for the ball equation, when I try to implant it, I achieved some sort of thing that looked like - a funny statement - as gatehouse from Chernobyl,  that flew into space after the Chernobyl explosion. :-D I'm sure it's due my implantation that was bad. I realized that increasing the distance in the Z-axis simply couldn't be linear, because then I would get some shape of a dragonfly or how to call it better. Your OpenGL version is a fantastic example of math and speed. 30 lines and you're done. What? Unreal. Absolutely great work. I can't imagine how I would connect the individual points of the surface for maptriangle in this way.
Pete thank you for your interest and effort to find a problem. I appreciate it.

almost ball source:

Code: QB64: [Select]
  1.  
  3.     cX AS SINGLE
  4.     cY AS SINGLE
  5.     cZ AS SINGLE
  6.     X AS SINGLE
  7.     Y AS SINGLE
  8.     Z AS SINGLE
  9.     R AS SINGLE
  10.     Pi AS SINGLE
  11.     Pi2 AS SINGLE
  12.     pi3 AS SINGLE
  14. REDIM SHARED v(0) AS V
  15.  
  16.  
  17. texture& = Textur&
  18. init_Sphere 0, 0, -6, 2, 24 'this last number muss be the same!
  19.  
  21.     RotoXZ
  22.     draw_Sphere texture&, 24 'this last number muss be the same!
  23.     _DISPLAY
  25.  
  26.  
  27. SUB init_Sphere (cx AS SINGLE, cy AS SINGLE, cz AS SINGLE, radius AS SINGLE, N)
  28.  
  29.     O = radius / 8 'step on circle circuit
  30.     hl = radius / (_PI / .9)
  31.     nz = cz - radius
  32.     PIN = N * 2
  33.  
  34.  
  35.     t = 0
  36.     FOR r1 = 0 TO radius STEP O
  37.         t = t + _PI / PIN
  38.         FOR c1 = 0 TO _PI(2) + .001 STEP _PI(2) / N
  39.             nX = cx + (SIN(c1) * r1)
  40.             nY = cy + (COS(c1) * r1)
  41.  
  42.             v(i).X = nX
  43.             v(i).Y = nY
  44.             v(i).Z = nz
  45.             v(i).cZ = cz
  46.             v(i).cY = cy
  47.             v(i).cX = cx
  48.             radius3d = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2)
  49.  
  50.             v(i).R = radius3d
  51.  
  52.             PI = JK(cy, cz, nY, nz, radius3d)
  53.             pi2 = JK(cx, cz, nX, nz, radius3d)
  54.             v(i).pi3 = JK(cx, cy, nX, nY, radius3d)
  55.             v(i).Pi = PI
  56.             v(i).Pi2 = pi2
  57.  
  58.             i = i + 1
  59.             REDIM _PRESERVE v(i) AS V
  60.  
  61.         NEXT c1
  62.         nz = nz + hl * SIN(t)
  63.     NEXT r1
  64.  
  65.     ' t = 0
  66.     FOR r1 = radius TO 0 STEP -O
  67.         t = t - _PI / PIN
  68.         FOR c1 = -.001 TO _PI(2) STEP _PI(2) / N
  69.             nX = cx + SIN(c1) * r1
  70.             nY = cy + COS(c1) * r1
  71.  
  72.  
  73.             v(i).X = nX
  74.             v(i).Y = nY
  75.             v(i).Z = nz
  76.             v(i).cZ = cz
  77.             v(i).cY = cy
  78.             v(i).cX = cx
  79.             radius3d = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2)
  80.             v(i).R = radius3d
  81.  
  82.             PI = JK(cy, cz, nY, nz, radius3d)
  83.             pi2 = JK(cx, cz, nX, nz, radius3d)
  84.             v(i).pi3 = JK(cx, cy, nX, nY, radius3d)
  85.             v(i).Pi = PI
  86.             v(i).Pi2 = pi2
  87.             i = i + 1
  88.             REDIM _PRESERVE v(i) AS V
  89.         NEXT c1
  90.         nz = nz + hl * SIN(t)
  91.  
  92.     NEXT r1
  93.     i = i - 1
  94.     REDIM _PRESERVE v(i) AS V
  95.  
  97.  
  98. SUB draw_Sphere (texture AS LONG, N)
  99.     W = _WIDTH(texture)
  100.     H = _HEIGHT(texture)
  101.  
  102.     c = 1
  103.     DO UNTIL c >= UBOUND(v) - N
  104.         FOR i = c TO c + (N - 1)
  105.             i2 = (N + 1) + i
  106.             _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(v(i - 1).X, v(i - 1).Y, v(i - 1).Z)-(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)
  107.             _MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)-(v(i2).X, v(i2).Y, v(i2).Z)
  108.         NEXT i
  109.         c = c + (N + 1)
  110.     LOOP
  112.  
  113.  
  114.  
  115. SUB RotoXZ
  116.     SHARED angle
  117.     angle = angle + .0001
  118.     FOR r = LBOUND(v) TO UBOUND(v)
  119.         cx = v(r).cX
  120.         cz = v(r).cZ
  121.         pi = v(r).Pi2
  122.         pi3 = v(r).pi3
  123.         radius = v(r).R
  124.         nx = cx + SIN(pi + angle) * radius
  125.         nz = cz + COS(pi + angle) * radius
  126.         v(r).Z = nz
  127.         v(r).X = nx
  128.         REM        PRINT nx, ny, nz
  129.     NEXT r
  131.  
  132.  
  133. SUB RotoYZ
  134.     SHARED angle
  135.     angle = angle + .0001
  136.     FOR r = LBOUND(v) TO UBOUND(v)
  137.         cy = v(r).cY
  138.         cz = v(r).cZ
  139.         pi = v(r).Pi
  140.         radius = v(r).R
  141.         nz = cz + SIN(pi + angle) * radius
  142.         ny = cy + COS(pi + angle) * radius
  143.         v(r).Z = nz
  144.         v(r).Y = ny
  145.         REM        PRINT nx, ny, nz
  146.     NEXT r
  148.  
  149.  
  150. FUNCTION JK! (cx, cy, px, py, R!) 'return vector angle
  151.     LenX! = cx - px
  152.     LenY! = cy - py
  153.     jR! = 1 / R!
  154.  
  155.     jX! = LenX! * jR!
  156.     jY! = LenY! * jR!
  157.  
  158.     sinusAlfa! = jX!
  159.     Alfa! = ABS(_ASIN(sinusAlfa!))
  160.  
  161.     Q = 1
  162.     IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
  163.     IF px >= cx AND py <= cy THEN Q = 2
  164.     IF px <= cx AND py <= cy THEN Q = 3
  165.     IF px <= cx AND py >= cy THEN Q = 4
  166.     SELECT CASE Q
  167.         CASE 1: alfaB! = Alfa!
  168.         CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
  169.         CASE 3: alfaB! = _PI + Alfa!
  170.         CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
  171.     END SELECT
  172.     JK! = alfaB!
  173.     IF JK! = 0 THEN BEEP
  175.  
  176.  
  177. FUNCTION Textur&
  178.     text = _NEWIMAGE(100, 100, 32)
  179.     a = _DEST
  180.     _DEST text
  181.     FOR f = 5 TO 0 STEP -1
  182.         LINE (f, f)-(100 - f, 100 - f), &HFFFFFFFF, B
  183.     NEXT f
  184.     LINE (5, 5)-(95, 95), &H00000000, BF
  185.     Textur& = _COPYIMAGE(text, 33)
  186.     _DEST a
  187.     _FREEIMAGE text
  189.  

"Sattelite"

Code: QB64: [Select]
  1.  
  3.     cX AS SINGLE
  4.     cY AS SINGLE
  5.     cZ AS SINGLE
  6.     X AS SINGLE
  7.     Y AS SINGLE
  8.     Z AS SINGLE
  9.     R AS SINGLE
  10.     Pi AS SINGLE
  11.     Pi2 AS SINGLE
  12.     pi3 AS SINGLE
  14. REDIM SHARED v(0) AS V
  15.  
  16.  
  17. texture& = Textur&
  18. init_Sphere 0, 0, -6, 2
  19.  
  20.  
  21. 'test
  23.     RotoXZ
  24.     draw_Sphere texture&
  25.     _DISPLAY
  27.  
  28.  
  29.  
  30. SUB test
  31.     FOR t = LBOUND(v) TO UBOUND(v)
  32.         PRINT v(t).Z; v(t).R; t
  33.         SLEEP
  34.     NEXT
  36.  
  37.  
  38.  
  39.  
  40.  
  41. SUB init_Sphere (cx AS SINGLE, cy AS SINGLE, cz AS SINGLE, radius AS SINGLE)
  42.  
  43.     'one circle circuit is set here as 8 steps (6.28/8)
  44.  
  45.     O = radius / 8 'step on circle circuit
  46.     Hl = _PI / 16 '16 'depth step in Z axis
  47.     nz = cz + radius
  48.  
  49.     FOR r1 = 0 TO radius STEP O 'udelej 8 kruznic
  50.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  51.             nX = cx + (SIN(c1) * r1)
  52.             nY = cy + (COS(c1) * r1)
  53.             v(i).X = nX
  54.             v(i).Y = nY
  55.             v(i).Z = nz
  56.             v(i).cZ = cz
  57.             v(i).cY = cy
  58.             v(i).cX = cx
  59.             radius3D = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2) '+ (cz - nz) ^ 2)
  60.  
  61.             v(i).R = radius3D
  62.  
  63.             pi = JK(cy, cz, nY, nz, radius3D)
  64.             pi2 = JK(cx, cz, nX, nz, radius3D)
  65.             v(i).pi3 = JK(cx, cy, nX, nY, radius3D)
  66.             v(i).Pi = pi
  67.             v(i).Pi2 = pi2
  68.  
  69.             i = i + 1
  70.             REDIM _PRESERVE v(i) AS V
  71.  
  72.         NEXT c1
  73.  
  74.         nz = cz + SIN(Hl) * r1
  75.         Hl = Hl + Hl
  76.  
  77.  
  78.     NEXT r1
  79.  
  80.  
  81.     FOR r1 = radius - O TO 0 STEP -O
  82.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  83.             nX = cx + (SIN(c1) * r1)
  84.             nY = cy + (COS(c1) * r1)
  85.  
  86.             v(i).X = nX
  87.             v(i).Y = nY
  88.             v(i).Z = nz
  89.             v(i).cZ = cz
  90.             v(i).cY = cy
  91.             v(i).cX = cx
  92.             radius3D = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2) ' + (cz - nz) ^ 2)
  93.             v(i).R = radius3D
  94.  
  95.             pi = JK(cy, cz, nY, nz, radius3D)
  96.             pi2 = JK(cx, cz, nX, nz, radius3D)
  97.             v(i).pi3 = JK(cx, cy, nX, nY, radius3D)
  98.             v(i).Pi = pi
  99.             v(i).Pi2 = pi2
  100.             i = i + 1
  101.             REDIM _PRESERVE v(i) AS V
  102.         NEXT c1
  103.  
  104.         nz = cz + SIN(Hl) * r1
  105.         Hl = Hl + Hl
  106.  
  107.     NEXT r1
  108.     i = i - 1
  109.     REDIM _PRESERVE v(i) AS V
  110.  
  112.  
  113. SUB draw_Sphere (texture AS LONG)
  114.     'je to po osmi zaznamech na jeden obvod   'every one circle circuit contains 8 steps (so one radius is not circle, but 8-angle)
  115.     W = _WIDTH(texture)
  116.     H = _HEIGHT(texture)
  117.  
  118.     c = 1
  119.     DO UNTIL c >= UBOUND(v) - 8
  120.         FOR i = c TO c + 7
  121.             i2 = 9 + i
  122.             _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(v(i - 1).X, v(i - 1).Y, v(i - 1).Z)-(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)
  123.             _MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)-(v(i2).X, v(i2).Y, v(i2).Z)
  124.         NEXT i
  125.         c = c + 9
  126.     LOOP
  127.  
  129.  
  130.  
  131.  
  132. SUB RotoXZ
  133.     SHARED angle
  134.     angle = angle + .0001
  135.     FOR r = LBOUND(v) TO UBOUND(v)
  136.         cx = v(r).cX
  137.         cz = v(r).cZ
  138.         pi = v(r).Pi2
  139.         pi3 = v(r).pi3
  140.         radius = v(r).R
  141.         nx = cx + SIN(pi + angle) * radius
  142.         nz = cz + COS(pi + angle) * radius
  143.         v(r).Z = nz
  144.         v(r).X = nx
  145.         REM        PRINT nx, ny, nz
  146.     NEXT r
  148.  
  149.  
  150. SUB RotoYZ
  151.     SHARED angle
  152.     angle = angle + .0001
  153.     FOR r = LBOUND(v) TO UBOUND(v)
  154.         cy = v(r).cY
  155.         cz = v(r).cZ
  156.         pi = v(r).Pi
  157.         radius = v(r).R
  158.         nz = cz + SIN(pi + angle) * radius
  159.         ny = cy + COS(pi + angle) * radius
  160.         v(r).Z = nz
  161.         v(r).Y = ny
  162.         REM        PRINT nx, ny, nz
  163.     NEXT r
  165.  
  166.  
  167. FUNCTION JK! (cx, cy, px, py, R!) 'return vector angle
  168.     LenX! = cx - px
  169.     LenY! = cy - py
  170.     jR! = 1 / R!
  171.  
  172.     jX! = LenX! * jR!
  173.     jY! = LenY! * jR!
  174.  
  175.     sinusAlfa! = jX!
  176.     Alfa! = ABS(_ASIN(sinusAlfa!))
  177.  
  178.     Q = 1
  179.     IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
  180.     IF px >= cx AND py <= cy THEN Q = 2
  181.     IF px <= cx AND py <= cy THEN Q = 3
  182.     IF px <= cx AND py >= cy THEN Q = 4
  183.     SELECT CASE Q
  184.         CASE 1: alfaB! = Alfa!
  185.         CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
  186.         CASE 3: alfaB! = _PI + Alfa!
  187.         CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
  188.     END SELECT
  189.     JK! = alfaB!
  190.     IF JK! = 0 THEN BEEP
  192.  
  193.  
  194. FUNCTION Textur&
  195.     text = _NEWIMAGE(100, 100, 32)
  196.     a = _DEST
  197.     _DEST text
  198.     FOR f = 5 TO 0 STEP -1
  199.         LINE (f, f)-(100 - f, 100 - f), &HFFFFFFFF, B
  200.     NEXT f
  201.     LINE (5, 5)-(95, 95), &H00000000, BF
  202.     Textur& = _COPYIMAGE(text, 33)
  203.     _DEST a
  204.     _FREEIMAGE text
  206.  

"satellite 2"

Code: QB64: [Select]
  1. 'cilem programu je rotujici koule pomoci maptriangle.
  3.     cX AS SINGLE
  4.     cY AS SINGLE
  5.     cZ AS SINGLE
  6.     X AS SINGLE
  7.     Y AS SINGLE
  8.     Z AS SINGLE
  9.     R AS SINGLE
  10.     Pi AS SINGLE
  11.     Pi2 AS SINGLE
  12.     pi3 AS SINGLE
  14. REDIM SHARED v(0) AS V
  15.  
  16.  
  17. texture& = Textur&
  18. init_Sphere 0, 0, -6, 2
  19.  
  20.  
  21. 'test
  23.     RotoXZ
  24.     draw_Sphere texture&
  25.     _DISPLAY
  27.  
  28.  
  29.  
  30. SUB test
  31.     FOR t = LBOUND(v) TO UBOUND(v)
  32.         PRINT v(t).Z; v(t).R; t
  33.         SLEEP
  34.     NEXT
  36.  
  37.  
  38.  
  39.  
  40.  
  41. SUB init_Sphere (cx AS SINGLE, cy AS SINGLE, cz AS SINGLE, radius AS SINGLE)
  42.  
  43.     'one circle circuit is set here as 8 steps (6.28/8)
  44.  
  45.     O = radius / 16 'step on circle circuit
  46.     Hl = _PI / 32 '16 'depth step in Z axis
  47.     nz = cz + radius
  48.  
  49.     FOR r1 = 0 TO radius STEP O 'udelej 8 kruznic
  50.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  51.             nX = cx + (SIN(c1) * r1)
  52.             nY = cy + (COS(c1) * r1)
  53.             v(i).X = nX
  54.             v(i).Y = nY
  55.             v(i).Z = nz
  56.             v(i).cZ = cz
  57.             v(i).cY = cy
  58.             v(i).cX = cx
  59.             radius3D = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2) '+ (cz - nz) ^ 2)
  60.  
  61.             v(i).R = radius3D
  62.  
  63.             pi = JK(cy, cz, nY, nz, radius3D)
  64.             pi2 = JK(cx, cz, nX, nz, radius3D)
  65.             v(i).pi3 = JK(cx, cy, nX, nY, radius3D)
  66.             v(i).Pi = pi
  67.             v(i).Pi2 = pi2
  68.  
  69.             i = i + 1
  70.             REDIM _PRESERVE v(i) AS V
  71.  
  72.         NEXT c1
  73.  
  74.         nz = cz + SIN(Hl) * r1
  75.         Hl = Hl + Hl
  76.  
  77.  
  78.     NEXT r1
  79.  
  80.  
  81.     FOR r1 = radius - O TO 0 STEP -O
  82.         FOR c1 = 0 TO _PI(2) STEP _PI(2) / 8
  83.             nX = cx + (SIN(c1) * r1)
  84.             nY = cy + (COS(c1) * r1)
  85.  
  86.             v(i).X = nX
  87.             v(i).Y = nY
  88.             v(i).Z = nz
  89.             v(i).cZ = cz
  90.             v(i).cY = cy
  91.             v(i).cX = cx
  92.             radius3D = SQR((cx - nX) ^ 2 + (cz - nz) ^ 2) ' + (cz - nz) ^ 2)
  93.             v(i).R = radius3D
  94.  
  95.             pi = JK(cy, cz, nY, nz, radius3D)
  96.             pi2 = JK(cx, cz, nX, nz, radius3D)
  97.             v(i).pi3 = JK(cx, cy, nX, nY, radius3D)
  98.             v(i).Pi = pi
  99.             v(i).Pi2 = pi2
  100.             i = i + 1
  101.             REDIM _PRESERVE v(i) AS V
  102.         NEXT c1
  103.  
  104.         nz = cz + SIN(Hl) * r1
  105.         Hl = Hl + Hl
  106.  
  107.     NEXT r1
  108.     i = i - 1
  109.     REDIM _PRESERVE v(i) AS V
  110.  
  112.  
  113. SUB draw_Sphere (texture AS LONG)
  114.     'je to po osmi zaznamech na jeden obvod   'every one circle circuit contains 8 steps (so one radius is not circle, but 8-angle)
  115.     W = _WIDTH(texture)
  116.     H = _HEIGHT(texture)
  117.  
  118.     c = 1
  119.     DO UNTIL c >= UBOUND(v) - 8
  120.         FOR i = c TO c + 7
  121.             i2 = 9 + i
  122.             _MAPTRIANGLE (0, 0)-(W, 0)-(0, H), texture TO(v(i - 1).X, v(i - 1).Y, v(i - 1).Z)-(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)
  123.             _MAPTRIANGLE (W, 0)-(0, H)-(W, H), texture TO(v(i).X, v(i).Y, v(i).Z)-(v(i2 - 1).X, v(i2 - 1).Y, v(i2 - 1).Z)-(v(i2).X, v(i2).Y, v(i2).Z)
  124.         NEXT i
  125.         c = c + 9
  126.     LOOP
  127.  
  129.  
  130.  
  131.  
  132. SUB RotoXZ
  133.     SHARED angle
  134.     angle = angle + .0001
  135.     FOR r = LBOUND(v) TO UBOUND(v)
  136.         cx = v(r).cX
  137.         cz = v(r).cZ
  138.         pi = v(r).Pi2
  139.         pi3 = v(r).pi3
  140.         radius = v(r).R
  141.         nx = cx + SIN(pi + angle) * radius
  142.         nz = cz + COS(pi + angle) * radius
  143.         v(r).Z = nz
  144.         v(r).X = nx
  145.         REM        PRINT nx, ny, nz
  146.     NEXT r
  148.  
  149.  
  150. SUB RotoYZ
  151.     SHARED angle
  152.     angle = angle + .0001
  153.     FOR r = LBOUND(v) TO UBOUND(v)
  154.         cy = v(r).cY
  155.         cz = v(r).cZ
  156.         pi = v(r).Pi
  157.         radius = v(r).R
  158.         nz = cz + SIN(pi + angle) * radius
  159.         ny = cy + COS(pi + angle) * radius
  160.         v(r).Z = nz
  161.         v(r).Y = ny
  162.         REM        PRINT nx, ny, nz
  163.     NEXT r
  165.  
  166.  
  167. FUNCTION JK! (cx, cy, px, py, R!) 'return vector angle
  168.     LenX! = cx - px
  169.     LenY! = cy - py
  170.     jR! = 1 / R!
  171.  
  172.     jX! = LenX! * jR!
  173.     jY! = LenY! * jR!
  174.  
  175.     sinusAlfa! = jX!
  176.     Alfa! = ABS(_ASIN(sinusAlfa!))
  177.  
  178.     Q = 1
  179.     IF px >= cx AND py >= cy THEN Q = 1 ' select angle to quadrant
  180.     IF px >= cx AND py <= cy THEN Q = 2
  181.     IF px <= cx AND py <= cy THEN Q = 3
  182.     IF px <= cx AND py >= cy THEN Q = 4
  183.     SELECT CASE Q
  184.         CASE 1: alfaB! = Alfa!
  185.         CASE 2: alfaB! = _PI / 2 + (_PI / 2 - Alfa!)
  186.         CASE 3: alfaB! = _PI + Alfa!
  187.         CASE 4: alfaB! = _PI(1.5) + (_PI / 2 - Alfa!)
  188.     END SELECT
  189.     JK! = alfaB!
  190.     IF JK! = 0 THEN BEEP
  192.  
  193.  
  194. FUNCTION Textur&
  195.     text = _NEWIMAGE(100, 100, 32)
  196.     a = _DEST
  197.     _DEST text
  198.     FOR f = 5 TO 0 STEP -1
  199.         LINE (f, f)-(100 - f, 100 - f), &HFFFFFFFF, B
  200.     NEXT f
  201.     LINE (5, 5)-(95, 95), &H00000000, BF
  202.     Textur& = _COPYIMAGE(text, 33)
  203.     _DEST a
  204.     _FREEIMAGE text
  206.  

and more and more....


I would like to add one thing. I just wanted to try. I thought it might be like this, I wasn't looking for formulas, nothing. I just sat down and started writing the program. I'm excited about a lot of new things I've discovered.
« Last Edit: July 07, 2019, 12:44:53 pm by Petr »
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #6 on: July 07, 2019, 01:20:00 pm »
I'm the candidate who will bring hemispheres and poles together!

@Amish: OpenGL seems well suited for this. I wonder if _maptriangle could make a sphere without noticeable linear components?

I wasn't sure what Petr meant by "baseball" in his original post, So I thought he was just looking for a way to make one hemisphere match the other, but if he wants the image perfectly rounded, you nailed it, just not with _maptriangle!

@Petr: I half finished my post, did some stuff in the yard, and saw you came up with a _maptriangle solution. I tried it, and yes, it evens things out between the two hemispheres better than just adjusting init_Sphere.

Pete
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Deformed Sphere (3D)
« Reply #7 on: July 07, 2019, 01:44:04 pm »
Hi Pete. Certainly it can be done. I just chose the wrong way to do it. Those lines around the perimeter - that's the intention. It is actually the texture of a white rectangle with transparency set inside to see where the texture is mapped. To texturize the surface, simply take photos, split them into the same number of parts, and place them on a specific surface location. This achieves the effect of the textured body. For example, for a cylinder rotating in X / Z axes. If the cylinder is made up of ten segments, you divide the texture into 10 bars - the texture width / 10 and place it on the surface of the cylinder. Each segment is one tenth of the circumference., so one tenth from texture width.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #8 on: July 07, 2019, 01:58:28 pm »
Oh, it's a math thing...

I tried math once, but it didn't add up!

Code: QB64: [Select]
  1. DEFINT A-Z
  2. var1 = 3
  3. up! = 2
  4.  
  5. main sum, var1, up
  6. PRINT sum
  8.  
  9. SUB main (sum, var1, up)
  10.     sum = var1 + up
  12.  

Pete :D
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Deformed Sphere (3D)
« Reply #9 on: July 07, 2019, 03:35:24 pm »
yes, Pete... :-D use DEFSNG.
Logged

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Deformed Sphere (3D)
« Reply #10 on: July 07, 2019, 11:41:16 pm »
Hi Petr,

Those are cool looking satellites.
Logged

Offline Pete

  • Forum Resident
  • Posts: 2361
  • Cuz I sez so, varmint!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #11 on: July 08, 2019, 12:02:20 am »
Saddle lights? Oh right. What cowboys use for night riding.

Pete :D
Logged
Want to learn how to write code on cave walls? https://www.tapatalk.com/groups/qbasic/qbasic-f1/

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #12 on: July 08, 2019, 12:52:40 am »
Quote from: Pete on July 07, 2019, 01:58:28 pm
Oh, it's a math thing...

I tried math once, but it didn't add up!

Code: QB64: [Select]
  1. DEFINT A-Z
  2. var1 = 3
  3. up! = 2
  4.  
  5. main sum, var1, up
  6. PRINT sum
  8.  
  9. SUB main (sum, var1, up)
  10.     sum = var1 + up
  12.  

Pete :D
You are forgetting "!" on line 5.
This add up the thing.
Code: QB64: [Select]
  1. DEFINT A-Z
  2. var1 = 3
  3. up! = 2
  4.  
  5. main sum, var1, up!
  6. PRINT sum
  8.  
  9. SUB main (sum, var1, up)
  10.     sum = var1 + up
  12.  
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Ashish

  • Forum Resident
  • Posts: 630
  • Never Give Up!
    • View Profile
Re: Deformed Sphere (3D)
« Reply #13 on: July 08, 2019, 01:37:23 am »
@Petr
Why not use OpenGL for this?
Logged
if (Me.success) {Me.improve()} else {Me.tryAgain()}


My Projects - https://github.com/AshishKingdom?tab=repositories
OpenGL tutorials - https://ashishkingdom.github.io/OpenGL-Tutorials

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Deformed Sphere (3D)
« Reply #14 on: July 08, 2019, 08:12:23 am »
Hi Ashish. Why? 90 percent of my program use hardware images. Is problem with _DISPLAYORDER  _HARDWARE, _GLRENDER. Hardware layer is not visible if i use quadrics and external H file for call it. I just tried it. With _GLRENDER _BEHIND is visible hardware layer, but not OpenGL layer.... better way is maptriangle if is most used in existing program.
Logged
Pages: [1] 2   Go Up
« previous next »