Global ScrX=800,ScrY=600
Graphics ScrX,ScrY,32,2

Dim Sinn#(360),Coss#(360)


Dim Obj3DPunkt(50,2000,2),ObjQuad(50,2000,4)
Dim Bereich(105,105,105)
Global Wx,Wy,Wz=-90,K#=.45

Global U0=400,V0=400
Global U2D,V2D,W2D
For I=0 To 359:Sinn(I)=Sin(I):Coss(I)=Cos(I):Next
;"-------Sin/Cos Vorberechnen-----------------"


;             E----------------F
;           / :               /!
;         /   :             /  !
;       /     :           /    !
;     /       :         /      !
;    A----------------B        !
;    !        :       !        !
;    !        :       !        !
;    !        :       !        !
;    !        :       !        !
;    !       .G.......!........H
;    !     .          !      / 
;    !   .            !    /   
;    ! .              !  /   
;    C----------------D/
;                 



Set3DPkt(0,"A",-50,-50,-50)
Set3DPkt(0,"B", 50,-50,-50)
Set3DPkt(0,"C",-50, 50,-50)
Set3DPkt(0,"D", 50, 50,-50)
Set3DPkt(0,"E",-50,-50, 50)
Set3DPkt(0,"F", 50,-50, 50)
Set3DPkt(0,"G",-50, 50, 50)
Set3DPkt(0,"H", 50, 50, 50)

                     ;Farbe
SetQuad(0,0,"ABDC",-1)
SetQuad(0,1,"BFHD",-65536)
SetQuad(0,2,"FEGH",-1000)
SetQuad(0,3,"AEGC",-20000)





SetBuffer BackBuffer()
Repeat:
;"----------Drehwinkel ändern"
Cls
Select KeyDown(203):Case 1:WY=WY-1:End Select
Select KeyDown(205):Case 1:WY=WY+1:End Select
Select KeyDown(200):Case 1:WX=WX-1:End Select
Select KeyDown(208):Case 1:WX=WX+1:End Select
Select KeyDown(201):Case 1:Wz=Wz-1:End Select
Select KeyDown(209):Case 1:Wz=Wz+1:End Select



Select WX>359:Case 1:WX=WX-360:End Select
Select WY>359:Case 1:WY=WY-360:End Select
Select WZ>359:Case 1:WZ=WZ-360:End Select

Select WX<0:Case 1:WX=360+WX:End Select
Select WY<0:Case 1:WY=360+WY:End Select
Select WZ<0:Case 1:WZ=360+WZ:End Select

Anzeigen()
WireFramme()



;--------------Flaps Zäler----------------"
FPSZa=FPSZa+1:Select MilliSecs()>FPSTimer+999:Case 1:FPSTimer=MilliSecs()
FPS=FPSZa:FPSZa=0:End Select

Color 255,0,0:Text 10,10,FPS
Flip




Until KeyDown(1)=1
End


;"Zeigt das Object auf dem Bildschirm an------"
Function Anzeigen()
LockBuffer
For ZZ=0 To 100
For ZX=0 To 100:For ZY=0 To 100
Farbe=Bereich(ZX,ZY,ZZ)
Select Farbe<0:Case 1

Calk3Dto2D(ZX-50,ZY-50,ZZ-50)
Select (W2D+50)>ZZ:Case 1
WritePixelFast U2D,V2D,Farbe
End Select
End Select
Next:Next:Next
UnlockBuffer
End Function



;"------------Zeigt das Gitternetz an-----------------"
Function WireFramme()
Repeat
V1=ObjQuad(0,Quad,0):V2=ObjQuad(0,Quad,1)
V3=ObjQuad(0,Quad,2):V4=ObjQuad(0,Quad,3)
Color 0,0,ObjQuad(0,Quad,4)
Select V1+V2:Case 0:Return:End Select

X=Obj3DPunkt(0,V1,0):Y=Obj3DPunkt(0,V1,1):Z=Obj3DPunkt(0,V1,2)
Calk3Dto2D(X,Y,Z):X1=U2D:Y1=V2D


X=Obj3DPunkt(0,V2,0):Y=Obj3DPunkt(0,V2,1):Z=Obj3DPunkt(0,V2,2)
Calk3Dto2D(X,Y,Z):X2=U2D:Y2=V2D

X=Obj3DPunkt(0,V3,0):Y=Obj3DPunkt(0,V3,1):Z=Obj3DPunkt(0,V3,2)
Calk3Dto2D(X,Y,Z):X3=U2D:Y3=V2D

X=Obj3DPunkt(0,V4,0):Y=Obj3DPunkt(0,V4,1):Z=Obj3DPunkt(0,V4,2)
Calk3Dto2D(X,Y,Z):X4=U2D:Y4=V2D


Line X1,Y1,X2,Y2
Line X2,Y2,X3,Y3
Line X3,Y3,X4,Y4
Line X4,Y4,X1,Y1

Quad=Quad+1
Forever
End Function





;"Berechnet aus die 3DKoordinaten die 2DCoordinaten
Function Calk3Dto2D(X,Y,Z)
DY#=Coss(Wx)*Y-Sinn(Wx)*Z:Z=Sinn(WX)*Y+Coss(WX)*Z:Y=DY
DX#=Coss(Wy)*X-Sinn(Wy)*Z:Z=Sinn(WY)*X+Coss(Wy)*Z:X=DX
DX#=Coss(Wz)*X-Sinn(Wz)*Y:Y=Sinn(Wz)*X+Coss(Wz)*Y:X=DX
U2D=Z*K-Y+U0
V2D=X-Z*K+V0
W2D=Z
End Function 



;"-----Eckpunkte-----------
Function Set3DPkt(O,P$,X,Y,Z)
Pu=Asc(P$)-65
Obj3DPunkt(O,Pu,0)=X
Obj3DPunkt(O,Pu,1)=Y
Obj3DPunkt(O,Pu,2)=Z
End Function





;"--------Fläschen---Erstellen-----------"
Function SetQuad(O,P,Stringg$,Farbe)
N1=Asc(Left(Stringg$,1))-65:N2=Asc(Mid(Stringg$,2,1))-65
N3=Asc(Mid(Stringg$,3,1))-65:N4=Asc(Right(Stringg$,1))-65

ObjQuad(O,P,0)=N1
ObjQuad(O,P,1)=N2
ObjQuad(O,P,2)=N3
ObjQuad(O,P,3)=N4
ObjQuad(O,P,4)=Farbe
;----------------Problemzonne------------------------------
X1=Obj3DPunkt(0,N1,0):Y1=Obj3DPunkt(0,N1,1):Z1=Obj3DPunkt(0,N1,2)
X2=Obj3DPunkt(0,N2,0):Y2=Obj3DPunkt(0,N2,1):Z2=Obj3DPunkt(0,N2,2)
X3=Obj3DPunkt(0,N3,0):Y3=Obj3DPunkt(0,N3,1):Z3=Obj3DPunkt(0,N3,2)
X4=Obj3DPunkt(0,N4,0):Y4=Obj3DPunkt(0,N4,1):Z4=Obj3DPunkt(0,N4,2)
;AppTitle X1+"  "+X2+"  "+Y1+"  "+Y3+"  "+Z1+" "+Z2

For ZX=X1 To X2:For ZY=Y1 To Y4:For ZZ=Z1 To Z2

Bereich(ZX+50,ZY+50,ZZ+50)=Farbe

Next:Next:Next

End Function