[bmx] drawpixmaptext by Leon Drake [ 1+ years ago ]

[BlitzBot]

Title : drawpixmaptext
Author : Leon Drake
Posted : 1+ years ago

Description : This command allows you to write text to a pixmap without requiring a DX or OGL graphics context open.

Code :

Code (blitzmax) Select Expand

Function drawpixmaptext(text$,pix:TPixmap,x,y,font:TImageFont,red=255,green=255,blue=255)
Local newx
Local theight



theight = font.Height()
Print theight
For i = 0 To text.length-1

tempText$ = Mid(text, i+1, 1)
asciiVal = Asc(tempText)
n=font.CharToGlyph( asciiVal )
If n<0 Continue

glyph:TImageGlyph = font.LoadGlyph(n)
image:TImage=glyph._image
Print "Draw "+Chr(asciiVal)
If image <> Null
tempix:TPixmap = LockImage(image)
UnlockImage(glyph._image)

If tempix




For yy = 0 To tempix.height-1
For xx = 0 To tempix.width-1
If newx+x+xx < pix.width And y+yy < pix.height Then

alpha# = RGBA_alpha(ReadPixel(tempix,xx,yy))
alphan# = Float(alpha#/255.0)
anti# = 1.0-alphan#
ured = RGBA_Red(ReadPixel(tempix,xx,yy))
ugrn = RGBA_Green(ReadPixel(tempix,xx,yy))
ublu = RGBA_Blue(ReadPixel(tempix,xx,yy))

