Isometric shadow casting light.

[leopardpm]

ok, i am on your wavelength now... I need to draw out my idea... brb

[Boromir]

[leopardpm]

ok... so here is the issue: we need to determine the points of the polygon that encompass the entire shadow in respect to the lightbox.

so, given those two 'shadow rays', we have the first 2 points (which are part of the object itself, you already have these calculated)

the next two points to calculate are where those points hit the rectangle defining the light box (in the image above, the points are at the arrowheads of the two rays). THEN, based on these last two points, we need to figure out how many (0,1, or 2) corners of the lightbox are between them - this can easily be down by testing EACH of the four corners angle to the light source and check to see if the corner angle is between the angles of the rays....

[leopardpm]

wait a sec! we may not even need to figure out the corners like that... because you use the paint command... the problem is that you are drawing too many lines to define your 'interior'... i think the paint command will automatically end at the edge of the image so we don't need to figure it out... let me check...

hmmm, in your 'shadowcast' sub...

Code: Select all

    'draw shadow outline
    line img,(p1.x,p1.y)-(p2.x  ,p2.y  ),rgba(col,0,0,0)
    line img,(p2.x  ,p2.y  )-(p3.x  ,p3.y  ),rgba(col,0,0,0)
    line img,(p4.x,p4.y)-(p3.x  ,p3.y  ),rgba(col,0,0,0)
    line img,(p1.x,p1.y)-(p4.x,p4.y),rgba(col,0,0,0)

these are the four sides of the shadow points.... which line is the line that connects the two farthest points together? we need to comment that out...

based on this...

Code: Select all

        dim as point2d p1=shad1,p2=ch1,p3=ch2,p4=shad2

I would guess that p1 & p4 are the farthest out points so then it is the last 'line' above that needs to be commented out. BUT, this will not work yet because of the next issue...

also, your makepoint routine just figures out an arbitrary point along the shadow ray... we need the exact point of where the ray intersects the rectangle of the light box...

[leopardpm]

my first attempt didn't work... I am thinking of just using our own 'draw line' sub that starts at the given point and draws a line, using the given slope, until it reaches the edge of the light box...

[leopardpm]

ok, googled 'intersection between a ray and a line' and found this....

Given a line segment, that is two points (x1,y1) and (x2,y2), one point P(x,y) and an angle theta. How do we find if this line segment and the line ray that emanates from P at an angle theta from horizontal intersects or not? If they do intersect, how to find the point of intersection?

which is what we need... the answer is...

Points in the segment between (x1,y1) and (x2,y2) may be expressed as (x1+p(x2−x1),y1+p(y2−y1)) with 0≤p≤1.

Points in the ray starting from (x0,y0) with angle θ may be expressed as (x0+qcosθ,y0+qsinθ) with q≥0.

Setting resulting points to be equal creates a system of 2 equations with 2 variables and a few constraints, i.e.
x1+p(x2−x1)=x0+qcosθ
y1+p(y2−y1)=y0+qsinθ
with constraints 0≤p≤1 and q≥0.

You first find p and q such that the equivalence holds (depending on the values of the points and the angle you might find zero, one or infinite solutions), and then discard any p and q that don't satisfy their constraints. The resulting p and q determine the intersections.

trying to unravel the math and convert to logic code may be harder than just drawing our own line routine... lol

[leopardpm]

ok, there is something bugging me about the whole 'get slope' routine, in fact, I am hating all the slow math calcs... Each object will require 6 calls to the getslope routine and two calls to the makepoint routine resulting in a total of:

6 x SQRT
6 x ATAN2
2 x SIN
2 x COS
plus a multitude of other basic math ops (which are basically cheap though....)

per object... this is slowing things down....

IF, instead, we make our own breshams line routine which takes 2 points (light source and an object corner) and draws a line that follows these rules:

