Fast 2D Light Casting

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

Fast 2D Light Casting

Postby Zamaster » Jan 25, 2009 5:55

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]
h4tt3n
Posts: 691
Joined: Oct 22, 2005 21:12
Location: Denmark

Postby h4tt3n » Jan 25, 2009 8:22

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

Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jan 25, 2009 17:40

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

Postby h4tt3n » Jan 25, 2009 18:41

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
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jan 25, 2009 22:38

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
h4tt3n
Posts: 691
Joined: Oct 22, 2005 21:12
Location: Denmark

Postby h4tt3n » Jan 25, 2009 23:14

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
badmrbox
Posts: 659
Joined: Oct 27, 2005 14:40
Location: Sweden
Contact:

Postby badmrbox » Jan 25, 2009 23:24

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

Postby vdecampo » Jan 25, 2009 23:44

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

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

Postby badmrbox » Jan 26, 2009 1:10

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

Postby vdecampo » Jan 26, 2009 1:19

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

Postby counting_pine » Jan 26, 2009 2:06

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.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jan 27, 2009 0:24

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.
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Jan 27, 2009 0:53

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.
Zamaster
Posts: 1024
Joined: Jun 20, 2005 21:40
Contact:

Postby Zamaster » Jan 27, 2009 1:26

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.
rdc
Posts: 1713
Joined: May 27, 2005 17:22
Location: Texas, USA
Contact:

Postby rdc » Jan 27, 2009 22:48

Stupid me. Thanks.

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest