I've re-written it to use D3D text and now lines of text also have a life time and will auto-erase as part of the update function. Also, this new version is just better than the old one!
Here's the functions:
STBStart -> Initiates the functions (is sub rarther than function)
STBAdd -> Adds a new STB to the screen, returns an ID number for that STB
STBAddLine -> Adds a text string to a STB
STBRemoveLine -> Removes the oldest line from the STB manually
STBUpdate -> Updates all the STBs on screen when 0 is used or the specific STB identified by the input
Here's the code:
//Startup
Set Display Mode 640,480,16
set window on
sync on
sync rate 60
//Initiate d3d
d3d_init
//Load fonts
TextSize=15
d3d_font 1,"Arial",TextSize,0,0,1
//Initaite the functions
GoSub STBStart
//Add a STB to the screen
MySTB = STBAdd(1,3,20,240,TextSize*1.5,5000)
//Do - loop
do
//Clear the screen
cls 0
//Get the current time
time=timer()
//Check for spacekey
if spacekey()=1 and KEY=0
//Inc the var
inc loopcount,1
//Add a line to the STB
STBAddLine(MySTB,"Random text line "+str$(loopcount),time)
//Stop repeat until spacekey is released
KEY=1
endif
//Spacekey is released, reset var
if spacekey()=0 then KEY=0
//Update STB(s)
STBUpdate(0,time)
//Sync the screen
sync
loop
//Destroy the arrays and vars
STBDestroy()
//End the program
end
`**************************************************
`**************************************************
`************** FUNCTIONS START HERE **************
`**************************************************
`**************************************************
STBStart:
Type STBType
X as integer
Y as integer
Life as integer
Font as integer
AgeLimit as integer
LinesMax as integer
LinesNow as integer
TextHeight as integer
TextString as string
EndType
Global STBMax as integer
Global STBMaxLines as integer
Global Dim STBLines(0,0) as STBType
Return
Function STBAdd(Font as integer, Lines as integer PosX as integer, PosY as integer, TextHeight as integer, Life as integer)
//Inc vars
inc STBMax,1
if Lines>STBMaxLines then STBMaxLines=Lines
Global Dim STBLines(STBMax,STBMaxLines) as STBType
//Add perameters
STBLines(STBMax,0).x =PosX
STBLines(STBMax,0).y =PosY
STBLines(STBMax,0).Font =Font
STBLines(STBMax,0).Life =Life
STBLines(STBMax,0).LinesMax =Lines
STBLines(STBMax,0).TextHeight =TextHeight
EndFunction STBMax
Function STBAddLine(STB_ID as integer, TextString as string, Time as integer)
inc STBLines(STB_ID,0).LinesNow,1
if STBLines(STB_ID,0).LinesNow>STBLines(STB_ID,0).LinesMax
STBShift(STB_ID)
STBLines(STB_ID,STBLines(STB_ID,0).LinesMax).TextString=TextString
dec STBLines(STB_ID,0).LinesNow,1
else
STBLines(STB_ID,STBLines(STB_ID,0).LinesNow).TextString=TextString
endif
STBLines(STB_ID,STBLines(STB_ID,0).LinesNow).AgeLimit = Time+STBLines(STB_ID,0).Life
EndFunction
Function STBRemoveLine(STB_ID as integer)
STBShift(STB_ID)
dec STBLines(STB_ID,0).LinesNow,1
EndFunction
Function STBShift(STB_ID as integer)
for t=1 to STBLines(STB_ID,0).LinesMax-1
STBLines(STB_ID,t).TextString =STBLines(STB_ID,t+1).TextString
STBLines(STB_ID,t).AgeLimit =STBLines(STB_ID,t+1).AgeLimit
next t
STBLines(STB_ID,STBLines(STB_ID,0).LinesMax).TextString = ""
EndFunction
Function STBUpdate(STB_ID as integer,Time as integer)
if STB_ID>0
if STBLines(STB_ID,0).LinesNow>0
STBUpdateSpecific(STB_ID,Time)
endif
else
for t=1 to STBMax
if STBLines(t,0).LinesNow>0
STBUpdateSpecific(t,Time)
endif
next t
endif
EndFunction
Function STBUpdateSpecific(STB_ID as integer,Time as integer)
for l=1 to STBLines(STB_ID,0).LinesNow
if Time<STBLines(STB_ID,l).AgeLimit
D3D_starttext
D3D_text STBLines(STB_ID,0).Font,STBLines(STB_ID,0).X,STBLines(STB_ID,0).Y+(STBLines(STB_ID,0).TextHeight*l),0,STBLines(STB_ID,l).TextString
D3D_endtext
else
STBRemoveLine(STB_ID)
endif
next l
EndFunction
Function STBDestroy()
UnDim STBLines()
UnDim STBMax()
UnDim STBMaxLines()
EndFunction
I'm going to re-add the 'direction' functionallity later.
Anybody got any ideas/requests that might make this more useful?
Thanks,
BC