DrawTextAdvanced() - Auto-Wrap text, add outline, rotate ...

[c4s]

My goal was to combine several codes I had for wrapping a text, adding an outline etc. into one single procedure and out came this. It should work on all systems because just native PureBasic commands are used. Also Unicode shouldn't be any problem. What else to say? Well, take a look at the example to see for yourself. Here is the complete code:

Code: Select all

; "DrawTextAdvanced" by c4s  (v1.13, 06.02.2011)
;
;
;- Description
; It creates a transparent image with the specified text. Optionally the text can be
; wrapped if a defined width has been reached or #LF$ was found. The whole procedure
; will be configurated via the following structure. All settings, except the text of
; course, are optional and the returning value will be the newly created image, see:
;
;
;- Options
; "Text.s"
;  The text that should be displayed. Use #LF$ as a line-break. Must be set!
; "TextColor.l"
;  RGBA color of the text.
;   Default: $FF000000 (fully visible black)
; "TextFontID.i"
;  FontID for the text.
;   Default: #PB_Default
;
; "Position.l"
;  Position of the text: Left, Right, Center.
;   Default: #DTA_PositionLeft
; "PositionWidth.l"
;  Define the width of the wrapping area. The text will wrap either if this width is
;  reached or an #LF$ character was found. Set it to "0" to just watch for the #LF$.
;  Note that it will be filled with the width of the final created image anyway.
;   Default: 0
; "PositionHeight.l"
;  This is ignored but will be filled with the height of the created image.
;   Default: 0
; "PositionAngle.f"
;  Rotate the text counter-clockwise in degrees. A value of "0.0" means no rotation.
;   Default: 0.0
;
; "Wrap.l"
;  #DTA_True to enable, #DTA_False to disable the text wrapping.
;   Default: #DTA_True
; "WrapSpacing.l"
;  Space between each text line in pixels. Can be positive or negative.
;   Default: 0
;
; "Outline.l"
;  #DTA_True to enable, #DTA_False to disable the outline around the text.
;   Default: #DTA_False
; "OutlineColor.l"
;  RGBA color of the outline.
;   Default: $FFFFFFFF (fully visible white)
; "OutlineSize.l"
;  Size in pixels of the outline.
;   Default: 1
;
; "ImageNr.l"
;  Works as every (image) function of PureBasic. Either use a constant value or
;  #PB_Any. The procedure will then return the new image number or true/false.
;   Default: #PB_Any
; "ImageSimulate.l"
;  When it's #DTA_True, no image will be created. This could be useful if just the
;  returned width and height are needed.
;   Default: #DTA_False
;
;
;- Notes
; ·Important: The options in the passed structure will be corrected and replaced if
;  they are wrong, so reusing it might not work.
; ·Sometimes the text might be cropped because TextWidth() returns a wrong value. Is
;  this a bug of PureBasic?
; ·Outline doesn't work if color of text is $00000000 or both colors are the same,
;  however a primitive workaround is included.
; ·An ImageNr of 0 doesn't work because it will get the default #PB_Any.



EnableExplicit


#DTA_True = 1
#DTA_False = -1
#DTA_PositionLeft = 1
#DTA_PositionRight = 2
#DTA_PositionCenter = 3

Structure DrawTextAdvanced_Options
	Text.s
	TextColor.l
	TextFontID.i
	Position.l
	PositionWidth.l
	PositionHeight.l
	PositionAngle.f
	Wrap.l
	WrapSpacing.l
	Outline.l
	OutlineColor.l
	OutlineSize.l
	ImageNr.l
	ImageSimulate.l
EndStructure

Structure DrawTextAdvanced_Line
	Text.s
	X.l
	Y.l
	Width.l
	Height.l
EndStructure


Macro Center(Value, Max)
	(((Max) - (Value)) / 2)
EndMacro

Macro MidFast(String, StartPos, Length)
	PeekS(@String + ((StartPos - 1) * SizeOf(Character)), Length)
EndMacro

Procedure DrawTextAdvanced(*Options.DrawTextAdvanced_Options)
	Protected NewList Lines.DrawTextAdvanced_Line()
	Protected WrapCPosition, WrapC.s, WrapWord.s
	Protected WrapLineTemp1.s, WrapLineTemp1Width, WrapLineTemp2.s, WrapLineTemp2Width
	Protected WrapLine.s, WrapLineWidth, WrapLineHeight
	Protected LineWidthMax, LineHeightMax, LineYTemp
	Protected RotateOldX, RotateOldY, RotateOldWidth, RotateOldHeight
	Protected RotateSinR.f, RotateCosR.f, RotateX, RotateY
	Protected OutlineX, OutlineY, OutlineRangeUp, OutlineRangeDown, OutlineRangeRight
	Protected OutlineXScan, OutlineYScan, OutlineTrailingOffset, OutlineSkipped
	Protected ImageNr, ImageNrTemp

