Dark Bit Factory & Gravity
GENERAL => Projects => Topic started by: Shockwave on June 28, 2009
-
No apologies for the code, it's rushed :)
'
' FAKE LIGHTSOURCED BOBS
'
' BY SHOCKWAVE 27-06-09
'
'
'===============================================================================
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
'-------------------------------------------------------------------------------
' SCREEN SETUP;
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS INTEGER POINTS=27
DIM SHARED AS DOUBLE VXR,VYR,VZR,size
size=110
DIM SHARED AS DOUBLE VX(POINTS),VY(POINTS),VZ(POINTS),VT(POINTS)
DIM SHARED AS DOUBLE VTX(POINTS),VTY(POINTS),VTZ(POINTS),VTT(POINTS)
DECLARE SUB ROTATE()
DECLARE SUB DRAW_BOBS()
DIM L AS INTEGER
FOR L=1 TO POINTS
READ VX(L),VY(L),VZ(L),VT(L)
NEXT
'-------------------------------------------------------------------------------
' 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 = 120
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
DIM SHARED AS UINTEGER CPALETTE ( 1000 ,3 )
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, BYVAL BT AS INTEGER )
DECLARE SUB BERASE()
'-------------------------------------------------------------------------------
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 SHARED AS INTEGER XX,C
DIM SHARED AS DOUBLE NNN,FFF,GGG,HHH,LIGHTX,LIGHTY
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()
ROTATE()
DRAW_BOBS()
C=0
FOR XX=20 TO 5 STEP-1
CIRC(3,LIGHTX,LIGHTY,XX,C,C+20,C+40)
C=C+20
IF C>210 THEN C=210
NEXT
PTC_UPDATE@BUFFER(0)
'ERASE BUFFER
BERASE()
SLEEP 1
WEND
EXITPROCESS(0)
END
SUB DRAW_BOBS()
DIM AS DOUBLE TX,TY,TZ,TT
DIM AS INTEGER L1,L2
FOR L1=1 TO POINTS-1
FOR L2=1 TO POINTS-1
TX=VTX(L2+1)
TY=VTY(L2+1)
TZ=VTZ(L2+1)
TT=VTT(L2+1)
IF VTZ(L2)< TZ THEN
VTX(L2+1)=VTX(L2)
VTY(L2+1)=VTY(L2)
VTZ(L2+1)=VTZ(L2)
VTT(L2+1)=VTT(L2)
VTX(L2)=TX
VTY(L2)=TY
VTZ(L2)=TZ
VTT(L2)=TT
END IF
NEXT
NEXT
FOR L1=1 TO POINTS
DRAW_BOB(VTX(L1),VTY(L1),VTT(L1))
NEXT
END SUB
SUB BERASE()
dim pp as integer ptr
DIM AS INTEGER SLICE,TC,Y,SV,LV,RW
'-------------------------------------------------------------------------------
' COLOUR ME PURPLE!
'-------------------------------------------------------------------------------
DIM AS DOUBLE RRR,GGG
RRR=1
GGG=0
RW=0
FOR Y=0 TO YRES-1
select case y
case 0 to 39
TC=RGB(RW*.2,RW*.4,RW*1)
RW=RW+1
case yres-39 to yres
RW=RW-1
TC=RGB(RW*.2,RW*.4,RW*1)
case else
LV=5+4*SIN((Y-ANGLE)*.03)
SV=10+LV*SIN((ANGLE+Y)*.05)
TC=RGB(SV,SV*RRR,SV*GGG)
RRR=RRR-.0018
GGG=GGG+.02
case 40,yres-40
TC=&hAACCFF
end select
SLICE=XRES-1
PP=@BUFFER(Y*XRES)
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
NEXT
END SUB
'-------------------------------------------------------------------------------
' DRAW A BOB AT XP,YP, MASKING THE COLOUR PURPLE. CAUTION !! NO CLIPPING !!
'-------------------------------------------------------------------------------
SUB DRAW_BOB(BYVAL XP AS INTEGER, BYVAL YP AS INTEGER , BYVAL BT 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=CPALETTE(*PP1 , BT)
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=(90+40*SIN(ANGLE*3.14/120))
MMM=(90+40*COS(ANGLE*3.14/133))
LIGHTY=((YRES/2)-330*COS(ANGLE*3.14/133))
LIGHTX=((XRES/2)-330*SIN(ANGLE*3.14/120))
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,P
DIM AS DOUBLE RR,GG,BB,BR
P=0
FOR Y=RINGSIZE/2 TO 1 STEP-1
CIRC(1,RINGSIZE/2,RINGSIZE/2,Y,P,0,0)
'-----------------------------------------------------------------------
' FAKE A SPECULAR HIGHLIGHT:
'-----------------------------------------------------------------------
IF Y<60 THEN
P=P+4
END IF
IF Y<120 THEN
P=P+1
END IF
P=P+1
IF P>1000 THEN P=1000
NEXT
BR=90
RR=0
GG=0
BB=0
FOR Y=0 TO 1000
if y>300 then
RR=RR+.45
GG=GG+.45
BB=BB+.45
BR=BR+.45
end if
if y>250 then
RR=RR+.45
GG=GG+.45
BB=BB+.45
BR=BR+.45
end if
IF Y<30 THEN
BR=BR-2
ELSE
RR=RR+.2
GG=GG+.2
BB=BB+.2
END IF
IF BB>255 THEN BB=255
IF RR>255 THEN RR=255
IF GG>255 THEN GG=255
IF BR>255 THEN BR=255
CPALETTE(Y,1)=RGB(INT(RR),BR,BR)
CPALETTE(Y,2)=RGB(BR,INT(GG),BR)
CPALETTE(Y,3)=RGB(BR,BR,INT(BB))
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
TC=CR
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
SUB ROTATE()
DIM A AS INTEGER
DIM VX1 AS DOUBLE
dim VY1 AS DOUBLE
dim VZ1 AS DOUBLE
DIM VZZ AS DOUBLE
dim vxx as double
dim vyy as double
DIM VDV AS DOUBLE
'###############################################
'## Rotate And Scale Each Point! Store Result ##
'###############################################
For a=1 To points
VX1=VX(A)
VY1=VY(A)
VZ1=VZ(A)
'######################
'## X,Y,Z rotations! ##
'######################
Vxx=Vx1
Vyy=Vy1*cos(Vxr)+Vz1*sin(Vxr)
Vzz=Vz1*cos(Vxr)-Vy1*sin(Vxr)
Vy1=Vyy
Vx1=Vxx*cos(Vyr)-Vzz*sin(Vyr)
Vz1=Vxx*sin(Vyr)+Vzz*cos(Vyr)
Vzz=Vz1
Vxx=Vx1*cos(Vzr)-Vy1*sin(Vzr)
Vyy=Vx1*sin(Vzr)+Vy1*cos(Vzr)
'########################
'## Apply Perspective! ##
'########################
Vdv=(Vzz/4)+1
Vxx=(size*(Vxx/Vdv))+(XRES/2)-60
Vyy=(size*(Vyy/Vdv))+(YRES/2)-60
Vtx(a)=(Vxx)
Vty(a)=(Vyy)
Vtz(a)=(Vzz)
VtT(a)=(VT(A))
'buffer(vtx(a)+(vty(a)*xres)) = &hffffff
Next
Vxr=Vxr+.01
Vyr=Vyr+.02
Vzr=Vzr+.03
END SUB
data -1,-1,-1,1
data 0,-1,-1,1
data 1,-1,-1,1
data -1, 0,-1,1
data 0, 0,-1,1
data 1, 0,-1,1
data -1, 1,-1,1
data 0, 1,-1,1
data 1, 1,-1,1
data -1,-1, 0,2
data 0,-1, 0,2
data 1,-1, 0,2
data -1, 0, 0,2
data 0, 0, 0,2
data 1, 0, 0,2
data -1, 1, 0,2
data 0, 1, 0,2
data 1, 1, 0,2
data -1,-1, 1,3
data 0,-1, 1,3
data 1,-1, 1,3
data -1, 0, 1,3
data 0, 0, 1,3
data 1, 0, 1,3
data -1, 1, 1,3
data 0, 1, 1,3
data 1, 1, 1,3
-
Outstanding VectorBobs. Very cool. With seeing the lightsource
it makes much more sense now. Brilliant work, mate! That's truley
oldschoolish!
-
A very nice set of balls you are displaying there.
-
Thank you, Im glad that you like them.. They are quite big.
-
One thing that might make it stand out even more is to consider using gradients that are not so linear. When a person looks at a metallic object, they know it is metal often because they see light reflections next to darker areas. Logically this could never be so we understand that there is an object being reflected. What you might try is giving each ball a sort of base reflection (which would be a very abstract series of light and dark) and then drawing your effect as a sort of transparent overlay. The world reflections on the balls would not move but your light mapped overlay light effect would.
Here we have a very basic but effective chrome reflection. This is very generic but we see a world reflected here.
Even though you can see the sun reflected there, that does not mean that the close light reflection comes directly from that angle. This frees you to put the reflection spot anywhere regardless of where the sun is "mapped".
-
Damned nice idea P_O :)
I think that it could work too, just by blending the circular gradient over the base image your effect could be displayed.
I do like my balls, I know not everyone has balls of steel so I felt a bit bad about displaying them at first to be honest.
Now my balls are on display for everyone to see I think that I want them to look as good as possible so I will be very happy for anyone to play with my balls to add this effect to them.
Thanks mate :)
-
Pretty cool :) I remember the same effect in Blitz in DBF's Alive; also did one myself.
Great metallic spin :D
-
You have a good memory :)
I was actually looking at that old demo and decided to make a freebasic version :)
-
Good memory? Nah, just my favorite old demo :D That and WhammyKefBalls ;)
Fash's best work, along with No-3D I have to say.
-
I spoke to Parabellum about a year and a half ago via Email :)
He has made a vectrex emulator in Java, it's brilliant. His blog is here;
http://vectrex-emu.blogspot.com/ (http://vectrex-emu.blogspot.com/)
It hasnt been updated since last year but it's fantastic stuff.
-
Wow, great to see he's still kickin' :)
-
Wow, great to see he's still kickin' :)
I wish that he would come back to be honest with you Ferris, he's one of my oldest friends on the internet and I miss the chats we used to have a great deal.