Isometric shadow casting light.

Boromir · Post by **Boromir** » Jan 16, 2017 19:48

This is some shadow light code I created for my isometric game engine. It's too slow to render in the game realtime. Any ideas on improvements?

collide.bi

Code: Select all

Public Function collide_object(x As integer,y As integer,x2 As integer,y2 As integer,speed As integer,width2 As integer,height2 As integer,width1 As integer,height1 As Integer,direc As Integer)As Integer
Dim As Integer distx,disty
'Line (0+x,(height1/2)+y)-((width1/2)+x,0+y),RGB(255,255,255)
'Line ((width1/2)+x,0+y)-(width1+x,(height1/2)+y),RGB(255,255,255)
'Line ((width1/2)+x,height1+y)-(width1+x,(height1/2)+y),RGB(255,255,255)
'Line (0+x,(height1/2)+y)-((width1/2)+x,height1+y),RGB(255,255,255)
'
'Line (0+x2,0+y2)-(width2+x2,0+y2),RGB(255,255,255)
'Line (0+x2,height2+y2)-(width2+x2,height2+y2),RGB(255,255,255)
'Line (0+x2,0+y2)-(0+x2,height2+y2),RGB(255,255,255)
'Line (width2+x2,0+y2)-(width2+x2,height2+y2),RGB(255,255,255)

                if x>x2 then distx=x-x2
                if x<=x2 then distx=x2-x
                if y>y2 then disty=y-y2
                if y<=y2 then disty=y2-y
		If Sqr(distx*distx + disty*disty)>500 Then Return 1

If direc=1 Then
			If x2>=(width1/2)+x And x2<=width1+x and y2-speed>=height1+y+(((width1/2)+x-x2)/(width1/height1)) Then 
				Return 1
			ElseIf x2>=width1+x Then
				Return 1
			ElseIf x2+width2<=0+x Then
				Return 1
			ElseIf x2+width2>=(width1/2)+x And x2<=(width1/2)+x And y2-speed>=height1+y Then
				Return 1
			ElseIf y2-speed+height2<=y+(height1/2)-1 Then
				Return 1
			ElseIf x2+width2<=(width1/2)+x And x2+width2>=0+x and y2-speed>=height1+y+(((x2+width2)-((width1/2)+x))/(width1/height1)) Then
				Return 1
			Else
				Return 0
			End If
End if

If direc=2 Then
			If x2>=(width1/2)+x And x2<=width1+x and y2+speed+height2<=y+(((x2)-((width1/2)+x))/(width1/height1)) Then
				Return 1
			elseif x2>=width1+x Then
				Return 1
			ElseIf x2+width2<=0+x Then
				Return 1
			elseif x2+width2>=(width1/2)+x And x2<=(width1/2)+x And y2+speed+height2<=y Then
				Return 1
			ElseIf y2+speed>=y+(height1/2) Then
				Return 1
			elseif x2+width2<=(width1/2)+x And x2+width2>=0+x and y2+speed+height2<=y-(((x2+width2)-((width1/2)+x))/(width1/height1)) Then
				Return 1
			Else
				Return 0
			End If
End If


If direc=3 Then 
			If y2>=(height1/2)+y And y2<=height1+y and x2+speed+width2<=x+(((y2)-((height1/2)+y))*(width1/height1)) Then
				Return 1
			elseif y2>=height1+y Then
				Return 1
			ElseIf y2+height2<=y Then
				Return 1
			elseif y2+height2>=(height1/2)+y And y2<=(height1/2)+y And x2+speed+width2<=x Then
				Return 1
			ElseIf x2+speed>=x+(width1/2) Then
				Return 1
			elseif y2+height2<=(height1/2)+y And y2+height2>=0+y and x2+speed+width2<=x-(((y2+height2)-((height1/2)+y))*(width1/height1)) Then
				Return 1
			Else
				Return 0
			End If
End If
If direc=4 Then
			If y2>=(height1/2)+y And y2<=height1+y and x2-speed>=(width1/2)+x+((height1+y-y2)*(width1/height1)) Then 
				Return 1
			ElseIf y2>=height1+y Then
				Return 1
			ElseIf y2+height2<=y Then
				Return 1
			ElseIf y2+height2>=(height1/2)+y And y2<=(height1/2)+y And x2-speed>=width1+x Then
				Return 1
			ElseIf x2-speed+width2<x+(width1/2)-1 Then
				Return 1
			ElseIf y2+height2<=(height1/2)+y And y2+height2>=0+y and x2-speed>=width1+x+(((y2+height2)-((height1/2)+y))*(width1/height1)) Then
				Return 1
			Else
				Return 0
			End If
End If

End Function

light.bas

Code: Select all

#Include "collide.bi"
#include "fbgfx.bi"
Using fb

    #macro ppoint(_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

#define RR( c ) ( CUInt( c ) Shr 16 And 255 )
#define RG( c ) ( CUInt( c ) Shr  8 And 255 )
#define RB( c ) ( CUInt( c )        And 255 )


Public Sub Lined(x As Integer,y As Integer,xv As Integer,yv As integer)
Dim as integer w,h,pitch,d
dim as any ptr row
dim as uinteger ptr pixel
Screeninfo w,h,,,pitch
row=ScreenPtr

