Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on June 27, 2009
-
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?
-
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: