OpenGL intersection of two objects

General FreeBASIC programming questions.
Post Reply
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

OpenGL intersection of two objects

Post by UEZ »

Any idea how to display only the intersection of two objects?

Example below from here: http://other.paul-grunewald.de/ogl/

Code: Select all

' Einbindung von OpenGL
#include once "GL/gl.bi"
#include once "GL/glu.bi"

' Festlegung der Konstanten, die für den Bildschirm wichtig sind
const scrnX = 640
const scrnY = 480
const depth = 32
const fullscreen = &h0           ' Vollbildmodus ( &h0 = aus, &h1 = an )

screenres scrnX,scrnY,depth,,&h2 OR fullscreen

' Konfiguration von OpenGL
glMatrixMode(GL_PROJECTION)      ' Matrix definieren
glLoadIdentity
glViewport(0,0,scrnX,scrnY)      ' Achse festlegen
glOrtho(0,scrnX,scrnY,0,-128,128)
glMatrixMode(GL_MODELVIEW)       ' Deaktivierung des Rendern der Rückseiten
glEnable(GL_CULL_FACE)
glCullFace(GL_BACK)
glEnable GL_TEXTURE_2D           ' Texturen aktivieren
glLoadIdentity
glEnable(GL_DEPTH_TEST)          ' Tiefentest
glDepthFunc(GL_LESS)
glEnable(GL_ALPHA_TEST)          ' Alphatest
glAlphaFunc(GL_GREATER, 0.1)

do
  glClear  GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT

	' Quadrat A
	glTranslatef 100,100,0       ' z = 0
	glColor3ub 255,0,0 ' rotes Quadrat (A)
	glBegin GL_QUADS
		glVertex2i  0, 50    '' LINKS UNTEN  (1. Koordinate)
		glVertex2i 50, 50    '' RECHTS UNTEN (2. Koordinate)
		glVertex2i 50,  0    '' RECHTS OBEN  (3. Koordinate)
		glVertex2i  0,  0    '' LINKS OBEN   (4. Koordinate)
	glEnd

	glLoadIdentity

	' Quadrat B
	glTranslatef 125,125,1       ' z = 1
	glColor3ub 0,0,255 ' blaues Quadrat (B)
	glBegin GL_QUADS
		glVertex2i  0, 50    '' LINKS UNTEN  (1. Koordinate)
		glVertex2i 50, 50    '' RECHTS UNTEN (2. Koordinate)
		glVertex2i 50,  0    '' RECHTS OBEN  (3. Koordinate)
		glVertex2i  0,  0    '' LINKS OBEN   (4. Koordinate)
	glEnd

	glLoadIdentity

  glFlush ' Verarbeitung der Befehle
  flip
  screensync
loop until multikey(&h01) ' Verlasse die Schleife sobald Escape gedrückt wird
Image
images upload

Only the marked yellow area (blue square) in the middle of these two objects?

Thanks.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: OpenGL intersection of two objects

Post by dodicat »

This is a bit cheesy (2d co-ordinate geometry)
Press space key to refresh

Code: Select all

 ' Einbindung von OpenGL

Type Point
    As double x,y
End Type

Type Line
    As Point s,f
End Type

function range(f as long,L as long) as long
return  int(Rnd*(l+1)-f)+f
end function

Function isleft(L As Line,p As Point) As Long 'for function intersect
    Return  Sgn((L.s.x-L.f.x)*(p.y-L.f.y)-(p.x-L.f.x)*(L.s.y-L.f.y))<0
End Function

Function intersect(L1 As Line,L2 As Line) As Long 'do 2 lines intersect?
    If isleft(L2,L1.s) = isleft(L2,L1.f) Then Return 0 
    If isleft(L1,L2.s) = isleft(L1,L2.f) Then Return 0
    Return -1
End Function

Function intersection(L1 As Line,L2 As Line) As Point 'point of intersection of 2 lines
    dim as double z=(L1.f.x-L1.s.x):if z=0 then z=1e-6
    Var M1=(L1.f.y-L1.s.y)/z
    z=(L2.f.x-L2.s.x):if z=0 then z=1e-6
    Var M2=(L2.f.y-L2.s.y)/z
    z=(L1.f.x-L1.s.x):if z=0 then z=1e-6
    Var C1=(L1.s.y*L1.f.x-L1.s.x*L1.f.y)/z
    z=(L2.f.x-L2.s.x):if z=0 then z=1e-6
    Var C2=(L2.s.y*L2.f.x-L2.s.x*L2.f.y)/z
     z=iif (M1-M2<>0,M1-M2,1e-6)
    Return Type((C2-C1)/z,(M1*C2-M2*C1)/z)
End Function

Function inpolygon(p1() As Point,byval p2 As Point) As integer 'is a point in a polygon?
    #define Winder(L1,L2,p) ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1 
        Else
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

'polygon/polygon intersections to ret()
function intersections(p1() as point,p2() as point,ret() as point) as long
    redim ret(0)
    redim as line x(0),y(0)
    'do the edge intersections
    for n as long=lbound(p1) to ubound(p1)-1
        redim preserve x(1 to ubound(x)+1)
        x(ubound(x))=type<line>(p1(n),p1(n+1))
    next
     redim preserve x(1 to ubound(x)+1)
        x(ubound(x))=type<line>(p1(ubound(p1)),p1(lbound(p1)))  
        
     for n as long=lbound(p2) to ubound(p2)-1
        redim preserve y(1 to ubound(y)+1)
        y(ubound(y))=type<line>(p2(n),p2(n+1))
    next
     redim preserve y(1 to ubound(y)+1)
        y(ubound(y))=type<line>(p2(ubound(p2)),p2(lbound(p2)))  
    for n as long=lbound(x) to ubound(x)
        for m as long=lbound(y) to ubound(y) 
            If intersect(x(n),y(m)) Then 
        var p=intersection(x(n),y(m))
        redim preserve ret(1 to ubound(ret)+1)
        ret(ubound(ret))=p
      end if
