Lightsourced bobs (faked!)

[Shockwave]

I was just messing around this afternoon with some bobs and this is what I came up with..
Hope you like it

This cheating effect would be easily possible on a standard A500 (with lower amount of colours and smaller bobs)... I can't recall it ever being done this way but I am probably wrong, it would look way cool with vector bobs too.

Code: [Select]

'
'                           FAKE LIGHTSOURCED BOBS
'
'                           BY SHOCKWAVE  27-06-09
'
'
'===============================================================================

    #INCLUDE "TINYPTC_EXT.BI"
    #INCLUDE "WINDOWS.BI"

'-------------------------------------------------------------------------------   
'   SCREEN SETUP;   
'-------------------------------------------------------------------------------

    CONST   XRES    =    800
    CONST   YRES    =    600

'-------------------------------------------------------------------------------
'   YOU CAN MESS WITH THESE A BIT IF YOU KNOW WHAT YOU ARE DOING;
'   THEY DEFINE HOW BIG THE BOB IS AND THE SIZE OF THE TEMPLATE
'   YOU'LL NEED TO MANUALLY ADJUST LATER IN THE CODE TO CENTER THE REFLECTION.
'-------------------------------------------------------------------------------

    DIM SHARED AS INTEGER RINGSIZE = 300
    DIM SHARED AS INTEGER BOBSIZE  = 128
   
    DIM SHARED AS UINTEGER BOB_BUFFER    ( BOBSIZE * BOBSIZE ):  ' HOLDS THE BOB
    DIM SHARED AS UINTEGER BUFFER        ( XRES * YRES ):        ' SCREEN BUFFER
    DIM SHARED AS UINTEGER RING_BUFFERA  ( RINGSIZE * RINGSIZE ):' ORIGINAL TEMPLATE
    DIM SHARED AS UINTEGER RING_BUFFERB  ( RINGSIZE * RINGSIZE ):' "WORK" TEMPLATE
   

    DECLARE SUB CREATEBOB():           '  WE NEED TO CREATE A NEW BOB EACH FRAME, THIS SUB DOES IT.
    DECLARE SUB FILL_RING_BUFFER():    '  SUB TO GENERATE CIRCULAR FILL PATTERN.   
    DECLARE SUB COPY_RING_BUFFER():    '  SUB TO COPY TEMPLATE TO WORK BUFFER AND CREATE BOB

'-------------------------------------------------------------------------------

'   SUB TO DRAW CIRCLES;
    DECLARE SUB CIRC(BYVAL BUFF AS INTEGER , BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)   

'   SUB TO DRAW BOBS;
    DECLARE SUB DRAW_BOB(BYVAL XP AS INTEGER, BYVAL YP AS INTEGER)

'-------------------------------------------------------------------------------

    FILL_RING_BUFFER():' GENERATE FILL PATTERN.

'-------------------------------------------------------------------------------
'   SET UP THE SCREEN.
'-------------------------------------------------------------------------------

    PTC_ALLOWCLOSE(0)   
    PTC_SETDIALOG(1,"WWW.DBFINTERACTIVE.COM"+CHR$(13)+"FULL SCREEN?",0,1)               
    IF (PTC_OPEN("Coded by Shockwave",XRES,YRES)=0) THEN
    END-1
    END IF   


'-------------------------------------------------------------------------------
'   SPAGHETTI CODE: VARIABLES ARE JUST THERE SO WE HAVE SOME TO MOVE AND DRAW BOBS.
'-------------------------------------------------------------------------------

    DIM AS INTEGER XX
    DIM SHARED AS DOUBLE NNN,FFF,GGG,HHH
   
    DIM SHARED AS DOUBLE ANGLE,OLD
   
'-------------------------------------------------------------------------------
'   MAIN LOOP
'-------------------------------------------------------------------------------
    ANGLE =0
    OLD=TIMER
    WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE) 
        ANGLE=ANGLE+((TIMER-OLD)*105)
        OLD=TIMER
        GGG=(TIMER*1.5)
        CREATEBOB()
        COPY_RING_BUFFER()
        FFF=0
        NNN=0
        HHH=0
        FOR XX=0 TO 50
        DRAW_BOB(340+(100*SIN(FFF+GGG)+100*SIN(NNN+GGG-FFF)),240+(100*SIN(FFF-GGG+HHH)+40*SIN(NNN+GGG-FFF)))
        FFF=FFF+.25
        NNN=NNN-.22
        HHH=HHH+.15
        NEXT

           


        PTC_UPDATE@BUFFER(0)
        ERASE BUFFER
        SLEEP 1
    WEND
    EXITPROCESS(0)
    END

