Isometric shadow casting light.

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

Re: Isometric shadow casting light.

Postby Boromir » Mar 02, 2017 5:16

I am thinking your crash is a memory leak - since you are painting to an image buffer, it is overspilling out of the buffer somehow...

that's what I thought too but i removed all drawing routines and it still crashes.

edit: it seems the problem was imagecreating every round. fixed now.

now for the leak issue
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 02, 2017 5:20

leopardpm wrote:for fixing the paint issue, choose the point that is midway between opposing corners... but I can't figure out exactly which two coordinate variables would be opposing in your code:

Code: Select all

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,(chx2+1,chy1+1),rgba(0,0,0,0),rgba(0,0,0,0)

does this code draw each adjacent side of the shadow polygon in sequential order?

if so, then this should always choose a point in the box:

paint img, (abs(shx2-chx1),abs(shy1-chy2),rgba(0,0,0,0),rgba(0,0,0,0)


My idea also but it doesn't seem to work.
edit: found out why. It seems my shadow goes way off the screen making the paint operation attempt to paint offscreen
Last edited by Boromir on Mar 02, 2017 5:22, edited 1 time in total.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 02, 2017 5:22

found another, probably related, error:

Here is good screenshot
Image

here is the paint error screenshot
Image

and here is other error - it is doing the paint problem but the shadow polygon is wrong...
Image
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 02, 2017 5:28

wait a sec.... why are you using RGBA? does the light image use the alpha for the fade? I think that is at least part of the problem with the paint issue.... the reason is because the screen and some of FB's graphix commands ignore the alpha channel... perhaps paint does as well? For instance, pset a dot with alpha onto the screen, then read it back with point.... it will NOT have any alpha anymore... this might be the issue maybe... might explain the memory leak thing

re: shadow going way offscreen - I tried to change that before by adjusting your '7000' number to something like '40'... but that didn't seem to work... what is the '7000' number for? I am confused...
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 02, 2017 5:41

leopardpm wrote:wait a sec.... why are you using RGBA? does the light image use the alpha for the fade? I think that is at least part of the problem with the paint issue.... the reason is because the screen and some of FB's graphix commands ignore the alpha channel... perhaps paint does as well? For instance, pset a dot with alpha onto the screen, then read it back with point.... it will NOT have any alpha anymore... this might be the issue maybe... might explain the memory leak thing

re: shadow going way offscreen - I tried to change that before by adjusting your '7000' number to something like '40'... but that didn't seem to work... what is the '7000' number for? I am confused...


fbgfx does not ignore alpha. It just over-writes alpha values instead of blending.
for blending you can use gfx_alpha_primitives when initializing the screen.
You can see this by adding a color statement at the beginning

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 400x400 for the glow
'
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(abs(ydif), abs(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*70'massively in need of optimization
    ydif=ydif*70'massively in need of optimization
    x2=x1+(ydif)  -(ydif+xdif)
    y2=y1-(xdif)  -(ydif-xdif)
end sub

screen 18,32
dim as integer x,y,x2,y2,xl,yl, _
               shx1,shy1,shx2,shy2,dist,xdif,ydif
dim as integer slope1,slope2,slope3,slope4
x=100 'box
y=100 '    co-ordinate 1
x2=110'box
y2=110'    co-ordinate 2

'create light glow from 32 bit bitmap
dim as any ptr light
light=imagecreate(400,400)
bload "light.bmpx",light
'====================================
color rgb(255,255,255),rgb(255,255,255)
dim as any ptr img
img=imagecreate(640,480,rgba(0,0,0,0))'create temporary image array

do
screenlock
cls
getmouse xl,yl'put light at mouse
line img,(0,0)-(640,480),rgba(0,0,0,0),bf
dim as integer chx1,chy1,chx2,chy2,testval
'calculate differences for each point
slope1=getslope(xdif,ydif,x2,y,xl,yl)
slope2=getslope(xdif,ydif,x2,y2,xl,yl)
slope3=getslope(xdif,ydif,x,y,xl,yl)
slope4=getslope(xdif,ydif,x,y2,xl,yl)
'find two edge points for the shadow caster
'===================================================
if slope1>=testval then testval=slope1:chx1=x2:chy1=y
if slope2>=testval then testval=slope2:chx1=x2:chy1=y2
if slope3>=testval then testval=slope3:chx1=x:chy1=y
if slope4>=testval then testval=slope4:chx1=x:chy1=y2

if slope1<=testval then testval=slope1:chx2=x2:chy2=y
if slope2<=testval then testval=slope2:chx2=x2:chy2=y2
if slope3<=testval then testval=slope3:chx2=x:chy2=y
if slope4<=testval then testval=slope4:chx2=x:chy2=y2
'===================================================

put img,(xl-200,yl-200),light,alpha'   put light into it

getslope(xdif,ydif,chx1,chy1,xl,yl)'get slope difference for one edge of the shadow
makepoint(xdif,ydif,30,chx1,chy1,shx1,shy1)'create first point
getslope(xdif,ydif,chx2,chy2,xl,yl)'get slope difference for the other edge
makepoint(xdif,ydif,30,chx2,chy2,shx2,shy2)'create second point

'create shadow block
line img,(shx1,shy1)-(chx1,chy1),rgba(0,0,0,0)
line img,(chx1,chy1)-(chx2,chy2),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)

'paint img,(chx2+1,chy1+1),rgba(0,0,0,0),rgba(0,0,0,0)
paint img, (abs(shx2-chx1),abs(shy2-chy1)),rgba(0,0,0,0),rgba(0,0,0,0)
'draw glow
put (0,0),img,alpha
'draw shadow casting box
line (x,y)-(x2,y2),rgb(0,0,0),bf



screenunlock
sleep 1
loop until multikey(1)



the 7000 is unnecessary. it can be 70
you only notice the problem with a massive light source
Last edited by Boromir on Mar 02, 2017 5:48, edited 2 times in total.
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 02, 2017 5:44

btw I fixed the crash bug :) it had to do with image creating every iteration and never destroying it.

I'll work some more on this tomorrow. It's late for me.
Last edited by Boromir on Mar 02, 2017 15:54, edited 1 time in total.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 02, 2017 5:51

Boromir wrote:btw I fixed the crash bug :) it had to do with image creating every iteration