next
next
'do the vertex intersections 
for n as long=lbound(p1) to ubound(p1)
    if inpolygon(p2(),p1(n)) then
         redim preserve ret(1 to ubound(ret)+1)
        ret(ubound(ret))=p1(n)
        end if
 next n
 for n as long=lbound(p2) to ubound(p2)
    if inpolygon(p1(),p2(n)) then
         redim preserve ret(1 to ubound(ret)+1)
        ret(ubound(ret))=p2(n)
        end if
 next n
 dim as point C '-- get centroid
 dim as long counter
 for n as long=lbound(ret) to ubound(ret)
     counter+=1
     c.x+=ret(n).x
     c.y+=ret(n).y
 next n
 c.x=c.x/counter
 c.y=c.y/counter
 'to suit anti clockwise quad points
 For p1 as long  = lbound(ret) To ubound(ret)-1
    For p2 as long  = p1 + 1 To ubound(ret)
        if atan2(ret(p1).y-c.y,ret(p1).x-c.x)< atan2(ret(p2).y-c.y,ret(p2).x-c.x) then
            swap ret(p1),ret(p2)
            end if
         Next p2
    Next p1
return ubound(ret)
end function

#include once "GL/gl.bi"
#include once "GL/glu.bi"

' Festlegung der Konstanten, die für den Bildschirm wichtig sind
const scrnX = 1024
const scrnY = 768
const depth = 32
const fullscreen = &h0           ' Vollbildmodus ( &h0 = aus, &h1 = an )
'create an opengl quad
sub makequad(q() as point)
    q(1)=type<point>(rnd*scrnx/2,rnd*scrny/2)
    q(2)=type<point>(q(1).x, range(q(1).y,scrny))
    q(3)=type<point>(range(q(2).x,scrnx),q(2).y)
    q(4)=type<point>(q(3).x,q(1).y)
end sub

screenres scrnX,scrnY,depth,,&h2 'OR fullscreen

'minimum for ortho
glMatrixMode GL_PROJECTION
glOrtho 0, scrnx, scrny, 0,-1, 1
glMatrixMode GL_MODELVIEW

'========
dim as string key
redim as point q1(1 to 4),q2(1 to 4),ret()
makequad q1():makequad q2()
windowtitle "PRESS SPACE KEY"
do
  key=inkey 
  if key=" " then makequad q1():makequad q2():key=""   ''refresh random quads
  glClear  GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT

   ' Quadrat A
  
   glColor3ub 255,0,0 ' rotes Quadrat (A)
   glBegin GL_QUADS                        
      glVertex2i q1(1).x,q1(1).y' 0, 50    '' top left     (1. Koordinate)
      glVertex2i q1(2).x,q1(2).y'50, 50    '' bottom left  (2. Koordinate)
      glVertex2i q1(3).x,q1(3).y'50,  0    '' bottom right (3. Koordinate)
      glVertex2i q1(4).x,q1(4).y' 0,  0    '' top right    (4. Koordinate)
   glEnd
   ' Quadrat B
   
   glColor3ub 0,0,255 ' blaues Quadrat (B)
   glBegin GL_QUADS                       '' as above
    glVertex2i q2(1).x,q2(1).y' 0, 50    '' (1. Koordinate)
    glVertex2i q2(2).x,q2(2).y'50, 50    '' (2. Koordinate)
    glVertex2i q2(3).x,q2(3).y'50,  0    '' (3. Koordinate)
    glVertex2i q2(4).x,q2(4).y' 0,  0    '' (4. Koordinate)
   glEnd
   
   if intersections (q1(),q2(),ret()) then
    glColor3ub 0,255,0             ' green intersection Quadrat (C)
    glBegin GL_QUADS
    glVertex2i (ret(1).x),(ret(1).y)' 0, 50    ''  anti clockwise order
    glVertex2i (ret(2).x),(ret(2).y)'50, 50    ''  
    glVertex2i (ret(3).x),(ret(3).y)'50,  0    ''  
    glVertex2i (ret(4).x),(ret(4).y)' 0,  0    ''  
   glEnd
   
       end if

   glLoadIdentity

  glFlush ' Verarbeitung der Befehle
  flip
  screensync
loop until multikey(&h01) ' Verlasse die Schleife sobald Escape gedrückt wird 
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

This the job for the stencil buffer.

You have to learn how to set the rules of the stencil buffer.

If the red quad are drawn then the value in stencil buffer are incremented odd (1)
If the blue quad are drawn then the value in stencil buffer are incremented odd (1)
the parts where the quads are overlapped are even (2)

The rule don't draw the odd pixels must be selected.

Search for "stencil buffer tutorial"

Joshy
Last edited by D.J.Peters on Apr 08, 2018 6:38, edited 1 time in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: OpenGL intersection of two objects

Post by dodicat »

Simple polygon intersection by geometry.
Use opengl for colouring only

Code: Select all

Randomize
#include once "GL/gl.bi"
#include once "GL/glu.bi"
Type Point
    As Double x,y
End Type

Type Line
    As Point s,f
End Type

Function range(f As Long,L As Long) As Long
    Return Int(Rnd*((l+1)-(f))+(f))
End Function

Function isleft(L As Line,p As Point) As Long 'for function intersect
    Return  Sgn((L.s.x-L.f.x)*(p.y-L.f.y)-(p.x-L.f.x)*(L.s.y-L.f.y))<0
End Function

Function intersect(L1 As Line,L2 As Line) As Long 'do 2 lines intersect?
    If isleft(L2,L1.s) = isleft(L2,L1.f) Then Return 0 
    If isleft(L1,L2.s) = isleft(L1,L2.f) Then Return 0
    Return -1