'-------------------------------------------------------------------------------
'   DRAW A BOB AT XP,YP, MASKING THE COLOUR PURPLE. CAUTION !! NO CLIPPING !!
'-------------------------------------------------------------------------------

SUB DRAW_BOB(BYVAL XP AS INTEGER, BYVAL YP AS INTEGER)
DIM AS INTEGER X,Y
DIM AS UINTEGER PTR PP1,PP2


PP1=@BOB_BUFFER(0)

FOR Y =0 TO BOBSIZE-1
   
    PP2=@BUFFER(((Y+YP)*XRES)+XP)
    FOR X=0 TO BOBSIZE-1       
    IF *PP1<>&HFF00FF THEN       
        *PP2=*PP1       
    END IF   
    PP1+=1
    PP2+=1
    NEXT

NEXT


END SUB


'-------------------------------------------------------------------------------
'   CREATE A PURPLE SQUARE WITH A BLACK HOLE IN THE MIDDLE.
'-------------------------------------------------------------------------------

SUB CREATEBOB()

dim pp as integer ptr
DIM AS INTEGER SLICE,TC,Y


'-------------------------------------------------------------------------------
'   COLOUR ME PURPLE!
'-------------------------------------------------------------------------------

TC=RGB(255,0,255)

FOR Y=0 TO BOBSIZE-1
                    SLICE=BOBSIZE
                    PP=@BOB_BUFFER(Y*BOBSIZE)
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
NEXT

'-------------------------------------------------------------------------------
'   DRAW A BLACK HOLE IN THE MIDDLE!
'-------------------------------------------------------------------------------

CIRC(2,BOBSIZE/2,BOBSIZE/2,BOBSIZE/2,0,0,0)
END SUB



'-------------------------------------------------------------------------------
'        THIS SUB GENERATES A NEW WORK BUFFER AND THEN GETS THE BOB.
'-------------------------------------------------------------------------------

SUB COPY_RING_BUFFER()

'-------------------------------------------------------------------------------
'   COPY STORED TEMPLATE TO THE NEW ONE.
'-------------------------------------------------------------------------------

DIM AS INTEGER X,Y
DIM AS UINTEGER PTR PP1,PP2


PP1=@RING_BUFFERA(0)
PP2=@RING_BUFFERB(0)

FOR X=0 TO RINGSIZE*RINGSIZE
   
    *PP2=*PP1
    PP1+=1
    PP2+=1
   
NEXT


'-------------------------------------------------------------------------------
'   DRAW OUR STENCIL ON TOP OF THE WORK TEMPLATE, MOVING IT AROUND A BIT TO
'   CHEAT THE MOVING LIGHTSOURCE.
'-------------------------------------------------------------------------------

PP1=@BOB_BUFFER(0)
    NNN=(86+45*SIN(ANGLE*3.14/130))
    MMM=(86+45*COS(ANGLE*3.14/133))
    FOR Y=0 TO BOBSIZE-1
        PP2=@RING_BUFFERB(((Y+INT(MMM))*RINGSIZE)+INT(NNN))
        FOR X=0 TO BOBSIZE-1
            IF *PP1 <> &HFF00FF THEN
                *PP1=*PP2
            END IF           
        PP1+=1
        PP2+=1
        NEXT
    NEXT
END SUB



