2D shadows

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
sero
Posts: 53
Joined: Mar 06, 2018 13:26
Location: USA

Re: 2D shadows

Postby sero » Feb 01, 2021 20:55

dodicat wrote:Include circles

I realize I'm necroposting, but in my searching for anything line to circle tangent intersection I found this example by dodicat. Unfortunately the demonstration was a mathematical approximation for projecting shadows from circles. It looks good except when the distance between the circle and the mouse point are close.

I reworked the function for accuracy at the cost of speed. It now uses atan2, cos, and sin. I'm not even sure if this is the correct solution since I was looking for it myself. I don't mean to cause any disturbance in the forums by posting this. I mean to post for posterity and to encourage alternate solutions.

Code: Select all

Screen 20,32
Dim As Integer xres,yres
Screeninfo xres,yres
Type pt
    As Integer x,y
    Ca As Single 'angle to mouse(radians)
    #define v Type<pt>
End Type

#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 Integer
    Declare Constructor
    Declare Constructor(As pt,As pt,As Ulong)
End Type

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


Constructor box:End Constructor

Constructor box(p1 As pt,p3 As pt,c As Ulong)
col=c
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
End Constructor

Function shortline(fp As pt,p As pt,length As Integer) 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

Function compare (a1 As Single,a2 As Single)As Long
    Dim As Single pi=4*Atn(1)
    If Abs(a1)>pi/2 Or Abs(a2)>pi/2 Then
        If Sgn(a1)<>Sgn(a2) Then Return a2<a1
    End If
    Return a1<a2
End Function

Sub Circle_sort(p() As pt,c As pt)
    For p1 As Long  = 1 To 3
        For p2 As Long  = p1 + 1 To 4
            Var w= compare(p(p1).Ca,p(p2).Ca)
            If w Then Swap p(p1),p(p2)
        Next p2
    Next p1
   
End Sub

Sub barebox(bx1 As box,msg As Integer=0)
    If msg=0 Then
        Line (bx1.p(1).x,bx1.p(1).y)-(bx1.p(3).x,bx1.p(3).y),Rgb(0,0,Bx1.inc),b
    Else
        Line (bx1.p(1).x,bx1.p(1).y)-(bx1.p(3).x,bx1.p(3).y),bx1.col,bf
    End If
End Sub

Sub barecircle(C As Circle,msg As Integer=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

Sub GetBoxShadow(Byval b1 As box,c As pt)
    Dim As box b=b1
    Dim As Integer i=b.inc
    Dim As Single pi=4*Atn(1),z
    For n As Long=1 To 4
        z= (Atan2((c.y-b.p(n).y),(c.x-b.p(n).x)))
        b.p(n).ca=z
    Next n
   
    circle_sort(b.p(),c)
   
    Var S1=shortline(b.p(1),c,-1100)
    Line(s1.x,s1.y)-(b.p(1).x,b.p(1).y),Rgb(0,0,i)
    Var S2=shortline(b.p(4),c,-1100)
    Line(s2.x,s2.y)-(b.p(4).x,b.p(4).y),Rgb(0,0,i)
   
    Dim As pt ctr= v((s1.x+s2.x)\2,(s1.y+s2.y)\2)
    Var lngth=dist(b.p(0),b.p(1))
    Var s3=shortline(b.p(0),ctr,lngth*1.2)
    barebox(b1)
    Paint(s3.x,s3.y),Rgb(0,0,0),Rgb(0,0,i)
End Sub

Sub GetCircleShadow(C As Circle,p As pt)
    Var dx=(C.ctr.x-p.x),dy=(C.ctr.y-p.y)
    Swap dx,dy
    dx=-dx
    dx=C.ctr.x+dx:dy=C.ctr.y+dy
    Var s1=shortline(C.ctr,v(dx,dy),C.r)
    Var s2=shortline(s1,p,-1100)
    Var t1=s2
    Line(s1.x,s1.y)-(s2.x,s2.y),Rgb(0,C.inc,0)
    s1=shortline(C.ctr,v(dx,dy),-C.r)
    s2=shortline(s1,p,-1100)
    Var t2=s2
    Line(s1.x,s1.y)-(s2.x,s2.y),Rgb(0,C.inc,0)
    Var M=v((t1.x+t2.x)\2,(t1.y+t2.y)\2)
    Var p2=shortline(C.ctr,M,1.1*C.r)
    barecircle(C)
    Paint(p2.x,p2.y),Rgb(0,0,0),Rgb(0,C.inc,0)
End Sub

Sub GetCircleShadow2(C As Circle,p As pt) ' ############################################## new method ###
  dim as single pi = 3.14159265
  dim as single pi_half = 1.570796
 
  ' delta and distance between circle center and mouse
  dim as long _dx = p.x - c.ctr.x
  dim as long _dy = p.y - c.ctr.y
  dim as long _z = sqr( ( _dx * _dx ) + ( _dy * _dy ) )
 
  ' here is the angle of the circle center to the mouse
  dim as single _a = atan2( _dy, _dx )
 
  ' here is the angle change relative to the mouse distance
  dim as single _at = ( pi_half - ( pi_half / ( sqr( _z - c.r ) ) ) )
 
  ' tangent point 1
  dim as single _tx1 = c.ctr.x + ( ( c.r ) * cos( _a + _at ) )
  dim as single _ty1 = c.ctr.y + ( ( c.r ) * sin( _a + _at ) )
 
  ' tangent point 2
  dim as single _tx2 = c.ctr.x + ( c.r * cos( _a - _at ) )
  dim as single _ty2 = c.ctr.y + ( c.r * sin( _a - _at ) )
 
  ' below is due to not using your shortline() function for no
  ' reason other than i was too lazy
  dim as long _dx1 = p.x - _tx1
  dim as long _dy1 = p.y - _ty1
  dim as long _dv1 = _dy1 / _dx1
  dim as long _dz1 = sqr( ( _dx1 * _dx1 ) + ( _dy1 * _dy1 ) )
  dim as long _dx2 = p.x - _tx2
  dim as long _dy2 = p.y - _ty2
  dim as long _dv2 = _dy2 / _dx2
  dim as long _dz2 = sqr( ( _dx2 * _dx2 ) + ( _dy2 * _dy2 ) )
 
  ' project the shadow sides from the circle tangent points
  Line( _tx1,_ty1)-( _tx1 + ( -1100 * _dx1 / _dz1 ), _ty1 + ( -1100 * _dy1 / _dz1 ) ), rgb(0,c.inc,0)
  Line( _tx2,_ty2)-( _tx2 + ( -1100 * _dx2 / _dz2 ), _ty2 + ( -1100 * _dy2 / _dz2 ) ), rgb(0,c.inc,0)
 
  ' fill in the circle to allow paint() to fill in the shadow space
  barecircle(C)
 
  ' here the paint() point is calculated to be just beyond the
  ' circle radius using the angle of the mouse to the circle
  _tx1 = c.ctr.x + ( ( c.r + 1 ) * cos( _a + pi ) )
  _ty1 = c.ctr.y + ( ( c.r + 1 ) * sin( _a + pi ) )
 
  ' paint() the shadow space
  paint( _tx1, _ty1 ), rgb( 0, 0, 0 ), rgb( 0, c.inc, 0 )
End Sub

Function inbox(b As box,mx As Integer,my As Integer) As Long
    var bw=abs(b.p(1).x-b.p(2).x)/30
    var bh=abs(b.p(1).y-b.p(4).y)/30
    Return mx>=b.p(1).x-bw And mx<=b.p(3).x+bw And my>=b.p(1).y-bh And my<=b.p(3).y+bh
End Function

Function InCircle(b As Circle,mx As Integer,my As Integer) As Integer
    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 Integer,yres As Integer,floor As Any Ptr)
    Dim As Long counter
    Dim As Ulong col
    For y As Long=-10 To yres+10 Step 100
        For x As Long=-10 To xres+10 Step 100
            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

Function checkboxseperation(b() As box,tst As pt,n As Integer,dx As Integer,dy As Integer) As Integer
    For z As Integer=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 Integer,yres As Integer)
    Redim b(0)
    Redim b(1 To IntRange(5,20))
    Var m=map(5,20,Ubound(b),150,30)'fewer boxes then make them bigger
    For n As Integer=1 To Ubound(b)
        Dim As Integer 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))
        b(n).inc=n
    Next n