End Function

Function intersection(L1 As Line,L2 As Line) As Point 'point of intersection of 2 lines
    Dim As Double z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
    Var M1=(L1.f.y-L1.s.y)/z
    z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
    Var M2=(L2.f.y-L2.s.y)/z
    z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
    Var C1=(L1.s.y*L1.f.x-L1.s.x*L1.f.y)/z
    z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
    Var C2=(L2.s.y*L2.f.x-L2.s.x*L2.f.y)/z
    z=Iif (M1-M2<>0,M1-M2,1e-6)
    Return Type((C2-C1)/z,(M1*C2-M2*C1)/z)
End Function

Function inpolygon(p1() As Point,Byval p2 As Point) As Integer 'is a point in a polygon?
    #define Winder(L1,L2,p) ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
    For n As Integer=1 To Ubound(p1)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        If p1(index).y<=p2.y Then
            If p1(nextindex).y>p2.y Andalso  Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1 
        Else
            If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
        End If
    Next n
    Return wn
End Function

'polygon/polygon intersections to ret()
Function intersections(p1() As Point,p2() As Point,ret() As Point) As Long
    Redim ret(0)
    Redim As Line x(0),y(0)
    'do the edge intersections
    For n As Long=Lbound(p1) To Ubound(p1)-1
        Redim Preserve x(1 To Ubound(x)+1)
        x(Ubound(x))=Type<Line>(p1(n),p1(n+1))
    Next
    Redim Preserve x(1 To Ubound(x)+1)
    x(Ubound(x))=Type<Line>(p1(Ubound(p1)),p1(Lbound(p1)))  
    
    For n As Long=Lbound(p2) To Ubound(p2)-1
        Redim Preserve y(1 To Ubound(y)+1)
        y(Ubound(y))=Type<Line>(p2(n),p2(n+1))
    Next
    Redim Preserve y(1 To Ubound(y)+1)
    y(Ubound(y))=Type<Line>(p2(Ubound(p2)),p2(Lbound(p2)))  
    For n As Long=Lbound(x) To Ubound(x)
        For m As Long=Lbound(y) To Ubound(y) 
            If intersect(x(n),y(m)) Then 
                Var p=intersection(x(n),y(m))
                Redim Preserve ret(1 To Ubound(ret)+1)
                ret(Ubound(ret))=p
            End If
        Next
    Next
    'do the vertex intersections 
    For n As Long=Lbound(p1) To Ubound(p1)
        If inpolygon(p2(),p1(n)) Then
            Redim Preserve ret(1 To Ubound(ret)+1)
            ret(Ubound(ret))=p1(n)
        End If
    Next n
    For n As Long=Lbound(p2) To Ubound(p2)
        If inpolygon(p1(),p2(n)) Then
            Redim Preserve ret(1 To Ubound(ret)+1)
            ret(Ubound(ret))=p2(n)
        End If
    Next n
    Dim As Point C '-- get centroid
    Dim As Long counter
    For n As Long=Lbound(ret) To Ubound(ret)
        counter+=1
        c.x+=ret(n).x
        c.y+=ret(n).y
    Next n
    c.x=c.x/counter
    c.y=c.y/counter
    'to suit anti clockwise quad points
    For p1 As Long  = Lbound(ret) To Ubound(ret)-1
        For p2 As Long  = p1 + 1 To Ubound(ret)
            If Atan2(ret(p1).y-c.y,ret(p1).x-c.x)< Atan2(ret(p2).y-c.y,ret(p2).x-c.x) Then
                Swap ret(p1),ret(p2)
            End If
        Next p2
    Next p1
    Return Ubound(ret)
End Function

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 Getpolygon(n As Long=8,_      'number of sides
    centreX As Long,_               'centres
    centreY As Long,_
    size As Long=100,_              'size
    angle As Single=0,_             ' rotate
    ex As Single=1,_                'eccentricity on x plane 
    ey As Single=1,_                'eccentricity on y plane
    offset As Single=0,_            'offset initial angle
    p() As Point)                   'out array
    
    Redim p(1 To n)
    angle=angle*0.0174532925199433 'degrees to radians
    offset=offset*0.0174532925199433
    Dim slug As Single=6.283185307179586/n
    Dim As Single x1,y1
    Dim As Single x1r,y1r
    Dim As Long count
    Dim As Single cosangle=Cos(angle),sinangle=Sin(angle)
    For z As Single=0+offset To 6.283185307179586 +offset Step slug
        count+=1
        If count>n Then Exit For
        x1=centrex+ex*(size)*Cos(z)
        y1=centrey+ey*(size)*Sin(z)
        'now rotate
        x1r=(cosangle*(x1-centreX)-sinangle*(y1-centreY))+centreX
        y1r=(sinangle*(x1-centreX)+cosangle*(y1-centreY))+centreY
        p(count)=Type<Point>(x1r,y1r)
    Next z
End Sub

Dim As Integer scrnx=1024,scrny=768
Screenres scrnX,scrnY,32,,2 

'minimum for ortho
glMatrixMode GL_PROJECTION
glOrtho 0, scrnx, scrny, 0,-1, 1
gllinewidth 4


Redim As Point p(),q(),i()

Dim As Single a,ex1,ey1,ex2,ey2
Dim As String key
Dim As Long x1,y1,x2,y2,rad1,rad2,num1,num2,fps
'start settings
num1=5
x1=400
y1=300
rad1=150
ex1=1
ey1=1

num2=6
x2=400
y2=500
rad2=150
ex2=1
ey2=1


