3d To 2d projection
#1
Code:
'3d To 2d projection Using two cameras


Declare Function dbtp(x1 As Double,y1 As Double,z1 As Double,x2 As Double,y2 As Double,z2 As Double) As Double
Declare Sub drawstring(x As Integer, y As Integer, s As String, c As Integer)
Declare Sub calc3dto2dprojection(camera_zoom As Integer,camera_index As Integer,point_index As Integer)
Declare Sub drawprojection()
Declare Sub rotatepoint(px As Double,py As Double,pz As Double,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
Declare Sub rotatepoints(point_index As Integer,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)

Type threedpoint
    x As Integer
    y As Integer
    z As Integer
End Type

Type twodproj
    x As Integer
    y As Integer
End Type


Type camera
    x     As Double
    y     As Double
    z     As Double
    xyrot As Double
    xzrot As Double
    yzrot As Double
    zoom  As Double
End Type

ScreenRes 404,200,8,2
Dim As Integer i,j,k
Dim Shared p(8) As threedpoint
Dim Shared tpr(8) As threedpoint'temp point rotation

Dim Shared pp As twodproj
Dim Shared cam(2) As camera
Dim Shared As Double tpx,tpy,tpz

Const pi As Double = 3.1415926535897932

Dim Shared r As Double
Dim As Integer sleeptime
sleeptime=15

cam(1).x=0
cam(1).y=0
cam(1).z=256
cam(1).xyrot=0
cam(1).xzrot=0
cam(1).yzrot=0
cam(1).zoom=1

cam(2).x=256
cam(2).y=0
cam(2).z=0
cam(2).xyrot=0
cam(2).xzrot=90
cam(2).yzrot=0
cam(2).zoom=1

For i = 1 To 8
       Read p(i).x,p(i).y,p(i).z
Next


Do
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on xy axis",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
    ''''''''''''''''''''''''''''''
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on XZ axis",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            'rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on Yz axis",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    Window:View
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            'rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on xy & xz axes",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on xy & yz axes",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            'rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
    Window:View
    ScreenSet 0,0
    Cls
    'box for camera 1
    Line (0,0)-(199,199),15,b
    drawstring(2,2,"camera 1 Front view",15)
    drawstring(2,190,"rotating on xy,xz,yz axes",15)
    'box for camera 2
    Line (203,0)-(403,199),14,b
    drawstring(205,2,"camera 2 Side view",14)
    drawstring(205,190,"Right Side view",14)
    ScreenSet 1,1
    For i = 0 To 359
        Select Case InKey
            Case Chr(27), Chr(255) + "k"
                End
        End Select
        For j=1 To 8
            tpr(j)=p(j)
            rotatepoints(j,1,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,2,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
            rotatepoints(j,3,Cdbl(i),0,0,0)'3 planes of rotation 1=xy, 2=xz, 3=yz
        Next
        drawprojection
        For j=1 To 8
            p(j)=tpr(j)
        Next
        Sleep sleeptime
    Next
Loop
End


Sub drawprojection()
    Dim As Integer i,j,k,clr
    Dim As Double x1,y1,x2,y2
    View:Window
    ScreenCopy 0,1
    For i = 1 To 2
        Select Case i
            Case 1
                View (0,0)-(199,199)'drawing area
                Window (-100,-100)-(99,99)
            Case 2
                View (203,0)-(403,199)'drawing area
                Window (-100,-100)-(99,99)'(0,0)-(199,199)
        End Select
        For j = 1 To 8
            calc3dto2dprojection(256,i,j)
            x1=pp.x
            y1=pp.y
            If j=1 Then
                Circle(x1,y1),r*10,11
                ScreenSet 0,0
                PSet(x1,y1),10
                ScreenSet 1,1
            End If
            For k = 1 To 8
                calc3dto2dprojection(256,i,k)
                x2=pp.x
                y2=pp.y
                If k <> j Then
                    x2=pp.x
                    y2=pp.y
                    Select Case j
                        Case 1 To 4
                            Select Case k
                                Case 1 To 4
                                    clr=12
                                Case 5 To 8
                                    clr=13
                            End Select
                        Case 5 To 8
                            Select Case k
                                Case 1 To 4
                                    clr=14
                                Case 5 To 8
                                    clr=15
                            End Select
                    End Select
                    Line(x1,y1)-(x2,y2),clr
                End If
            Next
        Next
    Next
End Sub

'distance between two 3d points
Function dbtp(x1 As Double,y1 As Double,z1 As Double,x2 As Double,y2 As Double,z2 As Double) As Double
    dbtp = Sqr((x1-x2)^2 + (y1-y2)^2 + (z1-z2)^2)
End Function

Sub drawstring(x As Integer, y As Integer, s As String, c As Integer)
    Color c
    Draw String (x,y),s
End Sub

Sub calc3dto2dprojection(camera_zoom As Integer,camera_index As Integer,point_index As Integer)
    Dim As Integer i,j,k,cami,pointi
    cami=camera_index
    pointi=point_index
    Dim As Double dist'for brevity purposes
    Dim As Double ratio'
    Dim As Double temppx,temppy,temppz
    Dim As Double tempcx,tempcy,tempcz

    temppx=p(pointi).x
    temppy=p(pointi).y
    temppz=p(pointi).z
    tempcx=cam(cami).x
    tempcy=cam(cami).y
    tempcz=cam(cami).z
    'first step is to rotate the point around 0,0,0
    rotatepoint(temppx,temppy,temppz,1,-cam(cami).xyrot,0,0,0)
    temppx=tpx
    temppy=tpy
    rotatepoint(temppx,temppy,temppz,2,-cam(cami).xzrot,0,0,0)
    temppx=tpx
    temppz=tpz
    rotatepoint(temppx,temppy,temppz,3,-cam(cami).yzrot,0,0,0)
    temppy=tpy
    temppz=tpz
    'second step is to rotate the camera around 0,0,0
    rotatepoint(tempcx,tempcy,tempcz,1,-cam(cami).xyrot,0,0,0)
    tempcx=tpx
    tempcy=tpy
    rotatepoint(tempcx,tempcy,tempcz,2,-cam(cami).xzrot,0,0,0)
    tempcx=tpx
    tempcz=tpz
    rotatepoint(tempcx,tempcy,tempcz,3,-cam(cami).yzrot,0,0,0)
    tempcy=tpy
    tempcz=tpz
    'third step would be to move the point on the z axis only
    temppz=temppz+(camera_zoom-tempcz)
    '
    'forth step is to project it onto a 2d plane
    dist=dbtp(0,0,camera_zoom,temppx,temppy,temppz)
    ratio=camera_zoom/dist
    pp.x=temppx*ratio
    pp.y=temppy*ratio
    r=ratio

End Sub

Sub rotatepoints(point_index As Integer,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
    Dim As Integer pointi
    Dim As Double dx,dy,dz
    pointi=point_index
    dx=p(pointi).x-rox
    dy=p(pointi).y-roy
    dz=p(pointi).z-roz
    
    '3 planes of rotation 1=xy, 2=xz, 3=yz
    Select Case plane
        Case 1'xy plane
            p(pointi).x=dx*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+rox
            p(pointi).y=dy*Cos(angle*pi/180) + dx*Sin(angle*pi/180)+roy
        Case 2'xz plane
            p(pointi).x=dx*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+rox
            p(pointi).z=dz*Cos(angle*pi/180) - dx*Sin(angle*pi/180)+roz
        Case 3'yz plane
            p(pointi).z=dz*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+roz
            p(pointi).y=dy*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+roy
    End Select
End Sub


Sub rotatepoint(px As Double,py As Double,pz As Double,plane As Integer,angle As Double,rox As Double,roy As Double,roz As Double)
    Dim As Double dx,dy,dz
    dx=px-rox
    dy=py-roy
    dz=pz-roz
    
    '3 planes of rotation 1=xy, 2=xz, 3=yz
    Select Case plane
        Case 1'xy plane
            tpx=dx*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+rox
            tpy=dy*Cos(angle*pi/180) + dx*Sin(angle*pi/180)+roy
        Case 2'xz plane
            tpx=dx*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+rox
            tpz=dz*Cos(angle*pi/180) - dx*Sin(angle*pi/180)+roz
        Case 3'yz plane
            tpz=dz*Cos(angle*pi/180) - dy*Sin(angle*pi/180)+roz
            tpy=dy*Cos(angle*pi/180) + dz*Sin(angle*pi/180)+roy
    End Select
End Sub


Data -50, 50, 50
Data -50,-50, 50
Data  50,-50, 50
Data  50, 50, 50

Data -50, 50,-50
Data -50,-50,-50
Data  50,-50,-50
Data  50, 50,-50


Attached Files Thumbnail(s)

Reply
#2
this example use keys:
arrow keys (up, down, left, right)
and (+,-,d,c,a,z,q,Q,r,1,2,3,!,@,#,w,s,y,Y,h,H,u,U,j,J,i,I,k,K)
Code:
'note: my arrays usually do not use sub script zero
'when i dim a(4) i use a(1),a(2),a(3),a(4)... a(0) is not used
'good example is a rectangel has for points, point 1,2,3,4 and
'i usually refer to these points in my arrays as a(1-4) not a(0-3)
'secondly, even though i dim a(4), knowing a(0-5) are allocated in memory
'i find it convenient to use a(0) to temporarily store the value of (1-4)
'starting in the top left corner cuz we read (left to right)
'but in a counter clockwise manner cuz my code figures angles increase this way
'a(1) is top left corner
'a(2) is bottom left corner
'a(3) is bottom right corner
'a(4) is top right corner
'note:
'a(5) would be center of rectangle
'a(6) would be width of rectangle
'a(7) would be height of rectangle
'for a cube
'a(1-4) are the front face corners
'a(5-8) are the back face corners
'a(6) would be center of the cube
'a(7-9) would be the width,height,depth
'rotation is counter clockwise 0 degrees is at 3 O'clock - 90 is @ 12 - 180 is @ 9 - 270 is @ 6
'axis xy from front view
'axis xz from bottom view
'axis yz from right view
Type point2d
    x As Double
    y As Double
End Type
Type point2dgamma
    x As Double
    y As Double
    g As Double'gamma is ratio
End Type
Type point3d
    x As Double
    y As Double
    z As Double
End Type
Type cube2dgamma
    p(8) As point2dgamma
End Type
Type axes2dgamma
    p(6) As point2dgamma
End Type
Type rotation3daxes
    xy As Double
    xz As Double
    yz As Double
End Type
Type camera
    pos3d      As point3d
    rot3d      As rotation3daxes
    stationary As Byte
    visible    As Byte
    lensdepth  As Integer'this adjusts FOV
End Type
Type lines
    lstart As point3d
    lend As point3d
End Type
Type line2dgamma
    p(2) As point2dgamma
End Type

Declare Function rotate3dpoint(rotation_order As Integer,pivot As point3d, p As point3d, angle As rotation3daxes) As point3d
Declare Function proj3d(p3d As point3d,cam As camera) As point2dgamma
Declare Function abtp(abtpx1 as Double,abtpy1 as Double,abtpx2 as Double,abtpy2 as Double) as Double
Declare Function mymod(n As Double,m As Integer) As Double
Declare Sub drawonlens()

Const Pi = Atn(1) * 4
Dim As Integer _'iterators
i, _
j, _
k
'Dim Shared As Byte _'logic
'TRUE, _
'FALSE
'TRUE=-1
'FALSE=Not TRUE
Dim Shared As Integer _
mousex, _
mousey, _
mouseb, _
mousew, _
mousewp
Dim Shared tempd As Double
Dim Shared world_origin As point3d
world_origin.x=0
world_origin.y=0
world_origin.z=0

Dim pivotpoint3d As point3d
pivotpoint3d.x=0
pivotpoint3d.y=0
pivotpoint3d.z=0

Dim Shared vertex3d() As point3d
ReDim Preserve vertex3d(16)
For i = 1 To 14
    Read vertex3d(i).x
    Read vertex3d(i).y
    Read vertex3d(i).z
Next

'Dim rotaxis As rotation3daxes
'rotaxis.xy=90
'rotaxis.xz=0
'rotaxis.yz=90

'4 cameras
'cam 1 stationary, front view
'cam 2 stationary, right side view
'cam 3 stationary, top view
'cam 4 can manuver, default isometric view (up/right/front)
Dim Shared cam(4) As camera

cam(1).lensdepth=256
'front view
cam(1).pos3d.x=0
cam(1).pos3d.y=0
cam(1).pos3d.z=512
cam(1).rot3d.xy=0
cam(1).rot3d.xz=0
cam(1).rot3d.yz=0
'right side view
'cam(1).pos3d.x=512
'cam(1).pos3d.y=0
'cam(1).pos3d.z=0
'cam(1).rot3d.xy=0
'cam(1).rot3d.xz=90
'cam(1).rot3d.yz=0
'right side view-2
'cam(1).pos3d.x=-512
'cam(1).pos3d.y=0
'cam(1).pos3d.z=0
'cam(1).rot3d.xy=0
'cam(1).rot3d.xz=270
'cam(1).rot3d.yz=0
'top view
'cam(1).pos3d.x=0
'cam(1).pos3d.y=512
'cam(1).pos3d.z=0
'cam(1).rot3d.xy=0
'cam(1).rot3d.xz=0
'cam(1).rot3d.yz=270
'bottom view
'cam(1).pos3d.x=0
'cam(1).pos3d.y=-512
'cam(1).pos3d.z=0
'cam(1).rot3d.xy=0
'cam(1).rot3d.xz=0
'cam(1).rot3d.yz=90
'1 is the top left corner of the lens
cam(1).stationary=TRUE'camera can not be repositioned
cam(1).visible=TRUE'camer can be seen and displayed by other cameras
'mousex=wx1+(wx2-wx1)*(mousex/(drawareax2-drawareax1))
Dim Shared As Integer wx1,wy1,wx2,wy2,wsize,scrnres
scrnres=256
wsize=256
wx1=wsize/2*-1
wy1=wsize/2*-1
wx2=wsize/2
wy2=wsize/2

ScreenRes scrnres,scrnres,8,2
ScreenSet(1,1)
View (0,0)-(scrnres-1,scrnres-1)'drawing area
Window (wx1,wy1)-(wx2,wy2)
Dim tempv As point3d
Dim temppivot As point3d
Dim tempvup As point3d
Dim tempvdn As point3d
Dim tempvlt As point3d
Dim tempvrt As point3d
Dim tempvfwd As point3d
Dim tempvrev As point3d
Dim tempangle As Double
Dim tempangleup As Double
Dim tempangledn As Double
Dim tempanglelt As Double
Dim tempanglert As Double
Dim tempanglefwd As Double
Dim tempanglerev As Double
Dim temprot As rotation3daxes
temprot.xy=0
temprot.xz=0
temprot.yz=0
Dim scube As cube2dgamma 'my spinning cube
Dim axes As axes2dgamma' my axes
Dim axesrot As rotation3daxes
axesrot.xy=0
axesrot.xz=0
axesrot.yz=0
Dim As Integer ti
Dim As String h
ti=1
Dim neg As Byte
Dim Shared As Integer rotationorder
rotationorder=5
Dim As Byte spincubexy,spincubexz,spincubeyz
Dim As Byte spinaxisxy,spinaxisxz,spinaxisyz
spincubexy=FALSE
spincubexz=FALSE
spincubeyz=FALSE
spinaxisxy=FALSE
spinaxisxz=FALSE
spinaxisyz=FALSE
Dim As Byte userotorder
userotorder=TRUE
Dim Shared line3d() As lines
ReDim Preserve line3d(1)
Dim lineg As line2dgamma
Dim shared linecount As Integer
linecount=0
Dim Shared As Byte leftmousebdown,rightmousebdown
leftmousebdown=FALSE
rightmousebdown=FALSE
Dim Shared As Integer mouseclicks
mouseclicks=0
Dim Shared drawingz As Integer
Dim Shared nm As Integer
nm=256
Do
    For i=0 To 359
        ScreenCopy 0,1
        If cam(1).rot3d.xz<0 Then neg=TRUE Else neg = FALSE
        cam(1).rot3d.xy=mymod(cam(1).rot3d.xy,360)
        cam(1).rot3d.xz=mymod(cam(1).rot3d.xz,360)
        cam(1).rot3d.yz=mymod(cam(1).rot3d.yz,360)
        If cam(1).rot3d.xy<0 Then cam(1).rot3d.xy=360+cam(1).rot3d.xy
        If cam(1).rot3d.xz<0 Then cam(1).rot3d.xz=360+cam(1).rot3d.xz
        If cam(1).rot3d.yz<0 Then cam(1).rot3d.yz=360+cam(1).rot3d.yz
        Locate 29,1
        If userotorder=FALSE Then
            Print "simulated axes - 6 rot orders   ";
        Else
            Print "simulated axes rotation order";rotationorder;
        EndIf
        Locate 30,1
        Print "cam using rotation order";rotationorder;
        Locate 1,1
        Print "camrot axis xy ";cam(1).rot3d.xy
        Print "camrot axis xz ";cam(1).rot3d.xz
        Print "camrot axis yz ";cam(1).rot3d.yz
        Print "cam x pos ";cam(1).pos3d.x
        Print "cam y pos ";cam(1).pos3d.y
        Print "cam z pos ";cam(1).pos3d.z
        Print "sim axis xy ";axesrot.xy
        Print "sim axis xz ";axesrot.xz
        Print "sim axis yz ";axesrot.yz
        Print "cam lens depth ";cam(1).lensdepth
        Print "drawing depth ";drawingz
        Print "nm=";nm
        drawonlens
        If spincubexy=TRUE Then temprot.xy=i Else temprot.xy=0
        If spincubexz=TRUE Then temprot.xz=i Else temprot.xz=0
        If spincubeyz=TRUE Then temprot.yz=i Else temprot.yz=0
        If spinaxisxy=TRUE Then axesrot.xy=i' Else axesrot.xy=0
        If spinaxisxz=TRUE Then axesrot.xz=i' Else axesrot.xz=0
        If spinaxisyz=TRUE Then axesrot.yz=i' Else axesrot.yz=0
        'spin cube
        For j = 1 To 8
            tempv=vertex3d(j)
            tempv=rotate3dpoint(rotationorder,world_origin, tempv, temprot)
            scube.p(j)=proj3d(tempv,cam(1))
        Next
        If scube.p(1).g<>0 Then
            Circle (scube.p(1).x,scube.p(1).y),10*scube.p(1).g,15
            If scube.p(2).g<>0 Then
                Line(scube.p(1).x,scube.p(1).y)-(scube.p(2).x,scube.p(2).y),13
            EndIf
            If scube.p(4).g<>0 Then
                Line(scube.p(1).x,scube.p(1).y)-(scube.p(4).x,scube.p(4).y),13
            EndIf
            If scube.p(5).g<>0 Then
                Line(scube.p(1).x,scube.p(1).y)-(scube.p(5).x,scube.p(5).y),15
            EndIf
        End If
        If scube.p(2).g<>0 Then
            If scube.p(3).g<>0 Then
                Line(scube.p(2).x,scube.p(2).y)-(scube.p(3).x,scube.p(3).y),13
            EndIf
            If scube.p(6).g<>0 Then
                Line(scube.p(2).x,scube.p(2).y)-(scube.p(6).x,scube.p(6).y),15
            EndIf
        EndIf
        If scube.p(3).g<>0 Then
            If scube.p(4).g<>0 Then
                Line(scube.p(3).x,scube.p(3).y)-(scube.p(4).x,scube.p(4).y),13
            EndIf
            If scube.p(7).g<>0 Then
                Line(scube.p(3).x,scube.p(3).y)-(scube.p(7).x,scube.p(7).y),15
            EndIf
        EndIf
        If scube.p(4).g<>0 And scube.p(8).g<>0 Then
            Line(scube.p(4).x,scube.p(4).y)-(scube.p(8).x,scube.p(8).y),15
        EndIf
        If scube.p(5).g<>0 Then
            If scube.p(6).g<>0 Then
                Line(scube.p(5).x,scube.p(5).y)-(scube.p(6).x,scube.p(6).y),14
            EndIf
            If scube.p(8).g<>0 Then
                Line(scube.p(5).x,scube.p(5).y)-(scube.p(8).x,scube.p(8).y),14
            EndIf
        EndIf
        If scube.p(6).g<>0 And scube.p(7).g<>0 Then
            Line(scube.p(6).x,scube.p(6).y)-(scube.p(7).x,scube.p(7).y),14
        EndIf
        If scube.p(7).g<>0 And scube.p(8).g<>0 Then
            Line(scube.p(7).x,scube.p(7).y)-(scube.p(8).x,scube.p(8).y),14
        EndIf
        For j=1 To 6
            tempv=vertex3d(j+8)
            If userotorder=TRUE Then
                tempv=rotate3dpoint(rotationorder,world_origin, tempv, axesrot)
            Else
                tempv=rotate3dpoint(j,world_origin, tempv, axesrot)
            End If
            axes.p(j)=proj3d(tempv,cam(1))
        Next
        For j=2 To 6 Step 2
            Circle (axes.p(j).x,axes.p(j).y),10*axes.p(j).g,15
        Next
        If axes.p(1).g<>0 And axes.p(2).g<>0 Then
            Line(axes.p(1).x,axes.p(1).y)-(axes.p(2).x,axes.p(2).y),10
        EndIf
        If axes.p(3).g<>0 And axes.p(4).g<>0 Then
            Line(axes.p(3).x,axes.p(3).y)-(axes.p(4).x,axes.p(4).y),11
        EndIf
        If axes.p(5).g<>0 And axes.p(6).g<>0 Then
            Line(axes.p(5).x,axes.p(5).y)-(axes.p(6).x,axes.p(6).y),12
        EndIf
        For j = 1 To linecount
            tempv=line3d(j).lstart
            lineg.p(1)=proj3d(tempv,cam(1))
            tempv=line3d(j).lend
            lineg.p(2)=proj3d(tempv,cam(1))
            If lineg.p(1).g<>0 And lineg.p(2).g<>0 Then
                Line(lineg.p(1).x,lineg.p(1).y)-(lineg.p(2).x,lineg.p(2).y)
            EndIf
        Next
        
        
        
        
        tempv=cam(1).pos3d
        h=InKey
        Select Case h
            Case Chr(27)
                Exit Do
            Case "+"
                wsize=wsize-4
                If wsize=0 Then wsize=4
                wx1=wsize/2*-1
                wy1=wsize/2*-1
                wx2=wsize/2
                wy2=wsize/2
                Window (wx1,wy1)-(wx2,wy2)
            Case "-"
                wsize=wsize+4
                wx1=wsize/2*-1
                wy1=wsize/2*-1
                wx2=wsize/2
                wy2=wsize/2
                Window (wx1,wy1)-(wx2,wy2)
            Case "d"
                drawingz=drawingz+1
            Case "c"
                drawingz=drawingz-1
                'If drawingz<0 Then drawingz=0
            Case "a"
                cam(1).lensdepth=cam(1).lensdepth+1
            Case "z"
                cam(1).lensdepth=cam(1).lensdepth-1
                If cam(1).lensdepth< 1 Then cam(1).lensdepth=1
            Case "q"
                If userotorder=FALSE Then userotorder=TRUE Else userotorder=FALSE
            Case "Q"
                axesrot.xy=0
                axesrot.xz=0
                axesrot.yz=0
            Case "r","R"
                rotationorder=rotationorder+1
                If rotationorder=7 Then rotationorder=1
            Case "1"
                If spincubexy=FALSE Then
                    spincubexy=TRUE
                Else
                    spincubexy=FALSE
                EndIf
            Case "2"
                If spincubexz=FALSE Then
                    spincubexz=TRUE
                Else
                    spincubexz=FALSE
                EndIf
            Case "3"
                If spincubeyz=FALSE Then
                    spincubeyz=TRUE
                Else
                    spincubeyz=FALSE
                EndIf
            Case "!"
                If spinaxisxy=FALSE Then
                    spinaxisxy=TRUE
                Else
                    spinaxisxy=FALSE
                EndIf
            Case "@"
                If spinaxisxz=FALSE Then
                    spinaxisxz=TRUE
                Else
                    spinaxisxz=FALSE
                EndIf
            Case "#"
                If spinaxisyz=FALSE Then
                    spinaxisyz=TRUE
                Else
                    spinaxisyz=FALSE
                EndIf
            Case Chr(255)+"H"'up
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera up
                tempv.y=cam(1).pos3d.y +10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case Chr(255)+"P"'dn
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera down
                tempv.y=cam(1).pos3d.y -10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case Chr(255)+"K"'lt
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera left
                tempv.x=cam(1).pos3d.x -10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case Chr(255)+"M"'rt
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera right
                tempv.x=cam(1).pos3d.x +10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case "w"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera forward
                tempv.z=cam(1).pos3d.z +10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case "s"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively moving the camera backwards
                tempv.z=cam(1).pos3d.z -10
                cam(1).pos3d=rotate3dpoint(rotationorder,cam(1).pos3d, tempv, cam(1).rot3d)
            Case "y"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively rolling the camera clock wise
                cam(1).rot3d.xy=cam(1).rot3d.xy+1
            Case "Y"
                axesrot.xy=Int(axesrot.xy)+1
            Case "h"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively rolling the camera counter clock wise
                cam(1).rot3d.xy=cam(1).rot3d.xy-1
            Case "H"
                axesrot.xy=Int(axesrot.xy)-1
            Case "u"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively yawing the camera's nose to the left
                cam(1).rot3d.xz=cam(1).rot3d.xz+1
            Case "U"
                axesrot.xz=Int(axesrot.xz)+1
            Case "j"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively yawing the camera's nose to the right
                cam(1).rot3d.xz=cam(1).rot3d.xz-1
            Case "J"
                axesrot.xz=Int(axesrot.xz)-1
            Case "i"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively pitching the camera's nose up
                cam(1).rot3d.yz=cam(1).rot3d.yz+1
            Case "I"
                axesrot.yz=Int(axesrot.yz)+1
            Case "k"
                'according to camera's current rotation on the 3 axes
                'adjust cam.x,y,z effectively pitching the camera's nose down
                cam(1).rot3d.yz=cam(1).rot3d.yz-1
            Case "K"
                axesrot.yz=Int(axesrot.yz)-1
            Case Chr(27), Chr(255) + "k"
                Exit Do
            Case Else
        End Select
        GetMouse mousex,mousey,mousew,mouseb
        Sleep 1
    
    Next
Loop
End

Function rotate3dpoint(rotation_order As Integer,pivot As point3d, p As point3d, angle As rotation3daxes) As point3d
    Dim As Double _
    dx,           _
    dy,           _
    dz,           _
    anglexy,      _
    anglexz,      _
    angleyz
    
    dx=p.x-pivot.x
    dy=p.y-pivot.y
    dz=p.z-pivot.z
    anglexy=angle.xy*pi/180
    anglexz=angle.xz*pi/180
    angleyz=angle.yz*pi/180
    'starting off from the front or right views and yawing
    'rotation order #3 works when rotation on xz axis 0 to 359 (yaw)
    'ie. rotating xy axis makes it roll
    '    rotating yz axis makes it pitch
    'starting off from the top view
    'rotation 5 works
    'Locate 31,20
    Select Case rotation_order
        Case 1
            'Print "xy - xz - yz";
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
            dx=p.x
            dy=p.y
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
            dz=p.z
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
        Case 2
            'Print "xy - yz - xz";
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
            dx=p.x
            dy=p.y
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
            dz=p.z
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
        Case 3
            'Print "xz - xy - yz";
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
            dx=p.x
            dz=p.z
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
            dy=p.y
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
        Case 4
            'Print "xz - yz - xy";
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
            dx=p.x
            dz=p.z
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
            dy=p.y
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
        Case 5
            'Print "yz - xy - xz";
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
            dy=p.y
            dz=p.z
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
            dx=p.x
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
        Case 6
            'Print "yz - xz - xy";
            p.y=dy*Cos(angleyz) - dz*Sin(angleyz)
            p.z=dz*Cos(angleyz) + dy*Sin(angleyz)
            dy=p.y
            dz=p.z
            p.x=dx*Cos(anglexz) + dz*Sin(anglexz)
            p.z=dz*Cos(anglexz) - dx*Sin(anglexz)
            dx=p.x
            p.x=dx*Cos(anglexy) - dy*Sin(anglexy)
            p.y=dy*Cos(anglexy) + dx*Sin(anglexy)
    End Select
    
    p.x=p.x+pivot.x
    p.y=p.y+pivot.y
    p.z=p.z+pivot.z
    Return p
End Function

'project_3d_point_to_2d_camera_lens_to_screen_xy_coordinates_with_gamma
Function proj3d(   _
    p3d As point3d, _
    cam As camera   _
    ) As point2dgamma
    Dim As Integer camlensdepth
    camlensdepth=cam.lensdepth
    Dim p2dg As point2dgamma
    Dim As Double _
    z_distance,   _
    z_ratio
    Dim As point3d _
    tp,            _'temp_point
    tc              'temp_camera_position
    Dim trot As rotation3daxes
    Dim reversero As Integer
    Select Case rotationorder
        Case 1
            reversero=6
        Case 2
            reversero=4
        Case 3
            reversero=5
        Case 4
            reversero=2
        Case 5
            reversero=3
        Case 6
            reversero=1
    End Select
    tp=p3d
    trot.xy=cam.rot3d.xy*-1
    trot.xz=cam.rot3d.xz*-1
    trot.yz=cam.rot3d.yz*-1
    tp=rotate3dpoint(reversero,cam.pos3d, p3d, trot)
    tc=cam.pos3d
    tp.x=tp.x-tc.x
    tp.y=tp.y-tc.y
    z_distance=tc.z-tp.z
    If z_distance=0 Then z_distance=1
    tempd=z_distance
    z_ratio=camlensdepth/z_distance
    p2dg.x=tp.x*z_ratio
    p2dg.y=tp.y*z_ratio
    If tp.z>=tc.z Then
        p2dg.g=0
    Else
        p2dg.g=z_ratio
    EndIf
    Return p2dg
End Function

Sub drawonlens()
    Dim As point3d mouse3d, scrnc3d, tempv
    Dim As point2dgamma mouse2d, scrnc2d
    'scrnc3d.x=0+cam(1).pos3d.x
    'scrnc3d.y=0+cam(1).pos3d.y
    'scrnc3d.z=cam(1).pos3d.z-256
    'scrnc3d=rotate3dpoint(rotationorder,cam(1).pos3d,scrnc3d,cam(1).rot3d)
    'Print Int(scrnc3d.x);Int(scrnc3d.y);Int(scrnc3d.z)
    mousex=wx1+(wx2-wx1)*(mousex/scrnres)
    mousey=(wy1+(wy2-wy1)*(mousey/scrnres))*-1

    mouse3d.x=mousex*(256/cam(1).lensdepth)*((256-drawingz)/256)+cam(1).pos3d.x'*(drawingz/128)
    mouse3d.y=mousey*(256/cam(1).lensdepth)*((256-drawingz)/256)+cam(1).pos3d.y
    mouse3d.z=cam(1).pos3d.z-256+drawingz
    mouse3d=rotate3dpoint(rotationorder,cam(1).pos3d,mouse3d,cam(1).rot3d)
    Print Int(mouse3d.x);Int(mouse3d.y);Int(mouse3d.z)
    'tempv=scrnc3d
    'scrnc2d=proj3d(tempv,cam(1))
    'tempv=mouse3d
    'mouse2d=proj3d(tempv,cam(1))
    'Line(scrnc2d.x,scrnc2d.y)-(mouse2d.x,mouse2d.y)
    Select Case mouseb
        Case 0
            If leftmousebdown=TRUE Then
                Select Case mouseclicks
                    Case 0
                        mouseclicks=1
                        line3d(0).lstart=mouse3d
                    Case 1
                        line3d(0).lend=mouse3d
                        linecount=linecount+1
                        ReDim Preserve line3d(linecount)
                        line3d(linecount)=line3d(0)
                        line3d(0).lstart=mouse3d
                End Select
                'mouse button released
                'linecount=linecount+1
                'ReDim Preserve line3d(linecount)
                'line3d(linecount).lstart=scrnc3d
                'line3d(linecount).lend=mouse3d
            EndIf
            If rightmousebdown=TRUE Then
                If mouseclicks=1 Then
                    'linecount=linecount-1
                    mouseclicks=0
                EndIf
            EndIf
            leftmousebdown=FALSE
            rightmousebdown=FALSE
        Case 1
            leftmousebdown=TRUE
        Case 2
            rightmousebdown=TRUE
    End Select
    Print "line count=";linecount
    If mouseclicks=1 Then
        tempv=line3d(0).lstart
        scrnc2d=proj3d(tempv,cam(1))
        tempv=mouse3d
        mouse2d=proj3d(tempv,cam(1))
        Line(scrnc2d.x,scrnc2d.y)-(mouse2d.x,mouse2d.y)
    End If
End Sub




Function abtp(abtpx1 as Double,abtpy1 as Double,abtpx2 as Double,abtpy2 as Double) as Double
    Dim As Double xlength,ylength,angle
    xlength=(abtpx1-abtpx2)*-1
    ylength=(abtpy1-abtpy2)*-1
    angle=atan2(ylength,xlength)/pi*180
    If angle<0 then angle=360+angle Mod 360
    abtp=angle
End Function



Function mymod(n As Double,m As Integer) As Double
    Dim As Integer i
    Dim As Byte neg, dec, inf
    Select Case n
        Case 0
            mymod = 0
        Case Else
            If n<0 Then neg = TRUE Else neg = FALSE
            dec=FALSE
            inf=FALSE
            Dim As String nstring
            nstring=LTrim(Str(n))
            'If Mid(nstring,1,1)="-" Then neg=TRUE Else neg=FALSE
            If neg=TRUE Then nstring= Mid(nstring,2)
            For i = 1 To Len(nstring)
                Select Case Mid(nstring,i,1)
                    Case "0" To "9"
                        'this is ok
                    Case "."
                        dec=TRUE
                    Case Else
                        'Cls
                        'Print nstring
                        'Print Mid(nstring,i,1)
                        'sleep
                        inf=TRUE
                        Exit For
                End Select
            Next
            If inf=TRUE Then
                mymod=0
            Else
                If neg=TRUE Then
                    If dec=TRUE Then
                        mymod=Val(Str(val(Mid(nstring,1,InStr(nstring,".")-1)) Mod m)+"."+Mid(nstring,InStr(nstring,".")+1))*-1
                    Else
                        mymod = n Mod m
                    End If
                Else
                    If dec=TRUE Then
                        mymod=Val(Str(val(Mid(nstring,1,InStr(nstring,".")-1)) Mod m)+"."+Mid(nstring,InStr(nstring,".")+1))
                    Else
                        mymod = n Mod m
                    End If
                EndIf
            EndIf
    End Select
End Function


'spinning cube
Data -100, 100, 100
Data -100,-100, 100
Data  100,-100, 100
Data  100, 100, 100

Data -100, 100,-100
Data -100,-100,-100
Data  100,-100,-100
Data  100, 100,-100
'axes
'x axis
Data -100,0,0
Data  100,0,0
'y axis
Data 0, 100,0
Data 0,-100,0
'z axis
Data 0,0, 100
Data 0,0,-100


''axes
''x axis
'Data -100,10,10
'Data  100,10,10
''y axis
'Data 10, 100,10
'Data 10,-100,10
''z axis
'Data 10,10, 100
'Data 10,10,-100
Reply