Rectangular Text

BlitzPlus Forums/BlitzPlus Programming/Rectangular Text

Arem	(Posted 2005) [#1]

This is a little function I wrote to make a string of text be displayed at a certain location at a certain width. I have already chopped 9 lines off the code and was wondering if anybody could shorten it more.

Graphics 800,600,32,2

SetBuffer BackBuffer()
textsquare("This is the test of the new textsquare function and I need to ramble to make sure it works, so that is what I am doing. I hope it works well. Yeah. This is getting old. Yup. It is. Ok. That ought to be long enough now.",100,20,400)
Flip
WaitKey
End

Function textsquare(incoming$,x,y,width)
word$=""
tempx=x
tempy=y

While incoming$<>""
word$=""
While Right$(word$,1)<>" " And incoming$<>""
word$=word$+Left$(incoming$,1)
incoming$=Right$(incoming$,Len(incoming$)-1)
Wend

If tempx+StringWidth(word$)<width+x
Text(tempx,tempy,word$)
tempx=tempx+StringWidth(word$)
Else
tempx=x
tempy=tempy+FontHeight()
Text(tempx,tempy,word$)
tempx=tempx+StringWidth(word$)
End If
Wend
End Function

Good luck!

WolRon

(Posted 2005) [#2]

What are the forum codes?

Arem	(Posted 2005) [#3]

You misunderstand me, fool. I don't want to put code in a box for the forums. I want to do it in a graphics mode. I am currently writing a function that does it fully justified.

DredPirateRoberts

(Posted 2005) [#4]

not al that shorter line wise but its more efficient

;======================================================================
;
;======================================================================
Function TextSquare2 ( txt$, ix, iy, width )
Local offset
Local offset2
Local word$
Local x

While ( 1 )

   offset2 = Instr ( txt$, " ", offset )
   word$ = Mid$ ( txt$, offset, offset2-offset )

   Text ( x+ix, iy, word )

   If ( offset2 = 0 ) Then Exit

   x = x + StringWidth(word$) + StringWidth(" ")

   If ( x + StringWidth(word$) >= width )
       x = 0
       iy = iy + FontHeight()
   End If

   offset = offset2 + 1

Wend

End Function

Arem	(Posted 2005) [#5]

This code will justify it too!

Graphics 800,600,32,2

Type word
	Field content$
End Type

SetBuffer BackBuffer()
squaretext("This is a really long string to test my function.  I hope it works.  But it may not.  It ought to be long enough soon.  Like now.  That's probably good.  Ok.  Stopping the rambling.  Yup.  Ok.  I'm really done now.",0,0,100)
Flip
WaitKey
End

Function squaretext(incoming$,x,y,width)
	While incoming$<>""
		If StringWidth(incoming$)>width
			temp$=""
			tempnum=1
			
			While StringWidth(temp$)<width
				temp$=temp$+Mid$(incoming$,tempnum,1)
				tempnum=tempnum+1
			Wend
			
			While Not Right$(temp$,1)=" "
				temp$=Left$(temp$,Len(temp$)-1)
			Wend
			
			incoming$=Right$(incoming$,Len(incoming$)-Len(temp$))
			
			If Left$(incoming$,1)=" "
				incoming$=Right$(incoming$,Len(incoming$)-1)
			End If
			
			While Right$(temp$,1)=" "
				temp$=Left$(temp$,Len(temp$)-1)
			Wend
			
			justifiedtext(temp$,x,y,width)
		Else
			Text(x,y,incoming$)
			incoming$=""
		End If
		y=y+FontHeight()
	Wend
End Function

Function justifiedtext(curline$,x,y,width)
		tempx#=x
		spacing#=Float#(width)/Float#(Len(curline$))
	
		For a=1 To Len(curline$)
			Text(tempx,y,Mid$(curline$,a,1))
			tempx#=tempx#+spacing#
		Next
End Function

If you can shorten it, please do.

Arem	(Posted 2005) [#6]

Ok. This is as good as I can get it.

Function squaretext(incoming$,x,y,width)
	While incoming$<>""
		If StringWidth(incoming$)>width
			curline$=""
			
			While StringWidth(curline$)<width
				curline$=curline$+Mid$(incoming$,Len(curline$)+1,1)
			Wend
			
			While Not Right$(curline$,1)=" "
				curline$=Left$(curline$,Len(curline$)-1)
			Wend
			
			incoming$=Trim$(Right$(incoming$,Len(incoming$)-Len(curline$)))
			curline$=Trim$(curline$)
			spacing#=Float#(width)/Float#(Len(curline$))
	
			For a=0 To Len(curline$)
				Text(x+Float(spacing#)*a,y,Mid$(curline$,a+1,1))
			Next
		Else
			Text(x,y,incoming$)
			incoming$=""
		End If
		y=y+FontHeight()
	Wend
End Function

22 lines of bliss. Shorten it. Please.