Windowtitle "PRESS SPACE KEY"
Do
    key=Inkey
    If key=" " Then
        key=""
        x1=range(200,700): x2=range(200,700)
        y1=range(200,600): y2=range(200,600)
        num1=range(3,9):num2=range(3,9)
        rad1=range(150,400):rad2=range(150,400)
    End If
    
    a+=.75   'angle
    Getpolygon(num1,x1,y1,rad1,a,ex1,ey1,,p()) 
    Getpolygon(num2,x2,y2,rad2,-a,ex2,ey2,,q())
    intersections(p(),q(),i())
    ' =======  use opengl to render only  ============
    glClear  GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
    glbegin gl_polygon
    glcolor3ub 200,0,0'draw red polygon
    For n As Long=Lbound(p) To Ubound(p)
        glvertex2i p(n).x,p(n).y
    Next
    glend
    glbegin gl_polygon
    glcolor3ub 0,0,200 'draw blue polygon
    For n As Long=Lbound(q) To Ubound(q)
        glvertex2i q(n).x,q(n).y
    Next
    glend
    
    'the intersected polygon
    glbegin gl_polygon 
     glcolor3ub(0,200,0) 'draw the intersection polygon
    For n As Long=Lbound(i) To Ubound(i)
        glvertex2i i(n).x,i(n).y
    Next
    glend
    
    glcolor3ub 200,200,255 'draw a border
    glbegin gl_lines
    For n As Long=Lbound(i) To Ubound(i)-1
        glvertex2i i(n).x,i(n).y
        glvertex2i i(n+1).x,i(n+1).y
    Next
    glvertex2i i(Ubound(i)).x,i(Ubound(i)).y
    glvertex2i i(Lbound(i)).x,i(Lbound(i)).y
    glend
    
    Flip
    Sleep regulate(60,fps),1
Loop Until key=Chr(27)




  
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: OpenGL intersection of two objects

Post by UEZ »

Thanks @dodicat and @Joshy for your replies and examples. I will check it out whether it fits to my needs.

The reason why I asked for it was that I want to create the OpenGL version of GDI+ Impossible Possible effect. The trickiest part it to merge the ends. With GDI+ I used some kind of textures which will be created first then the main form will be painted and afterwards the textured part will be over painted.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: OpenGL intersection of two objects

Post by UEZ »

Well, what I'm trying and it might be a naiv way is to draw first the magenta part which should be merged into the yellow section (only intersected part should be drawn). The yellow rectangle should be transparent that the magenta part is visible.

Code: Select all

#include once "GL/gl.bi"
#include once "GL/glu.bi"

#Define Min(a, b)	Iif(a < b, a, b)

Dim As String sTitle = "GDI+ Impossible Possible / FPS: "
WindowTitle sTitle

Const As UShort iW = 600, iH = iW, iWh = iW \ 2, iHh = iH \ 2
Const As ULong  iBGColor = &hFFFFFF

ScreenRes iW, iH, 32, , &h2 or &h0 
Color 0, iBGColor

Type tagRects
  x As Single
  y As Single
  a As Single
End Type

Const As Single fPi = Acos(-1), f2Pi = 2 * fPi, fRad = fPi / 180
Dim Shared As Ushort iQuantity

iQuantity = 180

Dim Shared As tagRects tRect(iQuantity)
Dim Shared As Single fRadius, fSize, fSize2, fOverlap, x1, y1, x2, y2, x3, y3, x4, y4, cx, cy, r, vx, vy

fRadius = Min(iW, iH) * 0.5
fSize = fRadius * 0.25
fOverlap = iQuantity * 0.1
fSize2 = fSize / 2

Dim As Ushort i, j, iFPS = 0

For i = 0 To iQuantity - 1
	tRect(i).x = (iWh - fSize2) + Cos(i / iQuantity * f2Pi) * (fRadius - fSize)
	tRect(i).y = (iHh - fSize2) + Sin(i / iQuantity * f2Pi) * (fRadius - fSize)
	tRect(i).a = i Shl 2 + i
Next

Dim As Single fTimer

glMatrixMode(GL_PROJECTION)      	' Matrix definieren
glViewport(0, 0, iW, iH)      		' Achse festlegen
glOrtho(0, iW, iH, 0, -1, 1)		' links oben ist 0, 0
glMatrixMode(GL_MODELVIEW)       	' Deaktivierung des Rendern der Rückseiten
glEnable(GL_CULL_FACE)
glCullFace(GL_BACK)
'glEnable(GL_TEXTURE_2D)           	' Texturen aktivieren
glLoadIdentity
glEnable(GL_DEPTH_TEST)          	' Tiefentest
glDepthFunc(GL_LESS)
glEnable(GL_ALPHA_TEST)          	' Alphatest
'glAlphaFunc(GL_GREATER, 0.5)
glClearColor(1.0, 1.0, 1.0, 0.5)
glEnable(GL_POLYGON_SMOOTH)
glShadeModel(GL_SMOOTH)