Start:
-advance to next point in the line
-test if the point is a corner point of the object, if so then start drawing a black line and stop testing for hitting the object (save this point for later)
-if not drawing black line then test if the point is the object, if so then exit routine because this line is blocked by the object and not going towards one of the two shadow points of the object
-test if point is past the light box rectangle, if not then goto start
exit

this eliminates ALL the higher order maths AND all of the 'IF THEN' tests/comparisons to determine which two slopes are the furthest.... and draws the outer edges and finds the two object corners points (the saved points above) so that a line can be draw between them before the paint command can be done...

woohoo! Both simplified AND optimized! at least that is the theory... lol

[leopardpm]

BUT... it does waste time following the line TO each corner point, especially the corner points which are not the shadow points... so maybe we keep the whole part to determine which two points are the shadow points, THEN we draw our line to the edge of the light box.... still gets rid of 4 x SQRT and ATAN2...


hold on... we can just remove all the SQRTs and the whole DIST variable because it is totally unused... it is calculated, transferred around, but nowhere I can see it being used for anything.... so that is one little speedup no matter what which way we fix the other issue...

well, got rid of all DIST references and the SQRT... no noticeable speedup... but at least its gone...lol

[leopardpm]

been optimizing a bit and just playing around with it... got about a 60-70% speed increase so far... but avoiding doing the line draw routine... not ready to under take it yet, even though it is just a basic copy paste from any of a number of previous programs... lol

[Boromir]

hold on... we can just remove all the SQRTs and the whole DIST variable because it is totally unused... it is calculated, transferred around, but nowhere I can see it being used for anything.... so that is one little speedup no matter what which way we fix the other issue...

well, got rid of all DIST references and the SQRT... no noticeable speedup... but at least its gone...lol

Yeah, that needed to go. It was a leftover from previous stuff.
We can use cos and sin tables to speed it up those operations.
I have to look through some of you previous posts in more detail. Lots of math I need to study. :)
Can you post your optimized version?

[dodicat]

ok, googled 'intersection between a ray and a line' and found this....

Given a line segment, that is two points (x1,y1) and (x2,y2), one point P(x,y) and an angle theta. How do we find if this line segment and the line ray that emanates from P at an angle theta from horizontal intersects or not? If they do intersect, how to find the point of intersection?

which is what we need... the answer is...

Only using 2D co-ordinate geometry

Code: Select all

Type line2d
    As Single x1,y1,x2,y2 'start and end of lines(x1,y1)-(x2,y2)
End Type
Type point2d
    As Single x,y
End Type


#define onscreen (mx>0) and (mx<xres) and (my>0) and (my<yres)
#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius


'distance from a point to a line segment
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)/M
    Oy=(M1*C2-M2*C1)/M
    Return Sqr((px-Ox)*(px-Ox)+(py-Oy)*(py-Oy))
End Function

'point of intersection of two lines
Function intersect(L1 As line2d,L2 As line2d) As point2d
    Dim As Double M1,M2,C1,C2
    Dim As point2d pt
    M1=(L1.y2-L1.y1)/(L1.x2-L1.x1)
    M2=(L2.y2-L2.y1)/(L2.x2-L2.x1)
    C1=(L1.y1*L1.x2-L1.x1*L1.y2)/(L1.x2-L1.x1)
    C2=(L2.y1*L2.x2-L2.x1*L2.y2)/(L2.x2-L2.x1)
    pt.x=(C2-C1)/(M1-M2)
    pt.y=(M1*C2-M2*C1)/(M1-M2)
    Return pt
End Function
#macro display
Screenlock
Cls
Draw String (20,20), "Drag circles by left click on and pull"
Draw String (20,40), "Angle in degrees from horizontal = " +Str(-angle)
For z As Long=1 To 2
    Circle (p(z).x,p(z).y),10
Next
Line(p(2).x,p(2).y)-(p(1).x,p(1).y)