End Sub

Function checkcircleseperation(b() As Circle,tst As pt,n As Integer,r As Integer) As Integer
    For z As Integer=1 To n
        If dist(b(z).ctr,tst) < (2*r) Then Return 0
    Next z
    Return -1
End Function

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

Redim As box b()
setupboxes(b(),xres,yres)

Dim As Any Ptr floor=Imagecreate(xres,yres)
setupfloor(xres,yres,floor)
Dim As Circle blankc
Dim As box blankb
Dim As Integer mx,my,mb,flag
Do
    Getmouse mx,my,,mb
    If mb=1 And flag=0 Then flag=1:setupboxes(b(),xres,yres):setupcircles(circles(),xres,yres)
    Screenlock
    Cls
    Put(0,0),floor,Alpha,255
   
    For n1 As Integer=Lbound(b) To Ubound(b)
        If inbox(b(n1),mx,my) =0 Then GetBoxShadow(b(n1),v(mx,my))
    Next n1
    For n1 As Integer=Lbound(circles) To Ubound(circles)
        'If inCircle(circles(n1),mx,my) =0 Then GetCircleShadow(circles(n1),v(mx,my)) '### old method ###
        If inCircle(circles(n1),mx,my) =0 Then GetCircleShadow2(circles(n1),v(mx,my)) '### new method ###
    Next n1
   
    Put(0,0),floor,Alpha,100
    Draw String (5,5),"Click Mouse",0
    For n As Integer=1 To Ubound(b)
        barebox(b(n),1)
    Next n
    For n As Integer=1 To Ubound(circles)
        barecircle(circles(n),1)
    Next n
   
    Screenunlock
    Sleep 15,1
    flag=mb
Loop Until Len(Inkey)

Imagedestroy floor
UEZ
Posts: 730
Joined: May 05, 2017 19:59
Location: Germany

Re: 2D shadows

Postby UEZ » Feb 01, 2021 21:18

Looks very nice!

Thanks for sharing
Dr_D
Posts: 2431
Joined: May 27, 2005 4:59
Contact:

Re: 2D shadows

Postby Dr_D » Feb 06, 2021 20:20

I love this kind of stuff. I made a similar thing a long time ago to test a triangle rasterizer. I added a little "candle" to yours. :p

Code: Select all

#include "fbgfx.bi"
ScreenRes 800,600,32,,FB.GFX_ALPHA_PRIMITIVES

Randomize

Const Light_Range=1000
Const cubes=5

#Include once "fbgfx.bi"

#Define Get_R(a) ((a shr 16) and 255)
#Define Get_G(a) ((a shr 8) and 255)
#Define Get_B(a) (a and 255)

#Define Get_Ptr_Size_X(a) cptr(FB.IMAGE Ptr,a)->width
#Define Get_Ptr_Size_Y(a) cptr(FB.IMAGE Ptr,a)->height

Sub Apply_Color_Filter(ByRef Img as any ptr, r As Integer, g As Integer, b As Integer)
   
    Dim as Uinteger CurrentCol
    Dim as integer _R,_G,_B
   
    Dim as integer SizeX = Get_ptr_Size_X(Img)
    Dim as integer SizeY = Get_ptr_Size_Y(Img)
    Dim as single CurrentLum
   
    For i as integer = 0 to SizeX - 1
        For j as integer = 0 to SizeY - 1
           
            CurrentCol = Point(i,j,Img)
           
            _R = r
            _G = g
            _B = b
           
            CurrentLum = (Get_R(Currentcol)+Get_g(Currentcol)+Get_b(Currentcol))/(255*3)
           
            Pset Img,(i,j),rgb(CurrentLum*_r,CurrentLum*_g,CurrentLum*_b)
        Next
    Next

End Sub

Dim As Any Ptr Texture_Roof1=ImageCreate(100,100)
Line Texture_Roof1,(0,0)-(100,100),RGB(46,37,51),BF

Dim As Any Ptr Texture_Roof2=ImageCreate(100,100)
Line Texture_Roof2,(0,0)-(100,100),RGB(56,28,19),BF

Dim As Any Ptr Roof_Tile1=ImageCreate(11,6)
Line Roof_Tile1,(0,0)-(10,5),RGB(46,37,51),B
Line Roof_Tile1,(0,5)-(10,5),RGB(29,19,30)
Line Roof_Tile1,(1,1)-(9,2),RGB(114,107,126),BF
Line Roof_Tile1,(1,3)-(9,4),RGB(77,74,93),BF

Dim As Any Ptr Roof_Tile1R=ImageCreate(11,6)
Line Roof_Tile1R,(0,0)-(10,5),RGB(43,35,32),B
Line Roof_Tile1R,(0,5)-(10,5),RGB(23,19,18)
Line Roof_Tile1R,(1,1)-(9,2),RGB(124,101,93),BF
Line Roof_Tile1R,(1,3)-(9,4),RGB(84,68,63),BF

Dim As Any Ptr Roof_Tile2(5),Roof_Tile3(5)
For i As Integer=0 To 5
   Roof_Tile2(i)=ImageCreate(8,4)
   Line Roof_Tile2(i),(0,0)-(8,4),RGB(46,37,51),BF
   Roof_Tile3(i)=ImageCreate(8,4)
   Line Roof_Tile3(i),(0,0)-(8,4),RGB(46,37,51),BF
Next
Line Roof_Tile2(0),(0,0)-(7,2),RGB(77,74,93),BF
Line Roof_Tile2(0),(1,3)-(6,3),RGB(77,74,93)

Line Roof_Tile2(1),(0,0)-(7,2),RGB(114,107,126),BF
Line Roof_Tile2(1),(1,3)-(6,3),RGB(114,107,126)

Line Roof_Tile2(2),(0,0)-(7,2),RGB(61,55,72),BF
Line Roof_Tile2(2),(1,3)-(6,3),RGB(61,55,72)

Line Roof_Tile2(3),(0,0)-(7,2),RGB(77,74,93),BF
Line Roof_Tile2(3),(1,3)-(6,3),RGB(77,74,93)

Line Roof_Tile2(4),(0,0)-(7,2),RGB(77,74,93),BF
Line Roof_Tile2(4),(1,3)-(6,3),RGB(77,74,93)

Line Roof_Tile2(5),(0,0)-(7,2),RGB(61,55,72),BF
Line Roof_Tile2(5),(1,3)-(6,3),RGB(61,55,72)

Line Roof_Tile3(0),(0,2)-(7,3),RGB(77,74,93),BF
Line Roof_Tile3(0),(1,1)-(6,1),RGB(77,74,93)

Line Roof_Tile3(1),(0,2)-(7,3),RGB(114,107,126),BF
Line Roof_Tile3(1),(1,1)-(6,1),RGB(114,107,126)

Line Roof_Tile3(2),(0,2)-(7,3),RGB(61,55,72),BF
Line Roof_Tile3(2),(1,1)-(6,1),RGB(61,55,72)

Line Roof_Tile3(3),(0,2)-(7,3),RGB(77,74,93),BF
Line Roof_Tile3(3),(1,1)-(6,1),RGB(77,74,93)

Line Roof_Tile3(4),(0,2)-(7,3),RGB(77,74,93),BF
Line Roof_Tile3(4),(1,1)-(6,1),RGB(77,74,93)

Line Roof_Tile3(5),(0,2)-(7,3),RGB(61,55,72),BF
Line Roof_Tile3(5),(1,1)-(6,1),RGB(61,55,72)

Dim As Any Ptr Red_Filter=ImageCreate(100,100)
Line Red_Filter,(0,0)-(100,100),RGB(163,81,54),BF

For i As Integer=0 To 10
   Put Texture_Roof1,(i*10,48),Roof_Tile1,Trans
Next

For x As Integer=0 To 12
   For y As Integer=0 To 8
      If y Mod 2=1 Then
         Put Texture_Roof1,(x*9-5,y*5+54),Roof_Tile2(Rnd()*5),Trans
      Else
         Put Texture_Roof1,(x*9,y*5+54),Roof_Tile2(Rnd()*5),Trans
      End If
   Next
Next

