Tag System - Up The Swanie

Hiya All! :)

As you'll see from the routine below, I am trying to implement a tag system (like html codes to switch what should effect the text) And I have never used the Left$ or Right$ commands before, and as you will also spot that it doesnt work in my favour at all. And thus, I'd really appreciate any help in getting it working as it should do.

What it should do is:

Read the Message$ text
Decipher any tags found in the square brackets
Reset to just before the tag
Change the colour / effect or what have you
And draw the finished outcome.

Im using an imagebuffer as I can reposition the whole thing alot easier, then calling to update each time etc.

Graphics 640,480
SetBuffer BackBuffer()

Global message$
message$=			"[R]Please [G]Change [B]My [P]colors[Return]"  
message$=message$+	"[N]And this is default / normal text and this should be [B]blue Text"

Global char$
Global XPos,YPos
Global Text_Area=CreateImage(640,256)

Draw_To_Screen()

While Not KeyHit(1)
Cls
	DrawImage Text_Area,0,0
Flip
Wend


Function Draw_To_Screen()
SetBuffer ImageBuffer(Text_Area)
For t = 1 To Len(message$)  

	char$=Mid$(message$,t,1)
	
	If char$=Left$(message$,3)="[R]"
		Color 128,000,000
		XPos=Xpos-(3*8)
	End If
	
	If char$=Left$(message$,3)="[G]"
		Color 000,200,000
		XPos=Xpos-(3*8)

	End If
	
	If char$=Left$(message$,3)="[B]"
		Color 000,000,250
		XPos=Xpos-(3*8)
	End If

	If char$=Left$(message$,3)="[P]"
		Color 100,000,250
		XPos=Xpos-(3*8)
	End If
	
	If char$=Left$(message$,3)="[W]"
		Color 255,255,255
		XPos=Xpos-(3*8)

	End If
	
	If char$=Left$(message$,8)="[Return]"
		XPos=0
		YPos=YPos+8
	End If
	
	Text XPos+(t*8),YPos,char$
	
Next
SetBuffer BackBuffer()
End Function

Cheers & Many many thanks,
Mikey F :)

In the alien breed CP code.zip, in inc\utils.bb there's a function called readitem.

Function readitem$(filename$,item$)
	filein = ReadFile(filename)
	ret$ = "?Null?"
	lin$ = ""
	item = Lower(item)
	Repeat
		l$ = Lower(ReadLine(filein))
		lb = Instr(l$,"<"+item+">")
		rb = Instr(l$,"</"+item+">")
		If lb>0 And rb>0
			lb = lb + Len("<"+item+">")
			ret= Mid(l,lb,rb-lb)
		EndIf
	Until Eof(filein)
	CloseFile filein
	Return ret$
End Function

Have a read and see it this helps.

Here's one I wrote a while back. Uses a similar system, except ^WH or ^BL, etc. I'm sure you could adapt it. Very fast, and doesn't require a graphics buffer, or creating images on the fly. Just uses text commands. :)

Example included of course - the guts of it is the "Word" TYPE, which is used to split up the sentence into each color code section (or you could use other codes, for bold, etc - I just parse that in the main function call as you can see), and the function.

