Thanks a lot. I've started playing with it. Was hard to figure out why I had to keep things into untit cube (coordinates<1), but since I got it, I was able to render my Rodrigues rotation delightfully ;-)
@dodicat, I was just looking on a way to render this in 3D perspective. I really don't know how to make it, but the dahfi's renderer is absolutly neat:
Code: Select all
' subs Cone_Precalc and translate() have all the details
'[a bit refactored for comfort (of mine..)]
#ifndef _pi
const as double _twoPi => 8*atn(1)
const as double _pi => 4*atn(1)
#endIf
#macro _ALPHA256(ret,back, fore, am, a256)
ret=((_
( fore and &hFF00FF)*a256 + _
( back and &hFF00FF)*am + &h800080 ) and &hFF00FF00 or _
(_
( fore and &H00FF00)*a256 + _
( back and &h00FF00)*am + &h008000 ) and &h00FF0000) shr 8
#endMacro
#macro _ROTC0(dsta, dstb, srca, srcb)
temp = cosa_*srca - sina_*srcb
dstb = cosa_*srcb + sina_*srca
dsta = temp
#endMacro
#macro _ROTC(a_,dst, src, dota, dotb)
scope
dim as single a = ( a_ )
dim as double cosa_ = cos(a), sina_ = sin(a), temp
_ROTC0( (dst._axisX)dota, (dst._axisX)dotb, (src._axisX)dota, (src._axisX)dotb )
_ROTC0( (dst._axisY)dota, (dst._axisY)dotb, (src._axisY)dota, (src._axisY)dotb )
_ROTC0( (dst._axisZ)dota, (dst._axisZ)dotb, (src._axisZ)dota, (src._axisZ)dotb )
end scope
#endMacro
#macro _XROT(dst,a_)
_ROTC(a_, dst, dst, ._y, ._z)
#endMacro
#macro _YROT(dst,a_)
_ROTC(a_, dst, dst, ._z, ._x)
#endMacro
#macro _ZROT(dst,a_)
_ROTC(a_, dst, dst, ._x, ._y)
#endMacro
type IMAGEVARS
' 2016 Jan 31
declare destructor()
declare sub ClearScreen(byval Col as ulong=&HFF000000)
private:
declare sub Destroy()
declare sub VarsCommon()
public:
declare sub ScrInf()
declare sub ScreenInit(byval Wid as single=-1, _
byval Hgt as single=-1, _
byval Bpp as uinteger=32, _
byval NumPages as integer=1, _
byval Flags as integer=0)
declare function Create(byval Wid as long=-1, _
byval Hgt as long=0, _
byval Colour as ulong=rgb(0,0,0)) _
as any ptr
declare sub Checkers(byval PColor as ulong=rgba(145,145,145,255), _
byval Size as uinteger=12)
as any ptr _im, _pixels
as integer _w, _h, _bpp, _
_bypp, _pitch, _numpages, _
_flags, _rate, _isScreen, _
_pitchBy, _wm, _hm
as single _midx, _midy, _
_midxm, _midym, _diagonal
as string _driverName
end type
destructor IMAGEVARS()
Destroy()
end destructor
sub IMAGEVARS.Destroy()
if THIS._im<>0 then
imageDestroy(THIS._im)
THIS._im = 0
end if
end sub
sub IMAGEVARS.VarsCommon()
THIS._wm = THIS._w - 1
THIS._midx = THIS._w/2
THIS._midxm = THIS._wm/2
THIS._hm = THIS._h - 1
THIS._midy = THIS._h/2
THIS._midym = THIS._hm/2
THIS._diagonal = sqr(THIS._w*THIS._w + THIS._h*THIS._h)
if THIS._bypp<>0 then THIS._pitchBy = THIS._pitch\THIS._bypp
end sub
sub IMAGEVARS.ClearScreen(byval Col as ulong)
line (0,0)-(THIS._wm, THIS._hm), Col, bf
end sub
sub IMAGEVARS.ScrInf()
screenInfo THIS._w, THIS._h, THIS._bpp, _
THIS._bypp, THIS._pitch, THIS._rate, _
THIS._driverName
THIS._pixels = screenPtr()
THIS.VarsCommon()
end sub
sub IMAGEVARS.ScreenInit(byval Wid as single=-1, _
byval Hgt as single=-1, _
byval Bpp as uinteger=32, _
byval NumPages as integer=1, _
byval Flags as integer=0)
dim as integer ww, hh
screenInfo ww, hh
'
Wid = abs(Wid)
if Wid<=1 then
Wid *= ww
end if
Hgt = abs(Hgt)
if Hgt<=1 then
Hgt *= hh
end if
THIS._w = Wid
THIS._h = Hgt
THIS._Bpp = Bpp
THIS._flags or= 8
THIS._numpages = Numpages
THIS._flags = Flags
'
THIS.Destroy()
'
screenRes Wid, Hgt, Bpp, Numpages, Flags
'
THIS.ScrInf()
THIS._isScreen = -1
if NumPages> 1 then screenSet 0, 1
end sub
function IMAGEVARS.Create(byval Wid as long=-1, _
byval Hgt as long=0, _
byval Colour as ulong=rgb(0,0,0)) _
as any ptr
if Hgt=0 then
ScrInf()
Wid = THIS._w
Hgt = THIS._h
end if
'
THIS.Destroy()
'
THIS._im => imageCreate( Wid, Hgt, Colour )
imageInfo THIS._im, THIS._w, THIS._h, THIS._bypp, THIS._pitch, THIS._pixels
THIS._bpp = THIS._bypp*8
'
THIS.VarsCommon()
THIS._isScreen = 0
'
return THIS._im
end function
sub IMAGEVARS.Checkers(byval PColor as ulong, byval Size as uinteger)
dim as uinteger sizeDouble => Size*2
dim as uinteger sizeM => Size - 1
for y as integer = 0 to THIS._hm step Size
for x as integer = -Size*((y/sizeDouble)=int(y/sizeDouble)) to _
THIS._wm step _
sizeDouble
line THIS._im, (x, y)-(x + sizeM, y + sizeM), PColor, bf
next x
next y
End Sub
type AADOT
declare sub RenderTarget(byval Pti as IMAGEVARS ptr)
declare sub DrawAadot(byval X as single=0, _
byval Y as single=0, _
byval C as ulong=&hFFFFFFFF)
as single _rad = 0.65
as single _alpha = 1
as ulong _outlined = 0
as IMAGEVARS ptr _p
as any ptr _pixels
private:
as single _slope
as single _slope_X2
end type
sub AADOT.RenderTarget(byval Pti as IMAGEVARS ptr)
if pti->_isScreen then
THIS._pixels = screenPtr()
else
THIS._pixels = Pti->_pixels
end if
'
THIS._p = Pti
end sub
sub AADOT.DrawAadot(byval X as single=0, _
byval Y as single=0, _
byval C as ulong=&hFFFFFFFF)
if THIS._p->_h<1 then exit sub
'
THIS._slope = THIS._alpha*256
THIS._slope_X2 = THIS._slope*2
'
dim as single coneHgt = THIS._rad*THIS._slope
dim as integer _x = X - THIS._rad
dim as integer x2 = X + THIS._rad
_x += _x*(_x<0)
dim as integer _y = Y - THIS._rad
dim as integer y2 = Y + THIS._rad
_y += _y*(_y<0)
dim as single dxClip = THIS._slope*(X - _x)
dim as single dy = THIS._slope * (y - _Y)
x2 += (x2 - THIS._p->_wm)*(x2>THIS._p->_wm)
y2 += (y2 - THIS._p->_hm)*(y2>THIS._p->_hm)
dim as integer pwidm = x2 - _X
dim as ulong ptr pCorner = THIS._pixels
pCorner += _y*THIS._p->_pitchBy + _x
'
if THIS._outlined then
for py as ulong ptr = pCorner to _
@pCorner[ (y2-_y)*THIS._p->_pitchBy ] step _
THIS._p->_pitchBy
dim as single ySq = dy*dy
dim as single dx = dxClip
for px as ulong ptr = py to py + pwidm
dim as integer alph = coneHgt - sqr(dx*dx + ySq)
if alph>THIS._slope then alph = THIS._slope_X2 - alph
if alph>0 then
dim as integer alphM = 256 - alph
_ALPHA256( *px, *px, C, alphM, alph )
end if
'
dx -= THIS._slope
next px
dy -= THIS._slope
next py
else
for py as ulong ptr = pCorner to @pCorner[ (Y2-_Y)*THIS._p->_pitchBy ] step THIS._p->_pitchBy
dim as single ySq = dy*dy, dx = dxClip
for px as ulong ptr = py to py + pwidm
dim as integer alph = coneHgt - sqr(dx*dx + ySq)
'
if alph> THIS._slope then
alph = THIS._slope
else
alph += alph*(alph<0)
end if
'
dim as integer alphM = 256 - alph
_ALPHA256( *px, *px, C, alphM, alph )
dx -= THIS._slope
next px
dy -= THIS._slope
next py
end if
end sub
type V3
as double _x, _y, _z
as double _rad
as long _c
end type
type P3D as V3
type AXIS3D
as V3 _axisX = (1,0,0)
as V3 _axisY = (0,-1,0)
as V3 _axisZ = (0,0,1)
as double _x, _y, _z
end type
type TMOUSE
declare property Dx() as single
declare property Dy() as single
declare function Buttons() as integer
as integer _x, _y, _b
as integer _xp, _yp, _bp
as single _scalar = 1
end type
property TMOUSE.dx as single
'
return THIS._scalar*(THIS._x - THIS._xp)
end property
property TMOUSE.dy as single
'
return THIS._scalar*(THIS._y - THIS._yp)
end property
function TMOUSE.buttons as integer
THIS._bp = THIS._b
THIS._xp = THIS._x
THIS._yp = THIS._y
'
getMouse THIS._x, THIS._y, , THIS._b
'
return THIS._b
end function
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
'. + + + + + + + + + + + + + + + + + + + +
declare sub Render(byref Buf as IMAGEVARS, _
byref BackImg as IMAGEVARS, _
Points() as V3, _
byref Axis as AXIS3D, _
byval Zoom as single, _
byval Lb as integer=-1)
sub Render(byref Buf as IMAGEVARS, _
byref BackImg as IMAGEVARS, _
Points() as V3, _
byref Axis as AXIS3D, _
byval Zoom as single, _
byval lB as integer=-1)
screenLock
put (0,0), BackImg._im, PSET
draw string (0,0), "cone precalculated", rgb(255,255,255)
draw string (0,10), "translation", rgb(0,255,0)
'
dim as AADOT dot
dot.RenderTarget (@Buf)
dot._alpha = 0.75
'
dim as single z_point_scale = 0.011
'
if Lb<0 then Lb = lBound(points)
for p as V3 ptr = @Points(Lb) to @Points( uBound(Points) )
dim as single rz_ = ( Axis._z + _
Axis._axisZ._z*p->_z + _
Axis._axisX._z*p->_x + _
Axis._axisY._z*p->_y )
If rz_>0.1 Then
dim as single rz = Zoom/rz_
dim as single y = Buf._midy - _
rz*(Axis._y + _
Axis._axisY._y*p->_y + _
Axis._axisZ._y*p->_z + _
Axis._AxisX._y*p->_x)
dim as single x = Buf._midx + _
rz*(Axis._x + _
Axis._axisX._x*p->_x + _
Axis._axisY._x*p->_y + _
Axis._axisZ._x*p->_z)
'
dot._rad = z_point_scale*rz*p->_rad
dot.DrawAadot(x, y, p->_c)
end if
Next p
screenUnlock
end sub
declare sub Translate(byref Ret as V3, Vec as V3, Precalc as V3)
sub Translate(byref Ret as V3, Vec as V3, Precalc as V3)
Ret._x = Vec._x*Precalc._x + Vec._y*Precalc._z + Vec._z*Precalc._y
Ret._y = Vec._y*Precalc._x + Vec._z*Precalc._z + Vec._x*Precalc._y
Ret._z = Vec._z*Precalc._x + Vec._x*Precalc._z + Vec._y*Precalc._y
end sub
declare sub TranslateAll(A() as V3, byref SurfNorm as V3=(0, 0, -1))
sub TranslateAll(A() as V3, byref SurfNorm as V3=(0, 0, -1))
dim as integer ub = uBound(A)\2
dim as integer num_points = ub+1
for i as integer = 0 to ub
var dest = i+num_points
'
Translate ( A(dest), SurfNorm, A(i) )
A(dest)._rad = A(i)._rad
A(dest)._c = rgb(0,255,0)
next i
end sub
function RodriguesRotation(byref H as P3D, _
byref U as P3D, _
byref M as P3D, _
byval angle as double) _
as P3D
'_the Rodrigues transform_
'
dim as P3D result
'
'vector position of M relative to H
dim as P3D G
G._x = M._x - H._x
G._y = M._y - H._y
G._z = M._z - H._z
'
'K = 1 - cos angle
dim as double K = 1 - cos(angle)
'
result._x = H._x + G._x*( U._x*U._x*K + cos(angle) ) + _
G._y*( U._x*U._y*K - U._z*sin(angle) ) + _
G._z*( U._x*U._z*K + U._y*sin(angle) )
result._y = H._y + G._x*( U._x*U._y*K + U._z*sin(angle) ) + _
G._y*( U._y*U._y*K + cos(angle) ) + _
G._z*( U._y*U._z*K - U._x*sin(angle) )
result._z = H._z + G._x*( U._x*U._z*K - U._y*sin(angle) ) + _
G._y*( U._y*U._z*K + U._x*sin(angle) ) + _
G._z*( U._z*U._z*K + cos(angle) )
'
'---->
return result
end function
function SmallRodriguesRotation(byref H as P3D, _
byref U as P3D, _
byref M as P3D, _
byval angle as double) _
as P3D
'_the Rodrigues transform_
'
dim as P3D result
'
'vector position of M relative to H
dim as P3D G
G._x = M._x - H._x
G._y = M._y - H._y
G._z = M._z - H._z
'
'K = 1 - cos angle
dim as double K = 0
'
result._x = H._x + G._x*( U._x*U._x*K + 1 ) + _
G._y*( U._x*U._y*K - U._z*(angle) ) + _
G._z*( U._x*U._z*K + U._y*(angle) )
result._y = H._y + G._x*( U._x*U._y*K + U._z*(angle) ) + _
G._y*( U._y*U._y*K + 1 ) + _
G._z*( U._y*U._z*K - U._x*(angle) )
result._z = H._z + G._x*( U._x*U._z*K - U._y*(angle) ) + _
G._y*( U._y*U._z*K + U._x*(angle) ) + _
G._z*( U._z*U._z*K + 1 )
'
'---->
return result
end function
declare sub ConePrecalc(A() as V3, _
byval NumPoints as integer=25, _
byval ConeHalfAngle as single=_pi/20)
sub ConePrecalc(D() as V3, _
byval NumPoints as integer=25, _
byval ConeHalfAngle as single=_pi/20)
redim D(NumPoints - 1)
'
'_____________________________init____
'origin h of the rotation axis (U)
dim as single hx = 0
dim as single hy = 0
dim as single hz = 0
dim as P3D h
h._x = hx
h._y = hy
h._z = hz
'direction unit vector of the axis (U)
dim as single a = 0
dim as single b = 1
dim as single c = 1
dim as single norm = sqr(a^2 + b^2 + c^2)
dim as P3D abc
abc._x = a
abc._y = b
abc._z = c
dim as P3D u
u._x = a/norm
u._y = b/norm
u._z = c/norm
'point M to apply rotation on
dim as single mx = 0.2
dim as single my = 0
dim as single mz = 0.6
dim as P3D M
m._x = mx
m._y = my
m._z = mz
'angle of the rotation
dim as double axisRotationAngle
'____________________________________
'feed
for i as integer = 0 to NumPoints - 1
'
if i<100 then
D(i)._x = hx + i*a/100
D(i)._y = hy + i*b/100
D(i)._z = hz + i*c/100
D(i)._rad = 0.6
D(i)._c = rgb(250,110,050)
else
D(i) = RodriguesRotation(h, u, m, i/10)
with D(i)
._rad = 1
._c = rgb(255,255,255)
end with
end if
next i
end sub
declare sub Main()
sub Main()
dim as IMAGEVARS buf, img
dim as AXIS3D axis
'
buf.ScreenInit(640, 480)
img.Create buf._w, buf._h, rgb(48,48,48)
img.Checkers rgb(92,92,92), 30
'
dim as single anim_fps = 26
dim as single phys_fps = 55
'
axis._z = 3
dim as single zoom = 0.6*buf._diagonal
dim as single rot_plane = _pi/9, _
rot_plane_inc = .0001
dim as V3 points()
ConePrecalc( points(), 500, _pi )
'
redim preserve points( (ubound(points) + 1)*2 - 1)
TranslateAll( points() )
'
'~~~~~~ anim / physics / input ~~~~~~
dim as single anim_f, _
phys_f, _
ianim = 1/anim_fps, _
iphys = 1/phys_fps
'
dim as double tNow = TIMER, _
td, _
tp = tNow
dim as double tDemoExit = tNow+5, _
tMessageTime = 3
dim as string kstr
dim as tMouse mouse
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
do
'addition--------------------------
dim as integer gmX, gmY, gmWheel
getMouse gmX, gmY, gmWheel
zoom = .6*buf._diagonal + gmWheel/(40 + log(abs(gmWheel - 100)))*buf._diagonal
'----------------------------------
if anim_f<=0 then
var translations_lbound = 0 ''(ubound(points)+1)\2
'
Render(buf, img, points(), axis, zoom, translations_lbound)
tMessageTime -= ianim
anim_f += ianim
end If
'
tp = tNow
tNow = TIMER
td = tNow - tp
anim_f -= td
'
if mouse.Buttons()>0 then
mouse._scalar = _pi/buf._diagonal
_YROT(axis, -mouse.Dx)
_XROT(axis, -mouse.Dy)
else
dim as single rspeed = _twoPi/8500
phys_f += td
while phys_f>0
_ZROT(axis, -rot_plane)
_YROT(axis, rspeed)
_ZROT(axis, rot_plane)
rot_plane += rot_plane_inc
phys_f -= iphys
wend
end if
'
kstr=left(inkey$,1)
sleep 15
loop until ( kstr=chr(27) )
'
end sub
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
Main()
'. _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
'END_OF_SOURCE_FILE
Just I guess that applying some z_order before showing wouldn't hurt.