For x As Integer=0 To 12
   For y As Integer=0 To 9
      If y Mod 2=1 Then
         Put Texture_Roof1,(x*9-5,y*5-1),Roof_Tile3(Rnd()*5),Trans
      Else
         Put Texture_Roof1,(x*9,y*5-1),Roof_Tile3(Rnd()*5),Trans
      End If
   Next
Next

Put Texture_Roof2,(0,0),Texture_Roof1,Trans
Apply_Color_Filter(Texture_Roof2,163*2,81*2,54*2)
For i As Integer=0 To 10
   Put Texture_Roof2,(i*10,48),Roof_Tile1R,Trans
Next

Dim As Integer mx,my

Type TCube
   As Integer X,Y,XScale,YScale
   As Integer Clr(3),Roof
   As Double Angle1(8),Angle2(8),Angle3(8),Angle4(8)
   As Any Ptr Shadow
End Type

Dim Shared As TCube Cube(cubes)

Dim As Integer ScrollX,ScrollY
Dim As Integer cubex(cubes),cubey(cubes),cubexscale(cubes),cubeyscale(cubes),cubecolor(cubes,3),switch
Dim As Double cubeangle1(cubes),cubeangle2(cubes),cubeangle3(cubes),cubeangle4(cubes)
For i As Integer=1 To cubes
   With Cube(i)
      .X=Rnd()*700+50
      .Y=Rnd()*500+50
      .XScale=100
      .YScale=100
      For i2 As Integer=1 To 3
         .Clr(i2)=128
      Next
      .Roof=Rnd()*1
      .Shadow=ImageCreate(.XScale,.YScale/2)
      Line .Shadow,(0,0)-(.XScale,.YScale/2),RGB(8,0,7),BF
   End With
Next

Dim As Any Ptr floor=ImageCreate(800,600)
Line floor,(0,0)-(800,600),RGB(8,0,7),BF

For x As Integer=0 To 80
   For y As Integer=0 To 60
      If (x \ 4 + y \ 4) Mod 2 > 0 Then
           switch=1
       Else
           switch=0
       End If
       If switch=1 Then Line floor,(x*10,y*10)-(x*10+10,y*10+10),RGB(255,240,203),BF
       If switch=0 Then Line floor,(x*10,y*10)-(x*10+10,y*10+10),RGB(8,0,7),BF
   Next
Next

setmouse(400,300,0)

Do
   Getmouse mx,my
   Sleep 10,1
   ScreenLock
      Cls
      For i As Integer=1 To cubes
         With Cube(i)
            .Angle1(1)=ATan2(mx-.X,my-.Y)
            .Angle2(1)=ATan2(mx-.X-.XScale,my-.Y)
            .Angle3(1)=ATan2(mx-.X-.XScale,my-.Y-.YScale)
            .Angle4(1)=ATan2(mx-.X,my-.Y-.YScale)
            Line (.X-ScrollX,.Y-ScrollY)-(mx-Sin(.Angle1(1))*Light_Range-ScrollX,my-Cos(.Angle1(1))*Light_Range-ScrollY),RGB(0,0,255)
            Line (.X+.XScale-ScrollX,.Y-ScrollY)-(mx-Sin(.Angle2(1))*Light_Range-ScrollX,my-Cos(.Angle2(1))*Light_Range-ScrollY),RGB(0,0,255)
            Line (.X+.XScale-ScrollX,.Y+.YScale-ScrollY)-(mx-Sin(.Angle3(1))*Light_Range-ScrollX,my-Cos(.Angle3(1))*Light_Range-ScrollY),RGB(0,0,255)
            Line (.X-ScrollX,.Y+.YScale-ScrollY)-(mx-Sin(.Angle4(1))*Light_Range-ScrollX,my-Cos(.Angle4(1))*Light_Range-ScrollY),RGB(0,0,255)
           
            'Line (mx-Sin(.Angle2(1))*Light_Range-ScrollX,my-Cos(.Angle2(1))*Light_Range-ScrollY)-(mx-Sin(.Angle1(1))*Light_Range-ScrollX,my-Cos(.Angle1(1))*Light_Range-ScrollY),RGB(0,0,255)
            'Line (mx-Sin(.Angle3(1))*Light_Range-ScrollX,my-Cos(.Angle3(1))*Light_Range-ScrollY)-(mx-Sin(.Angle4(1))*Light_Range-ScrollX,my-Cos(.Angle4(1))*Light_Range-ScrollY),RGB(0,0,255)
            'Line (mx-Sin(.Angle1(1))*Light_Range-ScrollX,my-Cos(.Angle1(1))*Light_Range-ScrollY)-(mx-Sin(.Angle4(1))*Light_Range-ScrollX,my-Cos(.Angle4(1))*Light_Range-ScrollY),RGB(0,0,255)
         End With
      Next
      For i As Integer=1 To cubes
         With Cube(i)
            Line (.X-ScrollX,.Y-Scrolly)-(.X+.XScale-ScrollX,.Y+.YScale-ScrollY),RGB(0,0,255),B
         End With
      Next
      Paint (mx,my),RGB(255,240,203),RGBA(0,0,255,255)
      For i As Integer=1 To cubes
         With Cube(i)
            Line (.X-ScrollX,.Y-ScrollY)-(mx-Sin(.Angle1(1))*Light_Range-ScrollX,my-Cos(.Angle1(1))*Light_Range-ScrollY),RGB(8,0,7)
            Line (.X+.XScale-ScrollX,.Y-ScrollY)-(mx-Sin(.Angle2(1))*Light_Range-ScrollX,my-Cos(.Angle2(1))*Light_Range-ScrollY),RGB(8,0,7)
            Line (.X+.XScale-ScrollX,.Y+.YScale-ScrollY)-(mx-Sin(.Angle3(1))*Light_Range-ScrollX,my-Cos(.Angle3(1))*Light_Range-ScrollY),RGB(8,0,7)
            Line (.X-ScrollX,.Y+.YScale-ScrollY)-(mx-Sin(.Angle4(1))*Light_Range-ScrollX,my-Cos(.Angle4(1))*Light_Range-ScrollY),RGB(8,0,7)
         End With
      Next
      Put (0,0),floor,Alpha,150
      For i As Integer=1 To cubes
         With Cube(i)
            If .Roof=0 Then
               Put(.X-Scrollx,.Y-Scrolly),Texture_Roof2,Trans
            Else
               Put(.X-Scrollx,.Y-Scrolly),Texture_Roof1,Trans
            End If
            If my>.Y+.YScale/2-ScrollY Then
               Put (.X-Scrollx,.Y-Scrolly),.Shadow,Alpha,128
            Else
               Put (.X-Scrollx,.Y+.YScale/2-Scrolly),.Shadow,Alpha,128
            End If
         End With
      next
     
     
      dim as integer cw = 8
      for s as integer = 0 to cw
         
         dim as integer r = 360\cw
         
         line(mx+s-cw/2,my)- step (0,50), rgb( 0, 0, 128-127*cos( (s*r)*.01745) )
         
      next
     
      for s as integer = 28+int(rnd*4) to 1 step -1

         dim as uinteger colour = rgba( 255, 255, s*8, 64-s*2 )

         circle(mx-1+(rnd*2),my), s, colour,,,,f
         
      next
     
      line(mx,my+5)-(mx-2+(rnd*4), my), rgba(0,0,0,64)
     
   ScreenUnlock
Loop Until Inkey=Chr(27)
end
Dr_D
Posts: 2431
Joined: May 27, 2005 4:59
Contact:

Re: 2D shadows

Postby Dr_D » Feb 06, 2021 20:38

Jeez... didn't realize the original thread was that old. lol
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: 2D shadows

Postby h4tt3n » Feb 16, 2021 18:02

Looks great! I am completely certain that you can do this with pure vector math (no cos / sin / sqr / atan2) by modifying the Separating Axis Theorem (SAT), which is used for very fast geometrical object collision detection. Google is your friend.
sero
Posts: 53
Joined: Mar 06, 2018 13:26
Location: USA

Re: 2D shadows

Postby sero » Feb 18, 2021 21:00

h4tt3n wrote:Google is your friend.

