Alternating codes per letter in text

Posted by Meekah on Mon 24 May 2004 03:29 AM — 4 posts, 20,055 views.

Meekah USA Mon 24 May 2004 03:29 AM #0

I have tried to figure out how to do this but haven't succedded yet.

What I would like is an alias that would take the inputted text and output it with inserted color codes alternating per letter.

example:

alias input> say Hello, how are you?

alias output> say `OH`^e`Ol`^l`Oo`^, `Oh`^o`Ow `^a`Or`^e `Oy`^o`Ou`^?``

If anyone has any ideas on how to do this it would be much appreciated.

Thanks in advance

meekah

Magnum Canada Mon 31 May 2004 12:48 PM #1

Function PickColour (StrPosition)
	Dim StringPosition
	Dim PositionColour(2)
	PositionColour(1) = "'O"
	PositionColour(2) = "'^"
	StringPosition = StrPosition
	While StringPosition > UBound(PositionColour)
		StringPosition = StringPosition - UBound(PositionColour)
	Wend
	PickColour = PositionColour(StringPosition)
End Function

Function Colourize (SourceString)
	Dim TargetString
	Dim ColourCode
	Dim x
	TargetString = Empty
	For x = 1 to Len(SourceString)
		ColourCode = PickColour(x)
		TargetString = TargetString & ColourCode & Mid(SourceString, x, 1)
	Next
	Colourize = TargetString
End Function

Sub ColourSay (AliasName, AliasLine, ArrWildcards)
	World.LogSend "say " & Colourize(ArrWildcards(1))
End Sub

These sets of routines will do the job. Note: The routines will attempt to colour spaces as well. It would be too complicated to work around this.

You could colourize any string you want to send via other subroutines, simply by using the Colourize function. I wrote a simple alias if you only want to use this to "say" things. Here's the alias:

<aliases>
  <alias
   name="ColourSay"
   script="ColourSay"
   match="csay *"
   enabled="y"
   sequence="100"
  >
  </alias>
</aliases>

You could easily make these routines use more colours by editing the PickColour function. Simply increase the value of Dim PositionColour(2) to whatever number of colours you will be using, then add the appropriate PositionColour(#) = lines as needed.

Magnum Canada Mon 31 May 2004 01:08 PM #2

Ok, turns out testing for spaces wasn't so difficult afterall.

Here's a revised edition, with all of the relevant code quoted:

Function PickColour (StrPosition)
	Dim StringPosition
	Dim PositionColour(2)
	PositionColour(1) = "'O"
	PositionColour(2) = "'^"
	StringPosition = StrPosition
	While StringPosition > UBound(PositionColour)
		StringPosition = StringPosition - UBound(PositionColour)
	Wend
	PickColour = PositionColour(StringPosition)
End Function

Function Colourize (SourceString)
	Dim TargetString
	Dim ColourCode
	Dim CurrentChr
	Dim SpacesEncountered
	Dim x
	TargetString = Empty
	SpacesEncountered = 0
	For x = 1 to Len(SourceString)
		CurrentChr = Mid(SourceString, x, 1)
		If CurrentChr = Chr(32) Then                    ' Chr(32) is the space character.
			SpacesEncountered = SpacesEncountered + 1
			TargetString = TargetString & CurrentChr
		Else
			ColourCode = PickColour(x - SpacesEncountered)
			TargetString = TargetString & ColourCode & CurrentChr
		End If
	Next
	Colourize = TargetString
End Function

Sub ColourSay (AliasName, AliasLine, ArrWildcards)
	World.LogSend "say " & Colourize(ArrWildcards(1))
End Sub

Meekah USA Tue 01 Jun 2004 06:18 PM #3

Works perfectly, thank you so much.