Do
	glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)

	
	For i = 0 To 0
		x1 = tRect(i).x
		y1 = tRect(i).y
		x2 = x1 + fSize
		y2 = y1 + fSize
		vx = (x2 - x1)
		vy = (y2 - y1)
		cx = x1 + vx / 2
		cy = y1 + vy / 2
		r = Sqr((y2 - y1) * (y2 - y1) + (x2 - x1) * (x2 - x1)) / 2
		
		x1 = cx + Cos(tRect(i).a * fRad) * r
		y1 = cy + Sin(tRect(i).a * fRad) * r
		x2 = cx + Cos((90 + tRect(i).a) * fRad) * r
		y2 = cy + Sin((90 + tRect(i).a) * fRad) * r
		x3 = cx + Cos((180 + tRect(i).a) * fRad) * r
		y3 = cy + Sin((180 + tRect(i).a) * fRad) * r
		x4 = cx + Cos((270 + tRect(i).a) * fRad) * r
		y4 = cy + Sin((270 + tRect(i).a) * fRad) * r

		glPolygonMode(GL_FRONT, GL_FILL)
		glColor4f(1.0, 1.0, 0.0, 0.5)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()	
		
		glPolygonMode(GL_FRONT, GL_LINE)
		glLineWidth(2)
		glColor4f(1.0, 0.0, 0.0, 1.0)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()				
		glFlush() ' Verarbeitung der Befehle
	Next

	
	For i = iQuantity - fOverlap To iQuantity - 1
		x1 = tRect(i).x
		y1 = tRect(i).y
		x2 = x1 + fSize
		y2 = y1 + fSize
		vx = (x2 - x1)
		vy = (y2 - y1)
		cx = x1 + vx / 2
		cy = y1 + vy / 2
		r = Sqr((y2 - y1) * (y2 - y1) + (x2 - x1) * (x2 - x1)) / 2
		
		x1 = cx + Cos(tRect(i).a * fRad) * r
		y1 = cy + Sin(tRect(i).a * fRad) * r
		x2 = cx + Cos((90 + tRect(i).a) * fRad) * r
		y2 = cy + Sin((90 + tRect(i).a) * fRad) * r
		x3 = cx + Cos((180 + tRect(i).a) * fRad) * r
		y3 = cy + Sin((180 + tRect(i).a) * fRad) * r
		x4 = cx + Cos((270 + tRect(i).a) * fRad) * r
		y4 = cy + Sin((270 + tRect(i).a) * fRad) * r

		glPolygonMode(GL_FRONT, GL_FILL)
		glColor4f(1.0, 0.0, 1.0, 1.0)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()	
		
		glPolygonMode(GL_FRONT, GL_LINE)
		glLineWidth(2)
		glColor4f(0.0, 0.0, 0.0, 1.0)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()				
		glFlush() ' Verarbeitung der Befehle
	Next
	
	

	For i = 0 To iQuantity - 1
		x1 = tRect(i).x
		y1 = tRect(i).y
		x2 = x1 + fSize
		y2 = y1 + fSize
		vx = (x2 - x1)
		vy = (y2 - y1)
		cx = x1 + vx / 2
		cy = y1 + vy / 2
		r = Sqr((y2 - y1) * (y2 - y1) + (x2 - x1) * (x2 - x1)) / 2
		
		x1 = cx + Cos(tRect(i).a * fRad) * r
		y1 = cy + Sin(tRect(i).a * fRad) * r
		x2 = cx + Cos((90 + tRect(i).a) * fRad) * r
		y2 = cy + Sin((90 + tRect(i).a) * fRad) * r
		x3 = cx + Cos((180 + tRect(i).a) * fRad) * r
		y3 = cy + Sin((180 + tRect(i).a) * fRad) * r
		x4 = cx + Cos((270 + tRect(i).a) * fRad) * r
		y4 = cy + Sin((270 + tRect(i).a) * fRad) * r

		glPolygonMode(GL_FRONT, GL_FILL)
		glColor4f(1.0, 1.0, 1.0, 1.0)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()	
		
		glPolygonMode(GL_FRONT, GL_LINE)
		glLineWidth(2)
		glColor4f(0.0, 0.0, 0.0, 1.0)
		glBegin(GL_POLYGON)
			glVertex2f (x4, y4)    '' LINKS UNTEN  (1. Koordinate)
			glVertex2f (x3, y3)    '' RECHTS UNTEN (2. Koordinate)
			glVertex2f (x2, y2)    '' RECHTS OBEN  (3. Koordinate)
			glVertex2f (x1, y1)    '' LINKS OBEN   (4. Koordinate)
		glEnd()		
		
		glFlush() ' Verarbeitung der Befehle
				
		
		tRect(i).a += 0.75
	Next

	
	Flip

    Sleep 1, 1	
	  	If Timer - fTimer > 0.99 Then
		WindowTitle sTitle & iFPS
		iFPS = 0
		fTimer = Timer
	Else
		iFPS += 1
	EndIf 
Loop Until Len(InKey())
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

With a GPU you don't need to calculate the rotation, translation and zooming on the CPU :-)

I don't changed the logic of your code
except tRect.x and tRect.y is now the center of the rectangle
but I removed ~70 lines of code ;-)

Joshy

Code: Select all

#lang "fb"                 ' Isn't QBASIC :-)
#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "crt.bi"     ' nice for PI cosf,sinf,sqrtf ...
#include once "fbgfx.bi"
using FB

' first declare consts (there are global also)
Const As Single  fPi = M_PI, f2Pi = M_PI*2, fRad = fPi / 180
Const as string  sTitle = "OpenGL Impossible Possible / FPS: "
Const As integer iW = 600, iH = iW, iWh = iW \ 2, iHh = iH \ 2
const as integer iQuantity = 180

' declare types
Type tagRects
  x As Single
  y As Single
  a As Single
End Type

' define macros
#Define Min(a, b) Iif((a) < (b), (a), (b))

' draw a 1x1 rectangle used fillcolor , linecolor
sub DrawQuad(fRed as single, fGreen as single, fBlue as single, fAlpha as single, _
             lRed as single, lGreen as single, lBlue as single, lAlpha as single)
  glPolygonMode(GL_FRONT, GL_FILL)
  glColor4f(fred,fgreen,fblue,falpha)
  glBegin(GL_QUADS)
    glVertex2f(-.5f, .5f)    '' LINKS UNTEN  (1. Koordinate)
    glVertex2f( .5f, .5f)    '' RECHTS UNTEN (2. Koordinate)
    glVertex2f( .5f,-.5f)    '' RECHTS OBEN  (3. Koordinate)
    glVertex2f(-.5f,-.5f)    '' LINKS OBEN   (4. Koordinate)
  glEnd()
  
  glPolygonMode(GL_FRONT, GL_LINE)
  glColor4f(lRed,lGreen,lBlue,lAlpha)
  glBegin(GL_QUADS)
    glVertex2f(-.5f, .5f)
    glVertex2f( .5f, .5f)
    glVertex2f( .5f,-.5f)
    glVertex2f(-.5f,-.5f)
  glEnd()