Ahh, good ol' Google. The fourth link that Google provided me upon searching "separating axis theorem" deceptively went to a viagra page. Not just viagra, but super viagra, and viagra professional, too. Avoid the "dyn4j" result if you search this yourself.

What I did uncover about this theorem doesn't appear to account for the distance from a circle relating to the angles of intersecting tangent points. The theorem looks to be at it's simplest implementation when circles are involved due to their constant radius.The theorem would fit if the intersecting tangent points on that circle fall upon a line that passes through the circle center and is perpendicular to the vector between the circle center and the candle point. If you lock the angle at 90 degrees then sure, we can avoid sin/cos/tan stuff with inverted slopes. Eazy peazy. But this is nearly the same problem I was encountering before where the intersecting tangent points on the circle do not relate to the distance. It looks fine when the candle point is far away, but up close the casting shadows look quite off.

The closer the candle point is to the circle, the greater the angle change from the perpendicular line to the desired intersecting tangent points. I believe it is because of this relationship from distance to angle that makes trig necessary. This isn't just some exponential relationship. The only way i could see doing this without the trig math is to precalculate a list of slopes to the tangent points relative to the distance. A handful of precalculated slopes within a select case should approximate a visually convincing "hack" of the true tangent points. It wouldn't be unreasonable to include "hack" code if it saves on computation. Another option to save on computation would be to compile with approximate floating point: https://www.freebasic.net/wiki/CompilerCmdLine Here's one for fast cos and fast sin: https://www.freebasic.net/forum/viewtopic.php?f=7&t=28502

If you are completely certain about this theorem, then please at least share with us the Google results that justify your certainty. I would like to learn more. This is a fascinating theorem, but I don't see it's application to this exact situation. Here's the best page I found involving the theorem and circles: https://gamedevelopment.tutsplus.com/tutorials/collision-detection-using-the-separating-axis-theorem--gamedev-169 Here's one that mentions why the theorem is so simple with circles on page 26: http://cs.brown.edu/courses/cs1971/lectures/lecture05.pdf

Here's a demonstration ( rectangle objects only ) without using sin, cos, or tan. In this demo, the position of the pointer is taken into consideration for casting lines from the rectangle edges.

Code: Select all

type udt_point
  x as long
  y as long
end type

type udt_rect
  x1 as long
  y1 as long
  x2 as long
  y2 as long
end type

sub render( _
  byref source as udt_point, _
  byref rect as udt_rect )
 
  dim as ulong color1 = rgb( 255, 255, 255 )
  dim as ulong color2 = rgb(  47,   0,   0 )
  dim as ulong color3 = rgb(   7,   7,   7 )
  dim as byte quadrant
 
  dim as double m
  dim as long b1, b2
 
  line ( rect.x1, 0 )-( rect.x1,  719 ), color3
  line ( rect.x2, 0 )-( rect.x2,  719 ), color3
  line ( 0, rect.y1 )-( 1279, rect.y1 ), color3
  line ( 0, rect.y2 )-( 1279, rect.y2 ), color3
 
  if source.x > rect.x2 then
    if source.y > rect.y2 then
      quadrant = 3
     
      m  = ( source.y - rect.y2 ) / ( source.x - rect.x1 )
      b1 = rect.y2 - ( m * rect.x1 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x1, rect.y2 )-(    0, b1 ), color1
      line ( rect.x1, rect.y2 )-( 1279, b2 ), color2
     
      m  = ( source.x - rect.x2 ) / ( source.y - rect.y1 )
      b1 = rect.x2 - ( m * rect.y1 )
      b2 = b1 + ( m * 719 )
      line ( rect.x2, rect.y1 )-( b1,   0 ), color1
      line ( rect.x2, rect.y1 )-( b2, 719 ), color2
     
      line ( rect.x1, rect.y2 )-( rect.x2, rect.y2 ), color1
      line ( rect.x2, rect.y1 )-( rect.x2, rect.y2 ), color1
     
    elseif source.y < rect.y1 then
      quadrant = 9
     
      m  = ( source.y - rect.y1 ) / ( source.x - rect.x1 )
      b1 = rect.y1 - ( m * rect.x1 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x1, rect.y1 )-(    0, b1 ), color1
      line ( rect.x1, rect.y1 )-( 1279, b2 ), color2
     
      m  = ( source.y - rect.y2 ) / ( source.x - rect.x2 )
      b1 = rect.y2 - ( m * rect.x2 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x2, rect.y2 )-(    0, b1 ), color1
      line ( rect.x2, rect.y2 )-( 1279, b2 ), color2
     
      line ( rect.x1, rect.y1 )-( rect.x2, rect.y1 ), color1
      line ( rect.x2, rect.y1 )-( rect.x2, rect.y2 ), color1
     
    else
      quadrant = 6
     
      if ( source.y = rect.y1 ) then
        line ( rect.x2, rect.y1 )-(    0, rect.y1 ), color1
        line ( rect.x2, rect.y1 )-( 1279, rect.y1 ), color2
       
      else
        m  = ( source.x - rect.x2 ) / ( source.y - rect.y1 )
        b1 = rect.x2 - ( m * rect.y1 )
        b2 = b1 + ( m * 719 )
        line ( rect.x2, rect.y1 )-( b1,   0 ), color1
        line ( rect.x2, rect.y1 )-( b2, 719 ), color2
       
      end if
     
      if ( source.y = rect.y2 ) then
        line ( rect.x2, rect.y2 )-(    0, rect.y2 ), color1
        line ( rect.x2, rect.y2 )-( 1279, rect.y2 ), color2
       
      else
        m  = ( source.y - rect.y2 ) / ( source.x - rect.x2 )
        b1 = rect.y2 - ( m * rect.x2 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x2, rect.y2 )-(    0, b1 ), color1
        line ( rect.x2, rect.y2 )-( 1279, b2 ), color2
       
      end if
     
      line ( rect.x2, rect.y1 )-( rect.x2, rect.y2 ), color1
     
    end if
  elseif source.x < rect.x1 then
    if source.y > rect.y2 then
      quadrant = 1
     
      m  = ( source.y - rect.y2 ) / ( source.x - rect.x2 )
      b1 = rect.y2 - ( m * rect.x2 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x2, rect.y2 )-( 1279, b2 ), color1
      line ( rect.x2, rect.y2 )-(    0, b1 ), color2
     
      m  = ( source.x - rect.x1 ) / ( source.y - rect.y1 )
      b1 = rect.x1 - ( m * rect.y1 )
      b2 = b1 + ( m * 719 )
      line ( rect.x1, rect.y1 )-( b1,   0 ), color1
      line ( rect.x1, rect.y1 )-( b2, 719 ), color2
     
      line ( rect.x1, rect.y1 )-( rect.x1, rect.y2 ), color1
      line ( rect.x1, rect.y2 )-( rect.x2, rect.y2 ), color1
     
    elseif source.y < rect.y1 then
      quadrant = 7
     
      m  = ( source.y - rect.y1 ) / ( source.x - rect.x2 )
      b1 = rect.y1 - ( m * rect.x2 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x2, rect.y1 )-( 1279, b2 ), color1
      line ( rect.x2, rect.y1 )-(    0, b1 ), color2
     
      m  = ( source.y - rect.y2 ) / ( source.x - rect.x1 )
      b1 = rect.y2 - ( m * rect.x1 )
      b2 = b1 + ( m * 1279 )
      line ( rect.x1, rect.y2 )-( 1279, b2 ), color1
      line ( rect.x1, rect.y2 )-(    0, b1 ), color2
     
      line ( rect.x1, rect.y1 )-( rect.x2, rect.y1 ), color1
      line ( rect.x1, rect.y1 )-( rect.x1, rect.y2 ), color1
     
    else
      quadrant = 4
     
      if ( source.y = rect.y1 ) then
        line ( rect.x1, rect.y1 )-( 1279, rect.y1 ), color1
        line ( rect.x1, rect.y1 )-(    0, rect.y1 ), color2
       
      else
        m  = ( source.x - rect.x1 ) / ( source.y - rect.y1 )
        b1 = rect.x1 - ( m * rect.y1 )
        b2 = b1 + ( m * 719 )
        line ( rect.x1, rect.y1 )-( b1,   0 ), color1
        line ( rect.x1, rect.y1 )-( b2, 719 ), color2
       
      end if
      if ( source.y = rect.y2 ) then
        line ( rect.x1, rect.y2 )-( 1279, rect.y2 ), color1
        line ( rect.x1, rect.y2 )-(    0, rect.y2 ), color2
       
      else
        m  = ( source.y - rect.y2 ) / ( source.x - rect.x1 )
        b1 = rect.y2 - ( m * rect.x1 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x1, rect.y2 )-( 1279, b2 ), color1
        line ( rect.x1, rect.y2 )-(    0, b1 ), color2
       
      end if
     
      line ( rect.x1, rect.y1 )-( rect.x1, rect.y2 ), color1
     
    end if
  else
    if source.y > rect.y2 then
      quadrant    = 2
     
      if ( source.x = rect.x1 ) then
        line ( rect.x1, rect.y2 )-( rect.x1,   0 ), color1
        line ( rect.x1, rect.y2 )-( rect.x1, 719 ), color2
       
      else
        m  = ( source.y - rect.y2 ) / ( source.x - rect.x1 )
        b1 = rect.y2 - ( m * rect.x1 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x1, rect.y2 )-(    0, b1 ), color1
        line ( rect.x1, rect.y2 )-( 1279, b2 ), color2
       
      end if
      if ( source.x = rect.x2 ) then
        line ( rect.x2, rect.y2 )-( rect.x2,   0 ), color1
        line ( rect.x2, rect.y2 )-( rect.x2, 719 ), color2
       
      else
        m  = ( source.y - rect.y2 ) / ( source.x - rect.x2 )
        b1 = rect.y2 - ( m * rect.x2 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x2, rect.y2 )-( 1279, b2 ), color1
        line ( rect.x2, rect.y2 )-(    0, b1 ), color2
       
      end if
     
      line ( rect.x1, rect.y2 )-( rect.x2, rect.y2 ), color1
     
    elseif source.y < rect.y1 then
      quadrant    = 8
     
      if ( source.x = rect.x1 ) then
        line ( rect.x1, rect.y2 )-( rect.x1, 719 ), color1
        line ( rect.x1, rect.y2 )-( rect.x1,   0 ), color2
       
      else
        m  = ( source.y - rect.y1 ) / ( source.x - rect.x1 )
        b1 = rect.y1 - ( m * rect.x1 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x1, rect.y1 )-(    0, b1 ), color1
        line ( rect.x1, rect.y1 )-( 1279, b2 ), color2
       
      end if
      if ( source.x = rect.x2 ) then
        line ( rect.x2, rect.y1 )-( rect.x2, 719 ), color1
        line ( rect.x2, rect.y1 )-( rect.x2,   0 ), color2
       
      else
        m  = ( source.y - rect.y1 ) / ( source.x - rect.x2 )
        b1 = rect.y1 - ( m * rect.x2 )
        b2 = b1 + ( m * 1279 )
        line ( rect.x2, rect.y1 )-( 1279, b2 ), color1
        line ( rect.x2, rect.y1 )-(    0, b1 ), color2
       
      end if
     
      line ( rect.x1, rect.y1 )-( rect.x2, rect.y1 ), color1
     
    else
      quadrant = 5
     
      line ( rect.x1, rect.y1 )-( rect.x2, rect.y2 ), color1, b
     
    end if
  end if
  draw string (1,1), "quadrant:" & quadrant, color1