Graphics 800,600,32,1
	
	Global sfont=LoadFont("Times New Roman",18,0,0,0)
	Global bfont=LoadFont("Times New Roman",18,1,0,0)
	Global ifont=LoadFont("Times New Roman",18,0,1,0)
	Global ufont=LoadFont("Times New Roman",18,0,0,1)
	Global spfont=LoadFont("Verdana",14,0,0,0)
	
	Type Word
		Field Txt$
		Field Col$
		End Type
		
	SetBuffer BackBuffer()
	ClsColor 100,100,100
	Cls
	
	ctext "^go52760 ^whgold pieces",135,105	
	Flip
		
	WaitKey()
	End
	
	
	Function Ctext(txt$,x,y,bold=1,italic=0,underline=0,shadow=1)
	SetFont bfont
	If bold=0 Then SetFont sfont
	If italic=1 Then SetFont ifont
	If underline=1 Then SetFont ufont
	this.word=New word
	For i = 1 To Len(txt$)
		CurrentChar$=Mid$(txt$,i,1)
		If CurrentChar$ = "^" Then
			ColCode$=Mid$(txt$,i+1,2)
			this.word=New Word
				this\col$ = Lower(ColCode$)
			i=i+2
		Else
			this\txt$=this\txt$+CurrentChar$
		End If
	Next
	tx=x
	For this.word = Each word
		Color 0,0,0
		If shadow=1 Then Text tx,y+2,this\txt$
		
		Select this\col$
			Case "wh":Color 255,255,255
			Case "bl":Color 80,80,255
			Case "go":Color 200,200,70
			Case "bk":Color 0,0,0
			Default:Color 255,255,255
		End Select
		Text tx,Y,this\txt$
			tx=tx+StringWidth(this\txt$)
		Delete this
		Next
	End Function

+BlackD

Excellent, I'll look into both!

Cheers!

Ok I've had a peek and a poke about the routines, and I am a little lost somewhat.

I've tried to implement different sized tags, and check what to increment with the i=i+??? and as you'll see it horribly wrong.

A routine I am trying to pull off, is a text Bitmap Font (or true type font - which evers more versatile) writter, for using as an instructions screen to scroll through, thats why I opted for an image buffer to reproduce the text information with. And the text will be obtained from a Loaded file (Txt Document).

If you know what I've done wrong, or there is a better method then Id really appreciate it and love to know.

Graphics 640,480
SetBuffer BackBuffer()

Type Word
	Field Txt$
	Field Col$
End Type

Global message$
message$=			"[Red]Please [Green]Change [Blue]My [Purple]colors[Return]"  
message$=message$+	"[Normal]And this is default / normal text and this should be [Blue]blue Text"

Global char$,ColCode$,skip=False
Global XPos,YPos
Global Text_Area=CreateImage(640,256)

Draw_To_Screen()

While Not KeyHit(1)
Cls
	DrawImage Text_Area,0,0
Flip
Wend


Function Draw_To_Screen()
SetBuffer ImageBuffer(Text_Area)
this.word=New word
For i = 1 To Len(message$)  
	
	CurrentChar$=Mid$(message$,i,1)

	If CurrentChar$ = "[" Then
		
		If Skip=False
			this.word=New Word
			ColCode$=Mid$(message$,i+1,4)
			this\col$ = Lower(ColCode$)

			If this\col$="Red]" 
				i=i+4
				Skip=True
			End If
		
		End If
	
		
		If Skip=False	
			ColCode$=Mid$(message$,i+1,6)
			this\col$ = Lower(ColCode$)

			If this\col$="Green]" 
				i=i+6
				Skip=True
			End If
		End If
		
		If Skip=False
			ColCode$=Mid$(message$,i+1,5)
			this\col$ = Lower(ColCode$)

			If this\col$="Blue]"
			 	i=i+5
				Skip=True
			End If
	
		End If
		
		If Skip=False
			ColCode$=Mid$(message$,i+1,8)
			this\col$ = Lower(ColCode$)

			If this\col$="Purple]" Or this\col$="Return]" Or this\col$="Normal]" 
				i=i+8
				Skip=True
			End If
		
		End If

	Else
		this\txt$=this\txt$+CurrentChar$
	End If
	
	skip=False

Next


tx=x

For this.word = Each word
	Color 0,0,0
	
	;If shadow=1 Then Text tx,y+2,this\txt$
		
	Select this\col$
		Case "Red]"		:Color 255,000,000
		Case "Blue]"	:Color 080,080,255
		Case "gold]"	:Color 200,200,070
		Case "black]"	:Color 000,000,000
			
		Default:Color 255,255,255
		
	End Select
		
	Text tx,Y,this\txt$
		tx=tx+StringWidth(this\txt$)
	Delete this
		
