PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

3D to 2D Transformation...

https://www.purebasic.fr/english/viewtopic.php?t=21007

Page 1 of 1

3D to 2D Transformation...

Posted: Wed Apr 05, 2006 6:43 pm
by Michael Vogel
Code updated for 5.20+

Hi,
I begin to write a small tool for viewing 3D data (e.g. running courses) - here's my "kernel", maybe someone can use it...

Code: Select all

; Define

   EnableExplicit

   ; 3D-Transformations - done by Michael Vogel

   #pointsize=10

   Global viewx.d,viewy.d,viewz.d
   Global scale.d
   Global screenx=640
   Global screeny=480
   Global offsetx=screenx>>1
   Global offsety=screeny>>1

   Structure Mat
      x.d[4]
      y.d[4]
      z.d[4]
      t.d[4]
   EndStructure

   Structure TripelPlus
      x.d
      y.d
      z.d
      _x.l
      _y.l
      _size.l
   EndStructure

   Structure Dupel
      von.l
      nach.l
   EndStructure

   Global Matrix.Mat
   Global Calc.Mat
   Global RotXMat.Mat
   Global RotYMat.Mat
   Global Camera.Mat
   Global CamFD.d;         focal distance: Fokusabstand

   Global Punkte=8
   Global Dim Points.TripelPlus(Punkte)

   Global Linien=12
   Global Dim Lines.Dupel(Linien)

   Define i.l,x.w,y.w,z.w
   For i=1 To Punkte
      Read.w x
      Read.w y
      Read.w z
      Points(i)\x=x
      Points(i)\y=y
      Points(i)\z=z
   Next i

   For i=1 To Linien
      Read.w x
      Read.w y
      Lines(i)\von=x
      Lines(i)\nach=y
   Next i

   DataSection
      ; Würfel-Eckepunkte
      Data.w 50,50,50
      Data.w -50,50,50
      Data.w -50,-50,50
      Data.w 50,-50,50
      Data.w 50,50,-50
      Data.w -50,50,-50
      Data.w -50,-50,-50
      Data.w 50,-50,-50
   EndDataSection

   DataSection
      ; Würfel-Kanten
      Data.w 1,2,2,3,3,4,4,1
      Data.w 1,5,2,6,3,7,4,8
      Data.w 5,6,6,7,7,8,8,5
   EndDataSection
; EndDefine
Procedure SetNorm(*m.mat)
   *m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
   *m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
   *m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
   *m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetTransformation(*m.mat, x.d, y.d, z.d)
   *m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
   *m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
   *m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
   *m\x[3]=x : *m\y[3]=y : *m\z[3]=z : *m\t[3]=1
EndProcedure
Procedure SetScale(*m.mat, x.d, y.d, z.d)
   *m\x[0]=x : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
   *m\x[1]=0 : *m\y[1]=y : *m\z[1]=0 : *m\t[1]=0
   *m\x[2]=0 : *m\y[2]=0 : *m\z[2]=z : *m\t[2]=0
   *m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotX(*m.mat, angle.d)
   Protected s.d=Sin(angle)
   Protected c.d=Cos(angle)
   *m\x[0]=1 : *m\y[0]=0 : *m\z[0]=0 : *m\t[0]=0
   *m\x[1]=0 : *m\y[1]=c : *m\z[1]=s : *m\t[1]=0
   *m\x[2]=0 : *m\y[2]=-s : *m\z[2]=c : *m\t[2]=0
   *m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotY(*m.mat, angle.d)
   Protected s.d=Sin(angle)
   Protected c.d=Cos(angle)
   *m\x[0]=c : *m\y[0]=0 : *m\z[0]=s : *m\t[0]=0
   *m\x[1]=0 : *m\y[1]=1 : *m\z[1]=0 : *m\t[1]=0
   *m\x[2]=-s : *m\y[2]=0 : *m\z[2]=c : *m\t[2]=0
   *m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure SetRotZ(*m.mat, angle.d)
   Protected s.d=Sin(angle)
   Protected c.d=Cos(angle)
   *m\x[0]=c : *m\y[0]=s : *m\z[0]=0 : *m\t[0]=0
   *m\x[1]=-s : *m\y[1]=c : *m\z[1]=0 : *m\t[1]=0
   *m\x[2]=0 : *m\y[2]=0 : *m\z[2]=1 : *m\t[2]=0
   *m\x[3]=0 : *m\y[3]=0 : *m\z[3]=0 : *m\t[3]=1
