I was just messing around this afternoon with some bobs and this is what I came up with..
Hope you like it :D
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.
'
' 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
btw feel free to adapt it into vector bobs :) I'd love to see it.
Nice one. Looks somehow strange that the lightsource is rotating
on the bobs but it really reminds me on an old Amiga production.
It will surely look better in a proper object with a sun flying around in front of it :)
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?
Quote from: Clyde on June 27, 2009
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.
nice one! Hope to see more and more oldsch00lish effects in proper full sw rendering !!! ;D
BTW Shockwave, you rock! keep up the good work! 10x for all of your efforts!
:clap: