Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on June 23, 2007
-
However this has something more.. I used a technique to disguise the technique, and you will see three different coloured bobs in the same bob rope :P
Very lame, very uncommented but I don't give a fuck :D
Please feel free to send it to hell or use and abuse in your own fucktros :)
By the way, this uses Rbraz's excellent ptc_ext. You wont be able to run it without so upgrade or use the attached exe instead.
OPTION STATIC
OPTION EXPLICIT
#INCLUDE "TINYPTC_ext.BI"
#include "windows.bi"
CONST XRES = 640
CONST YRES = 480
DIM SHARED AS UINTEGER BUFFER (XRES * YRES)
' 5 BUFFERS FOR 5 FRAMES OF "ANIMATION" FOR UNLIMITED BOB EFFECT
DIM SHARED AS UINTEGER BOB_BUFF1(XRES * YRES)
DIM SHARED AS UINTEGER BOB_BUFF2(XRES * YRES)
DIM SHARED AS UINTEGER BOB_BUFF3(XRES * YRES)
DIM SHARED AS UINTEGER BOB_BUFF4(XRES * YRES)
DIM SHARED AS UINTEGER BOB_BUFF5(XRES * YRES)
' WHICH BUFFER ARE WE WORKING WITH ATM?
DIM SHARED AS INTEGER BUF_POINTER = 1
DIM SHARED AS INTEGER COLOUR_OFFSET = 0
DIM SHARED AS INTEGER COLOUR_OFFSET2 = 0
' UNLIMITED BOBS PALETTE
DIM SHARED AS UINTEGER U_PALETTE(30)
' BOB STORAGE :-p
DIM SHARED AS UINTEGER BOB(16 * 16)
'-------------------------------------------------------------------------------
DECLARE SUB COPY_SCREEN()
DECLARE SUB READ_PALETTE()
DECLARE SUB READ_BOB()
DECLARE SUB DRAW_BOB(BYVAL BX AS INTEGER , BYVAL BY AS INTEGER)
'-------------------------------------------------------------------------------
READ_PALETTE()
READ_BOB()
'-------------------------------------------------------------------------------
ptc_allowclose(0)
ptc_setdialog(0,"",0,1)
IF (PTC_OPEN("cockshave^s!p",XRES,YRES)=0) THEN
END-1
END IF
DIM GADD AS DOUBLE
DIM AS DOUBLE XL1,YL1
DIM AS INTEGER XL,YL
WHILE(GetAsyncKeyState(VK_ESCAPE)<>-32767)
GADD=GADD+1
XL1=320+200*SIN(GADD/116)
YL1=240+200*COS(GADD/116)
DRAW_BOB(XL1+45*SIN(GADD/33)+15*SIN(GADD/13),YL1+15*COS(GADD/33)-5*COS(GADD/12))
COPY_SCREEN()
PTC_UPDATE@BUFFER(0)
BUF_POINTER=BUF_POINTER+1
IF BUF_POINTER>5 THEN
BUF_POINTER=1
COLOUR_OFFSET=COLOUR_OFFSET+5
COLOUR_OFFSET2=COLOUR_OFFSET2-5
IF COLOUR_OFFSET2<0 THEN COLOUR_OFFSET2=10
IF COLOUR_OFFSET>10 THEN
COLOUR_OFFSET=0
END IF
END IF
'ERASE BUFFER
WEND
END
SUB DRAW_BOB(BYVAL BX AS INTEGER , BYVAL BY AS INTEGER)
DIM AS INTEGER XL,YL
SELECT CASE BUF_POINTER
CASE 1
FOR YL=0 TO 15
FOR XL=0 TO 15
IF BOB(XL+(YL*16)) >0 THEN
BOB_BUFF1(BX+XL+((BY+YL)*XRES)) = (BOB(XL+(YL*16)))+ COLOUR_OFFSET
END IF
NEXT
NEXT
CASE 2
FOR YL=0 TO 15
FOR XL=0 TO 15
IF BOB(XL+(YL*16)) >0 THEN
BOB_BUFF2(BX+XL+((BY+YL)*XRES)) = (BOB(XL+(YL*16)))+ COLOUR_OFFSET
END IF
NEXT
NEXT
CASE 3
FOR YL=0 TO 15
FOR XL=0 TO 15
IF BOB(XL+(YL*16)) >0 THEN
BOB_BUFF3(BX+XL+((BY+YL)*XRES)) = (BOB(XL+(YL*16)))+ COLOUR_OFFSET
END IF
NEXT
NEXT
CASE 4
FOR YL=0 TO 15
FOR XL=0 TO 15
IF BOB(XL+(YL*16)) >0 THEN
BOB_BUFF4(BX+XL+((BY+YL)*XRES)) = (BOB(XL+(YL*16)))+ COLOUR_OFFSET
END IF
NEXT
NEXT
CASE 5
FOR YL=0 TO 15
FOR XL=0 TO 15
IF BOB(XL+(YL*16)) >0 THEN
BOB_BUFF5(BX+XL+((BY+YL)*XRES)) = (BOB(XL+(YL*16)))+ COLOUR_OFFSET
END IF
NEXT
NEXT
END SELECT
END SUB
SUB COPY_SCREEN()
DIM A AS INTEGER
SELECT CASE BUF_POINTER
CASE 1
FOR A=0 TO XRES * YRES
BUFFER(A) = U_PALETTE(BOB_BUFF1(A)+COLOUR_OFFSET2)
NEXT
CASE 2
FOR A=0 TO XRES * YRES
BUFFER(A) = U_PALETTE(BOB_BUFF2(A)+COLOUR_OFFSET2)
NEXT
CASE 3
FOR A=0 TO XRES * YRES
BUFFER(A) = U_PALETTE(BOB_BUFF3(A)+COLOUR_OFFSET2)
NEXT
CASE 4
FOR A=0 TO XRES * YRES
BUFFER(A) = U_PALETTE(BOB_BUFF4(A)+COLOUR_OFFSET2)
NEXT
CASE 5
FOR A=0 TO XRES * YRES
BUFFER(A) = U_PALETTE(BOB_BUFF5(A)+COLOUR_OFFSET2)
NEXT
END SELECT
END SUB
SUB READ_PALETTE()
DIM LP AS INTEGER
FOR LP=0 TO 29
READ U_PALETTE(LP)
NEXT
END SUB
SUB READ_BOB()
DIM LP AS INTEGER
FOR LP=0 TO 16*16
READ BOB(LP)
NEXT
END SUB
DATA &H000000,&H550000,&HAA0000,&HFF0000,&HFFFFFF
DATA &H000000,&H005500,&H00AA00,&H00FF00,&HFFFFFF
DATA &H000000,&H000055,&H0000AA,&H0000FF,&HFFFFFF
DATA &H000000,&H550000,&HAA0000,&HFF0000,&HFFFFFF
DATA &H000000,&H005500,&H00AA00,&H00FF00,&HFFFFFF
DATA &H000000,&H000055,&H0000AA,&H0000FF,&HFFFFFF
' Bob!
DATA 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0
DATA 0,0,0,1,1,1,1,1,2,2,1,1,1,0,0,0
DATA 0,0,1,1,1,1,2,2,2,2,2,2,1,1,0,0
DATA 0,1,1,1,1,1,2,2,3,3,2,2,1,1,1,0
DATA 0,1,1,1,1,2,2,3,4,4,3,2,2,1,1,0
DATA 0,1,1,1,1,2,2,3,4,4,3,2,2,1,1,0
DATA 1,2,1,1,1,1,2,2,3,3,2,2,1,1,1,1
DATA 1,2,1,1,1,1,2,2,2,2,2,2,1,1,1,1
DATA 1,2,1,1,1,1,1,1,2,2,1,1,1,1,1,1
DATA 1,1,2,1,1,1,1,1,1,1,1,1,1,1,1,1
DATA 0,1,2,1,1,1,1,1,1,1,1,1,1,1,1,0
DATA 0,1,2,2,1,1,1,1,1,1,1,1,1,1,1,0
DATA 0,1,1,2,2,2,1,1,1,1,1,1,1,1,1,0
DATA 0,0,1,1,1,1,2,2,2,1,1,1,1,1,0,0
DATA 0,0,0,1,1,1,1,1,1,1,1,1,1,0,0,0
DATA 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0
Exe attached.
-
Haha ... that's kewl dude ... reminds me on good ole times ... for sure ^^
Cheers,
SLiPPY
-
simple but very kewl :kewl:
-
The best effects usually were simple to make :) The skill was being able to think of a twist to the idea like this routine does to enable different coloured bobs in the same bob string. This could have been made much easier on a real Amiga, it took a little bit of faffing around with tinyptc.
-
The best effects usually were simple to make
i never coded on an amiga and didnt really know about the demo scene until i joined this place but since coming here ive learned how all these effects are done and they are simpler than i ever thought They would be.
and now when i show people here i get more of a reaction :P so i must say thank you to all you old skool coder for giving away you trade secrets.
-
I love infibobs!
Jim
-
@Jim
I almost pissed myself when you called them infibobs! What a cool name!
@Shockwave
Some cool shit - again! Thanks for posting . . .
DrewPee
-
Coding them is the easy part :) Making a nice movement pattern for them is harder.
-
wow shocky. :)
very good demo. if you do not mind , i will port it to my OgerMagic and uesd it as an animated background of displaying HiScores demo with some music.