Thanks jj2007.
To ease the cpu workload I have tried opengl rendering (very easy to convert from fbgfx)
Code: Select all
#include "gl/gl.bi"
sub setupgl
Dim As Integer xres,yres
Screeninfo xres,yres
glDisable (GL_DEPTH_TEST)
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)
glEnable (GL_BLEND)
glEnable (GL_LINE_SMOOTH)
glOrtho 0, xres, yres, 0,-1, 1
glClearColor 0,0,.5,1
end sub
setupgl
Sub drawstring(x As Long,y As Long,txt As String,size As Long,c As Ulong,b As Ulong)
#define GL_RGBA_ 6408
#define GL_BGRA_ 32993
Dim As Long xx=128*8,yy=16*size
static As Any Ptr i
static As gluint texture,s
if s=0 then glGenTextures(1, @texture):
i=Imagecreate(128*4,16,b):'8 16
glBindTexture( GL_TEXTURE_2D, texture ):s=1
draw string i,(0,0),txt,c
glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA_, 128*4,16, 0, GL_BGRA_, GL_UNSIGNED_BYTE, i+32 )
glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST )
glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST )
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL)
glEnable( GL_TEXTURE_2D )
glcolor3ub(Cast(Ubyte Ptr,@c)[2],Cast(Ubyte Ptr,@c)[1],Cast(Ubyte Ptr,@c)[0])
glbegin gl_quads
glTexCoord2f(0,0)
glvertex2f(x,y)
glTexCoord2f(0,1)
glvertex2f(x,y+yy)
glTexCoord2f(1,1)
glvertex2f(x+xx,y+yy)
glTexCoord2f(1,0)
glvertex2f(x+xx,y)
glend
gldisable( GL_TEXTURE_2D )
imagedestroy i
End Sub
Type V3
As Single x,y,z
End Type
Operator -(v1 As v3,v2 As v3) As v3 'v1-v2
Return Type(v1.x-v2.x,v1.y-v2.y,v1.z-v2.z)
End Operator
Operator ^ (Byref v1 As v3,Byref v2 As v3) As v3 'cross product
Return Type(v1.y*v2.z-v2.y*v1.z,-(v1.x*v2.z-v2.x*v1.z),v1.x*v2.y-v2.x*v1.y)
End Operator
Type float As V3
Type box
As v3 p(1 To 4)
As Ulong c 'colour
As Single z
End Type
Type angle3D 'FLOATS for angles
As Single sx,sy,sz
As Single cx,cy,cz
Declare Static Function construct(As Single,As Single,As Single) As Angle3D
End Type
Declare Function InputFunction(x As Double,y As Double) As Double
Screenres 1024,768,32,,2
Width 1024\8,768\16 'max dos font size
setupgl
'============ globals =============
Const pi=4*Atn(1)
Redim Shared As box b()
Redim Shared As box rot1()
Dim Shared As Angle3D A3d
Dim Shared As V3 CC 'grid centre
Dim Shared As Double df,x,y 'for inputfunction()
Dim Shared As Single MinX
Dim Shared As Single MaxX
Dim Shared As Single MinY
Dim Shared As Single MaxY
MinX=-3:MaxX=3:Miny=-3:MaxY=3
Dim Shared As Integer xres,yres
Screeninfo xres,yres
'================================== functions ================
Sub QsortZ(array() As box,begin As Long,Finish As Long)
Dim As Long i=begin,j=finish
Dim As box x =array(((I+J)\2))
While I <= J
While array(I).z > X.z:I+=1:Wend
While array(J).z < X.z:J-=1:Wend
If I<=J Then Swap array(I),array(J): I+=1:J-=1
Wend
If J >begin Then QsortZ(array(),begin,J)
If I <Finish Then QsortZ(array(),I,Finish)
End Sub
Function Angle3D.construct(x As Single,y As Single,z As Single) As Angle3D
Return Type (Sin(x),Sin(y),Sin(z), _
Cos(x),Cos(y),Cos(z))
End Function
Function Rotate(c As V3,p As V3,a As Angle3D,scale As float=Type(1,1,1)) As V3
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<V3>((scale.x)*((a.cy*a.cz)*dx+(-a.cx*a.sz+a.sx*a.sy*a.cz)*dy+(a.sx*a.sz+a.cx*a.sy*a.cz)*dz)+c.x,_
(scale.y)*((a.cy*a.sz)*dx+(a.cx*a.cz+a.sx*a.sy*a.sz)*dy+(-a.sx*a.cz+a.cx*a.sy*a.sz)*dz)+c.y,_
(scale.z)*((-a.sy)*dx+(a.sx*a.cy)*dy+(a.cx*a.cy)*dz)+c.z)
End Function
Function perspective(p As V3,eyepoint As V3) As V3
Dim As Single w=1+(p.z/eyepoint.z)
If w=0 Then w=1e-6
Return Type<V3>((p.x-eyepoint.x)/w+eyepoint.x,_
(p.y-eyepoint.y)/w+eyepoint.y,_
(p.z-eyepoint.z)/w+eyepoint.z)
End Function
Function dot(v1 As v3,v2 As v3) As Single
Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y + v1.z*v1.z)
Dim As Single d2=Sqr(v2.x*v2.x + v2.y*v2.y + v2.z*v2.z)
Dim As Single v1x=v1.x/d1,v1y=v1.y/d1,v1z=v1.z/d1 'normalize
Dim As Single v2x=v2.x/d2,v2y=v2.y/d2,v2z=v2.z/d2 'normalize
Return v1x*v2x+v1y*v2y+v1z*v2z 'dot product
End Function
Function map(a As Single,b As Single,x As Single,c As Single,d As Single) As Single
Return ((d)-(c))*((x)-(a))/((b)-(a))+(c)
End Function
Function setgrid(sx As Single,bx As Single,sy As Single,by As Single,st As Single,p() As box,fn As Function(x As Double,y As Double=0) As Double) As v3
''485 515 335 365
#define U Ubound(p)
Redim p(0)
Dim As Single cx,cy,ctr
Static As Single q=15
Var sttx=st*(MaxX-MinX)/(bx-sx)
Var stty=st*(MaxY-MinY)/(by-sy)
For y As Single=sy To by+st/2 Step st
For x As Single=sx To bx+st/2 Step st
ctr+=1
cx+=x
cy+=y
Redim Preserve p(1 To U+1)
Var lx=map(sx,bx,x,MinX,MaxX)+500
Var ly=map(sy,by,y,MinY,MaxY)+350
'temp adjust to use limits for .z
p(u).p(1)=Type<v3>(lx,ly, fn(p(u).p(1).x,p(u).p(1).y))
p(u).p(2)=Type<v3>(lx+sttx,ly, fn(p(u).p(2).x,p(u).p(2).y))
p(u).p(3)=Type<v3>(lx+sttx,ly+stty,fn(p(u).p(3).x,p(u).p(3).y))
p(u).p(4)=Type<v3>(lx,ly+stty, fn(p(u).p(4).x,p(u).p(4).y))
're set
p(u).p(1).x=x: p(u).p(1).y=y
p(u).p(2).x=x+st: p(u).p(2).y=y
p(u).p(3).x=x+st: p(u).p(3).y=y+st
p(u).p(4).x=x: p(u).p(4).y=y+st
p(u).c=Rgb(x*q, x*q xor y*q,y*q)
Next x
Next y
Return Type(cx/ctr,cy/ctr)'centre
End Function
Sub drawboxes(b() As box)
Redim As Long a()
redim as V3 aa()
For n As Long=Lbound(b) To Ubound(b)
Var rd=Cast(Ubyte Ptr,@b(n).c)[2]
Var gr=Cast(Ubyte Ptr,@b(n).c)[1]
Var bl=Cast(Ubyte Ptr,@b(n).c)[0]
Dim As v3 screencentre=(xres\2,yres\2)
Var v1=b(n).p(2)-b(n).p(1)
Var v2=b(n).p(3)-b(n).p(2)
Var norm=v1^v2 'cross product
Var dt=dot(norm,Type(1,.5,0))
Var f=map(-1,1,dt,.2,1)
glbegin gl_quads
glcolor3ub f*rd,f*gr,f*bl
for m as long=4 to 1 step -1
glvertex2f b(n).p(m).x,b(n).p(m).y
next m
glend
Next
End Sub
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
Static As Double timervalue,_lastsleeptime,t3,frames
frames+=1
If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
If sleeptime<1 Then sleeptime=1
_lastsleeptime=sleeptime
timervalue=Timer
Return sleeptime
End Function
Sub setup(x1 As Single,x2 As Single,y1 As Single,y2 As Single,meshsize As Single)
CC= setgrid(x1,x2,y1,y2,meshsize,b(),@InputFunction)'create grid, CC is the centre
Redim rot1(Lbound(b) To Ubound(b)) 'working array
A3d=angle3D.construct(0,-pi/2,0)
Var dx=x2-x1,dy=y2-y1
Var s=20-map(0,30,dx,0,10)
For n As Long=Lbound(b) To Ubound(b)
For m As Long=1 To 4
rot1(n).p(m)=rotate(CC,B(n).p(m),A3D,Type(s,s,s)) 'align boxes horizontally based
rot1(n).c=B(n).c
B(n).p(m)=rot1(n).p(m)
Next m
Next n
End Sub
function display() as long
#define resetwheel(w,fl) fl=w
#define wheel(w,f) w-f
Static As float ang=(0,-pi/7,pi/2) 'default
Static As Long fps
Static As String key
Static As Long mx,my,mw,mb,rflag
Static As Single sc=1
Const k=40
Var f=map(0,40,k,0,.5)
Do
setup(485,485+k,335,335+k,f)
Getmouse mx,my,mw,mb
If mb=2 Then 'reset
ang.z=pi/2:ang.y=-pi/7:ang.x=0
resetwheel(mw,rflag)
End If
mw=wheel(mw,rflag)
If mx>0 Then sc=2+(mw/10)'scaler
key=Inkey
If key=Chr(255)+"K" Then ang.z-=.05 'left
If key=Chr(255)+"M" Then ang.z+=.05 'right
If key=Chr(255)+"P" Then ang.y-=.05 'down
If key=Chr(255)+"H" Then ang.y+=.05 'up
If key="q" Then ang.x+=.05
If key="w" Then ang.x-=.05
A3D=Angle3D.construct(ang.x,ang.y,ang.z) 'set the rotate trigs
For n As Long=Lbound(b) To Ubound(b)
For m As Long=1 To 4
rot1(n).p(m) =rotate(CC,B(n).p(m),A3D,Type(sc,sc,sc))
rot1(n).p(m) =perspective(rot1(n).p(m),Type(cc.x,cc.y,400*sc))'eyepoint
If mb=1 Then rot1(n).p(m).x-=cc.x-mx: rot1(n).p(m).y-=cc.y-my'follow the mouse
Next m
rot1(n).z=(rot1(n).p(1).z+rot1(n).p(3).z)/2
Next n
qsortz(rot1(),Lbound(rot1), Ubound(rot1))
glClear(GL_COLOR_BUFFER_BIT)
DrawString(50,50,"Framerate "&fps,1.5,rgb(200,200,200),rgb(0,0,255\2))
drawstring (50,80,"keys q and w to rotate round vertical (y) axis",1.5,rgb(200,200,200),rgb(0,0,255\2))
DrawString(50,110,"Use the arrow keys for x and z axis",1.5,rgb(200,200,200),rgb(0,0,255\2))
drawstring(50,140, "Mouse wheel to magnify",1.5,rgb(200,200,200),rgb(0,0,255\2))
DrawString(50,170,"Right mouse click to reset",1.5,rgb(200,200,200),rgb(0,0,255\2))
drawboxes(rot1())
Flip
Sleep regulate(80,fps),1
Loop Until key=Chr(27)
return 0
End function
end display()
Sleep
Function InputFunction(x As Double,y As Double) As Double
'set the x/y domains
MinX=-pi*4
MaxX=pi*4
MinY=-pi*4
MaxY=pi*4
if MaxX<MinX then swap MaxX,MinX
if MaxY<MinY then swap MaxY,MinY
'return sin(x)*cos(y)*3 'egg box
Return (20*Cos(x/3)+.5*Sin(y/4)*Log(x)*(x^.3-15*x^.2))/12 ' << --------------- INPUT function -----------
End Function