dim as Single xnew,ynew,xdist1,ydist1
Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,numpixels,curpixel,xinc1,xinc2,yinc1,yinc2
Dim As Integer alphac=0,r,g,b,aupd,i,s,j=2,xs,ys
r=255
g=255
b=0
x3=x
y3=y
x2=xv
y2=yv
dx = abs(x2 - x3):dy = abs(y2 - y3):xnew = x3:ynew = y3

if x2 >= x3 Then
  xinc1 = 1:xinc2 = 1
else
  xinc1 = -1:xinc2 = -1
End If

if y2 >= y3 Then
  yinc1 = 1:yinc2 = 1
else
  yinc1 = -1:yinc2 = -1
End If

if dx >= dy Then
  xinc1 = 0:yinc2 = 0:den = dx:num = dx / 2:numadd = dy:numpixels = dx
Else
  xinc2 = 0:yinc1 = 0:den = dy:num = dy / 2:numadd = dx:numpixels = dy
End If

curpixel=0
While curpixel <= numpixels
	Dim As Integer safe=0
	If j=2 And curpixel>5 And curpixel<numpixels-100 Then
	For s=0 To 1000 Step 120
	For i=0 To 1000 Step 240
	If xnew<i Then Exit For
	If ynew<s Then Exit For
	'If xnew>i+120 Then Exit For
	If ynew>s+60 Then Exit For 
	If collide_object(i,s,xnew,ynew,0,1,1,120,60,1)=0 Then Exit sub
	If collide_object(i,s,xnew,ynew,0,1,1,120,60,2)=0 Then Exit Sub
	If collide_object(i,s,xnew,ynew,0,1,1,120,60,3)=0 Then Exit Sub
	If collide_object(i,s,xnew,ynew,0,1,1,120,60,4)=0 Then Exit Sub
	Next
	Next
	End If
	If j=2 Then
		j=0
	ElseIf j<2 Then
		j+=1
	End If
	If safe=0 Then
		'PReset(xnew, ynew),RGBA(r,g,b,Alphac)
			If CInt(xnew)>0 And CInt(xnew)<1280 Then xs=CInt(xnew)
			If CInt(ynew)>0 and CInt(ynew)<1024 Then ys=CInt(ynew)
        	   ppoint(xs,ys,d)
        	   r=rr(d)
        	   If r<245 Then r+=10
        	   g=rg(d)
        	   If g<245 Then g+=10
        	   b=rb(d)
        	   If b<245 Then b+=10
            ppset(xs,ys,RGB(r,g,b))
	End if

  num += numadd
  if num >= den Then	num -= den:xnew += xinc1:ynew += yinc1
  xnew += xinc2:ynew += yinc2:curpixel+=1
  If aupd=0 and alphac<0 Then alphac=0
  If aupd=0 Then alphac=(curpixel*100)/numpixels
  If aupd=0 Then alphac=100-alphac
  If aupd=0 Then alphac=alphac*0.55
Wend

End Sub

Screenres 1280,1024,32,,GFX_ALPHA_PRIMITIVES' or GFX_FULLSCREEN
Dim As Integer x,y
Declare Sub glow(x As integer, y As integer,rad As integer,rady As integer)

Do
GetMouse x,y
'x=400
'y+=1
ScreenLock
Cls
BLoad "test_small.bmp"
glow(x, y,1200,720)

ScreenUnLock
Sleep 1
Loop Until MultiKey(1)

Sub glow(x As integer, y As integer,rad As integer,rady As integer)
  Dim i As Integer
  Dim x1 As Single, y1 As Single
  Dim x2 As Single, y2 As Single
  Dim stepv As Single
  Dim angle As Single
  Dim cosv As Single, sinv As Single
  
  rad = (rad) / 2
  rady = (rady) / 2

  stepv = Atn(1) / 100
  'draw lines
  For i = 0 To 799
    'find angle
    angle = stepv * i

    cosv = Cos(angle)
    sinv = Sin(angle)
    x1 = x
    y1 = y
    x2 = x + cosv * rad
    y2 = y + sinv * rady
    'draw each lines
    Lined (x1, y1,x2, y2)
  Next
End Sub

Edit: Made some more improvements.
Edit: Added macros for faster pixel plotting.

greenink · Post by **greenink** » Jan 17, 2017 12:54

It still works fast for me even with other threads putting my CPU usage to 100% on both cores. Are you using the -O 3 command line option when compiling? Also multiplication is much faster than division. I would do most of the calculations in single floating point.
For

Code: Select all

 If aupd=0 Then alphac=(curpixel*100)/numpixels

You could write

Code: Select all

 dim as single rnumpixels=1!/numpixels

somewhere at the start of the sub
and then

Code: Select all

 If aupd=0 Then alphac=(curpixel*100)*rnumpixels

Also if you want to draw a circle without slow sin/cos evaluations:

Code: Select all

' Paper: http://vicanek.de/articles/QuadOsc.pdf
screenres 800,450,32