end sub  

'
' main
'
' dim vars
Dim As tagRects tRect(iQuantity)
Dim As Single fRadius, fSize, fSize2, fOverlap
Dim As integer iFrames,iFPS
' NOTE: timer values should be double
Dim As double tLast,tNow

fRadius = Min(iW, iH) * 0.5
fSize = fRadius * 0.25
fOverlap = iQuantity * 0.1
fSize2 = fSize / 2

' setup the center (not the top left corner) of the quads
For i as integer = 0 To iQuantity - 1
  tRect(i).x = iWh + Cosf(i / iQuantity * f2Pi) * (fRadius - fSize)
  tRect(i).y = iHh + Sinf(i / iQuantity * f2Pi) * (fRadius - fSize)
  tRect(i).a = i Shl 2 + i
Next

' Use our number crasher the GPU :-)
ScreenRes iW, iH, 32, ,GFX_OPENGL

' set visible region
glViewport(0,0,iW,iH)

glMatrixMode(GL_PROJECTION)
glLoadIdentity()

' Achse festlegen links oben ist 0, 0
glOrtho(0, iW, iH, 0, -1, 1)

glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
' Deaktivierung des Rendern der Rückseiten
glEnable(GL_CULL_FACE)
glCullFace(GL_BACK)
' Tiefentest
glEnable(GL_DEPTH_TEST)             
glDepthFunc(GL_LESS)
 ' Alphatest
glEnable(GL_ALPHA_TEST)
'glAlphaFunc(GL_GREATER, 0.5)
glClearColor(1.0, 1.0, 1.0, 0.5)

glEnable(GL_POLYGON_SMOOTH)
glShadeModel(GL_SMOOTH)

' set line size
glLineWidth(2)

Do
  tNow=Timer()
  glClear(GL_COLOR_BUFFER_BIT OR GL_DEPTH_BUFFER_BIT)
  glPushMatrix()
    glTranslatef(tRect(0).x,tRect(0).y, 0)
    glRotatef(tRect(0).a,0,0,1)
    glScalef(fSize,fSize,1)
    DrawQuad(1,1,0,0.5, 1,0,0,1)
  glPopMatrix()
   
  For i as integer = iQuantity - fOverlap To iQuantity - 1
    glPushMatrix()
      glTranslatef(tRect(i).x,tRect(i).y, 0)
      glScalef(fSize,fSize,1)
      glRotatef(tRect(i).a,0,0,1)
      DrawQuad(1,0,1,1, 0,0,0,1)     
    glPopMatrix()      
  Next  

  For i as integer = 0 To iQuantity - 1
    glPushMatrix()
      glTranslatef(tRect(i).x,tRect(i).y, 0)
      glScalef(fSize,fSize,1)
      glRotatef(tRect(i).a,0,0,1)
      DrawQuad(1,1,1,1 ,0,0,0,1)
    glPopMatrix()      
    tRect(i).a += 0.75
  Next
  
  Flip : iFrames+=1
  ' don't use Windotitle to often it's slow !
  if iFrames mod 60=0 then
    tNow=Timer() : iFPS=60/(tNow-tLast)
    WindowTitle sTitle & iFPS
    tLast=tNow
  End If
Loop Until Len(InKey())
Last edited by D.J.Peters on Apr 09, 2018 15:24, edited 1 time in total.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: OpenGL intersection of two objects

Post by UEZ »

Thanks Joshy - FPS increased dramatically :-)

glTranslatef and glRotatef are the magic functions. I knew that that are some equal functions to GDI+... ^^ but the hard math way was also funny...

No idea how to draw only the intersected area? I didn't get yet the stencil buffer stuff...
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

I changed DrawQuad a little bit see last post.

move the center of the rectangle to X,Y,0 (0 = ignore Z in 2D mode)
glTranslatef(tRect(i).x, tRect(i).y, 0)

scale the 1x1 rectangle to your defined X,Y,1 size (1 = ignore Z in 2D mode)
glScalef(fSize,fSize,1)

last but not least rotate (in degree) the rectangle around the Z-axis (-1 would rotate in opposite direction)
glRotatef(tRect(i).a, 0,0,1)

Happy GPU coding :-)

Joshy
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

warning spoiler alert

Joshy

Code: Select all

#lang "fb"                 ' Isn't QBASIC :-)
#include once "GL/gl.bi"
#include once "GL/glu.bi"
#include once "crt.bi"     ' nice for PI cosf,sinf,sqrtf ...

#include once "fbgfx.bi"
using FB

const as integer iQuantity = 500
const as integer iQuadSize = 100

Type tagRects
  As Single xPos,yPos,angle
End Type

function CreateQuad(size as single) as long 
  var s=size*0.5
  if s<10 then s=10
  var id=glGenLists(1)
  glNewList(id,GL_COMPILE)
  for i as integer=0 to 1
    if i=0 then
      glPolygonMode(GL_FRONT, GL_FILL)
      glColor3ub(254,254,254)
    else
      glPolygonMode(GL_FRONT, GL_LINE)
      glColor3ub(1,1,1)
    end if  
    glBegin(GL_QUADS)
      glVertex2f(-s, s) : glVertex2f( s, s)
      glVertex2f( s,-s) : glVertex2f(-s,-s)
    glEnd()
  next  
  glEndList()
  return id
end function  

'
' main
'

Dim As tagRects tRect(iQuantity)
Dim As Single fXRadius, fYRadius
Dim As integer iW,iH,iWh,iHh,iFrames,iFPS
Dim As double tLast,tNow
 