Next

SetBuffer BackBuffer()
End Function

Cheers and bless you all!
-Mikey F :)

I usually seperate the functions into 3 sections. Input, lexical analyzer, and parser. The input just sends the next character to the lexical analyzer, the lexical analyzer strings the input into tokens, and the parser actually acts upon the whole thing.

Const TOKEN_EOL = 0
Const TOKEN_TAG = 1
Const TOKEN_STRING = 2

Global push = False
Global pushed$
Global message$
Global messagepointer = 1
Global token$
Global TextX = 0
Global TextY = 0


;character input
Function GetCharacter$()
If push = True ;if a character has been pushed onto the buffer, send it first
 DebugLog pushed$
 push = False
 Return pushed$
End If
If messagepointer > Len(message$) Then Return "eol"
c$ = Mid$(message$,messagepointer,1)
messagepointer = messagepointer + 1
Return c$
End Function

Function PushCharacter(c$)
Pushed = c$
Push = True
End Function

Function Lex()

c$ = GetCharacter()
Select c$
Case "["
 c$ = GetCharacter()
 Token = ""
 While c$ <> "]" And c$<> "eol"
  Token = Token + c$
  c$ = GetCharacter()
 Wend 
 Return TOKEN_TAG
Case "eol"
 Token$ = ""
 Return TOKEN_EOL
Default
 Token$ = ""
 While c$ <> "["And c$<>"eol"
  Token = Token + c$
  c$ = GetCharacter()
 Wend
 PushCharacter(c$)
 Return TOKEN_STRING
End Select
End Function

Function DisplayText(TextString$)
Message$ = TextString$
Repeat
 TokenValue = Lex()
 DebugLog TokenValue +" " + Token$
 Select TokenValue
 Case TOKEN_EOL
  Return
 Case TOKEN_TAG
  Select Lower(Token$)
  Case "r"
   Color 255,0,0
  Case "g"
   Color 0,255,0
  Case "b"
   Color 0,0,255
  Case "w"
   Color 255,255,255
  Case "p"
   Color 255,0,255
  Case "n"
   Color 212,212,212
  Case "return"
   TextX = 0
   TextY = TextY + 16
  Default
   RuntimeError "Don't recognize tag " + Token
  End Select
 Default
  Text TextX,TextY,Token$
  TextX = TextX + 8*Len(Token)
 End Select
Forever
End Function

Graphics 800,600
m$ = "[R]Please [G]Change [B]My [P]colors[Return]"
m$ = m$ + "[N]And this is default / normal text and this should be [B]blue Text"

DisplayText(m$)
WaitKey()

I know that seems like a lot for just changing colors, but it'll make it easier when you add functions, as well, as changing input. Like you could change to reading from a file or over a network connection just by changing the GetCharacter routine.

Hiya!

Is there any way to prevent their being to big a gap between the texts after a tag has been performed? Usual formatting, of each letter follows and sits nicely together?

As I'm about to add different sized fonts being specified this Bit's easy its the aligning thats a tad puzzling :_)

I am also having difficulties turning this into a Bitmap Font version too.

Many Many Thanks for your help.
Mikey F

Any luck, Im going slightly bald as it's driving me crazy. Hehehe.

I'd love very much for this to draw a letter of a bitmap font rather then text.

Const TOKEN_EOL = 0
Const TOKEN_TAG = 1
Const TOKEN_STRING = 2

Const xres=800,yres=600

Graphics xres,yres
SetBuffer BackBuffer()

;-==========================-
;-=[Create Some Font Types]=-
;-==========================-
Const ABFontW=16						;Font Width
Const ABFontH=16						;Font Height
Const ABFontL=96						;Number Of Letters In The Font



Global Bitmap_Font	=LoadAnimImage("media\Font16x16.png"	,ABFontW,ABFontH,0,ABFontL-1)


