Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on September 24, 2008
-
It's a little bit messy and it wont compile because it needs the libs, but this should do for reference if anyone ever wants it :)
'
' PARANOIMIA CASTLE MASTER REMAKE BY SHOCKWAVE
' NOTE THAT THIS WILL NOT COMPILE SO DONT POST COMPLAINING ABOUT IT :-P
' SOURCE CODE FOR REFERENCE ONLY.
'-------------------------------------------------------------------------------
' LIBS:
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
' LOGO BINARIES
#INCLUDE "logoraw.bas"
#INCLUDE "logopal.bas"
' FONT BINARIES;
#INCLUDE "pnafpal.bas"
#INCLUDE "pnafraw.bas"
'-------------------------------------------------------------------------------
' STATIC ARRAYS DECLARE EVERYTHING
'-------------------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
' RESOLUTION
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
'-------------------------------------------------------------------------------
' CONSTANTS PRECALCULATED HERE TO SAVE SOME CYCLES LATER;
'-------------------------------------------------------------------------------
DIM SHARED AS INTEGER XSET,YSET
XSET=XRES/2
YSET=YRES/2+130
DIM SHARED AS DOUBLE RAD2DEG =(3.14 / 180)
'-------------------------------------------------------------------------------
' STARFIELD STUFF;
'-------------------------------------------------------------------------------
DIM SHARED AS INTEGER STARS=120
DIM SHARED AS DOUBLE STRA(STARS):' THETA
DIM SHARED AS DOUBLE STRB(STARS):' BEGINNING RADIUS
DIM SHARED AS DOUBLE STRE(STARS):' END RADIUS
DIM SHARED AS DOUBLE STRS(STARS):' SPEED
DECLARE SUB POLARSET():' TO SET POINTS AROUND CIRCLE
DECLARE SUB POLARDRW():' TO DRAW STARFIELD
DECLARE SUB BERASE():' TO ERASE THE SCREEN BUFFER QUICKLY
POLARSET():' SET STARS INITIAL POINTS
'-------------------------------------------------------------------------------
' SETUP FOR LOGO
'-------------------------------------------------------------------------------
Const FLT_IMGX = 720:' DIMENSIONS (W IS DIVISIBLE BY 8)
Const FLT_IMGY = 174
Declare Sub FLT_DrawImagelarge(byval FLT_imxpos as integer,byval FLT_imypos as integer)
Declare Sub FLT_LoadDataImage()
Dim Shared FLT_img_buffer( FLT_imgx * FLT_imgy ) as integer
Dim Shared FLT_img_r(256), FLT_img_g(256), FLT_img_b(256) as short
FLT_LoadDataImage()
'-------------------------------------------------------------------------------
' AND THE FONT;
'-------------------------------------------------------------------------------
Const LfimgX = 1896:' DIMENSIONS (W IS DIVISIBLE BY 8)
Const LfimgY = 35
DECLARE SUB LARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING)
Declare Sub LfDrawImage(byval imxpos as integer,byval imypos as integer,byval SX as integer,byval SY as integer)
Declare Sub LFLoadDataImage()
Dim Shared LFimg_buffer( lfimgx * lfimgy ) as integer
Dim Shared LFimg_r(256), LFimg_g(256), LFimg_b(256) as short
LFLoadDataImage()
'-------------------------------------------------------------------------------
' SCROLLING MESSAGE;
'-------------------------------------------------------------------------------
DIM SHARED AS STRING TXT: ' TEXT STRING
DIM SHARED AS DOUBLE SCP=0:' SCREEN OFFSET
DIM SHARED AS INTEGER TP=1:' STRING POINTER
TXT=" "
TXT=TXT+" paranoimia released castle master for ztt s hardcore action series ..."
TXT=TXT+" all arranging, engineering and producing performed by perfect cracks ltd."
TXT=TXT+" contact us at : p.o. box 10 , 4140 amay , belgium ....."
TXT=TXT+"italians write to : p.o. box 127 , bari , italy"
TXT=TXT+" ........ remake coded by shockwave of codigos for >www.retro-remakes.net< "
TXT=TXT+"and for the remakes challenge at: >www.dbfinteractive.com< although you wont be able to vote for this "
TXT=TXT+"as i am one of the competition judges... hope you like the remake and i am looking forward to see what else gets released in the comp! greetings to everyone who knows me.. wrapppp "
txt=ucase(txt)
DECLARE SUB SCROLLER()
'-------------------------------------------------------------------------------
' COPPERLIST;
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER COPPERS(YRES)
DECLARE SUB MAKECOPPERS()
MAKECOPPERS()
'-------------------------------------------------------------------------------
' LITTLE LOGO;
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER LOGOLITTLECOLOURS(1000):' USED TO HOLD "CYCLING LOGO COLOURS"
DIM SHARED LOGOLITTLE(62,5):' LOGO STORAGE, SEE BINARY AT END OF FILE
DECLARE SUB READLOGOLITTLE()
DECLARE SUB DRAWLOGOLITTLE()
READLOGOLITTLE()
'-------------------------------------------------------------------------------
' SCREEN SETUP;
'-------------------------------------------------------------------------------
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"WWW.RETRO-REMAKES.NET"+CHR$(13)+"FULL SCREEN?",0,1)
IF (PTC_OPEN("Remade by Shockwave^Codigos",XRES,YRES)=0) THEN
END-1
END IF
SLEEP 5
'-------------------------------------------------------------------------------
' MAIN LOOP;
'-------------------------------------------------------------------------------
DIM SHARED AS DOUBLE GADD,LCC,LETIME
GADD=0
DIM SHARED AS DOUBLE OLD,NEW,DV,FUCKED
FUCKED=250
LETIME=TIMER
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
IF TIMER-LETIME<1.5 THEN FUCKED=250
' GET TIMER VALUE FOR DELTA MOVEMENT CALCULATION
OLD=TIMER
GADD=GADD-(DV*0.025)
FLT_DrawImagelarge(40,0):' DRAW LARGE LOGO
POLARDRW(): ' DRAW POLAR STARS
SCROLLER(): ' DRAW SCROLLTEXT
DRAWLOGOLITTLE(): ' DRAW SMALL LOGO
PTC_UPDATE@BUFFER(0): ' REFRESH SCREEN
BERASE(): ' ERASE BUFFER, DRAW COPPERBAR
NEW = (TIMER-OLD)+.001
DV=NEW*50
WEND
'-------------------------------------------------------------------------------
' PROGRAM END ON ESC OR LMB.
'-------------------------------------------------------------------------------
END
'-------------------------------------------------------------------------------
' DRAWS THE LITTLE PARANOIMIA DESIGN LOGO IN ITS VARIOUS STATES
'-------------------------------------------------------------------------------
SUB DRAWLOGOLITTLE()
LCC=LCC-(DV/2)
IF LCC<0 THEN LCC=LCC+500
DIM AS INTEGER X,Y,XO,YO,CX,CY,TC
XO=640
YO=560
CY=YO
FOR Y=1 TO 5
CX=XO
FOR X=1 TO 62
TC=LOGOLITTLECOLOURS(X+INT(LCC)+INT(Y/2))
IF FUCKED>20 THEN
FUCKED=FUCKED-(DV/100)
TC=RGB(INT(FUCKED),INT(FUCKED),INT(FUCKED))
END IF
IF LOGOLITTLE(X,Y)=1 THEN
BUFFER(CX+(CY*XRES))=TC
BUFFER(CX+1+(CY*XRES))=TC
BUFFER(CX+1+((CY+1)*XRES))=TC
BUFFER(CX+((CY+1)*XRES))=TC
END IF
CX=CX+2
NEXT
CY=CY+2
NEXT
END SUB
'-------------------------------------------------------------------------------
' READS IN THE LITTLE PARANOIMIA DESIGN LOGO, CALLED ONCE BEFORE MAIN LOOP
' ALSO CALCULATES A PALETTE TO SCROLL THROUGH THE LOGO.
'-------------------------------------------------------------------------------
SUB READLOGOLITTLE()
' READ:
DIM X,Y
FOR Y=1 TO 5
FOR X=1 TO 62
READ LOGOLITTLE(X,Y)
NEXT
NEXT
' PALETTE COMPUTATION:
DIM AS DOUBLE C
C=20
FOR X=1 TO 1000
SELECT CASE X
CASE 90 TO 100
C=C+12
CASE 101 TO 110
C=C-12
END SELECT
IF C>235 THEN C=235
IF C<20 THEN C=20
LOGOLITTLECOLOURS(X)=RGB(INT(C),INT(C),INT(C)+20)
NEXT
END SUB
'-------------------------------------------------------------------------------
' DRAWS THE BOUNCING SCROLLER;
'-------------------------------------------------------------------------------
SUB SCROLLER()
DIM SINPOS AS DOUBLE
SINPOS=310*SIN(GADD)
IF SINPOS<0 THEN SINPOS=-SINPOS
LARGETEXT(SCP,180+SINPOS,MID(TXT,TP,26))
SCP=SCP-(DV*3.5)
IF SCP<=-32 THEN
SCP=SCP+32
TP=TP+1
IF TP>LEN(TXT) THEN TP=1
END IF
END SUB
'-------------------------------------------------------------------------------
' DRAWS AND MOVES THE LAME STARS;
'-------------------------------------------------------------------------------
SUB POLARDRW()
DIM AS INTEGER TX,TY,L,TC,TCC
DIM AS DOUBLE SPEED
FOR L=1 TO STARS
TX=(STRB(L)*SIN(STRA(L)*RAD2DEG))+XSET
TY=(STRB(L)*COS(STRA(L)*RAD2DEG))+YSET
IF TX>1 AND TX<XRES-1 AND TY>182 AND TY<YRES-1 THEN
TC=((int((STRB(L) *.7)/40)) * 40)
IF STRB(L)>10 THEN TC=TC+10
IF TC>255 THEN TC=255
TCC=RGB(TC,TC,TC)
BUFFER(TX+(TY*XRES))=TCC
BUFFER(TX+1+(TY*XRES))=TCC
BUFFER(TX+1+((TY+1)*XRES))=TCC
BUFFER(TX+((TY+1)*XRES))=TCC
END IF
SPEED=STRS(L)*DV
STRB(L)=STRB(L)+SPEED
IF STRB(L)>=STRE(L) THEN
STRB(L)=1
STRE(L)= 500: ' END RADIUS
STRA(L)=(RND(1)*360):' ANGLE ON CIRCUMFERENCE
STRS(L)=(RND(1)*3)+1
END IF
NEXT
END SUB
'-------------------------------------------------------------------------------
' SET POSITIONS FOR POLAR STARFIELD
'-------------------------------------------------------------------------------
SUB POLARSET()
DIM AS INTEGER L,D
FOR L=1 TO STARS
D=D+1
IF L=30 THEN D=D+20
IF L=50 THEN D=D+40
IF L=90 THEN D=D+50
'-----------------------------------------------------------------------
' GENERATE SOME OF THE POINTS BUNCHED UP ON THE EDGE LIKE THE ORIGINAL,
' LOOKS SHIT, BUT HEY, THAT'S HOW THE ORIGINAL WAS :-P
'-----------------------------------------------------------------------
IF L>120 THEN D=(RND(1)*360)
STRA(L)=D:' ANGLE ON CIRCUMFERENCE
IF L<120 THEN
STRS(L)=INT(RND(1)*5)+1:' SPEED
ELSE
STRS(L)=(RND(1)*2)+1: ' SPEED
END IF
STRE(L)= 500: ' END RADIUS
STRB(L)= 1:' START RADIUS
NEXT
END SUB
'-------------------------------------------------------------------------------
' CLEARS THE SCREEN AND DRAWS THE LITTLE BLUE COPPER BAR WHILE IT DOES SO.
'-------------------------------------------------------------------------------
SUB BERASE()
DIM AS INTEGER TC,PP,Y,SLICE
FOR Y=0 TO YRES-1
SELECT CASE Y
CASE 176,177,180,181
TC=&H000095
PP = @BUFFER((Y*XRES))
SLICE=XRES
CASE 178,179
TC=&H0000ff
PP = @BUFFER((Y*XRES))
SLICE=XRES
CASE ELSE
TC=&H000000
PP = @BUFFER((Y*XRES))
SLICE=XRES
END SELECT
asm
mov eax,dword ptr[TC]
mov ecx, [slice]
mov edi, [PP]
rep stosd
end asm
NEXT
END SUB
'-------------------------------------------------------------------------------
' "LOAD" LOGO;
'-------------------------------------------------------------------------------
Sub FLT_LoadDataImage()
dim i as integer
'Loads Color palette
for i = 0 to 255
FLT_img_r( i ) = logo.bmp.pal (i*3)'Red color
FLT_img_g( i ) = logo.bmp.pal (i*3+1)'Green color
FLT_img_b( i ) = logo.bmp.pal (i*3+2)'Blue color
FLT_img_r( i ) =(FLT_img_r(i) Shl 16) Or (FLT_img_g(i) Shl 8 ) Or FLT_img_b(i)
Next
for i = 1 to (FLT_imgx*FLT_imgy) - 1
FLT_img_buffer(i) = logo.bmp.raw (i)
next
End Sub
'-------------------------------------------------------------------------------
' DRAW LOGO
'-------------------------------------------------------------------------------
Sub FLT_DrawImagelarge(byval xpos as integer,byval ypos as integer)
dim as uinteger x,y,pixel,mong,OFFZET
DIM AS UINTEGER PTR PP,PP2
OFFZET=0
for Y = 0 to FLT_IMGY-1
PP=@BUFFER(xpos+(YPOS*XRES)-1)
pp2 = @FLT_img_buffer(((y+OFFZET)*FLT_imgx))
for X = 0 to FLT_imgx-1
mong = (FLT_img_r(*pp2) )
if mong > 0 then
*PP = MONG
END IF
PP +=1
pp2 +=1
next
YPOS=YPOS+1
next
End Sub
'-------------------------------------------------------------------------------
' CALCULATE AN OFFSET IN THE FONT TABLE TO GET TO THE LETTER WE WANT THEN CALL
' THE SUB TO DRAW THAT LETTER.
'-------------------------------------------------------------------------------
SUB LARGETEXT(BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING)
DIM AS INTEGER A,MMM,NNN,ZERO,OOO
FOR A=1 TO LEN(LTS)
NNN=(ASC(MID(LTS,A,1)))-32:' FONT IS IN ASCII ORDER TO SAVE SLOW STRING MANIPULATION.
IF NNN<0 THEN NNN=0
IF MID(LTS,A,1) <>" " AND NNN >0 THEN
OOO=0
MMM = NNN * 32
LFDRAWIMAGE( LTX,LTY, MMM+2 , OOO )
END IF
LTX=LTX+32
NEXT
END SUB
'-------------------------------------------------------------------------------
' "LOAD" THE FONT
'-------------------------------------------------------------------------------
Sub LFLoadDataImage()
dim i as integer
'Loads Color palette
for i = 0 to 255
LFimg_r( i ) = pnaf.bmp.pal (i*3)'Red color
LFimg_g( i ) = pnaf.bmp.pal (i*3+1)'Green color
LFimg_b( i ) = pnaf.bmp.pal (i*3+2)'Blue color
LFimg_r( i ) = rgb (LFimg_r(i),LFimg_g(i),LFimg_b(i))
Next
for i = 1 to (LFimgx*LFimgy) - 1
LFimg_buffer(i) = pnaf.bmp.raw (i)
next
End Sub
'-------------------------------------------------------------------------------
' ACTUALLY DRAWS ONE OF THE LETTERS, N Y CLIPPING FOR SPEED, SO BE CAREFUL :-P
'-------------------------------------------------------------------------------
Sub LFDrawImage(byval xpos as integer,byval ypos as integer,byval SX as integer,byval SY as integer)
dim as integer x,y,pixel,mong,intx,inty,xxx,yyy,VLU,TT
xxx=xpos
yyy=ypos
TT=1
for Y = SY to SY+34
for X = SX to SX+31
pixel = LFimg_buffer(x+(y*lfimgx))
mong = (LFimg_r(pixel) )
intx = XXX
inty = YYY
if MONG<>0 AND INTX>=0 AND INTX<XRES then
MONG=COPPERS(INTY)
Buffer( intX +(intY * XRES )) = MONG
end if
xxx=xxx+1
next
yyy=yyy+1
xxx=xpos
next
End Sub
'-------------------------------------------------------------------------------
' CALCULATE AND STORE THE SCROLLTEXT COPPERLIST
'-------------------------------------------------------------------------------
SUB MAKECOPPERS()
DIM AS DOUBLE R,G,B
R=0
G=0
B=0
DIM AS INTEGER Y,OFFS
OFFS=180
FOR Y=0 TO 128
SELECT CASE Y
CASE 0 TO 20
B=B+10
G=G-5
R=R+5
CASE 21 TO 40
R=R+10
B=B-2
CASE 41 TO 60
B=B-7
CASE 61 TO 80
R=R-4
G=G+4
CASE 81 TO 100
R=R-10
G=G+14
CASE 101 TO 120
G=G-15
R=R-15
B=B+4
END SELECT
IF B<0 THEN B=0
IF R<0 THEN R=0
IF G<0 THEN G=0
IF B>250 THEN B=250
IF R>250 THEN R=250
IF G>250 THEN G=250
COPPERS(Y+OFFS)=RGB(INT(R),INT(G),INT(B))
COPPERS(Y+OFFS+120)=RGB(INT(R),INT(G),INT(B))
COPPERS(Y+OFFS+240)=RGB(INT(R),INT(G),INT(B))
NEXT
END SUB
'-------------------------------------------------------------------------------
' PARANOIMIA DESIGN LOGO;
'-------------------------------------------------------------------------------
DATA 1,1,0,0,0,1,0,0,1,1,0,0,0,1,0,0,1,1,0,0,0,1,0,0,1,0,0,1,0,1,0,0,1,0,0,1,0,0,0,0,0,1,1,0,0,1,1,0,0,0,1,1,0,1,0,0,1,1,0,1,1,0
DATA 1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,1,0,0,0,1,0,1,0,0,0,0,1,0,1,0,1,0,0,0,1,0,0,0,0,0,1,0,0,0,1,0,1
DATA 1,1,0,0,1,1,1,0,1,1,0,0,1,1,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,1,1,1,0,0,0,0,1,0,1,0,1,1,0,0,0,1,0,0,1,0,1,0,0,0,1,0,1
DATA 1,0,0,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,0,1,0,1,0,1,0,1,0,0,0,0,1,0,1,0,1,0,0,0,0,0,1,0,1,0,1,0,1,0,1,0,1
DATA 1,0,0,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,0,1,0,0,1,0,1,0,0,0,1,0,1,0,1,0,1,0,0,0,0,1,1,0,0,1,1,1,0,1,1,0,0,1,0,0,1,1,0,1,0,1