end sub

#include once "fbgfx.bi"
screenres 1280, 720, 32

dim as udt_point mouse
dim as udt_rect box

box.x1  = 540
box.y1  = 320
box.x2  = 740
box.y2  = 400

do
  getmouse mouse.x, mouse.y
 
    screenlock
      cls
      render( mouse, box )
    screenunlock
   
  sleep( 15 )
loop until multikey( fb.SC_ESCAPE )
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: 2D shadows

Postby h4tt3n » Feb 19, 2021 7:45

That's a great example, sero :-)

In retrospect I am sorry for having not written a more elaborate reply regarding the SAT algorithm. My main point here is: the idea of SAT is casting the shadow of a pair of objects on a flat surface for every vertex, and if there is a ray of light between any of those, they are not intersecting. Intuitively, it should be possible to translate this into a light / shadow casting algorithm. My other main point is: SAT is an excellent way to learn 2d vector math, and I suggest you build your own vector class with methods such as dot product, projection and so on. This will make your code much easier to manage and understand. I will be happy to provide you with my own trusty vector library for inspiration.

Cheers, Mike
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: 2D shadows

Postby h4tt3n » Feb 19, 2021 10:46

I found a small, and very simple SAT test of mine:


Code: Select all

''****************************************************************************************
''
''   separating axis theorem collision detection, Mike "h4tt3n", february 2012
''   test # 02, vector projection
''
''   pick up control points and move them around with the mouse
''   press "esc" to quit
''   
''   Reference:
''   http://www.geometrictools.com/Documentation/MethodOfSeparatingAxes.pdf
''   http://www.metanetsoftware.com/technique/tutorialA.html
''   http://content.gpwiki.org/index.php/VB:Tutorials:Building_A_Physics_Engine:Basic_Intersection_Detection
''   http://www.sevenson.com.au/actionscript/sat/
''   http://www.codeproject.com/Articles/15573/2D-Polygon-Collision-Detection
''
''****************************************************************************************

''   includes
#Include "fbgfx.bi"
#Include "vec2_07.bi"