;{ Check, correct and set default options
;{ Text
	If Len(*Options\Text) = 0
		ProcedureReturn #False
	EndIf

	If *Options\TextColor = 0
		*Options\TextColor = $FF000000
	EndIf

	If *Options\TextFontID = 0
		*Options\TextFontID = #PB_Default
	EndIf
;}

;{ Position
	If *Options\Position <> #DTA_PositionLeft And *Options\Position <> #DTA_PositionRight And *Options\Position <> #DTA_PositionCenter
		*Options\Position = #DTA_PositionLeft
	EndIf

	If *Options\PositionWidth < 1
		*Options\PositionWidth = 0
	EndIf

	If *Options\PositionHeight < 1
		*Options\PositionHeight = 0
	EndIf

	If *Options\PositionAngle = 0
		*Options\PositionAngle = 0.0
	EndIf
;}

;{ Wrap
	If *Options\Wrap <> #DTA_True And *Options\Wrap <> #DTA_False
		*Options\Wrap = #DTA_True
	EndIf

	If *Options\WrapSpacing = 0
		*Options\WrapSpacing = 0
	EndIf
;}

;{ Outline
	If *Options\Outline <> #DTA_True And *Options\Outline <> #DTA_False
		*Options\Outline = #DTA_False
	EndIf

	If *Options\OutlineColor = 0
		*Options\OutlineColor = $FFFFFFFF
	EndIf

	If *Options\OutlineSize < 1
		*Options\OutlineSize = 1
	EndIf
;}

;{ Image
	If *Options\ImageNr = 0
		*Options\ImageNr = #PB_Any
	EndIf

	If *Options\ImageSimulate <> #DTA_True And *Options\ImageSimulate <> #DTA_False
		*Options\ImageSimulate = #DTA_False
	EndIf
;}


	; Workaround (Otherwise Outline wouldn't work):
	If *Options\Outline = #DTA_True
		If Alpha(*Options\TextColor) = $00
			*Options\TextColor | $01000000
		EndIf
		If *Options\TextColor = *Options\OutlineColor
			*Options\OutlineColor - 1
		EndIf
	EndIf
;}


;{ Analyze text: Lines, Dimension, Position
;{ Get every line and their width & height
	ImageNrTemp = CreateImage(#PB_Any, 1, 1)  ; Needed for TextWidth() & TextHeight()
	If ImageNrTemp
		If StartDrawing(ImageOutput(ImageNrTemp))
			DrawingFont(*Options\TextFontID)

			Repeat
;{			Get line
				WrapLine = "" : WrapLineWidth = 0 : WrapLineHeight = 0

				If *Options\Wrap = #DTA_True
;{				Wrap
					Repeat
;{					Get word
						WrapWord = "" : WrapC = ""

						Repeat
							WrapWord + WrapC
							WrapCPosition + 1
							WrapC = MidFast(*Options\Text, WrapCPosition, 1)
						Until WrapC = " " Or WrapC = #LF$ Or WrapC = ""
;}

						WrapLineTemp1 + WrapWord
						WrapLineTemp1Width = TextWidth(WrapLineTemp1)

						If *Options\PositionWidth <> 0 And WrapLineTemp1Width > *Options\PositionWidth And WrapLineTemp2  ; Break if width is defined and has been reached
							WrapLine = WrapLineTemp2
							WrapLineWidth = WrapLineTemp2Width
							WrapLineHeight = TextHeight(WrapLineTemp2)
							WrapLineTemp1 = WrapWord  ; Add "wrapped" word to next temp line
							WrapLineTemp2 = ""
							WrapC = " "  ; Don't go out of loop
							WrapCPosition - 1  ; Do the previous step again
							Break
						ElseIf WrapC = #LF$ Or WrapC = ""  ; Regular line break
							WrapLine = WrapLineTemp1
							WrapLineWidth = WrapLineTemp1Width
							WrapLineHeight = TextHeight(WrapLineTemp1 + #LF$)
							WrapLineTemp1 = ""  ; Clear temp line
							WrapLineTemp2 = ""
							;WrapC = WrapC
							;WrapCPosition = WrapCPosition
							Break
						Else
							WrapLineTemp1 + " "
						EndIf

						WrapLineTemp2 = WrapLineTemp1
						WrapLineTemp2Width = WrapLineTemp1Width
					ForEver
;}
				Else
;{				Normal
					WrapLine = *Options\Text
					WrapLineWidth = TextWidth(WrapLine)
					WrapLineHeight = TextHeight(WrapLine)
;}
				EndIf
;}

				; Add line to list:
				If AddElement(Lines())
					With Lines()
						\Text = WrapLine
						\Width = WrapLineWidth
						\Height = WrapLineHeight
					EndWith
				EndIf
			Until WrapC = ""  ; No characters left in "Get line" loop?

			StopDrawing()
		EndIf
		FreeImage(ImageNrTemp)
	EndIf
;}

;{ Get dimension of whole block (all lines)
	ForEach Lines()
		If Lines()\Width > LineWidthMax : LineWidthMax = Lines()\Width : EndIf
		LineHeightMax + Lines()\Height + *Options\WrapSpacing
	Next
	*Options\PositionWidth = LineWidthMax
	*Options\PositionHeight = LineHeightMax - *Options\WrapSpacing

	If *Options\Outline = #DTA_True
		*Options\PositionWidth + (*Options\OutlineSize * 2)
		*Options\PositionHeight + (*Options\OutlineSize * 2)
	EndIf
;}

;{ Set position of each line
	ForEach Lines()
		Select *Options\Position
			Case #DTA_PositionLeft
				Lines()\X = 0
				If *Options\Outline = #DTA_True : Lines()\X + *Options\OutlineSize : EndIf
			Case #DTA_PositionRight
				Lines()\X = *Options\PositionWidth - Lines()\Width
				If *Options\Outline = #DTA_True : Lines()\X - *Options\OutlineSize : EndIf
			Case #DTA_PositionCenter
				Lines()\X = Round(Center(Lines()\Width, *Options\PositionWidth), #PB_Round_Nearest)
		EndSelect

		Lines()\Y = LineYTemp
		If *Options\Outline = #DTA_True : Lines()\Y + *Options\OutlineSize : EndIf
		LineYTemp + Lines()\Height + *Options\WrapSpacing
	Next
;}

	If *Options\PositionAngle <> 0.0
;{	Apply rotation to block dimension and line position
		; Based on code by STARGÅTE (http://www.purebasic.fr/german/viewtopic.php?p=285528#p285528)

		RotateSinR = Sin(Radian(*Options\PositionAngle))
		RotateCosR = Cos(Radian(*Options\PositionAngle))

		; Correct dimension of block:
		RotateOldWidth = *Options\PositionWidth
		RotateOldHeight = *Options\PositionHeight
		*Options\PositionWidth = Abs(RotateCosR * RotateOldWidth) + Abs(RotateSinR * RotateOldHeight)
		*Options\PositionHeight = Abs(-RotateSinR * RotateOldWidth) + Abs(RotateCosR * RotateOldHeight)

		; Correct position of each line:
		If RotateCosR < 0
			RotateX - (RotateCosR * RotateOldWidth)
		EndIf
		If RotateSinR < 0
			RotateX - (RotateSinR * RotateOldHeight)
		EndIf
		If RotateSinR > 0
			RotateY + (RotateSinR * RotateOldWidth)
		EndIf
		If RotateCosR < 0
			RotateY - (RotateCosR * RotateOldHeight)
		EndIf
		ForEach Lines()
			RotateOldX = Lines()\X
			RotateOldY = Lines()\Y
			Lines()\X = RotateX + ((RotateCosR * RotateOldX) + (RotateSinR * RotateOldY))
			Lines()\Y = RotateY + ((-RotateSinR * RotateOldX) + (RotateCosR * RotateOldY))
		Next
;}
	EndIf


	If *Options\PositionWidth < 1 Or *Options\PositionHeight < 1 Or ListSize(Lines()) = 0  ; Something went wrong
		ProcedureReturn #False
	EndIf
;}

	If *Options\ImageSimulate = #DTA_True
		ProcedureReturn #True
	EndIf


;{ Create image
	ImageNr = CreateImage(*Options\ImageNr, *Options\PositionWidth, *Options\PositionHeight, 32 | #PB_Image_Transparent)
	If *Options\ImageNr <> #PB_Any : ImageNr = *Options\ImageNr : EndIf
	If ImageNr
		If StartDrawing(ImageOutput(ImageNr))
			DrawingMode(#PB_2DDrawing_Transparent | #PB_2DDrawing_AlphaBlend)

;{		Draw text
			DrawingFont(*Options\TextFontID)

			ForEach Lines()
				If *Options\PositionAngle = 0.0
					DrawText(Lines()\X, Lines()\Y, Lines()\Text, *Options\TextColor)
				Else
					DrawRotatedText(Lines()\X, Lines()\Y, Lines()\Text, *Options\PositionAngle, *Options\TextColor)
				EndIf
			Next
;}

			If *Options\Outline = #DTA_True
;{			Draw outline
				; Based on code by Demivec  (http://www.purebasic.fr/english/viewtopic.php?p=345086#p345086)
				; (Also check out his much faster procedure: http://www.purebasic.fr/english/viewtopic.php?p=345320#p345320)

				While OutlineY < *Options\PositionHeight
					; Set ranges:
					OutlineRangeUp = OutlineY - *Options\OutlineSize
					If OutlineRangeUp < 0 : OutlineRangeUp = 0 : EndIf
					OutlineRangeDown = OutlineY + *Options\OutlineSize
					If OutlineRangeDown > *Options\PositionHeight - 1 : OutlineRangeDown = *Options\PositionHeight - 1 : EndIf

					OutlineSkipped = 0
					OutlineX = 0
					Repeat
						If Point(OutlineX, OutlineY) = *Options\TextColor

							If OutlineSkipped > *Options\OutlineSize : OutlineSkipped = *Options\OutlineSize : EndIf

							OutlineTrailingOffset = 0
							Repeat
								; Columns to be filled are always left of current column
								For OutlineXScan = OutlineX - OutlineSkipped To OutlineX - OutlineTrailingOffset  ; Include current column if not trailing border
									; Plot scanline pixel if not in current column (x):
									If OutlineXScan <> OutlineX
										If Point(OutlineXScan, OutlineY) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineY, *Options\OutlineColor) : EndIf
									EndIf

									; Check up:
									For OutlineYScan = OutlineY - 1 To OutlineRangeUp Step -1
										If Point(OutlineXScan, OutlineYScan) <> *Options\TextColor
											If Point(OutlineXScan, OutlineYScan) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineYScan, *Options\OutlineColor) : EndIf
										EndIf
									Next

									; Check down:
									For OutlineYScan = OutlineY + 1 To OutlineRangeDown
										If Point(OutlineXScan, OutlineYScan) <> *Options\TextColor
											If Point(OutlineXScan, OutlineYScan) <> *Options\OutlineColor : Plot(OutlineXScan, OutlineYScan, *Options\OutlineColor) : EndIf
										EndIf
									Next
								Next

								If OutlineTrailingOffset
									OutlineX - 1  ; Adjust loop variable for next unscanned column
									Break
								EndIf

								; Check next (right) columns:
								OutlineRangeRight = OutlineX + *Options\OutlineSize
								If OutlineRangeRight > *Options\PositionWidth - 1
									OutlineRangeRight = *Options\PositionWidth - 1
								EndIf

								OutlineSkipped = 0
								OutlineTrailingOffset = 1
								For OutlineXScan = OutlineX + 1 To OutlineRangeRight
									If Point(OutlineXScan, OutlineY) = *Options\TextColor  ; Found a new current column
										OutlineTrailingOffset = 0
										Break
									Else
										OutlineSkipped + 1
									EndIf
								Next

								If OutlineSkipped <> 0
									OutlineX + OutlineSkipped + 1
								EndIf
							Until OutlineSkipped = 0

						Else
							OutlineSkipped + 1
						EndIf

						OutlineX + 1
					Until OutlineX = *Options\PositionWidth
					OutlineY + 1
				Wend
;}
			EndIf

			StopDrawing()
		EndIf
	EndIf
;}

	ProcedureReturn ImageNr
EndProcedure



;- Example
;{
Enumeration
	#Window
	#ImageGadget
	#Image
	#Option1
	#Option2
	#Option3
	#Option4
	#Font
	#Timer
EndEnumeration

#Width = 400
#Height = 400

#Text = "Test Line 1" + #LF$ + "Test test Line 2" + #LF$ + "Test test test Line 3"

LoadFont(#Font, "Arial", 24, #PB_Font_Bold | #PB_Font_HighQuality | #PB_Font_Italic)

Procedure CreateExampleImage1()
	Protected  DTAO.DrawTextAdvanced_Options, DTAImageNr, X, Y
	Static InitOptions
	Static Color, ColorStep, Angle.f, Spacing, SpacingStep

	; "Animate" some options:
	If InitOptions = #False
		InitOptions = #True
		Color = $80 : ColorStep = 2
		Angle = 0
		Spacing = 0 : SpacingStep = 1
	EndIf

	Color + ColorStep
	If Color >= $FD : ColorStep = -2 : ElseIf Color <= $02 : ColorStep = 2 : EndIf

	Angle - 2

	Spacing + SpacingStep
	If Spacing >= 15 : SpacingStep = -1 : ElseIf Spacing <= -10 : SpacingStep = 1 : EndIf


	; Set up the options:
	With DTAO
		\Text = #Text
		\TextColor = RGBA(Color / 2, Color / 2, $FF, $FF - Color)
		\TextFontID = FontID(#Font)
		\Position = #DTA_PositionCenter
		\PositionAngle = Angle
		\WrapSpacing = Spacing
		\Outline = #DTA_True
		\OutlineColor = RGBA(Color, Color, Color, $AA)
		\OutlineSize = 2
	EndWith


	; Create DTA image and draw it on #Image:
	DTAImageNr = DrawTextAdvanced(@DTAO)
	If DTAImageNr
		CreateImage(#Image, #Width, #Height)
		StartDrawing(ImageOutput(#Image))
			; Draw background gradient:
			DrawingMode(#PB_2DDrawing_Gradient)
			CircularGradient(#Width / 2, #Height / 2, #Width / 2)
			GradientColor(0.0, $F5CFBD)
			GradientColor(1.0, $E9926B)
			Box(0, 0, #Width, #Height)

			; Draw centered DTA image:
			X = Center(DTAO\PositionWidth, #Width) : Y = Center(DTAO\PositionHeight, #Height)
			DrawAlphaImage(ImageID(DTAImageNr), X, Y)
		StopDrawing()

		FreeImage(DTAImageNr)
	EndIf
EndProcedure

Procedure CreateExampleImage2()
	Protected  DTA1O.DrawTextAdvanced_Options, DTA1ImageNr, DTA2O.DrawTextAdvanced_Options, DTA2ImageNr, X, Y
	Static InitOptions
	Static Angle.f, AngleStep

	; "Animate" some options:
	If InitOptions = #False
		InitOptions = #True
		Angle = 0 : AngleStep = 0.5
	EndIf

	Angle + AngleStep
	If Angle >= 10 : AngleStep = -0.5 : ElseIf Angle <= -10 : AngleStep = 0.5 : EndIf


	; Set up the options:
	With DTA1O
		\Text = #Text
		\TextColor = $FF202020
		\TextFontID = FontID(#Font)
		\Position = #DTA_PositionCenter
		\PositionAngle = Angle
	EndWith

	With DTA2O
		\Text = #Text
		\TextColor = $60202020
		\TextFontID = FontID(#Font)
		\Position = #DTA_PositionCenter
		\PositionAngle = Angle
		\Outline = #DTA_True
		\OutlineColor = $30202020
	EndWith


	; Create DTA images and draw it on #Image:
	DTA1ImageNr = DrawTextAdvanced(@DTA1O)
	If DTA1ImageNr
		DTA2ImageNr = DrawTextAdvanced(@DTA2O)
		If DTA2ImageNr
			CreateImage(#Image, #Width, #Height)
			StartDrawing(ImageOutput(#Image))
				; Draw background gradient:
				DrawingMode(#PB_2DDrawing_Gradient)
				CircularGradient(#Width / 2 + 5, #Height / 2 + 10, #Width / 2)
				GradientColor(0.0, $1381C7)
				GradientColor(1.0, $000000)
				Box(0, 0, #Width, #Height)

				; Draw centered DTA images:
				X = Center(DTA1O\PositionWidth, #Width) : Y = Center(DTA1O\PositionHeight, #Height)
				DrawAlphaImage(ImageID(DTA2ImageNr), X + 1, Y + 2)  ; First the "shadow" image
				DrawAlphaImage(ImageID(DTA1ImageNr), X, Y)
			StopDrawing()

			FreeImage(DTA2ImageNr)
		EndIf
		FreeImage(DTA1ImageNr)
	EndIf
EndProcedure

Procedure CreateExampleImage3()
	Protected  DTAO.DrawTextAdvanced_Options, DTAImageNr, X, Y
	Static InitOptions
	Static Width, WidthStep

	; "Animate" some options:
	If InitOptions = #False
		InitOptions = #True
		Width = 200 : WidthStep = -2
	EndIf

	Width + WidthStep
	If Width > 350 : WidthStep = -2 : ElseIf Width <= 2 : WidthStep = 2 : EndIf


	; Set up the options:
	With DTAO
		\Text = #Text
		\TextFontID = FontID(#Font)
		\PositionWidth = Width
	EndWith


	; Create DTA image and draw it on #Image:
	DTAImageNr = DrawTextAdvanced(@DTAO)
	If DTAImageNr
		CreateImage(#Image, #Width, #Height)
		StartDrawing(ImageOutput(#Image))
			; Background:
			Box(0, 0, #Width, #Height, $FFFFFF)

			; Draw line, info text, DTA image and its bounding box:
			X = 40 : Y = 50
			Box(X + Width, 0, 4, #Height, $808080)
			DrawingMode(#PB_2DDrawing_Transparent)
			DrawText(0, 0, "Input: " + Str(Width) + "x ?", $808080)
			DrawText(0, 20, "Result: " + Str(DTAO\PositionWidth) + "x" + Str(DTAO\PositionHeight), $808080)
			DrawAlphaImage(ImageID(DTAImageNr), X, Y)
			DrawingMode(#PB_2DDrawing_Outlined)
			Box(X - 1, Y - 1, DTAO\PositionWidth + 2, DTAO\PositionHeight + 2, $808080)
		StopDrawing()

		FreeImage(DTAImageNr)
	EndIf
EndProcedure


If OpenWindow(#Window, #PB_Ignore, #PB_Ignore, #Width + 20, #Height + 50, "DrawTextAdvanced Examples", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	ImageGadget(#ImageGadget, 10, 10, #Width, #Height, 0)
	OptionGadget(#Option1, 10, #Height + 20, 90, 20, "Example 1")
	 SetGadgetState(#Option1, #True)
	OptionGadget(#Option2, 110, #Height + 20, 90, 20, "Example 2")
	OptionGadget(#Option3, 210, #Height + 20, 90, 20, "Example 3")
	OptionGadget(#Option4, 310, #Height + 20, 90, 20, "Pause")

	AddWindowTimer(#Window, #Timer, 50)

	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Timer
				If EventTimer() = #Timer
					Select (GetGadgetState(#Option1) * 1) + (GetGadgetState(#Option2) * 2) + (GetGadgetState(#Option3) * 3)
						Case 1 : CreateExampleImage1()
						Case 2 : CreateExampleImage2()
						Case 3 : CreateExampleImage3()
					EndSelect
					SetGadgetState(#ImageGadget, ImageID(#Image))
				EndIf
			Case #PB_Event_CloseWindow
				Break
		EndSelect
	ForEver
EndIf
;}

Changelog:
1.13 - 06.02.2011
- Changed: Maybe a bit faster text analyzing by using MidFast()
- Changed: Renamed WrapMargin to WrapSpacing
- Fixed: Too small WrapSpacing caused error

1.10 - 30.01.2011
- Added: 2 more examples that can easily be switched
- Changed: Increased speed of outline code (now uses Demivec's first solution)
- Fixed: If a width was defined the resulting dimension was too big

1.00 - 27.01.2011
Initial release


So I hope this is useful to some of you - Happy coding!

[Nituvious]

That is really cool! It was very fast even with debugger enabled and having a CPU/RAM intensive program running as well. Thank you for the code!

[+18]

fantastic! thanks

[Demivec]

- The text analyzing and outline part are rather slow (especially the outline one!). If you have any optimizations, please let me know.

Here is an improvement for outlining that I wrote. It should speed things up more than a few times over with very noticeable improvements when the outline width is increased. To make things simple I've coded it as a separate procedure.

Here's the code:

Code: Select all

;Draw a border of width 'owidth' using color 'ocol' around pixels of color 'dcol'
;Before calling procedure an output must be selected with StartDrawing().
;(x1,y1) (x2,y2) define a rectangle to search and where drawing occurs.
Procedure outlineDrawing(x1, y1, x2, y2, owidth, ocol, dcol)
  Protected iw = x2 - x1 + 1, ih = y2 - y1 + 1
  Protected upRange, downRange, rightRange, trailingBorderOffset, skipped, x, y, xScan, yScan
  
  ;vertical
  ;y = 0 
  ;repeat
  While y < ih
    ;set ranges
    upRange = y - owidth
    If upRange < 0
      upRange = 0
    EndIf 
    downRange = y + owidth
    If downRange > ih - 1
      downRange = ih - 1
    EndIf 
    
    ;horizontal
    skipped = 0
    x = 0 
    Repeat 
      If Point(x, y) = dcol
        
        If skipped > owidth
          skipped = owidth
        EndIf
        
        trailingBorderOffset = 0
        Repeat 
          ;columns to be filled are always to the left of the current column
          For xScan = x - skipped To x - trailingBorderOffset ;include current column if not a trailing border
            ;plot scanline pixel if not in the current column (x)
            If xScan <> x
              Plot(xScan, y, ocol)
            EndIf 
            
                        ;check up
            For yScan = y - 1 To upRange Step -1
              If Point(xScan, yScan) <> dcol
                Plot(xScan, yScan, ocol)
              EndIf 
            Next 
            
            ;check down
            For yScan = y + 1 To downRange
              If Point(xScan, yScan) <> dcol
                Plot(xScan, yScan, ocol)
              EndIf 
            Next 
          Next
          
          If trailingBorderOffset
            x - 1 ;adjust loop variable for the next unscanned column
            Break ;exit Repeat/Until
          EndIf 
          
          ;check next (right) columns
          rightRange = x + owidth
          If rightRange > iw - 1
            rightRange = iw - 1
          EndIf 
          
          skipped = 0
          trailingBorderOffset = 1
          For xScan = x + 1 To rightRange
            If Point(xScan, y) = dcol
              ;found a new current column
              trailingBorderOffset = 0
              Break 
            Else
              skipped + 1
            EndIf 
          Next
          
          If skipped <> 0
            x + skipped + 1
          EndIf 
        Until skipped = 0
        
      Else
        skipped + 1
      EndIf 
      
      x + 1
    Until x = iw
    y + 1 
    ;Until y = ih
  Wend
  
EndProcedure

To use it in your code, place the procedure outlineDrawing() before your procedure DrawTextAdvanced() and replace the following code lines in DrawTextAdvanced() starting at about line 368 :

Code: Select all

If *Options\Outline = #DTA_True
  ;{         Draw outline
  ; Based on code by Trond (http://www.purebasic.fr/english/viewtopic.php?p=314663#p314663)
  For OutlineY1 = 0 To *Options\PositionHeight - 1
    For OutlineX1 = 0 To *Options\PositionWidth - 1
      If Point(OutlineX1, OutlineY1) <> *Options\textColor
        
        For OutlineY2 = -*Options\OutlineSize To *Options\OutlineSize
          OutlineY = OutlineY1 + OutlineY2
          If OutlineY >= 0 And OutlineY < *Options\PositionHeight
            
            For OutlineX2 = -*Options\OutlineSize To *Options\OutlineSize
              OutlineX = OutlineX1 + OutlineX2
              If OutlineX >= 0 And OutlineX < *Options\PositionWidth
                If Point(OutlineX, OutlineY) = *Options\textColor
                  Plot(OutlineX1, OutlineY1, *Options\OutlineColor)
                  Break 2
                EndIf
              EndIf
            Next
            
          EndIf
        Next
        
      EndIf
    Next
  Next
  ;}
EndIf

with:

Code: Select all

If *Options\Outline = #DTA_True
  ;{         Draw outline
  outlineDrawing(0,0,*Options\PositionWidth - 1, *Options\PositionHeight - 1, *Options\OutlineSize, *Options\OutlineColor,*Options\textColor)
  ;}
EndIf

@Edit: Made code correction to outlineDrawing() to more properly handle using an alpha component to the outline color. The change resulted in a loss of code speed. The outlineDrawing() procedure is still faster than the original solution it replaced though.

[c4s]

Thank you Demivec, I just tested it and it really is a lot faster. However there seem to be something wrong: Try it with an OutlineSize of 10 and more transparency for the OutlineColor. You'll see that there is no clear outline and alpha doesn't seem to work properly. Do you know were the problem is?

[Demivec]

I am looking at the problem now, I discovered it while using a large outline also. A quick fix can be made which makes a slower result (about 1.5x longer). As you noted, if alpha is not used it doesn't manifest itself. I will determine whether a better fix can be implemented. Stay tuned ...

[WilliamL]

Works fine on my Mac! Very nice.

[c4s]

@WilliamL
Thank you, that's good news.

@Demivec
I'm interested in it. Would be great if you find a proper solution.

[Demivec]

@c4s: I made a code correction to outlineDrawing() in the previous post to more properly handle using an alpha component with the outline color. The change resulted in a loss of code speed. The outlineDrawing() procedure is still faster than the original solution it replaced though.

I am going to work on a solution that uses a different approach and see if it results in any improvements. If so I'll post them (in a few days).

[c4s]

Demivec, that's great!
If you allow me to I'm going to add your code to the main one soon. I also have some kind of a bug-fix to add...

[Demivec]

If you allow me to I'm going to add your code to the main one soon. I also have some kind of a bug-fix to add...

That would be fine. Give me a few days to update it, I found some minor loopholes in the way it's coded. I coded it to take coordinates of a rectangle in it's parameters, but internally I treat it as if the upper-left coordinate is always (0,0).

[Demivec]

@c4s: Here is the new and improved outliner (mostly tested). It is 1.5 times as long as my previous code but more than 3 times faster (try it with an outline of 50 and an timer value of 5!).

It makes use of DrawBuffer(). It should be cross-platform; please let me know if it isn't. I verified it works with Pixel formats of BGR and Reverse_Y. Currently it assumes the draw buffer address is always available. Error handling can be done by adding a single line to call my previous method if there is no draw buffer address or to forgo the outline, depending on your wishes.

I matched it's results against the super slow method (thanks Trond) you first posted and they are a good match with no descernable differences in the results (except speed).

I use the draw buffer to scan the image but I use Plot() to draw the outline pixels. This makes it possible to use gradients and other effects from the 2D draw library.


The procedure can be basically dropped in as a replacement for my previous one.

Code: Select all

;Draw a border of width 'owidth' using color 'ocol' around pixels of color 'dcol'
;Before calling procedure an output must be selected with StartDrawing().
;Requires a 32-bit output.
;(x1,y1) (x2,y2) define a rectangle to search and where drawing occurs.
Procedure outlineDrawing(x1, y1, x2, y2, owidth, ocol, dcol)
  Protected iw = x2 - x1 + 1, ih = y2 - y1 + 1
  Protected i, maxLineIndex = owidth * 2 - 1
  Dim b_dcol(maxLineIndex, iw - 1)
  Dim b_ocol(maxLineIndex, iw - 1)
  Dim b_index(maxLineIndex)
  
  Protected *dbuf, dbufPixForm, dbufPitch, pitchIncrement = 4, isDbufReverseY
  *dbuf = DrawingBuffer()
  dbufPixForm = DrawingBufferPixelFormat()
  dbufPitch = DrawingBufferPitch()

  If Not (dbufPixForm & (#PB_PixelFormat_32Bits_RGB | #PB_PixelFormat_32Bits_BGR))
    ProcedureReturn
  EndIf 
  ;translate dcol value into correct format based on drawing buffer's pixel format
  If dbufPixForm & #PB_PixelFormat_32Bits_RGB
    dcol = Alpha(dcol) << 24 + Blue(dcol) << 16 + Green(dcol) << 8 + Red(dcol)
  Else
    dcol = Alpha(dcol) << 24 + Red(dcol) << 16 + Green(dcol) << 8 + Blue(dcol)
  EndIf 
  isDbufReverseY = dbufPixForm & #PB_PixelFormat_ReversedY

  ;initialize indexes
  For i = 0 To maxLineIndex
    b_index(i) = i
  Next 
  
  Protected scanLineCount, calcLineCount = -owidth, plotLineCount = -2 * owidth
  Protected upRange, downRange, rightRange, trailingBorderOffset, skipped, x, y, xScan, yScan
  Protected tempIndexValue
  ;vertical
  y = y1 
  While y <= y2 Or plotLineCount < ih
    
    If scanLineCount < ih
      ;scan line data
      *dbuf = DrawingBuffer() ;an assumption is made that the pitch and pixel format will be the same each time
      For x = x1 To x2
        If PeekI(*dbuf + dbufPitch * (y - y1) + x * pitchIncrement) = dcol
          b_dcol(b_index(maxLineIndex), x - x1) = #True
        Else 
          b_dcol(b_index(maxLineIndex), x - x1) = #False
        EndIf 
      Next
      scanLineCount + 1
    Else
      FillMemory(@b_dcol(b_index(maxLineIndex), 0), iw * SizeOf(Integer), #False, #PB_Integer)
    EndIf
    FillMemory(@b_ocol(b_index(maxLineIndex), 0), iw * SizeOf(Integer), #False, #PB_Integer)
    
    If calcLineCount >= 0 And calcLineCount < ih
      ;set ranges
      upRange = owidth - calcLineCount
      If upRange < 0
        upRange = 0
      EndIf 
      downRange = owidth + calcLineCount
      If downRange > maxLineIndex
        downRange = maxLineIndex
      EndIf

      ;horizontal
      skipped = 0
      x = 0 
      Repeat 
        If b_dcol(b_index(owidth), x)
          
          If skipped > owidth
            skipped = owidth
          EndIf
          
          trailingBorderOffset = 0
          Repeat 
            ;columns to be filled are always to the left of the current column
            For xScan = x - skipped To x - trailingBorderOffset ;include current column if not a trailing border
              ;mark pixel for plotting if not in the current column (x)
              If xScan <> x
                b_ocol(b_index(owidth), xScan) = #True
              EndIf 
              
              ;check up
              For yScan = owidth - 1 To upRange Step -1
                If b_dcol(b_index(yScan), xScan)
                  Break ;blocked
                Else
                  b_ocol(b_index(yScan), xScan) = #True
                EndIf 
              Next 
              
              ;check down
              For yScan = owidth + 1 To downRange
                If b_dcol(b_index(yScan), xScan)
                  Break ;blocked
                Else
                  b_ocol(b_index(yScan), xScan) = #True
                EndIf 
              Next 
            Next
            
            If trailingBorderOffset
              x - 1 ;adjust loop variable for the next unscanned column
              Break ;exit Repeat/Until
            EndIf 
            
            ;check next (right) columns
            rightRange = x + owidth
            If rightRange > iw - 1
              rightRange = iw - 1
            EndIf 
            
            skipped = 0
            trailingBorderOffset = 1
            For xScan = x + 1 To rightRange
              If b_dcol(b_index(owidth), xScan)
                ;found a new current column
                trailingBorderOffset = 0
                Break 
              Else
                skipped + 1
              EndIf 
            Next
            
            If skipped <> 0
              x + skipped + 1
            EndIf 
          Until skipped = 0
          
        Else
          skipped + 1
        EndIf 
        
        x + 1
      Until x = iw
    EndIf 
    calcLineCount + 1
    
    ;plot finished scanline
    If plotLineCount >= 0
      For x = x1 To x2
        If b_ocol(b_index(0), x - x1)
          If isDbufReverseY
            Plot(x, y2 - plotLineCount - 1, ocol)
          Else
            Plot(x, plotLineCount, ocol)
          EndIf 
        EndIf 
      Next 
    EndIf 
    plotLineCount + 1

    ;shift line indexes
    tempIndexValue = b_index(0)
    For i = 1 To maxLineIndex
      b_index(i - 1) = b_index(i)
    Next 
    b_index(maxLineIndex) = tempIndexValue
    
    y + 1 
  Wend
EndProcedure

Perhaps a way can be found to speed up the remaining code sections as well.

[Vera]

thanks for this thread

@ Demivec
Just dropping in to confirm: both your versions run fine on Linux Suse 11.1.

Although for my 'slower' PC I needed to encrease the timer up to 125 and more (none debug mode) to get moving pictures. (it still slightly jerks at 195) As for the speed, I don't get a real achievement with the 2nd version.

greetings ~ Vera

[Rook Zimbabwe]

Can this be used with OGRE?

[c4s]

Ok, I fixed a rather big error that caused the resulting dimension being to big if a width was defined. I also added 2 more examples and changed the outline code to Demivec's first solution (Thanks btw. - Although your second code looks even faster, its code was too big for my taste and the first one is quite fast as well )