Line(s.x1,s.y1)-(s.x2,s.y2)
If segment_distance(s.x1,s.y1,s.x2,s.y2,i.x,i.y) <1 Then
    Circle (i.x,I.y),10
    Draw String(i.x+20,i.y),Str(Int(I.x))+","+Str(Int(i.y))
Else
    Draw String(30,300),"No Intersection"
End If
Screenunlock
#endmacro

#macro mouse(m)
Dim As Long x=mx,y=my,dx,dy
Dim As Single pi=4*Atn(1)
While mb = 1
    Display():Sleep 1,1
    Getmouse mx,my,,mb
    If onscreen Then
        If mx<>x Or my<>y  Then
            dx = mx - x
            dy = my - y
            x = mx
            y = my
            p(m).x=x+dx
            p(m).y=y+dy
        End If
    End If
Wend
#endmacro

Screen 19
Dim As Integer xres,yres
Screeninfo xres,yres
Dim As line2d s 'fixed line segment
s.x1=400
s.y1=100
s.x2=600
s.y2=400
Dim As point2d p(1 To 2)={(100,100),(300,200)} 'arbitary starting points
Dim As Integer mx,my,mb
Dim As Single pi=4*Atn(1)
Do
    Dim As Single theta=Atan2(p(2).y-p(1).y,p(2).x-p(1).x)
    Dim As Long angle=theta*180/pi
    Getmouse(mx,my,,mb)
    Dim As point2d I=Intersect(s,Type<line2d>(p(1).x,p(1).y,p(2).x,p(2).y))
    
    
    display:Sleep 1,1
    For n As Long=1 To 2
        If incircle(p(n).x,p(n).y,10,mx,my) And mb=1 Then
            mouse(n)
        End If
    Next n
Loop Until Len(Inkey)





 

[Boromir]

Simple bresham that does the job. Now to port it over.

Code: Select all

Public Sub Lined(buff As Any Ptr,x As Integer,y As Integer,xv As Integer,yv As Integer,xs as integer,ys as integer,sw as integer,sh as integer)
dim as Single xnew,ynew
Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,xinc1,xinc2,yinc1,yinc2
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
if y2 >= y3 Then yinc1 = 1:yinc2 = 1 else yinc1 = -1:yinc2 = -1

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

While 1
  if xnew>xs+sw or xnew<xs or ynew>ys+sh or ynew<ys then exit sub
  PSet buff,(xnew,ynew),RGB(255,255,255)
  num += numadd
  if num >= den Then	num -= den:xnew += xinc1:ynew += yinc1
  xnew += xinc2:ynew += yinc2
Wend
End Sub



screen 18,32
dim as any ptr img
dim as integer x,y
img=imagecreate(640,480)

do
    getmouse x,y
screenlock
cls
line img,(0,0)-(640,480),rgb(0,0,0),bf
line img,(30,30)-(200,200),rgb(255,255,255),b
lined(img,100,100,x,y,30,30,170,170)
put(0,0),img,trans
screenunlock

sleep 1
loop until multikey(1)

[Boromir]

Got it working. Just needs to be optimized now.
Edit: Whoops! looks like it still doesn't work on the upper side.

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 800x400 for the glow
'
const scrw=1280
const scrh=1024
const pi = 4 * atn(1)
dim shared as double DtoR = pi / 180   ' degrees * DtoR = radians

type point2d
    x as integer
    y as integer
end type
type box
    p1 as point2d
    p2 as point2d
    p3 as point2d
    p4 as point2d
    p5 as point2d
    declare sub draw(img as any ptr)
end type

Public Sub Lined(p1 as point2d,p2 as point2d,xs as integer,ys as integer,sw as integer,sh as integer,byref p3 as point2d,byref edge as integer)
dim as Single xnew,ynew
Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,xinc1,xinc2,yinc1,yinc2
x3=p1.x:y3=p1.y
x2=p2.x:y2=p2.y
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
if y2 >= y3 Then yinc1 = 1:yinc2 = 1 else yinc1 = -1:yinc2 = -1

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