newred = ((RGBA_Red(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ured*alphan#))
newgrn = ((RGBA_Green(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ugrn*alphan#))
newblu = ((RGBA_Blue(ReadPixel(pix,newx+x+xx,y+yy))*anti#)+(ublu*alphan#))


If newred > 255 Then newred = 255
If newgrn > 255 Then newgrn = 255
If newblu > 255 Then newblu = 255

WritePixel(pix,newx+x+xx,(theight-tempix.height)+y+yy,ToRGBA(newred,newgrn,newblu,255))

EndIf
Next
Next

EndIf
EndIf
newx = newx + tempix.width



Next


End Function

Function RGBA_Red%(rgba%)
Return (rgba Shr 16) & $FF
End Function
             
Function RGBA_Green%(rgba%)
Return (rgba Shr 8) & $FF
End Function

Function RGBA_Blue%(rgba%)
Return rgba & $FF
End Function

Function RGBA_alpha%(rgba%)
Return (rgba% Shr 24) & $FF
End Function

Function ToRGBA%(r%,g%,b%,a%)
'return (a << 24) | (r << 16) | (g << 8) | (b);
Return ((A Shl 24) | (R Shl 16) | (G Shl 8) | B)
End Function

Comments :


DreamLoader(Posted 1+ years ago)

 really nice,thanks for share!


Ked(Posted 1+ years ago)

 Awesome! I wonder why I haven't seen this before...EDIT: Nevermind. Doesn't work too well.


DreamLoader(Posted 1+ years ago)

 the color part doesn't workalso the alpha code doesn't work!you can modify this a little to draw the alpha text


klepto2(Posted 1+ years ago)

 try this:

Code Select Expand

Function drawpixmaptext(Text:String, pix:TPixmap, x:Int, y:Int, font:TImageFont, RED:Int = 255, Green:Int = 255, Blue:Int = 255)
Local newx:Int
Local theight:Int

IF font = Null then return

theight = font.Height()
For Local I:Int = 0 To Text.Length - 1

Local tempText:String = Mid(Text, I + 1, 1)
Local asciiVal:Int = Asc(tempText)
Local n:Int = font.CharToGlyph(asciiVal)
If n<0 Continue

Local glyph:TImageGlyph = font.LoadGlyph(n)
Local image:TImage = glyph._image
Local tempix:TPixmap
If image <> Null
tempix = LockImage(image)
UnlockImage(glyph._image)

If tempix

Local tx:Float = glyph._x
Local ty:Float = glyph._y



For Local yy:Int = 0 To glyph._h - 1'Height - 1
For Local xx:Int = 0 To glyph._w - 1'tempix.width - 1
If newx + x + xx + tx < pix.width And y + yy + ty < pix.Height Then

Local Alpha:Float = RGBA_alpha(ReadPixel(tempix, xx, yy))
Local alphan:Float = Float(Alpha:Float / 255.0)
Local anti:Float = 1.0 - alphan:Float
Local ured:Int = RED'RGBA_Red(ReadPixel(tempix, xx, yy))
Local ugrn:Int = Green'RGBA_Green(ReadPixel(tempix, xx, yy))
Local ublu:Int = Blue'RGBA_Blue(ReadPixel(tempix, xx, yy))

Local newred:Int = ((RGBA_Red(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ured * alphan:Float))
Local newgrn:Int = ((RGBA_Green(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ugrn * alphan:Float))
Local newblu:Int = ((RGBA_Blue(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (ublu * alphan:Float))
Local newAlpha:Int = ((RGBA_alpha(ReadPixel(pix, newx + x + xx + tx, ty + y + yy)) * anti) + (Alpha * alphan:Float))

If newred > 255 Then newred = 255
If newgrn > 255 Then newgrn = 255
If newblu > 255 Then newblu = 255
If newAlpha > 255 Then newAlpha = 255

WritePixel(pix, newx + x + xx + tx, y + yy + ty, ToRGBA(newred, newgrn, newblu, newAlpha))
EndIf
Next
Next



EndIf
EndIf


newx = newx + glyph.Advance()

Next


End Function

Function RGBA_Red:Int(rgba:Int)
Return (rgba Shr 16) & $FF
End Function
             
Function RGBA_Green:Int(rgba:Int)
Return (rgba Shr 8) & $FF
End Function

Function RGBA_Blue:Int(rgba:Int)
Return rgba & $FF
End Function

Function RGBA_alpha:Int(rgba:Int)
Return (rgba:Int Shr 24) & $FF
End Function

Function ToRGBA:Int(r:Int, g:Int, b:Int, a:Int)
'return (a << 24) | (r << 16) | (g << 8) | (b);
Return ((A Shl 24) | (R Shl 16) | (G Shl 8) | B)
End Function

Function TextWidthFont:Int(Text:String, Font:TImageFont)
Local width:Int = 0
For Local n:Int = 0 Until Text.Length
Local I:Int = font.CharToGlyph(Text[n])
If I < 0 Continue
width:+font.LoadGlyph(I).Advance()
Next
Return width
End Function
Its fixed version of the above:-Alpha support-Color Support-Correct Spacing for chars (using glyph details)-Extra Function to retrieve the TextWidth without the need to have a graphiccontext


DreamLoader(Posted 1+ years ago)

 got an error :pixmap coordinates out of bounds!i used a unicode truetype font for testing.also i used a "simple" version to show the original text:Function drawpixmaptext1(text$,pix:TPixmap,x,y,font:TImageFont)  Local newx  Local theight               theight = font.Height()         'Print theight         For i = 0 To text.length-1         tempText$ = Mid(text, i+1, 1)         asciiVal = Asc(tempText)         n=font.CharToGlyph( asciiVal )         If n<0 Continue                  glyph:TImageGlyph = font.LoadGlyph(n)         image:TImage=glyph._image         'Print "Draw "+Chr(asciiVal)         If image <> Null         tempix:TPixmap = LockImage(image)         UnlockImage(glyph._image)         If tempix                           For yy = 0 To tempix.height-1                  For xx = 0 To tempix.width-1                     If newx+x+xx < pix.width And y+yy < pix.height                         Local rgba:Int=ReadPixel(tempix,xx,yy)                        WritePixel(pix,newx+x+xx,(theight-tempix.height)+y+yy,rgba)                        EndIf                  Next               Next                        EndIf         EndIf         newx =    newx + tempix.width      NextEnd Function


klepto2(Posted 1+ years ago)

 oh yeah, i missed the glyph height and width in the checking for pixmap bounds. Otherwise it should work. I have tested it with various ttfs and also had written the whole maxide src to one pixmap. (time < 5sec)


DreamLoader(Posted 1+ years ago)

 kelpto2, can you modify your code above?


markcw(Posted 1+ years ago)

 I think he did.Some test code.

Code Select Expand

'Rem
Strict

Graphics 640,480,0

Local pixmap:TPixmap = CreatePixmap(128, 128, PF_RGBA8888)
Local font:TImageFont = TImageFont.CreateDefault()

DrawPixmapText("R", pixmap, 10, 10, font, 255, 0, 0)
DrawPixmapText(" A", pixmap, 10, 10, font, 255, 127, 0)
DrawPixmapText("  I", pixmap, 10, 10, font, 255, 255, 0)
DrawPixmapText("   N", pixmap, 10, 10, font, 0, 255, 0)
DrawPixmapText("    B", pixmap, 10, 10, font, 0, 255, 255)
DrawPixmapText("     O", pixmap, 10, 10, font, 255, 0, 255)
DrawPixmapText("      W", pixmap, 10, 10, font, 127, 0, 255)
DrawPixmapText("        :)", pixmap, 10, 10, font, 255, 255, 255)

While Not (KeyDown(KEY_ESCAPE) Or AppTerminate())
Cls
DrawPixmap(pixmap,0,0)
Flip
Wend
'EndRem


DreamLoader(Posted 1+ years ago)

 works fine now,thanks [/i]