PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

3d problem

https://www.purebasic.fr/german/viewtopic.php?t=17537

Seite 2 von 2

Verfasst: 11.12.2008 18:11
von Kevin
das klappt bei mir aber nicht

Verfasst: 11.12.2008 20:13
von alter Mann
vielleicht so ?

Code: Alles auswählen

InitSprite()

OpenWindow(0, 200, 200, 410, 410, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
OpenWindowedScreen(WindowID(0), 5, 105, 400, 300, 0, 0, 0)

If CreateGadgetList(WindowID(0))
  CheckBoxGadget(1, 5, 5, 100, 20, "-x")
  CheckBoxGadget(2, 5, 25, 100, 20, "-y")
  CheckBoxGadget(3, 5, 45, 100, 20, "-z")
  CheckBoxGadget(4, 105, 5, 100, 20, "x")
  CheckBoxGadget(5, 105, 25, 100, 20, "y")
  CheckBoxGadget(6, 105, 45, 100, 20, "z")
  ButtonGadget(7, 5, 65, 200, 20, "zurücksetzen")
  TextGadget(8,210,65,190,20,"")
EndIf

Structure Kor
  x.w
  y.w
  z.w
  rgb.l
EndStructure
Global NewList Kor.Kor()
Global NewList Kor1.Kor()

Procedure AddKor(x, y, z, rgb)
  AddElement(Kor())
  Kor()\x = x
  Kor()\y = y
  Kor()\z = z
  Kor()\rgb = rgb
EndProcedure

Structure Cb
  x.w
  y.w
  rgb.l
EndStructure
Global NewList Cb.Cb()
Procedure AddCb(x, y, rgb)
  AddElement(Cb())
  Cb()\x = x
  Cb()\y = y
  Cb()\rgb = rgb
EndProcedure

AddKor(50, 50, 100, RGB(96, 96, 96))
AddKor(150, 50, 100, RGB(96, 0, 0))
AddKor(50, 150, 100, RGB(0, 96, 0))
AddKor(150, 150, 100, RGB(0, 0, 96))

AddKor(50, 50, 50, RGB(192, 192, 192))
AddKor(150, 50, 50, RGB(192, 0, 0))
AddKor(50, 150, 50, RGB(0, 192, 0))
AddKor(150, 150, 50, RGB(0, 0, 192))

Global Dim a.f(4,4)

Procedure.f InitM()
  a(1, 1) = 1.0
  a(2, 1) = 0.0
  a(3, 1) = 0.0
  a(4, 1) = 0.0
 
  a(1, 2) = 0.0
  a(2, 2) = 1.0
  a(3, 2) = 0.0
  a(4, 2) = 0.0
 
  a(1, 3) = 0.0
  a(2, 3) = 0.0
  a(3, 3) = 1.0
  a(4, 3) = 0.0
 
  a(1, 4) = 0.0
  a(2, 4) = 0.0
  a(3, 4) = 0.0
  a(4, 4) = 1.0
 
EndProcedure

Procedure.f GetMX(xx, yy, zz, ww)
  x_neu.f = xx*a(1, 1) + yy*a(1, 2) + zz*a(1, 3) + ww*a(1, 4)
  ProcedureReturn x_neu
EndProcedure

Procedure.f GetMY(xx, yy, zz, ww)
  y_neu.f = xx*a(2, 1) + yy*a(2, 2) + zz*a(2, 3) + ww*a(2, 4)
  ProcedureReturn y_neu
EndProcedure

Procedure.f GetMZ(xx, yy, zz, ww)
  z_neu.f = xx*a(3, 1) + yy*a(3, 2) + zz*a(3, 3) + ww*a(3, 4)
  ProcedureReturn z_neu
EndProcedure

Procedure.f GetMW(xx, yy, zz, ww)
  w_neu.f = xx*a(4, 1) + yy*a(4, 2) + zz*a(4, 3) + ww*a(4, 4)
  ProcedureReturn w_neu
EndProcedure

Procedure.f SetMX(wx.f)
  a(2, 2) = Cos(wx)
  a(2, 3) = -Sin(wx)
  a(3, 2) = Sin(wx)
  a(3, 3) = Cos(wx)
EndProcedure

Procedure.f SetMY(wy.f)
  a(1, 1) = Cos(wy)
  a(1, 3) = Sin(wy)
  a(3, 1) = -Sin(wy)
  a(3, 3) = Cos(wy)
EndProcedure

Procedure.f SetMZ(wz.f)
  a(1, 1) = Cos(wz)
  a(1, 2) = Sin(wz)
  a(2, 1) = -Sin(wz)
  a(2, 2) = Cos(wz)
EndProcedure


aa.f = 0.0
ab.f = 0.0
ac.f = 0.0

speed.f = 0.5
zoom = 2

InitM()

Repeat
  FlipBuffers()
  ClearScreen(0)
  Delay(5)
 
  If GetGadgetState(1) : aa + speed : EndIf
  If GetGadgetState(2) : ab + speed : EndIf
  If GetGadgetState(3) : ac + speed : EndIf
  If GetGadgetState(4) : aa-speed : EndIf
  If GetGadgetState(5) : ab-speed : EndIf
  If GetGadgetState(6) : ac-speed : EndIf
 
  If aa>360 : aa-360 : EndIf
  If ab>360 : ab-360 : EndIf
  If ac>360 : ac-360 : EndIf
 
  If aa<-360 : aa+360 : EndIf
  If ab<-360 : ab+360 : EndIf
  If ac<-360 : ac+360 : EndIf
 
  ;180*#PI 0.017453
  aaa.f = aa*0.017453
  aab.f = ab*0.017453
  aac.f = ac*0.017453
 
  InitM()
  SetMX(aaa)
  ResetList(Kor())
  ClearList(Kor1())
  While NextElement(Kor())
    eX = Kor()\x
    eY = Kor()\y
    eZ = Kor()\z
    AddElement(Kor1())
    Kor1()\x = GetMX(eX, eY, eZ, 1)
    Kor1()\y = GetMY(eX, eY, eZ, 1)
    Kor1()\z = GetMZ(eX, eY, eZ, 1)
    Kor1()\rgb = Kor()\rgb
  Wend   
 
  InitM()
  SetMY(aab)
  ResetList(Kor1())
  While NextElement(Kor1())
    eX = Kor1()\x
    eY = Kor1()\y
    eZ = Kor1()\z
   
    Kor1()\x = GetMX(eX, eY, eZ, 1)
    Kor1()\y = GetMY(eX, eY, eZ, 1)
    Kor1()\z = GetMZ(eX, eY, eZ, 1)
  Wend   

  InitM()
  SetMZ(aac)
  ResetList(Kor1())
  While NextElement(Kor1())
    eX = Kor1()\x
    eY = Kor1()\y
    eZ = Kor1()\z
   
    Kor1()\x = GetMX(eX, eY, eZ, 1)
    Kor1()\y = GetMY(eX, eY, eZ, 1)
    Kor1()\z = GetMZ(eX, eY, eZ, 1)
  Wend   

  ResetList(Kor1())
  
  MaxZ.f = -1000.0
  nr.l = -1
  nr1.l = 0
  While NextElement(Kor1())
    x = Kor1()\x/zoom
    y = Kor1()\y/zoom
    AddCb(x, y, Kor1()\rgb)
    If Kor1()\z > MaxZ
      MaxZ = Kor1()\z
      nr = nr1
    EndIf
    nr1 + 1
  Wend
  
  SetGadgetText(8,"Oben: "+StrF(MaxZ)+"("+Str(nr+1)+")" )
  
  If StartDrawing(ScreenOutput())
      ResetList(Cb())
      While NextElement(Cb())
        Circle(200 + Cb()\x, 150 + Cb()\y, 2, Cb()\rgb)
      Wend
      ClearList(Cb())
    StopDrawing()
  EndIf
 
  Select WindowEvent()
    Case #PB_Event_CloseWindow
      End
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 7
          aa = 0 : ab = 0 : ac = 0
      EndSelect
  EndSelect
ForEver

Verfasst: 11.12.2008 20:27
von Kevin
ok
ich habe nicht gesagt was ich eigentlich erreichen möchte
also nochmal
ich möchte die elemente nach sichtbarkeit sortieren aber das klappt nicht

hier ist mal der code
zeile 200-225 soll die elemente sortieren

Code: Alles auswählen

InitSprite() 

OpenWindow(0, 200, 200, 410, 410, "", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget) 
OpenWindowedScreen(WindowID(0), 5, 105, 400, 300, 0, 0, 0) 

If CreateGadgetList(WindowID(0)) 
  CheckBoxGadget(1, 5, 5, 100, 20, "-x") 
  CheckBoxGadget(2, 5, 25, 100, 20, "-y") 
  CheckBoxGadget(3, 5, 45, 100, 20, "-z") 
  CheckBoxGadget(4, 105, 5, 100, 20, "x") 
  CheckBoxGadget(5, 105, 25, 100, 20, "y") 
  CheckBoxGadget(6, 105, 45, 100, 20, "z") 
  ButtonGadget(7, 5, 65, 200, 20, "zurücksetzen") 
  TextGadget(8,210,65,190,20,"") 
EndIf 

Structure Kor 
  x.w 
  y.w 
  z.w 
  rgb.l 
EndStructure 
Global NewList Kor.Kor() 
Global NewList Kor1.Kor() 

Procedure AddKor(x, y, z, rgb) 
  AddElement(Kor()) 
  Kor()\x = x 
  Kor()\y = y 
  Kor()\z = z 
  Kor()\rgb = rgb 
EndProcedure 

Structure Cb 
  x.w 
  y.w 
  rgb.l 
EndStructure 
Global NewList Cb.Cb() 
Procedure AddCb(x, y, rgb) 
  AddElement(Cb()) 
  Cb()\x = x 
  Cb()\y = y 
  Cb()\rgb = rgb 
EndProcedure 

AddKor(50, 50, 100, RGB(96, 96, 96)) 
AddKor(150, 50, 100, RGB(96, 0, 0)) 
AddKor(50, 150, 100, RGB(0, 96, 0)) 
AddKor(150, 150, 100, RGB(0, 0, 96)) 

AddKor(50, 50, 50, RGB(192, 192, 192)) 
AddKor(150, 50, 50, RGB(192, 0, 0)) 
AddKor(50, 150, 50, RGB(0, 192, 0)) 
AddKor(150, 150, 50, RGB(0, 0, 192)) 

Global Dim a.f(4,4) 

Procedure.f InitM() 
  a(1, 1) = 1.0 
  a(2, 1) = 0.0 
  a(3, 1) = 0.0 
  a(4, 1) = 0.0 
  
  a(1, 2) = 0.0 
  a(2, 2) = 1.0 
  a(3, 2) = 0.0 
  a(4, 2) = 0.0 
  
  a(1, 3) = 0.0 
  a(2, 3) = 0.0 
  a(3, 3) = 1.0 
  a(4, 3) = 0.0 
  
  a(1, 4) = 0.0 
  a(2, 4) = 0.0 
  a(3, 4) = 0.0 
  a(4, 4) = 1.0 
  
EndProcedure 

Procedure.f GetMX(xx, yy, zz, ww) 
  x_neu.f = xx*a(1, 1) + yy*a(1, 2) + zz*a(1, 3) + ww*a(1, 4) 
  ProcedureReturn x_neu 
EndProcedure 

Procedure.f GetMY(xx, yy, zz, ww) 
  y_neu.f = xx*a(2, 1) + yy*a(2, 2) + zz*a(2, 3) + ww*a(2, 4) 
  ProcedureReturn y_neu 
EndProcedure 

Procedure.f GetMZ(xx, yy, zz, ww) 
  z_neu.f = xx*a(3, 1) + yy*a(3, 2) + zz*a(3, 3) + ww*a(3, 4) 
  ProcedureReturn z_neu 
EndProcedure 

Procedure.f GetMW(xx, yy, zz, ww) 
  w_neu.f = xx*a(4, 1) + yy*a(4, 2) + zz*a(4, 3) + ww*a(4, 4) 
  ProcedureReturn w_neu 
EndProcedure 

Procedure.f SetMX(wx.f) 
  a(2, 2) = Cos(wx) 
  a(2, 3) = -Sin(wx) 
  a(3, 2) = Sin(wx) 
  a(3, 3) = Cos(wx) 
EndProcedure 

Procedure.f SetMY(wy.f) 
  a(1, 1) = Cos(wy) 
  a(1, 3) = Sin(wy) 
  a(3, 1) = -Sin(wy) 
  a(3, 3) = Cos(wy) 
EndProcedure 

Procedure.f SetMZ(wz.f) 
  a(1, 1) = Cos(wz) 
  a(1, 2) = Sin(wz) 
  a(2, 1) = -Sin(wz) 
  a(2, 2) = Cos(wz) 
EndProcedure 


aa.f = 0.0 
ab.f = 0.0 
ac.f = 0.0 

speed.f = 0.5 
zoom = 2 

InitM() 

Repeat 
  FlipBuffers() 
  ClearScreen(0) 
  Delay(5) 
  
  If GetGadgetState(1) : aa + speed : EndIf 
  If GetGadgetState(2) : ab + speed : EndIf 
  If GetGadgetState(3) : ac + speed : EndIf 
  If GetGadgetState(4) : aa-speed : EndIf 
  If GetGadgetState(5) : ab-speed : EndIf 
  If GetGadgetState(6) : ac-speed : EndIf 
  
  If aa>360 : aa-360 : EndIf 
  If ab>360 : ab-360 : EndIf 
  If ac>360 : ac-360 : EndIf 
  
  If aa<-360 : aa+360 : EndIf 
  If ab<-360 : ab+360 : EndIf 
  If ac<-360 : ac+360 : EndIf 
  
  ;180*#PI 0.017453 
  aaa.f = aa*0.017453 
  aab.f = ab*0.017453 
  aac.f = ac*0.017453 
  
  InitM() 
  SetMX(aaa) 
  ResetList(Kor()) 
  ClearList(Kor1()) 
  While NextElement(Kor()) 
    eX = Kor()\x 
    eY = Kor()\y 
    eZ = Kor()\z 
    AddElement(Kor1()) 
    Kor1()\x = GetMX(eX, eY, eZ, 1) 
    Kor1()\y = GetMY(eX, eY, eZ, 1) 
    Kor1()\z = GetMZ(eX, eY, eZ, 1) 
    Kor1()\rgb = Kor()\rgb 
  Wend    
  
  InitM() 
  SetMY(aab) 
  ResetList(Kor1()) 
  While NextElement(Kor1()) 
    eX = Kor1()\x 
    eY = Kor1()\y 
    eZ = Kor1()\z 
    
    Kor1()\x = GetMX(eX, eY, eZ, 1) 
    Kor1()\y = GetMY(eX, eY, eZ, 1) 
    Kor1()\z = GetMZ(eX, eY, eZ, 1) 
  Wend    

  InitM() 
  SetMZ(aac) 
  ResetList(Kor1()) 
  While NextElement(Kor1()) 
    eX = Kor1()\x 
    eY = Kor1()\y 
    eZ = Kor1()\z 
    
    Kor1()\x = GetMX(eX, eY, eZ, 1) 
    Kor1()\y = GetMY(eX, eY, eZ, 1) 
    Kor1()\z = GetMZ(eX, eY, eZ, 1) 
  Wend    

 
Repeat    ; sortieren
 buf=-1
 buff=-1
 ResetList(Kor1()) 
 While NextElement(Kor1()) 
  z=Kor1()\z
   If z<0
    z=-z
   EndIf
   
   If z=>buf
    *Kor1=@Kor1()
    buff=1
    buf=z
   EndIf
 Wend

 If buff=1
  ChangeCurrentElement(Kor1(),*Kor1)
  x = Kor1()\x/zoom 
  y = Kor1()\y/zoom 
  AddCb(x, y, Kor1()\rgb)
  DeleteElement(Kor1())
 EndIf

Until buff=-1


  If StartDrawing(ScreenOutput()) 
      ResetList(Cb()) 
      While NextElement(Cb()) 
        Circle(200 + Cb()\x, 150 + Cb()\y, 2, Cb()\rgb) 
      Wend 
      ClearList(Cb()) 
    StopDrawing() 
  EndIf 
  
  Select WindowEvent() 
    Case #PB_Event_CloseWindow 
      End 
    Case #PB_Event_Gadget 
      Select EventGadget() 
        Case 7 
          aa = 0 : ab = 0 : ac = 0 
      EndSelect 
  EndSelect 
ForEver

Verfasst: 11.12.2008 23:25
von alter Mann
wenn Du nach Sichtbarkeit sortieren (und ich denke mal, dass es um
die Darstellung geht), so darfst Du nicht den Absolutwert von z nehmen und du musst die unteren zuerst malen und dann die oberen darüber

Code: Alles auswählen

Repeat    ; sortieren 
 buf.f=1000000.0 
 buff=-1 
 ResetList(Kor1()) 
 While NextElement(Kor1()) 
  z.f=Kor1()\z 

   If z<=buf 
    *Kor1=@Kor1() 
    buff=1 
    buf=z 
   EndIf 
 Wend 

 If buff=1 
  ChangeCurrentElement(Kor1(),*Kor1) 
  x = Kor1()\x/zoom 
  y = Kor1()\y/zoom 
  AddCb(x, y, Kor1()\rgb) 
  DeleteElement(Kor1()) 
 EndIf 

Until buff=-1

Verfasst: 12.12.2008 13:50
von Kevin
Vielen Dank :mrgreen:
Alle Zeiten sind UTC+02:00
Seite 2 von 2

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de