''   function declarations
Declare Function ProjectOnLine(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As vec2f
Declare Function ProjectOnPerpLine(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As vec2f
Declare Function PerpProject(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As float
Declare Function IsPointOnLine(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As float

''   constants
Const As Float    pi                  = 4*Atn(1)         ''   pi
Const As Integ    screenwid         = 800                  ''   screen width
Const As Integ    screenhgt         = 600                  ''   screen height
Const As Integ    NumPoints         = 4                  ''   number of control points
Const As Integ    NumSegments         = 2                  ''   number of control points
Const As Integ    border            = 100                  ''   
Const As Float    pickdist            = 64                  ''   mouse pick distance

Type PointType
   As vec2f position
End Type

Type LineSegmentType
   As PointType Ptr point1
   As PointType Ptr point2
   As UByte R
   As UByte G
   As UByte B
End Type

''   dim variables
Dim As vec2i    m, mo
Dim As Integ    mb, mbo, picked

Dim As PointType p(1 To NumPoints)
Dim As LineSegmentType s(1 To NumSegments)

Randomize()

'' place control points
For i As Integ = 1 To NumPoints
   P(i).position.x = border + Rnd * (screenwid - 2 * border)
   P(i).position.y = border + Rnd * (screenHgt - 2 * border)
Next

With s(1)
   .point1 = @p(1)
   .point2 = @p(2)
   .R = 255
   .G = 32
   .B = 255
End With

With s(2)
   .point1 = @p(3)
   .point2 = @p(4)
   .R = 32
   .G = 255
   .B = 255
End With

'With s(3)
'   .point1 = @p(5)
'   .point2 = @p(6)
'   .R = 255
'   .G = 255
'   .B = 64
'End With

''   initiate screen
ScreenRes screenwid, screenhgt, 32,, fb.GFX_ALPHA_PRIMITIVES
WindowTitle "separating axis theorem test # 02"

''   main loop
Do
   
   '' update mouse state
   mo = m:   mbo = mb: GetMouse m.x, m.y,, mb
   
   '' on left mouse, pick up nearest control point
   If mb = 1 Then
      If Picked = -1 Then
         Dim As Float tempdist = pickdist*pickdist
         For i As Integ = 1 To NumPoints
            Dim As Float dx       = m.x-p(i).position.x   :   If Abs(dx) > pickdist Then Continue For
            Dim As Float dy       = m.y-p(i).position.y   :   If Abs(dy) > pickdist Then Continue For
            Dim As Float dsqrd   = dx*dx+dy*dy            :  If dsqrd   > tempdist Then Continue For
            tempdist = dsqrd
            picked = i
         Next
      End If
   Else
      picked = -1
   End If
   
   '' move picked-up control point
   If Not picked = -1 Then
      p(picked).position += (m - mo)
   EndIf
   
   '' draw to screen
   ScreenLock
      
      Cls
      
      '' draw line segments
      For i As Integ = 1 To NumSegments
         
         Line (s(i).point1->position.x, s(i).point1->position.y)-(s(i).point2->position.x, s(i).point2->position.y), RGBA(s(i).R, s(i).G, s(i).B, 255)
         
      Next
      
      ''   project line segments onto each other
      For i As Integ = 1 To NumSegments
         
         For j As Integ = 1 To NumSegments
            
            If i = j Then Continue for
         
            Dim As vec2f proj1 = ProjectOnPerpLine(s(i).point1->position, s(i).point2->position, s(j).point1->position)
            Dim As vec2f proj2 = ProjectOnPerpLine(s(i).point1->position, s(i).point2->position, s(j).point2->position)
         
            Line (proj1.x, proj1.y)-(proj2.x, proj2.y), RGBA(s(j).R, s(j).G, s(j).B, 128)
            
            Line (proj1.x, proj1.y)-(s(j).point1->position.x, s(j).point1->position.y), RGBA(255, 255, 255, 64)
            Line (proj2.x, proj2.y)-(s(j).point2->position.x, s(j).point2->position.y), RGBA(255, 255, 255, 64)
            
         Next
         
      Next
         
      '' draw control points
      For i As Integ = 1 To NumPoints
         
         Circle (p(i).position.x, p(i).position.y), 2.5, RGBA(255, 255, 255, 255),,, 1, f
         Draw String (p(i).position.x+8, p(i).position.y+8), "P" + Str(i), RGBA(255, 255, 255, 255)
         
      Next
      
      '' print stuff
      Locate 2, 2: If Not picked = -1 Then Print "Picked: P" & picked Else Print "Picked: None"
      
      Dim As Integer P2on1_1 = Sgn(PerpProject(s(1).point1->position, s(1).point2->position, s(2).point1->position))
      Dim As Integer P2on1_2 = Sgn(PerpProject(s(1).point1->position, s(1).point2->position, s(2).point2->position))
      Dim As Integer P1on2_1 = Sgn(PerpProject(s(2).point1->position, s(2).point2->position, s(1).point1->position))
      Dim As Integer P1on2_2 = Sgn(PerpProject(s(2).point1->position, s(2).point2->position, s(1).point2->position))
      
      Locate 4, 2: If (p2on1_1 = p2on1_2) Or (p1on2_1 = p1on2_2) Then Print "No collision!": Else Print "Collision!"
      
   ScreenUnLock
   
   Sleep 4, 1
   
Loop Until MultiKey(1)

''   functions
Function ProjectOnLine(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As vec2f
   
  'Dim As Vec2f ab = (p1 - p0)
  'Dim As Vec2f ap = (x  - p0)
  'Dim As float t  = ap.dot(ab) / ab.dot(ab)
  'Return p0 + ab * t
   
  Return p0 + (x - p0).project(p1 - p0)
   
End Function

Function ProjectOnPerpLine(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As vec2f
   
  Dim As Vec2f ab = (p1 - p0).normal()
  Dim As Vec2f ap = (x  - p0)
  Dim As float t = ap.dot(ab) / ab.dot(ab)
  Return p0 + t * ab
   
  'Return p0 + (x - p0).project((p1 - p0).normal())
   
End Function

Function IsPointOnLine (ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As float
   
   Dim As Vec2f ab = (p1 - p0)
     Dim As Vec2f ap = (x  - p0)
     Dim As float t  = ap.dot(ab) / ab.dot(ab)
   
   If (t > 0 And t < 1) Then Return t Else Return 0
   
End Function

Function PerpProject(ByVal p0 As vec2f, ByVal p1 As vec2f, ByVal x As vec2f) As float
   
  'Dim As Vec2f ab = (p1 - p0).normal()  '' possible separating axis
  'Dim As Vec2f ap = (x  - p0)           '' vector to be projected on axis
  'Return ap.dot(ab)
 
  Return (x - p0).dot((p1 - p0).normal())
   
End Function



And the vector library:

Vec2_07.bi

Code: Select all

''*******************************************************************************
''      
''      Freebasic 2d Floating point and Integer vector library
''      version 0.7b, august 2011, Michael "h4tt3n" Nissen, jernmager@yahoo.dk
''      Integer vectors have been added for screen and mouse operations.   
''      
''      function syntax:
''      
''      (return type) (function name) (argument type (, ...) (description))
''      
''       Floating point vector function list:
''      
''      vector absolute             (vector)                      - absolute value
''      vector normal               (vector)                      - normal vector
''      vector rightnormal        (vector)                      - right hand normal vector
''      vector leftnormal           (vector)                      - left hand normal vector
''      vector normalised           (vector)                      - normalised vector
''      vector normalisednormal      (vector)                           -   normalised normal vector
''      scalar magnitude            (vector)                      - magnitude
''      scalar magnitudesquared      (vector)                      - magnitude squared
''      scalar distance             (vector, vector)              - vector distance
''      scalar distancesquared      (vector, vector)              - vector distance squared
''      scalar dot                  (vector, vector)              - dot product
''      scalar perpdot            (vector, vector)              - normal dot product
''      vector project              (vector, vector)               -   vector projection
''      vector component               (vector, vector)               -   vector component
''      vector randomise               (scalar)                           -   randomise in range +/- value
''      vector lerp                        (vector, scalar)           - linear interpolation
''      vector rotate                     (vector, vector)               -   rotates vector
''      vector rotate                     (vector, scalar)               -   rotates vector
''
''      Integer vector function list:
''      
''      
''       function useage, member and non-member style:
''
''      vector_a.function(vector_b),   function(vector_a, vector_b)
''
''      
''*******************************************************************************

''   
Type Float As Single
Type Integ As INTEGER

''  Vec2f 2d Float vector structure
Type Vec2f
   
  ''  Vec2f variables
  As Float x, y
   
  ''  Vec2f constructor declarations
   Declare Constructor ()
  Declare Constructor (ByVal x As Float = 0, ByVal y As Float = 0)
  Declare Constructor (ByRef vec As Vec2f)
   
  ''  Vec2f compound arithmetic member operator declarations
  Declare Operator += (ByRef rhs As Vec2f)
  Declare Operator -= (ByRef rhs As Vec2f)
  Declare Operator *= (ByRef rhs As Vec2f)
  Declare Operator *= (ByRef rhs As Float)
  Declare Operator /= (ByRef rhs As Float)
  Declare Operator Let (ByRef rhs As Vec2f)
   
   ''   Vec2f member function declarations
  Declare Function absolute() As Vec2f
  Declare Function normal() As Vec2f
  Declare Function rightnormal() As Vec2f
  Declare Function leftnormal() As Vec2f
  Declare Function normalised() As Vec2f
  Declare Function normalisednormal() As Vec2f
  Declare Function magnitude() As Float
  Declare Function magnitudesquared() As Float
  Declare Function distance(ByRef rhs As Vec2f) As Float
  Declare Function distancesquared(ByRef rhs As Vec2f) As Float
  Declare Function dot(ByRef rhs As Vec2f) As Float
  Declare Function perpdot(ByRef rhs As Vec2f) As Float
  Declare Function project(ByRef rhs As Vec2f) As Vec2f
  Declare Function component(ByRef rhs As Vec2f) As Vec2f
  Declare Function randomise(ByVal rhs As Float) As Vec2f
  Declare Function lerp(ByRef rhs As Vec2f, ByVal i As Float) As Vec2f
  Declare Function rotate(ByRef rhs As Vec2f) As Vec2f
  Declare Function rotate(ByRef rhs As Float) As Vec2f
 
End Type

''  Vec2f unary arithmetic non-member operator declarations
Declare Operator - (ByRef rhs As Vec2f) As Vec2f

''  Vec2f binary arithmetic non-member operator declarations
Declare Operator + (ByRef lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f
Declare Operator - (ByRef lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f
Declare Operator * (ByVal lhs As Float, ByRef rhs As Vec2f) As Vec2f
Declare Operator * (ByRef lhs As Vec2f, ByVal rhs As Float) As Vec2f
Declare Operator * (ByRef lhs As vec2f, ByVal rhs As vec2f) As vec2f
Declare Operator / (ByRef lhs As Vec2f, ByVal rhs As Float) As Vec2f
Declare Operator / (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Vec2f

''  Vec2f binary relational non-member operator declarations
Declare Operator = (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ
Declare Operator = (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ
Declare Operator = (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ
Declare Operator < (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ
Declare Operator < (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ
Declare Operator < (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ
Declare Operator > (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ
Declare Operator > (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ
Declare Operator > (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ

''  Vec2f non-member function declarations
Declare Function absolute (ByRef lhs As Vec2f) As Vec2f
Declare Function normal (ByRef lhs As Vec2f) As Vec2f
Declare Function rightnormal (ByRef lhs As Vec2f) As Vec2f
Declare Function leftnormal (ByRef lhs As Vec2f) As Vec2f
Declare Function normalised (ByRef lhs As Vec2f) As Vec2f
Declare Function normalisednormal(ByRef lhs As Vec2f) As Vec2f
Declare Function magnitude (ByRef lhs As Vec2f) As Float
Declare Function magnitudesquared (ByRef lhs As Vec2f) As Float
Declare Function distance (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float
Declare Function distancesquared (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float
Declare Function dot (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float
Declare Function perpdot (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float
Declare Function project (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f
Declare Function component(ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f
Declare Function randomise(ByVal lhs As Float) As Vec2f
Declare Function lerp(ByVal lhs As Vec2f, ByRef rhs As Vec2f, ByVal i As Float) As Vec2f
Declare Function rotate(ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f

''  Vec2f constructors
Constructor Vec2f(): This.x = 0.0: This.y = 0.0: End Constructor
Constructor Vec2f(ByVal x As Float, ByVal y As Float): This.x = x: This.y = y: End Constructor
Constructor Vec2f(ByRef vec As Vec2f): This.x = vec.x: This.y = vec.y: End Constructor

''  Vec2f compound arithmetic member operators
Operator Vec2f.+= (ByRef rhs As Vec2f): This.x += rhs.x: This.y += rhs.y: End Operator
Operator Vec2f.-= (ByRef rhs As Vec2f): This.x -= rhs.x: This.y -= rhs.y: End Operator
Operator Vec2f.*= (ByRef rhs As Vec2f): This.x *= rhs.x: This.y *= rhs.y: End Operator
Operator Vec2f.*= (ByRef rhs As Float): This.x *= rhs: This.y *= rhs: End Operator
Operator Vec2f./= (ByRef rhs As Float): This.x /= rhs: This.y /= rhs: End Operator
Operator Vec2f.Let (ByRef rhs As Vec2f): This.x = rhs.x: This.y = rhs.y: End Operator

''  Vec2f member functions
Function Vec2f.absolute() As Vec2f: Return Vec2f(Abs(This.x), Abs(This.y)): End Function
Function Vec2f.normal() As Vec2f: Return Vec2f(This.y, -This.x): End Function
Function Vec2f.rightnormal() As Vec2f: Return This.normal: End Function
Function Vec2f.leftnormal() As Vec2f: Return -This.normal: End Function
Function Vec2f.normalised() As Vec2f: If (This.x = 0) And (This.y = 0) Then Return Vec2f(0,0): Else Return This/This.magnitude(): End If: End Function
Function Vec2f.normalisednormal() As Vec2f: Return This.normal()/magnitude(): End Function
Function Vec2f.magnitude() As Float: Return Sqr(This.magnitudesquared()): End Function
Function Vec2f.magnitudesquared() As Float: Return This.dot(This): End Function
Function Vec2f.distance(ByRef rhs As Vec2f) As Float: Return Sqr(This.distancesquared(rhs)): End Function
Function Vec2f.distancesquared(ByRef rhs As Vec2f) As Float: Return (This-rhs).dot(This-rhs): End Function
Function Vec2f.dot(ByRef rhs As Vec2f) As Float: Return (This.x*rhs.x+This.y*rhs.y): End Function
Function Vec2f.perpdot(ByRef rhs As Vec2f) As Float: Return This.dot(rhs.normal()): End Function
'Function Vec2f.project(ByRef rhs As Vec2f) As Vec2f: Return (rhs.dot(This)/This.dot(This))*This: End Function
Function Vec2f.project(ByRef rhs As Vec2f) As Vec2f: Return (This.dot(rhs)/rhs.dot(rhs))*rhs: End Function
Function Vec2f.component(ByRef rhs As Vec2f) As Vec2f: Return (This.dot(rhs)/rhs.dot(rhs))*This: End Function
Function Vec2f.randomise(ByVal rhs As Float) As Vec2f: Return Vec2f((Rnd-Rnd)*rhs, (Rnd-Rnd)*rhs): End Function
Function Vec2f.lerp(ByRef rhs As Vec2f, ByVal i As Float) As Vec2f: Return This+(rhs-This)*i: End Function
Function Vec2f.rotate(ByRef rhs As Vec2f) As Vec2f: Return Vec2f(rhs.dot(This), rhs.perpdot(This)): End Function

''  Vec2f unary arithmetic non-member operators
Operator - (ByRef rhs As Vec2f) As Vec2f: Return Vec2f(-rhs.x, -rhs.y): End Operator

''  Vec2f binary arithmetic non-member operators
Operator + (ByRef lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f: Return Vec2f(lhs.x+rhs.x, lhs.y+rhs.y): End Operator
Operator - (ByRef lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f: Return Vec2f(lhs.x-rhs.x, lhs.y-rhs.y): End Operator
Operator * (ByVal lhs As Float, ByRef rhs As Vec2f) As Vec2f: Return Vec2f(lhs*rhs.x, lhs*rhs.y): End Operator
Operator * (ByRef lhs As Vec2f, ByVal rhs As Float) As Vec2f: Return Vec2f(lhs.x*rhs, lhs.y*rhs): End Operator
Operator * (ByRef lhs As vec2f, ByVal rhs As vec2f) As vec2f: Return vec2f(lhs.x*rhs.y, lhs.y*rhs.y): End Operator
Operator / (ByRef lhs As Vec2f, ByVal rhs As Float) As Vec2f: Return Vec2f(lhs.x/rhs, lhs.y/rhs): End Operator
Operator / (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Vec2f: Return Vec2f(lhs.x/rhs.x, lhs.y/rhs.y): End Operator

''  Vec2f binary relational non-member operators
Operator = (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ: Return (lhs.x = rhs.x) And (lhs.y = rhs.y): End Operator
Operator = (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ: Return (lhs = rhs.x) And (lhs = rhs.y): End Operator
Operator = (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ: Return (lhs.x = rhs) And (lhs.y = rhs): End Operator
Operator < (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ: Return (lhs.x > rhs.x) And (lhs.y > rhs.y): End Operator
Operator < (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ: Return (lhs > rhs.x) And (lhs > rhs.y): End Operator
Operator < (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ: Return (lhs.x > rhs) And (lhs.y > rhs): End Operator
Operator > (ByRef lhs As Vec2f, ByVal rhs As Vec2f) As Integ: Return (lhs.x > rhs.x) And (lhs.y > rhs.y): End Operator
Operator > (ByRef lhs As Float, ByVal rhs As Vec2f) As Integ: Return (lhs > rhs.x) And (lhs > rhs.y): End Operator
Operator > (ByRef lhs As Vec2f, ByVal rhs As Float) As Integ: Return (lhs.x > rhs) And (lhs.y > rhs): End Operator

''  Vec2f non-member functions
Function absolute (ByRef lhs As Vec2f) As Vec2f: Return lhs.absolute(): End Function
Function normal (ByRef lhs As Vec2f) As Vec2f: Return lhs.normal(): End Function
Function rightnormal (ByRef lhs As Vec2f) As Vec2f: Return lhs.rightnormal(): End Function
Function leftnormal (ByRef lhs As Vec2f) As Vec2f: Return lhs.leftnormal(): End Function
Function normalised (ByRef lhs As Vec2f) As Vec2f: Return lhs.normalised(): End Function
Function normalisednormal(ByRef lhs As Vec2f) As Vec2f: Return lhs.normalisednormal(): End Function
Function magnitude (ByRef lhs As Vec2f) As Float: Return lhs.magnitude(): End Function
Function magnitudesquared (ByRef lhs As Vec2f) As Float: Return lhs.magnitudesquared(): End Function
Function distance (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float: Return lhs.distance(rhs): End Function
Function distancesquared (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float: Return lhs.distancesquared(rhs): End Function
Function dot (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float: Return lhs.dot(rhs): End Function
'Function project (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Float: Return lhs.perpdot(rhs): End Function
Function project (ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f: Return lhs.project(rhs): End Function
Function component(ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f: Return lhs.component(rhs): End Function
Function randomise(ByVal lhs As Float) As Vec2f: Return Vec2f((Rnd-Rnd)*lhs, (Rnd-Rnd)*lhs): End Function
Function lerp(ByVal lhs As Vec2f, ByRef rhs As Vec2f, ByVal i As Float) As Vec2f: Return lhs.lerp(rhs, i): End Function
Function rotate(ByVal lhs As Vec2f, ByRef rhs As Vec2f) As Vec2f: Return lhs.rotate(rhs): End Function

''  Vec2i 2d Integer vector structure
Type Vec2i
   
  ''  Vec2i variables
  As Integ x, y
   
  ''  Vec2i constructor declarations
   Declare Constructor ()
  Declare Constructor (ByVal x As Integ, ByVal y As Integ)
  Declare Constructor (ByRef vec As Vec2i)
   
  ''  Vec2i compound arithmetic member operator declarations
  Declare Operator += (ByRef rhs As Vec2i)
  Declare Operator -= (ByRef rhs As Vec2i)
  Declare Operator *= (ByRef rhs As Vec2i)
  Declare Operator *= (ByVal rhs As Integ)
  Declare Operator \= (ByVal rhs As Integ)
  Declare Operator Let (ByRef rhs As Vec2i)
 
  ''  Vec2i member function declarations
 
End Type

''  Vec2i unary arithmetic non-member operator declarations
Declare Operator - (ByRef rhs As Vec2i) As  Vec2i

''  Vec2i binary arithmetic non-member operator declarations
Declare Operator + (ByRef lhs As Vec2i, ByRef rhs As Vec2i) As Vec2i
Declare Operator - (ByRef lhs As Vec2i, ByRef rhs As Vec2i) As Vec2i
Declare Operator * (ByVal lhs As Float, ByRef rhs As Vec2i) As Vec2i
Declare Operator * (ByRef lhs As Vec2i, ByVal rhs As Float) As Vec2i
Declare Operator \ (ByRef lhs As Vec2i, ByVal rhs As Float) As Vec2i

''  Vec2i non-member function declarations

''  Vec2i constructors
Constructor Vec2i(): This.x = 0: This.y = 0: End Constructor
Constructor Vec2i(ByVal x As Integ, ByVal y As Integ): This.x = x: This.y = y: End Constructor
Constructor Vec2i(ByRef vec As Vec2i): This.x = vec.x: This.y = vec.y: End Constructor

''  Vec2i compound arithmetic member operators
Operator Vec2i.+= (ByRef rhs As  Vec2i): This.x += rhs.x: This.y += rhs.y: End Operator
Operator Vec2i.-= (ByRef rhs As  Vec2i): This.x -= rhs.x: This.y -= rhs.y: End Operator
Operator Vec2i.*= (ByRef rhs As  Vec2i): This.x *= rhs.x: This.y *= rhs.y: End Operator
Operator Vec2i.*= (ByVal rhs As  Integ): This.x *= rhs: This.y *= rhs: End Operator
Operator Vec2i.\= (ByVal rhs As  Integ): This.x \= rhs: This.y \= rhs: End Operator
Operator Vec2i.let (ByRef rhs As  Vec2i): This.x = rhs.x: This.y = rhs.y: End Operator

''  Vec2i member functions

''  Vec2i unary arithmetic non-member operators
Operator - (ByRef rhs As Vec2i) As Vec2i: Return Vec2i(-rhs.x, -rhs.y): End Operator

''  Vec2i binary arithmetic non-member operators
Operator + (ByRef lhs As Vec2i, ByRef rhs As Vec2i) As Vec2i: Return Vec2i(lhs.x+rhs.x, lhs.y+rhs.y): End Operator
Operator - (ByRef lhs As Vec2i, ByRef rhs As Vec2i) As Vec2i: Return Vec2i(lhs.x-rhs.x, lhs.y-rhs.y): End Operator
Operator * (ByVal lhs As Integ, ByRef rhs As Vec2i) As Vec2i: Return Vec2i(lhs*rhs.x, lhs*rhs.y): End Operator
Operator * (ByRef lhs As Vec2i, ByVal rhs As Integ) As Vec2i: Return Vec2i(lhs.x*rhs, lhs.y*rhs): End Operator
Operator \ (ByRef lhs As Vec2i, ByVal rhs As Integ) As Vec2i: Return Vec2i(lhs.x\rhs, lhs.y\rhs): End Operator

''  Vec2i non-member functions

''  shared binary arithmetic non-member operator declarations
Declare Operator + (ByRef lhs As Vec2f, ByRef rhs As Vec2i) As Vec2f
Declare Operator + (ByRef lhs As Vec2i, ByRef rhs As Vec2f) As Vec2f
Declare Operator - (ByRef lhs As Vec2f, ByRef rhs As Vec2i) As Vec2f
Declare Operator - (ByRef lhs As Vec2i, ByRef rhs As Vec2f) As Vec2f

''  shared non-member function declarations

''  shared binary arithmetic non-member operators
Operator + (ByRef lhs As Vec2f, ByRef rhs As Vec2i) As Vec2f: Return Vec2f(lhs.x+rhs.x, lhs.y+rhs.y): End Operator
Operator + (ByRef lhs As Vec2i, ByRef rhs As Vec2f) As Vec2f: Return Vec2f(lhs.x+rhs.x, lhs.y+rhs.y): End Operator
Operator - (ByRef lhs As Vec2f, ByRef rhs As Vec2i) As Vec2f: Return Vec2f(lhs.x-rhs.x, lhs.y-rhs.y): End Operator
Operator - (ByRef lhs As Vec2i, ByRef rhs As Vec2f) As Vec2f: Return Vec2f(lhs.x-rhs.x, lhs.y-rhs.y): End Operator

''  shared non-member functions


sero
Posts: 53
Joined: Mar 06, 2018 13:26
Location: USA

Re: 2D shadows

Postby sero » Feb 19, 2021 14:44

h4tt3n wrote:I found a small, and very simple SAT test of mine
Jaw drop. There is a lot of useful material here. Anyone interested in collision detection should make this a part of their curriculum. Here's a short youtube video showing and explaining the basic concept. https://www.youtube.com/watch?v=IELWpIGtjRg At the 9:30 mark the author demonstrates a collision and what the resulting overlap means for the moving object's vector. This link from h4tt3n demonstrates just that: https://www.sevenson.com.au/programming/sat/

@h4tt3n Finding your post this morning was like opening that big present from Santa even though I had no idea it was Christmas. Your code is moving to the top of my list. I realize your code is dated back to 2012 and wanted to let you know one of your web references is no longer available. This one: http://content.gpwiki.org/index.php/VB:Tutorials:Building_A_Physics_Engine:Basic_Intersection_Detection now leads off to some hotel website.

Big big big thankyou!
dodicat
Posts: 6999
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: 2D shadows

Postby dodicat » Feb 19, 2021 16:00

I found this from 2017 on a pen drive.
I left it the way I found it.
I get a warning from gcc optimized code, but what the heck, it's only the gcc team.

I think we had a spell of shadows back then, I see I have many others on the drive.

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
 
UEZ
Posts: 730
Joined: May 05, 2017 19:59
Location: Germany

Re: 2D shadows

Postby UEZ » Feb 20, 2021 9:17

@dodicat: your example looks awesome! Thanks for sharing it.

@rest: thanks you, too, for your nice examples.
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Re: 2D shadows

Postby h4tt3n » Feb 20, 2021 17:21

sero wrote:Big big big thankyou!


You're welcome sero! :-) I'll see if I can dig out some more stuff. Now I just need to crack the 2d shadow problem, or I won't be able to sleee again...

Edit: I noticed that you initially revived this thread in search of line to circle tangent intersection. This type of problem among other similar is covered extensively in the topic of 2d collision detection. The cackbone in all of this is vector math, most of which is covered in the vector library I shared. I did some ball - ball and ball - wall collision physics simulations a while back, maybe they would interet you?

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 6 guests