here are a must read !xlucas wrote:But truly, my real problem is with perspective and clipping.
Joshy
here are a must read !xlucas wrote:But truly, my real problem is with perspective and clipping.
D.J.Peters wrote:here are a must read !xlucas wrote:But truly, my real problem is with perspective and clipping.
Joshy
Code: Select all
$$ \begin{array}{l} w' = x * m_{03} + y * m_{13} + \color{red}{z * m_{23}} + 1 * m_{33} \end{array}{} $$
xlucas wrote:I know. I did it that way because I'm working at the same time on the editor and the renderer and for each, a different system is convenient. Once I make a final thing, I would just transform the 3D models to the same system as that of the renderer. I prefer to use Z for up because that is how a "player" would feel the world (unless in space). One tends to imagine a map and maps usually go by X and Y, not X and Z. Minecraft uses X/Z maps and I don't like that much, ha, ha. Of course, if the renderer were for an X-Wing and not for a Stunts, then it'd make more sense to use Y for up. But yes, I do agree in the end it should be just one system.
xlucas wrote:Nice to meet you, Euler! Ha, ha. Well, actually, I do know who Leonard Euler was. I just didn't know about Euler's Angles. I sat and thought how I should do this and well, I remember the nights playing with the telescope. I love Astronomy, but I'm not an astronomer. So that's how I came to set up that system. I also realised that using the system with azimuth first would mean that I can just ignore azimuth when solving for the horizon. Still, after reading about the gimbal lock, I know exactly what you mean. Since I recalculate from 0/0/0 degrees and execute all three rotations for each frame (with the purpose of not losing accuracy), I assumed there'd be no risk of locking, but to be honest, I haven't played much with 3D in the past, so I may be totally wrong.
xlucas wrote:I can understand your code. It only takes me longer to read than my own, of course... and your code is long, man... ha, ha. I've been playing with the paper plane. Really great. I'm kind of concerned on how I will trim my triangles. It's easier to do it with segments. I know my rotation is not the best, but so far, it works (I will of course keep on reading and will consider other systems). But truly, my real problem is with perspective and clipping.
xlucas wrote:Paul: Yeah, I know how matrices work. I just didn't represent my transformations with matrices in my code because that would make things slower and the transformations were very simple anyway, but I'm reading about the homogenous vectors and it's very interesting. I'm surprised that my completely unoptimised code already gets to enough FPSs as for a game. I'm not even cacheing the trigonometric functions yet!
Code: Select all
type V3
as single x,y,z
end type
' camera near-plane clipping
' iP = input Points
' nP = number of input Points
' oP = clipped output Points
' function returns number of clipped output Points or 0
const as single NEAR_PLANE = 1 ' <- change it to 30
function ZClipNear(iP() as V3,nP as integer,oP() as V3) as integer
dim as single s=any,e=any,t=any
dim as integer r,c,l = nP-1
if l<1 then ' it's only one input Point to clip
' it's in front of the camera (copy this Point to output)
if iP(c).z>=1 then oP(r)=iP(c) : r+=1 ' count it in [r]eturn value
else
c=l ' [c]urent Point = [l]ast Point in input array
for n as integer=0 to l
s = iP(c).z ' get z [s]tart from [c]urent point
e = iP(n).z ' get z [e]nd from [n]ext point
if s>=NEAR_PLANE andalso e>=NEAR_PLANE then
' if both start and end in front of the camera copy [n]ext Point to output
oP(r)=iP(n) : r+=1 ' count it in [r]eturn value
elseif s<NEAR_PLANE andalso e<NEAR_PLANE then
' if both start and end behind the camera simple ignore it :-)
else
' One Point are in front and one are behind the camera
' it plays no rule witch from them are in front or behind
' most important here are the fact that
' z-[s]tart and z-[e]nd are never equal so no division by zero !
' create in the [o]ut[P]ut array a new Point clipped as the nearpane
t = (NEAR_PLANE-s)/(e - s)
oP(r).x = iP(c).x + (iP(n).x - iP(c).x)*t
oP(r).y = iP(c).y + (iP(n).y - iP(c).y)*t
oP(r).z = NEAR_PLANE : r+=1 ' <- and count the new clipped point
' !!! at this clipping stage if the curent Point z-[s]tart
' was behind the camera (s<NEAR_PLANE) the [n]ext Point "must be" in front !!!
' copy [n]ext [i]n[P]ut to [o]ut[P]ut and count it
if s<NEAR_PLANE then oP(r)=iP(n) : r+=1
end if
c=n ' move [c]urent Point to the [n]ext Point
next
end if
return r ' return the number of clipped points in output array
end function
dim as V3 world(2)
dim as V3 clipNear(5)
dim as V3 clipFar(5)
dim as V3 camera
dim as single w
dim as integer n
dim as single x,y,sx,sy
screenres 640,480,8,2
screenset 1,0
camera.y=-10
camera.z= 100
while inkey()=""
cls
camera.z=100+sin(w)*100
' create a rotating 3d rectangle in the X-Z plane
for i as integer=0 to 3
world(i).x=cos(w+i*1.57)*70 - camera.x
world(i).y=1-camera.y
world(i).z=sin(w+i*1.57)*70 + camera.z
next
' clip the rectangle at the z-nearlane
n=ZClipNear(world(),4,clipNear())
if n>0 then
for i as integer=0 to n-1
dim as integer j=(i+1) mod n
sx=320 + (clipNear(i).x*512)/clipNear(i).z
sy=240 + (clipNear(i).y*512)/clipNear(i).z
x =320 + (clipNear(j).x*512)/clipNear(j).z
y =240 + (clipNear(j).y*512)/clipNear(j).z
line (sx,sy)-(x,y),15
circle (sx,sy),3,15,,,,F
next
end if
flip
sleep 10
w+=0.01
wend
Code: Select all
function ZClipFar(iP() as V3,nP as integer,oP() as V3,FarPlane as single=1000.0) as integer
dim as single s=any,e=any,t=any
dim as integer r,c,l = nP-1
if l<1 then
if iP(c).z<FarPlane then oP(r)=iP(c) : r+=1
else
c=l
for n as integer=0 to l
s = iP(c).z : e = iP(n).z
if s<FarPlane andalso e<FarPlane then
oP(r)=iP(n) : r+=1
elseif s>FarPlane andalso e>FarPlane then
' nothing to do I like it :-)
else
t = (FarPlane - s)/(e - s)
oP(r).x = iP(c).x + (iP(n).x - iP(c).x)*t
oP(r).y = iP(c).y + (iP(n).y - iP(c).y)*t
oP(r).z = FarPlane : r+=1
if s>FarPlane then oP(r)=iP(n) : r+=1
end if
c=n
next
end if
return r
end function
Code: Select all
type V3
as single x,y,z
end type
' camera near-plane clipping
' the nearplane normaly hard coded as 1 but for this demo implemented as param
function ZClipNear(iP() as V3,nP as integer,oP() as V3,NearPlane as single=1.0) as integer
dim as single s=any,e=any,t=any
dim as integer r,c,l = nP-1
if l<1 then
if iP(c).z>=NearPlane then oP(r)=iP(c) : r+=1
else
c=l
for n as integer=0 to l
s = iP(c).z : e = iP(n).z
if s>=NearPlane andalso e>=NearPlane then
oP(r)=iP(n) : r+=1
elseif s<NearPlane andalso e<NearPlane then
' do nothing I like it :-)
else ' clip it at near plane (normaly z=1)
t = (NearPlane - s)/(e - s)
oP(r).x = iP(c).x + (iP(n).x - iP(c).x)*t
oP(r).y = iP(c).y + (iP(n).y - iP(c).y)*t
oP(r).z = NearPlane : r+=1
if s<NearPlane then oP(r)=iP(n) : r+=1
end if
c=n
next
end if
return r
end function
dim as V3 world(2)
dim as V3 clipNear(5)
dim as V3 clipFar(5)
dim as V3 camera
dim as V3 a,b
dim as single w,nearplane
dim as integer n
dim as single x,y,sx,sy
screenres 640,480,8,2
screenset 1,0
camera.y=-10
camera.z= 100
a.x=-150 : a.y= 1
b.x= 150 : b.y= 1
while inkey()=""
cls
nearplane=100+sin(w*0.5-3.14)*99
' draw the nearplane (normaly you will never see them)
sx=320 + ((a.x - camera.x)*512)/nearplane
sy=240 + ((a.y - camera.y)*512)/nearplane
x =320 + ((b.x - camera.x)*512)/nearplane
y =240 + ((a.y - camera.y)*512)/nearplane
line (sx,sy)-(x,y),10
' create a rotating 3d rectangle in the X-Z plane
for i as integer=0 to 3
world(i).x=cos(w+i*1.57)*50 - camera.x
world(i).y=1-camera.y
world(i).z=sin(w+i*1.57)*50 + camera.z
next
' clip the rectangle at the moving z-nearlane
n=ZClipNear(world(),4,clipNear(),nearplane)
if n>0 then
for i as integer=0 to n-1
dim as integer j=(i+1) mod n
sx=320 + (clipNear(i).x*512)/clipNear(i).z
sy=240 + (clipNear(i).y*512)/clipNear(i).z
x =320 + (clipNear(j).x*512)/clipNear(j).z
y =240 + (clipNear(j).y*512)/clipNear(j).z
line (sx,sy)-(x,y),15
circle (sx,sy),3,15,,,,F
next
end if
flip
sleep 10
w+=0.01
wend
paul doe wrote:What you say makes perfect sense in a 2D cartesian plane, but in 3D it does not. Z has almost invariably been used as the 'depth' component of the 3D coordinate tuple
paul doe wrote:Not to mention that with Euler, you can only rotate about the center of the coordinate system.
paul doe wrote:It's a common misconception that matrices are the 'slower' way to do these things.
D.J.Peters wrote:In your "simple" 3d math the camera is always at the origin i'm right ?
D.J.Peters wrote:A fixed camera at the origin makes near plane clipping really easy and fast.
xlucas wrote:I understand that and I'm willing to use a screen-based reference system if working in team, but I would like to remmark that I have a good reason for doing this way. Stunts, like Wolfenstein-3D, for example, is a 2D-map-based game. For a player, the lateral components are interchangeable, but the up/down component is different, because of gravity. Besides, only one height is possible (In Stunts, it may seem at first sight that there are two height levels, but this is a trick. Notice how not two items can be at the same X/Y. The raised elements are just displaced, but there's no actual height component in the map. Because it's 2D, it makes more sense to call the coordinates X and Y than X and Z. As I feel it, the Z actually is depth here. It's map-based depth, though, not screen-based depth. But again, this is just "philosophy", ha, ha. I've no problem with working on a screen-based system.
xlucas wrote:This is something I still don't understand very well and have to learn. As I understood it, rotating about an axis that's not at the origin is arithmetically equivalent to displacing the world, then rotating, then optionally displacing back. Do you mean that one creates rotation matrices on-the-fly to produce rotation at uncentred axes? I kind of understand what happens in the code, but it's like I'm not understanding how one reaches the technique. I still have to digest all this :-)
Code: Select all
function rotateAroundAxis( byref v as vec4, byref axis as vec4, byval angle as single ) as vec4
/'
rotate vector v around arbitrary axis for angle radians
it can only rotate around an axis through our object, to rotate around another axis:
first translate the object to the axis, then use this function, then translate back
in the new direction.
'/
if( ( v.x = 0 ) and ( v.y = 0 ) and ( v.z = 0 ) ) then
return vec4( 0.0, 0.0, 0.0 )
end if
dim nAxis as vec4 = vec4( axis.x, axis.y, axis.z )
nAxis.normalize()
'' calculate parameters of the rotation matrix
dim as single c = cos( angle )
dim as single s = sin( angle )
dim as single t = 1 - c
'' multiply w with rotation matrix
dim w as vec4
w.x = ( t * nAxis.x * nAxis.x + c ) * v.x _
+ ( t * nAxis.x * nAxis.y + s * nAxis.z ) * v.y _
+ ( t * nAxis.x * nAxis.z - s * nAxis.y ) * v.z
w.y = ( t * nAxis.x * nAxis.y - s * nAxis.z ) * v.x _
+ ( t * nAxis.y * nAxis.y + c ) * v.y _
+ ( t * nAxis.y * nAxis.z + s * nAxis.x ) * v.z
w.z = ( t * nAxis.x * nAxis.z + s * nAxis.y ) * v.x _
+ ( t * nAxis.y * nAxis.z - s * nAxis.x ) * v.y _
+ ( t * nAxis.z * nAxis.z + c ) * v.z
'' the vector has to retain its length, so it's normalized and
'' multiplied with the original length
w.normalize()
w = w * v.length()
return( w )
end function
xlucas wrote:I know processors today are very fast and I've been realising how fast trigonometric functions are. I think I'll follow your advice to not caché them, since it's true it would get the code more messy for little gain. About matrix multiplication for every transformation, I'm just trying to avoid multiplications by 1 and 0 when the transformation can be performed comprehensively. I am not sure whether the processor is faster at multiplying by those factors than by others. I assume it takes exactly the same amount of time, so that the CPU can sync. Anyway, of course behind the scenes, it's the same transformation we're doing, so one could say I am indeed using matrix multiplication. Again, no problem to adopt good things that work.
paul doe wrote:Note that rotating about an arbitrary axis is not the same thing as rotating around an arbitrary point.
D.J.Peters wrote:if clipping heppents clip the point and copy the result to a vertex and draw it
(the point self are never modifyed by the clipping)
You are kidding me :-)xlucas wrote:...This will produce two different new verteces and I'll have a 4-sided polygon. Split the polygon in two triangles. Draw each triangle. Voilà!
Code: Select all
type V3 ' 3d coords
' +x points right +y points up +z points forward (in the screen)
' It's left-handed cartesian coordinate systems
' OpenGL used a right handed system where +z points backward (out the screen)
as single x,y,z
end type
type PV3 as V3 ptr
type V3List as PV3D ptr
type Point3D
as V3 o ' [o]bject space (after creation or loading from disk)
as V3 l ' [l]ocal space (after scaling, moving and rotation at the local object origin)
as V3 w ' [w]orld space (after animation inside the world or if connected to a parent object)
as V3 c ' [c]amera space (after moving and rotation of the camera)
end type
type PPoint as Point3D ptr
type PointList as PPoint ptr
type Vertex3D
as V3 c ' 3d clipped coords
as integer sx,sy ' 2d screen coords
as integer u,v ' texture coords
as integer iNormal ' index of a vertex normal (or -1 if it's a face normal)
' ...
end type
type PVertex as Vertex3D ptr
type VertexList as PVertex ptr
type Face3D
declare constructor(i0 as integer)
declare constructor(i0 as integer,i1 as integer)
declare constructor(i0 as integer,i1 as integer,i2 as integer)
declare constructor(i0 as integer,i1 as integer,i2 as integer,i3 as integer)
declare constructor(i() as integer)
declare operator [](index as uinteger) byref as integer
declare function count as uinteger ' 1=point, 2=line, 3=triangle, 4=quad #=polygon
as integer Indicies(any)
as PV3 Normal
end type
constructor Face3D(i0 as integer)
redim Indicies(0) : Indicies(0)=i0
end constructor
constructor Face3D(i0 as integer,i1 as integer)
redim Indicies(1) : Indicies(0)=i0:Indicies(1)=i1
end constructor
constructor Face3D(i0 as integer,i1 as integer,i2 as integer)
redim Indicies(2) : Indicies(0)=i0:Indicies(1)=i1:Indicies(2)=i2
end constructor
constructor Face3D(i0 as integer,i1 as integer,i2 as integer,i3 as integer)
redim Indicies(3) : Indicies(0)=i0:Indicies(1)=i1:Indicies(3)=i2:Indicies(3)=i3
end constructor
constructor Face3D(ii() as integer)
dim as integer n=ubound(ii)
if n>-1 then
redim Indicies(n) : for i as integer=0 to n:Indicies(i)=ii(i):next
end if
end constructor
function Face3D.count as uinteger
return ubound(Indicies)
end function
operator Face3D.[](index as uinteger) byref as integer
operator = Indicies(index)
end operator
type Shape3D
as integer nPoints
as PointList Points
as integer nColors ' 0=textured, 1=flat soild, n=gouraud shading
as V3List Colors ' colors or NULL
as any ptr texture ' FreeBASIC image or NULL
as integer nNormals ' 1=flat shaded, >1=gouraud shading
as V3List Normals
end type
type PShape3D as Shape3D ptr
type ShapeList as PShape ptr
type Object3D
as integer nPoints
as Point3D ptr pPoints
as integer nShapes
as Shape3D ptr pShapes
end type
sub CreateRGBPalette()
dim as integer r8,g8,b8
for i as uinteger= 0 to 255
r8=(((i shr 5) and &H07) * 255) / 7
g8=(((i shr 2) and &H07) * 255) / 7
b8=(((i shr 0) and &H03) * 255) / 3
palette i,r8,g8,b8
next
end sub
function ZClipNear(iP() as V3,nP as integer,oP() as Vertex3D) as integer
dim as single s=any,e=any,t=any
dim as integer r,c,l = nP-1
if l<1 then
if iP(c).z>=1 then
oP(r).c=iP(c)
oP(r).sx=320+(iP(c).x*512)/iP(c).z
oP(r).sy=240+(iP(c).y*512)/iP(c).z
r+=1
end if
else
c=l
for n as integer=0 to l
s = iP(c).z : e = iP(n).z
if s>=1 andalso e>=1 then
oP(r).c=iP(c)
oP(r).sx=320+(iP(c).x*512)/iP(c).z
oP(r).sy=240+(iP(c).y*512)/iP(c).z
r+=1
elseif s<1 andalso e<1 then
' do nothing
else ' clip it at near plane z=1
t = (1 - s)/(e - s)
oP(r).c.x = iP(c).x + (iP(n).x - iP(c).x)*t
oP(r).c.y = iP(c).y + (iP(n).y - iP(c).y)*t
oP(r).c.z = 1
oP(r).sx=320+iP(c).x*512
oP(r).sy=240+iP(c).y*512
r+=1
if s<1 then
oP(r).c=iP(n)
oP(r).sx=320+(iP(n).x*512)/iP(n).z
oP(r).sy=240+(iP(n).y*512)/iP(n).z
r+=1
end if
end if
c=n
next
end if
return r
end function
' Returns 2 times the signed triangle area.
' The result is positive if abc is ccw, negative if abc is cw, zero if abc is degenerate.
function SignedTriangle2DArea(a as Vertex3D, b as Vertex3D,c as Vertex3D) as single
return (a.sx - c.sx) * (b.sy - c.sy) - (a.sy - c.sy) * (b.sx - c.sx)
end function
function IsFrontface(v() as Vertex3D) as boolean
dim as single Area2=SignedTriangle2DArea(v(0),v(2),v(1))
return iif(Area2>0,true,false)
end function
function IsBackface(v() as Vertex3D) as boolean
dim as single Area2=SignedTriangle2DArea(v(0),v(2),v(1))
return iif(Area2<0,true,false)
end function
type vector2d
as integer x,y
end type
sub FilledPolygon(TargetPtr as any ptr=0, _ ' 0 = screen otherwise image ptr
p() as Vertex3d , _ ' the screen coords (x,y)
n as integer , _ ' how many coords in array
red as ulong , _ ' color
green as ulong , _
blue as ulong)
static as integer palflag=0
dim as integer TargetWidth=any,TargetHeight=any,TargetBytes=any,TargetPitch=any
dim as integer f=any,t=any,b=any,l=any,r=any
dim as integer lc=any,nlc=any,rc=any,nrc=any
dim as integer d1=any,s1=any,d2=any,s2 =any,cl=any,cr=any
dim as ubyte c8 =any
dim as ushort c16=any
dim as ulong c24=any
dim as any ptr row=any
n-=1
' isn`t a triangle a quad or a polygon
if n<2 then exit sub
if TargetPtr=0 then
TargetPtr=screenptr() ' first pixel top left on screen
if TargetPtr=0 then exit sub
ScreenInfo _
TargetWidth , _
TargetHeight,, _
TargetBytes , _
TargetPitch
else
ImageInfo _
TargetPtr , _
TargetWidth , _
TargetHeight, _
TargetBytes , _
TargetPitch , _
TargetPtr
end if
select case as const TargetBytes
case 1
#define RGB8(_r,_g,_b) ( (_r and &HE0) or ((_g and &HE0) shr 3) or ((_b and &HC0) shr 6) )
c8=rgb8(red,green,blue)
#undef RGB8
case 2
#define RGB16(_r,_g,_b) (((_r shr 3) shl 11) or ((_g shr 2) shl 5) or (_b shr 3))
c16=rgb16(red,green,blue)
#undef RGB16
case 4
c24=rgb(red,green,blue)
end select
' top bottom left right (clipping)
#define mr 1000000
t= mr: b=-mr : l= mr : r=-mr
#undef mr
for nc as integer=0 to n
with p(nc)
if .sy<t then t=.sy:f=nc ' top
if .sy>b then b=.sy ' bottom
if .sx<l then l=.sx ' left
if .sx>r then r=.sx ' right
end with
next
' clip
if l>TargetWidth-1 then exit sub ' left is outside
if r<0 then exit sub ' right is outside
if t>TargetHeight-1 then exit sub ' top is outside
if b<0 then exit sub ' bottom is outside
if (r-l)<1 then exit sub ' 0 pixels width
if b>TargetHeight-1 then b=TargetHeight-1 ' clip bottom
if (b-t)<1 then exit sub ' 0 pixels height
' left and next left counter
lc=f:nlc=lc-1:if nlc<0 then nlc=n
' right and next right counter
rc=f:nrc=rc+1:if nrc>n then nrc=0
'if p(nlc).x>p(nrc).x then exit sub
row=TargetPtr+t*TargetPitch
#define SHIFTS 10 ' fixed point format
' from top to bottom
while t<b
' if top counter = curent left y then get next left y
if t=p(lc).sy then
' ignore horizontal edge
while p(lc).sy=p(nlc).sy
lc=nlc:nlc-=1:if nlc<0 then nlc=n
wend
' x start of the left edge
d1=int(p(lc).sx) shl SHIFTS
' x step of the left edge
s1=(int(p(nlc).sx-p(lc).sx) shl SHIFTS)/(p(nlc).sy-p(lc).sy)
' move from curent left edge counter to the next
lc = nlc
end if
' if top counter = curent right y then get next left y
if t=p(rc).sy then
' ignore horizontal edge
while p(rc).sy=p(nrc).sy
rc=nrc:nrc+=1:if nrc>n then nrc=0
wend
' x start of the right edge
d2=int(p(rc).sx) shl SHIFTS
' x step of the right edge
s2=(int(p(nrc).sx-p(rc).sx) shl SHIFTS)/(p(nrc).sy-p(rc).sy)
' move from curent right edge counter to the next
rc=nrc
end if
' if curent top in scrren
if t>-1 then
l=d1 shr SHIFTS ' most left pixel
r=d2 shr SHIFTS ' most right pixel
if l>r then return ' !!!
' on screen
if l<TargetWidth andalso r>-1 then
if l<0 then l=0
if r>TargetWidth-1 then r=TargetWidth-1
select case as const TargetBytes
case 1
var s=cptr(ubyte ptr,row)+l
var e=cptr(ubyte ptr,row)+r
while s<e : *s=c8 : s+=1:wend : *e=c8
case 2
var s=cptr(ushort ptr,row)+l
var e=cptr(ushort ptr,row)+r
while s<e : *s=c16 : s+=1:wend : *e=c16
case 4
var s=cptr(ulong ptr,row)+l
var e=cptr(ulong ptr,row)+r
while s<e : *s=c24 : s+=1:wend : *e=c24
end select
end if
end if
t+=1
d1+=s1
d2+=s2
row+=TargetPitch
wend
#undef SHIFTS
end sub
sub Scale(vo() as V3,vi() as V3,nv as integer,sx as single=1,sy as single=1,sz as single=1)
for i as integer=0 to nv-1
vo(i).x=vi(i).x*sx
vo(i).y=vi(i).y*sy
vo(i).z=vi(i).z*sz
next
end sub
sub Rotate(vo() as V3, vi() as V3, nv as integer, rx as single,ry as single,rz as single)
dim as single cx=cos(rx),cy=cos(ry),cz=cos(rz)
dim as single sx=sin(rx),sy=sin(ry),sz=sin(rz)
dim as single x,y,z
for i as integer=0 to nv-1
y = vi(i).y*cx - vi(i).z*sx
z = vi(i).y*sx + vi(i).z*cx
x = vi(i).x*cy + z*sy
vo(i).z =-vi(i).x*sy + z*cy
vo(i).x = x*cz + y*sz
vo(i).y =-x*sz + y*cz
next
end sub
sub Move(vo() as V3,vi() as V3,nv as integer,mx as single=0,my as single=0,mz as single=0)
for i as integer=0 to nv-1
vo(i).x=vi(i).x+mx
vo(i).y=vi(i).y+my
vo(i).z=vi(i).z+mz
next
end sub
dim as V3 BoxPoints(7) => { _
(-.5, .5,-.5), _
(-.5,-.5,-.5), _
( .5,-.5,-.5), _
( .5, .5,-.5), _
( .5, .5, .5), _
( .5,-.5, .5), _
(-.5,-.5, .5), _
(-.5, .5, .5) }
dim as V3 BoxNormals(5) => { _
( 0, 0, 1), _
( 1, 0, 0), _
( 0, 0, 1), _
(-1, 0, 0), _
( 0, 1, 0), _
( 0,-1, 0) }
dim as integer BoxFaces(5,3) => { _
{ 0, 1, 2, 3}, _
{ 3, 2, 5, 4}, _
{ 4, 5, 6, 7}, _
{ 7, 6, 1, 0}, _
{ 7, 0, 3, 4}, _
{ 1, 6, 5, 2} }
dim as V3 obj(7)
dim as V3 world(4)
dim as Vertex3d clipped(5)
dim as V3 camera
dim as V3 a,b
dim as Vertex3d v(5)
dim as integer n
dim as single xr,yr,zr
screenres 640,480,16,2
screenset 1,0
dim as integer bytes_per_pixel
screeninfo ,,,bytes_per_pixel
if bytes_per_pixel=1 then CreateRGBPalette()
camera.x= 0
camera.y= 0
camera.z= 50
a.x=-150 : a.y= 1
b.x= 150 : b.y= 1
scale (BoxPoints(),BoxPoints(),8,10,20,30)
while inkey()=""
cls
rotate(obj(),BoxPoints(),8,xr,yr,zr)
move(obj(),obj(),8,camera.x,camera.y,camera.z)
for fc as integer = 0 to 5
for fi as integer = 0 to 3
world(fi)=obj(BoxFaces(fc,fi))
next
n=ZClipNear(world(),4,clipped())
if n>0 then
if IsFrontface(clipped())=false then FilledPolygon(,clipped(),n,50+fc*10,50+fc*10,50+fc*10)
'FilledPolygon(,clipped(),n,50+fc*10,50+fc*10,50+fc*10)
end if
next
flip
sleep 1000/60
xr+=0.01
yr+=0.02
zr+=0.03
wend
Code: Select all
Type screendata
As Integer w,h,depth,pitch
As Any Pointer row
End Type
Type V3
As Single x,y,z
As Ulong col
As Single grad
As Long xi
End Type
Sub fillpolygon(a() As V3, c As Ulong,miny As Long,maxy As Long,s As screendata)
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'Mostly translated by forum member Pitto
#define ppset32(_x,_y,colour) *Cptr(Ulong Ptr,s.row+ (_y)*s.pitch+ (_x) Shl 2) =(colour)
#define onscreen ((x1)>=0) Andalso ((x1)<(s.w-1)) Andalso ((y1)>=0) Andalso ((y1)<(s.h-1))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Dim As Ubyte Ptr clr=Cptr(Ubyte Ptr,@c)
Dim As Long r=clr[2], g=clr[1], b=clr[0]
Static As Single f
Dim As Long LB=Lbound(a),UB=Ubound(a)
For i As Long=lb To Ub - 1
Var dy=a(i+1).y-a(i).y
Var dx=a(i+1).x-a(i).x
If dy=0 Then a(i).grad=1
If dx=0 Then a(i).grad=0
If dy <> 0 Andalso dx <> 0 Then
a(i).grad = dx / dy
End If
Next i
For y As Long=miny To maxy
Var k = lb
For i As Long=lb To Ub - 1
If ( a(i).y<=y Andalso a(i+1).y>y) Orelse (a(i).y>y Andalso a(i+1).y<=y) Then
a(k).xi= (a(i).x+a(i).grad*(y-a(i).y))
k +=1
End If
Next i
For j As Long = lb To k-2 -1
For i As Long = lb +1 To k-2
If a(i).xi > a(i+1).xi Then
Swap a(i).xi,a(i+1).xi
End If
Next i
Next j
Dim As Long e
For i As Long = lb To k - 2 Step 2
'bressenham line inlined
Dim As Long x1= a(i).xi ,y1= y,x2=a(i+1).xi+1,y2= y
Var dx=Abs(x2-x1),dy=0,sx=Sgn(x2-x1),sy=0
If dx<dy Then e=dx\2 Else e=dy\2
Do
If onscreen Then
f=map(0,s.w,x1,1,0)
ppset32((x1),(y1),Rgb(f*r,f*g,f*b))
End If
If x1 = x2 Then If y1 = y2 Then Exit Do
If dx > dy Then
x1 += sx : e -= dy : If e < 0 Then e += dx : y1 += sy
Else
y1 += sy : e -= dx : If e < 0 Then e += dy : x1 += sx
End If
Loop
Next i
Next y
End Sub
Sub drawpolygon(p() As V3,i As long,s As screendata)
Static As Single miny=1e6,maxy=-1e6
Static As v3 V(1 To Ubound(p,2)+1)
For n As long=1 To Ubound(p,2)
If miny>p(i,n).y Then miny=p(i,n).y
If maxy<p(i,n).y Then maxy=p(i,n).y
V(n)=p(i,n)
Next
v(Ubound(v))=v(Lbound(v))
fillpolygon(v(),p(i,1).col,miny,maxy,s)
End Sub
Function Rotate(c As V3,p As V3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
(scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
(scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z,p.col)
End Function
Function perspective(p As V3,eyepoint As V3) As V3
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
(p.y-eyepoint.y)/w+eyepoint.y,_
(p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function
Function Regulate(Byval MyFps As long,Byref fps As long) As long
Static As Double timervalue,lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Sub sort(array() As V3,painter() As long)
For p1 As long = 1 To Ubound(array,1) - 1
For p2 As long = p1 + 1 To Ubound(array,1)
If array(p1,0).z<array(p2,0).z Then Swap painter(p1),painter(p2):Swap array(p1,0),array(p2,0)
Next p2
Next p1
End Sub
Sub Expand(p() As V3,b As Single,shift As V3,i As long)
For n As long=Lbound(p,2) To Ubound(p,2)
p(i,n).x=b*p(i,n).x+shift.x
p(i,n).y=b*p(i,n).y+shift.y
p(i,n).z=b*p(i,n).z+shift.z
Next n
End Sub
'=========================================================
'set the cube faces on (0,0,0) as centre
Dim As V3 g1(1 To ...,1 To ...)={{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
{(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
{(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
{(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
{(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
{(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base
'set colours,save in 1st. index
Randomize 2
#define clr rgb(rnd*255,rnd*255,rnd*200)
g1(1,1).col=clr:g1(2,1).col=clr:g1(3,1).col=clr:g1(4,1).col=clr:g1(5,1).col=clr:g1(6,1).col=clr
Dim As V3 tmp1(1 To Ubound(g1,1),0 To Ubound(g1,2))'the working array
Screen 20,32
Dim As screendata S
With S
Screeninfo .w,.h,.depth,,.pitch
.row=Screenptr
End With
'blow up and translate the cube to screen centre
For i As long=Lbound(g1,1) To Ubound(g1,1)
Expand (g1(),180,Type<v3>(s.w\2,s.h\2,0),i)
Next i
Dim As V3 eye= Type<V3>(s.w\2,s.h\2,800)
Dim As String i
Dim As V3 angle
Dim As V3 fulcrum=Type<V3>(s.w\2,s.h\2,0) ' middle of cube
Dim As long mx,my,button,fps,flag
Dim As long painter(1 To 6)
For n As long=1 To 6:painter(n)=n:Next n
Dim As long cx,cy,cz 'centriods
Do
Getmouse mx,my,,button
i=Inkey
angle.x+=.01/2
angle.y+=.02/2
angle.z+=.03/2
For m As long=Lbound(g1,1) To Ubound(g1,1)
cx=0:cy=0:cz=0
For n As long=1 To Ubound(g1,2)
tmp1(m,n)=Rotate(fulcrum,g1(m,n),angle)
tmp1(m,n)=perspective(tmp1(m,n),eye) 'apply the eye (perspective)
If button Then'follow the mouse
tmp1(m,n).x+=mx-s.w\2
tmp1(m,n).y+=my-s.h\2
End If
'accumulate cx,cy,cz
cx+=tmp1(m,n).x:cy+=tmp1(m,n).y:cz+=tmp1(m,n).z
Next n
cx=cx/4:cy=cy/4:cz=cz/4
'get face centroid into zero'th index
tmp1(m,0)=Type<v3>(cx,cy,cz)
Next m
'sort the faces by centriods
sort(tmp1(),painter())
Screenlock
Cls
Draw String(10,30),"Frame Rate = " & fps
Locate 6,0
Print "Painting order"
For n As long=1 To 6:Print "face "; painter(n):Next n
For z As long=Lbound(tmp1,1)+3 To Ubound(tmp1,1)'Paint only the closest three faces
Var p=painter(z)
Select Case p
Case 1: drawpolygon(tmp1(),p,s):Locate 7,12:Print "texture"
Case 2: drawpolygon(tmp1(),p,s):Locate 8,12:Print "texture"
Case 3: drawpolygon(tmp1(),p,s):Locate 9,12:Print "texture"
Case 4: drawpolygon(tmp1(),p,s):Locate 10,12:Print "texture"
Case 5: drawpolygon(tmp1(),p,s):Locate 11,12:Print "texture"
Case 6: drawpolygon(tmp1(),p,s):Locate 12,12:Print "texture"
End Select
Next z
Screenunlock
'reset painter
For n As long=1 To 6:painter(n)=n:Next n
Sleep regulate(80,fps),1
Loop Until i=Chr(27)
Sleep
dodicat wrote:Same perspective as my previous example.
Draw the cube pixel by pixel and texture (shade) the surface.
Direct pixel clipping.
Move by mouse.
This is a 32 bit snippet.
64 bit is too slow.Code: Select all
Type screendata
As Integer w,h,depth,pitch
As Any Pointer row
End Type
Type V3
As Single x,y,z
As Ulong col
As Single grad
As Long xi
End Type
Sub fillpolygon(a() As V3, c As Ulong,miny As Long,maxy As Long,s As screendata)
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
'Mostly translated by forum member Pitto
#define ppset32(_x,_y,colour) *Cptr(Ulong Ptr,s.row+ (_y)*s.pitch+ (_x) Shl 2) =(colour)
#define onscreen ((x1)>=0) Andalso ((x1)<(s.w-1)) Andalso ((y1)>=0) Andalso ((y1)<(s.h-1))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Dim As Ubyte Ptr clr=Cptr(Ubyte Ptr,@c)
Dim As Long r=clr[2], g=clr[1], b=clr[0]
Static As Single f
Dim As Long LB=Lbound(a),UB=Ubound(a)
For i As Long=lb To Ub - 1
Var dy=a(i+1).y-a(i).y
Var dx=a(i+1).x-a(i).x
If dy=0 Then a(i).grad=1
If dx=0 Then a(i).grad=0
If dy <> 0 Andalso dx <> 0 Then
a(i).grad = dx / dy
End If
Next i
For y As Long=miny To maxy
Var k = lb
For i As Long=lb To Ub - 1
If ( a(i).y<=y Andalso a(i+1).y>y) Orelse (a(i).y>y Andalso a(i+1).y<=y) Then
a(k).xi= (a(i).x+a(i).grad*(y-a(i).y))
k +=1
End If
Next i
For j As Long = lb To k-2 -1
For i As Long = lb +1 To k-2
If a(i).xi > a(i+1).xi Then
Swap a(i).xi,a(i+1).xi
End If
Next i
Next j
Dim As Long e
For i As Long = lb To k - 2 Step 2
'bressenham line inlined
Dim As Long x1= a(i).xi ,y1= y,x2=a(i+1).xi+1,y2= y
Var dx=Abs(x2-x1),dy=0,sx=Sgn(x2-x1),sy=0
If dx<dy Then e=dx\2 Else e=dy\2
Do
If onscreen Then
f=map(0,s.w,x1,1,0)
ppset32((x1),(y1),Rgb(f*r,f*g,f*b))
End If
If x1 = x2 Then If y1 = y2 Then Exit Do
If dx > dy Then
x1 += sx : e -= dy : If e < 0 Then e += dx : y1 += sy
Else
y1 += sy : e -= dx : If e < 0 Then e += dy : x1 += sx
End If
Loop
Next i
Next y
End Sub
Sub drawpolygon(p() As V3,i As long,s As screendata)
Static As Single miny=1e6,maxy=-1e6
Static As v3 V(1 To Ubound(p,2)+1)
For n As long=1 To Ubound(p,2)
If miny>p(i,n).y Then miny=p(i,n).y
If maxy<p(i,n).y Then maxy=p(i,n).y
V(n)=p(i,n)
Next
v(Ubound(v))=v(Lbound(v))
fillpolygon(v(),p(i,1).col,miny,maxy,s)
End Sub
Function Rotate(c As V3,p As V3,angle As V3,scale As V3=Type<V3>(1,1,1)) As V3
Dim As Single sx=Sin(angle.x),sy=Sin(angle.y),sz=Sin(angle.z)
Dim As Single cx=Cos(angle.x),cy=Cos(angle.y),cz=Cos(angle.z)
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<V3>((scale.x)*((cy*cz)*dx+(-cx*sz+sx*sy*cz)*dy+(sx*sz+cx*sy*cz)*dz)+c.x,_
(scale.y)*((cy*sz)*dx+(cx*cz+sx*sy*sz)*dy+(-sx*cz+cx*sy*sz)*dz)+c.y,_
(scale.z)*((-sy)*dx+(sx*cy)*dy+(cx*cy)*dz)+c.z,p.col)
End Function
Function perspective(p As V3,eyepoint As V3) As V3
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
(p.y-eyepoint.y)/w+eyepoint.y,_
(p.z-eyepoint.z)/w+eyepoint.z,p.col)
End Function
Function Regulate(Byval MyFps As long,Byref fps As long) As long
Static As Double timervalue,lastsleeptime,t3,frames
Var t=Timer
frames+=1
If (t-t3)>=1 Then t3=t:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-T+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=T
Return sleeptime
End Function
Sub sort(array() As V3,painter() As long)
For p1 As long = 1 To Ubound(array,1) - 1
For p2 As long = p1 + 1 To Ubound(array,1)
If array(p1,0).z<array(p2,0).z Then Swap painter(p1),painter(p2):Swap array(p1,0),array(p2,0)
Next p2
Next p1
End Sub
Sub Expand(p() As V3,b As Single,shift As V3,i As long)
For n As long=Lbound(p,2) To Ubound(p,2)
p(i,n).x=b*p(i,n).x+shift.x
p(i,n).y=b*p(i,n).y+shift.y
p(i,n).z=b*p(i,n).z+shift.z
Next n
End Sub
'=========================================================
'set the cube faces on (0,0,0) as centre
Dim As V3 g1(1 To ...,1 To ...)={{(-1,-1,-1),(1,-1,-1),(1,1,-1),(-1,1,-1)},_'front
{(1,-1,-1),(1,-1,1),(1,1,1),(1,1,-1)},_ 'right
{(-1,-1,1),(1,-1,1),(1,1,1),(-1,1,1)},_'back
{(-1,-1,-1),(-1,-1,1),(-1,1,1),(-1,1,-1)},_'left
{(1,1,-1),(1,1,1),(-1,1,1),(-1,1,-1)},_'top
{(1,-1,-1),(1,-1,1),(-1,-1,1),(-1,-1,-1)}}'base
'set colours,save in 1st. index
Randomize 2
#define clr rgb(rnd*255,rnd*255,rnd*200)
g1(1,1).col=clr:g1(2,1).col=clr:g1(3,1).col=clr:g1(4,1).col=clr:g1(5,1).col=clr:g1(6,1).col=clr
Dim As V3 tmp1(1 To Ubound(g1,1),0 To Ubound(g1,2))'the working array
Screen 20,32
Dim As screendata S
With S
Screeninfo .w,.h,.depth,,.pitch
.row=Screenptr
End With
'blow up and translate the cube to screen centre
For i As long=Lbound(g1,1) To Ubound(g1,1)
Expand (g1(),180,Type<v3>(s.w\2,s.h\2,0),i)
Next i
Dim As V3 eye= Type<V3>(s.w\2,s.h\2,800)
Dim As String i
Dim As V3 angle
Dim As V3 fulcrum=Type<V3>(s.w\2,s.h\2,0) ' middle of cube
Dim As long mx,my,button,fps,flag
Dim As long painter(1 To 6)
For n As long=1 To 6:painter(n)=n:Next n
Dim As long cx,cy,cz 'centriods
Do
Getmouse mx,my,,button
i=Inkey
angle.x+=.01/2
angle.y+=.02/2
angle.z+=.03/2
For m As long=Lbound(g1,1) To Ubound(g1,1)
cx=0:cy=0:cz=0
For n As long=1 To Ubound(g1,2)
tmp1(m,n)=Rotate(fulcrum,g1(m,n),angle)
tmp1(m,n)=perspective(tmp1(m,n),eye) 'apply the eye (perspective)
If button Then'follow the mouse
tmp1(m,n).x+=mx-s.w\2
tmp1(m,n).y+=my-s.h\2
End If
'accumulate cx,cy,cz
cx+=tmp1(m,n).x:cy+=tmp1(m,n).y:cz+=tmp1(m,n).z
Next n
cx=cx/4:cy=cy/4:cz=cz/4
'get face centroid into zero'th index
tmp1(m,0)=Type<v3>(cx,cy,cz)
Next m
'sort the faces by centriods
sort(tmp1(),painter())
Screenlock
Cls
Draw String(10,30),"Frame Rate = " & fps
Locate 6,0
Print "Painting order"
For n As long=1 To 6:Print "face "; painter(n):Next n
For z As long=Lbound(tmp1,1)+3 To Ubound(tmp1,1)'Paint only the closest three faces
Var p=painter(z)
Select Case p
Case 1: drawpolygon(tmp1(),p,s):Locate 7,12:Print "texture"
Case 2: drawpolygon(tmp1(),p,s):Locate 8,12:Print "texture"
Case 3: drawpolygon(tmp1(),p,s):Locate 9,12:Print "texture"
Case 4: drawpolygon(tmp1(),p,s):Locate 10,12:Print "texture"
Case 5: drawpolygon(tmp1(),p,s):Locate 11,12:Print "texture"
Case 6: drawpolygon(tmp1(),p,s):Locate 12,12:Print "texture"
End Select
Next z
Screenunlock
'reset painter
For n As long=1 To 6:painter(n)=n:Next n
Sleep regulate(80,fps),1
Loop Until i=Chr(27)
Sleep
Users browsing this forum: No registered users and 1 guest