to update this code ; in particular I've included a polygon filling routine . This routine
was translated from C by another FreeBASIC user .
From what I'm able to determine thus far , the polygon filler is quite accurate , fast
and efficient.
Quite a few years ago I wrote similar code for openGL , this however required quite
a few external libraries ; whereas this doesn't and may even run in DOS.
Obviously there's a fair bit more to do , for now though this might suffice .
In the routine Persp , the variable d and the number 2 might be adjusted to tweek the
appearance of the graph .
Code: Select all
'
' -----------------------------------------------------------------------------
'
' My graf 3d
'
' MyGraf3_3d.bas
'
'
' (c) copyright 2019 , sciwiseg@gmail.com ,
'
' Edward.Q.Montague. [ alias]
'
'
'
'
'
' -----------------------------------------------------------------------------
'
type point
x as single
y as single
z as single
u as single ' possible extension for special coord system
end type
'
const Pi=4*atn(1)
' replaces the defines above (single line Macro's in FB)
Const As Long POINTS = 4 , POLYGONS = 20, SCR_W = 740, SCR_H = 680
'
dim as single x1,y1,z1,x2,y2,z2
dim as integer i,j,k
'
' ----------------------------------------------------------------------------
'
'
' Looking at a cube .
'
' cc -1,1 _______<_______ 1,1 start z = -1
' | | back face.
' | |
' v ^
' | |
' |_______________|
' -1,-1 > 1,-1
'
'
' -----------------------------------------------------------------------------
'
declare function rotx(q as point,angx as single) as point
declare function roty(q as point,angy as single) as point
declare function rotz(q as point,angz as single) as point
declare function tranx(q as point,movx as single) as point
declare function trany(q as point,movy as single) as point
declare function tranz(q as point,movz as single) as point
declare function persp(q as point,d as single) as point
'
declare function Trall( p1() as point,n as integer,edge() as integer, div as integer ,np as integer,ne as integer) as integer
declare sub gendata1(a() as long,n as integer,m as integer)
declare sub gendata2(a() as long,n as integer,m as integer)
declare sub genmatrix(gm() as single,n as integer,m as integer)
declare sub gmdata(gm() as single,n as integer,m as integer)
declare function f1(x as single , y as single)as single
declare sub trallg(gm() as single,dm() as single , n as integer,m as integer)
declare sub trand(dm() as single,a() as long,n as integer,m as integer)
declare Sub fill_polygon(a() As Long, ByVal c As ULong)
declare sub outline_polygon(a() As Long, ByVal c As ULong)
declare sub tqxyz(x as single , y as single ,n as integer , m as integer , byref q as point)
declare sub w2scrn(p as point,n as integer , m as integer,byref u as long,byref v as long)
'
' ============================================================================
'
dim as integer np , ne,n,m
'
restore storeA
read np
'
dim as point p1(1 to np)
'
restore store1
for i =1 to np
read p1(i).x
read p1(i).y
read p1(i).z
next i
'
'
restore storeB
read ne
'
dim as integer edge(1 to ne,0 to 1)
'
restore store2
for i = 1 to ne
read edge(i,0)
read edge(i,1)
next i
'
' -----------------------------------------------------------------------------
'
'screen 12
'window (-1.5,-1.5)-(1.5,1.5)
'line (-1.4,-1.4)-(1.4,1.4),11,b
'
'cls
'k=Trall( p1() ,3,edge() , 32 ,np ,ne )
'sleep
'INITIALIZING GRAPHICS _________________________________________________
ScreenRes(SCR_W, SCR_H, 24) 'initialize graphics
'window(10,10)-(210,110)
Cls
n=520
m=520
'
dim a(0 to POINTS,0 to 1) as long
dim gm(0 to n , 0 to m,0 to 1) as single
dim dm(0 to n , 0 to m,0 to 1) as single
'screen 12
'window(0,0)-(SCR_W,SCR_H)
gendata2(a() ,n ,m )
sleep
end
genmatrix(gm() ,n ,m )
gmdata(gm() ,n ,m )
trallg(gm(),dm() , n ,m )
trand(dm() ,a() ,n ,m )
sleep
end
'
' ===================================
'
' number of vertices
'
storeA:
data 8
'
' vertex data , easier to keep track of
' data when we use multiple data statements.
'
store1:
data 1,1,1
data -1,1,1
data -1,-1,1
data 1,-1,1
data 1,1,-1
data -1,1,-1
data -1,-1,-1
data 1,-1,-1
'
' Number of edges.
'
storeB:
data 12
'
' edge data
'
store2:
data 1,2
data 1,4
data 1,5
data 2,3
data 2,6
data 3,4
data 3,7
data 4,8
data 5,6
data 5,8
data 6,7
data 7,8
'
' -------------------------------------------------------------------------------
'
function rotx(q as point,angx as single) as point
'
' Rotate around x axis .
'
static as point p
'
p.x = q.x
p.y= q.y*cos(angx)-sin(angx)*q.z
p.z= q.z*cos(angx)+sin(angx)*q.y
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function roty(q as point,angy as single) as point
'
' Rotate around y axis .
'
static as point p
'
p.x = sin(angy)*q.z + cos(angy)*q.x
p.y = q.y
p.z = cos(angy)*q.z -sin(angy)*q.x
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function rotz(q as point,angz as single) as point
'
' Rotate around z axis .
'
static as point p
'
p.x = sin(angz)*q.y + cos(angz)*q.x
p.y = cos(angz)*q.y-sin(angz)*q.x
p.z = q.z
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranx(q as point,movx as single) as point
'
' Translate point along x axis
'
static as point p
'
p.x=q.x + movx
p.y=q.y
p.z=q.z
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function trany(q as point,movy as single) as point
'
' Translate point along y axis .
'
static as point p
'
p.x=q.x
p.y=q.y + movy
p.z=q.z
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function tranz(q as point,movz as single) as point
'
' Translate point along z axis .
'
static as point p
'
p.x=q.x
p.y=q.y
p.z=q.z + movz
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function persp(q as point,d as single) as point
'
' 3d perspective .
'
' Add 2.5 to the numerator when using any negative z value.
'
' In this instance -1 <= z <= 1 , unit cube .
'
' Therefore 2.5 is appropriate .
'
static as point p
'
p.x = d*q.x/(q.z+2)
p.y = d*q.y/(q.z+2)
p.z = d
'
return p
'
end function
'
' -----------------------------------------------------------------------------
'
function Trall( p1() as point,n as integer,edge() as integer, div as integer ,np as integer,ne as integer) as integer
'
' Translate and rotate all vertices .
' as an animation , for n cycles .
'
' np number of points .
' ne number of integers .
'
'
' With div number of angle divisions .
'
static as point p2(1 to np)
static as single theta,thi,x1,y1,z1,x2,y2,z2
static as integer i,j,k
static as integer i1,j1,k1
'
theta = Pi/div
'
for i=1 to n
for j = 0 to div
'cls
thi = j*theta
for k = 1 to np
p2(k) = roty(p1(k),thi)
p2(k)=persp(p2(k),0.8)
next k
'
cls
'
for i1 = 1 to ne
j1 = edge(i1,0)
k1 = edge(i1,1)
x1 = p2(j1).x
y1 = p2(j1).y
' z1 = p2(j1).z
x2 = p2(k1).x
y2 = p2(k1).y
' z2 = p2(k1).z
line(x1,y1)-(x2,y2),14
next i1
'
sleep 100
next j
next i
'
return 0
'
end function
'
' --------------------------------------------------------------------------------
'
'
' ----------------------------------------------------------------
'
sub gendata1(a() as long,n as integer,m as integer)
'
' Generate 3d data grid .
'
' For perspective the range for x and y and z , is [-1,1]
'
'
' Then a translation back to screen coordinates is required . [-1,1] => [10,n] & [-1,1] => [10,m] ?
' x = (x + 1)*0.5*(n - 10) + 10
' y = (y + 1)*0.5*(m - 10) + 10
'
'
' w = f(x,y)
' q.x = x
' q.y = w
' q.z = z
'
' p = persp(q,d)
'
' ( x', y',z , w') = persp( x , y , z , w )
'
'
static as integer i1,j1,k1,l1,qg,pg
static as single x,y,z,d
static as ulong colour,u,v
static as point p , q
d=0.8
'qg=10
'pg=10
pg=n/20
qg=m/10
colour=rgb(120,200,200)
for j1=10 to m step qg
'z = 1 - 2*(j1-10)/(m-10) ' 1 -> -1
for i1=10 to n step pg
k1=0
x=i1
y=j1
tqxyz(x , y ,n , m , q )
' f1(q.x,q.y) here ?
p = persp(q ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x=i1+pg
y=j1
tqxyz(x , y ,n , m , q )
' f1(q.x,q.y) here ?
p = persp(q ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x=i1+pg
y=j1+qg
tqxyz(x , y ,n , m , q )
' f1(q.x,q.y) here ?
p = persp(q ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x = i1
y = j1+qg
tqxyz(x , y ,n , m , q )
' f1(q.x,q.y) here ?
p = persp(q ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
fill_polygon(a(), CULng(rnd*&hFFFFFF))
outline_polygon(a() , colour)
next i1
'
next j1
'
end sub
'
' ----------------------------------------------------------------
'
sub gendata2(a() as long,n as integer,m as integer)
'
' Generate 3d data grid .
'
' For perspective the range for x and y and z , is [-1,1]
'
'
' Then a translation back to screen coordinates is required . [-1,1] => [10,n] & [-1,1] => [10,m] ?
' x = (x + 1)*0.5*(n - 10) + 10
' y = (y + 1)*0.5*(m - 10) + 10
'
'
' w = f(x,y)
' q.x = x
' q.y = w
' q.z = z
'
' p = persp(q,d)
'
' ( x', y',z , w') = persp( x , y , z , w )
'
'
static as integer i1,j1,k1,l1,qg,pg
static as single x,y,z,d , theta
static as ulong colour,u,v,chrome
static as point p , q , s
theta = Pi/4
d=0.98
d=1.2
'qg=10
'pg=10
pg=n/50
qg=m/50
colour=rgb(120,200,200)
for j1=10 to m step qg
'z = 1 - 2*(j1-10)/(m-10) ' 1 -> -1
for i1=10 to n step pg
k1=0
x=i1
y=j1
tqxyz(x , y ,n , m , q )
q.y= f1(q.x,q.y)
chrome = (q.y + 1)*32
s=rotx(q ,theta )
p = persp(s ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x=i1+pg
y=j1
tqxyz(x , y ,n , m , q )
q.y = f1(q.x,q.y)
s=rotx(q ,theta )
p = persp(s ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x=i1+pg
y=j1+qg
tqxyz(x , y ,n , m , q )
q.y = f1(q.x,q.y)
s=rotx(q ,theta )
p = persp(s ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
x = i1
y = j1+qg
tqxyz(x , y ,n , m , q )
q.y = f1(q.x,q.y)
s=rotx(q ,theta )
p = persp(s ,d )
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
' fill_polygon(a(), CULng(rnd*&hFFFFFF))
fill_polygon(a(), rgb(0,0,0))
outline_polygon(a() , colour)
next i1
'
next j1
'
end sub
'
' ----------------------------------------------------------------
'
sub genmatrix(gm() as single,n as integer,m as integer)
'
' Generate a matrix with limits [x,-1,1][y,-1,1]
'
'
static as integer i,j
static as single x,y,z
'
for j=0 to m
y=1-2*i/m
z=y
for i=0 to n
x=-1+2*i/n
gm(i,j,0)=x
gm(i,j,1)=z
next i
next j
'
'
end sub
'
' -------------------------------------------------------------------
'
sub gmdata(gm() as single,n as integer,m as integer)
'
' Generate data from function f1(x,y) .
'
'
static as integer i,j
static as single x,y,z
'
for j=0 to m
for i=0 to n
x=gm(i,j,0)
y=gm(i,j,1)
z=f1(x,y)
gm(i,j,0) = z
next i
next j
'
end sub
'
' ---------------------------------------------------------------------
'
sub trallg(gm() as single,dm() as single , n as integer,m as integer)
'
' translate , rotate , apply perspective to all of gm()
'
'
static as integer i,j
static as single x,y,z,d
static as point p,q
'
d=0.8
'
for j=0 to m
q.z=1-2*j/m
for i=0 to n
q.x=-1 +2*i/n
q.y=gm(i,j,0)
p = persp(q ,d )
dm(i,j,0) = p.x
dm(i,j,1) = p.y
next i
next j
'
'
end sub
'
' -------------------------------------------------------------------
'
sub trand(dm() as single,a() as long,n as integer,m as integer)
'
' translate dm() to a() , also translate to screen coordinates for fill_polygon() routine .
'
'
static as integer i1,j1,k1,l1,qg,pg
static as long u , v
static as single x,y,z
static as point p , q
static as ulong colour
qg=10
pg=10
colour=rgb(20,120,20)
for j1=10 to m step qg
for i1=10 to n step pg
k1=0
p.x=dm(i1,j1,0)
p.y=dm(i1,j1,1)
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
p.x=dm(i1+pg,j1,0)
p.y=dm(i1,j1,1)
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
p.x=dm(i1+pg,j1,0)
p.y=dm(i1,j1+qg,1)
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
k1=k1+1
p.x=dm(i1,j1,0)
p.y=dm(i1,j1+qg,1)
w2scrn(p ,n , m ,u ,v )
a(k1, 0) = u
a(k1, 1) = v
fill_polygon(a(), CULng(rnd*&hFFFFFF))
'outline_polygon(a() , colour)
next i1
'
next j1
'
'
end sub
'
' -------------------------------------------------------------------
'
function f1(x as single , y as single)as single
'
' function to generate values upon [x,-1,1][y,-1,1]
'
' [ ,-1,1]
'
static as single r , z
r=x*x+y*y
if ( r > 0 ) then
r = 5*sqr(r)
z=-sin(r*Pi)/(r*Pi)
else
z=-1
end if
return z
'
end function
'
' -----------------------------------------------------------------------------------------------------
'
Sub fill_polygon(a() As Long, ByVal c As ULong)
'translation of a c snippet by Angad
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
Dim As Long i, j, k, dy, dx, x, y, temp
Dim As Long xi(0 to Ubound(a, 1))
Dim As Single slope(0 to Ubound(a, 1))
'join first and last vertex
a(Ubound(a, 1), 0) = a(0, 0)
a(Ubound(a, 1), 1) = a(0, 1)
For i = 0 To Ubound(a, 1) - 1
dy = a(i+1, 1) - a(i, 1)
dx = a(i+1, 0) - a(i, 0)
If (dy = 0) Then slope(i) = 1.0
If (dx = 0) Then slope(i) = 0.0
If (dy <> 0) AndAlso (dx <> 0) Then slope(i) = dx / dy
Next i
For y = 0 to SCR_H - 1
k = 0
' using FB's short-cut operators (which C doesn't have!)
For i = 0 to Ubound(a, 1) - 1
If (a(i, 1) <= y AndAlso a(i+1, 1) > y) OrElse _
(a(i, 1) > y AndAlso a(i+1, 1) <= y) Then
xi(k) = CLng(a(i, 0) + slope(i) * (y - a(i, 1)))
k += 1
End If
Next i
For j = 0 to k - 2
'Arrange x-intersections in order
For i = 0 To k - 2
If (xi(i) > xi(i + 1)) Then
temp = xi(i)
xi(i) = xi(i + 1)
xi(i + 1) = temp
End If
Next i
Next j
'line filling
For i = 0 To k - 2 Step 2
Line (xi(i), y)-(xi(i + 1) + 1, y), c
Next i
Next y
End Sub
'
' -----------------------------------------------------------------------------
'
sub outline_polygon(a() As Long, ByVal c As ULong)
'
' Draw an outtline for the polygon , in color c .
'
'translation of a c snippet by Angad
'source of c code: http://code-heaven.blogspot.it/2009/10/simple-c-program-for-scan-line-polygon.html
Dim As Long i, j, x, y, u , v , temp
'join first and last vertex
a(Ubound(a, 1), 0) = a(0, 0)
a(Ubound(a, 1), 1) = a(0, 1)
For i = 0 To Ubound(a, 1) - 1
x=a(i,0)
y=a(i,1)
u=a(i+1,0)
v=a(i+1,1)
line(x,y)-(u,v),c
Next i
end sub
'
' ----------------------------------------------------------------------
'
sub w2scrn( p as point,n as integer , m as integer, byref u as long, byref v as long)
'
' input x,y,n,m
' output u , v
'
p.x = (p.x + 1)*0.5*(n - 10) + 10 ' [-1,1] -> [10,n]
p.y = (p.y + 1)*0.5*(m - 10) + 10 ' [-1,1] -> [10,m]
u = clng(p.x)
v = clng(p.y)
'
end sub
'
' -------------------------------------------------------------
'
sub tqxyz(x as single , y as single ,n as integer , m as integer , byref q as point)
'
' translate to x ~ i1 , y ~ j1 to q.x , q.y , q.z
'
q.z = 1 - 2*(y-10)/(m-10)
q.x = -1 + 2*(x-10)/(n-10)
q.y = -1 + 2*(y-10)/(m-10)
'
end sub