While 1
  if xnew>xs+sw orelse xnew>scrw then edge=3:p3.x=xnew:p3.y=ynew:exit sub
  if xnew<xs    orelse xnew<0    then edge=2:p3.x=xnew:p3.y=ynew:exit sub
  if ynew>ys+sh orelse ynew>scrh then edge=4:p3.x=xnew:p3.y=ynew:exit sub
  if ynew<ys    orelse ynew<0    then edge=1:p3.x=xnew:p3.y=ynew:exit sub
  num += numadd
  if num >= den Then	num -= den:xnew += xinc1:ynew += yinc1
  xnew += xinc2:ynew += yinc2
Wend
End Sub


public function getslope(p1 as point2d, _
                  p2 as point2d) as integer
        dim as integer xdif,ydif
        xdif = p2.x - p1.x
        ydif = p2.y - p1.y
        return atan2(ydif, xdif)*(180 / pi)
end function

public sub makepoint(angle as integer,plight as point2d, _
              p1 as point2d, _
              byref p2 as point2d,byref edge as integer)
    p2.x=p1.x-(cos(angle*DtoR)*(200))
    p2.y=p1.y-(sin(angle*DtoR)*(200))
    lined(p1,p2,plight.x-400,plight.y-200,800,400,p2,edge)
end sub

declare sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as integer)

screenres scrw,scrh,32
dim as box boxes(10)

dim as point2d plight
dim as integer slope1,slope2,slope3,slope4
for i as integer=0 to 10
with boxes(i)
.p1.x=100+(i*80) 'box
.p1.y=90 '    co-ordinate 1
.p2.x=80+(i*80)'box
.p2.y=100'    co-ordinate 2
.p3.x=120+(i*80)'box
.p3.y=100'    co-ordinate 3
.p4.x=100+(i*80)'box
.p4.y=110'    co-ordinate 4
.p5.x=100+(i*80)'(.p1.x+.p2.x+.p3.x+.p4.x)/4
.p5.y=100'(.p1.y+.p2.y+.p3.y+.p4.y)/4
end with
next i
'create light glow from 32 bit bitmap
dim as any ptr light
light=imagecreate(800,400)
bload "light.bmpx",light
'====================================
color rgb(255,255,255),rgb(0,0,0)
dim as any ptr img,back
img=imagecreate(scrw,scrh,rgba(0,0,0,0))
back=imagecreate(scrw,scrh,rgb(0,0,0))
For i As Integer=0 To 1700 Step 20
Line back,(0,i)-(scrw,i-scrw/2),RGB(150,0,50)
Next
For i As Integer=-700 To 1024 Step 20
Line back,(0,i)-(scrw,i+scrw/2),RGB(150,0,100)
Next
dim as integer fps,frames
dim as double prevtime
prevtime=timer
do
getmouse plight.x,plight.y'put light.x and y at mouse

screenlock
Cls
Put (0,0),back,pset
line img,(0,0)-(scrw,scrh),rgba(0,0,0,0),bf'fill image with nothingness
put img,(plight.x-400,plight.y-200),light,alpha'   put light into it
for i as integer=0 to 10
shadowcast(boxes(i),plight,img,i)'cast shadow
next i
for i as integer=0 to 10
boxes(i).draw(img)
next i
put (0,0),img,alpha'draw result
print "fps "+str(fps)
screenunlock

sleep 1
frames+=1
if timer-1>prevtime then fps=frames:frames=0:prevtime=timer
loop until multikey(1)




