Dark Bit Factory & Gravity
PROGRAMMING => Other languages => Blitz => Topic started by: Shockwave on May 04, 2006
-
This needs the media files from the alpha blurr demo, you can download it here;
(http://www.dbfinteractive.com/demos/vbadshot.png)
http://www.dbfinteractive.com/demos/alphablurr.zip (http://www.dbfinteractive.com/demos/alphablurr.zip) (550 kb)
; DBF New Board Intro Coded By Shockwave (C) 2004..
;
;
;
;
;-------------------------------------------------------------------------------------------------------
Global xres = 640
Global yres = 480
Global masterfade = 255
;-------------------------------------------------------------------------------------------------------
update = CreateTimer(60)
Graphics xres,yres,0,1
SetBuffer BackBuffer()
Global audio = PlayMusic("media/follow.xm")
Global emblem = LoadImage ("media/silver.png")
;=======================================================================================================
; START OF VECTORBALL PREPARATIONS!
;=======================================================================================================
Global vecballsize#=29; Dotball Scale
Global vecballpoints=125 ; No. of points on Dot ball
Global vecballxr,vecballyr,vecballzr; Rotation values
;---------------------------------------------------------
Dim vecballx#(vecballpoints); Storage for untransformed ball
Dim vecbally#(vecballpoints)
Dim vecballz#(vecballpoints)
;-----------------------------------------------------------------------------------------------------
Dim vecballtx(vecballpoints); Storage for transformed ball
Dim vecballty(vecballpoints)
Dim vecballtz(vecballpoints)
;-----------------------------------------------------------------------------------------------------
Restore vecballobject
For a=1 To vecballpoints
Read vecballx(a)
Read vecbally(a)
Read vecballz(a)
Next
;---------------------------------------------------------
; Define Sine Tables For faster matrix calculations;
;---------------------------------------------------------
Dim cs#(2880); Make some sin and cos for speed.
Dim sn#(2880)
ang#=0
;---------------------------------------------------------
For a=0 To 2880
cs#(a)=Cos(ang#)
sn#(a)=Sin(ang#)
ang=ang#+.25
Next
;-----------------------------------------------------------------------------------------------------
Dim vecballbuffer(xres,yres)
Dim vecbob(16,16)
loadvecbob()
Dim flamecolours(255); Store For Colour List.
create_fire_colours()
Global xst=0
Global yst=0
screen =CreateImage(xres,yres,1)
Global msg$=" PRESS V TO TOGGLE WAIT FOR V-SYNCH.... F TO TOGGLE FPS........ SHAMELESS PLUG........ VISIT WWW.DBFINTERACTIVE.COM IF YOU LIKE OLD SCHOOL DEMO STUFF! "
msg$=msg$+"WELL ONE WAY OR ANOTHER I AM BACK! SHOCKWAVE PRESENTS A LITTLE INTRO IN 2005, IT IS CODED "
msg$=msg$+"IN BLITZ BUT IT DOES NOT USE ANY OF THE BLITZ 3D OR BLITZ PLUS COMMANDS........... ALL THE ALPHA AND MOTION BLURR IS PURE HAND CODED.... OR PURE SHIT DEPENDING ON YOUR POINT OF VIEW :-) "
msg$=msg$+"WHO SAYS YOU NEED TO USE DLLS OR BLITZ PLUS OR BLITZ 3D TO DO THIS STUFF? ANYWAY, I HAVE BORROWED THE VECTORBOB EFFECT FROM OUR FORTHCOMING DEMO "
msg$=msg$+"(AMOPRPHOUS DARKNESS) WHICH WILL BE A MULTI PART JOB BUT PROGRESS IS SLOW BECAUSE I AM HAVING TO CODE A LOT OF THE TEXTURE STUFF WE'RE USING FROM SCRATCH.. "
msg$=msg$+"I'D LIKE TO WELCOME OUR TWO NEWEST MEMBERS... R0LY (MUSIC) AND TETRA (CODE) QUICK CREDITS FOR THIS INTRO:
msg$=msg$+" CODING IN PURE B2D BY SHOCKWAVE"
msg$=msg$+" GRAPHICS BY WHAM"
msg$=msg$+" MUSIC BY R0LY"
msg$=msg$+" I GUESS THAT I CODED THIS BECAUSE I WANTED A BREAK FROM MY TEXTURE MAPPER WHICH IS PISSING ME OFF BIG TIME BUT IT'S COMING... SLOWLY! "
msg$=msg$+" I LOST NEARLY ALL MY SOURCE CODE WHEN I SOLD MY LAST COMPUTER AND I NEED TO COMPLETELY RE-CODE MY 3D LIBRARIES, TO BE HONEST I THOUGHT IT WOULD BE EASIER "
msg$=msg$+"GOING THAN IT HAS BEEN, AMORPHOUS DARKNESS IS FINISHED SAVE FOR THAT DAMNED PERSPECTIVE CORRECT MAPPER............ I CAN'T CODE THE END PART WITHOUT IT AND IT'S NOT BEHAVING ITS SELF. "
msg$=msg$+"NEVER MIND, I'LL GET THERE I GUESS! "
msg$=msg$+"I WILL BE RELEASING THIS INTRO OVER AT POUET AMONGST OTHER PLACES, I AM SURE THAT IT WILL GET FLAME GRILLED BECAUSE "
msg$=msg$+"IT'S OLD SCHOOL, IT'S WRITTEN IN BLITZ AND THE EXE SIZE IS BIGGER THAN IT'S EQUIVALENT C OR ASM VERSION........ "
Msg$=msg$+"THE WHOLE POINT OF THIS IS REALLY FOR FUN AND ANY 3D OR BLURRS ETC YOU SEE IN MY DEMOS WILL BE HAND CODED JUST LIKE IN THE OLD DAYS... "
msg$=msg$+" ANYWAY, I HOPE THAT IF YOU LIKE RETRO STUFF THAT YOU WON'T BE TOO UNKIND "
msg$=msg$+"BECAUSE THERE'S MORE OF THIS SORT OF THING TO COME, NOT TO MENTION SOME NEWER EFFECTS BUT UNDERSTAND THAT WE DO THIS RETRO STUFF FOR THE FUN OF IT AND THE LOVE OF IT........... "
msg$=msg$+"MAYBE THERE ARE SOME UK SCENERS READING THAT REMEMBER ME FROM THE AMIGA? MY HANDLE WAS THE SAME THEN, I USED TO DO GFX AND I WAS IN A FEW UK GROUPS OVER THE YEARS.......... "
msg$=msg$+"ANYHOW, HERE ARE A FEW HELLOS TO SOME FRIENDS AND AFTER THAT I GUESS I'LL SEE YOU NEXT TIME!.......... "
msg$=msg$+"RANDOM HELLOS TO: WHAM/DBF, TETRA/DBF, ROLY/DBF, LONESTAR/HUGI, BLUNDER, GRIM, KRYLAR, CLYDE/GVY, JIM SHAW, JINX, NINO, FASH / GVY, RAFRYER, CHRIS RANKINE, YALOOPY, BLITZ AMMATEUR AND ALL THE REST OF YOU WHO I'VE FORGOTTEN... SHAMEFUL BEHAVIOUR! "
msg$=msg$+"SHOUTS TO SOME OF MY OLD SCENE FRIENDS WHO MAY OR MAY NOT BE HERE... SAINT / TSL, MFD / TSL, TAS / TSL, SCRAB / CYRUS, LYNX / REBELS, KREST / REBELS, FOBIA / ANARCHY, NOVA / DIGITAL, HAWKEYE / DIGITAL, BOD / DIGITAL, ACE / QUARTZ, DELBERT / PLAGUE, REN / TEKNIK, PARASITE / LSD, SOUL / LSD, RED DEVIL / WIZZCAT, "
msg$=msg$+"SPROGGIT / DMX, STEINAR / DMX, MR.T/ RAZOR 1911 AND EVERYONE ELSE I KNEW BACK IN THE DAY.... IF YOU WANT TO GET IN TOUCH YOU CAN ALWAYS VISIT THE DBF SITE AND DROP ME A MAIL, I'D LOVE TO HEAR FROM YOU!! "
msg$=msg$+"TIME TO HAND THE KEYS TO R0LY.... "
msg$=msg$+"HI, HERE IS R0LY AT THE KEYS... I JUST WANNA SAY HELLO TO ALL THE PEOPLE WHO SPEND THIER TIME "
msg$=msg$+"CODING, PAINTING AND COMPOSING.... IT'S GREAT TO ENJOY ALL THE PRODUCTIONS AND "
msg$=msg$+"IT'S ALSO GREAT TO BE IN THE DEMOSCENE FROM THE LATE 80'S UNTIL TODAY!!! KEEP UP THE GOOD WORK! "
msg$=msg$+"TAKE IT EASY OR ANY WAY YOU CAN GET IT AND WE'LL SEE YOU AGAIN WITH A MORE DEMANDING PRODUCT! "
msg$=msg$+" "
Global gg
Global gg2
Global fvc#=640
Global fuv#=-300
Global demotime = 0
Global Lft# = 0
Global rgt# =640
;-------------------------------------------------------------------------------------------------------------------------------------
; Get The Font Ready!
;-------------------------------------------------------------------------------------------------------------------------------------
Const file$ = "media/font.png"; Highlight Font filename.
Const FWidth = 16; Width of letters
Const FHeight = 16; Height Of letters
Const Fchars = 60; Number of letters in font
Global graphicfont
graphic_text_setup(file$,fwidth,fheight,0,fchars)
Global p = 1
Global scx = 0
;-------------------------------------------------------------------------------------------------------------------------------------
Global toggle=1
Global ftoggle=0
Global fps=0
Global newfps=0
Global mtime=MilliSecs()
While Not KeyDown(1)
gg=gg+20
If gg>=1440 gg=gg-1440
If demotime<150 demotime=demotime+1
If demotime>=150 Then
DrawBlock screen,0,0
If masterfade<255 masterfade = masterfade+1
vecballs()
Color 0,0,masterfade/3.5
Rect lft,380,rgt/2,91
If fvc#>380 fvc=fvc-((fvc-380)/15)
If fuv#<0 fuv=fuv+((0-fuv)/15)
GrabImage screen,0,0
DrawImage emblem,fvc,fuv
Color 55,55,255
Line 0,379,lft,379
Line rgt,471,640,471
Color 255,255,255
Line 0,380,lft,380
Line rgt,470,640,470
If lft<645 lft=lft+((640 - lft)/10)
If rgt>-5 rgt=rgt-((rgt-0)/10)
SCROLLER()
If ftoggle=1 graphic_text2("FPS:"+Str$(newfps),0,0,16,0)
If KeyHit(47) Then
toggle=toggle+1
End If
If toggle>1 toggle=0
If KeyHit(33) Then
ftoggle=ftoggle+1
End If
If ftoggle>1 ftoggle=0
End If
; If toggle=0 Flip False
; If toggle=1 bollox = WaitTimer(update) : Flip
Flip False
fps=fps+1
If MilliSecs()-mtime>=1000 Then
newfps=fps
fps=0
mtime=MilliSecs()
End If
Wend
End
Function SCROLLER()
chop$=Mid$(msg$,p,50)
graphic_text(chop$,scx,420,16,0)
scx=scx-3
If scx<-16 Then
p=p+1
If p>Len(msg$)-1 p=1
scx=scx+16
End If
End Function
Function vecballs()
Local a,xx#,yy#,zz#,dv#
;---------------------------------------------------------
; Rotate And Scale Each Point! Store Result
;---------------------------------------------------------
For a=1 To vecballpoints
x1#=vecballx#(a)
y1#=vecbally#(a)
z1#=vecballz#(a)
;---------------------------------------------------------
; X,Y,Z rotations!
;---------------------------------------------------------
xx#=x1#
yy#=y1#*cs(vecballxr)+z1#*sn(vecballxr)
zz#=z1#*cs(vecballxr)-y1#*sn(vecballxr)
y1#=yy#
x1#=xx#*cs(vecballyr)-zz#*sn(vecballyr)
z1#=xx#*sn(vecballyr)+zz#*cs(vecballyr)
zz#=z1#
xx#=x1#*cs(vecballzr)-y1#*sn(vecballzr)
yy#=x1#*sn(vecballzr)+y1#*cs(vecballzr)
;---------------------------------------------------------
; Apply Perspective!
;---------------------------------------------------------
dv#=(zz#/40)+1
xx#=vecballsize*(xx/dv)+100
yy#=vecballsize*(yy/dv)+112
vecballtx(a)=Int(xx#)
vecballty(a)=Int(yy#)
vecballtz(a)=Int(zz#)
Next
vecballxr=vecballxr+4
vecballyr=vecballyr+2
vecballzr=vecballzr+1
If vecballxr>1440 vecballxr=vecballxr-1440
If vecballyr>1440 vecballyr=vecballyr-1440
If vecballzr>1440 vecballzr=vecballzr-1440
;-----------------------------------------------------------------------------------------------------
For loopy=10 To 229
For loopx=0 To 217
pixel= ((vecballbuffer(loopx-1,loopy)+vecballbuffer(loopx+1,loopy)+vecballbuffer(loopx,loopy-1)+vecballbuffer(loopx,loopy+1))) Shr 2
If loopy<191 Then
pixel=pixel * .99
If pixel<0 pixel=0
Else
pixel=pixel * .92
If pixel<masterfade/10 pixel=masterfade/10
End If
vecballbuffer(loopx,loopy)=pixel
Next
Next
;-----------------------------------------------------------------------------------------------------
For a=1 To vecballpoints
For loopy=1 To 16
For loopx=1 To 16
pixel = vecbob (loopx,loopy)
If pixel>0 vecballbuffer((bobx+loopx+vecballtx(a)),(boby+loopy+vecballty(a)))=vecballbuffer((bobx+loopx+vecballtx(a)),(boby+loopy+vecballty(a)))+pixel
If vecballbuffer((bobx+loopx+vecballtx(a)),(boby+loopy+vecballty(a)))>masterfade vecballbuffer((bobx+loopx+vecballtx(a)),(boby+loopy+vecballty(a)))=masterfade
Next
Next
Next
Local stx=xst
Local sty=yst
xst=xst+1
If xst>1 Then
yst=yst+1
xst=0
End If
If yst>1 yst=0
LockBuffer BackBuffer()
For loopy=0 To 239
stx=xst
For loopx=0 To 319
If vecballbuffer(loopx,loopy) >0 WritePixelFast stx,sty,flamecolours(vecballbuffer(loopx,loopy) )
; If vecballbuffer(loopx,loopy) >0 WritePixelFast loopx,loopy,$ffffff
stx=stx+2
Next
sty=sty+2
Next
UnlockBuffer BackBuffer()
End Function
;-----------------------------------------------------------------------------------------------------
Function loadvecbob()
Local loopx,loopy,temp
Restore firebobdata
For loopy=1 To 16
For loopx=1 To 16
Read temp
vecbob(loopx,loopy) = temp
Next
Next
End Function
;-----------------------------------------------------------------------------------------------------
Function create_fire_colours()
Local redval = 0
Local blueval = 0
Local grnval = 0
Local colour = 0
For a=1 To 255
If a>50 redval=redval+1
If a>50 grnval=grnval+2
blueval=blueval+3
If redval>255 redval = 255
If grnval>255 grnval = 255
If blueval>255 blueval= 255
colour=(((redval Shl 8)+grnval) Shl 8) + blueval
flamecolours(a)=colour
Next
End Function
;-------------------------------------------------------------------------------------------------
;This function Initialises the font.
;-------------------------------------------------------------------------------------------------
Function graphic_text_setup(font$,gtwidth,gtheight,gtstart,gtlength)
graphicfont=LoadAnimImage (font$,gtwidth,gtheight,gtstart,gtlength)
End Function
;-------------------------------------------------------------------------------------------------
;-------------------------------------------------------------------------------------------------
;General Purpose GFX Text Command.
;-------------------------------------------------------------------------------------------------
Function graphic_text(gtdisp$,gtxpos,gtypos,gtstep,solid)
If gtdisp$="" gtdisp$=" "
For a=1 To Len(gtdisp$)
gtletter=Asc((Mid$(gtdisp$,a,1)))-32
For xx=0 To fwidth Step 1
If gtletter >-1 And gtletter<60 DrawImageRect graphicfont,gtxpos+xx,gtypos+20*cs(gg+gtxpos+xx),xx,0,1,16,gtletter
Next
gtxpos=gtxpos+gtstep
Next
End Function
Function graphic_text2(gtdisp$,gtxpos,gtypos,gtstep,solid)
If gtdisp$="" gtdisp$=" "
For a=1 To Len(gtdisp$)
gtletter=Asc((Mid$(gtdisp$,a,1)))-32
If gtletter >-1 And gtletter<60 DrawImageRect graphicfont,gtxpos,gtypos,xx,0,16,16,gtletter
gtxpos=gtxpos+gtstep
Next
End Function
;-----------------------------------------------------------------------------------------------------
.vecballobject
Data -2,-2,0,-1,-2,0,0,-2,0,1,-2,0,2,-2,0
Data -2,-1,0,-1,-1,0,0,-1,0,1,-1,0,2,-1,0
Data -2, 0,0,-1, 0,0,0, 0,0,1, 0,0,2, 0,0
Data -2, 1,0,-1, 1,0,0, 1,0,1, 1,0,2, 1,0
Data -2, 2,0,-1, 2,0,0, 2,0,1, 2,0,2, 2,0
Data -2,-2,1,-1,-2,1,0,-2,1,1,-2,1,2,-2,1
Data -2,-1,1,-1,-1,1,0,-1,1,1,-1,1,2,-1,1
Data -2, 0,1,-1, 0,1,0, 0,1,1, 0,1,2, 0,1
Data -2, 1,1,-1, 1,1,0, 1,1,1, 1,1,2, 1,1
Data -2, 2,1,-1, 2,1,0, 2,1,1, 2,1,2, 2,1
Data -2,-2,2,-1,-2,2,0,-2,2,1,-2,2,2,-2,2
Data -2,-1,2,-1,-1,2,0,-1,2,1,-1,2,2,-1,2
Data -2, 0,2,-1, 0,2,0, 0,2,1, 0,2,2, 0,2
Data -2, 1,2,-1, 1,2,0, 1,2,1, 1,2,2, 1,2
Data -2, 2,2,-1, 2,2,0, 2,2,1, 2,2,2, 2,2
Data -2,-2,-2,-1,-2,-2,0,-2,-2,1,-2,-2,2,-2,-2
Data -2,-1,-2,-1,-1,-2,0,-1,-2,1,-1,-2,2,-1,-2
Data -2, 0,-2,-1, 0,-2,0, 0,-2,1, 0,-2,2, 0,-2
Data -2, 1,-2,-1, 1,-2,0, 1,-2,1, 1,-2,2, 1,-2
Data -2, 2,-2,-1, 2,-2,0, 2,-2,1, 2,-2,2, 2,-2
Data -2,-2,-1,-1,-2,-1,0,-2,-1,1,-2,-1,2,-2,-1
Data -2,-1,-1,-1,-1,-1,0,-1,-1,1,-1,-1,2,-1,-1
Data -2, 0,-1,-1, 0,-1,0, 0,-1,1, 0,-1,2, 0,-1
Data -2, 1,-1,-1, 1,-1,0, 1,-1,1, 1,-1,2, 1,-1
Data -2, 2,-1,-1, 2,-1,0, 2,-1,1, 2,-1,2, 2,-1
.firebobdata
Data 0,0,0,0,0,1,2,2,2,2,1,0,0,0,0,0
Data 0,0,0,1,2,1,1,1,1,1,2,2,3,0,0,0
Data 0,0,2,1,2,2,1,1,2,3,3,2,1,3,0,0
Data 0,1,1,3,1,1,1,1,3,5,5,3,2,2,1,0
Data 0,1,3,2,1,1,1,3,5,9,9,5,3,1,2,0
Data 1,1,6,2,2,1,1,3,5,9,9,5,3,1,1,1
Data 2,1,9,2,2,1,1,2,3,5,5,3,2,1,1,2
Data 2,1,9,3,2,2,2,1,2,3,3,2,1,1,1,2
Data 2,2,9,5,2,2,2,1,1,1,1,1,1,1,1,2
Data 2,3,7,9,3,2,2,1,1,1,1,1,1,1,1,2
Data 1,3,5,9,5,2,2,2,1,1,1,1,1,2,1,1
Data 0,3,2,7,9,5,3,2,2,1,1,1,1,2,2,0
Data 0,2,4,3,7,9,9,5,3,2,1,2,3,1,1,0
Data 0,0,2,3,2,5,7,9,8,7,6,3,2,2,0,0
Data 0,0,0,2,3,3,3,3,3,3,2,2,1,0,0,0
Data 0,0,0,0,0,1,2,2,2,2,1,0,0,0,0,0