Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Shockwave on June 11, 2011
-
Here's the source to my entry for the wireframe challenge.
'
' Vector Scroll By Shockwave
' ==========================
'
' Greetings to gun owners everywhere.
' http://www.dbfinteractive.com
'
'===============================================================================
RANDOMIZE TIMER
'-------------------------------------------------------------------------------
#INCLUDE "TINYPTC_EXT.BI"
#INCLUDE "WINDOWS.BI"
#INCLUDE "disgracepal.bas"
#INCLUDE "disgraceraw.bas"
#INCLUDE "some.bas"
#INCLUDE "minifmod170.bi"
OPTION STATIC
OPTION EXPLICIT
'===============================================================================
' INITIALISE PICTURE TEMPLATE;
'===============================================================================
DIM SHARED AS INTEGER IMGX,IMGY
'===============================================================================
' Be aware.. these variables are for the template of the image.
' Make sure that they are the exact size of the template picture.
' Make sure that the width divides by 8 with no remainder or you
' Will surely get awful errors.
'===============================================================================
IMGX=304:' WIDTH
IMGY=44:' HEIGHT
DIM SHARED AS INTEGER IMG_COLOURS(256)
DIM SHARED AS INTEGER IMG_RAW(IMGX * IMGY)
DECLARE SUB LOAD_IMAGE()
DECLARE SUB DRAW_IMAGE (BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL W AS INTEGER, BYVAL H AS INTEGER, BYVAL SX AS INTEGER , BYVAL SY AS INTEGER , BYVAL MASK AS UINTEGER )
LOAD_IMAGE()
'-------------------------------------------------------------------------------
' Consts, Variables and Arrays.
'-------------------------------------------------------------------------------
CONST XRES = 800
CONST YRES = 600
CONST HALFX = 400
CONST HALFY = 300
' *
' * How Many Letters We Can Display On Screen At Once.
' *
CONST MAXLETTERS = 38
' *
' * Each Letter Is Made From A 3*3 Matrix.
' *
CONST VERTX = 3
CONST VERTY = 3
' *
' * Define The Letters.
' *
DIM SHARED AS DOUBLE POINTX (VERTX,VERTY,MAXLETTERS)
DIM SHARED AS DOUBLE POINTY (VERTX,VERTY,MAXLETTERS)
DIM SHARED AS DOUBLE POINTZ (VERTX,VERTY,MAXLETTERS)
DIM SHARED AS INTEGER TPX (VERTX,VERTY)
DIM SHARED AS INTEGER TPY (VERTX,VERTY)
DIM SHARED AS INTEGER TPX2 (VERTX,VERTY)
DIM SHARED AS INTEGER TPY2 (VERTX,VERTY)
DIM SHARED AS UINTEGER COLOUR_PALETTE(100000)
' *
' * Letter Structures
' *
DIM SHARED AS SHORT STRUCT (20 , 65)
' *
' * Scrolly Message!
' *
DIM SHARED AS STRING SCROLL_TEXT
DIM SHARED AS INTEGER P
P=1
SCROLL_TEXT =" "
SCROLL_TEXT=SCROLL_TEXT+"PARANOIMIA -- COURTESY OF PERFECT CRACKS -- HAHA... JUST KIDDING... "
SCROLL_TEXT=SCROLL_TEXT+" ACTUALLY IT'S SHOCKWAVE HERE WITH HIS ENTRY TO &&& DARK BIT FACTORY &&& --WIREFRAME CHALLENGE 2011-- ** IF YOU ARE FINDING THIS HARD TO READ TRY CURSORS UP AND DOWN TO ROTATE AND CURSORS LEFT AND RIGHT TO ADJUST THE SPEED **"
SCROLL_TEXT=SCROLL_TEXT+"THIS INTRO TAKES IT'S INSPIRATION AND IT'S MUSIC (BY JESPER KYD) FROM THE ORIGINAL SUPERCARS CRACKTRO____ "
SCROLL_TEXT=SCROLL_TEXT+"THE BIG DIFFERENCE IS THE LARGE AMOUNT OF GLOW THAT I PUT ON THIS VECTOR SCROLL AND ALSO THAT COOLJ'S INTRO ACTUALLY LOOKED &&GOOD&& "
SCROLL_TEXT=SCROLL_TEXT+"I AM UNDECIDED WHETHER I LIKE THIS OR NOT AND I WOULD RATHER MAKE SOMETHING BETTER FOR THE CHALLENGE... THE TROUBLE IS THAT I WILL NOT BE ABLE TO SPEND ANY MORE TIME ON IT THIS MONTH "
SCROLL_TEXT=SCROLL_TEXT+"SO THIS WILL HAVE TO DO... WHICH MEANS I'LL GET OWNED BY ABOUT 12 PEOPLE && HAHA && IT'S ALL GOOD THOUGH ___ "
SCROLL_TEXT=SCROLL_TEXT+"I'D BETTER DO SOME GREETINGS (I WILL PROBABLY FORGET ABOUT 98213465 PEOPLE - SORRY) IN RANDOM ORDER, TOO MUCH GLOW TO THE FOLLOWING PEOPLE "
SCROLL_TEXT=SCROLL_TEXT+"* JIM * RBZ * HELLFIRE * DR_DEATH * PADMAN * COMBATKING * KIRL * NINOGENIO * RDC * MOROBOSHISAN * RELSOFT * STORMBRINGER * LITTLEWHITE * SLINKS * YALOOPY * XETICK * EFECTO * BIKEMADNESS * WENLOCK * HOTSHOT *"
SCROLL_TEXT=SCROLL_TEXT+" FERRIS * CLYDE * JANER * DICAB * ZAWRAN * MICHU * AMPLI * NUKE * JONCOM * TETRA * DRUID * TAJ * IROKOS * BEN GARRETT * ENZYMER * ALPHA ONE * WIDOWMAKER * STU EVERSON * AND EVERYONE ELSE WHO I HAVE FORGOTTEN -- THERE ARE DEFINITELY LOADS OF YOU AND I AM A TWAT WITH A BAD MEMORY "
SCROLL_TEXT=SCROLL_TEXT+"____ IF YOU KNOW ME PLEASE CONSIDER YOURSELF GREETED ____ FUCKINGS TO PUKI - YOU CUNT ____ THAT'S ALL I HAVE TIME FOR SO LET'S WRAP..... "
SCROLL_TEXT=SCROLL_TEXT+"LAID HER"
SCROLL_TEXT=SCROLL_TEXT+" "
SCROLL_TEXT=UCASE(SCROLL_TEXT)
' *
' * Delta timing and screen buffers.
' *
DIM SHARED AS DOUBLE DV , OLD , GADD , SCX,SCRLROT,MULT
DIM SHARED AS UINTEGER SCREEN_BUFFER ( XRES * YRES )
DIM SHARED AS UINTEGER PROCESS_BUFFER ( XRES * YRES )
SCX = 0
CONST STARNUM =2000
DIM SHARED AS DOUBLE STRX (STARNUM)
DIM SHARED AS DOUBLE STRY (STARNUM)
DIM SHARED AS DOUBLE STRZ (STARNUM)
'-------------------------------------------------------------------------------
' Define the Subs.
'-------------------------------------------------------------------------------
DECLARE SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER)
DECLARE SUB PREPARE_LETTERS()
DECLARE SUB SET_PALETTE()
DECLARE SUB RENDER_SCREEN_BUFFER()
DECLARE SUB DARKEN_BUFFER()
DECLARE SUB PREPARE_GRID()
DECLARE SUB DRAW_GRID()
DECLARE SUB SETSTARS()
DECLARE SUB DRAWSTARS()
PREPARE_GRID()
PREPARE_LETTERS()
SET_PALETTE()
SETSTARS()
'-------------------------------------------------------------------------------
' *
' * Open the window
' *
PTC_ALLOWCLOSE(0)
PTC_SETDIALOG(1,"Test"+CHR$(13)+"Full Screen?",0,1)
IF (PTC_OPEN("Shockwave 2011",XRES,YRES)=0) THEN
END-1
END IF
SLEEP 10
'-------------------------------------------------------------------------------
' PLAY THE FUCKING MUSIC;
'-------------------------------------------------------------------------------
If MiniFmod_Init(@some.xm(0), 25168) = 0 Then
end-1
End If
MiniFmod_Play()
DIM TWAT AS INTEGER
TWAT=SHOWCURSOR(0)
'-------------------------------------------------------------------------------
' Loop
'-------------------------------------------------------------------------------
SCRLROT=0
MULT=60
WHILE(GETASYNCKEYSTATE(VK_ESCAPE)<> -32767 and PTC_GETLEFTBUTTON=FALSE)
OLD=TIMER
IF GETASYNCKEYSTATE(VK_UP) THEN
SCRLROT=SCRLROT-.1
IF SCRLROT<-3.6 THEN SCRLROT=-3.6
END IF
IF GETASYNCKEYSTATE(VK_DOWN) THEN
SCRLROT=SCRLROT+.1
IF SCRLROT>3.6 THEN SCRLROT=3.6
END IF
IF GETASYNCKEYSTATE(VK_LEFT) THEN
MULT=MULT+1
IF MULT>120 THEN MULT=120
END IF
IF GETASYNCKEYSTATE(VK_RIGHT) THEN
MULT=MULT-1
IF MULT<30 THEN MULT=30
END IF
DRAW_GRID()
DRAWSTARS()
DRAW_IMAGE(0,0,290,30,40,30,0)
DRAW_IMAGE(0,31,90,10,680,530,0)
DARKEN_BUFFER()
RENDER_SCREEN_BUFFER()
PTC_UPDATE@SCREEN_BUFFER(0)
ERASE PROCESS_BUFFER
DV=TIMER-OLD
GADD = GADD + ( DV*10 )
IF DV>=1 THEN DV=1
WEND
MiniFmod_Stop()
EXITPROCESS(0)
'-------------------------------------------------------------------------------
' Subroutines
'-------------------------------------------------------------------------------
SUB SETSTARS()
' *
' * - Set the initial Star Points.
' *
DIM LP AS INTEGER
FOR LP=1 TO STARNUM
STRX(LP)=(RND(1)*1000)-900
STRY(LP)=(RND(1)*450)-150
STRZ(LP)=(RND(1)*16)
NEXT
END SUB
SUB DRAWSTARS()
' *
' * - Lame Ass 3D Starfield
' *
DIM AS INTEGER LP,TX,TY,ADD
FOR LP=1 TO STARNUM
TX=(STRX(LP)/STRZ(LP))+780
TY=(STRY(LP)/STRZ(LP))+100
IF TX>5 AND TX<XRES-10 AND TY>10 AND TY<YRES-10 AND STRZ(LP)<13 THEN
ADD=32+(-STRZ(LP))
PROCESS_BUFFER(TX+(TY*XRES))+=ADD*8
END IF
STRZ(LP)=STRZ(LP)-(DV*.6)
STRX(LP)=STRX(LP)-DV*45
STRY(LP)=STRY(LP)+DV*25
IF STRZ(LP)<0 THEN STRZ(LP)+=16
IF STRX(LP)<= -900 THEN STRX(LP)+=1000
IF STRY(LP)>= 300 THEN STRY(LP)-=450
NEXT
END SUB
SUB DARKEN_BUFFER()
DIM AS UINTEGER PTR PP1,PP2,PP3,PP4,PP5
' *
' * - Cheap and fast Anti-Alias Blurr with botton right bias.
' *
DIM LP AS INTEGER
DIM TOT AS INTEGER
PP1=@PROCESS_BUFFER(XRES+1)
PP2=@PROCESS_BUFFER(XRES)
PP3=@PROCESS_BUFFER(XRES+2)
PP4=@PROCESS_BUFFER(1)
PP5=@PROCESS_BUFFER(XRES+XRES+1)
FOR LP=XRES*20 TO (XRES*(YRES-20))-(XRES)
TOT= (*PP1 + *PP2 + *PP3 +*PP4 + *PP5) *.45
*PP1 = TOT
PP1+=1
PP2+=1
PP3+=1
PP4+=1
PP5+=1
NEXT
END SUB
SUB DRAW_GRID()
' *
' * 3D Scroll Routine.
' *
DIM AS INTEGER LP,TX,TY,X,Y,CC,RGBB,LEP
DIM AS DOUBLE XPS,JUMP,SCALE
DIM AS DOUBLE VX1,VY1,VZ1
SCALE=10
DIM AS DOUBLE VRXR ,VRYR,VRZR,VZZ,VXX,VYY,VDV
VRYR=1.43
VRZR=-.2+.02*SIN(GADD*.1)
VRXR=0.9+SCRLROT
JUMP = 24
SCX = SCX + DV * MULT
IF SCX > JUMP THEN
P=P+1
IF P>LEN(SCROLL_TEXT)-MAXLETTERS THEN
P=1
END IF
SCX=SCX-JUMP
END IF
XPS=-((MAXLETTERS*JUMP) / 2 )
XPS =XPS -SCX
CC=300
FOR LP = 1 TO MAXLETTERS
FOR X=1 TO 3
FOR Y=1 TO 3
VX1=POINTX(X,Y,LP)+XPS
VY1=POINTY(X,Y,LP)
VZ1=POINTZ(X,Y,LP)+7
Vxx=Vx1
Vyy=Vy1*cos(VRxr)+Vz1*sin(VRxr)
Vzz=Vz1*cos(VRxr)-Vy1*sin(VRxr)
Vy1=Vyy
Vx1=Vxx*cos(VRyr)-Vzz*sin(VRyr)
Vz1=Vxx*sin(VRyr)+Vzz*cos(VRyr)
Vzz=Vz1
Vxx=Vx1*cos(VRzr)-Vy1*sin(VRzr)
Vyy=Vx1*sin(VRzr)+Vy1*cos(VRzr)
Vdv=(Vzz/60.15)+8.5
Vxx=(SCALE*(Vxx/Vdv))+(HALFX)+410
Vyy=(SCALE*(Vyy/Vdv))+HALFY-200
TPX(X,Y)=Int(Vxx)
TPY(X,Y)=Int(Vyy)
VX1=POINTX(X,Y,LP)+XPS
VY1=POINTY(X,Y,LP)
VZ1=POINTZ(X,Y,LP)+7.5
Vxx=Vx1
Vyy=Vy1*cos(VRxr)+Vz1*sin(VRxr)
Vzz=Vz1*cos(VRxr)-Vy1*sin(VRxr)
Vy1=Vyy
Vx1=Vxx*cos(VRyr)-Vzz*sin(VRyr)
Vz1=Vxx*sin(VRyr)+Vzz*cos(VRyr)
Vzz=Vz1
Vxx=Vx1*cos(VRzr)-Vy1*sin(VRzr)
Vyy=Vx1*sin(VRzr)+Vy1*cos(VRzr)
Vdv=(Vzz/60.15)+8.5
Vxx=(SCALE*(Vxx/Vdv))+(HALFX)+410
Vyy=(SCALE*(Vyy/Vdv))+HALFY-200
TPX2(X,Y)=Int(Vxx)
TPY2(X,Y)=Int(Vyy)
NEXT
NEXT
if cc>=0 then CC-=20
if cc<0 then cc=0
RGBB=CC
XPS =XPS+JUMP
LEP=ASC(MID(SCROLL_TEXT,P+LP,1))-31
IF LEP<1 THEN LEP=1
IF LEP>65 THEN LEP=1
if STRUCT (1,LEP)=1 THEN EDGE(TPX(1,1),TPY(1,1),TPX(1,2),TPY(1,2),RGBB)
if STRUCT (2,LEP)=1 THEN EDGE(TPX(1,2),TPY(1,2),TPX(1,3),TPY(1,3),RGBB)
if STRUCT (3,LEP)=1 THEN EDGE(TPX(1,3),TPY(1,3),TPX(2,3),TPY(2,3),RGBB)
if STRUCT (4,LEP)=1 THEN EDGE(TPX(2,3),TPY(2,3),TPX(3,3),TPY(3,3),RGBB)
if STRUCT (5,LEP)=1 THEN EDGE(TPX(3,3),TPY(3,3),TPX(3,2),TPY(3,2),RGBB)
if STRUCT (6,LEP)=1 THEN EDGE(TPX(3,2),TPY(3,2),TPX(3,1),TPY(3,1),RGBB)
if STRUCT (7,LEP)=1 THEN EDGE(TPX(3,1),TPY(3,1),TPX(2,1),TPY(2,1),RGBB)
if STRUCT (8,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(1,1),TPY(1,1),RGBB)
if STRUCT (9,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(2,2),TPY(2,2),RGBB)
if STRUCT (10,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(2,3),TPY(2,3),RGBB)
if STRUCT (11,LEP)=1 THEN EDGE(TPX(1,2),TPY(1,2),TPX(2,2),TPY(2,2),RGBB)
if STRUCT (12,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(3,2),TPY(3,2),RGBB)
if STRUCT (13,LEP)=1 THEN EDGE(TPX(1,1),TPY(1,1),TPX(2,2),TPY(2,2),RGBB)
if STRUCT (14,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(3,3),TPY(3,3),RGBB)
if STRUCT (15,LEP)=1 THEN EDGE(TPX(3,1),TPY(3,1),TPX(2,2),TPY(2,2),RGBB)
if STRUCT (16,LEP)=1 THEN EDGE(TPX(2,2),TPY(2,2),TPX(1,3),TPY(1,3),RGBB)
if STRUCT (17,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(1,2),TPY(1,2),RGBB)
if STRUCT (18,LEP)=1 THEN EDGE(TPX(2,1),TPY(2,1),TPX(3,2),TPY(3,2),RGBB)
if STRUCT (19,LEP)=1 THEN EDGE(TPX(1,2),TPY(1,2),TPX(2,3),TPY(2,3),RGBB)
if STRUCT (20,LEP)=1 THEN EDGE(TPX(3,2),TPY(3,2),TPX(2,3),TPY(2,3),RGBB)
if STRUCT (1,LEP)=1 THEN EDGE(TPX2(1,1),TPY2(1,1),TPX2(1,2),TPY2(1,2),RGBB)
if STRUCT (2,LEP)=1 THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(1,3),TPY2(1,3),RGBB)
if STRUCT (3,LEP)=1 THEN EDGE(TPX2(1,3),TPY2(1,3),TPX2(2,3),TPY2(2,3),RGBB)
if STRUCT (4,LEP)=1 THEN EDGE(TPX2(2,3),TPY2(2,3),TPX2(3,3),TPY2(3,3),RGBB)
if STRUCT (5,LEP)=1 THEN EDGE(TPX2(3,3),TPY2(3,3),TPX2(3,2),TPY2(3,2),RGBB)
if STRUCT (6,LEP)=1 THEN EDGE(TPX2(3,2),TPY2(3,2),TPX2(3,1),TPY2(3,1),RGBB)
if STRUCT (7,LEP)=1 THEN EDGE(TPX2(3,1),TPY2(3,1),TPX2(2,1),TPY2(2,1),RGBB)
if STRUCT (8,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(1,1),TPY2(1,1),RGBB)
if STRUCT (9,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(2,2),TPY2(2,2),RGBB)
if STRUCT (10,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(2,3),TPY2(2,3),RGBB)
if STRUCT (11,LEP)=1 THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(2,2),TPY2(2,2),RGBB)
if STRUCT (12,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(3,2),TPY2(3,2),RGBB)
if STRUCT (13,LEP)=1 THEN EDGE(TPX2(1,1),TPY2(1,1),TPX2(2,2),TPY2(2,2),RGBB)
if STRUCT (14,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(3,3),TPY2(3,3),RGBB)
if STRUCT (15,LEP)=1 THEN EDGE(TPX2(3,1),TPY2(3,1),TPX2(2,2),TPY2(2,2),RGBB)
if STRUCT (16,LEP)=1 THEN EDGE(TPX2(2,2),TPY2(2,2),TPX2(1,3),TPY2(1,3),RGBB)
if STRUCT (17,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(1,2),TPY2(1,2),RGBB)
if STRUCT (18,LEP)=1 THEN EDGE(TPX2(2,1),TPY2(2,1),TPX2(3,2),TPY2(3,2),RGBB)
if STRUCT (19,LEP)=1 THEN EDGE(TPX2(1,2),TPY2(1,2),TPX2(2,3),TPY2(2,3),RGBB)
if STRUCT (20,LEP)=1 THEN EDGE(TPX2(3,2),TPY2(3,2),TPX2(2,3),TPY2(2,3),RGBB)
NEXT LP
END SUB
SUB PREPARE_LETTERS()
' *
' *
' * Define which letters are connected.
' *
' *
DIM AS INTEGER LP,LP2,VALUE
FOR LP=1 TO 65
FOR LP2=1 TO 20
READ VALUE
STRUCT(LP2,LP)=VALUE
NEXT
NEXT
END SUB
SUB PREPARE_GRID()
' *
' * This one just sets the vertices of the 3*3 grid in the letters.
' * Also it makes sure that the connections for each letter are clear.
' *
DIM LP AS INTEGER
DIM AS INTEGER X,Y,L
DIM AS DOUBLE TXP,TYP,TZP,GAP
GAP = 10
' *
' * Loop through each of the letters
' *
FOR L=1 TO MAXLETTERS
TXP = -GAP
TYP = -(GAP*1.2)
TZP = 1.0
' *
' * X Co-Ords
' *
FOR X=1 TO VERTX
' *
' * Y Co-Ords
' *
FOR Y=1 TO VERTY
' *
' * Set the vertices
' *
POINTX ( X,Y,L ) = TXP
POINTY ( X,Y,L ) = TYP
POINTZ ( X,Y,L ) = TZP
TYP = TYP + (GAP*1.2)
NEXT Y
TXP = TXP + GAP
TYP = -(GAP*1.2)
NEXT X
TXP = -GAP
TZP = 0.0
NEXT L
END SUB
SUB EDGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER , BYVAL X2 AS INTEGER , BYVAL Y2 AS INTEGER , BYVAL LR AS INTEGER)
' *
' * - Line Draw Routine.
' *
DIM xdistance AS DOUBLE
DIM ydistance AS DOUBLE
DIM TC AS INTEGER
DIM i AS INTEGER
DIM h2 AS INTEGER
DIM StartX AS DOUBLE
DIM StartY AS DOUBLE
DIM XRatio AS DOUBLE
DIM YRatio AS DOUBLE
DIM BUFF AS INTEGER
TC = LR
xdistance = X2 - X1
ydistance = Y2 - Y1
h2 = sqr( xdistance * xdistance + ydistance * ydistance )
if h2>1200 then exit sub
StartX = X1
StartY = Y1
XRatio = xdistance * ( 1.0 / h2 )
YRatio = ydistance * ( 1.0 / h2 )
for i = 0 to h2
IF STARTX>1 AND STARTX<XRES-15 AND STARTY>0 AND STARTY<YRES-1 THEN
PROCESS_BUFFER ( INT((StartX) + (INT(StartY) * XRES )) ) = TC
END IF
StartX = StartX + XRatio
StartY = StartY + YRatio
next i
END SUB
SUB RENDER_SCREEN_BUFFER()
' *
' * - Plot Those Dots!
' *
DIM AS UINTEGER PTR PP1,PP2
DIM AS UINTEGER LP
PP1 =@SCREEN_BUFFER(0)
PP2 =@PROCESS_BUFFER(0)
FOR LP=0 TO XRES*YRES
*PP1 = COLOUR_PALETTE( *PP2 )
PP1 += 1
PP2 += 1
NEXT
END SUB
SUB SET_PALETTE()
' *
' * - PRE-CALCULATE A PALETTE THIS WILL SAVE A LOT OF TIME LATER :-)
' *
DIM AS DOUBLE RR,GG,BB
DIM AS INTEGER LP
DIM AS UINTEGER TC
RR = 0.0
GG = 0.0
BB = 0.0
FOR LP=0 TO 9999
TC=RGB(INT(RR),INT(GG),INT(BB))
COLOUR_PALETTE(LP) = TC
IF LP>50 THEN
RR += .30
GG += .60
BB += .8
END IF
IF RR > 255 THEN RR = 255
IF GG > 255 THEN GG = 255
IF BB > 255 THEN BB = 255
NEXT
END SUB
SUB DRAW_IMAGE(BYVAL X1 AS INTEGER , BYVAL Y1 AS INTEGER, BYVAL W AS INTEGER, BYVAL H AS INTEGER, BYVAL SX AS INTEGER , BYVAL SY AS INTEGER , BYVAL MASK AS UINTEGER)
'-------------------------------------------------------------------------------
' *
' * DRAW_IMAGE BY SHOCKWAVE^CODIGOS
' *
' * USAGE : DRAWIMAGE ( X1 , Y1 , WIDTH , HEIGHT , SCREENX , SCREENY , MASK COLOUR &HRRGGBB)
' *
' * THIS FUNCTION DOES NOT CHECK WHERE YOU ARE COPYING FROM.
' * IF YOU TRY TO COPY FROM AN AREA OUTSIDE YOUR TEMPLATE, IT WILL CRASH.
' * IT IS DONE THIS WAY FOR SPEED.
' *
' * THIS FUNCTION DOES CLIP THE IMAGE TO THE DISPLAY SCREEN.
' * IT IS SAFE TO DRAW PARTLY OR COMPLETELY OFF THE DISPLAY SCREEN.
' *
'-------------------------------------------------------------------------------
DIM AS INTEGER X,Y,XX,YY,PIXEL,Q,GLOW
DIM AS UINTEGER PTR PP1,PP2
YY=SY
GLOW=10+9*SIN(GADD*.5)
FOR Y=Y1 TO Y1+H
XX=SX
PP1=@IMG_RAW(X1+(Y*IMGX))
PP2=@PROCESS_BUFFER (XX+(YY*XRES))
if YY>0 AND YY<YRES then
FOR X=X1 TO X1+W
PIXEL=*PP1
Q=IMG_COLOURS(PIXEL)
IF Q<>&H000000 THEN *PP2=60+GLOW
PP2+=1
PP1+=1
XX=XX+1
NEXT
end if
YY=YY+1
NEXT
END SUB
SUB LOAD_IMAGE()
DIM AS INTEGER L,RR,GG,BB
'-------------------------------------------------------------------------------
' PALETTE FIRST..
'-------------------------------------------------------------------------------
RR=0
GG=1
BB=2
FOR L=0 TO 255
IMG_COLOURS(L)=RGB(disgrace.bmp.pal(RR),disgrace.bmp.pal(GG),disgrace.bmp.pal(BB))
RR=RR+3
GG=GG+3
BB=BB+3
NEXT
'-------------------------------------------------------------------------------
' RAW DATA NEXT..
'-------------------------------------------------------------------------------
FOR L=0 TO (IMGX*IMGY)-1
IMG_RAW(L)=disgrace.bmp.raw(L)
NEXT
END SUB
'*******************************************************************************
'* The Alphabet ;-)
'*******************************************************************************
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' Space
DATA 0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0,0' !
DATA 1,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0' "
DATA 1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0' #
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' $
DATA 1,0,0,1,1,0,0,1,0,0,0,0,0,0,1,1,1,0,0,1' %
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1' & = DIAMOND
DATA 0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0' `
DATA 0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0' (
DATA 0,0,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1' )
DATA 0,0,0,0,0,0,0,0,1,1,1,1,1,1,1,1,0,0,0,0' *
DATA 0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0' +
DATA 0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,1,1' ,
DATA 0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0' -
DATA 0,0,1,1,0,0,0,0,0,0,0,0,0,1,0,1,0,0,0,0' .
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0' /
DATA 1,1,1,1,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0' 0
DATA 0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,1,0,0,0' 1
DATA 0,1,1,1,0,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 2
DATA 0,0,1,1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0' 3
DATA 0,0,0,0,1,1,0,0,0,0,1,1,0,0,0,0,1,0,0,0' 4
DATA 1,0,1,1,1,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 5
DATA 0,1,1,1,1,0,1,0,0,0,1,1,0,0,0,0,1,0,0,0' 6
DATA 0,0,0,0,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0' 7
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' 8
DATA 1,0,0,0,1,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' 9
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' :
DATA 0,0,1,1,0,0,1,1,0,0,0,0,1,1,1,1,0,0,0,0' :
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1,0' <
DATA 0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0' =
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,1' >
DATA 0,0,0,0,0,1,1,1,0,1,0,1,0,0,0,0,0,0,0,0' ?
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' @
DATA 0,1,0,0,1,0,0,0,0,0,1,1,0,0,0,0,1,1,0,0' A
DATA 1,1,1,1,1,0,0,1,0,0,1,1,0,0,0,0,0,1,0,0' B
DATA 0,0,0,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,1,0' C
DATA 1,1,1,1,1,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0' D
DATA 0,0,0,1,0,0,1,0,0,0,1,1,0,0,0,0,1,0,1,0' E
DATA 0,1,0,0,0,0,1,0,0,0,1,1,0,0,0,0,1,0,0,0' F
DATA 0,1,1,1,1,0,1,0,0,0,0,1,0,0,0,0,1,0,0,0' G
DATA 1,1,0,0,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0' H
DATA 0,0,1,1,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0' I
DATA 0,1,1,0,0,1,1,1,0,0,0,0,0,0,0,0,0,0,0,1' J
DATA 1,1,0,0,1,0,0,0,0,0,1,1,0,0,1,0,0,0,0,0' K
DATA 1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' L
DATA 1,1,0,0,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0' M
DATA 1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0,0,0' N
DATA 1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0' O
DATA 1,1,0,0,0,1,1,1,0,0,1,1,0,0,0,0,0,0,0,0' P
DATA 1,1,1,0,0,1,1,1,0,0,0,0,0,1,0,0,0,0,0,1' Q
DATA 1,1,0,0,0,0,1,1,0,0,1,0,0,1,1,0,0,0,0,0' R
DATA 1,0,1,1,1,0,1,1,0,0,1,1,0,0,0,0,0,0,0,0' S
DATA 0,0,0,0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0' T
DATA 1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0' U
DATA 1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,1,1' V
DATA 1,1,1,1,1,1,0,0,0,1,0,0,0,0,0,0,0,0,0,0' W
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,1,0,0,0,0' X
DATA 1,0,1,1,1,1,0,0,0,0,1,1,0,0,0,0,0,0,0,0' Y
DATA 0,0,1,1,0,0,1,1,0,0,0,0,0,0,1,1,0,0,0,0' Z
DATA 1,1,1,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0' [
DATA 0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0' \
DATA 0,0,0,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0' ]
DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,1,0,0' ^
DATA 0,0,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0' _
-
Very cool and karma for sharing the source! Btw in windowed mode it seems to have a small bug. Running windowed mode and click mouse outside the window, intro is freezed while music still playing. Anyway very nice! Sadly i am only for a few mins at home to get new clean clothes for hospital. So i dont have the time now to take a look to the source. K++
-
Hi mate, no that's not a bug it's the way that rbz's tiny ptc framework is :)
It's great to see you here, even if it's only briefly. Hope you're feeling better soon Thorsten.
-
K++ for the source pal! ;)
-
Hi mate, no that's not a bug it's the way that rbz's tiny ptc framework is :)
It's more likely an unwanted feature ::)
Shockwave, please test this one:
http://www.rbraz.com/source/tinyptc_ext.zip
If everything is ok I'll update tinyptc_ext thread with this archive.
-
Works great Rbz :)
K+
-
Thumbs up!
-
Cheers Rel :)
-
Shockwave - just downloaded the source for this - I have to say one thing - STUNNING - loving what you have done. Sorry it has taken me so long to download it! ;)
Drew