Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on November 22, 2008
-
Here's the source.
There is an attachment with exe's etc :)
'
' oOoO Agile Remake By Shockwave ^ Codigos OoOo
'
'
'-------------------------------------------------------------------------------
' INCLUDES;
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
#INCLUDE "agpal.bas"
#INCLUDE "agraw.bas"
'#include "sc68replay.bi"
#include "go.bas"
'-------------------------------------------------------------------------------
' DEFINITIONS;
'-------------------------------------------------------------------------------
'-------------------------------------------------------------------------------
' RULES;
'-------------------------------------------------------------------------------
OPTION STATIC
OPTION EXPLICIT
'-------------------------------------------------------------------------------
' SCREEN PARAMS;
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
DIM SHARED AS UINTEGER BUFFER ( XRES * YRES )
'-------------------------------------------------------------------------------
' INITIALISE FONTS
'-------------------------------------------------------------------------------
Const LfimgX = 1952
Const LfimgY = 65
DECLARE SUB LARGETEXT (BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING , BYVAL FADE AS double)
Declare Sub LfDrawImage (byval imxpos as integer,byval imypos as integer,byval SX as integer,byval SY as double)
Declare Sub LfDrawImageA(byval imxpos as integer,byval imypos as integer,byval SX as integer,byval FADE as double)
Declare Sub LFLoadDataImage()
Dim Shared LFimg_buffer( lfimgx * lfimgy ) as integer
Dim Shared LFimg_r(256), LFimg_g(256), LFimg_b(256), LFimg_a(256) as short
LFLoadDataImage()
DIM SHARED AS INTEGER CUR_PAGE,MAX_PAGE,PAGE_OFFSET
DIM SHARED AS INTEGER PX,PY,TP,FADING
FADING=0
PX=1
PY=1
PAGE_OFFSET=0
CUR_PAGE=1
MAX_PAGE=2
DIM SHARED AS STRING TEXT
TP=1
'PAGE 1
TEXT= " -= AGILE PRESENTS =- "
TEXT=TEXT+"----------------------"
TEXT=TEXT+" = CRIME WAVE = "
TEXT=TEXT+" FROM US GOLD "
TEXT=TEXT+"----------------------"
TEXT=TEXT+" CRACKED BY CONQUEROR "
'PAGE 2
TEXT=TEXT+" "
TEXT=TEXT+"CRACKED ON 1991-02-16!"
TEXT=TEXT+" "
TEXT=TEXT+" WE PAY OUR HOMAGE TO "
TEXT=TEXT+"ELRIC FOR THE SHIPMENT"
TEXT=TEXT+" "
'PAGE 3
TEXT=TEXT+" CALL OUR BOARDS!! "
TEXT=TEXT+"----------------------"
TEXT=TEXT+" PLEASURE DOME "
TEXT=TEXT+" 46-16-127263 "
TEXT=TEXT+" GRAVEYARD "
TEXT=TEXT+" 44-915-160560 "
'PAGE 2
TEXT=TEXT+" OR WRITE TO: "
TEXT=TEXT+" "
TEXT=TEXT+" AGILE, BOX 12044 "
TEXT=TEXT+" 63012 ESKILSTUNA "
TEXT=TEXT+" SWEDEN "
TEXT=TEXT+" "
TEXT=TEXT+" LIGHTSHININGS GO TO: "
TEXT=TEXT+"----------------------"
TEXT=TEXT+" CRYSTAL SKID ROW "
TEXT=TEXT+" CLASSIC RAZOR 1911 "
TEXT=TEXT+" SPRINT REBELS "
TEXT=TEXT+" RED SECTOR TRISTAR "
'PAGE 2
'PAGE 2
TEXT=TEXT+" QUARTEX DEFJAM "
TEXT=TEXT+" FAIRLIGHT SENSOR "
TEXT=TEXT+" GOONIES THE SILENTS "
TEXT=TEXT+" SUBWAY SCOOPEX "
TEXT=TEXT+" LEGION METALLIANS "
TEXT=TEXT+" PHENOMENA KEFRENS "
'PAGE 2
TEXT=TEXT+" MIRACLE THE LINK "
TEXT=TEXT+" ANGELS ECSTASY "
TEXT=TEXT+" SPREADPOINT MAYHEM "
TEXT=TEXT+" CRIONICS DEXION "
TEXT=TEXT+" FLASH PROD DUAL CREW "
TEXT=TEXT+" DIGITECH NORTH STAR "
'PAGE 2
TEXT=TEXT+" CRUSADERS ALCATRAZ "
TEXT=TEXT+" PIRANHAS ANARCHY "
TEXT=TEXT+" CRYPTOBURNERS... "
TEXT=TEXT+" "
TEXT=TEXT+"AND ALL THE OTHERS WE "
TEXT=TEXT+" FORGOT AT THE MOMENT "
'PAGE 2
TEXT=TEXT+" SOME PRESONAL GREETS "
TEXT=TEXT+" FROM CONQ AND ZIKE "
TEXT=TEXT+" FLIES OVER TO: "
TEXT=TEXT+" "
TEXT=TEXT+"----------------------"
TEXT=TEXT+" (NO SPECIAL ORDER) "
'PAGE 2
TEXT=TEXT+" VIDEO VINDICATOR "
TEXT=TEXT+" SLAYER - PAT - IRATA "
TEXT=TEXT+" SVENNE DUFVA - DELTA "
TEXT=TEXT+" OHM - XEROX - STATIC "
TEXT=TEXT+" HUSMUSEN TED - MARK! "
TEXT=TEXT+" GEORGE II - MR.GURK "
'PAGE 2
TEXT=TEXT+" CELEBRANDIL - JESUS "
TEXT=TEXT+" CREEPING DEATH - P-1 "
TEXT=TEXT+" SABBATH - RINGO STAR "
TEXT=TEXT+" STEEL - LINK - ONYX "
TEXT=TEXT+" DROOPY - GASTON "
TEXT=TEXT+" SAURON - STRIDER "
'PAGE 2
TEXT=TEXT+" THE BARON - PORSCHE "
TEXT=TEXT+" REBEL - ANTIACTION "
TEXT=TEXT+" HAVOK - BIG AL "
TEXT=TEXT+" RASTAN - ZELNIK "
TEXT=TEXT+" COKE - ZIN - RECTOR "
TEXT=TEXT+" HOSON - ACID MAN "
'PAGE 2
TEXT=TEXT+" DIABLO - PORTA "
TEXT=TEXT+" AYATOLLAH - BLAIZER "
TEXT=TEXT+" JCH - SMAUGE - NOMAD "
TEXT=TEXT+" COBRA - NERGAL "
TEXT=TEXT+" MIKAEL BALLE - KYD "
TEXT=TEXT+" MOGWIE - ALTA - CUGEL"
'PAGE 2
TEXT=TEXT+" MR.PERFECT - TSH "
TEXT=TEXT+" KEVIN - COMERADE J "
TEXT=TEXT+" RYGAR - SARGE - IBM "
TEXT=TEXT+" BRYCE - TYGER "
TEXT=TEXT+" ANIMAL - CYORIC "
TEXT=TEXT+" STOOKIE - THE GNN "
'PAGE 2
TEXT=TEXT+" DEL - GREMLIN - SPY "
TEXT=TEXT+" JEDI - BAMBAM - CORE "
TEXT=TEXT+" METAL GEAR - ICRONITE"
TEXT=TEXT+" SLEEPING BAG "
TEXT=TEXT+" STRESSKILLER - DEZED "
TEXT=TEXT+" UTOPIA! - SMAUGE "
'PAGE 2
TEXT=TEXT+" HITCHHIKER - COLDFIRE"
TEXT=TEXT+" STRANGER - GALACTUS "
TEXT=TEXT+" DR.AWESOME - SEAGULL "
TEXT=TEXT+" BLACK SHADOW - BOBO "
TEXT=TEXT+" BACCHUS - IRON MAN "
TEXT=TEXT+" TELEFON JACK - CYBER "
'PAGE 2
TEXT=TEXT+" MR.THOMPSON - STRIPER"
TEXT=TEXT+" VIPER - THE CROOK "
TEXT=TEXT+" DIVINE - KAPTEN DATA "
TEXT=TEXT+"DAMAGE (HIT MED TAXI -"
TEXT=TEXT+" PENGARNA!) - SPIKE "
TEXT=TEXT+" PET - LITEACE - MMM "
'PAGE 2
TEXT=TEXT+" ATOM - PHS - IL SCURO"
TEXT=TEXT+" SKYWISE - HIHAT "
TEXT=TEXT+" WARLORD - SENSEI "
TEXT=TEXT+" MIKE - WINTER MUTE "
TEXT=TEXT+" DANKO -BOBBAN "
TEXT=TEXT+" EUZKERA - DR.COOL "
'PAGE 2
TEXT=TEXT+" WILD THING - MERLIN "
TEXT=TEXT+" ODIE - RIK - GOBLIN "
TEXT=TEXT+" ARCHANGEL - ARNIE "
TEXT=TEXT+" TILT - MATHEW "
TEXT=TEXT+" ZIPHOID - NITROBIT "
TEXT=TEXT+" TOMMYKNOCKERS(VOICE) "
'PAGE 2
TEXT=TEXT+"CREDITS FOR THIS INTRO"
TEXT=TEXT+"----------------------"
TEXT=TEXT+" GRAPHIX BY LOST BOYS "
TEXT=TEXT+"MUSIC BY JOCHEN HIPPEL"
TEXT=TEXT+" CODING BY CONQUEROR! "
TEXT=TEXT+"----------------------"
'PAGE 2
TEXT=TEXT+"WIN32 REMAKE CODED BY:"
TEXT=TEXT+"----------------------"
TEXT=TEXT+" SHOCKWAVE OF CODIGOS "
TEXT=TEXT+" FOR: "
TEXT=TEXT+"WWW.RETRO-REMAKES.NET!"
TEXT=TEXT+"----------------------"
'PAGE 2
TEXT=TEXT+" GREETINGS TO ALL OUR "
TEXT=TEXT+" FRIENDS, MEMBERS AND "
TEXT=TEXT+" VISITORS "
TEXT=TEXT+" SEE YOU IN ANOTHER "
TEXT=TEXT+" REMAKE SOON! "
TEXT=TEXT+" ------------ "
DECLARE SUB TYPER()
DIM SHARED AS INTEGER CLOCK=1
DIM SHARED AS DOUBLE FADE1=0.01
DIM SHARED AS DOUBLE WACKO=1
DIM SHARED AS DOUBLE DSTART,RSTART
'-------------------------------------------------------------------------------
' SCREEN OPEN;
'-------------------------------------------------------------------------------
'sc68replay_Init(@go.sc68(0), 65980, SC68Replay_MEMORY)
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"REMAKE BY SHOCKWAVE"+CHR(13)+"FULLSCREEN?",0,1)
IF (PTC_OPEN("WWW.RETRO-REMAKES.NET",XRES,YRES)=0) THEN
END-1
END IF
DIM SHARED AS DOUBLE OLD,DV
dim shared as integer pp
pp=showcursor(0)
'sc68replay_Play()
SLEEP 50
'-------------------------------------------------------------------------------
' MAIN LOOP;
'-------------------------------------------------------------------------------
RSTART=TIMER+2
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767) AND (PTC_GETLEFTBUTTON=FALSE)
OLD=TIMER
' LARGETEXT(10,10,"A",1)
IF TIMER>=RSTART THEN TYPER()
PTC_UPDATE@BUFFER(0)
ERASE BUFFER
SLEEP 1
DV=(TIMER-OLD)*7
WEND
'sc68replay_Stop()
END
SUB TYPER()
DIM AS INTEGER TTX,TTY,XPO,YPO,YR,COUNT
YPO=30
YR=1
COUNT=0
XPO=50
WHILE YR<7 AND COUNT<CLOCK
IF COUNT<(CLOCK-1) THEN
LARGETEXT( XPO , YPO , MID(TEXT,COUNT+TP,1) , WACKO)
ELSE
LARGETEXT( XPO , YPO , MID(TEXT,COUNT+TP,1) , FADE1)
END IF
XPO=XPO+32
IF XPO>740 THEN
XPO=50
YPO=YPO+66
YR=YR+1
END IF
COUNT=COUNT+1
WEND
IF MID(TEXT,COUNT+TP,1)=" " THEN FADE1=1
IF FADING=0 OR FADE1<1 THEN FADE1=FADE1+DV
IF FADING=0 AND CLOCK<=132 AND FADE1>=1 AND WACKO= 1 THEN
CLOCK=CLOCK+1
FADE1=0
END IF
IF WACKO=1 AND COUNT>=132 AND FADING=0 THEN
FADING=1
DSTART=TIMER+2
END IF
IF FADING=1 AND TIMER>DSTART THEN
WACKO=WACKO-DV
IF WACKO<=0 THEN
WACKO=1
CLOCK=0
FADING=0
TP=TP+132
IF TP>LEN(TEXT) THEN TP=1
END IF
END IF
END SUB
'-------------------------------------------------------------------------
' ACCEPTS A SINGLE LETTER AND DRAWS IT WHERE IT IS TOLD WITH FADE IF
' APPLICABLE IF ALPHA NOT SET, THE SUB CALLS FASTER NON-FADE TEXT ROUTINE.
'-------------------------------------------------------------------------
SUB LARGETEXT(BYVAL LTX AS INTEGER , BYVAL LTY AS INTEGER ,BYVAL LTS AS STRING , BYVAL FADE AS double)
DIM AS INTEGER OFFSET,ASCIIVAL,ZERO
'---------------------------------
' CALCULATE ASCII VALUE OF LTS;
'---------------------------------
ASCIIVAL=(ASC(LTS))-32
'---------------------------------
' MAKE SURE CHARACTER IS LEGAL!
'---------------------------------
IF ASCIIVAL<0 THEN ASCIIVAL=0
IF LTS <>" " AND ASCIIVAL >0 THEN
'---------------------------------
' CALCULATE IMAGE OFFSET AND DRAW.
'---------------------------------
OFFSET = (ASCIIVAL * 33)
IF FADE>=1 THEN
LFDRAWIMAGE ( LTX,LTY, OFFSET , 0 )
ELSE
LFDRAWIMAGEA( LTX,LTY, OFFSET , FADE )
END IF
END IF
END SUB
'-------------------------------------------------------------------------------
' LARGE FONT;
'-------------------------------------------------------------------------------
Sub LFLoadDataImage()
dim i as integer
'Loads Color palette
for i = 0 to 255
LFimg_r( i ) = agfont.bmp.pal (i*3)'Red color
LFimg_g( i ) = agfont.bmp.pal (i*3+1)'Green color
LFimg_b( i ) = agfont.bmp.pal (i*3+2)'Blue color
LFimg_a( i ) = rgb (INT(LFimg_r(i)),INT(LFimg_g(i)),INT(LFimg_b(i)))
' '(LFimg_r(i) Shl 16) Or (LFimg_g(i) Shl 8 ) Or LFimg_b(i)
' LFimg_a( i ) =(LFimg_r(i) Shl 16) Or (LFimg_g(i) Shl 8 ) Or LFimg_b(i)
Next
for i = 1 to (LFimgx*LFimgy) - 1
LFimg_buffer(i) = agfont.bmp.raw (i)
next
End Sub
Sub LFDrawImage(byval xpos as integer,byval ypos as integer,byval SX as integer,byval SY as double)
dim as integer x,y,pixel,mong,intx,inty,xxx,yyy,VLU
VLU=&h000000
xxx=xpos
yyy=ypos
for Y = 0 to 64
for X = SX to SX+31
pixel = LFimg_buffer(x+(y*lfimgx))
Buffer( XXX +(YYY * XRES )) = rgb (LFimg_r(pixel),LFimg_g(pixel),LFimg_b(pixel))
xxx=xxx+1
next
yyy=yyy+1
xxx=xpos
next
End Sub
Sub LFDrawImageA(byval xpos as integer,byval ypos as integer,byval SX as integer,byval FADE as double)
dim as integer x,y,pixel,mong,intx,inty,xxx,yyy,VLU,fader,monger,pixelz
VLU=&h000000
xxx=xpos
yyy=ypos
for Y = 0 to 64
for X = SX to SX+31
pixel = LFimg_buffer(x+(y*lfimgx))
mong = (LFimg_r(pixel) )
intx = xxx
inty = yyy
if MONG<>VLU then
monger=rgb (int(LFimg_r(pixel)*fade),int(LFimg_g(pixel)*fade),int(LFimg_b(pixel)*fade))
Buffer( intX +(intY * XRES )) = monger
end if
xxx=xxx+1
next
yyy=yyy+1
xxx=xpos
next
End Sub
-
Nice one Shockwave! :) Thanks for the code!
-
:)
There's not much there really but the font is nice so if anyone wants to use it in anything, there it is.
-
Cool :D
yeh, the font is really nice, thanks for sharing it