Sharp transparent text routine

BlitzPlus Forums/BlitzPlus Programming/Sharp transparent text routine

JoshK

(Posted 2003) [#1]

AlphaText(x,y,text$,centerx=False,centery=False,alpha#=0.1)

This is the fastest possible way to draw transparent text using Blitz commands.

Graphics3D 400,300,-1,2
SetBuffer BackBuffer()

SetFont LoadFont("Verdana",16,0,0,0) 

cam=CreateCamera()
CameraClsColor cam,0,0,255
MoveEntity cam,0,0,-5
s=CreateSphere(20)
EntityShininess s,1
EntityColor s,255,0,0
TurnEntity CreateLight(),0,45,0

offset=MilliSecs()+900

While Not KeyHit(1)
	TurnEntity s,0,2,0
	RenderWorld
	AlphaText GraphicsWidth()/2,GraphicsHeight()/2,"Welcome to my transparent text demo.",1,1,Sin((MilliSecs()-offset)/10.0)/2.0+0.5
	Flip
	Wend
End

;==============================
;Include file
;==============================

Dim fontdata(0,0,0)
Global FONTDATALOADED
Global FONTDATAWIDTH
Global FONTDATAHEIGHT

Function LoadFontData()
FONTDATALOADED=True
FONTDATAWIDTH=FontWidth()
FONTDATAHEIGHT=FontHeight()
Dim fontdata(126,FONTDATAWIDTH-1,FONTDATAHEIGHT-1)
For n=32 To 126
	If FONTDATALOADED
		For x=0 To FONTDATAWIDTH-1
			For y=0 To FONTDATAHEIGHT-1
				fontdata(n,x,y)=0
				Next
			Next
		EndIf
	c$=Chr(n)
	i=CreateImage(StringWidth(c),StringHeight(c))
	SetBuffer ImageBuffer(i)
	Color 255,255,255
	Text 0,0,c
	If i
		w=ImageWidth(i)
		h=ImageHeight(i)
		For x=0 To w-1
			For y=0 To h-1
				hue=ReadPixel(x,y,ImageBuffer(i))
				If hue=-16777216 hue=0
				fontdata(n,x,y)=hue
				Next
			Next
		FreeImage i
		Else
		w=0
		h=0
		EndIf
	Next
SetBuffer BackBuffer()
End Function

Function AlphaText(x,y,s$,cx=0,cy=0,alpha#=0.5)
If cx x=x-StringWidth(s)/2.0
If cy y=y-StringHeight(s)/2.0
If Not FONTDATALOADED loadfontdata
For n=1 To Len(s)
	c$=Mid(s,n,1)
	a=Asc(c)
	For tx=0 To FONTDATAWIDTH-1
		For ty=0 To FONTDATAHEIGHT-1
			hue=fontdata(a,tx,ty)
			If hue
				r=Red(hue)
				g=Green(hue)
				b=Blue(hue)
				hue=ReadPixel(offset+x+tx,y+ty)
				r=alpha*r+(1.0-alpha)*Red(hue)
				g=alpha*g+(1.0-alpha)*Green(hue)
				b=alpha*b+(1.0-alpha)*Blue(hue)
				WritePixel offset+x+tx,y+ty,RGB(r,g,b)
				EndIf
			Next
		Next
	offset=offset+StringWidth(c)
	Next
End Function

Function AlphaTextFast(x,y,s$,cx=0,cy=0,alpha#=0.5)
If Not FONTDATALOADED loadfontdata
For n=1 To Len(s)
	c$=Mid(s,n,1)
	a=Asc(c)
	For tx=0 To FONTDATAWIDTH-1
		For ty=0 To FONTDATAHEIGHT-1
			hue=fontdata(a,tx,ty)
			If hue
				r=Red(hue)
				g=Green(hue)
				b=Blue(hue)
				hue=ReadPixelFast(offset+x+tx,y+ty)
				r=alpha*r+(1.0-alpha)*Red(hue)
				g=alpha*g+(1.0-alpha)*Green(hue)
				b=alpha*b+(1.0-alpha)*Blue(hue)
				WritePixelFast offset+x+tx,y+ty,RGB(r,g,b)
				EndIf
			Next
		Next
	offset=offset+StringWidth(c)
	Next
End Function

CyBeRGoth

(Posted 2003) [#2]

Some functions missing?

red()
green()
blue()

JoshK

(Posted 2003) [#3]

Oh, I forgot. You should really be using these is you're not:

www.leadwerks.com/code/userlibs/maths/

Dragon57

(Posted 2003) [#4]

Hmm, this is the first time trying to use userlibs. I have downloaded and put the maths.dll and maths.decls file in the userlibs directory. When I try to start Blitz3D now, I get an error requestor that says:
Compiler environment error: Error in userlib 'maths.decls' - expecting ")" after function decl

Any idea what I am doing wrong?

scooter43

(Posted 2003) [#5]

Here are the missing functions to run the code posted above:


Function Red(argb)
    Return (argb Shr 16) And $ff
End Function

Function Green(argb)
    Return (argb Shr 8) And $ff
End Function

Function Blue(argb)
    Return argb And $ff
End Function

Function RGB(r,g,b)
	Return (r Shl 16) Or (g Shl 8) Or b 
End Function

pretty cool... I didn't need the math library to run it though?