sub box.draw(img as any ptr)
    'line img,(p1.x,p1.y)-(p2.x,p2.y),rgb(0,0,0)
    'line img,(p2.x,p2.y)-(p4.x,p4.y),rgb(0,0,0)
    'line img,(p3.x,p3.y)-(p4.x,p4.y),rgb(0,0,0)
    'line img,(p3.x,p3.y)-(p1.x,p1.y),rgb(0,0,0)
    line img,(p1.x,p1.y-20)-(p2.x,p2.y-20),rgb(255,0,0)
    line img,(p2.x,p2.y-20)-(p2.x,p2.y),rgb(255,0,0)
    line img,(p2.x,p2.y)-(p4.x,p4.y),rgb(255,0,0)
    line img,(p3.x,p3.y)-(p4.x,p4.y),rgb(255,0,0)
    line img,(p3.x,p3.y)-(p3.x,p3.y-20),rgb(255,0,0)
    line img,(p3.x,p3.y-20)-(p1.x,p1.y-20),rgb(255,0,0)
    line img,(p4.x,p4.y)-(p4.x,p4.y-20),rgb(255,0,0)
    line img,(p2.x,p2.y-20)-(p4.x,p4.y-20),rgb(255,0,0)
    line img,(p3.x,p3.y-20)-(p4.x,p4.y-20),rgb(255,0,0)
    paint img,(p1.x+1,p1.y+3),rgb(50,0,0),rgb(255,0,0)
    paint img,(p1.x-1,p1.y+3),rgb(100,0,0),rgb(255,0,0)
    paint img,(p1.x,p1.y-1),rgb(255,0,0),rgb(255,0,0)
end sub

sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as integer)
dim as point2d shad1,shad2
dim as integer slope1,slope2,slope3,slope4

dim as point2d ch1,ch2
dim as integer testval=-200
'calculate differences for each point

with box1
slope1=getslope(.p2,plight)'+180
slope2=getslope(.p4,plight)'+180
slope3=getslope(.p1,plight)'+180
slope4=getslope(.p3,plight)'+180
dim as integer k,k1,k2,k3,k4
if slope1>0 then k+=1:k1=1
if slope2>0 then k+=1:k2=1
if slope3>0 then k+=1:k3=1
if slope4>0 then k+=1:k4=1
if k>0 andalso k<4 andalso plight.x<(box1.p2.x+box1.p3.x)/2 then
    if k1=1 then slope1-=360
    if k2=1 then slope2-=360
    if k3=1 then slope3-=360
    if k4=1 then slope4-=360
end if
'===================================================
if slope1>testval then testval=slope1:ch1.x=.p2.x:ch1.y=.p2.y      ':chx2=x:chy2=y2
if slope2>testval then testval=slope2:ch1.x=.p4.x:ch1.y=.p4.y     ':chx2=x:chy2=y
if slope3>testval then testval=slope3:ch1.x=.p1.x:ch1.y=.p1.y       ':chx2=x2:chy2=y2
if slope4>testval then testval=slope4:ch1.x=.p3.x:ch1.y=.p3.y      ':chx2=x2:chy2=y
'testval=-1
if slope1<testval then testval=slope1:ch2.x=.p2.x:ch2.y=.p2.y
if slope2<testval then testval=slope2:ch2.x=.p4.x:ch2.y=.p4.y
if slope3<testval then testval=slope3:ch2.x=.p1.x:ch2.y=.p1.y
if slope4<testval then testval=slope4:ch2.x=.p3.x:ch2.y=.p3.y
'===================================================
end with
'use selected points
dim as integer s,edge1,edge2
s=getslope(ch1,plight)'get slope difference for one edge of the shadow
makepoint(s,plight,ch1,shad1,edge1)'create first point
s=getslope(ch2,plight)'get slope difference for the other edge
makepoint(s,plight,ch2,shad2,edge2)'create second point
    dim as point2d p1=shad1,p2=ch1,p3=ch2,p4=shad2,p5=box1.p5