screeninfo iW,iH
iW*=0.8 : iH*=0.8 : iWh= iW shr 1 : iHh= iH shr 1

'ScreenControl SET_GL_DEPTH_BITS  ,24
'ScreenControl SET_GL_STENCIL_BITS, 8
ScreenRes iW, iH, 32, ,GFX_OPENGL ' or GFX_STENCIL_BUFFER

fXRadius = iWh-iQuadSize*0.75
fYRadius = iHh-iQuadSize*0.75

var Quad = CreateQuad(iQuadSize)

' setup the center of the quads
For i as integer = 0 to iQuantity-1
  var rad=(i / iQuantity) * M_PI*2
  with tRect(i)
    .xPos  = iWh + Cosf(rad) * fXRadius
    .yPos  = iHh + Sinf(rad*2) * fYRadius
    .angle = M_PI*2/iQuantity
  end with  
Next

var image = imagecreate(200,200,,32)
dim as any ptr pixels
imageinfo image,,,,,pixels

' set visible region
glViewport(0,0,iW,iH)

glMatrixMode(GL_PROJECTION)
glLoadIdentity()

' Achse festlegen links oben ist 0, 0
glOrtho(0, iW, iH, 0, -1, 1)

glMatrixMode(GL_MODELVIEW)
glLoadIdentity()
' Deaktivierung des Rendern der Rückseiten
glEnable(GL_CULL_FACE)
glCullFace(GL_BACK)
' Tiefentest
glEnable(GL_DEPTH_TEST)             
glDepthFunc(GL_LESS)
 ' Alphatest
glEnable(GL_ALPHA_TEST)
glAlphaFunc(GL_GREATER, 0.5)
' disable Z in 2D mode
glDisable(GL_DEPTH_TEST)

glPolygonMode(GL_FRONT, GL_FILL)
glEnable(GL_POLYGON_SMOOTH)
glShadeModel(GL_SMOOTH)

glHint( GL_LINE_SMOOTH_HINT, GL_NICEST )
glHint( GL_POLYGON_SMOOTH_HINT, GL_NICEST )

' set line size
glLineWidth(1)

glReadBuffer(GL_BACK)
glPixelStorei(GL_UNPACK_ALIGNMENT,1)

Do
  tNow=Timer()
  glClearColor(1,1,1,1)
  glClear(GL_COLOR_BUFFER_BIT)
  For i as integer = 0 to iQuantity-1
    with tRect(i)
      glPushMatrix()
        glTranslatef(.xPos,.yPos,0)
        glRotatef(.angle,0,0,1)
        glCallList(Quad)
      glPopMatrix()
      if i=32 then glReadPixels(iW-200,iHh-100,200,200,GL_RGBA,GL_UNSIGNED_BYTE,pixels)
      tRect(i).angle += 1
    end with  
  Next
  dim as ubyte ptr channel=pixels
  for i as integer=1 to 200*200
    ' if background color set the alpha channel to 0
    if *channel=&HFF then channel[3]=0
    channel+=4
  next  
  glRasterPos2i(iW-200,iHh+100)
  glDrawPixels(200,200,GL_RGBA,GL_UNSIGNED_BYTE,pixels)
  Flip : sleep 10
  iFrames+=1
  if iFrames mod 60=0 then
    tNow=Timer() : iFPS=60/(tNow-tLast)
    WindowTitle "fps: " & iFPS
    tLast=tNow
  End If
Loop Until Len(InKey())
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: OpenGL intersection of two objects

Post by UEZ »

I see you cracked it. Well done. :-)

Now I need to understand the OpenGL stuff in details and what you did...

Edit1: what I find out is that you copy a portion which fits to the area of start / end of the infinity.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

Change the code lines from row 125
and you will see the image.

Joshy

Code: Select all

for i as integer=1 to 200*200
    ' if background color then set the alpha channel to 0
    ' if *channel=&HFF then channel[3]=0
    if *channel=&HFF then channel[0]=255:channel[1]=0:channel[2]=255
    channel+=4
  next 
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

FBGFX only tiny but slower !

Joshy

Code: Select all

const as integer iNUM  = 180          ' number of QUADS
const as integer iSIZE = 100     ' iQUADSIZE
const as integer iHALF = iSize\2 ' iQUADSIZE\2
const as single  iMAX  = sqr(iSIZE*iSIZE+iSIZE*iSIZE) ' max QuadSize while rotating
const as string  sQUAD = "BH"&iHALF &"R"&iSIZE &"D"&iSIZE &"L"&iSIZE &"U"&iSIZE &"BF"&iHALF

sub DrawQuad(iX as integer,iY as integer, fAngle as single)
  dim as integer iAngle=abs(fAngle) : iAngle mod=360
  dim as string rec = "BM"&iX &","&iY &"TA"&iAngle &sQUAD
  dim as string cmd = "C7"&rec &"P7,7"&"C16"&rec &"P15,16"
  draw cmd
end sub

var sS=512 ' screen size
var sC=256 ' screen center
var sR=200 ' screen radius
dim as single angle,angleStart,angleStep=ATN(1)*4/iNUM
dim as ubyte ptr pixels,row,p
dim as integer   iPitch
screeninfo ,sS : sS*=0.9 : sC=sS\2
screenres sS,sS,,2 ' two pages we don't need screenlock/unlock
screenset 1,0 ' one page is the hidden workpage the other are shown
color 0,31
var img=imagecreate(iMAX,iMAX)
imageinfo img,,,,iPitch,pixels
sR = sC-iMAX/2
while inkey()=""
  cls
  angle=angleStart
  for i as integer=0 to iNUM-1
    var rad=(i/iNUM*2)*-ATN(1)*4
    DrawQuad(sc+cos(rad)*sR,sc+sin(rad)*sR,angle)
    if i=32 then
      get (sS-iMAX,sC-iMAX/2)-step(iMAX-1,iMAX-1),img
      row=pixels
      for y as integer=0 to iMax-1:
        p=row
        for x as integer=0 to iMax-1
          if *p=31 then *p=0
          p+=1
        next
        row+=iPitch
      next  
    end if  
    angle+=angleStep
  next
  put (sS-iMAX,sC-iMAX/2),img,TRANS
  flip
  angleStart+=1
  sleep 10
