UEZ wrote:I'm not aware that I can upload files to the (German?) FB Portal. All the better if I could.
badidea wrote:File encoding needs to be ISO-8859-1, not UTF-8. Or at least, when I set that in Geany, it works.
And fTimer should to be double.
Code: Select all
#Include Once "GL/glu.bi"
#include Once "GL/glext.bi"
#include "fbgfx.bi"
Dim Shared LightDiffuse(0 To 3) As Single => {0.7, 0.7, 0.7, 1.0}
Dim Shared LightPosition(0 To 3) As Single => {0.0 , 0.0 , 1.0, 1.0}
Dim Shared As Integer xres,yres
xres=1024
yres=768
Screenres xres,yres,32,,2
Dim Shared As GLuint tex(1 To 52+1)
#ifdef __FB_WIN32__
Function speak(text As String) As Long
Dim As String x="mshta vbscript:Execute(""CreateObject(""""SAPI.SpVoice"""").Speak("""""+text+""""")(window.close)"")"
Shell x
Return 1
End Function
#endif
Sub drawstringgfx(Byval xpos As Long,Byval ypos As Long,Byref text As String,Byval colour As Ulong,Byval size As Single,Byref im As Any Pointer=0)
Type D2
As Double x,y
As Ulong col
End Type
size=Abs(size)
Static As d2 XY()
Static As Long runflag
If runflag=0 Then
Redim XY(128,127)
Screen 8
Width 640\8,200\16
Dim As Ulong Pointer img
Dim count As Long
For ch As Long=1 To 127
img=Imagecreate(9,17)
Draw String img,(1,1),Chr(ch)
For x As Long=1 To 8
For y As Long=1 To 16
If Point(x,y,img)<>0 Then
count=count+1
XY(count,ch)=Type<D2>(x,y)
End If
Next y
Next x
count=0
Imagedestroy img
Next ch
runflag=1
End If
If size=0 Then Exit Sub
Dim As D2 np,t
#macro Scale(p1,p2,d)
np.col=p2.col
np.x=d*(p2.x-p1.x)+p1.x
np.y=d*(p2.y-p1.y)+p1.y
#endmacro
Dim As D2 c=Type<D2>(xpos,ypos)
Dim As Long dx=xpos,dy=ypos,f
If Abs(size)=1.5 Then f=3 Else f=2
For z6 As Long=1 To Len(text)
Var asci=text[z6-1]
For _x1 As Long=1 To 64*2
t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy,colour)
Scale(c,t,size)
If XY(_x1,asci).x<>0 Then
If size>1 Then
Line im,(np.x-size/f,np.y-size/f)-(np.x+size/f,np.y+size/f),np.col,bf
Else
Pset im,(np.x,np.y),np.col
End If
End If
Next _x1
dx=dx+8
Next z6
End Sub
Sub initgfx Constructor
drawstringgfx(0,0,"",0,0)
Screen 0
End Sub
Function Filter(Byref tim As Ulong Pointer,_
Byval rad As Single,_
Byval destroy As Long=1,_
Byval fade As Long=0) As Ulong Pointer
#define map(a,b,_x_,c,d) ((d)-(c))*((_x_)-(a))/((b)-(a))+(c)
If fade<0 Then fade=0:If fade>100 Then fade=100
Type p2
As Long x,y
As Ulong col
End Type
#macro p_point(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
(colour)=*pixel
#endmacro
#macro ppset(_x,_y,colour)
pixel=row+pitch*(_y)+(_x)*4
*pixel=(colour)
#endmacro
#macro average()
ar=0:ag=0:ab=0:inc=0
xmin=x:If xmin>rad Then xmin=rad
xmax=rad:If x>=(_x-1-rad) Then xmax=_x-1-x
ymin=y:If ymin>rad Then ymin=rad
ymax=rad:If y>=(_y-1-rad) Then ymax=_y-1-y
For y1 As Long=-ymin To ymax
For x1 As Long=-xmin To xmax
inc=inc+1
ar=ar+(NewPoints(x+x1,y+y1).col Shr 16 And 255)
ag=ag+(NewPoints(x+x1,y+y1).col Shr 8 And 255)
ab=ab+(NewPoints(x+x1,y+y1).col And 255)
Next x1
Next y1
If fade=0 Then
averagecolour=Rgb(ar/(inc),ag/(inc),ab/(inc))
Else
averagecolour=Rgb(fd*ar/(inc),fd*ag/(inc),fd*ab/(inc))
End If
#endmacro
Dim As Single fd=map(0,100,fade,1,0)
Dim As Integer _x,_y
Imageinfo tim,_x,_y
Dim As Ulong Pointer im=Imagecreate(_x,_y)
Dim As Integer pitch
Dim As Any Pointer row
Dim As Ulong Pointer pixel
Dim As Ulong col
Imageinfo tim,,,,pitch,row
Dim As p2 NewPoints(_x-1,_y-1)
For y As Long=0 To (_y)-1
For x As Long=0 To (_x)-1
p_point(x,y,col)
NewPoints(x,y)=Type<p2>(x,y,col)
Next x
Next y
Dim As Ulong averagecolour
Dim As Long ar,ag,ab
Dim As Long xmin,xmax,ymin,ymax,inc
Imageinfo im,,,,pitch,row
For y As Long=0 To _y-1
For x As Long=0 To _x-1
average()
ppset((NewPoints(x,y).x),(NewPoints(x,y).y),averagecolour)
Next x
Next y
If destroy Then Imagedestroy tim: tim = 0
Function= im
End Function
Function settexture(image As Any Ptr) As gluint
Dim As gluint texture
glGenTextures(1, @texture)
glBindTexture( GL_TEXTURE_2D, texture )
glTexImage2d( GL_TEXTURE_2D, 0, GL_RGBA, Cast(fb.image Ptr, image)->Width, Cast(fb.image Ptr, image)->height, 0, GL_BGRA, GL_UNSIGNED_BYTE, image+Sizeof(fb.image) )
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)
Return texture
End Function
Sub GLsetup
glViewport 0,0,xres,yres
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 45,xres/yres,1,100
glMatrixMode GL_MODELVIEW
glLoadIdentity
glShadeModel GL_SMOOTH
glClearColor 0,.4,1,0
glClearDepth 1
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA)'''
glEnable GL_ALPHA
glEnable GL_BLEND
glLightfv GL_LIGHT1, GL_DIFFUSE, @LightDiffuse(0)
glLightfv GL_LIGHT1, GL_POSITION, @LightPosition(0)
glEnable GL_LIGHT1
'Enable lighting
glEnable GL_LIGHTING
glEnable GL_COLOR_MATERIAL
End Sub
'MY OWN ROTATE TO SET UP THE FACES
Type v3
As Single x,y,z
End Type
Operator + (v1 As V3,v2 As V3) As V3
Return Type(v1.x+v2.x,v1.y+v2.y,v1.z+v2.z)
End Operator
Operator * (f As Single,v1 As V3) As V3 'scalar*V3
Return Type(f*v1.x,f*v1.y,f*v1.z)
End Operator
Function RotatePoint(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)
End Function
'SET UP THE RINGFACES
Redim Shared As V3 a(1 To 4)
Dim Shared As V3 normals(1 To 52+1)
Dim As V3 ctr=Type(0,0,0) 'rotate about gl origin
Dim As Double z=1.207106781186547*2+14.4-.3 'z value of first face
Dim As Double r=2*4*Atn(1)/52
'first face (FRONT)
glTexCoord2f( 1,1)
a(1)=Type( 1, 1, z)
glTexCoord2f( 0,1)
a(2)=Type(-1, 1, z)
glTexCoord2f( 0,0)
a(3)=Type(-1,-1, z)
glTexCoord2f( 1,0)
a(4)=Type( 1,-1, z)
Var c=.5*(a(1)+a(3))
normals(1)=c
Dim As v3 sc=(1,1,1)
Dim Shared As v3 centroid(1 To 52+1),rt(1 To 52+1)
centroid(1)=Type(0,0,z)
For z As Long=1 To 52'7
Var n=Ubound(a)
Redim Preserve a(1 To Ubound(a)+4)
'rotate the faces, four corners at a time around (0,0,0), angle r
a(n+1)=RotatePoint(ctr,a(n+1-4),Type(0,r,0),sc)
a(n+2)=RotatePoint(ctr,a(n+2-4),Type(0,r,0),sc)
a(n+3)=RotatePoint(ctr,a(n+3-4),Type(0,r,0),sc)
a(n+4)=RotatePoint(ctr,a(n+4-4),Type(0,r,0),sc)
c=.5*(a(n+1)+a(n+3))
normals(z+1)=c
centroid(z+1)=.5*(a(n+1)+a(n+3))
Next z
For n As Long=1 To 52
Var l=Sqr(normals(n).x^2+normals(n).y^2 +normals(n).z^2)
normals(n)=(1/l)*normals(n) 'normalize
Next n
Sub drawstring(xpos As Long,ypos As Long,text As String ,col As Ulong,size As Single,xres As Long,yres As Long) Export
glMatrixMode GL_PROJECTION 'save projection
glPushMatrix
glMatrixMode GL_MODELVIEW
glPushMatrix
glMatrixMode GL_PROJECTION 'make ortho
glLoadIdentity
glOrtho 0, xres, yres, 0,-1, 1
glMatrixMode GL_MODELVIEW
glLoadIdentity
#define Red(c) ((c) Shr 16 And 255)
#define Green(c) ((c) Shr 8 And 255)
#define Blue(c) ((c) And 255)
#define Alph(c) ((c) Shr 24)
glColor4ub Red(col),Green(col),Blue(col),alph(col)
glend
glpointsize(1.1*size)
glBegin (GL_POINTS)
Type D2
As Single x,y
End Type
Static As d2 cpt(),XY()
Static As Long runflag
If runflag=0 Then
Redim XY(128,127)
Redim cpt(1 To 64*2)
Screen 8
Width 640\8,200\16
Dim As Ulong Pointer img
Dim count As Long
For ch As Long=1 To 127
img=Imagecreate(640,200)
Draw String img,(1,1),Chr(ch)
For x As Long=1 To 8
For y As Long=1 To 16
If Point(x,y,img)<>0 Then
count=count+1
XY(count,ch)=Type<D2>(x,y)
End If
Next y
Next x
count=0
Imagedestroy img
Next ch
runflag=1
End If
If size=0 Then Exit Sub
Dim As D2 np,t
#macro Scale(p1,p2,d)
np.x=d*(p2.x-p1.x)+p1.x
np.y=d*(p2.y-p1.y)+p1.y
#endmacro
Dim As D2 c=Type<D2>(xpos,ypos)
Dim As Long dx=xpos,dy=ypos
For z6 As Long=1 To Len(text)
Var asci=text[z6-1]
For _x1 As Long=1 To 64*2
t=Type<D2>(XY(_x1,asci).x+dx,XY(_x1,asci).y+dy)
Scale(c,t,size)
cpt(_x1)=np
If XY(_x1,asci).x<>0 Then
If Abs(size)>0 Then
glVertex3f (cpt(_x1).x,(cpt(_x1).y),0)
End If
End If
Next _x1
dx=dx+8
Next z6
glend
glMatrixMode GL_PROJECTION 'restore
glPopMatrix
glMatrixMode GL_MODELVIEW
glPopMatrix
End Sub
Sub inittext Constructor
drawstring(0,0,"",0,0,0,0)
End Sub
Sub DrawFaces(Byval rotangle As Single,x As Single,y As Single,Byval Z As Single)
glEnable( GL_TEXTURE_2D )
Dim As Single pi=4*Atn(1)
glLoadIdentity()
glTranslatef(x,y,Z-5)
glrotatef(10,1,0,0)
glRotatef(rotangle,0,1,0) ' Rotate
Dim As Long n
glcolor4f(0,0,0,1)
For z As Long=1 To 52+1
glBindTexture(GL_TEXTURE_2D, tex(z))
glBegin(GL_QUADS)
rt(z)=RotatePoint(Type(0,0,0),centroid(z),Type(0,rotangle*pi/180,0),Type(1,1,1))
glNormal3f normals(z).x,normals(z).y,normals(z).z
glTexCoord2f( 1,0)'1 0
glVertex3f(a(n+1).x,a(n+1).y,a(n+1).z)
glTexCoord2f( 0,0)'0 0
glVertex3f(a(n+2).x,a(n+2).y,a(n+2).z)
glTexCoord2f(0,1)'0 1
glVertex3f(a(n+3).x,a(n+3).y,a(n+3).z)
glTexCoord2f(1,1)'1 1
glVertex3f(a(n+4).x,a(n+4).y,a(n+4).z)
n=n+4
glend
Next z
glend
gldisable( GL_TEXTURE_2D )
End Sub
Sub Cube(Byref rotangle As Single)
Var k=5
glLoadIdentity()
glTranslatef(0,-.7,-32)
glRotatef(rotangle,1,1,1) ' Rotate
glBegin(GL_QUADS)
glcolor4ub 255,0,0,255
glNormal3f 0,1,0
glVertex3f( K*1.0, K*1.0,-K*1.0) ' Top right of the quad (top)
glVertex3f(-K*1.0, K*1.0,-K*1.0) ' Top left of the quad (top)
glVertex3f(-K*1.0, K*1.0, K*1.0) ' Bottom left of the quad (top)
glVertex3f( K*1.0, K*1.0, K*1.0) ' Bottom right of the quad (top)
glcolor4ub 255,100,0,255
glNormal3f 0,-1,0
glVertex3f( K*1.0,-K*1.0, K*1.0) ' Top right of the quad (bottom)
glVertex3f(-K*1.0,-K*1.0, K*1.0) ' Top left of the quad (bottom)
glVertex3f(-K*1.0,-K*1.0,-K*1.0) ' Bottom left of the quad (bottom)
glVertex3f( K*1.0,-K*1.0,-K*1.0) ' Bottom right of the quad (bottom)
glcolor4ub 255,0,255,255
glNormal3f 0,0,1
glVertex3f( K*1.0, K*1.0, K*1.0) ' Top right of the quad (front)
glVertex3f(-K*1.0, K*1.0, K*1.0) ' Top left of the quad (front)
glVertex3f(-K*1.0,-K*1.0, K*1.0) ' Bottom left of the quad (front)
glVertex3f( K*1.0,-K*1.0, K*1.0) ' Bottom right of the quad (front)
glcolor4ub 0,0,200,255
glNormal3f 0,0,-1
glVertex3f( K*1.0,-K*1.0,-K*1.0) ' Bottom left of the quad (back)
glVertex3f(-K*1.0,-K*1.0,-K*1.0) ' Bottom right of the quad (back)
glVertex3f(-K*1.0, K*1.0,-K*1.0) ' Top right of the quad (back)
glVertex3f( K*1.0, K*1.0,-K*1.0) ' Top left of the quad (back)
glcolor4ub 0,255,0,255
glNormal3f -1,0,0
glVertex3f(-K*1.0, K*1.0, K*1.0) ' Top right of the quad (left)
glVertex3f(-K*1.0, K*1.0,-K*1.0) ' Top left of the quad (left)
glVertex3f(-K*1.0,-K*1.0,-K*1.0) ' Bottom left of the quad (left)
glVertex3f(-K*1.0,-K*1.0, K*1.0) ' Bottom right of the quad (left)
glcolor4ub 255,0,100,255
glNormal3f 1,0,0
glVertex3f( K*1.0, K*1.0,-K*1.0) ' Top right of the quad (right)
glVertex3f( K*1.0, K*1.0, K*1.0) ' Top left of the quad (right)
glVertex3f( K*1.0,-K*1.0, K*1.0) ' Bottom left of the quad (right)
glVertex3f( K*1.0,-K*1.0,-K*1.0)
glend
End Sub
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
Dim As Any Ptr face(52)
Dim As String s= " Around the Sphere started by UEZ. "
s+="OpenGL on a ring "
s+=s
For n As Long=1 To Ubound(face)
face(n)=Imagecreate(128,128,Rgba(200,200,200,255))
Drawstringgfx(10,20,Mid(s,n,1),Rgba(0,0,0,255),6,face(n))
face(n)=filter(face(n),1)
Next n
For n As Long=1 To 52
tex(n)=settexture(face(n))
Next n
glsetup
Dim As Long fps
Dim As Single angle3
Dim As String ink
Windowtitle "---"
Dim As Single zz=-30 - (xres/275)
Do
ink=Inkey
angle3+=3
glClear(GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT)
drawstring(20,50,"fps = " + Str(fps) ,Rgb(0,0,0),1,xres,yres)
drawstring(20,80,"Press <esc> to end . . . ",Rgb(0,0,0),1,xres,yres)
glEnable (GL_CULL_FACE)
cube(angle3/5)
gldisable (GL_CULL_FACE)
DrawFaces(-angle3/10,0,0,zz)
Flip
Sleep regulate(60,fps),1
Loop Until ink=Chr(27)
#ifdef __FB_WIN32__
speak ("goodbye")
#endif
For a As Longint = 1 To 52
Imagedestroy face(a)
Next
End
badidea wrote:File encoding needs to be ISO-8859-1, not UTF-8. Or at least, when I set that in Geany, it works.
And fTimer should to be double.
Roland Chastain wrote:Yes, it works for me too.
dodicat wrote:I cannot get transparency on an openGL texture (yet), but I am working on it.
So the text is on a strip (which should be transparent, but I am fed up messing about just now)
UEZ wrote:badidea wrote:File encoding needs to be ISO-8859-1, not UTF-8. Or at least, when I set that in Geany, it works.
And fTimer should to be double.
I can vague remember that we had this discussion already some times ago because of Base128 en-/decoding issues.
badidea wrote:UEZ wrote:badidea wrote:File encoding needs to be ISO-8859-1, not UTF-8. Or at least, when I set that in Geany, it works.
And fTimer should to be double.
I can vague remember that we had this discussion already some times ago because of Base128 en-/decoding issues.
Yes, here: Twister Effect build 2020-04-15
As written above, the downloaded source compiles and runs perfectly. It is only the copy & paste version that didn't run. Now I tried again, and it works - mysteries of Windows...dodicat wrote:Are you having compiler / ide problems again jj2007?
Users browsing this forum: No registered users and 3 guests