;-==============-
;-=[Setup Text]=-
;-==============-
Global Article$
Article$ = 		"[Red]Please [Green]Change [Blue]My [Purple]colors[Return]"
Article$ = Article$ + 	"[Normal]And this is default / normal [Bum] text and this should be [Blue]blue Text"

Global i=1
Global push = False
Global pushed$
Global message$
Global messagepointer = 1
Global token$
Global TextX = 0
Global TextY = 0

Global Article_Store=CreateImage(800,600)
;-============================-
;-=[Feed Me Some Texts Bitch]=-
;-============================-
SetBuffer ImageBuffer(Article_Store)
displayText(Article$)
Flip
SetBuffer BackBuffer()

Global Over=False

While Not Over=True
Cls
	
	DrawImage Article_Store,0,0
	
         value=getkey()
	If value<>0 	Then Over=True
	
Flip
Wend







;character input
Function GetCharacter$()


If push = True ;if a character has been pushed onto the buffer, send it first
	DebugLog pushed$
 	push = False
 	Return pushed$
End If

If messagepointer > Len(message$) Then Return "eol"

character$ 	= Mid$(message$,messagepointer,1)
messagepointer 	= messagepointer + 1

Return character$

End Function


Function PushCharacter(character$)
Pushed = character$
Push = True
End Function



Function Lex()

character$ = GetCharacter()

Select character$

Case "["
	
	character$ = GetCharacter()
 	Token = ""
 
		While character$ <> "]" And character$<> "eol"
  			Token 			= Token + character$
  			character$ 		= GetCharacter()
		Wend 
 	
	Return TOKEN_TAG

Case "eol"
 	
	Token$ = ""
	Return TOKEN_EOL

Default
	Token$ = ""
		
		While character$ <> "["And character$<>"eol"
  			Token 			= Token + character$
  			character$ 		= GetCharacter()
		Wend

	PushCharacter(character$)
	Return TOKEN_STRING

End Select
End Function



Function DisplayText(TextString$)

Message$ = TextString$
Repeat
	TokenValue = Lex()
 	DebugLog TokenValue +" " + Token$
 	
	Select TokenValue
 	
		Case TOKEN_EOL
  				Return
 		Case TOKEN_TAG
  				Select (Token$)
  		
		Case "Red" 		
			Color 255,000,000 ;these will be changed to signify character sets
  		
		Case "Green" 	
			; Color 000,255,000
			
  		Case "Blue" 	

			; Color 000,000,255
			
  		Case "White" 	
			; Color 255,255,255
			
  		Case "Purple" 	
			; Color 255,000,255
  		
		Case "Normal" 	
			; Color 212,212,212
		
		Case "Bum" 		
			; Color 111,111,111  		

		
		
		Case "Return"
   				TextX = 0
   				TextY = TextY + 16
  		;Default : RuntimeError "Don't recognize tag " + Token
  	
	End Select

	Default
  	
		

		
		If Character>0 And Character<ABFontL-1

			DrawImage Bitmap_Font,TextX,TextY,Character	 
		
		End If

			TextX = TextX + 8 * Len(Token)
 	



	End Select

Forever
End Function

Thanks immensly!! :)

then draw a bunch of bitmaps and adapt it. As for the "gap", are you remembering to remove the Stringwidth(tag$) (or whatever its called) from the equation, so it doesn't move on that far?

+BlackD

The gaps, I've sorted out now.
And as for the adapting to Bitmaps, I couldn't sort that out at all. So am sticking with True Type fonts for the time being.

Is you code currently as posted above? If so, I'll adapt it to a bitmap system after work (8 hours away.. just walking out the door now). :)

Yes it is dude, and thanks kindly for that mate!
Cheers and all the best,
Mikey F :)

Ooops I forgot! LOL
I'll do it tomorrow. :)

No worries dude!
I'm wondering too, if anyone could help with adding in a word limit per line, so that the text automatically formats onto the next (carriage returns). That too would be amazing!!

Cheers once again for all your kind and generous help!!
Excellent :)