3D Würfel ohne Ogre

Anfängerfragen zum Programmieren mit PureBasic.
Emily
Beiträge: 96
Registriert: 25.01.2008 13:14

Beitrag von Emily »

Wirf mal einen Blick in "<PureBasicInstallationsordner>\Examples\Sources - Advanced\OpenGL Cube" ;)
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Dank dir, sieht interessant aus ...

:allright:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Hab hier auch noch was interessantes gefunden:
SuperSprite3D
http://www.purebasic.fr/german/viewtopi ... bc824a540a

Finde die OpenGL-Sachen ein bisschen zu abstrackt.
Ich meine, wenn jeder Befehl-OpenGL ist, wie kann ich dann meine PureBasic-Befehle da noch sinnvoll nutzen?

Wie kann ich zum Beispiel ein in PureBasic erstelltes Image in OpenGL integrieren?

:?
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
Scarabol
Beiträge: 1427
Registriert: 30.11.2005 21:00

Beitrag von Scarabol »

Also bisher verwende ich folgenden Code, der NICHT von mir stammt um Images in OGl einzubauen:

Code: Alles auswählen

Procedure GLLoadAlphaTexture(image_nr,img_file.s,Filename.s,Texfilter,TransparentColor.l)
  
  If img_file="file"
    img       = LoadImage(#PB_Any, Filename.s)
    Width.l   = FindNextExp(ImageWidth(img))
    Height.l  = FindNextExp(ImageHeight(img))
    ResizeImage(img, Width, Height)
    Size.l    = Width * Height * 4
  EndIf
  
  If img_file="image" 
    img.l = CreateImage(#PB_Any,256,256,24)
    Width.l   = FindNextExp(ImageWidth(img))
    Height.l  = FindNextExp(ImageHeight(img))
    ResizeImage(img, Width, Height)
    Size.l    = Width * Height * 4
  EndIf 
  
  Dim ImageData.b(Size)
  
  bmi.BITMAPINFO
  bmi\bmiHeader\biSize        = SizeOf(BITMAPINFOHEADER)
  bmi\bmiHeader\biWidth       = Width
  bmi\bmiHeader\biHeight      = Height
  bmi\bmiHeader\biPlanes      = 1
  bmi\bmiHeader\biBitCount    = 32
  bmi\bmiHeader\biCompression = #BI_RGB
  bmi\bmiHeader\biSizeImage   = (bmi\bmiHeader\biWidth * bmi\bmiHeader\biHeight * bmi\bmiHeader\biBitCount / 8)-1
  
  hdc = StartDrawing(ImageOutput(img))
    If img_file="image"
      createdraw()
    EndIf
    GetDIBits_(hdc, ImageID(img), 0, bmi\bmiHeader\biHeight, @ImageData(0), bmi, #DIB_RGB_COLORS)
  StopDrawing()
  
  red   = Red (TransparentColor)
  green = Green(TransparentColor)
  blue  = Blue (TransparentColor)
  
  For k=0 To Size-1 Step 4
    b = ImageData(k  ) & $FF
    g = ImageData(k+1) & $FF
    r = ImageData(k+2) & $FF
    
    If r = red And g = green And b = blue
      ImageData(k+3) = 0
    Else
      ImageData(k+3) = $ff
    EndIf
    
    ImageData(k+2) = b
    ImageData(k  ) = r
  Next
  
  glGenTextures_(image_nr, @Tex)   
  glBindTexture_(#GL_TEXTURE_2D, Tex)
  glTexImage2D_(#GL_TEXTURE_2D, 0, #GL_RGBA, Width, Height, 0, #GL_RGBA, #GL_UNSIGNED_BYTE, @ImageData(0))
  
  If TexFilter = 0 
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_NEAREST)
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_NEAREST)
  ElseIf TexFilter = 1
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MAG_FILTER, #GL_LINEAR)
    glTexParameteri_(#GL_TEXTURE_2D, #GL_TEXTURE_MIN_FILTER, #GL_LINEAR)
  EndIf
  
  FreeImage(img)
  
  ProcedureReturn Tex
EndProcedure
Gruß
Scarabol
Abgeschlossen Projekte:
Schreibmaschine, Bildschirmlupe, Wings3DtoOgreMeshConverter
Watch: PureArea

PB-V: 4
WinXP
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

So bitteschön ein undokumentierter Code von mir wie ich die Sprites perspektivisch verzehre. Zum Aufbau einer kleinen aber flotten 3D-Klötzchenengine auf Sprite3D-Basis.
Ich hoffe das interessiert....

Code: Alles auswählen

InitSprite()
InitKeyboard()
#screenw = 800
#screenh = 600

OpenScreen(#screenw,#screenh,32,"Perspektive mit Sprite3D")
Global posx.f, posy.f, gain.f, swh.l, shh.l
gain = 1.5

swh = #screenw/2
shh = #screenh/2

Repeat
  ExamineKeyboard()
  
  If KeyboardPushed(#PB_Key_Up)
    posy -10
  EndIf
  If KeyboardPushed(#PB_Key_Down)
    posy + 10
  EndIf
  If KeyboardPushed(#PB_Key_Left)
    posx-10
  EndIf
  If KeyboardPushed(#PB_Key_Right)
    posx+10
  EndIf
  
    If KeyboardPushed(#PB_Key_A)
    gain + 0.01
  EndIf
  If KeyboardPushed(#PB_Key_Z)
    gain - 0.01
  EndIf

  StartDrawing(ScreenOutput())
    LineXY(swh+posx-32,shh+posy-32,swh+(posx-32)*gain,shh+(posy-32)*gain,RGB(100,100,100))
    LineXY(swh+posx+32,shh+posy-32,swh+(posx+32)*gain,shh+(posy-32)*gain,RGB(100,100,100))
    LineXY(swh+posx+32,shh+posy+32,swh+(posx+32)*gain,shh+(posy+32)*gain,RGB(100,100,100))
    LineXY(swh+posx-32,shh+posy+32,swh+(posx-32)*gain,shh+(posy+32)*gain,RGB(100,100,100))
    
    LineXY(swh+(posx-32)*gain,shh+(posy-32)*gain,swh+(posx+32)*gain,shh+(posy-32)*gain,RGB(100,100,100))
    LineXY(swh+(posx+32)*gain,shh+(posy-32)*gain,swh+(posx+32)*gain,shh+(posy+32)*gain,RGB(100,100,100))
    LineXY(swh+(posx+32)*gain,shh+(posy+32)*gain,swh+(posx-32)*gain,shh+(posy+32)*gain,RGB(100,100,100))
    LineXY(swh+(posx-32)*gain,shh+(posy+32)*gain,swh+(posx-32)*gain,shh+(posy-32)*gain,RGB(100,100,100))
    
    
    Circle(swh+posx-32,shh+posy-32,3,RGB(255,255,0))
    Circle(swh+posx+32,shh+posy-32,3,RGB(255,255,0))
    Circle(swh+posx+32,shh+posy+32,3,RGB(255,255,0))
    Circle(swh+posx-32,shh+posy+32,3,RGB(255,255,0))
    
    Circle(swh+(posx-32)*gain,shh+(posy-32)*gain,3,RGB(0,255,0))
    Circle(swh+(posx+32)*gain,shh+(posy-32)*gain,3,RGB(0,255,0))
    Circle(swh+(posx+32)*gain,shh+(posy+32)*gain,3,RGB(0,255,0))
    Circle(swh+(posx-32)*gain,shh+(posy+32)*gain,3,RGB(0,255,0))
    
    DrawText(0,0,StrF(gain,2))
  StopDrawing()

  FlipBuffers()
  ClearScreen(0)


Until KeyboardPushed(#PB_Key_Escape)
CloseScreen()
Später dokumentiere ich es auch, versprochen.
Wie man sieht bedient sich diese Verzehrung den Trick, des Parallax-Scrollings.
Hatte auch mal eine kleine Engine entwickelt die mehr als nur klötzchen konnte (sogar mit einem modeleditor) doch der sortierungsaufwand musste manuel betrieben werden und war einfach zu groß...
I´a dllfreak2001
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

@Scarabol
FindNextExp() kennt mein PureBasic nicht :shock:
createdraw() ????

>>> die entscheidenen Dinge scheinen zu fehlen? :(
Kenne mich zwar mit Linux und MacOS-Code nicht so aus, der Code sieht aber eher nach WindowsAPI aus als dass er plattformunabhängig wäre?


Ich nutze PureBasic 4.1, ich dachte OpenGL geht einfach so ...
Und das Einbinden der OpenGL-Include hat auch nichts gebracht.
Ich vermute stark, du hast UserLibs eingebunden???


@dllfreak2001

Schau mal meinen Code:

Code: Alles auswählen

;/ Folker Linstedt
;/ 2008-02-01
;/ 3D-Engine

EnableExplicit

Structure p3D ;/ 3D-Punkt mit zugehörigem 2D-Projektionspunkt
  ;/ 3D-Koordinaten
  x.l
  y.l
  z.l
  ;/ 2D-Projektion
  x2D.l
  y2D.l
  color.l
  ;/ PunktID
  ID.l ;/ wird nicht verwendet
EndStructure

Structure lID; Line
  ID1.l ;/ IDs aus der Liste E3D
  ID2.l 
  color.l ;
EndStructure

Structure MID; Mesh
  ID1.l ;/ IDs aus der Liste E3D
  ID2.l 
  color.l ;
  MID.l ; ID des Meshes
EndStructure


Structure rID; Rectangle(i) / Texture
  ID1.l  ; oder auch nur zwei IDs, LinienIDs
  ID2.l
  ID3.l 
  ID4.l
  color.l
EndStructure


Global NewList E3D.p3D()
Global NewList LID.lID()
Global Dim LIX.lID(0)
Global Dim EDim.p3D(0)

Global NewList Mesh.MID(); Erste PunktID aus E3D bis letzte PunktID von dem Mesh/LinienGruppe

Procedure.l AddMesh()
Protected ID
  ID=CountList(E3D())  
  AddElement(Mesh())
  Mesh()\MID=CountList(Mesh())
  Mesh()\ID1=ID 
  Mesh()\ID2=ID 
  Mesh()\color=E3D()\color 
  
  ProcedureReturn Mesh()\MID
EndProcedure  

Procedure EndMesh()
  Mesh()\ID2=CountList(E3D())-1
EndProcedure


Procedure MoveMesh(MID,x,y,z);/ MoveMesh erst nach FromListToArry()
  Protected i
  SelectElement(Mesh(),MID)
  For i=Mesh()\ID1 To Mesh()\ID2
    EDim(i)\x+x  
    EDim(i)\y+y
    EDim(i)\z+z
  Next  
  
EndProcedure



Procedure SetMeshColor(MID,color) ; Alle Linien des Mesh müssen eine neue Farbe bekommen

EndProcedure

  

Procedure AddE3DPoint(x,y,z,f)
  AddElement(E3D())
  E3D()\x=x
  E3D()\y=y
  E3D()\z=z
  E3D()\color=f
  E3D()\ID=CountList(E3D())-1
EndProcedure

Procedure.l Test3DPoints(x,y,z,f,d=0)
  Protected Dings.l=0, ID.l
  
  If d
  
  ForEach E3D()
    If (E3D()\x=x) And (E3D()\y=y) And (E3D()\z=z)
      ID=E3D()\ID
      Dings=0
      Break
    Else  
      Dings=1
    EndIf
  Next
  
  EndIf
  
  If Dings Or CountList(E3D())=0 Or Not(d)
    AddE3DPoint(x,y,z,f) 
  EndIf  
  ID=E3D()\ID
  
  ProcedureReturn ID
EndProcedure


Procedure AddLineIDs(ID1, ID2, f)
  AddElement(LID())
    LID()\ID1=ID1
    LID()\ID2=ID2
    LID()\color=f
EndProcedure


Procedure AddQuader(x,y,z,f,XB=20,YB=20,ZB=20,d=0) ; float / double
Protected ID, IDE, wx, wy, wz,i,c=0
    
  wx=XB/2
  wy=YB/2
  wz=ZB/2
 
 If wx=0
   c+1
 EndIf
 If wy=0
   c+1
 EndIf
 If wz=0
   c+1
 EndIf
 
 If c=2
   Test3DPoints(x-wx,y-wy,z-wz,f)
   ID=E3D()\ID
   Test3DPoints(x+wx,y+wy,z+wz,f)
   AddLineIDs(ID,ID+1,f)
 ElseIf c<2
 
 If wy<>0 
   Test3DPoints(x-wx,y+wy,z-wz,f)
   ID=E3D()\ID
 EndIf
 
 Test3DPoints(x-wx,y-wy,z-wz,f)
 If wy=0   
   ID=E3D()\ID
 EndIf
  
 If wx<>0 
  Test3DPoints(x+wx,y-wy,z-wz,f)
   If wy<>0 
    Test3DPoints(x+wx,y+wy,z-wz,f)
   EndIf 
 EndIf 
  
 If wz<>0     
   If wy<>0
     Test3DPoints(x-wx,y+wy,z+wz,f)
   EndIf  
   Test3DPoints(x-wx,y-wy,z+wz,f)

   If wx<>0  
     Test3DPoints(x+wx,y-wy,z+wz,f)
     If wy<>0
       Test3DPoints(x+wx,y+wy,z+wz,f)
     EndIf  
   EndIf 
  
 EndIf 
 
 IDE=E3D()\ID
 
 
  
  AddLineIDs(ID,ID+1,f)
  AddLineIDs(ID+2,ID+3,f)
 
 If wz=0 Or  IDE-ID>3    
  AddLineIDs(ID+1,ID+2,f)
  AddLineIDs(ID+3,ID,f)  
 Else
  AddLineIDs(ID+1,ID+3,f)
  AddLineIDs(ID+2,ID  ,f)    
 EndIf 
 If IDE-ID>3
 
  AddLineIDs(ID+4,ID+5,f)
  AddLineIDs(ID+5,ID+6,f)
  AddLineIDs(ID+6,ID+7,f)
  AddLineIDs(ID+7,ID+4,f)
  
  AddLineIDs(ID,ID+4,f)
  AddLineIDs(ID+1,ID+5,f)
  AddLineIDs(ID+2,ID+6,f)
  AddLineIDs(ID+3,ID+7,f)  
  
 EndIf
 
 Else
 
 ;/ Nur Punkt
 
 EndIf

EndProcedure

Procedure AddCube(x,y,z,G,F,d=0); x,y,z
  AddQuader(x,y,z,f,g,g,g,d)
EndProcedure



Global ZeitMessung=0, PI.f=3.1415926999999; gerundet

Global Dim cosV.f(2)
Global Dim sinV.f(2)
Global Dim angle.f(2)

  cosV(0)=1
  sinV(0)=0
  
  cosV(1)=-1;-1
  sinV(1)=0;0
  
  cosV(2)=1;1
  sinV(2)=0;0
 
 angle(1)=PI


Procedure UpDateVertsDim(i);/ Umrechnung der Projektion
  Protected Yrx, Yry, Yrz, Xrx, Xry, Xrz, Zrx, Zry, Zrz, rx, ry, rz, x, y, z, scaleFactor.f=1
  
  ;/ Drehung um Y-Achse    
 

  x=EDim(i)\x
  z=EDim(i)\z
  y=EDim(i)\y
  
    
  ;/ Kamera bewegen
  
  ;x-100
  ;y+100
  z+0;
  
  
  ;/ Drehung um Y-Achse
  
  Yrx=(x*cosV(0))+(z*sinV(0)) ;/ Minus Z
  Yry=y
  Yrz=(-z*cosV(0))+(x*sinV(0)) ;/ Minus Z
  
  
  ;/ Drehung um X-Achse
    
  Xrx=Yrx  
  Xry=(Yry*cosV(1))+(Yrz*sinV(1)) 
  Xrz=(-Yrz*cosV(1))+(Yry*sinV(1))
  
  
  ;/ Drehung um Z-Achse
  Zrx=(Xrx*cosV(2))+(Xry*sinV(2))
  Zry=(-Xry*cosV(2))+(Xrx*sinV(2))
  Zrz=Xrz
   
  
   ;/ Zoom out
  
  
  rx=(Zrx/(1+((Zrz*scaleFactor)/500)));+(Zrx/(1+((Zrz*scaleFactor)/500)))
  ry=(Zry/(1+((Zrz*scaleFactor)/500)));+(Zry/(1+((Zrz*scaleFactor)/500)))
  
  
  EDim(i)\x2D=240-rx ;/ -x
  EDim(i)\y2D=160-ry
  
EndProcedure


Procedure Drehung(i)
 Protected temp.f
  
 ; If i<1
  
  If (angle(i)<PI)
    If angle(i)<(0.5*PI)
      temp=((angle(i)*(2/PI))-0.5)
      sinV(i)=(0.75-((temp*temp)-temp))
      cosV(i)=(0.75-((temp*temp)+temp))
    Else  
      temp=((((PI-angle(i))*(2/PI)))-0.5)
      sinV(i)=(0.75-((temp*temp)-temp))
      cosV(i)=(-0.75+((temp*temp)+temp)) 
    EndIf
  Else  ;/ ohne Sonst sieht es ganz schön schlimm aus
    If angle(i)<(1.5*PI)
      temp=(((angle(i)-PI)*(2/PI))-0.5)
      sinV(i)=(-0.75+((temp*temp)-temp))
      cosV(i)=(-0.75+((temp*temp)+temp))
    Else  
      temp=((((2*PI)-angle(i))*(2/PI))-0.5)
      sinV(i)=(-0.75+((temp*temp)-temp))
      cosV(i)=(0.75-((temp*temp)+temp)) 
    EndIf 
  EndIf
  
 ; EndIf
  
EndProcedure  


Procedure Calc() ;/ Kamera
Protected i
  ;/If (angle(i)>PI) ;/ Schlüssel  
  
  For i=0 To 2
    Drehung(i)
  Next
  
  ;/ Berechnung der Drehwinkel, eventuell kürzer und einfacher möglich???

EndProcedure



Procedure Draw2D(OutPut)
  Protected i,a
  StartDrawing(OutPut)
  Box(0,0,480,360,0) ;/ eine Art ClearScreen
  Plot(240,160,RGB(255,255,255)) ; MittelPunkt im Universum
  
  For i=0 To CountList(E3D())-1
    Calc()
    UpDateVertsDim(i)
   ; Circle(EDim(i)\x2D,EDim(i)\y2D,1,RGB(255,0,0))
   If EDim(i)\x2D>10 And  EDim(i)\x2D<470 And EDim(i)\y2D>10 And EDim(i)\y2D<350
    Plot(EDim(i)\x2D,EDim(i)\y2D,RGB(255,0,0)) 
   EndIf 
    ;/ Plot darf nicht außerhalb eines Images gezeichnet werden!!!
  Next
   
  
  For i=0 To CountList(LID())-1
    LineXY(EDim(  LIX(i)\ID1  )\x2D,EDim(LIX(i)\ID1)\y2D,EDim(LIX(i)\ID2)\x2D,EDim(LIX(i)\ID2)\y2D,LIX(i)\color)
  Next
  
  
  DrawText(0,0,StrF(CountList(LID()),2),RGB(255,255,255),0)
  
  StopDrawing()
 
   
 
EndProcedure


;/ Sortiert nach Wichtigkeit
Global Dim RotateUmAchse(2)



Procedure WinkelRechnung(i,R)
    If R>0
      angle(i)+0.05
      If (angle(i)>(2*PI))
        angle(i)-(2*PI)
      EndIf
    Else
      angle(i)-0.05
      If (angle(i)<0)
        angle(i)+(2*PI)
      EndIf
    EndIf    
    
    
EndProcedure    

Procedure fortlaufend()
Protected i
  If (ElapsedMilliseconds()-ZeitMessung)>(1000/50)
  
  
   For i=0 To 2
   If RotateUmAchse(i)
       WinkelRechnung(i,RotateUmAchse(i))
   
   EndIf 
   Next
   
   
   
    Draw2D(ImageOutput(0))
    SetGadgetState(0,ImageID(0))
    ZeitMessung=ElapsedMilliseconds()
    
  EndIf
EndProcedure


Procedure CreateSprites() ;- NEUE 2D-Befehle für Texturen
  Protected x,y
  CreateSprite(0,128,128,#PB_Sprite_Texture)
  CreateSprite(1,128,128,#PB_Sprite_Texture)
  
  StartDrawing(SpriteOutput(0))
  Box(0,0,SpriteWidth(0),SpriteHeight(0),RGB(255,64,0))
  Box(5,5,40,15,RGB(0,64,100))
  LineXY(0,0,SpriteWidth(0),SpriteHeight(0),RGB(0,0,255))
  LineXY(0,SpriteHeight(0),SpriteWidth(0),0,RGB(0,0,255))
  StopDrawing()
  
  
  StartDrawing(SpriteOutput(1))
  Box(0,0,SpriteWidth(0),SpriteHeight(0),RGB(0,64,0))
  For y=0 To 10
    For x=0 To 10
      Box(12*x,12*y,8,8,RGB(0,64+Random(40),100))
    Next  
  Next  
  
  StopDrawing()
  
  
  CreateSprite3D(0,0)  
  CreateSprite3D(1,1)  
EndProcedure

Procedure DrawSprites()
  ;/ aus verbunden Linien müssen Flächen werden. Bzw. es müssen Dreiecke erstellt werden.
  Start3D()
    
  
  
  Stop3D()
EndProcedure


Procedure FromListToArray()
ReDim LIX.LID(CountList(LID()));/ einer mehr, wenn keine Linien hinzugefügt wurden
Protected i=0
ForEach LID()
  LIX(i)\ID1=LID()\ID1
  LIX(i)\ID2=LID()\ID2
  LIX(i)\color=LID()\color
  i+1
Next

ReDim EDim.p3D(CountList(E3D()));/ einer mehr, wenn keine Punkte hinzugefügt wurden
i=0
ForEach E3D()
  EDim(i)\x=E3D()\x
  EDim(i)\y=E3D()\y
  EDim(i)\z=E3D()\z
  EDim(i)\x2D=E3D()\x2D
  EDim(i)\y2D=E3D()\y2D
  EDim(i)\Color=E3D()\Color
  EDim(i)\ID=E3D()\ID
  i+1
Next

EndProcedure

Procedure Add3DElements()
;/ Damit Verzerrungen minimiert werden, müssen Flächen
;/ in kleinere Flächen geteilt werden!

;Define i,i2,i3,c=4, l=48,f

Protected i,i2,i3,c=8, l=30,f

For i3=0 To c
 For i2=0 To c
  For i=0 To c
    f=30*(i+1)
    ;AddCube(-l+c*i,-l+c*i, l-c*i,2*l-c*2*i,RGB(f,f,f))
    ;AddCube(120-l*i2,90-l*i, 120-l*i3,l-10,RGB(0,255,0)) ;/ doppelte Punkte bei großen Anzahlen nicht tresten!!!
    ;/ Doppelte Linien werden gezeichnet, doppelte 3D-Punkte sind im Array und werden auch berechnet
    ;AddCube() macht statt 12 notwendigen Linien, 6 * 4 Linien! 6 Mal so viele 3D-Punkte wie benötigt werden!!!
    ;AddQuader(120-l*i2,90-l*i, 120-l*i3,l-10,RGB(0,255,0)) ;/ doppelte Punkte bei großen Anzahlen nicht tresten!!!
  Next  
 Next  
Next 


;/ Achsen
;AddQuader(0,0,0,RGB(128,255,0),0,0,200) 
;AddQuader(0,0,0,RGB(128,255,0),0,400,0) 
;AddQuader(0,0,0,RGB(128,255,0),400,0,0) ;/ unsichtbar


AddQuader(0,0,100,RGB(128,128,255),300,220,10)

AddQuader(0,-120,0,RGB(128,128,255),300,10,200) 

AddMesh()
For i=0 To 10
  AddQuader(-130+20*i,-115,15,RGB(128,255,0),15,0,15) 
  
Next
EndMesh()


AddCube(0,0,0,8,RGB(255,128,0))
AddCube(-50,0,0,8,RGB(255,128,0))

EndProcedure

angle(0)=PI
angle(1)=PI+0.4

;/ bei rund 3.000 3D-Punkten wird das System langsam


Procedure createGadgets()
 Protected i
  CreateImage(0,480,360)
  
  ImageGadget(0,10,5,480,360,ImageID(0),#PB_Image_Border)
  
  For i=0 To 2
    ButtonGadget(1+2*i,500,5+30*i,30,25,"<<",  #PB_Button_Toggle )
    ButtonGadget(2+2*i,530,5+30*i,30,25,">>",  #PB_Button_Toggle )
    ButtonGadget(7+i,560,5+30*i,30,25,"0")
  Next  
 ;ButtonGadget(3,530,5,20,25,"||",  #PB_Button_Toggle )
  
EndProcedure


Define i
If OpenWindow(0,0,0,600,750,"FL 3D - ACHTUNG! Bei Window-Events wird 3D mit Texturen unterbrochen!",#PB_Window_ScreenCentered | #PB_Window_SystemMenu) And CreateGadgetList(WindowID(0))
  
  InitSprite()
  OpenWindowedScreen(WindowID(0),10,380,480,360,0,0,0)
  InitSprite3D()
 ; CreateSpriteS()
  Sprite3DQuality(1)
  
  
  createGadgets() 
  
  Add3DElements()
  FromListToArray()
  
  ;/ MoveMesh erst nach FromListToArry()
  MoveMesh(0,0,0,0)
  
  
  Draw2D(ImageOutput(0))
  
  Define Event.l, Quit, GadgetNr
  
  
  
  Repeat
  
  Repeat
    
    Event=WaitWindowEvent(20)
    
     If Event=16
      Quit=1
      
    ElseIf Event=#PB_Event_Gadget
      GadgetNr=EventGadget() 
      
      
      For i=0 To 2
      
      If GadgetNr=1+2*i             
        SetGadgetState(2+2*i,0)
      ElseIf GadgetNr=2+2*i        
        SetGadgetState(1+2*i,0)
      EndIf
      
      If GetGadgetState(1+2*i)
        RotateUmAchse(i)=1       
      ElseIf GetGadgetState(2+2*i)        
        RotateUmAchse(i)=-1  
      Else
        RotateUmAchse(i)=0                          
      EndIf     
         
         If GadgetNr=7+i
           angle(i)=PI
           sinV(i)=0
           cosV(i)=1 
           
           RotateUmAchse(i)=0  
           SetGadgetState(1+2*i,0)                        
           SetGadgetState(2+2*i,0)
         EndIf
         
      Next
      
      If GadgetNr=8 
        cosV(1)=-1;-1         
        angle(1)=PI+0.4
      EndIf
      
      If GadgetNr=9 
        angle(2)=0
      EndIf
      
      
    EndIf
    
    ;/ fortlaufend
    fortlaufend()
    
  Until Event=0
  
  FlipBuffers()
  ClearScreen(0)
  
 ; Draw2D(ScreenOutput())
  
  DrawSprites()
    
    
  Until Quit 
  
  
  
  
  
  
EndIf
; IDE Options = PureBasic v4.02 (Windows - x86)
; CursorPosition = 519
; FirstLine = 499
; Folding = ----
; Executable = F3DXWCX.exe
Aber von Sprites noch keine Spur :mrgreen:
Kinder an die Macht http://scratch.mit.edu/
Benutzeravatar
dllfreak2001
Beiträge: 2925
Registriert: 07.09.2004 23:44
Wohnort: Bayern

Beitrag von dllfreak2001 »

8) Kenn ich doch schon....
I´a dllfreak2001
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Ich weiß, aber wir müssen ja nun langsam einen Schritt weiter kommen.

Einen kleinen Code, der direkt ausführbar ist und einen Würfel routieren lässt mit einer SpriteTextur ... das wäre cool.

Meine Bemühungen kann man ja sehen, ...

- der code ist noch zu lang, zu viel doppelt
- zu langsam, zu wirr
- nicht einfach genug zu handhaben

Cool wäre etwas wie:

AddCube(Index, SpriteID, AnStelleX, AnStelleY, AnStelleZ, Größe)
Rotation des Würfels optional. X, Y, Z sollten den MittelPunkt bestimmen, sonst muss man bei Größenänderung zu viel nachdenken.

Der Würfel könnte der Einfachhei halber auf jeder Seite die selbe Textur haben. Komplizierter wird es, wenn die Textur auf einzelnen Seiten in einer bestimmten Richtung gedreht sein muss. Aber da gibt es ja auch nur 4 Möglichkeiten. 0°, 90°, 180°, 270°

Oder wenn jede Seite eine andere Textur hat wie bei einem Zahlenwürfel.

Intern könnte der Cubus ja mit diesen Optionen versehen werden.
Also auch mit Transparenz und wenn jemand weiß wie es geht mit Bumpmaps.

2 TexturIDs pro Seite, Transparenz pro Seite,
Rotation der Textur pro TexturID, 0 bis 3 als 90° Schritte
Die definierte Textur enthält TransparenteFarbe, für Zäune zum Beispiel,

Das wären so meine Überlegungen. Die Frage ist nur, ob man das gleiche nicht mit OpenGL schon alles hat. Rad neu erfinden wäre ja doof. :freak:
Kinder an die Macht http://scratch.mit.edu/
DarkDragon
Beiträge: 6291
Registriert: 29.08.2004 08:37
Computerausstattung: Hoffentlich bald keine mehr
Kontaktdaten:

Beitrag von DarkDragon »

FindNextExp ist von mir.

Code: Alles auswählen

Procedure FindNextExp(Val)
  While a < Val
    a = 1 << b
    b + 1
  Wend
  ProcedureReturn a
EndProcedure
Es sucht den nächsten 2^n Wert, sodass 2^n >= Val
Angenommen es gäbe einen Algorithmus mit imaginärer Laufzeit O(i * n), dann gilt O((i * n)^2) = O(-1 * n^2) d.h. wenn man diesen Algorithmus verschachtelt ist er fertig, bevor er angefangen hat.
Benutzeravatar
Xaby
Beiträge: 2144
Registriert: 12.11.2005 11:29
Wohnort: Berlin + Zehdenick
Kontaktdaten:

Beitrag von Xaby »

Und was macht CreateDraw() /:->

Wir sind der Lösung auf der Spur, mühsam ernährt sich das Eichhörnchen :) :allright:
Kinder an die Macht http://scratch.mit.edu/
Antworten