EndProcedure
Procedure Multiply(*m.mat,*n.mat,*result.mat)
   *result\x[0]=*m\x[0]**n\x[0] + *m\x[1]**n\y[0] + *m\x[2]**n\z[0] + *m\x[3]**n\t[0]
   *result\y[0]=*m\y[0]**n\x[0] + *m\y[1]**n\y[0] + *m\y[2]**n\z[0] + *m\y[3]**n\t[0]
   *result\z[0]=*m\z[0]**n\x[0] + *m\z[1]**n\y[0] + *m\z[2]**n\z[0] + *m\z[3]**n\t[0]
   *result\t[0]=*m\t[0]**n\x[0] + *m\t[1]**n\y[0] + *m\t[2]**n\z[0] + *m\t[3]**n\t[0]

   *result\x[1]=*m\x[0]**n\x[1] + *m\x[1]**n\y[1] + *m\x[2]**n\z[1] + *m\x[3]**n\t[1]
   *result\y[1]=*m\y[0]**n\x[1] + *m\y[1]**n\y[1] + *m\y[2]**n\z[1] + *m\y[3]**n\t[1]
   *result\z[1]=*m\z[0]**n\x[1] + *m\z[1]**n\y[1] + *m\z[2]**n\z[1] + *m\z[3]**n\t[1]
   *result\t[1]=*m\t[0]**n\x[1] + *m\t[1]**n\y[1] + *m\t[2]**n\z[1] + *m\t[3]**n\t[1]

   *result\x[2]=*m\x[0]**n\x[2] + *m\x[1]**n\y[2] + *m\x[2]**n\z[2] + *m\x[3]**n\t[2]
   *result\y[2]=*m\y[0]**n\x[2] + *m\y[1]**n\y[2] + *m\y[2]**n\z[2] + *m\y[3]**n\t[2]
   *result\z[2]=*m\z[0]**n\x[2] + *m\z[1]**n\y[2] + *m\z[2]**n\z[2] + *m\z[3]**n\t[2]
   *result\t[2]=*m\t[0]**n\x[2] + *m\t[1]**n\y[2] + *m\t[2]**n\z[2] + *m\t[3]**n\t[2]

   *result\x[3]=*m\x[0]**n\x[3] + *m\x[1]**n\y[3] + *m\x[2]**n\z[3] + *m\x[3]**n\t[3]
   *result\y[3]=*m\y[0]**n\x[3] + *m\y[1]**n\y[3] + *m\y[2]**n\z[3] + *m\y[3]**n\t[3]
   *result\z[3]=*m\z[0]**n\x[3] + *m\z[1]**n\y[3] + *m\z[2]**n\z[3] + *m\z[3]**n\t[3]
   *result\t[3]=*m\t[0]**n\x[3] + *m\t[1]**n\y[3] + *m\t[2]**n\z[3] + *m\t[3]**n\t[3]
EndProcedure
Procedure Recalc()
   Protected i

   Multiply(@Camera,@Matrix,@Calc)
   For i=1 To Punkte
      With Points(i)
         viewx = \x*calc\x[0] + \y*calc\x[1] + \z*calc\x[2] + calc\x[3]
         viewy = \x*calc\y[0] + \y*calc\y[1] + \z*calc\y[2] + calc\y[3]
         viewz = \x*calc\z[0] + \y*calc\z[1] + \z*calc\z[2] + calc\z[3]

         scale=CamFD/viewz
         \_x=viewx*scale+offsetx
         \_y=viewy*scale+offsety
         \_size=scale*#Pointsize

      EndWith
   Next i