LOL! funny,when first looking through your code I noticed everything was in the loop including the imagecreate command, was gonna check to see if you deleted it as well at the end of the loop but... got distracted (it happens too easily sometimes!)
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 02, 2017 5:52

k goodnight - post your fixed program when you wake up... so all problems have been solved then?
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 02, 2017 13:51

leopardpm wrote:so all problems have been solved then?

Not totally. There are still issues on certain angles.
I removed the 7000 so it would be easier to see exactly what happens.

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 400x400 for the glow
'
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(abs(ydif), abs(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'*70'massively in need of optimization
    ydif=ydif'*70'massively in need of optimization
    x2=x1+(ydif)  -(ydif+xdif)
    y2=y1-(xdif)  -(ydif-xdif)
end sub

screen 18,32
dim as integer x,y,x2,y2,xl,yl, _
               shx1,shy1,shx2,shy2,dist,xdif,ydif
dim as integer slope1,slope2,slope3,slope4
x=100 'box
y=100 '    co-ordinate 1
x2=110'box
y2=110'    co-ordinate 2

'create light glow from 32 bit bitmap
dim as any ptr light
light=imagecreate(400,400)
bload "light.bmpx",light
'====================================
color rgb(0,0,0),rgb(255,255,255)
dim as any ptr img
img=imagecreate(640,480,rgba(0,0,0,0))'create temporary image array

do
screenlock
cls
getmouse xl,yl'put light at mouse
line img,(0,0)-(640,480),rgba(0,0,0,0),bf
dim as integer chx1,chy1,chx2,chy2,testval
'calculate differences for each point
slope1=getslope(xdif,ydif,x2,y,xl,yl)
slope2=getslope(xdif,ydif,x2,y2,xl,yl)
slope3=getslope(xdif,ydif,x,y,xl,yl)
slope4=getslope(xdif,ydif,x,y2,xl,yl)
'find two edge points for the shadow caster
'===================================================
if slope1>testval then testval=slope1:chx1=x2:chy1=y      :chx2=x:chy2=y2
if slope2>testval then testval=slope2:chx1=x2:chy1=y2     :chx2=x:chy2=y
if slope3>testval then testval=slope3:chx1=x:chy1=y       :chx2=x2:chy2=y2
if slope4>testval then testval=slope4:chx1=x:chy1=y2      :chx2=x2:chy2=y
'===================================================

put img,(xl-200,yl-200),light,alpha'   put light into it

getslope(xdif,ydif,chx1,chy1,xl,yl)'get slope difference for one edge of the shadow
makepoint(xdif,ydif,30,chx1,chy1,shx1,shy1)'create first point
getslope(xdif,ydif,chx2,chy2,xl,yl)'get slope difference for the other edge
makepoint(xdif,ydif,30,chx2,chy2,shx2,shy2)'create second point

'create shadow block
line img,(shx1,shy1)-(chx1,chy1),rgba(0,0,0,0)
line img,(chx1,chy1)-(chx2,chy2),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)

'paint img,(chx2+1,chy1+1),rgba(0,0,0,0),rgba(0,0,0,0)
paint img,(shx1+(chx2-shx1),shy1+(chy1-shy1)),rgba(0,0,0,0),rgba(0,0,0,0)
'draw glow
put (0,0),img,alpha
'draw shadow casting box
'line (x,y)-(x2,y2),rgb(0,0,0),bf
pset (shx1+(chx2-shx1),shy1+(chy1-shy1)),rgb(0,0,0)

print slope1;slope2;slope3;slope4
screenunlock
sleep 1
loop until multikey(1)


leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 07, 2017 13:00

hmmm... really driving me crazy! it is so very close, and looks good except for those weird cases at 0, 90, 180, 270 degrees - it seems to mostly be when either the first pair or the second pair of slops are the same...
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 09, 2017 14:52

I thought of a sloppy fix.

Find all the problematic angles.
If the current angle is problematic shift the current angle over by 1 degree.
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 09, 2017 15:00

Boromir wrote:I thought of a sloppy fix.

Find all the problematic angles.
If the current angle is problematic shift the current angle over by 1 degree.
already tried a similar 'sloppy fix' - I added a small random value to the angles.... didn't work so good.
Boromir
Posts: 451
Joined: Apr 30, 2015 19:28
Location: Texas,U.S., Earth,Solar System
Contact:

Re: Isometric shadow casting light.

Postby Boromir » Mar 31, 2017 16:09

Victory! It works.
https://drive.google.com/file/d/0BxwvH1 ... sp=sharing

Code: Select all

'2d Quad-Shadow caster
'by Ezekiel Gutierrez and Leopardpm
'
'requires light.bmpx 400x200 for the glow
'
type point2d
    x as integer
    y as integer
end type
type box
    p1 as point2d
    p2 as point2d
    p3 as point2d
    p4 as point2d
    declare sub draw
end type

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

sub makepoint(xdif as integer,ydif as integer,dist as integer, _
              p1 as point2d, _
              byref p2 as point2d)
    xdif=xdif*70'massively in need of optimization
    ydif=ydif*70'massively in need of optimization
    p2.x=p1.x+(ydif)  -(ydif+xdif)
    p2.y=p1.y-(xdif)  -(ydif-xdif)
end sub

screen 18,32
dim as box box1
dim as point2d plight,shad1,shad2
dim as integer dist,xdif,ydif
dim as single slope1,slope2,slope3,slope4

box1.p1.x=100 'box
box1.p1.y=90 '    co-ordinate 1
box1.p2.x=80'box
box1.p2.y=100'    co-ordinate 2
box1.p3.x=120'box
box1.p3.y=100'    co-ordinate 3
box1.p4.x=100'box
box1.p4.y=110'    co-ordinate 4
'create light glow from 32 bit bitmap
dim as any ptr light
light=imagecreate(400,200)
bload "light.bmpx",light
'====================================
color rgb(255,255,255),rgb(0,0,0)
dim as any ptr img
img=imagecreate(640,480,rgba(0,0,0,0))

do
screenlock
cls
getmouse plight.x,plight.y'put light.x and y at mouse
line img,(0,0)-(640,480),rgba(0,0,0,0),bf'fill image with nothingness
put img,(plight.x-200,plight.y-100),light,alpha'   put light into it

dim as point2d ch1,ch2
dim as single testval=-200,t2
'calculate differences for each point
with box1
slope1=getslope(xdif,ydif,.p2,plight)'+180
slope2=getslope(xdif,ydif,.p4,plight)'+180
slope3=getslope(xdif,ydif,.p1,plight)'+180
slope4=getslope(xdif,ydif,.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 and k<4 and plight.x<box1.p2.x 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:t2=1      ':chx2=x:chy2=y2
if slope2>testval then testval=slope2:ch1.x=.p4.x:ch1.y=.p4.y:t2=2     ':chx2=x:chy2=y
if slope3>testval then testval=slope3:ch1.x=.p1.x:ch1.y=.p1.y:t2=3       ':chx2=x2:chy2=y2
if slope4>testval then testval=slope4:ch1.x=.p3.x:ch1.y=.p3.y:t2=4      ':chx2=x2:chy2=y
'testval=-1
if slope1<testval and t2<>1 then testval=slope1:ch2.x=.p2.x:ch2.y=.p2.y
if slope2<testval and t2<>2 then testval=slope2:ch2.x=.p4.x:ch2.y=.p4.y
if slope3<testval and t2<>3 then testval=slope3:ch2.x=.p1.x:ch2.y=.p1.y
if slope4<testval and t2<>4 then testval=slope4:ch2.x=.p3.x:ch2.y=.p3.y
'===================================================
end with

getslope(xdif,ydif,ch1,plight)'get slope difference for one edge of the shadow
makepoint(xdif,ydif,30,ch1,shad1)'create first point
getslope(xdif,ydif,ch2,plight)'get slope difference for the other edge
makepoint(xdif,ydif,30,ch2,shad2)'create second point

'create shadow block
line img,(shad1.x,shad1.y)-(ch1.x  ,ch1.y  ),rgba(0,0,0,0)
line img,(ch1.x  ,ch1.y  )-(ch2.x  ,ch2.y  ),rgba(0,0,0,0)
line img,(shad2.x,shad2.y)-(ch2.x  ,ch2.y  ),rgba(0,0,0,0)
line img,(shad1.x,shad1.y)-(shad2.x,shad2.y),rgba(0,0,0,0)
'fill shadow block
'paint img,(shad1.x+(ch2.x-shad1.x),shad1.y+(ch1.y-shad1.y)),rgba(0,0,0,0),rgba(0,0,0,0)
'draw glow
put (0,0),img,alpha
'draw shadow casting box
box1.draw

print slope2;slope4;slope1;slope3

screenunlock
sleep 1
loop until multikey(1)


sub box.draw
    line (p1.x,p1.y)-(p2.x,p2.y),rgb(0,0,0)
    line (p2.x,p2.y)-(p4.x,p4.y),rgb(0,0,0)
    line (p3.x,p3.y)-(p4.x,p4.y),rgb(0,0,0)
    line (p3.x,p3.y)-(p1.x,p1.y),rgb(0,0,0)
end sub

dodicat
Posts: 6567
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Isometric shadow casting light.

Postby dodicat » Mar 31, 2017 17:12

Nice, the maths seem good, and the glow.

I have used the vector dot product previously to get the angles subtended at a point.
VIZ :(drag circles with the mouse)

Code: Select all


Type pt
    As Long 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


Function dot(v1 As pt,v2 As pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    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 'normalize
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2 'normalize
    Return (v1x*v2x+v1y*v2y) '1 * 1 *cos(angle between v1 and v2)
End Function


#macro display
'legs meet at p(2)
    dim as pt L1=(p(1).x-p(2).x,p(1).y-p(2).y)'leg 1
    dim as pt L2=(p(3).x-p(2).x,p(3).y-p(2).y)'leg 2
    dim as single angle=acos(dot(L1,L2))*(180/pi)'angle between legs in degrees
    screenlock
    cls
    draw string (20,20), "Drag circles by left click on and pull"
     draw string (20,40), "Angle in degrees"
    for z as long=1 to 3
        circle (p(z).x,p(z).y),10
    next
    line(p(2).x,p(2).y)-(p(1).x,p(1).y)
    line(p(2).x,p(2).y)-(p(3).x,p(3).y)
    draw string(p(2).x+20,p(2).y),str(angle)
    screenunlock
#endmacro

#macro mouse(m)
Dim As Long x=mx,y=my,dx,dy
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 pt p(1 to 3)={(100,100),(300,200),(200,400)} 'arbitary starting points
dim as integer mx,my,mb
dim as single pi=4*atn(1)
do
   
    getmouse(mx,my,,mb)
    display:sleep 1,1
    for n as long=1 to 3
        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)



 


And putting this to use in shadows:

Code: Select all

Type pt
    As Long x,y
End Type

Type polygon
    As pt p(Any) 'p(0) is the centroid,p(1) ... the vertices
    inc As Long 'colour increment for paint
    As Long maxd 'maximum radius
End Type

Sub drawpolygon(p() As Pt,Byref col As Ulong,fill as ulong=0,pt as long=0,Byval im As Any Pointer=0)
    Dim k As Integer=Ubound(p)+1
    Dim As Integer index,nextindex
    For n As Integer=1 To Ubound(p)
        index=n Mod k:nextindex=(n+1) Mod k
        If nextindex=0 Then nextindex=1
        Line im,(p(index).x,p(index).y)-(p(nextindex).x,p(nextindex).y),col
    Next
    if pt then paint(p(0).x,p(0).y),fill,col
End Sub

Function inpolygon(p1() As Pt,Byval p2 As Pt) As Long '(is a point inside a polygon)
    #macro Winder(L1,L2,p)
    ((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 dot(v1 As pt,v2 As pt) As Single 'dot product |v1| * |v2| *cos(angle between v1 and v2)
    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 'normalize
    Dim As Single v2x=v2.x/d2,v2y=v2.y/d2 'normalize
    Return (v1x*v2x+v1y*v2y) '1 * 1 *cos(angle between v1 and v2)
End Function

Function shortline(fp As pt,p As pt,length As Long) As pt 'line from fp to p with length (+ or - )
    Dim As Single diffx=p.x-fp.x,diffy=p.y-fp.y
    Dim As Single L=Sqr(diffx*diffx+diffy*diffy)
    Return Type<pt>(fp.x+length*diffx/L,fp.y+length*diffy/L)
End Function

Sub GetpolygonShadow(Byval b1 As polygon,c As pt)  'determine and paint a shadow
    #define dist(a,b) Sqr((a.x-b.x)*(a.x-b.x) + (a.y-b.y)*(a.y-b.y))
    Dim As Single dt=2
    Dim As Long id1,id2
    'let every polygon vertex meet every other polygon vertex
    For p1 As Long  = 1 To Ubound(b1.p)-1
        For p2 As Long  = p1 + 1 To Ubound(b1.p)
            'for each pair
            Var a1=Type<pt>(b1.p(p1).x-c.x,b1.p(p1).y-c.y)'leg 1, point p(p1) to mouse
            Var a2=Type<pt>(b1.p(p2).x-c.x,b1.p(p2).y-c.y)'leg 2, point p(p2) to mouse
            Var a3=dot(a1,a2)'a3 is the cosine of the angle between leg 1 and leg 2
            If dt>a3 Then dt=a3:id1=p1:id2=p2 'get smallest cosine and corresponding points
        Next p2                                'i.e. biggest angle between legs
    Next p1
    'use shortline to draw lines to mouse, direction away from mouse and offscreen
    Var S1=shortline(b1.p(id1),c,-2000)
    Line(s1.x,s1.y)-(b1.p(id1).x,b1.p(id1).y),Rgb(0,0,b1.inc)
    Var S2=shortline(b1.p(id2),c,-2000)
    Line(s2.x,s2.y)-(b1.p(id2).x,b1.p(id2).y),Rgb(0,0,b1.inc)
    'FOR THE PAINTING CENTRE:
    '(dx,dy) is the vector joining the centriod to mouse
    Dim As Single dx=c.x-b1.p(0).x,dy=c.y-b1.p(0).y
    Var d=dist(c,b1.p(0)) 'distance from centroid to mouse
    dx=-dx/d:dy=-dy/d'this vector is normalized
    'make sure the centre for painting is just outside the polygon.
    dx=b1.p(0).x+1.2*b1.maxd*dx:dy=b1.p(0).y+1.2*b1.maxd*dy  'paint centre
    drawpolygon(b1.p(),Rgb(0,0,b1.inc))
    Paint(dx,dy),Rgb(0,0,0),Rgb(0,0,b1.inc)
End Sub

Function framecounter() As Integer
    var t2=timer
    Static As Double t3,frames,answer
    frames=frames+1
    If (t2-t3)>=1 Then
        t3=t2
        answer=frames
        frames=0
    End If
    Return answer
End Function

Sub getdata(b As polygon,m As Long)
    Static As Long s
    #define length(a,b) Sqr((a.x-b.x)*(a.x-b.x)+(a.y-b.y)*(a.y-b.y))
    Dim As Long cx,cy
    For n As Long=1 To m
        Read b.p(n).x
        cx+=b.p(n).x
    Next
    For n As Long=1 To m
        Read b.p(n).y
        cy+=b.p(n).y
    Next
    b.p(0)=Type<pt>(cx/m,cy/m) 'centrid of polygon
   
    For n As Long=1 To m
        Var L=length(b.p(0),b.p(n))
        If b.maxd<L Then b.maxd=L 'biggest radius
    Next
    s+=1
    b.inc=s 'colour increment(slight difference in colour for each polygon
             ' So they can paint through each other
End Sub

Dim As polygon bx(1 To 3)
'create three polygons and fill the vertices from data
Redim (bx(1).p)(5)
Redim (bx(2).p)(4)
Redim (bx(3).p)(9)

getdata(bx(1),5)
getdata(bx(2),4)
getdata(bx(3),9)

Dim As Long mx,my
Screen 20,32,,64
Color ,Rgb(200,200,200)
 #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)
dim as any ptr i=imagecreate(1024*2,768*2)
dim as long max=sqr(1024*1024*4 + 768*768*4)/2
for y as long=0 to 768*2
    for x as long=0 to 1024*2
        var d=dist(type<pt>(x,y),type<pt>(1024,768))
       var c=map(0,max,d,255,0)
       pset i,(x,y),rgb(c,c,c)
    next
next

Do
    Getmouse mx,my
    Dim As pt mouse=Type<pt>(mx,my)
    Screenlock
    Cls
   
    For z As Long=1 To 3
        If inpolygon(bx(z).p(),mouse)=0 Then   
            GetpolygonShadow(bx(z),mouse)
        End If
        'drawpolygon(bx(z).p(),Rgb(0,100,255),1)
    Next z
     put(mx-1024,my-768),i,alpha,140
     draw string(20,20),"FPS " &framecounter
     for z as long=1 to 3
         drawpolygon(bx(z).p(),Rgb(0,100,255),rgba(0,100,255,100),1)
         next z
    Screenunlock
    Sleep 1,1
Loop Until Len(Inkey)
Sleep
imagedestroy i
'3 polygons

Data _
419,393,398,433,442
Data _
345,362,381,391,366

Data _
704,686,718,731
Data _
273,332,389,307

Data _
375,547,628,673,725,693,609,516,369
Data _
473,415,413,430,481,511,533,539,526
 
leopardpm
Posts: 1795
Joined: Feb 28, 2009 20:58

Re: Isometric shadow casting light.

Postby leopardpm » Mar 31, 2017 18:48

Boromir!

Nice! Smooth and simple... can now be greatly optimized i think

what was the issue we were having and how did you solve it?

Return to “Game Dev”

Who is online

Users browsing this forum: No registered users and 2 guests