that's what I thought too but i removed all drawing routines and it still crashes.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...
My idea also but it doesn't seem to work.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:
does this code draw each adjacent side of the shadow polygon in sequential order?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)
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)
fbgfx does not ignore alpha. It just over-writes alpha values instead of blending.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...
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)
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!)Boromir wrote:btw I fixed the crash bug :) it had to do with image creating every iteration
Not totally. There are still issues on certain angles.leopardpm wrote:so all problems have been solved then?
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)
already tried a similar 'sloppy fix' - I added a small random value to the angles.... didn't work so good.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.
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
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)
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