Isometric shadow casting light.

Game development specific discussions.
Boromir
Posts: 447
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Isometric shadow casting light.

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

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
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

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.
Last edited by Boromir on Jan 22, 2017 19:03, edited 1 time in total.
greenink
Posts: 200
Joined: Jan 28, 2016 15:45

Re: Isometric shadow casting light.

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

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
Posts: 447
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Thanks.
The new circle code seems much faster.

what does -O 3 do? It runs at the same speed despite using it or not.
Last edited by Boromir on Jan 20, 2017 1:06, edited 1 time in total.
greenink
Posts: 200
Joined: Jan 28, 2016 15:45

Re: Isometric shadow casting light.

-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
Posts: 447
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

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
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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
Posts: 447
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light. 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
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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
Posts: 5938
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Isometric shadow casting light.

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
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)
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
xx=IntRange(xres/15,xres-xres/15-dx):yy=Intrange(yres/15,yres-yres/15-dy)
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)
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)
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
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
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
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
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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
Posts: 447
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

@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
Posts: 3398
Joined: Jan 01, 2009 7:03

Re: Isometric shadow casting light.

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 :)
Last edited by BasicCoder2 on Mar 01, 2017 20:43, edited 1 time in total.
leopardpm
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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
Posts: 1792
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

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