SUB FILL_RING_BUFFER()
   
    '---------------------------------------------------------------------------
    ' GENERATE A GRADIENT:
    '---------------------------------------------------------------------------
   
    DIM AS INTEGER Y
    DIM AS DOUBLE RR,GG,BB
    RR=0.01
    GG=0.01
    BB=0.01
    FOR Y=RINGSIZE/2 TO 1 STEP-1
   
        CIRC(1,RINGSIZE/2,RINGSIZE/2,Y,INT(RR),INT(GG),INT(BB))

        '-----------------------------------------------------------------------
        ' FAKE A SPECULAR HIGHLIGHT:
        '-----------------------------------------------------------------------
       
        IF Y<6 THEN
            BB=BB*3.15
            RR=RR*3.15
            GG=GG*3.15
        END IF


        IF Y<100 THEN
            BB=BB+.25
            RR=RR+.05
            GG=GG+.15
        END IF

        IF Y<40 THEN
            BB=BB+.25
            RR=RR+.05
            GG=GG+.15
        END IF
       
        BB=BB+.25
        IF BB>255 THEN BB=255

        RR=RR+.05
        IF RR>255 THEN RR=255

        GG=GG+.15
        IF GG>255 THEN GG=255


    NEXT
   
END SUB



SUB CIRC(BYVAL BUFF AS INTEGER , BYVAL CX AS INTEGER , BYVAL CY AS INTEGER , BYVAL R AS INTEGER, BYVAL CR AS INTEGER,BYVAL CG AS INTEGER,BYVAL CB AS INTEGER)

'-------------------------------------------------------------------------
'
' FILLED CIRCLE ROUTINE WITH ASSEMBLY LANGUAGE RASTERISING.
' USAGE  CIRC ( X , Y , RADIUS , R , G , B )
' REMEMBER THAT X + Y ARE THE CENTER OF YOUR CIRCLE.
' THIS HAS BASIC CLIPPING TO SCREEN BOUNDARIES.
'
'-------------------------------------------------------------------------

DIM  as integer r2,cc,loopy,ww,l,clipl , clipr,slice,tc,BXR,BYR
IF BUFF=1 THEN BXR=RINGSIZE
IF BUFF=1 THEN BYR=RINGSIZE

IF BUFF=2 THEN BXR=BOBSIZE
IF BUFF=2 THEN BYR=BOBSIZE

IF BUFF=3 THEN BXR=XRES
IF BUFF=3 THEN BYR=YRES


dim pp as integer ptr
r2=r*r
cc=-r
TC = RGB ( CR , CG , CB )
IF BUFF=1 THEN
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            pp=@RING_BUFFERA((BXR*(loopy+CY))+clipl)
            slice = clipr-clipl
           
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
           

   
        end if

next
END IF

IF BUFF=2 THEN
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            PP=@BOB_BUFFER((BXR*(loopy+CY))+clipl)
            SLICE = CLIPR-CLIPL
           
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
           

   
        end if

next
END IF


IF BUFF=3 THEN
for loopy = cc to r     
        ww = Sqr(r2-loopy*loopy)

        if loopy+cy>=0 and loopy+cy<BYR then
            clipl = cx-ww
            clipr = (cx+ww)-1
            if clipl<0 then clipl=0
            if clipr>BXR-1 then clipr = BXR-1
            PP=@BUFFER((BXR*(loopy+CY))+clipl)
            SLICE = CLIPR-CLIPL
           
            if slice>0 then
                    asm
                    mov eax,dword ptr[TC]
                    mov ecx, [slice]
                    mov edi, [PP]
                    rep stosd
                    end asm   
            end if
           

   
        end if

next
END IF



END SUB


[Shockwave]

btw feel free to adapt it into vector bobs I'd love to see it.

[benny!]

Nice one. Looks somehow strange that the lightsource is rotating
on the bobs but it really reminds me on an old Amiga production.

[Shockwave]

It will surely look better in a proper object with a sun flying around in front of it

[Clyde]

Looks very clever dude, reminds me of a release we did as DBF in the blitz days.

in the current version FB 0.20, there's a const overflow error in line 139 where the mask colour is set:

TC=RGB(255,000,255)

change tc to an uinteger to get rid of this.

Any chance of a brighter colour version dude, as it's rather dark?

[Shockwave]

Any chance of a brighter colour version dude, as it's rather dark?

Yes, you can adjust the colours yourself You have the source code.

[Moroboshisan]

nice one! Hope to see more and more oldsch00lish effects in proper full sw rendering !!!

BTW Shockwave, you rock! keep up the good work! 10x for all of your efforts!