const as single w=.005*(8*atn(1)) 'w= radians per step (so here 200 steps = 2*Pi radians =360 degrees)
'const as single w=2.4#	'Golden angle 
 
dim as single u=0!,v=1!,k1=tan(w*.5),k2=2*k1/(1 + k1*k1)
for k as long =0 to 99
for j as ulong =0 to 799
	
	var tmp = u - k1*v
	v = v + k2*tmp
	u= tmp - k1*v
	
	var i=j mod 800
	pset (i,225+200*v),rgb(255,0,255)
	pset (i,225+200*u),rgb(0,255,255)
	pset (400+100*v,225+100*u),rgb(255,255,255)
	
next

next
getkey

Boromir · Post by **Boromir** » Jan 17, 2017 15:44

Thanks.
The new circle code seems much faster.

what does -O 3 do? It runs at the same speed despite using it or not.

greenink · Post by **greenink** » Jan 17, 2017 21:55

-O 3 sets the optimization level of the compiler to maximum. It works great with those versions of FB that use GCC (a C compiler) to produce the final code. I guess it depends on what OS you use. I also have heard that FB graphics is rather slow on windows 10 for some reason, maybe that is causing the low rendering speed. On Linux (AMD64) even using pset for doing all the graphics I find is very fast.

Boromir · Post by **Boromir** » Jan 17, 2017 22:03

Yeah I'm on windows 10 since I messed up my ubuntu installation playing with graphics drivers.
But I've got it down to a more usable speed now, but still one of the more resource greedy features of my engine.

leopardpm · Post by **leopardpm** » Feb 07, 2017 5:20

speed seems good, even on my clunky win10 system.

On thing to note is that every time you are recalculating teach 'ray' when, in essence, they are the exact same no matter what the starting point. Also, as each ray is calculated, the are ALOT of pixels which are checked multiple times to detect if the ray 'hits' something - the closer the pixel is to the center, the more times it will be checked by multiple rays.

A method of tackling these two issues could be approached like this...

Imagine your 'light circle' as a set image, with no blocking bits, like this:

now, instead of tracing each ray, place all the 'blocking' images into this image:

As you can see, the only 'pixels' that need to be shaded or 'turned off' are the ones which are behind each blocker - this area can easily be determined through straight math, or by casting your ray (now a shade ray, not a light ray) from the blocker out to the edge of the light circle using the light source center as the direction.

If you want to do it all in math (I think the fastest way, especially since all your 'blockers' are described as quads, 'diamonds'), take a look at Amit Patel's blog, at Red Blob Games, subject "2D Visibility" (http://www.redblobgames.com/articles/visibility/) - he shows how to do the math version and lists links to see how other folks have coded different variations.

In this way you skip processing all those 'unblocked' or lit up pixels!.... of course, the speedup will be inversely connected to the number of blocking things you might have - have one tree within your 'light circle' and this will be lickity-split fast, have a zillion trees and this may be slower than tracing the light rays.... but it is rational to assume that there will be only a few blockers (it looks like from your video that maybe 5-8 maximum trees in any particular light circle, so this would definitely be faster).

Just a thought, don't mind me! You are progressing excellently in your endeavors!!!!

Boromir · Post by **Boromir** » Feb 07, 2017 15:47

Those blockers are actually just parts of the glow image that need to be erased. Is it possible to erase parts of an array in fbgfx? Sorry if it's a dumb question. :)

leopardpm · Post by **leopardpm** » Feb 07, 2017 20:19

only by manually zeroing them out... there are some tricks if the blockers would all be aligned to the grid, but not for odd shapes

leopardpm · Post by **leopardpm** » Mar 01, 2017 2:42

Was just thinking about how to do this relatively easily...

first, I start out with all the 'known' points: the 'eye' or center, and every point which define the corners of any blocking polygon. These are shown in this image as the red circles aroung the black square:

Now, using the easy formula to calculate the angle that a polygon corner point is at using the center point, so, for instance in this picture, the points of that polygon might be at 280 degrees, 285 degrees, 287 degrees, and 295 degrees. Grab the lowest, and the highest - this gives you the two points at the outer edges of the blocker polygon. Now, using each of those points in conjunction with the center point, it is easy to determine the point on the outside radius of the lightsource (shown as the red circles on the outside, the endpoints of the green lines from the center point). so, Now you have 4 points (2 along outside edge of light circle, and the 2 from the edges of the blocker polygon - shown as the Red Circles with blue centers) which form the polygon of pixels that are in shadow (shown in yellow). Another easy routine, basic polygon fill, can shade this area in the lightsource mask... all done! and should be pretty fast... not the fastest I fear, but these are simple calcs and done only for each polygon blocker.

thinking a bit more, and to make it even easier: Start off with a temporary image buffer, paint your fading light circle onto it, use the above algorithm to get the 4 points of the shadow polygon, THEN just use the DRAW command to draw the filled polygon onto the image buffer (which ends up being your light (or shadow) mask)... let the draw command do the polygon fill for you, already pretty optimized probably... easy peasy pie!