wend
Last edited by D.J.Peters on Apr 10, 2018 0:03, edited 2 times in total.
D.J.Peters
Posts: 8586
Joined: May 28, 2005 3:28
Contact:

Re: OpenGL intersection of two objects

Post by D.J.Peters »

Challenge why is the color version ~100% faster than the white version ;-)

Of course the screen mode and number of drawn quads and its size is all the same.

Joshy

file: "fbgfx_white.bas"

Code: Select all

const as integer iNUM  = 180     ' number of QUADS
const as integer iSIZE =  50     ' iQUADSIZE
const as integer iHALF = iSize\2 ' iQUADSIZE\2
const as single  iMAX  = sqr(iSIZE*iSIZE+iSIZE*iSIZE) ' max QuadSize while rotating
const as string  sQUAD = "BH"&iHALF &"R"&iSIZE &"D"&iSIZE &"L"&iSIZE &"U"&iSIZE &"BF"&iHALF

sub DrawQuad(iX as integer,iY as integer, fAngle as single)
  dim as integer iAngle=abs(fAngle) : iAngle mod=360
  dim as string rec = "BM"&iX &","&iY &"TA"&iAngle &sQUAD
  dim as string cmd = "C7"&rec &"P7,7"&"C16"&rec &"P15,16"
  draw cmd
end sub

var sS=512 ' screen size
var sC=256 ' screen center
var sR=200 ' screen radius
dim as single angle,angleStart,angleStep=ATN(1)*4/iNUM
dim as ubyte ptr pixels,row,p
dim as integer   iPitch
screenres sS,sS,,2
screenset 1,0
color 0,31
var img=imagecreate(iMAX,iMAX)
imageinfo img,,,,iPitch,pixels
sC=sS\2 : sR = sC-iMAX/2 ' screen radius
dim as double tNow,tLast=Timer()
dim as integer iFrames,iFPS
while inkey()=""
  cls
  angle=angleStart
  for i as integer=0 to iNUM-1
    var rad=(i/iNUM*2)*-ATN(1)*4
    DrawQuad(sc+cos(rad)*sR,sc+sin(rad)*sR,angle)
    if i=32 then
      get (sS-iMAX,sC-iMAX/2)-step(iMAX-1,iMAX-1),img
      row=pixels
      for y as integer=0 to iMax-1:
        p=row
        for x as integer=0 to iMax-1
          if *p=31 then *p=0
          p+=1
        next
        row+=iPitch
      next  
    end if  
    angle+=angleStep
  next
  put (sS-iMAX,sC-iMAX/2),img,TRANS
  flip
  iFrames+=1
  if iFrames mod 60=0 then
    tNow=timer(): iFPS=60/(tNow-tLast) : tLast=tNow
    windowtitle "fps: " & iFPS
  end if  
  angleStart+=0.5
wend
file: "fbgfx_colors.bas"

Code: Select all

const as integer iNUM  = 180     ' number of QUADS
const as integer iSIZE =  50     ' iQUADSIZE
const as integer iHALF = iSize\2 ' iQUADSIZE\2
const as single  iMAX  = sqr(iSIZE*iSIZE+iSIZE*iSIZE) ' max QuadSize while rotating
const as string  sQUAD = "BH"&iHALF &"R"&iSIZE &"D"&iSIZE &"L"&iSIZE &"U"&iSIZE &"BF"&iHALF

sub DrawQuad(iX as integer,iY as integer, fAngle as single,colour as ulong)
  dim as integer iAngle=abs(fAngle) : iAngle mod=360 : colour=32 + (colour mod 128)
  dim as string rec = "BM"&iX &","&iY &"TA"&iAngle &sQUAD
  dim as string cmd = "C"&colour & rec &"P"&colour &","&Colour
  draw cmd
end sub

var sS=512 ' screen size
var sC=256 ' screen center
var sR=200 ' screen radius
dim as single angle,angleStart,angleStep=ATN(1)*4/iNUM
dim as ubyte ptr pixels,row,p
dim as integer   iPitch
screenres sS,sS,,2
screenset 1,0
color 0,31
var img=imagecreate(iMAX,iMAX)
imageinfo img,,,,iPitch,pixels
sC=sS\2 : sR = sC-iMAX/2 ' screen radius
dim as double tNow,tLast=Timer()
dim as integer iFrames,iFPS
while inkey()=""
  cls
  angle=angleStart
  for i as integer=0 to iNUM-1
    var rad=(i/iNUM*2)*-ATN(1)*4
    DrawQuad(sc+cos(rad)*sR,sc+sin(rad)*sR,angle,i)
    if i=32 then
      get (sS-iMAX,sC-iMAX/2)-step(iMAX-1,iMAX-1),img
      row=pixels
      for y as integer=0 to iMax-1:
        p=row
        for x as integer=0 to iMax-1
          if *p=31 then *p=0
          p+=1
        next
        row+=iPitch
      next  
    end if  
    angle+=angleStep
  next
  put (sS-iMAX,sC-iMAX/2),img,TRANS
  flip
  iFrames+=1
  if iFrames mod 60=0 then
    tNow=timer(): iFPS=60/(tNow-tLast) : tLast=tNow
    windowtitle "fps: " & iFPS
  end if  
  angleStart+=0.5
  'sleep 10
wend
Post Reply