'draw shadow outline
line img,(p1.x,p1.y)-(p2.x,p2.y),rgba(col,0,0,0)
line img,(p2.x,p2.y)-(p3.x,p3.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p3.x,p3.y),rgba(col,0,0,0)
if (edge2=1 AndAlso edge1=2) orelse (edge1=1 AndAlso edge2=2) orelse (edge1=4 andalso edge2=3) orelse (edge2=4 AndAlso edge1=3) then 
line img,(p1.x,p1.y)-(p4.x,p1.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p4.x,p1.y),rgba(col,0,0,0)
elseif (edge2=1 andalso edge1=3) orelse (edge2=4 AndAlso edge1=2) orelse (edge1=1 andalso edge2=3) orelse (edge1=4 AndAlso edge2=2) then
line img,(p1.x,p1.y)-(p1.x,p4.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p1.x,p4.y),rgba(col,0,0,0)
else 
line img,(p4.x,p4.y)-(p1.x,p1.y),rgba(col,0,0,0)
end if
'fill shadow outline
paint img,((p1.x+p2.x+p3.x+p4.x)/4, _
           (p1.y+p2.y+p3.y+p4.y)/4),rgba(col,0,0,0),rgba(col,0,0,0)
'draw box
end sub

[BasicCoder2]

That looks very good. I had to reduce the window size to fit my screen and moved the row of boxes down 100 pixels. So does this work with a random array of boxes not just a row? When light is thrown it doesn't just yellow the area it brightens what ever color it hits so can this work the same? I imagine maybe using the alpha value?
.

[Boromir]

That looks very good. I had to reduce the window size to fit my screen and moved the row of boxes down 100 pixels. So does this work with a random array of boxes not just a row?
.

Yes, the boxes can be positioned anywhere. Size can also be changed as wall as aspect ratio.

When light is thrown it doesn't just yellow the area it brightens what ever color it hits so can this work the same? I imagine maybe using the alpha value?
.

Yup, It uses a 32 bit glow image and alpha blends it with whatever is underneath.
I added a background to make it easy to see.

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 800x400 for the glow
'
const scrw=1280
const scrh=1024
const pi = 4 * atn(1)
dim shared as double DtoR = pi / 180   ' degrees * DtoR = radians

type point2d
    x as integer
    y as integer
end type
type box
    p1 as point2d
    p2 as point2d
    p3 as point2d
    p4 as point2d
    p5 as point2d
    declare sub draw(img as any ptr)
end type

Public Sub Lined(p1 as point2d,p2 as point2d,xs as integer,ys as integer,sw as integer,sh as integer,byref p3 as point2d,byref edge as integer)
dim as Single xnew,ynew
Dim As Single dx,dy,x3,y3,x2,y2,ynum,den,num,numadd,xinc1,xinc2,yinc1,yinc2
x3=p1.x:y3=p1.y
x2=p2.x:y2=p2.y
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
if y2 >= y3 Then yinc1 = 1:yinc2 = 1 else yinc1 = -1:yinc2 = -1

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

While 1
  if xnew>xs+sw orelse xnew>scrw then edge=3:p3.x=xnew:p3.y=ynew:exit sub
  if xnew<xs    orelse xnew<0    then edge=2:p3.x=xnew:p3.y=ynew:exit sub
  if ynew>ys+sh orelse ynew>scrh then edge=4:p3.x=xnew:p3.y=ynew:exit sub
  if ynew<ys    orelse ynew<0    then edge=1:p3.x=xnew:p3.y=ynew:exit sub
  num += numadd
  if num >= den Then	num -= den:xnew += xinc1:ynew += yinc1
  xnew += xinc2:ynew += yinc2
Wend
End Sub


public function getslope(p1 as point2d, _
                  p2 as point2d) as integer
        dim as integer xdif,ydif
        xdif = p2.x - p1.x
        ydif = p2.y - p1.y
        return atan2(ydif, xdif)*(180 / pi)
end function

public sub makepoint(angle as integer,plight as point2d, _
              p1 as point2d, _
              byref p2 as point2d,byref edge as integer)
    p2.x=p1.x-(cos(angle*DtoR)*(200))
    p2.y=p1.y-(sin(angle*DtoR)*(200))
    lined(p1,p2,plight.x-400,plight.y-200,800,400,p2,edge)
