0 Members and 1 Guest are viewing this topic.
'' 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,LETIMEGADD=0DIM SHARED AS DOUBLE OLD,NEW,DV,FUCKEDFUCKED=250LETIME=TIMERWHILE(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*50WEND'------------------------------------------------------------------------------- ' 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 NEXTEND 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) NEXTEND 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=1END IFEND 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 NEXTEND 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 NEXTEND 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))NEXTEND 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,0DATA 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,1DATA 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,1DATA 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,1DATA 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
Author
Topic: Castlemaster remake source (Read 2307 times)