Fast 2D Light Casting

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Fast 2D Light Casting

Post by Zamaster »

The only thing holding this back (severely) are the POINT and PSET calls at every pixel, this is easy to switch at some point.

I dont know if this means anything, but the inner loops for some reason didnt require anything other than adds or subtracts. This wasnt on purpose... but its neat I guess


http://www.mediafire.com/?enjcekngyjj

Image
Image
[/img]
Top
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Post by h4tt3n »

Screen pointers are your friends! :-)

I changed your code around line 67 and in the filling loops. I also removed the double buffering and replaced it with scrennlock / unlock. It's a nice code sample, but it looks a tad dated with all those goto's. It could be improved even more, I'm sure

Cheers,
Mike

Code: Select all

Const RR2 as double = SQR(2)^-1
Const PI as double = ATN(1)*4
Const TWOPI as double = PI*2
Const Antumbra as double = 0.349065850398865

Sub CastLight(source as integer ptr, xp as integer, yp as integer,_
              rad as double, col as integer = &HFFFFFF00, tcol As Integer = &HFF000000)
              
    #macro _setaddr(dest, src)
        asm mov eax, offset src
        asm mov [dest], eax
    #endmacro
    #define _gosub(addr) asm Call [addr]
    #define _return asm ret

    #define _Ek 1
    #define _Dn 2
    #define _Dp 3
    #define _Xd 4
    #define _Ub 5
    #define _Xx 6

    #macro _addelement(a)
        _N += 1
        Redim Preserve as integer ShadowsB(1 to _N, 1 to 6)
        ShadowsB(_N,_Xx) = a: ShadowsB(_N,_Xd) = SGN(dx)
        dx = abs(dx): dy = abs(dy)
        ShadowsB(_N,_Ek) = 2 * dx - dy
        ShadowsB(_N,_Dn) = ShadowsB(_N,_Ek) + dy
        ShadowsB(_N,_Dp) = ShadowsB(_N,_Ek) - dy
        ShadowsB(_N,_Ub) = 1
    #endmacro
    
    #macro _copyelement(x)
        _N += 1
        Redim Preserve as integer ShadowsB(1 to _N, 1 to 6)
        ShadowsB(_N,_Ek) = ShadowsA(x,_Ek)
        ShadowsB(_N,_Dn) = ShadowsA(x,_Dn)
        ShadowsB(_N,_Dp) = ShadowsA(x,_Dp)
        ShadowsB(_N,_Xx) = ShadowsA(x,_Xx)
        ShadowsB(_N,_Xd) = ShadowsA(x,_Xd)
        ShadowsB(_N,_Ub) = ShadowsA(x,_Ub)
    #endmacro
    
    #macro _copylist()
        For i = 1 to _N
            ShadowsA(i,1)=ShadowsB(i,1)
            ShadowsA(i,2)=ShadowsB(i,2)
            ShadowsA(i,3)=ShadowsB(i,3)
            ShadowsA(i,4)=ShadowsB(i,4)
            ShadowsA(i,5)=ShadowsB(i,5)
            ShadowsA(i,6)=ShadowsB(i,6)
        Next i
    #endmacro
    
    
    
    
    Redim as integer ShadowsA(1 to 2, 1 to 6), ShadowsB(1 to 1, 1 to 6)
    Dim as integer inc, scan, xs, xe, yend = rad*RR2, rs = rad*rad, xcirc, dx, dy, s1, s2
    Dim as integer xpos, ypos, segs, i, _N, ccol, LeftBnd, RightBnd, Offset
    Dim as any Ptr FillLoop, SearchLoop, Proc
    Dim as integer QuadBnd(1 to 8, 1 to 5)
    
    Dim As Uinteger Ptr Sptr = ScreenPtr			'<--- my addition !!!

    QuadBnd(1,_Ek) = 1: QuadBnd(1,_Dn) = 2: QuadBnd(1,_Dp) = 0: QuadBnd(1,_Xd) = -1: QuadBnd(1,_Ub) = 0
    QuadBnd(2,_Ek) = 1: QuadBnd(2,_Dn) = 2: QuadBnd(2,_Dp) = 0: QuadBnd(2,_Xd) =  1: QuadBnd(2,_Ub) = 0
    QuadBnd(3,_Ek) = 1: QuadBnd(3,_Dn) = 2: QuadBnd(3,_Dp) = 0: QuadBnd(3,_Xd) = -1: QuadBnd(3,_Ub) = 0
    QuadBnd(4,_Ek) = 1: QuadBnd(4,_Dn) = 2: QuadBnd(4,_Dp) = 0: QuadBnd(4,_Xd) =  1: QuadBnd(4,_Ub) = 0
    QuadBnd(5,_Ek) = 1: QuadBnd(5,_Dn) = 2: QuadBnd(5,_Dp) = 0: QuadBnd(5,_Xd) =  1: QuadBnd(5,_Ub) = 0
    QuadBnd(6,_Ek) = 1: QuadBnd(6,_Dn) = 2: QuadBnd(6,_Dp) = 0: QuadBnd(6,_Xd) = -1: QuadBnd(6,_Ub) = 0
    QuadBnd(7,_Ek) = 1: QuadBnd(7,_Dn) = 2: QuadBnd(7,_Dp) = 0: QuadBnd(7,_Xd) =  1: QuadBnd(7,_Ub) = 0
    QuadBnd(8,_Ek) = 1: QuadBnd(8,_Dn) = 2: QuadBnd(8,_Dp) = 0: QuadBnd(8,_Xd) = -1: QuadBnd(8,_Ub) = 0
    

    
    '-------------------------------------------------QUAD 1---------------------------------------
    
        _setaddr(FillLoop, FillQ1)
        _setaddr(SearchLoop, SearchQ1)
    
        ShadowsA(1,_Ek) = QuadBnd(1,_Ek): ShadowsA(1,_Dn) = QuadBnd(1,_Dn): ShadowsA(1,_Dp) = QuadBnd(1,_Dp)
        ShadowsA(1,_Xx) = xp: ShadowsA(1,_Xd) = QuadBnd(1,_Xd): ShadowsA(1,_Ub) = QuadBnd(1,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(2,_Ek): ShadowsA(2,_Dn) = QuadBnd(2,_Dn): ShadowsA(2,_Dp) = QuadBnd(2,_Dp)
        ShadowsA(2,_Xx) = xp: ShadowsA(2,_Xd) = QuadBnd(2,_Xd): ShadowsA(2,_Ub) = QuadBnd(2,_Ub)
    
        For inc = 1 to rad
        	
            If inc > yend Then
                xcirc = SQR(rs - inc*inc)
                RightBnd = xp + xcirc
                LeftBnd  = xp - xcirc
            Else
                RightBnd = xp + inc - 1
                LeftBnd  = xp - inc
            EndIf
            
            ypos = yp - inc
            segs = Ubound(ShadowsA)
            _N = 0
            
            For i = 1 to segs step 2
                s1 = i
                
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                
                s2 = i + 1
                
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                
                xs = ShadowsA(s1,_Xx)
                xe = ShadowsA(s2,_Xx)
                
                If xe < LeftBnd Then 
                    Goto SkipScanQ1
                Elseif xs > RightBnd Then
                    Goto SkipScanQ1
                Elseif xs < LeftBnd Then
                    xs = LeftBnd
                EndIf
                
                If xe > RightBnd Then xe = RightBnd
                
                xpos = xs
                
                If point(xpos, ypos) <> tcol Then
                    Do
                        xpos += 1
                        ccol = point(xpos,ypos,source)
                        If ccol = tcol or ccol = -1 Then
                            If xpos < xe Then
                                dx = xpos-xp: dy = inc
                                _addelement(xpos)
                            Else
                                PSet(xpos,ypos),col
                            Endif
                            Exit Do
                        Endif
                        If xpos >= xe Then Goto SkipScanQ1
                    Loop
                Else
                    _copyelement(s1)
                EndIf
                
                PSet (xpos, ypos), col
                Proc = FillLoop
                
                Do
                    xpos += 1
                    If xpos > xe Then Exit Do
                    _gosub(Proc)
                Loop
                
                If _N mod 2 = 1 Then
                    _copyelement(s2)
                EndIf
                
                SkipScanQ1:
                
            Next i
            
            If _N = 0 Then Exit For
            
            Redim Preserve as integer ShadowsA(1 to _N, 1 to 6)
            _copylist()
            Redim as integer ShadowsB(1 to 1, 1 to 6)
            
        Next inc
        
   
    '----------------------------------------------------QUAD 2------------------------------------
    
        Redim as integer ShadowsA(1 to 2, 1 to 6), ShadowsB(1 to 1, 1 to 6)
    
        _setaddr(FillLoop, FillQ2)
        _setaddr(SearchLoop, SearchQ2)
    
        ShadowsA(1,_Ek) = QuadBnd(3,_Ek): ShadowsA(1,_Dn) = QuadBnd(3,_Dn): ShadowsA(1,_Dp) = QuadBnd(3,_Dp)
        ShadowsA(1,_Xx) = yp: ShadowsA(1,_Xd) = QuadBnd(3,_Xd): ShadowsA(1,_Ub) = QuadBnd(3,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(4,_Ek): ShadowsA(2,_Dn) = QuadBnd(4,_Dn): ShadowsA(2,_Dp) = QuadBnd(4,_Dp)
        ShadowsA(2,_Xx) = yp: ShadowsA(2,_Xd) = QuadBnd(4,_Xd): ShadowsA(2,_Ub) = QuadBnd(4,_Ub)
        
        
        For inc = 1 to rad
            If inc > yend Then
                xcirc = SQR(rs - inc*inc)
                RightBnd = yp + xcirc
                LeftBnd  = yp - xcirc
            Else
                RightBnd = yp + inc - 1
                LeftBnd  = yp - inc 
            Endif
            xpos = xp + inc
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 to segs step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                
                xs = ShadowsA(s1,_Xx)
                xe = ShadowsA(s2,_Xx)
                
                If xe < LeftBnd Then 
                    Goto SkipScanQ2
                Elseif xs > RightBnd Then
                    Goto SkipScanQ2
                Elseif xs < LeftBnd Then
                    xs = LeftBnd
                Endif
                If xe > RightBnd Then xe = RightBnd
                ypos = xs
                If point(xpos, ypos) <> tcol Then
                    Do
                        ypos += 1
                        ccol = point(xpos,ypos,source)
                        If ccol = tcol or ccol = -1 Then
                            If ypos < xe Then
                                dx = ypos-yp: dy = inc
                                _addelement(ypos)
                            Else
                                PSet(xpos,ypos),col
                            EndIf
                            Exit Do
                        Endif
                        If ypos >= xe Then Goto SkipScanQ2
                    Loop
                Else
                    _copyelement(s1)
                Endif
                PSet (xpos, ypos), col
                Proc = FillLoop
                Do
                    ypos += 1
                    If ypos > xe Then Exit Do
                    _gosub(Proc)
                Loop
                If _N mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ2:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve as integer ShadowsA(1 to _N, 1 to 6)
            _copylist()
            Redim as integer ShadowsB(1 to 1, 1 to 6)
        Next inc


    '------------------------------------------------QUAD 3---------------------------------------
    
 
        Redim as integer ShadowsA(1 to 2, 1 to 6), ShadowsB(1 to 1, 1 to 6)
      
        _setaddr(FillLoop, FillQ3)
        _setaddr(SearchLoop, SearchQ3)

        ShadowsA(1,_Ek) = QuadBnd(5,_Ek): ShadowsA(1,_Dn) = QuadBnd(5,_Dn): ShadowsA(1,_Dp) = QuadBnd(5,_Dp)
        ShadowsA(1,_Xx) = xp: ShadowsA(1,_Xd) = QuadBnd(5,_Xd): ShadowsA(1,_Ub) = QuadBnd(5,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(6,_Ek): ShadowsA(2,_Dn) = QuadBnd(6,_Dn): ShadowsA(2,_Dp) = QuadBnd(6,_Dp)
        ShadowsA(2,_Xx) = xp: ShadowsA(2,_Xd) = QuadBnd(6,_Xd): ShadowsA(2,_Ub) = QuadBnd(6,_Ub)
    
        For inc = 1 to rad
            If inc > yend Then
                xcirc = SQR(rs - inc*inc)
                RightBnd = xp + xcirc
                LeftBnd  = xp - xcirc
            Else
                RightBnd = xp + inc
                LeftBnd  = xp - inc + 1
            Endif
            ypos = yp + inc
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 to segs step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                xs = ShadowsA(s1,_Xx): xe = ShadowsA(s2,_Xx)
                If xe > RightBnd Then 
                    Goto SkipScanQ3
                Elseif xs < LeftBnd Then
                    Goto SkipScanQ3
                Elseif xs > RightBnd Then
                    xs = RightBnd
                Endif
                If xe < LeftBnd Then xe = LeftBnd
                xpos = xs
                If point(xpos, ypos) <> tcol Then
                    Do
                        xpos -= 1
                        ccol = point(xpos,ypos,source)
                        If ccol = tcol or ccol = -1 Then
                            If xpos > xe Then
                                dx = xpos-xp: dy = inc
                                _addelement(xpos)
                            Else
                                PSet(xpos,ypos),col
                            Endif
                            Exit Do
                        Endif
                        If xpos <= xe Then Goto SkipScanQ3
                    Loop
                Else
                    _copyelement(s1)
                Endif
                PSet (xpos, ypos), col
                Proc = FillLoop
                Do
                    xpos -= 1
                    If xpos < xe Then Exit Do
                    _gosub(Proc)
                Loop
                If _N mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ3:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve as integer ShadowsA(1 to _N, 1 to 6)
            _copylist()
            Redim as integer ShadowsB(1 to 1, 1 to 6)
        Next inc


    '------------------------------------------------QUAD 4---------------------------------------


        Redim as integer ShadowsA(1 to 2, 1 to 6), ShadowsB(1 to 1, 1 to 6)
        
        _setaddr(FillLoop, FillQ4)
        _setaddr(SearchLoop, SearchQ4)
        
        ShadowsA(1,_Ek) = QuadBnd(7,_Ek): ShadowsA(1,_Dn) = QuadBnd(7,_Dn): ShadowsA(1,_Dp) = QuadBnd(7,_Dp)
        ShadowsA(1,_Xx) = yp: ShadowsA(1,_Xd) = QuadBnd(7,_Xd): ShadowsA(1,_Ub) = QuadBnd(7,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(8,_Ek): ShadowsA(2,_Dn) = QuadBnd(8,_Dn): ShadowsA(2,_Dp) = QuadBnd(8,_Dp)
        ShadowsA(2,_Xx) = yp: ShadowsA(2,_Xd) = QuadBnd(8,_Xd): ShadowsA(2,_Ub) = QuadBnd(8,_Ub)
        
        For inc = 1 to rad
            If inc > yend Then
                xcirc = SQR(rs - inc*inc)
                RightBnd = yp + xcirc
                LeftBnd  = yp - xcirc
            Else
                RightBnd = yp + inc
                LeftBnd  = yp - inc + 1
            Endif
            xpos = xp - inc
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 to segs step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                xs = ShadowsA(s1,_Xx): xe = ShadowsA(s2,_Xx)
                If xe > RightBnd Then 
                    Goto SkipScanQ4
                Elseif xs < LeftBnd Then
                    Goto SkipScanQ4
                Elseif xs > RightBnd Then
                    xs = RightBnd
                Endif
                If xe < LeftBnd Then xe = LeftBnd
                ypos = xs
                If point(xpos, ypos) <> tcol Then
                    Do
                        ypos -= 1
                        ccol = point(xpos,ypos,source)
                        If ccol = tcol or ccol = -1 Then
                            If ypos > xe Then
                                dx = ypos-yp: dy = inc
                                _addelement(ypos)
                            Else
                                PSet(xpos,ypos),col
                            Endif
                            Exit Do
                        Endif
                        If ypos <= xe Then Goto SkipScanQ4
                    Loop
                Else
                    _copyelement(s1)
                EndIf
                PSet (xpos, ypos), col
                Proc = FillLoop
                Do
                    ypos -= 1
                    If ypos < xe Then Exit Do
                    _gosub(Proc)
                Loop 
                If _N mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ4:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve as integer ShadowsA(1 to _N, 1 to 6)
            _copylist()
            Redim as integer ShadowsB(1 to 1, 1 to 6)
        Next inc
   
    Exit Sub
    
    '======================================FILLING LOOPS======================================
    
    asm FillQ1:
        If Point(xpos,ypos,source) <> tcol Then
            dx = xpos-xp-1: dy = inc
            _addelement(xpos-1)
            Proc = SearchLoop
        Else
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col		'<--- my addition !!!
        Endif
    _return
    
    asm SearchQ1:
        If point(xpos,ypos,source) = tcol Then
            dx = xpos-xp: dy = inc 
            _addelement(xpos)
            Proc = FillLoop
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm FillQ2:
        If point(xpos,ypos,source) <> tcol Then
            dx = ypos-yp-1: dy = inc
            _addelement(ypos-1)
            Proc = SearchLoop
        Else
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm SearchQ2:
        If point(xpos,ypos,source) = tcol Then
            dx = ypos-yp: dy = inc
            _addelement(ypos)
            Proc = FillLoop
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm FillQ3:
        If point(xpos,ypos,source) <> tcol Then
            dx = xpos-xp+1: dy = inc
            _addelement(xpos+1)
            Proc = SearchLoop
        Else
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm SearchQ3:
        If point(xpos,ypos,source) = tcol Then
            dx = xpos-xp: dy = inc 
            _addelement(xpos)
            Proc = FillLoop
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm FillQ4:
        If point(xpos,ypos,source) <> tcol Then
            dx = ypos-yp+1: dy = inc
            _addelement(ypos+1)
            Proc = SearchLoop
        Else
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    asm SearchQ4:
        If point(xpos,ypos,source) = tcol Then
            dx = ypos-yp: dy = inc
            _addelement(ypos)
            Proc = FillLoop
            'Pset(xpos,ypos), col
            Sptr[xpos + ypos * 640] = Col
        Endif
    _return
    
    
    
End Sub


screenres 640,480,32
setmouse ,,0
Dim as integer ptr Img
Dim as integer mx, my
Img = ImageCreate(640,480)
Bload "ShadowTest.bmp", Img

Do  
	ScreenLock
    getmouse mx,my
    If mx = -1 Then 
        mx = 320
        my = 240
    Endif
    Put (0,0), Img, PSET
    Locate 1,1: Print mx, my
    CastLight Img,mx,my,150
	ScreenUnLock
	Sleep 1, 1
Loop until inkey$ <> ""
ImageDestroy Img
end
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

Wow... even with plenty more psets and points that was an incredible speed boost. That was very inspiring thank you!
Top
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Post by h4tt3n »

You're welcome. Next thing might be getting rid of those nasty sqr() calls. And making the light dimmer furthest away from the source :-)

Oh, btw screen pointers work both ways, you can replace all the Point() calls too and gain even more speed. Only difficulty is that screen pointers crash the program if you try to access a pixel outside the window, which Pset() and Point() handles automatically.

Cheers,
Mike
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

Actually, the sqr calls only happen once per line at the very end of the casting and its hardly worthing getting rid of them. Yeah, my next plan is to optomize it using these screen pointers and then getting the light to obey Intensity/r^2 effectively
Top
h4tt3n
Posts: 698
Joined: Oct 22, 2005 21:12
Location: Denmark

Post by h4tt3n »

Well, if you've only got a few hundred sqr() calls / loop I suppose it's ok. Personally, I've made it somewhat of a sport to eliminate square roots, since they're one of the most cpu consuming functions around. I'd still recommend you to slice them away, if for no other reason then to become a better coder ^^

1/r^2 light intensity sounds great, looking forward to seeing it. keep up the good work!

cheers,
Mike
Top
badmrbox
Posts: 664
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:
Contact badmrbox

Post by badmrbox »

With what version of FB am I supposed to compile this code with to make it work?
Top
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:
Contact vdecampo

Post by vdecampo »

I am using the latest SVN 0.21.0 and it works for me.

-Vince
Top
badmrbox
Posts: 664
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:
Contact badmrbox

Post by badmrbox »

Ok, I'll try that. It doesn't work with 0.20.
Top
vdecampo
Posts: 2992
Joined: Aug 07, 2007 23:20
Location: Maryland, USA
Contact:
Contact vdecampo

Post by vdecampo »

I also tried it with 0.20.0 and that worked too.
-Vince
Top
counting_pine
Site Admin
Posts: 6323
Joined: Jul 05, 2005 17:32
Location: Manchester, Lancs

Post by counting_pine »

The original version (from mediafire) won't compile in lang fb, because a few variables aren't declared. h4tten's code fixes those.

@Zamaster, nice program. It's difficult to pick up the algorithm from the code, but it seems to work well.
The only possible problem I can see is that it seems to get a bit stuck on jagged surfaces it's facing directly - some pixels can "hide" in the corners created by the integer gradients. Is that a bug in the algorithm, or feature of it?

Anyway, it's good to see more stuff like this from you. Doesn't feel like we've seen enough of you in recent times. Hope you're keeping well.
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

I painfully found a way to rid the code of muls and sqrts... just for you h4tt3n. I also converted all instances of point and pset to pointer calls, however it crashes in the upper left hand corner :/ somewhere in the Quad 4 code.

@countingpine
Thank you! I havent done any programming for fun in a while due to school so I'm trying to get back into it. Yeah, its actually a feature, those pixels arent covered by the light cone so shouldnt be colored. At some point I want to add light bleeding, in which case those pixels and many others would be filled.

Code: Select all


Const RR2 As Double = Sqr(2)^-1
Const PI As Double = Atn(1)*4
Const TWOPI As Double = PI*2
Const Antumbra As Double = 0.349065850398865
#define SCRX 640
#define SCRY 480


Sub CastLight(source As Integer Ptr, xp As Integer, yp As Integer,_
              rad As Double, col As Integer = &HFFFFFF00, tcol As Integer = &HFF000000)
              
    #macro _setaddr(dest, src)
        asm mov eax, offset src
        asm mov [dest], eax
    #endmacro
    #define _gosub(addr) asm Call [addr]
    #define _return asm ret

    #define _Ek 1
    #define _Dn 2
    #define _Dp 3
    #define _Xd 4
    #define _Ub 5
    #define _Xx 6

    #macro _addelement(a)
        _N += 1
        Redim Preserve As Integer ShadowsB(1 To _N, 1 To 6)
        ShadowsB(_N,_Xx) = a: ShadowsB(_N,_Xd) = Sgn(dx)
        dx = Abs(dx): dy = Abs(dy)
        ShadowsB(_N,_Ek) = 2 * dx - dy
        ShadowsB(_N,_Dn) = ShadowsB(_N,_Ek) + dy
        ShadowsB(_N,_Dp) = ShadowsB(_N,_Ek) - dy
        ShadowsB(_N,_Ub) = 1
    #endmacro
    
    #macro _copyelement(x)
        _N += 1
        Redim Preserve As Integer ShadowsB(1 To _N, 1 To 6)
        ShadowsB(_N,_Ek) = ShadowsA(x,_Ek)
        ShadowsB(_N,_Dn) = ShadowsA(x,_Dn)
        ShadowsB(_N,_Dp) = ShadowsA(x,_Dp)
        ShadowsB(_N,_Xx) = ShadowsA(x,_Xx)
        ShadowsB(_N,_Xd) = ShadowsA(x,_Xd)
        ShadowsB(_N,_Ub) = ShadowsA(x,_Ub)
    #endmacro
    
    #macro _copylist()
        For i = 1 To _N
            ShadowsA(i,1)=ShadowsB(i,1)
            ShadowsA(i,2)=ShadowsB(i,2)
            ShadowsA(i,3)=ShadowsB(i,3)
            ShadowsA(i,4)=ShadowsB(i,4)
            ShadowsA(i,5)=ShadowsB(i,5)
            ShadowsA(i,6)=ShadowsB(i,6)
        Next i
    #endmacro
    

    Redim As Integer ShadowsA(1 To 2, 1 To 6), ShadowsB(1 To 1, 1 To 6)
    Dim As Integer inc, scan, xs, xe, yend = rad*RR2, rs = rad*rad, xcirc, dx, dy, s1, s2, prad
    Dim As Integer xpos, ypos, segs, i, _N, ccol, LeftBnd, RightBnd, Offset, yadd
    Dim As Any Ptr FillLoop, SearchLoop, Proc
    Dim As Integer QuadBnd(1 To 8, 1 To 5)
    
    Dim As Uinteger Ptr Sptr = ScreenPtr                        

    QuadBnd(1,_Ek) = 1: QuadBnd(1,_Dn) = 2: QuadBnd(1,_Dp) = 0: QuadBnd(1,_Xd) = -1: QuadBnd(1,_Ub) = 0
    QuadBnd(2,_Ek) = 1: QuadBnd(2,_Dn) = 2: QuadBnd(2,_Dp) = 0: QuadBnd(2,_Xd) =  1: QuadBnd(2,_Ub) = 0
    QuadBnd(3,_Ek) = 1: QuadBnd(3,_Dn) = 2: QuadBnd(3,_Dp) = 0: QuadBnd(3,_Xd) = -1: QuadBnd(3,_Ub) = 0
    QuadBnd(4,_Ek) = 1: QuadBnd(4,_Dn) = 2: QuadBnd(4,_Dp) = 0: QuadBnd(4,_Xd) =  1: QuadBnd(4,_Ub) = 0
    QuadBnd(5,_Ek) = 1: QuadBnd(5,_Dn) = 2: QuadBnd(5,_Dp) = 0: QuadBnd(5,_Xd) =  1: QuadBnd(5,_Ub) = 0
    QuadBnd(6,_Ek) = 1: QuadBnd(6,_Dn) = 2: QuadBnd(6,_Dp) = 0: QuadBnd(6,_Xd) = -1: QuadBnd(6,_Ub) = 0
    QuadBnd(7,_Ek) = 1: QuadBnd(7,_Dn) = 2: QuadBnd(7,_Dp) = 0: QuadBnd(7,_Xd) =  1: QuadBnd(7,_Ub) = 0
    QuadBnd(8,_Ek) = 1: QuadBnd(8,_Dn) = 2: QuadBnd(8,_Dp) = 0: QuadBnd(8,_Xd) = -1: QuadBnd(8,_Ub) = 0
    prad = rad-yend
    Dim as integer CurveOff(1 to prad), cind
    dx = 0
    dy = Rad
    xs = 1 - Rad
    i = prad
    Do
        If xs < 0 Then
            xs += dx SHL 1 + 3
        Else
            xs += (dx - dy) SHL 1 + 5
            CurveOff(i) = dx
            dy -= 1
            i -= 1
        End If
        dx += 1
    Loop Until i = 0
    '-------------------------------------------------QUAD 1---------------------------------------
    
        _setaddr(FillLoop, FillQ1)
        _setaddr(SearchLoop, SearchQ1)
    
        ShadowsA(1,_Ek) = QuadBnd(1,_Ek): ShadowsA(1,_Dn) = QuadBnd(1,_Dn): ShadowsA(1,_Dp) = QuadBnd(1,_Dp)
        ShadowsA(1,_Xx) = xp: ShadowsA(1,_Xd) = QuadBnd(1,_Xd): ShadowsA(1,_Ub) = QuadBnd(1,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(2,_Ek): ShadowsA(2,_Dn) = QuadBnd(2,_Dn): ShadowsA(2,_Dp) = QuadBnd(2,_Dp)
        ShadowsA(2,_Xx) = xp: ShadowsA(2,_Xd) = QuadBnd(2,_Xd): ShadowsA(2,_Ub) = QuadBnd(2,_Ub)
        yadd = yp * SCRX
        If yp - rad < 0 Then 
            prad = yp 
        Else
            prad = rad
        Endif
        For inc = 1 To prad
            If inc > yend Then
                xcirc = inc - yend
                RightBnd = xp + CurveOff(xcirc)
                LeftBnd  = xp - CurveOff(xcirc)
            Else
                RightBnd = xp + inc - 1
                LeftBnd  = xp - inc
            Endif
            If RightBnd >= SCRX Then RightBnd = SCRX-1
            If LeftBnd  <  0    Then LeftBnd  = 0
            ypos = yp - inc
            yadd -= SCRX
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 To segs Step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                xs = ShadowsA(s1,_Xx)
                xe = ShadowsA(s2,_Xx)
                If xe < LeftBnd Then 
                    Goto SkipScanQ1
                Elseif xs > RightBnd Then
                    Goto SkipScanQ1
                Elseif xs < LeftBnd Then
                    xs = LeftBnd
                Endif
                If xe > RightBnd Then xe = RightBnd
                xpos = xs
                If Sptr[yadd+xpos] <> tcol Then
                    Do
                        xpos += 1
                        If xpos >= xe Then Goto SkipScanQ1
                        ccol = Sptr[yadd+xpos]
                        If ccol = tcol Or ccol = -1 Then
                            If xpos < xe Then
                                dx = xpos-xp: dy = inc
                                _addelement(xpos)
                            Else
                                Sptr[yadd+xpos] = col
                            Endif
                            Exit Do
                        Endif
                    Loop
                Else
                    _copyelement(s1)
                Endif
                Sptr[yadd+xpos] = col
                Proc = FillLoop
                Do
                    xpos += 1
                    If xpos > xe Then Exit Do
                    _gosub(Proc)
                Loop
                If _N Mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ1:           
            Next i
            If _N = 0 Then Exit For
            Redim Preserve As Integer ShadowsA(1 To _N, 1 To 6)
            _copylist()
            Redim As Integer ShadowsB(1 To 1, 1 To 6)
        Next inc
    
 
    '----------------------------------------------------QUAD 2------------------------------------
    
        Redim As Integer ShadowsA(1 To 2, 1 To 6), ShadowsB(1 To 1, 1 To 6)
    
        _setaddr(FillLoop, FillQ2)
        _setaddr(SearchLoop, SearchQ2)
    
        ShadowsA(1,_Ek) = QuadBnd(3,_Ek): ShadowsA(1,_Dn) = QuadBnd(3,_Dn): ShadowsA(1,_Dp) = QuadBnd(3,_Dp)
        ShadowsA(1,_Xx) = yp: ShadowsA(1,_Xd) = QuadBnd(3,_Xd): ShadowsA(1,_Ub) = QuadBnd(3,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(4,_Ek): ShadowsA(2,_Dn) = QuadBnd(4,_Dn): ShadowsA(2,_Dp) = QuadBnd(4,_Dp)
        ShadowsA(2,_Xx) = yp: ShadowsA(2,_Xd) = QuadBnd(4,_Xd): ShadowsA(2,_Ub) = QuadBnd(4,_Ub)
        
        If xp + rad >= SCRX Then
            prad = SCRX-xp-1
        Else
            prad = rad
        Endif
        For inc = 1 To prad
            If inc > yend Then
                xcirc = inc-yend
                RightBnd = yp + CurveOff(xcirc)
                LeftBnd  = yp - CurveOff(xcirc)
            Else
                RightBnd = yp + inc - 1
                LeftBnd  = yp - inc 
            Endif
            If RightBnd >= SCRY Then RightBnd = SCRY-1
            If LeftBnd  <  0    Then LeftBnd  = 0
            xpos = xp + inc
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 To segs Step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                
                xs = ShadowsA(s1,_Xx)
                xe = ShadowsA(s2,_Xx)
                
                If xe < LeftBnd Then 
                    Goto SkipScanQ2
                Elseif xs > RightBnd Then
                    Goto SkipScanQ2
                Elseif xs < LeftBnd Then
                    xs = LeftBnd
                Endif
                If xe > RightBnd Then xe = RightBnd
                ypos = xs
                yadd = xs * SCRX
                If Sptr[yadd+xpos] <> tcol Then
                    Do
                        ypos += 1
                        If ypos >= xe Then Goto SkipScanQ2
                        yadd += SCRX
                        ccol = Sptr[yadd+xpos]
                        If ccol = tcol Or ccol = -1 Then
                            If ypos < xe Then
                                dx = ypos-yp: dy = inc
                                _addelement(ypos)
                            Else
                                Sptr[yadd+xpos] = col
                            Endif
                            Exit Do
                        Endif
                    Loop
                Else
                    _copyelement(s1)
                Endif
                Pset (xpos, ypos), col
                Proc = FillLoop
                Do
                    ypos += 1
                    yadd += SCRX
                    If ypos > xe Then Exit Do
                    _gosub(Proc)
                Loop
                If _N Mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ2:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve As Integer ShadowsA(1 To _N, 1 To 6)
            _copylist()
            Redim As Integer ShadowsB(1 To 1, 1 To 6)
        Next inc


    '------------------------------------------------QUAD 3---------------------------------------
     
 
        Redim As Integer ShadowsA(1 To 2, 1 To 6), ShadowsB(1 To 1, 1 To 6)
      
        _setaddr(FillLoop, FillQ3)
        _setaddr(SearchLoop, SearchQ3)

        ShadowsA(1,_Ek) = QuadBnd(5,_Ek): ShadowsA(1,_Dn) = QuadBnd(5,_Dn): ShadowsA(1,_Dp) = QuadBnd(5,_Dp)
        ShadowsA(1,_Xx) = xp: ShadowsA(1,_Xd) = QuadBnd(5,_Xd): ShadowsA(1,_Ub) = QuadBnd(5,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(6,_Ek): ShadowsA(2,_Dn) = QuadBnd(6,_Dn): ShadowsA(2,_Dp) = QuadBnd(6,_Dp)
        ShadowsA(2,_Xx) = xp: ShadowsA(2,_Xd) = QuadBnd(6,_Xd): ShadowsA(2,_Ub) = QuadBnd(6,_Ub)
        yadd = yp * SCRX
        If yp + inc > SCRY Then
            prad = SCRY - yp
        Else
            prad = rad
        Endif
        For inc = 1 To prad
            If inc > yend Then
                xcirc = inc - yend
                RightBnd = xp + CurveOff(xcirc)
                LeftBnd  = xp - CurveOff(xcirc)
            Else
                RightBnd = xp + inc
                LeftBnd  = xp - inc + 1
            Endif
            If RightBnd >= SCRX Then RightBnd = SCRX - 1
            If LeftBnd  <  0    Then LeftBnd  = 0
            ypos = yp + inc
            yadd += SCRX
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 To segs Step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                xs = ShadowsA(s1,_Xx): xe = ShadowsA(s2,_Xx)
                If xe > RightBnd Then 
                    Goto SkipScanQ3
                Elseif xs < LeftBnd Then
                    Goto SkipScanQ3
                Elseif xs > RightBnd Then
                    xs = RightBnd
                Endif
                If xe < LeftBnd Then xe = LeftBnd
                xpos = xs
                If Sptr[yadd+xpos] <> tcol Then
                    Do
                        xpos -= 1
                        If xpos <= xe Then Goto SkipScanQ3
                        ccol = Sptr[yadd+xpos]
                        If ccol = tcol Or ccol = -1 Then
                            If xpos > xe Then
                                dx = xpos-xp: dy = inc
                                _addelement(xpos)
                            Else
                                Sptr[yadd+xpos] = col
                            Endif
                            Exit Do
                        Endif
                    Loop
                Else
                    _copyelement(s1)
                Endif
                Sptr[yadd+xpos] = col
                Proc = FillLoop
                Do
                    xpos -= 1
                    If xpos < xe Then Exit Do
                    _gosub(Proc)
                Loop
                If _N Mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ3:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve As Integer ShadowsA(1 To _N, 1 To 6)
            _copylist()
            Redim As Integer ShadowsB(1 To 1, 1 To 6)
        Next inc

    '------------------------------------------------QUAD 4---------------------------------------
 

        Redim As Integer ShadowsA(1 To 2, 1 To 6), ShadowsB(1 To 1, 1 To 6)
        
        _setaddr(FillLoop, FillQ4)
        _setaddr(SearchLoop, SearchQ4)
        
        ShadowsA(1,_Ek) = QuadBnd(7,_Ek): ShadowsA(1,_Dn) = QuadBnd(7,_Dn): ShadowsA(1,_Dp) = QuadBnd(7,_Dp)
        ShadowsA(1,_Xx) = yp: ShadowsA(1,_Xd) = QuadBnd(7,_Xd): ShadowsA(1,_Ub) = QuadBnd(7,_Ub)
        ShadowsA(2,_Ek) = QuadBnd(8,_Ek): ShadowsA(2,_Dn) = QuadBnd(8,_Dn): ShadowsA(2,_Dp) = QuadBnd(8,_Dp)
        ShadowsA(2,_Xx) = yp: ShadowsA(2,_Xd) = QuadBnd(8,_Xd): ShadowsA(2,_Ub) = QuadBnd(8,_Ub)
        If xp - inc < 0 Then
            prad = xp
        Else
            prad = rad
        Endif
        For inc = 1 To prad
            If inc > yend Then
                xcirc = inc-yend
                RightBnd = yp + CurveOff(xcirc)
                LeftBnd  = yp - CurveOff(xcirc)
            Else
                RightBnd = yp + inc
                LeftBnd  = yp - inc + 1
            Endif
            If RightBnd >= SCRY Then RightBnd = SCRY-1
            If LeftBnd  <  0    Then LeftBnd  = 0
            xpos = xp - inc
            segs = Ubound(ShadowsA)
            _N = 0
            For i = 1 To segs Step 2
                s1 = i
                If ShadowsA(s1,_Ek) < 0 Then
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dn)
                Else
                    ShadowsA(s1,_Ek) += ShadowsA(s1,_Dp)
                    ShadowsA(s1,_Xx) += ShadowsA(s1,_Xd)
                End If
                s2 = i + 1
                If ShadowsA(s2,_Ek) < 0 Then
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dn)
                Else
                    ShadowsA(s2,_Ek) += ShadowsA(s2,_Dp)
                    ShadowsA(s2,_Xx) += ShadowsA(s2,_Xd)
                End If
                xs = ShadowsA(s1,_Xx): xe = ShadowsA(s2,_Xx)
                If xe > RightBnd Then 
                    Goto SkipScanQ4
                Elseif xs < LeftBnd Then
                    Goto SkipScanQ4
                Elseif xs > RightBnd Then
                    xs = RightBnd
                Endif
                If xe < LeftBnd Then xe = LeftBnd
                ypos = xs
                yadd = xs * SCRX
                If Sptr[yadd+xpos] <> tcol Then
                    Do
                        ypos -= 1
                        If ypos <= xe Then Goto SkipScanQ4
                        yadd -= SCRX
                        ccol = Sptr[yadd+xpos]
                        If ccol = tcol Or ccol = -1 Then
                            If ypos > xe Then
                                dx = ypos-yp: dy = inc
                                _addelement(ypos)
                            Else
                                Sptr[yadd+xpos] = col
                            Endif
                            Exit Do
                        Endif
                    Loop
                Else
                    _copyelement(s1)
                Endif
                Sptr[yadd+xpos] = col
                Proc = FillLoop
                Do
                    ypos -= 1
                    yadd -= SCRX
                    If ypos < xe Then Exit Do
                    _gosub(Proc)
                Loop 
                If _N Mod 2 = 1 Then
                    _copyelement(s2)
                Endif
                SkipScanQ4:
            Next i
            If _N = 0 Then Exit For
            Redim Preserve As Integer ShadowsA(1 To _N, 1 To 6)
            _copylist()
            Redim As Integer ShadowsB(1 To 1, 1 To 6)
        Next inc
   '/
    Exit Sub
    
    '======================================FILLING LOOPS======================================
    
    asm FillQ1:
        If Sptr[yadd+xpos] <> tcol Then
            dx = xpos-xp-1: dy = inc
            _addelement(xpos-1)
            Proc = SearchLoop
        Else
            Sptr[yadd+xpos] = Col               
        Endif
    _return
    
    asm SearchQ1:
        If Sptr[yadd+xpos] = tcol Then
            dx = xpos-xp: dy = inc 
            _addelement(xpos)
            Proc = FillLoop
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm FillQ2:
        If Sptr[yadd+xpos] <> tcol Then
            dx = ypos-yp-1: dy = inc
            _addelement(ypos-1)
            Proc = SearchLoop
        Else
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm SearchQ2:
        If Sptr[yadd+xpos] = tcol Then
            dx = ypos-yp: dy = inc
            _addelement(ypos)
            Proc = FillLoop
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm FillQ3:
        If Sptr[yadd+xpos] <> tcol Then
            dx = xpos-xp+1: dy = inc
            _addelement(xpos+1)
            Proc = SearchLoop
        Else
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm SearchQ3:
        If Sptr[yadd+xpos] = tcol Then
            dx = xpos-xp: dy = inc 
            _addelement(xpos)
            Proc = FillLoop
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm FillQ4:
        If Sptr[yadd+xpos] <> tcol Then
            dx = ypos-yp+1: dy = inc
            _addelement(ypos+1)
            Proc = SearchLoop
        Else
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    asm SearchQ4:
        If Sptr[yadd+xpos] = tcol Then
            dx = ypos-yp: dy = inc
            _addelement(ypos)
            Proc = FillLoop
            Sptr[yadd+xpos] = Col
        Endif
    _return
    
    
    
End Sub


screenres 640,480,32
setmouse ,,0
Dim As Integer Ptr Img
Dim As Integer mx, my
Img = ImageCreate(640,480)
Bload "ShadowTest.bmp", Img

Do  
        ScreenLock
    getmouse mx,my
    If mx = -1 Then 
        mx = 320
        my = 240
    Endif
    Put (0,0), Img, Pset
    Locate 1,1: Print mx, my
    CastLight Img,mx,my,300
    Circle (mx,my),10,&HFF0000,,,,F
        ScreenUnLock
        Sleep 1, 1
Loop Until Inkey$ <> ""
ImageDestroy Img
End
Last edited by Zamaster on Jan 28, 2009 1:14, edited 1 time in total.
Top
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Contact rdc

Post by rdc »

When I run this, all I get is a cyan colored screen and the mouse coordinates up in the corner. I am using Vista x64, so it is probably a compatibility issue.

It is strange since I haven't had a problem with any FB program other than this one.
Top
Zamaster
Posts: 1025
Joined: Jun 20, 2005 21:40
Contact:
Contact Zamaster

Post by Zamaster »

yeah, theres an image that goes with it that one would have to download from the link in the beginning of this post. Any 640x480 or whatever resolution image will work. As long as it has a black background.
Top
rdc
Posts: 1741
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:
Contact rdc

Post by rdc »

Stupid me. Thanks.
Top
Post Reply

Return to “Sources, Examples, Tips and Tricks”