end sub

declare sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as integer)

screenres scrw,scrh,32
dim as box boxes(99)

Dim as point2d plight
dim as integer slope1,slope2,slope3,slope4
for y as integer=0 to 9
	For x As Integer=0 To 10
with boxes(x+(y*10))
.p1.x=100+(x*80) 'box
.p1.y=90 +(y*80)'    co-ordinate 1
.p2.x=80+(x*80)'box
.p2.y=100+(y*80)'    co-ordinate 2
.p3.x=120+(x*80)'box
.p3.y=100+(y*80)'    co-ordinate 3
.p4.x=100+(x*80)'box
.p4.y=110+(y*80)'    co-ordinate 4
.p5.x=100+(x*80)'(.p1.x+.p2.x+.p3.x+.p4.x)/4
.p5.y=100+(y*80)'(.p1.y+.p2.y+.p3.y+.p4.y)/4
end With
	Next x
next y

'create light glow from 32 bit bitmap
dim as any ptr light
light=imagecreate(800,400)
bload "light.bmpx",light
'====================================
color rgb(255,255,255),rgb(0,0,0)
dim as any ptr img,back
img=imagecreate(scrw,scrh,rgba(0,0,0,0))
back=imagecreate(scrw,scrh,rgb(0,0,0))
For i As Integer=0 To 1700 Step 20
Line back,(0,i)-(scrw,i-scrw/2),RGB(150,0,50)
Next
For i As Integer=-700 To 1024 Step 20
Line back,(0,i)-(scrw,i+scrw/2),RGB(150,0,100)
Next
dim as integer fps,frames
dim as double prevtime
prevtime=timer
do
getmouse plight.x,plight.y'put light.x and y at mouse

screenlock
Cls
Put (0,0),back,pset
line img,(0,0)-(scrw,scrh),rgba(0,0,0,0),bf'fill image with nothingness
put img,(plight.x-400,plight.y-200),light,alpha'   put light into it
for i as integer=0 to UBound(boxes)
shadowcast(boxes(i),plight,img,i)'cast shadow
next i
For i as integer=0 to UBound(boxes)
boxes(i).draw(img)
next i
put (0,0),img,alpha'draw result
print "fps "+str(fps)
screenunlock

sleep 1
frames+=1
if timer-1>prevtime then fps=frames:frames=0:prevtime=timer
loop until multikey(1)




sub box.draw(img as any ptr)
    'line img,(p1.x,p1.y)-(p2.x,p2.y),rgb(0,0,0)
    'line img,(p2.x,p2.y)-(p4.x,p4.y),rgb(0,0,0)
    'line img,(p3.x,p3.y)-(p4.x,p4.y),rgb(0,0,0)
    'line img,(p3.x,p3.y)-(p1.x,p1.y),rgb(0,0,0)
    line img,(p1.x,p1.y-20)-(p2.x,p2.y-20),rgb(255,0,0)
    line img,(p2.x,p2.y-20)-(p2.x,p2.y),rgb(255,0,0)
    line img,(p2.x,p2.y)-(p4.x,p4.y),rgb(255,0,0)
    line img,(p3.x,p3.y)-(p4.x,p4.y),rgb(255,0,0)
    line img,(p3.x,p3.y)-(p3.x,p3.y-20),rgb(255,0,0)
    line img,(p3.x,p3.y-20)-(p1.x,p1.y-20),rgb(255,0,0)
    line img,(p4.x,p4.y)-(p4.x,p4.y-20),rgb(255,0,0)
    line img,(p2.x,p2.y-20)-(p4.x,p4.y-20),rgb(255,0,0)
    line img,(p3.x,p3.y-20)-(p4.x,p4.y-20),rgb(255,0,0)
    paint img,(p1.x+1,p1.y+3),rgb(50,0,0),rgb(255,0,0)
    paint img,(p1.x-1,p1.y+3),rgb(100,0,0),rgb(255,0,0)
    paint img,(p1.x,p1.y-1),rgb(255,0,0),rgb(255,0,0)