EndProcedure
Procedure Redraw()
   Protected i.w

   StartDrawing(ScreenOutput())
   Box(0,0,screenx,screeny,$f0f0f0)

   For i=1 To Punkte
      Circle(Points(i)\_x,Points(i)\_y,Points(i)\_size,$e04040)
   Next i
   For i=1 To Linien
      LineXY(Points(lines(i)\von)\_x,Points(lines(i)\von)\_y,Points(lines(i)\nach)\_x,Points(lines(i)\nach)\_y,$8080f0)
   Next i

   StopDrawing()
EndProcedure
Procedure Text(x.l,y.l,v.d)
   StartDrawing(ScreenOutput())
   DrawText(x,y,StrD(v,3))
   StopDrawing()
EndProcedure
Procedure Window()
   Global win=OpenWindow(0,0,0,screenx,screeny,"3D",#PB_Window_ScreenCentered)
   InitSprite()
   OpenWindowedScreen(WindowID(0),0,0,screenx,screeny,0,0,0)
   SetTimer_(win,1,100,0)
EndProcedure
Procedure Init()
   CamFD=200
   SetTransformation(@Camera,0,0,200)
EndProcedure
Procedure Main()
   SetNorm(@matrix)
   Window()
   Repeat
      FlipBuffers()

      Recalc()
      Redraw()

      Text(10,50,CamFD)
      Text(10,70,scale)

      Select WaitWindowEvent()

      Case #WM_TIMER
         ;n+1
         ;SetRoty(@Camera,n/#PI/2)

      Case #WM_CHAR
         Break

      Case #WM_LBUTTONDOWN
         ;

      Case #WM_RBUTTONDOWN
         ;

      Case #WM_MOUSEMOVE

         If GetKeyState_(#VK_SHIFT)&128
            SetTransformation(@matrix,WindowMouseX(0)-offsetx,WindowMouseY(0)-offsety,0)
         ElseIf GetKeyState_(#VK_CONTROL)&128
            SetScale(@matrix,WindowMouseX(0)/100,WindowMouseY(0)/100,1)
         Else
            SetRotx(@RotXMat,WindowMouseY(0)/100)
            SetRoty(@RotYMat,WindowMouseX(0)/100)
            Multiply(@RotXMat,@RotYMat,@matrix)
         EndIf

      EndSelect

   ForEver
   KillTimer_(win,1)
EndProcedure

Init()
Main()

Posted: Mon Apr 10, 2006 8:49 am
by dell_jockey
Hi Michael,

"danke schön" for sharing this code!

Posted: Mon Apr 10, 2006 6:31 pm
by SFSxOI
Michael;

Just what I needed for an upcoming project. How about 2D to 3D also?

Posted: Mon Apr 10, 2006 6:50 pm
by einander
Nice code.
Thanks!

Posted: Mon Apr 10, 2006 8:20 pm
by Dare2
Very nice, thanks.

Posted: Thu May 18, 2006 7:55 am
by Michael Vogel
Just have finished a "first beta" of my 3D viewer of my sport tracks, everyone who likes, can have a look:

http://sudokuprogram.googlepages.com/forerunner.exe
http://sudokuprogram.googlepages.com/MichaelVogel.hst

Remarks:
* The history file can be produced by GPS products from garmin (Training Center), so if anyone have this, show your on courses!
* You can use the mouse or the cursor keys (space to toggle) for the 3D view
* Important Keys
O - options
p/P - Point size
z/Z - Zoom
x,i - change colors and text
c - change color set

Posted: Thu May 18, 2006 8:10 am
by benny
@Michael:

Thanks for sharing the code and congratulations ... the tool looks excellent :!:
Well done ... and the transparent green looks very nice !!!

Posted: Thu May 18, 2006 8:45 am
by dell_jockey
Very nice Michael!

btw: interesting cycling track...

Posted: Thu May 18, 2006 9:20 am
by Dare2
Cool.

My legs hurt and my lungs ache just from looking at the last one.

Posted: Mon May 29, 2006 7:49 am
by Michael Vogel
Just a "small" update of the program (http://sudokuprogram.googlepages.com/forerunner.exe) now with more power like antialiasing (can be switched on/off with "a")
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited