Const Pi = 4.0*Atn(1.0), MidX = 800\2, MidY = 600\2, Deg2Rad=Atn(1.0)/45.0, Esc=!"\27"
Const p90=90/Pi

Type Vtx
  As Long x, y, z
End Type

Type Tri_
  As uLong v1, v2, v3
End Type


Declare Sub Set_Vertex(x As Long, y As Long, z As Long)
Declare Sub Set_Surface(v1 As uLong, v2 As uLong, v3 As uLong)
Declare Sub Set_Obj(byVal Rotate As Long)

Dim Shared As Vtx Vertex(999)
Dim Shared As Tri_ Tri(999)
Dim Shared vCnt As uLong, TriCnt As uLong
Dim Shared As Long _Edit=1, _View=0

Sub Set_Vertex (x As Long, y As Long, z As Long)
  Vertex(vCnt).x=x
  Vertex(vCnt).y=y
  Vertex(vCnt).z=z
  vCnt+=1
End Sub

Sub Set_Surface (v1 As uLong, v2 As uLong, v3 As uLong)
  Tri(TriCnt).v1=v1-1
  Tri(TriCnt).v2=v2-1
  Tri(TriCnt).v3=v3-1
  TriCnt+=1
End Sub    

'---------------------------------------------------------------------------------------------------------------------'

'' create obj3d (quader 100x100x100 Vertex=8 surface=12)
'' Set_Vertex (Vertex position x,Vertex position y,Vertex position z)
Set_Vertex (-50, -50, -50) 'Vertex 1 to..
Set_Vertex (-50, -50,  50) ' ..2..
Set_Vertex ( 50, -50,  50) ' ..3..
Set_Vertex ( 50, -50, -50) ' ..4..
Set_Vertex (-50,  50, -50) ' ..5..
Set_Vertex (-50,  50,  50) ' ..6..
Set_Vertex ( 50,  50,  50) ' ..7..
Set_Vertex ( 50,  50, -50) ' 8


'' surface (Triangle)
'' Set_Surface (Vertex 1, Vertex 2, Vertex 3)

Set_Surface (1, 2, 3) 
Set_Surface (1, 4, 3)

Set_Surface (1, 5, 4)
Set_Surface (5, 8, 4)

Set_Surface (4, 3, 8)
Set_Surface (8, 7, 3)

Set_Surface (7, 6, 3)
Set_Surface (6, 2, 3)

Set_Surface (1, 2, 5)
Set_Surface (5, 6, 2)

Set_Surface (5, 8, 7)
Set_Surface (7, 6, 5)
'' - - end create - -

'---------------------------------------------------------------------------------------------------------------------'
Sub Set_Obj(byVal Rotate As Long)
  Dim As Long WinkelX, WinkelY, WinkelZX, WinkelZY, Winkel
  Dim As Long zpx, zpy, c, v1_x, v1_y, v2_x, v2_y, v3_x, v3_y, Pnt
  ScreenSet _Edit
  Cls
  For Pnt=0 To TriCnt
    WinkelX=((ACos(Sgn(Vertex(Tri(pnt).v1).X))))*p90
    WinkelY=((ASin(Sgn(Vertex(Tri(pnt).v1).Y))))*p90
'    WinkelZX=((ACos(Sgn(Vertex(Tri(pnt).v1).Z))))*p90
'    WinkelZY=((ASin(Sgn(Vertex(Tri(pnt).v1).Z))))*p90
    If WinkelX=0 And WinkelY<0 Then WinkelY+=360
'    If WinkelY<0 Then WinkelY+=180
    
    Winkel=(WinkelX+WinkelY+IIF(WinkelY<0, 180, 0)+Rotate)*Deg2Rad
'    zpx=Abs((Vertex(Tri(pnt).v1).X))-(Cos(Winkel)*Abs(Vertex(Tri(pnt).v1).X))
'    zpy=abs((Vertex(Tri(pnt).v1).Y))-(Sin(Winkel)*Abs(Vertex(Tri(pnt).v1).Y))
    v1_x = MidX+(Cos(Winkel)*Abs(Vertex(Tri(pnt).v1).X))+(Vertex(Tri(pnt).v1).Z\2)
    v1_y = MidY+(Sin(Winkel)*Abs(Vertex(Tri(pnt).v1).Y))+(Vertex(Tri(pnt).v1).Z\2)
    
    WinkelX=((ACos(Sgn(Vertex(Tri(pnt).v2).X))))*p90
    WinkelY=((ASin(Sgn(Vertex(Tri(pnt).v2).Y))))*p90
'    WinkelZX=((ACos(Sgn(Vertex(Tri(pnt).v2).z))))*p90
'    WinkelZY=((ASin(Sgn(Vertex(Tri(pnt).v2).z))))*p90
    If WinkelX=0 And WinkelY<0 Then WinkelY+=360
'    If WinkelY<0 Then WinkelY+=180
    
    Winkel=(WinkelX+WinkelY+IIF(WinkelY<0, 180, 0)+Rotate)*Deg2Rad
'    zpx=Abs((Vertex(Tri(pnt).v2).X))-(Cos(Winkel)*Abs(Vertex(Tri(pnt).v2).X))
'    zpy=Abs((Vertex(Tri(pnt).v2).Y))-(Sin(Winkel)*Abs(Vertex(Tri(pnt).v2).Y))
    v2_x = MidX+(Cos(Winkel)*Abs(Vertex(Tri(pnt).v2).X))+(Vertex(Tri(pnt).v2).Z\2)
    v2_y = MidY+(Sin(Winkel)*Abs(Vertex(Tri(pnt).v2).Y))+(Vertex(Tri(pnt).v2).Z\2)

    WinkelX=((ACos(Sgn(Vertex(Tri(pnt).v3).x))))*p90
    WinkelY=((ASin(Sgn(Vertex(Tri(pnt).v3).y))))*p90
'    WinkelZX=((ACos(Sgn(Vertex(Tri(pnt).v3).z))))*p90
'    WinkelZY=((ASin(Sgn(Vertex(Tri(pnt).v3).z))))*p90
    If WinkelX=0 And WinkelY<0 Then WinkelY+=360
'    If WinkelY<0 Then WinkelY+=180

    Winkel=(WinkelX+WinkelY+IIF(WinkelY<0, 180, 0)+Rotate)*Deg2Rad
'    zpx=Abs((Vertex(Tri(pnt).v3).x))-(Cos(Winkel)*Abs(Vertex(Tri(pnt).v3).x))
'    zpy=Abs((Vertex(Tri(pnt).v3).y))-(Sin(Winkel)*Abs(Vertex(Tri(pnt).v3).y))
    v3_x = MidX+(Cos(Winkel)*Abs(Vertex(Tri(pnt).v3).x))+(Vertex(Tri(pnt).v3).z\2)
    v3_y = MidY+(Sin(Winkel)*Abs(Vertex(Tri(pnt).v3).y))+(Vertex(Tri(pnt).v3).z\2)

    c=1+Pnt
    Line (v1_x, v1_y)-(v2_x, v2_y), c
    Line (v2_x, v2_y)-(v3_x, v3_y), c
    Line (v3_x, v3_y)-(v1_x, v1_y), c
      
  'locate 1+pnt,1:?v1_x,v1_y,v2_x,v2_y,v3_x,v3_y
  Next Pnt
  ScreenSet , _Edit
  Swap _Edit, _View
End Sub


Screen 19, 8, 2
Dim Ang As Long
Do
  Set_Obj(Ang)
  Ang=IIF(Ang+3>359, Ang-360, Ang+3)
  Sleep 1
Loop Until Inkey=Esc
End