only one issue though.... the edge of the shadow polygon that runs between the two points along the outside of the light circle... the line between these points does not exactly match the arc of the light circle... so if the blocker was big (or very close to the light source, there would be an artifact of light at the edge of the light circle behind the blocker.... ah ha! all that is needed is to define the points along the outer edge to be a certain distance greater than the radius of the light circle so the shadow polygon completely encompasses all parts of the light circle.... wow, sounds like gibberish when I read it back to myself, but it is correct... will explain better if ya gots any questions....

dodicat · Post by **dodicat** » Mar 01, 2017 4:13

For a polygon I get the smallest dot product between every pair of polygon points and the light source.
These two legs are normalised first
(smallest dot ~~ biggest angle)

I use a rectangle here, but it can be extended to a polygon, so long as the polygon is fully convex (no concave bits).
For a circle it is just slogging out the angles via atan2.
E.G.

Code: Select all


Screen 20,32
Dim As integer xres,yres
Screeninfo xres,yres
Dim As Any Ptr im=Imagecreate(2*xres,2*yres)

Type pt
    As Long x,y
    #define v Type<pt>
End Type

Type V2
    As Single x,y,dx,dy
    As long radius
End Type

Type line3d
    As Single v1x,v1y,v2x,v2y
End Type

Redim Shared As line3d q(1 To 1)
Redim Shared As v2 bl(1 To 1)
#define Intrange(f,l) int(Rnd*((l+1)-(f))+(f))
#define dist(a,b) sqr((a.x-b.x)*(a.x-b.x) + (a.y-b.y)*(a.y-b.y))
#define map(a,b,x,c,d) ((d)-(c))*((x)-(a))/((b)-(a))+(c)
Type box
    As pt p(0 To 4)
    col As Ulong
    inc As Long
    As Long maxd
    As Long rot
    As Long ang
    Declare Constructor
    Declare Constructor(As pt,As pt,As Ulong,As Long=0,As Long=1)
End Type

Type Circle
    As pt ctr
    As Long r
    As Ulong col
    As Long inc
End Type

Function rotate(pivot As pt,_point As pt,angle As Long) As pt
    Dim pi As Double=4*Atn(1) 
    #define rad *pi/180
    Return v((Cos(angle rad)*(_point.x-pivot.x)-Sin(angle rad)*(_point.y-pivot.y)) +pivot.x, _
    (Sin(angle rad)*(_point.x-pivot.x)+Cos(angle rad)*(_point.y-pivot.y)) +pivot.y)
End Function

Constructor box:End Constructor

Constructor box(p1 As pt,p3 As pt,c As Ulong,angle As Long,flag As Long=1)
col=c
ang=angle
p(1)=p1:p(3)=p3
p(2).x=p(3).x:p(2).y=p(1).y
p(4).x=p(1).x:p(4).y=p(1).y+p(3).y-p(2).y
'p(0) is the box centroid
p(0).x=(p(1).x+p(2).x)\2
p(0).y=(p(2).y+p(3).y)\2
maxd=dist(p(0),p(1))
For n As Long=1 To 4
    this.p(n)=rotate( this.p(0), this.p(n),angle)
Next n
If flag =-1 Then
    For n As Long=1 To 3
        Redim Preserve Q(1 To Ubound(q)+1)
        Q(Ubound(Q))=Type<line3d>(this.p(n).x,this.p(n).y,this.p(n+1).x,this.p(n+1).y)
    Next n
    Redim Preserve Q(1 To Ubound(q)+1)
    Q(Ubound(Q))=Type<line3d>(this.p(4).x,this.p(4).y,this.p(1).x,this.p(1).y)
Else
    Var t=4*flag-4
    Dim As long n
    For n =1 To 3
        Q(t+n)=Type<line3d>(this.p(n).x,this.p(n).y,this.p(n+1).x,this.p(n+1).y)
    Next n
    Q(t+n)=Type<line3d>(this.p(4).x,this.p(4).y,this.p(1).x,this.p(1).y) 
End If
End Constructor

Sub drawlines(q As line3d)
    Line(q.v1x,q.v1y)-(q.v2x,q.v2y)
End Sub

Function shortline(fp As pt,p As pt,length As Long) As pt
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Return v(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function

Sub barebox(bx1 As box,msg As Long=0)
    For n As Long=1 To 4
        Var k=n,p=1
        If n=4 Then k=4:p=-3
        Line (bx1.p(k).x,bx1.p(k).y)-(bx1.p(k+p).x,bx1.p(k+p).y),Rgb(0,0,bx1.inc)'bx1.col
    Next n
    If msg Then'bx1.col
        Paint (bx1.p(0).x,bx1.p(0).y),bx1.col,Rgb(0,0,bx1.inc)
        For n As Long=1 To 4
            Var k=n,p=1
            If n=4 Then k=4:p=-3
            Line (bx1.p(k).x,bx1.p(k).y)-(bx1.p(k+p).x,bx1.p(k+p).y),bx1.col
        Next n
    End If
End Sub

Sub barecircle(C As Circle,msg As Long=0)
    If msg=0 Then
        Circle(C.ctr.x,C.ctr.y),C.r,Rgb(0,C.inc,0)
    Else
        Circle(C.ctr.x,C.ctr.y),C.r,C.col,,,,f
    End If
End Sub

Function dot(v1 As pt,v2 As pt) As Single
    Dim As Single d1=Sqr(v1.x*v1.x + v1.y*v1.y),d2=Sqr(v2.x*v2.x + v2.y*v2.y)
    Dim As Single v1x=v1.x/d1,v1y=v1.y/d1
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2
    Return (v1x*v2x+v1y*v2y)
End Function

Sub GetBoxShadow(Byval b1 As box,c As pt)
    Dim As Long i=b1.inc
    Dim As Single dt=2
    Dim As Long id1,id2
    
    For p1 As Long  = 1 To 3
        For p2 As Long  = p1 + 1 To 4
            Var a1=Type<pt>(-c.x+b1.p(p1).x,-c.y+b1.p(p1).y)
            Var a2=Type<pt>(-c.x+b1.p(p2).x,-c.y+b1.p(p2).y)
            Var a3=dot(a1,a2)
            If dt>a3 Then dt=a3:id1=p1:id2=p2 
        Next p2
    Next p1
    
    Var S1=shortline(b1.p(id1),c,-2000)
    Line(s1.x,s1.y)-(b1.p(id1).x,b1.p(id1).y),Rgb(0,0,i)
    Var S2=shortline(b1.p(id2),c,-2000)
    Line(s2.x,s2.y)-(b1.p(id2).x,b1.p(id2).y),Rgb(0,0,i)
    
    Dim As Single dx=c.x-b1.p(0).x,dy=c.y-b1.p(0).y
    Var d=dist(c,b1.p(0))
    dx=-dx/d:dy=-dy/d
    dx=b1.p(0).x+1.2*b1.maxd*dx:dy=b1.p(0).y+1.2*b1.maxd*dy
    barebox(b1)
    Paint(dx,dy),Rgb(0,0,0),Rgb(0,0,i)
End Sub

sub GetCircleShadow(C as circle,p as pt)
   #define incircle(C,p) ((C.ctr.x-p.x)*(C.ctr.x-p.x)+(C.ctr.y-p.y)*(C.ctr.y-p.y))<C.r*C.r
    #define A_line(x,y,angle,length)  Type(x+length*Cos(angle),y-length*Sin(angle))
    #macro shortline2(fp,p,length,ret)
     scope
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Ret= Type<v2>(fp.x+length*diffx/L,fp.y+length*diffy/L)
    end scope
#endmacro
if incircle(C,p) then exit sub
    Circle(C.ctr.x,C.ctr.y),C.r,Rgb(0,C.inc,0)
    var pi=4*atn(1)
    var ba=atan2((C.ctr.y-p.y),(C.ctr.x-p.x))
    var L1=sqr( (C.ctr.x-p.x)*(C.ctr.x-p.x) + (C.ctr.y-p.y)*(C.ctr.y-p.y))
    var a=acos(c.r/L1)
    var a2=a+ba
    dim as v2 pt2s,pt1s,cc
   dim as V2 pt2=a_line(C.ctr.x,C.ctr.y,Pi-a2,C.r)
     shortline2(pt2,p,(-2000*C.r),pt2s)
    line(pt2.x,pt2.y)-(pt2s.x,pt2s.y),Rgb(0,C.inc,0)
   var a3=a-ba
   dim as v2 pt1= a_line(C.ctr.x,C.ctr.y,pi+a3,C.r)
     shortline2(pt1,p,(-2000*C.r),pt1s)
    line(pt1.x,pt1.y)-(pt1s.x,pt1s.y),Rgb(0,C.inc,0)
    shortline2(C.ctr,p,-1.25*C.r,cc)
    Paint(cc.x,cc.y),Rgb(0,0,0),Rgb(0,C.inc,0) 
end sub

Function inpolygon(p1() As Pt,Byval p2 As Pt) As Long
    #macro Winder(L1,L2,p)
    -Sgn((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
    #endmacro
    Dim As Long index,nextindex,k=Ubound(p1)+1,wn
    For n As Long=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

Function inbox(b As box,mx As Long,my As Long) As Long
    Return inpolygon(b.p(),v(mx,my))
End Function

Function InCircle(b As Circle,mx As Long,my As Long) As Long
    Return (b.ctr.x-mx)*(b.ctr.x-mx) +(b.ctr.y-my)*(b.ctr.y-my) < b.r*b.r
End Function

Sub setupfloor(xres As Long,yres As Long,floor As Any Ptr)
    Dim As Long counter
    Dim As Ulong col
    For y As Long=-10 To yres+10 Step 10
        For x As Long=-10 To xres+10 Step 10
            counter+=1
            If counter Mod 2 Then col=Rgb(255,255,255) Else col=Rgb(0,100,200)
            Line floor,(x,y)-(x+100,y+100),col,bf
        Next x
    Next y
End Sub

Sub setupimage(xres As Long,yres As Long,Byref i As Any Ptr)
    Dim As Long cx=xres/2,cy=yres/2
    For y As Long=0 To yres
        For x As Long= 0 To xres
            Var d=dist(v(x,y),v(cx,cy))
            Var f=map(0,(1.3*xres/2),d,1,0)
            Pset i,(x,y),Rgb(255*f,255*f,255*f)
        Next x
    Next y
End Sub

Function checkboxseperation(b() As box,tst As pt,n As Long,dx As Long,dy As Long) As Long
    dim as pt p=v(bl(1).x,bl(1).y)
    For z As Long=1 To n
        If dist(b(z).p(0),tst) < (dx+dy) Then Return 0
    Next z
    Return -1
End Function

Sub setupboxes(b() As box,xres As Long,yres As Long)
    Redim b(0)
    Redim b(1 To IntRange(5,7))
    Var m=map(5,20,Ubound(b),150,30)'fewer boxes then make them bigger
    For n As Long=1 To Ubound(b)
        Dim As Long xx,yy,dx,dy
        Do
            dx=Intrange(30,m):dy=intrange(30,m)   
            xx=IntRange(xres/15,xres-xres/15-dx):yy=Intrange(yres/15,yres-yres/15-dy)
        Loop Until checkboxseperation(b(),v(xx,yy),n-1,dx,dy) 
        b(n)=Type<box>(v(xx,yy),v(xx+dx,yy+dy),Rgb(Rnd*255,Rnd*255,Rnd*255),intrange(0,0),-1)
        b(n).inc=n
    Next n
End Sub

Function checkcircleseperation(b() As Circle,tst As pt,n As Long,r As Long) As Long
     dim as pt p=v(bl(1).x,bl(1).y)
    For z As Long=1 To n
        If dist(b(z).ctr,tst) < 10 or dist(b(z).ctr,p)< (r+b(z).r)\2 Then Return 0
    Next z
    Return -1
End Function

Sub setupCircles(b() As Circle,xres As Long,yres As Long)
    Redim b(0)
    Redim b(1 To IntRange(3,7))
    Var m=map(3,7,Ubound(b),50,20)'fewer circles then make them bigger
    For n As Long=1 To Ubound(b)
        Dim As Long xx,yy,dx,dy
        Dim As Long rad
        Do
            rad=Intrange(30,m)  
            xx=IntRange(xres/15,xres-xres/15-dx):yy=Intrange(yres/15,yres-yres/15-dy)
        Loop Until checkcircleseperation(b(),v(xx,yy),n-2,rad) 
        b(n)=Type<Circle>(v(xx,yy),rad,Rgb(Rnd*255,Rnd*255,Rnd*255))
        b(n).inc=n
    Next n
End Sub

Function segment_distance(lx1 As Single, _
    ly1 As Single, _
    lx2 As Single, _
    ly2 As Single, _
    px As Single,_
    py As Single, _
    Byref ox As Single=0,_
    Byref oy As Single=0) As Single
    
    Dim As Single M1,M2,C1,C2,B
    B=(Lx2-Lx1):If B=0 Then B=1e-20
    M2=(Ly2-Ly1)/B:If M2=0 Then M2=1e-20
    M1=-1/M2
    C1=py-M1*px
    C2=(Ly1*Lx2-Lx1*Ly2)/B
    Var L1=((px-lx1)*(px-lx1)+(py-ly1)*(py-ly1)),L2=((px-lx2)*(px-lx2)+(py-ly2)*(py-ly2))
    Var a=((lx1-lx2)*(lx1-lx2) + (ly1-ly2)*(ly1-ly2))
    Var a1=a+L1
    Var a2=a+L2
    Var f1=a1>L2,f2=a2>L1
    If f1 Xor f2 Then 
        Var d1=((px-Lx1)*(px-Lx1)+(py-Ly1)*(py-Ly1))
        Var d2=((px-Lx2)*(px-Lx2)+(py-Ly2)*(py-Ly2))
        If d1<d2 Then Ox=Lx1:Oy=Ly1 : Return Sqr(d1) Else  Ox=Lx2:Oy=Ly2:Return Sqr(d2)
    End If
    Var M=M1-M2:If M=0 Then M=1e-20
    Ox=(C2-C1)/(M1-M2)
    Oy=(M1*C2-M2*C1)/M
    Return Sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
End Function

'optimize detection to save cpu.
Function DetectBallCollisions(Byref _that As V2,_this As V2) As Single
    Dim As Single xdiff = _this.x-_that.x
    Dim As Single ydiff = _this.y-_that.y
    If Abs(xdiff) > _this.radius*2 Then Return 0
    If Abs(ydiff) > _this.radius*2 Then Return 0
    Var L=Sqr(xdiff*xdiff+ydiff*ydiff)
    If L<=(_this.radius+_that.radius) Then Function=L
End Function

Sub check_ball_to_line_collisions(LN() As Line3d, ball() As V2)
    For z As long=1 To 1
        For z2 As long=Lbound(Ln) To Ubound(Ln)
            Dim As V2 closepoint
            Var seperation=segment_distance(Ln(z2).v1x,Ln(z2).v1y,Ln(z2).v2x,Ln(z2).v2y,ball(z).x,ball(z).y,closepoint.x,closepoint.y)
            If seperation<=ball(z).radius Then
                Var impactx=-ball(z).dx
                Var impacty=-ball(z).dy
                Var impulsex=(closepoint.x-ball(z).x)/seperation
                Var impulsey=(closepoint.y-ball(z).y)/seperation
                ball(z).x=closepoint.x-ball(z).radius*impulsex
                ball(z).y=closepoint.y-ball(z).radius*impulsey
                Var dv=impactx*impulsex+impacty*impulsey
                ball(z).dx+= 2*dv*impulsex
                ball(z).dy+= 2*dv*impulsey
            End If
        Next z2
    Next z
End Sub

Sub Check_BallCollisions(points() As V2)
    For n1 As long =1 To 1
        For n2 As long =n1+1 To Ubound(points)
            Var L=DetectBallCollisions(points(n1),points(n2))
            If L Then
                Var impulsex=(points(n1).x-points(n2).x)/L
                Var impulsey=(points(n1).y-points(n2).y)/L
                Var impactx=points(n1).dx-points(n2).dx
                Var impacty=points(n1).dy-points(n2).dy
                Var dt=impactx*impulsex+impacty*impulsey
                points(n1).dx-=2*dt*impulsex
                points(n1).dy-=2*dt*impulsey
            End If
        Next n2
    Next n1
End Sub

Sub transfer(c() As Circle, p() As v2)
    For n As long=1 To Ubound(C)
        Redim Preserve p(1 To Ubound(p)+1)
        p(Ubound(p)).x=C(n).ctr.x
        p(Ubound(p)).y=C(n).ctr.y
        p(Ubound(p)).radius=C(n).r
    Next n
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

'==========================================================
Redim As Circle circles()
setupCircles(circles(),xres,yres)
Redim As box b()
Redim q(0)
setupboxes(b(),xres,yres)

Dim As Any Ptr floor=Imagecreate(xres,yres)
setupfloor(xres,yres,floor)
setupimage(xres*2,yres*2,im)

Dim As Long mx,my,mb,flag,fps
Redim As box R(Lbound(b) To Ubound(b))
Dim As box tmp
Dim As Single a
bl(1)=Type<V2>(50,50,2.5,2.5,5)'15
transfer(circles(),bl())

Do
    a+=.2
    If a>=360 Then a=0
    For z As long=1 To Ubound(bl)
        bl(z).x+=bl(z).dx
        bl(z).y+=bl(z).dy
    Next z
    
    check_ball_to_line_collisions(Q(),bl())
    Check_BallCollisions(bl())
    
    
    For m As Long=Lbound(b) To Ubound(b)
        For z As Long=1 To 4
            tmp.p(z)=rotate(b(m).p(0),b(m).p(z),-b(m).ang)'set the box level
        Next z
        'box is now standard opposite corners
        'turn the boxes
        If m Mod 2 Then
            r(m)=Type<box>(tmp.p(1),tmp.p(3),b(m).col,a,m)
        Else
            r(m)=Type<box>(tmp.p(1),tmp.p(3),b(m).col,-a,m)
        End If
        r(m).inc=b(m).inc
    Next m

    Getmouse mx,my,,mb
    
    If mb=1 And flag=0 Then
        flag=1:Redim Q(0):setupboxes(b(),xres,yres)
        Redim R(Lbound(b) To Ubound(b))
        setupcircles(circles(),xres,yres)
        Redim Preserve bl(1 To 1)
        transfer(circles(),bl())
    End If
    Screenlock
    Cls
    Put(0,0),floor,Alpha,255
    
    For n1 As Long=Lbound(b) To Ubound(b)
        If inbox(r(n1),bl(1).x,bl(1).y) =0 Then GetBoxShadow(r(n1),v(bl(1).x,bl(1).y))
    Next n1
    For n1 As Long=Lbound(circles) To Ubound(circles)
        If inCircle(circles(n1),bl(1).x,bl(1).y) =0 Then GetCircleShadow(circles(n1),type<pt>(bl(1).x,bl(1).y))
    Next n1
    
    Put(0,0),floor,Alpha,100
    Put(bl(1).x-xres,bl(1).y-yres),im,Alpha,200
    Draw String (5,5),"Click Mouse" ,0
    draw string(5,50),"Framerate " &ubound(bl),0
    For n As Long=1 To Ubound(b)
        barebox(r(n),1)
    Next n
    For n As Long=1 To Ubound(circles)
        barecircle(circles(n),1)
    Next n
    For n As long=Lbound(q) To Ubound(q)
       ' drawlines(q(n))
    Next n
    Circle(bl(1).x,bl(1).y),bl(1).radius,Rgb(255,255,255),,,,f
    var r=bl(1).radius
    If bl(1).x>xres-r Or bl(1).x<r Then bl(1).dx=-bl(1).dx
    If bl(1).y>yres-r Or bl(1).y<r Then bl(1).dy=-bl(1).dy
    Screenunlock
    Sleep regulate(65,fps)
    flag=mb
Loop Until Len(Inkey)
Imagedestroy floor
Imagedestroy im
Sleep

leopardpm · Post by **leopardpm** » Mar 01, 2017 7:42

wow, nice demo yet again

wish I remembered what a 'dot product' even was, let alone how to use it in such a situation...

Boromir · Post by **Boromir** » Mar 01, 2017 20:16

@leopardpm
Your method makes sense but my implementation test is mangled. It seems to work when the light source x is positive relative to the box.

Code: Select all

#include once "fbgfx.bi"
function getslope(byref xdif as integer,byref ydif as integer,x1 as integer,y1 as integer,x2 as integer,y2 as integer) as integer
        xdif = x2 - x1
        ydif = y2 - y1
        return atan2(ydif, xdif)*(180 / 3.14)
end function

sub makepoint(xdif as integer,ydif as integer,dist as integer,x1 as integer,y1 as integer,byref x2 as integer,byref y2 as integer)
    xdif=xdif*7000'/xdif
    ydif=ydif*7000'/ydif
    x2=x1+(ydif)
    y2=y1-(xdif)
    x2-=+ydif+xdif
    y2-=+ydif-xdif
end sub

screen 18,32',,fb.GFX_ALPHA_PRIMITIVES
dim as integer x,y,x2,y2,xl,yl,shx1,shy1,shx2,shy2,slope,dist,xdif,ydif
x=100
y=100
x2=110
y2=110
xl=200
yl=200
color rgb(255,0,0),rgb(255,0,0)
do
screenlock
cls
getmouse xl,yl
dim as any ptr img
dim as integer chx1,chy1,chx2,chy2,testval

slope=getslope(xdif,ydif,x2,y,xl,yl)
if slope>testval then testval=slope:chx1=x2:chy1=y
slope=getslope(xdif,ydif,x2,y2,xl,yl)
if slope>testval then testval=slope:chx1=x2:chy1=y2
slope=getslope(xdif,ydif,x,y,xl,yl)
if slope>testval then testval=slope:chx1=x:chy1=y
slope=getslope(xdif,ydif,x,y2,xl,yl)
if slope>testval then testval=slope:chx1=x:chy1=y2
slope=getslope(xdif,ydif,x2,y,xl,yl)
if slope<testval then testval=slope:chx2=x2:chy2=y
slope=getslope(xdif,ydif,x2,y2,xl,yl)
if slope<testval then testval=slope:chx2=x2:chy2=y2
slope=getslope(xdif,ydif,x,y,xl,yl)
if slope<testval then testval=slope:chx2=x:chy2=y
slope=getslope(xdif,ydif,x,y2,xl,yl)
if slope<testval then testval=slope:chx2=x:chy2=y2

img=imagecreate(641,481,rgba(0,0,0,0))
line img,(0,0)-(640,480),rgba(255,255,255,200),bf

slope=getslope(xdif,ydif,chx1,chy1,xl,yl)
makepoint(xdif,ydif,30,chx1,chy1,shx1,shy1)
slope=getslope(xdif,ydif,chx2,chy2,xl,yl)
makepoint(xdif,ydif,30,chx2,chy2,shx2,shy2)

line img,(shx1,shy1)-(chx1,chy1),rgba(0,0,0,0)
line img,(shx2,shy2)-(chx2,chy2),rgba(0,0,0,0)
line img,(shx1,shy1)-(shx2,shy2),rgba(0,0,0,0)
line img,(chx1,chy1)-(chx2,chy2),rgba(0,0,0,0)
paint img,(shx2+(shx2-x),shy1+(shy2-y)),rgba(0,0,0,0),rgba(0,0,0,0)
'line img,()

' Let's draw a box
line (x,y)-(x2,y),rgb(0,0,0)
line (x2,y)-(x2,y2),rgb(0,0,0)
line (x2,y2)-(x,y2),rgb(0,0,0)
line (x,y2)-(x,y),rgb(0,0,0)

put (0,0),img,alpha
'line (x,y)-(x2,y2),rgb(120,0,0),bf


screenunlock
sleep 100
loop until multikey(1)

@dodicat
Wow!
Impressive demo. The code is all Greek to me though.

BasicCoder2 · Post by **BasicCoder2** » Mar 01, 2017 20:42

leopardpm wrote:wow, nice demo yet again
wish I remembered what a 'dot product' even was, let alone how to use it in such a situation...

After googling I see it is a value which tells you something about the relationship between 2 or 3 vectors.
I guess if we want to do this stuff or understand any of dodicat's code we will just have to take time out to educate ourselves of the math involved.
I haven't found any 3d math for dummies yet :)

leopardpm · Post by **leopardpm** » Mar 01, 2017 20:43

Boromir wrote: It seems to work when the light source x is positive relative to the box.

That tells me that the issue is in the slope calculation... I haven't looked through the code though yet. Do you just find the slope, or do you actually convert it to a full 360 degree (or radian) angle? if you don't convert it, then that is the problem because the slope between two points can actually be two values, one positive and one negative depending on your equation to calculate it is set.

leopardpm · Post by **leopardpm** » Mar 01, 2017 20:51

looked at your demo - really nice! and yes, the problem is with the slope function... you can tell because the demo works when the block is in the 0 to 180 degree field from the mouse.... 181 - 359 degrees cannot compute correctly.... I would have to think, but my guess is that if ydiff OR xdiff is negative, then the signs of both have to be changed.... just a quick off the top of my head gut response though... i dont trust it! lol

Isometric shadow casting light.

Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.

Re: Isometric shadow casting light.