Here you go, a real oldschool effect this time!
Coded in one hour for Hotshot, hope you like them my friend.
'
' Typical Shadebobs style effect by Shockwave.
'
' An acknowledgement would be great if you decide to take anything from this
' code.
'
' Uncredited ripping is lamer behaviour and puts people off sharing their code.
' Props to you if you share credit.
'
' http://www.dbfinteractive.com/index.php
'
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
'>> LIBS:
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
'>> SUBROUTINES;
'-------------------------------------------------------------------------------
DECLARE SUB DRAWBOB(BYVAL PX AS INTEGER, BYVAL PY AS INTEGER)
DECLARE SUB READ_BOB()
DECLARE SUB CYCLE_PALETTE()
DECLARE SUB COPY_BUFFER()
DECLARE SUB EFFECT()
DECLARE SUB RESET_STUFF()
'-------------------------------------------------------------------------------
'>> SCREENSIZE;
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
'-------------------------------------------------------------------------------
'>> INITIALISE PROGRAM;
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE OLD,TICK,EFT,ADD1,ADD2
DIM SHARED AS UINTEGER BOBSIZE = 16
DIM SHARED AS UINTEGER BOB_IMAGE(BOBSIZE * BOBSIZE)
READ_BOB()
DIM SHARED AS UINTEGER COLOUR_PALETTE ( 256 )
DIM SHARED AS UINTEGER SCREEN_BUFFER ( XRES * YRES )
DIM SHARED AS UINTEGER BOB_BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
'>> INITIALISE SCREEN;
'-------------------------------------------------------------------------------
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"WWW.DBFINTERACTIVE.COM"+CHR$(13)+"FULL SCREEN?",0,1)
IF (PTC_OPEN("By Shockwave",XRES,YRES)=0) THEN
END-1
END IF
SLEEP 5
RESET_STUFF()
CYCLE_PALETTE()
'-------------------------------------------------------------------------------
'>> MAIN LOOP;
'-------------------------------------------------------------------------------
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
OLD=TIMER
EFFECT()
PTC_UPDATE@SCREEN_BUFFER(0)
COPY_BUFFER()
CYCLE_PALETTE()
SLEEP 1
TICK=TICK+(TIMER-OLD)
IF TIMER-EFT>5 THEN RESET_STUFF()
WEND
EXITPROCESS(0)
'-------------------------------------------------------------------------------
'>> GENERATE NEW PATTERN AND CLEAR BUFFER;
'-------------------------------------------------------------------------------
SUB RESET_STUFF()
ADD1=(RND(1)/10)
ADD2=(RND(1)/10)
ERASE BOB_BUFFER
EFT=TIMER
END SUB
'-------------------------------------------------------------------------------
'>> DRAW THE LITTLE OLD FUCKERS;
'-------------------------------------------------------------------------------
SUB EFFECT()
DIM AS INTEGER L
DIM AS INTEGER CX,CY,H1,H2,V1,V2
DIM AS DOUBLE LL,LL2
CX=(XRES-BOBSIZE)/2
CY=(YRES-BOBSIZE)/2
V1=CY/2
V2=CY/3
H1=CX/2
H2=CX/3
FOR L=0 TO 360
DRAWBOB (CX+(H1*SIN(TICK+LL2))+(H2*COS(TICK-LL)),CY+(V1*SIN(TICK-LL2))+(V2*COS(TICK+LL)))
LL=LL+ADD1
LL2=LL2+ADD2
NEXT
END SUB
'-------------------------------------------------------------------------------
'>> Add our bob to the bob buffer, cycling the colours if they go outside the range.
'-------------------------------------------------------------------------------
SUB DRAWBOB(BYVAL PX AS INTEGER, BYVAL PY AS INTEGER)
DIM AS UINTEGER PTR PP1,PP2
DIM AS INTEGER X,Y
FOR Y=0 TO BOBSIZE-1
PP1=@BOB_IMAGE(Y*BOBSIZE)
PP2=@BOB_BUFFER(((Y+PY)*XRES)+PX)
' ADD SOME RUDIMENTARY Y CLIPPING TO STOP IT CRASHING IN CASE THE
' SETTINGS ARE CHANGED AND BOBS ARE DRAWN OUTSIDE, IT'S CLIPPED LINE BY
' LINE SO IT'S QUITE FAST, HORIZONTAL ERRORS WILL WRAP AROUND AND LOOK
' UGLY BUT WONT CRASH THE PROGRAM.
IF PY+Y>0 AND PY+Y<YRES THEN
FOR X=0 TO BOBSIZE-1
*PP2=*PP2+*PP1
' ROTATE IF > 255 TO MAKE THE COLOURS WRAP AROUND.
IF *PP2>255 THEN *PP2=0
PP1+=1
PP2+=1
NEXT
END IF
NEXT
END SUB
'-------------------------------------------------------------------------------
'>> Rainbow Cycling 256 colour palette :)
'-------------------------------------------------------------------------------
SUB CYCLE_PALETTE()
DIM AS INTEGER L
DIM AS DOUBLE MM,NN,GROW,GROWER
MM=0
NN=0
GROWER=1/255
GROW=0
COLOUR_PALETTE(0)=&H000000
FOR L=1 TO 255
COLOUR_PALETTE(L)=RGB(GROW*(125+124*SIN(MM+TICK)),GROW*(125+124*SIN(NN+TICK)),GROW*(125+124*SIN(MM-TICK)))
MM=MM+ADD1
NN=NN+ADD2
GROW=GROW+GROWER
NEXT
END SUB
'-------------------------------------------------------------------------------
'>> Read in the bob image.
'-------------------------------------------------------------------------------
SUB READ_BOB()
DIM AS INTEGER L
FOR L=0 TO (BOBSIZE*BOBSIZE)
READ BOB_IMAGE(L)
NEXT
END SUB
'-------------------------------------------------------------------------------
'>> Take the colour index stored in the bob buffer and copy the colour over to
'>> the screen buffer, clearing the screen at the same time.
'-------------------------------------------------------------------------------
SUB COPY_BUFFER()
DIM AS UINTEGER PTR PP1,PP2
DIM AS INTEGER L
PP1=@SCREEN_BUFFER(0)
PP2= @BOB_BUFFER(0)
FOR L=0 TO XRES*YRES
*PP1=COLOUR_PALETTE(*PP2)
PP1+=1
PP2+=1
NEXT
END SUB
'-------------------------------------------------------------------------------
'>>> Our Shadebob (16 * 16) ;
'-------------------------------------------------------------------------------
data 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0
data 0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0
data 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
data 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
data 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
data 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
data 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
data 0,0,1,1,1,1,1,1,1,1,1,1,1,1,0,0
data 0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0
data 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0
