Page 1 of 1

A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 19, 2011 8:08 pm
by Olliv
Hello,

This code displays a cube and allows the user to rotate it in lots of manners. The cube can me be moved too.

All is okay in the keyboard. I just don't know translate it. If anybody could help me, it would be useful.
I hope I will discover a better SPRITE3D library on the next update of PureBASIC (because it doesn't works fine on Linux, shame...) because this library is like the idea of PureBASIC I make for myself: small, simple and cool!

Without hint, you can even test it: all is in the keyboard. absolute rotations, relative rotations, absolute moving, relative moving, and relative shifting moving. All and just what is necessary to continue to a bigger project without bigger problems!
(Cf >> http://www.purebasic.fr/english/viewtop ... 8&start=30)

++

Code: Select all

      Structure OIJK
            Ox.D: Oy.D: Oz.D
            Ix.D: Iy.D: Iz.D
            Jx.D: Jy.D: Jz.D
            Kx.D: Ky.D: Kz.D
      EndStructure
      Define Rep.OIJK: Rep\Ix = 1. : Rep\Jy = 1. : Rep\Kz = 1.
      Global.I DskW, DskH, DskD, DskF, AffW, AffH
      Global.D Zoom = 1000.
Macro Rect(mx, my, mw, mh, mc)
      Line(mx, my, mw, 1, mc)
      Line(mx, my, 1, mh, mc)
      Line(mx, my + mh - 1, mw, 1, mc)
      Line(mx + mw - 1, my, 1, mh, mc)
EndMacro
Macro Rotation(a, b, Cos, Sin)
      x = a
      y = b
      a = x * Cos - y * Sin
      b = x * Sin + y * Cos
EndMacro
Macro RotaAbso(axe, a, b, c) ; Rotation selon le repère du décor
      Cos = Cos(c)
      Sin = Sin(c)
      Rotation(axe\I#a, axe\I#b, Cos, Sin)
      Rotation(axe\J#a, axe\J#b, Cos, Sin)
      Rotation(axe\K#a, axe\K#b, Cos, Sin)
EndMacro
Macro RotaRela(axe, a, b, c) ; Rotation selon le repère de l'objet
      Cos = Cos(c)
      Sin = Sin(c)
      Rotation(axe\a#x, axe\b#x, Cos, Sin)
      Rotation(axe\a#y, axe\b#y, Cos, Sin)
      Rotation(axe\a#z, axe\b#z, Cos, Sin)
EndMacro
Macro Transla(mObject, mInitial, mFinal, mAxe, mStep)
      For MI = mInitial To mFinal
            mObject(MI)\mAxe + mStep
      Next
EndMacro
      Define.D x, y, z, Cos, Sin, v = 0.05, Perspective, dx, dy, dz, OnX, OnY
      Define.D x1, y1, x2, y2
      InitSprite()
      InitSprite3D()
      InitKeyboard()
      ExamineDesktops()
      DskW = DesktopWidth(0)
      DskH = DesktopHeight(0)
      DskD = DesktopDepth(0)
      DskF = DesktopFrequency(0)
      AffW = DskW
      AffH = DskH
      OpenScreen(DskW, DskH, DskD, "PureScreen")    
      KeyboardMode(#PB_Keyboard_International)
      Global _Sol = 1, _Sol2 = 2
      CreateSprite(_Sol, 256, 256, #PB_Sprite_Texture)
      StartDrawing(SpriteOutput(_Sol) )
            Box(0, 0, 256, 256, RGB(1, 1, 128) )
            Box(1, 1, 254, 254, RGB(1, 1, 254) )
            For I = 0 To 15
                  Rect(16 + I, 16 + I, 224 - I * 2, 224 - I * 2, RGB(1, 1, 127 + I * 8) )
            Next
      StopDrawing()
      CreateSprite3D(_Sol0, _Sol)
      CreateSprite3D(_Sol1, _Sol)
      CreateSprite3D(_Sol2, _Sol)
      CreateSprite3D(_Sol3, _Sol)
      CreateSprite3D(_Sol4, _Sol)
      CreateSprite3D(_Sol5, _Sol)
      Structure V3
            x.D: y.D : z.D      
      EndStructure
Macro SetV3(var, xv, yv, zv)
      var\x = xv
      var\y = yv
      var\z = zv
EndMacro
      Global Dim Sol.V3(7)
      SetV3(Sol(0),  1.,  1.,  1.)
      SetV3(Sol(1), -1.,  1.,  1.)
      SetV3(Sol(2), -1.,  1., -1.)
      SetV3(Sol(3),  1.,  1., -1.)
      SetV3(Sol(4),  1., -1.,  1.)
      SetV3(Sol(5), -1., -1.,  1.)
      SetV3(Sol(6), -1., -1., -1.)
      SetV3(Sol(7),  1., -1., -1.)
      Global.I Dim Vertex0(5)
      Global.I Dim Vertex1(5)
      Global.I Dim Vertex2(5)
      Global.I Dim Vertex3(5)
Macro SetVertices(Mn, Ma, Mb, Mc, Md)
      Vertex0(Mn) = Ma            
      Vertex1(Mn) = Mb            
      Vertex2(Mn) = Mc            
      Vertex3(Mn) = Md            
EndMacro            
      SetVertices(0, 0, 1, 2, 3)
      SetVertices(1, 1, 0, 4, 5)
      SetVertices(2, 4, 7, 6, 5)
      SetVertices(3, 2, 6, 7, 3)
      SetVertices(4, 0, 3, 7, 4)
      SetVertices(5, 1, 5, 6, 2)
Structure VertexDisplay
      x.D
      y.D
      z.D
EndStructure
      Global Dim VD.VertexDisplay(7)
Macro SetVertex(Mn, Mx, My, Mz)
      x1 = AffW / 2
      y1 = AffH / 2
      dx = Mx
      dy = My
      dz = Mz - 10.
      Perspective = 1. / Sqr(dx * dx + dy * dy + dz * dz)
      OnX = Mx * Perspective * Zoom
      OnY = My * Perspective * Zoom
      x2 = x1 + OnX
      y2 = y1 - OnY
      VD(Mn)\x = x2
      VD(Mn)\y = y2
      VD(Mn)\z = Chiffre + 10.59 - Mz
EndMacro
Macro TransformSprite(mn, ma, mb, mc, md)
      TransformSprite3D(mn, VD(ma)\x, VD(ma)\y, VD(ma)\z, VD(mb)\x, VD(mb)\y, VD(mb)\z, VD(mc)\x, VD(mc)\y, VD(mc)\z, VD(md)\x, VD(md)\y, VD(md)\z)
      DisplaySprite3D(mn, 0, 0)
EndMacro
Macro Applica(axe, mx, my, mz, mI, mJ, mK)
      mx = axe\Ox + mI * axe\Ix + mJ * axe\Jx + mK * axe\Kx
      my = axe\Oy + mI * axe\Iy + mJ * axe\Jy + mK * axe\Ky
      mz = axe\Oz + mI * axe\Iz + mJ * axe\Jz + mK * axe\Kz
EndMacro
Macro Dessin(axe)
      For I = 0 To 7
            Applica(axe, x, y, z, Sol(I)\x, Sol(I)\y, Sol(I)\z)
            SetVertex(I, x, y, z)
      Next
      Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
      For I = 0 To 5
            TransformSprite(_Sol0, Vertex0(I), Vertex1(I), Vertex2(I), Vertex3(I) )
      Next      
EndMacro
Macro Deplace(axe, mx, my, mz)
      Applica(axe, axe\Ox, axe\Oy, axe\Oz, mx, my, mz)
EndMacro
      Repeat
            Delay(16)
            ExamineKeyboard()
            If KeyboardPushed(#PB_Key_Up)   : RotaAbso(Rep, y, z, v) : EndIf
            If KeyboardPushed(#PB_Key_Down) : RotaAbso(Rep, y, z, -v): EndIf
            If KeyboardPushed(#PB_Key_Tab)  : RotaAbso(Rep, x, z, v) : EndIf
            If KeyboardPushed(#PB_Key_A)    : RotaAbso(Rep, x, z, -v): EndIf
            If KeyboardPushed(#PB_Key_Left) : RotaAbso(Rep, x, y, v) : EndIf
            If KeyboardPushed(#PB_Key_Right): RotaAbso(Rep, x, y, -v): EndIf
            If KeyboardPushed(#PB_Key_Pad8) : RotaRela(Rep, J, K, v) : EndIf
            If KeyboardPushed(#PB_Key_Pad2) : RotaRela(Rep, J, K, -v): EndIf
            If KeyboardPushed(#PB_Key_Pad4) : RotaRela(Rep, I, J, v) : EndIf
            If KeyboardPushed(#PB_Key_Pad6) : RotaRela(Rep, I, J, -v): EndIf
            If KeyboardPushed(#PB_Key_Pad9) : RotaRela(Rep, K, I, v) : EndIf
            If KeyboardPushed(#PB_Key_Pad3) : RotaRela(Rep, K, I, -v): EndIf
            If KeyboardPushed(#PB_Key_T)    : Zoom * 1.01            : EndIf
            If KeyboardPushed(#PB_Key_Y)    : Zoom * 0.99            : EndIf
            If KeyboardPushed(#PB_Key_Q)    : Rep\Ox - 0.1           : EndIf
            If KeyboardPushed(#PB_Key_S)    : Rep\Ox + 0.1           : EndIf
            If KeyboardPushed(#PB_Key_E)    : Rep\Oy + 0.1           : EndIf
            If KeyboardPushed(#PB_Key_D)    : Rep\Oy - 0.1           : EndIf
            If KeyboardPushed(#PB_Key_R)    : Rep\Oz - 0.1           : EndIf
            If KeyboardPushed(#PB_Key_F)    : Rep\Oz + 0.1           : EndIf
            If KeyboardPushed(#PB_Key_C): Transla(Sol, 0, 7, x, 0.1)    : EndIf
            If KeyboardPushed(#PB_Key_V): Transla(Sol, 0, 7, x, (-0.1) ): EndIf
            If KeyboardPushed(#PB_Key_B): Transla(Sol, 0, 7, y, 0.1)    : EndIf
            If KeyboardPushed(#PB_Key_N): Transla(Sol, 0, 7, y, (-0.1) ): EndIf
            If KeyboardPushed(#PB_Key_G): Transla(Sol, 0, 7, z, 0.1)    : EndIf
            If KeyboardPushed(#PB_Key_H): Transla(Sol, 0, 7, z, (-0.1) ): EndIf
            If KeyboardPushed(#PB_Key_1): Deplace(Rep, (-0.1), 0., 0.) : EndIf
            If KeyboardPushed(#PB_Key_2): Deplace(Rep,   0.1 , 0., 0.) : EndIf
            If KeyboardPushed(#PB_Key_3): Deplace(Rep, 0., (-0.1), 0.) : EndIf
            If KeyboardPushed(#PB_Key_4): Deplace(Rep, 0.,   0.1 , 0.) : EndIf
            If KeyboardPushed(#PB_Key_5): Deplace(Rep, 0., 0., (-0.1)) : EndIf
            If KeyboardPushed(#PB_Key_6): Deplace(Rep, 0., 0.,   0.1 ) : EndIf
            ClearScreen(RGB(254, 254, 254) )
            StartDrawing(ScreenOutput() )
                  DrawingMode(#PB_2DDrawing_Transparent)
                  DrawText(0, 0, "Haut/Bas  Gauche/Droite  Tab/A  T/Y  Q/S  E/D  R/F  C/V  B/N  G/H  1/2  3/4  5/6  Pad4/Pad6  Pad2/Pad8  Pad3/Pad9", RGB(1, 1, 1) )
            StopDrawing()
            Start3D()
                  Sprite3DQuality(#PB_Sprite3D_BilinearFiltering)
                  Dessin(Rep)
            Stop3D()
            FlipBuffers()
      Until KeyboardPushed(#PB_Key_Escape)

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 19, 2011 8:55 pm
by Pureabc
Nice example.

Thanks.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 19, 2011 9:41 pm
by Olliv
You're welcome!

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 19, 2011 11:45 pm
by idle
for linux think you need to swap the x2 and x3 and add the height not sure if it's right though as can't check it on windows at the moment.

Code: Select all

Macro TransformSprite(mn, ma, mb, mc, md)
  CompilerIf #PB_OS_Linux 
     TransformSprite3D(mn, VD(ma)\x, VD(ma)\y, VD(ma)\z, VD(mc)\x, VD(mb)\y, VD(mb)\z, VD(mb)\x, VD(mc)\y, VD(mc)\z, VD(md)\x, VD(md)\y, VD(md)\z)
      DisplaySprite3D(mn, 0, DskH)  
   CompilerElse  
      TransformSprite3D(mn, VD(ma)\x, VD(ma)\y, VD(ma)\z, VD(mb)\x, VD(mb)\y, VD(mb)\z, VD(mc)\x, VD(mc)\y, VD(mc)\z, VD(md)\x, VD(md)\y, VD(md)\z)
      DisplaySprite3D(mn, 0, 0)
    CompilerEndIf  
       
EndMacro


Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sun Feb 20, 2011 1:23 am
by Vera
thank you for sharing :)
it's really nice to smoothly motion the blue box across the screen

@ idle
yes - you're right - with your enhanced macro I also see a blue turning cube at the bottom of the screen which was only plain white without the addition :)
(on Linux - Suse 11.1)

sorry I can't find that hight setting ad hoc - but with the shortkey 'D' you've moved it upwards quickly ;)

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sun Feb 20, 2011 5:11 pm
by Olliv
Idle wrote:for linux think you need to swap the x2 and x3 and add the height not sure if it's right
I thank you for this tip I think I wouldn't find alone. But, the transformation of the texture on OpenGL is not complete like on DIRECTX: If you draw a road in example, the white and yellow patterns on the black road will keep the same size wherever, on OPENGL. There is no reduction of the size of the patterns if this one go more far (no reduction in the two perpendicular orientations on the plane of the texture : only in one of the two orientations).

However, even if it's not right, I am very surprised by the existence of this solution.

Vera wrote:thank you for sharing
Bitte!
Vera wrote:sorry I can't find that hight setting ad hoc - but with the shortkey 'D' you've moved it upwards quickly ;)
It's because I have the wrong reflex to blend english and french term in my codes... I think without this, you could find height' setting easily. I am sorry...

I use a term named " Aff " from the french word "Afficher" (= to display).
x1 and y1 are the center of the view (which is equivalent to the center of the screen).
x2 and y2 are the final position of the displayed vertex after ALL math operation.

Code: Select all

Macro SetVertex(Mn, Mx, My, Mz)
      x1 = AffW / 2
      y1 = AffH / 2 ;                                                            <-- We can add here or...
      dx = Mx
      dy = My
      dz = Mz - 10.
      Perspective = 1. / Sqr(dx * dx + dy * dy + dz * dz)
      OnX = Mx * Perspective * Zoom
      OnY = My * Perspective * Zoom
      x2 = x1 + OnX
      y2 = y1 - OnY
      VD(Mn)\x = x2
      VD(Mn)\y = y2
      VD(Mn)\z = Chiffre + 10.59 - Mz
EndMacro

Code: Select all

      InitSprite()
      InitSprite3D()
      InitKeyboard()
      ExamineDesktops()
      DskW = DesktopWidth(0)
      DskH = DesktopHeight(0)
      DskD = DesktopDepth(0)
      DskF = DesktopFrequency(0)
      AffW = DskW
      AffH = DskH                  ;        <-- ... here.
Term "Dsk" = "DeSKtop"

It's not a very optimized code really...

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sun Feb 27, 2011 4:16 am
by WilliamL
Using idle's Macro TransformSprite, for Linux, the program works on a Mac too.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Mar 26, 2011 12:30 pm
by Olliv
WilliamL,

I thank you for this information which confirms the quality of the Idea suggested by Idle.

But, does the transformation match to the real perspective on OpenGL? (I would really like it does)

I'm on XP and when I set OpenGL in the sub-system options, the transformation of the texture doesn't match to the real perspective. I just get a texture transformation in the strict proportions of the face, not in the rules of the perspective.

However, if it's a bug on my computer only (maybe the version of OpenGL, I don't really know), I think the macro of Idle will be very intersting for compatibility.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Mon Jan 25, 2021 3:28 pm
by infratec
Ported to newer PB versions:

Code: Select all

Structure OIJK
  Ox.D: Oy.D: Oz.D
  Ix.D: Iy.D: Iz.D
  Jx.D: Jy.D: Jz.D
  Kx.D: Ky.D: Kz.D
EndStructure
Define Rep.OIJK: Rep\Ix = 1 : Rep\Jy = 1 : Rep\Kz = 1
Global.I DskW, DskH, DskD, DskF, AffW, AffH
Global.D Zoom = 1000.
Macro Rect(mx, my, mw, mh, mc)
  Line(mx, my, mw, 1, mc)
  Line(mx, my, 1, mh, mc)
  Line(mx, my + mh - 1, mw, 1, mc)
  Line(mx + mw - 1, my, 1, mh, mc)
EndMacro
Macro Rotation(a, b, Cos, Sin)
  x = a
  y = b
  a = x * Cos - y * Sin
  b = x * Sin + y * Cos
EndMacro
Macro RotaAbso(axe, a, b, c) ; Rotation selon le repère du décor
  Cos = Cos(c)
  Sin = Sin(c)
  Rotation(axe\I#a, axe\I#b, Cos, Sin)
  Rotation(axe\J#a, axe\J#b, Cos, Sin)
  Rotation(axe\K#a, axe\K#b, Cos, Sin)
EndMacro
Macro RotaRela(axe, a, b, c) ; Rotation selon le repère de l'objet
  Cos = Cos(c)
  Sin = Sin(c)
  Rotation(axe\a#x, axe\b#x, Cos, Sin)
  Rotation(axe\a#y, axe\b#y, Cos, Sin)
  Rotation(axe\a#z, axe\b#z, Cos, Sin)
EndMacro
Macro Transla(mObject, mInitial, mFinal, mAxe, mStep)
  For MI = mInitial To mFinal
    mObject(MI)\mAxe + mStep
  Next
EndMacro
Define.D x, y, z, Cos, Sin, v = 0.05, Perspective, dx, dy, dz, OnX, OnY
Define.D x1, y1, x2, y2
InitSprite()
InitKeyboard()
ExamineDesktops()
DskW = DesktopWidth(0)
DskH = DesktopHeight(0)
DskD = DesktopDepth(0)
DskF = DesktopFrequency(0)
AffW = DskW
AffH = DskH
OpenScreen(DskW, DskH, DskD, "PureScreen")   
KeyboardMode(#PB_Keyboard_International)
Global _Sol = 1, _Sol2 = 2
CreateSprite(_Sol, 256, 256)
StartDrawing(SpriteOutput(_Sol) )
Box(0, 0, 256, 256, RGB(1, 1, 128) )
Box(1, 1, 254, 254, RGB(1, 1, 254) )
For I = 0 To 15
  Rect(16 + I, 16 + I, 224 - I * 2, 224 - I * 2, RGB(1, 1, 127 + I * 8) )
Next
StopDrawing()

CopySprite(_Sol, _Sol0)
CopySprite(_Sol, _Sol1)
CopySprite(_Sol, _Sol2)
CopySprite(_Sol, _Sol3)
CopySprite(_Sol, _Sol4)
CopySprite(_Sol, _Sol5)
Structure V3
  x.D: y.D : z.D     
EndStructure
Macro SetV3(var, xv, yv, zv)
  var\x = xv
  var\y = yv
  var\z = zv
EndMacro
Global Dim Sol.V3(7)
SetV3(Sol(0),  1.,  1.,  1.)
SetV3(Sol(1), -1.,  1.,  1.)
SetV3(Sol(2), -1.,  1., -1.)
SetV3(Sol(3),  1.,  1., -1.)
SetV3(Sol(4),  1., -1.,  1.)
SetV3(Sol(5), -1., -1.,  1.)
SetV3(Sol(6), -1., -1., -1.)
SetV3(Sol(7),  1., -1., -1.)
Global.I Dim Vertex0(5)
Global.I Dim Vertex1(5)
Global.I Dim Vertex2(5)
Global.I Dim Vertex3(5)
Macro SetVertices(Mn, Ma, Mb, Mc, Md)
  Vertex0(Mn) = Ma           
  Vertex1(Mn) = Mb           
  Vertex2(Mn) = Mc           
  Vertex3(Mn) = Md           
EndMacro           
SetVertices(0, 0, 1, 2, 3)
SetVertices(1, 1, 0, 4, 5)
SetVertices(2, 4, 7, 6, 5)
SetVertices(3, 2, 6, 7, 3)
SetVertices(4, 0, 3, 7, 4)
SetVertices(5, 1, 5, 6, 2)
Structure VertexDisplay
  x.D
  y.D
  z.D
EndStructure
Global Dim VD.VertexDisplay(7)
Macro SetVertex(Mn, Mx, My, Mz)
  x1 = AffW / 2
  y1 = AffH / 2
  dx = Mx
  dy = My
  dz = Mz - 10.
  Perspective = 1.0 / Sqr(dx * dx + dy * dy + dz * dz)
  OnX = Mx * Perspective * Zoom
  OnY = My * Perspective * Zoom
  x2 = x1 + OnX
  y2 = y1 - OnY
  VD(Mn)\x = x2
  VD(Mn)\y = y2
  VD(Mn)\z = Chiffre + 10.59 - Mz
EndMacro
Macro TransformSprite1(mn, ma, mb, mc, md)
  TransformSprite(mn, VD(ma)\x, VD(ma)\y, VD(ma)\z, VD(mb)\x, VD(mb)\y, VD(mb)\z, VD(mc)\x, VD(mc)\y, VD(mc)\z, VD(md)\x, VD(md)\y, VD(md)\z)
  DisplaySprite(mn, 0, 0)
EndMacro
Macro Applica(axe, mx, my, mz, mI, mJ, mK)
  mx = axe\Ox + mI * axe\Ix + mJ * axe\Jx + mK * axe\Kx
  my = axe\Oy + mI * axe\Iy + mJ * axe\Jy + mK * axe\Ky
  mz = axe\Oz + mI * axe\Iz + mJ * axe\Jz + mK * axe\Kz
EndMacro
Macro Dessin(axe)
  For I = 0 To 7
    Applica(axe, x, y, z, Sol(I)\x, Sol(I)\y, Sol(I)\z)
    SetVertex(I, x, y, z)
  Next
  For I = 0 To 5
    TransformSprite1(_Sol0, Vertex0(I), Vertex1(I), Vertex2(I), Vertex3(I) )
  Next     
EndMacro
Macro Deplace(axe, mx, my, mz)
  Applica(axe, axe\Ox, axe\Oy, axe\Oz, mx, my, mz)
EndMacro
Repeat
  Delay(16)
  ExamineKeyboard()
  If KeyboardPushed(#PB_Key_Up)   : RotaAbso(Rep, y, z, v) : EndIf
  If KeyboardPushed(#PB_Key_Down) : RotaAbso(Rep, y, z, -v): EndIf
  If KeyboardPushed(#PB_Key_Tab)  : RotaAbso(Rep, x, z, v) : EndIf
  If KeyboardPushed(#PB_Key_A)    : RotaAbso(Rep, x, z, -v): EndIf
  If KeyboardPushed(#PB_Key_Left) : RotaAbso(Rep, x, y, v) : EndIf
  If KeyboardPushed(#PB_Key_Right): RotaAbso(Rep, x, y, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad8) : RotaRela(Rep, J, K, v) : EndIf
  If KeyboardPushed(#PB_Key_Pad2) : RotaRela(Rep, J, K, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad4) : RotaRela(Rep, I, J, v) : EndIf
  If KeyboardPushed(#PB_Key_Pad6) : RotaRela(Rep, I, J, -v): EndIf
  If KeyboardPushed(#PB_Key_Pad9) : RotaRela(Rep, K, I, v) : EndIf
  If KeyboardPushed(#PB_Key_Pad3) : RotaRela(Rep, K, I, -v): EndIf
  If KeyboardPushed(#PB_Key_T)    : Zoom * 1.01            : EndIf
  If KeyboardPushed(#PB_Key_Y)    : Zoom * 0.99            : EndIf
  If KeyboardPushed(#PB_Key_Q)    : Rep\Ox - 0.1           : EndIf
  If KeyboardPushed(#PB_Key_S)    : Rep\Ox + 0.1           : EndIf
  If KeyboardPushed(#PB_Key_E)    : Rep\Oy + 0.1           : EndIf
  If KeyboardPushed(#PB_Key_D)    : Rep\Oy - 0.1           : EndIf
  If KeyboardPushed(#PB_Key_R)    : Rep\Oz - 0.1           : EndIf
  If KeyboardPushed(#PB_Key_F)    : Rep\Oz + 0.1           : EndIf
  If KeyboardPushed(#PB_Key_C): Transla(Sol, 0, 7, x, 0.1)    : EndIf
  If KeyboardPushed(#PB_Key_V): Transla(Sol, 0, 7, x, (-0.1) ): EndIf
  If KeyboardPushed(#PB_Key_B): Transla(Sol, 0, 7, y, 0.1)    : EndIf
  If KeyboardPushed(#PB_Key_N): Transla(Sol, 0, 7, y, (-0.1) ): EndIf
  If KeyboardPushed(#PB_Key_G): Transla(Sol, 0, 7, z, 0.1)    : EndIf
  If KeyboardPushed(#PB_Key_H): Transla(Sol, 0, 7, z, (-0.1) ): EndIf
  If KeyboardPushed(#PB_Key_1): Deplace(Rep, (-0.1), 0, 0) : EndIf
  If KeyboardPushed(#PB_Key_2): Deplace(Rep,   0.1 , 0, 0) : EndIf
  If KeyboardPushed(#PB_Key_3): Deplace(Rep, 0, (-0.1), 0) : EndIf
  If KeyboardPushed(#PB_Key_4): Deplace(Rep, 0,   0.1 , 0) : EndIf
  If KeyboardPushed(#PB_Key_5): Deplace(Rep, 0, 0, (-0.1)) : EndIf
  If KeyboardPushed(#PB_Key_6): Deplace(Rep, 0, 0,   0.1 ) : EndIf
  ClearScreen(RGB(254, 254, 254) )
  StartDrawing(ScreenOutput() )
  DrawingMode(#PB_2DDrawing_Transparent)
  DrawText(0, 0, "Haut/Bas  Gauche/Droite  Tab/A  T/Y  Q/S  E/D  R/F  C/V  B/N  G/H  1/2  3/4  5/6  Pad4/Pad6  Pad2/Pad8  Pad3/Pad9", RGB(1, 1, 1) )
  StopDrawing()
  
  Dessin(Rep)
  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Tue Jan 26, 2021 12:22 pm
by Kwai chang caine
Thanks INFRATEC works great now here :wink:
Thanks obviously too, to OLLI for create and sharing this nice code 8)

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 06, 2021 7:44 pm
by ludoke
infratec

Thanks for that great example ,but can you explain

Rotation(axe\I#a, axe\I#b, Cos, Sin)

What means I#a and I#b ?

I suppose somthing with the macros ?

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Feb 06, 2021 8:11 pm
by infratec
It is a Macro parameter stuff.
Look at the help of Macros.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sat Jun 05, 2021 8:54 pm
by Olli
Thank you infratec for this update, I discover now only !

I do not know if ludoke has understood the macros. Anyway, it is a pleasure to remember to this source code. Idle added a tip to display rightly on Linux (short modification).

Code: Select all

Macro RotaAbso(axe, a, b, c) ; Rotation depending of the world
  Cos = Cos(c)
  Sin = Sin(c)
  Rotation(axe\I#a, axe\I#b, Cos, Sin)
  Rotation(axe\J#a, axe\J#b, Cos, Sin)
  Rotation(axe\K#a, axe\K#b, Cos, Sin)
EndMacro
Macro RotaRela(axe, a, b, c) ; Rotation depending of the object
  Cos = Cos(c)
  Sin = Sin(c)
  Rotation(axe\a#x, axe\b#x, Cos, Sin)
  Rotation(axe\a#y, axe\b#y, Cos, Sin)
  Rotation(axe\a#z, axe\b#z, Cos, Sin)
EndMacro
The distribution of the vectors is very "expensive" : it uses lots of variables, but this allows us to understand the basic 2D operations.

A 3D point here is the addition of three vectors I, J and K. And each vector contains 3 values x, y and z.

x, y, z : values of the static space
I, J, K : 3 unity-vectors which compose the future 3D points.

A point can have the position 3I + 2J+ 7K which is the position 3,2,7 in the space when IJK has not been rotated.

The rotations add themselves : depending of 3 planes IJ, JK or KI.
IJ is perpendicular to Z object axis
JK is perpendicular to X object axis
KI is perpendicular to Y object axis.

This algo cuts each rotation the one after the other, does not allow the slerp (spherical lerp), and requires to keep a rotation axis order : XYZ versus XZY.
There is no quaternion here, but allows us however to compare on the fly how could a quaternion operate (the quaternion does not require an axis order, which is replaced with a fourth component : W, this value blends the 3 rotations and also allows the slerps.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Mon Jun 07, 2021 8:35 am
by Joris
Syntax Error at :
Define Rep.OIJK: Rep\Ix = 1. : Rep\Jy = 1. : Rep\Kz = 1.

Using PB 5.71 LTS.

Re: A little bit of 3D in a code shorter than 200 lines

Posted: Sun Jun 13, 2021 12:26 pm
by Olli
@Joris

Fred restricted the syntax of the immediate floating point values :

Code: Select all

x0 = 1.    ; forbidden
x1 = 1.0   ; ok
Edit : ups ! Nop : no problem with floating point. I will do a check of what it is causing an error...

Edit 2 : check is done. It is really a problem of syntax change depending of the versions. This source code was made in 2011, before the status of LTS (long term support) on PureBasic. The update of infratec is right. This was just a problem of floating point syntax.

Add the zero decimal (1.0 ) or remove the dot, as infratec did, to have a right code !

Code: Select all

x0 = 1     ; ok
x1 = 1.    ; forbidden
x2 = 1.0   ; ok
@Ludoke
Ludoke wrote: What means I#a and I#b ?
#a and #b will respectively represent two of the three 3D directions.