Did you know that on an opengl screen (line 15 ish) the winapi buttons and fonts work.
Code: Select all
#include "windows.bi"
#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 1,1,1,1
End Sub
Screen 20,32,,2
setupgl
Dim Shared As Long wire,solid,glass
Type pt
As Double x,y,z
End Type
Type triangle
As pt p(0 To 2)
As pt ctr
As Ulong col
As pt norm
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
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 pt,p As pt,a As Angle3D,scale As pt=Type(1,1,1)) As pt
Dim As Single dx=p.x-c.x,dy=p.y-c.y,dz=p.z-c.z
Return Type<pt>((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 pt,eyepoint As pt) As pt
Dim As Single w=1+(p.z/eyepoint.z)
Return Type<pt>((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(p As pt,v2 As Pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
Dim As Single d1=Sqr(p.x*p.x + p.y*p.y+ p.z*p.z),d2=Sqr(v2.x*v2.x + v2.y*v2.y +v2.z*v2.z)
Dim As Single v1x=p.x/d1,v1y=p.y/d1,v1z=p.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)
End Function
Sub drawpolygon(p() As pt, c As Ulong)
Var col=Cptr(Ubyte Ptr,@c)
glcolor4ub(col[2],col[1],col[0],255)
Dim k As Long=Ubound(p)+1
Dim As Long index,nextindex
For n As Long=Lbound(p) To Ubound(p)
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=Lbound(p)
glvertex2d(p(index).x,p(index).y)
glvertex2d(p(nextindex).x,p(nextindex).y)
Next
End Sub
Sub fill(p() As Pt,c As Ulong,im As Any Ptr=0,flag As Long)
Var col=Cptr(Ubyte Ptr,@c)
glcolor4ub(col[2],col[1],col[0],150)
If glass Then glcolor4ub(0,0,50,55)
glbegin gl_lines
#define ub Ubound
Dim As Long Sy=1e6,By=-1e6,i,j,y,k
Dim As Single a(Ub(p)+1,1),dx,dy
For i =0 To Ub(p)
a(i,0)=p(i).x
a(i,1)=p(i).y
If Sy>p(i).y Then Sy=p(i).y
If By<p(i).y Then By=p(i).y
Next i
Dim As Single xi(Ub(a,1)),S(Ub(a,1))
a(Ub(a,1),0) = a(0,0)
a(Ub(a,1),1) = a(0,1)
For i=0 To Ub(a,1)-1
dy=a(i+1,1)-a(i,1)
dx=a(i+1,0)-a(i,0)
If dy=0 Then S(i)=1
If dx=0 Then S(i)=0
If dy<>0 Andalso dx<>0 Then S(i)=dx/dy
Next i
For y=Sy-1 To By+1
k=0
For i=0 To Ub(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)=(a(i,0)+S(i)*(y-a(i,1)))
k+=1
End If
Next i
For j=0 To k-2
For i=0 To k-2
If xi(i)>xi(i+1) Then Swap xi(i),xi(i+1)
Next i
Next j
For i = 0 To k - 2 Step 2
If wire=0 Or glass=1 Then
glvertex2d(xi(i)+1,y)
glvertex2d(xi(i+1)+1-1,y)
End If
Next i
Next y
If wire=1 Then
drawpolygon(p(),Rgb(0,0,0))
Else
If flag =0 And solid=0 Then drawpolygon(p(),Rgb(255,255,255))
End If
glend
End Sub
Sub blow(d() As pt,t As pt,m As Double)
For n As Long=1 To 12
d(n).x=(d(n).x)*m+t.x
d(n).y=(d(n).y)*m+t.y
d(n).z=(d(n).z)*m+t.z
Next
End Sub
Sub setup(p() As triangle,d() As pt,colours() As Ulong)
Dim As Long i
Dim As Double cx,cy,cz
Dim As pt centre=Type(1024\2,768\2,0)
For n As Long=1 To 20
cx=0:cy=0:cz=0
For k As Long=0 To 2
Read i
p(n).p(k)=d(i)
cx+=d(i).x
cy+=d(i).y
cz+=d(i).z
Next k
p(n).ctr=Type(cx/3,cy/3,cz/3)
p(n).norm=Type(p(n).ctr.x-centre.x,p(n).ctr.y-centre.y,p(n).ctr.z-centre.z)
p(n).col=colours(n)
Next n
End Sub
Sub show(p() As triangle)
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Dim As Long flag
Dim As pt lightsource
lightsource=Type(.5,0,.5)
For n As Long=Lbound(p) To Ubound(p)
If n<=10 Then flag=1 Else flag=0
Var col=Cptr(Ubyte Ptr,@p(n).col)
Dim As Single dt=dot(p(n).norm,lightsource)
Var dtt=map(1,-1,dt,0,1)
Dim As Ulong clr=Rgba(dtt*col[2],dtt*col[1],dtt*col[0],150)
fill(p(n).p(),clr,0,flag)
Next n
End Sub
Sub sort(p() As triangle)
For n1 As Long =Lbound(p) To Ubound(p)-1
For n2 As Long=n1+1 To Ubound(p)
If p(n1).ctr.z<p(n2).ctr.z Then Swap p(n1),p(n2)
Next n2
Next n1
End Sub
Function Regulate(Byval MyFps As Long,Byref fps As Long=0) 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
Sub setcolours(colours() As Ulong,colour As Ulong=Rgb(100,255,0))
Randomize 2
For n As Long=1 To 20
colours(n)=Rgba(Rnd*255,Rnd*255,Rnd*255,15)
Next n
End Sub
Function Set_Font (Font As String,Size As Long,Bold As Long,Italic As Long,Underline As Long,StrikeThru As Long) As HFONT
Dim As HDC hDC=GetDC(HWND_DESKTOP)
Dim As Long CyPixels=GetDeviceCaps(hDC,LOGPIXELSY)
ReleaseDC(HWND_DESKTOP,hDC)
Return CreateFont(0-(Size*CyPixels)/72,0,0,0,Bold,Italic,Underline,StrikeThru,ANSI_CHARSET _
,OUT_TT_PRECIS,CLIP_DEFAULT_PRECIS,DEFAULT_QUALITY,FF_DONTCARE,Font)
End Function
'===============================================================================
Dim As pt d(1 To 12)={ _
(0.000000,-0.525731,0.850651), _
(0.850651,0.000000,0.525731), _
(0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,-0.525731), _
(-0.850651,0.000000,0.525731), _
(-0.525731,0.850651,0.000000), _
(0.525731,0.850651,0.000000), _
(0.525731,-0.850651,0.000000), _
(-0.525731,-0.850651,0.000000), _
(0.000000,-0.525731,-0.850651), _
(0.000000,0.525731,-0.850651), _
(0.000000,0.525731,0.850651)}
Dim As Ulong colours(1 To 20)
Dim As triangle p(1 To 20),rot(1 To 20)
blow(d(),Type(1024\2,768\2,0),200)
setcolours(colours())
setup(p(),d(),colours())
Dim As Angle3D A3d
Dim As pt ang
Dim As pt c=Type(1024\2,768\2,0)
Dim As Long mx,my,btn
Color ,Rgb(255,255,255)
Dim Win As Any Ptr
Screencontrol 2, *Cptr(Integer Ptr,@Win )
Dim Shared As HFONT ThisFont:ThisFont=Set_Font("Times new roman",16,0,0,0,0)
Var Cc=CreateWindowEx(0,"button","alpha", WS_VISIBLE Or WS_CHILD,0,0,70,30,win,0,0,0)
Var Dd=CreateWindowEx(0,"Button","solid", WS_VISIBLE Or WS_CHILD,70,0,70,30,win,0,0,0)
Var c1=CreateWindowEx(0,"STATIC","", WS_VISIBLE Or WS_CHILD ,150,650,300,40,win,0,0,0)
Var Ee=CreateWindowEx(0,"Button","wire",WS_BORDER Or WS_VISIBLE Or WS_CHILD,140,0,70,30,win,0,0,0)
Var Gg=CreateWindowEx(0,"Button","glass",WS_BORDER Or WS_VISIBLE Or WS_CHILD,210,0,70,30,win,0,0,0)
SendMessage(Cc,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Dd,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Ee,WM_SETFONT,Cast(WPARAM,ThisFont),0)
SendMessage(Gg,WM_SETFONT,Cast(WPARAM,ThisFont),0)
ThisFont=Set_Font("Times new roman",26,0,0,0,0)
SendMessage(C1,WM_SETFONT,Cast(WPARAM,ThisFont),0)
Dim As msg msg
Dim As Long flag,fps
While true
While (PeekMessage (@Msg, NULL, 0, 0, PM_REMOVE) > 0)
TranslateMessage (@Msg)
DispatchMessage (@Msg)
Select Case msg.hwnd
Case Cc 'alpha
Select Case msg.message
Case WM_LBUTTONDOWN
wire=0
solid=0
glass=0
glEnable (GL_BLEND)
End Select
Case Dd 'solid
Select Case msg.message
Case WM_LBUTTONDOWN
wire=0
solid=1
glass=0
gldisable (GL_BLEND)
End Select
Case Ee
Select Case msg.message
Case WM_LBUTTONDOWN
wire=1
solid=0
glass=0
End Select
Case Gg 'glass
Select Case msg.message
Case WM_LBUTTONDOWN
wire=1
'solid=1
glass=1
glEnable (GL_BLEND)
End Select
Case Else
setwindowtext(C1,"framerate = "+Str(fps))
End Select
If Inkey=Chr(255)+"k" Then End
Wend
ang.x+=.03/2 'the orbiting speed
ang.y+=.02/2
ang.z+=.01/2
A3D=Angle3D.construct(ang.x,ang.y,ang.z)
For n As Long=1 To 20
For m As Long=0 To 2
rot(n).p(m)=Rotate(c,p(n).p(m),A3D)
rot(n).p(m)=perspective(rot(n).p(m),Type(1024\2,768\2,2000))
Next m
rot(n).ctr=Rotate(c,p(n).ctr,A3D)
rot(n).norm=Type(rot(n).ctr.x-c.x,rot(n).ctr.y-c.y,rot(n).ctr.z)
rot(n).col=p(n).col
Next n
sort(rot())
glClear(GL_COLOR_BUFFER_BIT)
show(rot())
Flip
Sleep regulate(60,fps),1
Wend
triangles:
Data _
2,3, 7, _
2, 8, 3, _
4, 5, 6, _
5, 4, 9, _
7, 6, 12, _
6, 7, 11, _
10, 11, 3, _
11, 10, 4, _
8, 9, 10, _
9, 8, 1, _
12, 1, 2, _
1, 12, 5, _
7, 3, 11, _
2, 7, 12, _
4, 6, 11, _
6, 5, 12, _
3, 8, 10, _
8, 2, 1, _
4, 10, 9, _
5, 9, 1
