blua tigro
Gebruiker
- Lid geworden
- 21 apr 2009
- Berichten
- 48
NIET GETEST !!!
is dit goed ?
wat moet erbij ?
is dit goed ?
wat moet erbij ?
Code:
'' bluatigro 30 aug 2017
'' frm_ray
'' needs m4x4 , dbl3d , basis3d and ray_world
public class frm_ray
public red as new dbl3d(1,0,0)
public green as new dbl3d(0,1,0)
private sub set_pixel(x as int16,y as int16,kl as color)
''i dont have the book jet
end sub
private sub frm_ray_load()
'' at begin of scene :
spheretel = 0
'' set drawing matix
link(1 , 0,0,0 , 0,0,0 , xyz , 0)
'' floting sphere
add_sphere(0,0,0,100,red)
'' ground
add_sphere(0,-me.height/2-verry_big _
,0,verry_big,green,0.5)
end sub
private sub frm_paint()
dim x as double
dim y as double
dim o as dbl3d
dim d as dbl3d
''for every pixel on form
for i = -me.width/2 to me.width/2
for j = -me.height/2 to me.height/2
'' camara origon
o = dbl3d(0,0,-1000)
'' camara direction
d = dbl3d(i,j,1000)
set_pixel(cint(i),cint(j) _
,render(o,d,7).tocolor)
next j
next x
end sub
end class
Code:
'' bluatigro 29 aug 2017
'' ray world module
'' needs m4x4 , dbl3d and basis3d
public module ray_world
public const verry_big as double = 1e9
public const verry_small as double = 1e-9
public spheretel as int16
public const spheremax as int16 = 200
public spheres(spheremax) as ray_sphere
public light as new dbl3d(-1,1,-1)
public class ray_mat
'' ray material
'' wil be extended
public diffuse as dbl3d
public reflection as double
end class
public class ray_sphere
'' ray sphere shape
public center as dbl3d
public r as double
public r2 as double
public mat as ray_mat
public sub new()
end sub
public sub fill(cx as double _
,cy as double,cz as double,r as double _
,m as ray_mat)
spot(cx,cy,cz)
center = dbl3d(cx,cy,cz)
me.r = r
r2 = r * r
mat = m
end sub
public function hit( o as t3d , d as t3d ) as double
'' calculate distance to sphere
'' or return verry_big if sphere wasn't hit
dim as double t , a , b , c , disc
dim as t3d temp = o - center
a = d.dot( d )
b = 2 * temp.dot( d )
c = temp.dot( temp ) - r2
disc = b * b - 4 * a * c
if disc < 0 then
return verry_big
else
dim as double e = math.sqrt( disc )
dim as double demon = 2 * a
t = ( -b - e ) / demon
if t > verry_small then
return t
end if
t = ( -b + e ) / demon
if t > verry_small then
return t
end if
end if
return verry_big
end function
end class
public sub add_sphere(x as double _
,y as double,z as double,r as double,kl as dbl3d _
,f as double = 0)
'' add a sphere to the world
if spheretel >= spheremax then exit sub
dim mat as ray_mat
mat.diffuse = kl
sphere(spheretel).fill(x,y,z,r,mat,f)
spheretel += 1
end sub
public function render(o as dbl3d _
,d as dbl3d,depth as int16)as dbl3d
'' get color of pixel
dim i as int16
dim isph as int16 = -1
dim b as double
dim sphdist as double = verry_big
'' get clostest sphere distance
for i = o to spheretel
b = spheres(i).hit(o,d)
if b < sphdist then
sphdist = dist
isph = i
end if
next i
'' get color of clostest sphere
'' and ca***ate shaded color
'' wil be extended
if i >= 0 then
dim kl as dbl3d = spheres(isph).mat.diffuse
dim p as dbl3d = o + d.normalize() * b
dim n as dbl3d = p - spheres(isph).center
dim a as double = getangle(n,light)
return kl*(math.cos(a)/2+.5)
end if
'' if no sphere was hit return black
return dbl3d()
end function
end module
Code:
'' bluatigro 29 aug 2017
'' 3d engine module
'' needs m4x4 and Dbl3D
public module basis3D
private dim sk(64) as Dbl3D
private dim v(20) as m4x4
private number as int16
public const xyz as int16 = 0
public const xzy as int16 = 1
public const yxz as int16 = 2
public const yzx as int16 = 3
public const zxy as int16 = 4
public const zyx as int16 = 5
public sub link(no as int16 _
,x as double,y as double,z as double _
,xz as double,yz as double,xy as double _
,ax as int16,p as int16)
'' create new matrix
'' wil effect future drawings
if no < 1 or n > 20 then exit sub
if p < 0 or p > 20 then exit sub
if p = no then exit sub
dim trans as m4x4
dim rotx as m4x4
dim roty as m4x4
dim rotz as m4x4
trans.translate(x,y,z)
rotx.rotate(yz)
roty.rotate(xz,1)
rotz.rotate(xy,2)
select case ax
case xyz
v(no)=rotx*roty*rotz*trans*v(p)
case xzy
v(no)=rotx*rotz*roty*trans*v(p)
case yxz
v(no)=roty*rotx*rotz*trans*v(p)
case yzx
v(no)=roty*rotz*rotx*trans*v(p)
case zxy
v(no)=rotz*rotx*roty*trans*v(p)
case zyx
v(no)=rotz*roty*rotx*trans*v(p)
case else
v(no)=rotx*roty*rotz*trans*v(p)
end select
number = no
end sub
public sub child(no as int16 _
,x as double,y as double,z as double _
,lim as int16,ax as int16,p as int16)
'' create a lim matrix of a avatar
'' wil effect furure drawings
link(no,x,y,z,sk(lim).y,sk(lim).x,sk(lim).z),ax,p)
end sub
public sub skelet(lim as int16 _
,x as double,y as double,z as double)
'' set the skelet lim of a avatar
sk(lim)=Dbl3D(x,y,z)
end sub
public function rad( deg as double ) as double
return deg * math.pi / 180.0
end function
public function pend( f as double _
, amp as double ) as double
'' for smoot animations of lims
return math.sin(rad(f))*amp
end function
public sub spot(byref x as double _
,byref y as double,byref z as double)
'' from local to world coordinates
dim v3d as dbl3d(x,y,z)
v3d=v(number)*v3d
x=v3d.x
y=v3d.y
z=v3d.z
end sub
public sub local(byref x as double _
,byref y as double,byref z as double)
'' from world to local coordinates
'' only rotation matrix
dim v3d as dbl3d(x,y,z)
dim m44 as m4x4
m44 = m44.inverse(v(number))
m44.translate(0,0,0)
v3d=m44*v3d
x=v3d.x
y=v3d.y
z=v3d.z
end sub
end module
Code:
'' bluatigro 29 aug 2017
'' matrix 4 x 4 class
'' needs Dbl3D
Public Class m4x4
Public m(3, 3) As Double
Private Const deg2rad as Double = Math.pi / 180
Public Sub New()
Dim i as Integer
Dim j as Integer
For i = 0 to 3
For j = 0 to 3
m(i, j) = 0.0
Next j
m(i, i) = 1.0
Next i
End Sub
Public Shared Operator *(a As m4x4, b As m4x4) As m4x4
Dim uit As m4x4
Dim i as Int16
Dim j as Int16
Dim k as Int16
For i = 0 to 3
For j = 0 to 3
uit.m(i, j) = 0.0
For k = 0 to 3
uit.m(i, j) += a.m(i, k) * b.m(k, j)
Next k
Next j
Next i
Return uit
End Operator
public shared operator *(m as m4x4, v as dbl3d) as dbl3d
return new dbl3d(v.x*m.m(0,0)+v.y*m.m(1,0) _
+v.z*m.m(2,0)+m.m(3,0) _
,v.x*m.m(0,1)+v.y*m.m(1,1) _
+v.z*m.m(2,1)+m(3,1) _
,v.x*m.m(0,2)+v.y*m.m(1,2) _
+v.z*m.m(2,2)+m.m(3,2))
end operator
public function inverse(q as m4x4) as m4x4
'' for the inverse rotation matrix
'' it wil NOT calculate inverse translation
dim d as double
dim uit as m4x4
d = q.m(0,0)*q.m(1,1)*q.m(2,2) _
- q.m(0,0)*q.m(2,1)*q.m(1,2) _
+ q.m(1,0)*q.m(2,1)*q.m(0,2) _
- q.m(1,0)*q.m(0,1)*q.m(2,2) _
+ q.m(2,0)*q.m(0,1)*q.m(1,2) _
- q.m(2,0)*q.m(1,1)*q.m(0,2)
uit.m(0,0)=(q.m(1,1)*q.m(2,2)-q.m(1,2)*q.m(2,1))/d
uit.m(1,0)=(q.m(0,1)*q.m(2,2)-q.m(0,2)*q.m(2,1))/d
uit.m(2,0)=(q.m(0,1)*q.m(1,2)-q.m(0,2)*q.m(1,1))/d
uit.m(0,1)=(q.m(1,0)*q.m(2,2)-q.m(1,2)*q.m(2,0))/d
uit.m(1,1)=(q.m(0,0)*q.m(2,2)-q.m(0,2)*q.m(2,0))/d
uit.m(2,1)=(q.m(0,0)*q.m(1,2)-q.m(0,2)*q.m(1,0))/d
uit.m(0,2)=(q.m(1,0)*q.m(2,1)-q.m(1,1)*q.m(2,0))/d
uit.m(1,2)=(q.m(0,0)*q.m(2,1)-q.m(0,1)*q.m(2,0))/d
uit.m(2,2)=(q.m(0,0)*q.m(1,1)-q.m(0,1)*q.m(1,2))/d
return uit
end function
Public Sub translate(x As Double _
,y As Double ,z As Double)
m(3, 0) = x
m(3, 1) = y
m(3, 2) = z
End Sub
Public Sub rotate(deg As Double _
, ax As Int16 = 0)
Dim a As Int16 = 1
Dim b As Int16 = 2
If ax = 1 Then
a = 0
b = 2
End If
If ax = 2 Then
a = 0
b = 1
End If
m(a, a) = Math.cos(deg * deg2rad)
m(a, b) = -Math.sin(deg * deg2rad)
m(b, a) = Math.sin(deg * deg2rad)
m(b, b) = Math.cos(deg * deg2rad)
End Sub
Public Sub scale(x As Double _
,y As Double ,z As double)
m(0, 0) = x
m(1, 1) = y
m(2, 2) = z
End Sub
Code:
'' bluatigro 29 aug 2017
'' double 3d class
Public Class Dbl3D
Public x As Double
Public y As Double
Public z As Double
Public Sub New()
x = 0
y = 0
z = 0
End Sub
Public Sub New(a As Double, b As Double, c As Double)
x = a
y = b
z = c
End Sub
Public Function toColor() As Color
Return Color.FromArgb(255 _
, CInt(x * 255), CInt(y * 255), CInt(z * 255))
End Function
Public Shared Operator +(a As Dbl3D, b As Dbl3D) As Dbl3D
Return New Dbl3D(a.x + b.x, a.y + b.y, a.z + b.z)
End Operator
Public Shared Operator -(a As Dbl3D, b As Dbl3D) As Dbl3D
Return New Dbl3D(a.x - b.x, a.y - b.y, a.z - b.z)
End Operator
Public Shared Operator /(a As Dbl3D, b As Double) As Dbl3D
Return New Dbl3D(a.x / b, a.y / b, a.z / b)
End Operator
Public Shared Operator *(a As Dbl3D, b As Double) As Dbl3D
Return New Dbl3D(a.x * b, a.y * b, a.z * b)
End Operator
Public Function dot(b As Dbl3D) As Double
Return x * b.x + y * b.y + z * b.z
End Function
Public Function cross(b As Dbl3D) As Dbl3D
Return New Dbl3D(y * b.z - z * b.y _
,z * b.x - x * b.z _
,x * b.y - y * b.x)
End Function
Public Function length() As Double
Return Math.sqrt(dot(Me))
End Function
Public Function getAngle(b As Dbl3D) As Double
Dim la as Double length()
Dim lb as Double b.length()
Dim d as Double dot(b)
Return Math.acs(d / (la * lb))
End Function
Public Sub normalize()
Me = Me / length()
End Sub
End Class