end sub

sub shadowcast(box1 as box,plight as point2d,img as any ptr,col as integer)
dim as point2d shad1,shad2
dim as integer slope1,slope2,slope3,slope4

dim as point2d ch1,ch2
dim as integer testval=-200
'calculate differences for each point

with box1
slope1=getslope(.p2,plight)'+180
slope2=getslope(.p4,plight)'+180
slope3=getslope(.p1,plight)'+180
slope4=getslope(.p3,plight)'+180
dim as integer k,k1,k2,k3,k4
if slope1>0 then k+=1:k1=1
if slope2>0 then k+=1:k2=1
if slope3>0 then k+=1:k3=1
if slope4>0 then k+=1:k4=1
if k>0 andalso k<4 andalso plight.x<(box1.p2.x+box1.p3.x)/2 then
    if k1=1 then slope1-=360
    if k2=1 then slope2-=360
    if k3=1 then slope3-=360
    if k4=1 then slope4-=360
end if
'===================================================
if slope1>testval then testval=slope1:ch1.x=.p2.x:ch1.y=.p2.y      ':chx2=x:chy2=y2
if slope2>testval then testval=slope2:ch1.x=.p4.x:ch1.y=.p4.y     ':chx2=x:chy2=y
if slope3>testval then testval=slope3:ch1.x=.p1.x:ch1.y=.p1.y       ':chx2=x2:chy2=y2
if slope4>testval then testval=slope4:ch1.x=.p3.x:ch1.y=.p3.y      ':chx2=x2:chy2=y
'testval=-1
if slope1<testval then testval=slope1:ch2.x=.p2.x:ch2.y=.p2.y
if slope2<testval then testval=slope2:ch2.x=.p4.x:ch2.y=.p4.y
if slope3<testval then testval=slope3:ch2.x=.p1.x:ch2.y=.p1.y
if slope4<testval then testval=slope4:ch2.x=.p3.x:ch2.y=.p3.y
'===================================================
end with
'use selected points
dim as integer s,edge1,edge2
s=getslope(ch1,plight)'get slope difference for one edge of the shadow
makepoint(s,plight,ch1,shad1,edge1)'create first point
s=getslope(ch2,plight)'get slope difference for the other edge
makepoint(s,plight,ch2,shad2,edge2)'create second point
    dim as point2d p1=shad1,p2=ch1,p3=ch2,p4=shad2,p5=box1.p5
'draw shadow outline
line img,(p1.x,p1.y)-(p2.x,p2.y),rgba(col,0,0,0)
line img,(p2.x,p2.y)-(p3.x,p3.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p3.x,p3.y),rgba(col,0,0,0)
if (edge2=1 AndAlso edge1=2) orelse (edge1=1 AndAlso edge2=2) orelse (edge1=4 andalso edge2=3) orelse (edge2=4 AndAlso edge1=3) then 
line img,(p1.x,p1.y)-(p4.x,p1.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p4.x,p1.y),rgba(col,0,0,0)
elseif (edge2=1 andalso edge1=3) orelse (edge2=4 AndAlso edge1=2) orelse (edge1=1 andalso edge2=3) orelse (edge1=4 AndAlso edge2=2) then
line img,(p1.x,p1.y)-(p1.x,p4.y),rgba(col,0,0,0)
line img,(p4.x,p4.y)-(p1.x,p4.y),rgba(col,0,0,0)
else 
line img,(p4.x,p4.y)-(p1.x,p1.y),rgba(col,0,0,0)
end if
'fill shadow outline
paint img,((p1.x+p2.x+p3.x+p4.x)/4, _
           (p1.y+p2.y+p3.y+p4.y)/4),rgba(col,0,0,0),rgba(col,0,0,0)
'draw box
end sub