Translate

Monday, March 24, 2008

Encheferizer

This is a VB.Net function that you can use to translate your message to Swedish Chef. It's great for error reporting! Paste this function into your VB.Net class. To use it, simply pass the text you want translated and it will return a string of "translated" text.


Sample Translation:
Zeees is a FB.Net fooncshun zeet yuoo cun use tu trunslete yuoor messege tu Svedeesh Cheff. It's greet fur irrur repurteeng! Peste zeees fooncshun intu yuoor FB.Net cless. Tu use it, seemply pess zee text yuoo vunt trunsleted und it veell retoorn a streeng ooff "trunsleted" text, Bork Bork Bork!






Here is a sample application that uses the Encheferizer code. Enjoy!
Encheferizer.zip



Public
Class Encheferizer
'Encheferize
'Adrian Hayes
' http://www.bearnakedcode.com
' You are free to use this code as you wish. It is offered without
' warranty. Use at your own risk - especially if you have a touchy
' manager who would not appreciate funny error reports or easter eggs.
'

' If you publish its source (or any portion thereof), please include
' a reference back to http://www.bearnakedcode.com.
' Translate English text to "Swedish Chef" dialect
' Based on PHP Encheferize from Eric Bakker - http://bork.eamelink.nl
' and original chef.x from John Hagerman
'
'Translation guide:
'an -> un -f -> ff th| -> t
'au -> oo -ir -> ur -tion -> shun
'a- -> e -I -> ee or I -u -> oo
'en -> ee -ow -> oo v -> f
'-ew -> oo |o -> oo w -> v
'
'"|" indicates a word boundary
'"-" indicates in the middle of a word

Public Function Encheferize(ByVal text As String) As String
Dim retval As String = "" ' return value
'separators is a character array used for searching the phrase for
?separating characters
to find word boundaries
Dim separators() As Char = {vbCr, vbLf, " ", ",", ".", ";", ":", "<", ">",
"""", "''", "[", "{", "]", "}", "|", "=", "+",
"-", "_", "!", "@", "#", "$", "%", "^", "&",
"*", "(", ")", "~"}
Dim word As String = ""
Dim rand As New Random

Dim c As Char
For i As Long = 0 To text.Length
c
= ""
If i < text.Length Then
c
= text.Substring(i, 1) ' set c to the i'th character in the text
End If
If Char.IsLetter(c) Then
word
+= c
Continue
For
Else
If Array.IndexOf(separators, c) >= 0 Or i = text.Length Then
' word found - send for "translation"
If word.Length > 0 Then
retval
+= EncheferizeWord(word)
word
= ""
End If
'"25% chance of ending a sentance with "Bork Bork Bork!"
If (c = "." Or c = "!") And rand.Next(0, 4) = 1 Then
retval
+= ", Bork Bork Bork!"
Else
retval
+= c
End If
Else
word
+= c
End If
End If
Next
Return retval
End Function

Public Function EncheferizeWord(ByVal word As String) As String
Dim retval As String = "" 'return value
Dim i As Integer 'tracks character position within word
Dim c As Char 'character currently under evaluation
Dim nc As Cha 'next character - if empty, then c is the
'last character in the word.
Dim biseen As Boolean = False 'used to insure we don't replace
'"i" with "ee" more than once in a word.

If word.ToLower = "bork" Then 'why improve perfection? :)
Return word
End If

i
= 0
' Get the character at position i.
' if not the last character, then get the next character as well
While i < word.Length
c
= word.Substring(i, 1)
If i < word.Length - 1 Then
nc
= word.Substring(i + 1, 1)
Else
nc
= ""
End If

'"The" -> "Zee" "Put the cake in the oven" -> "Poot zee ceke in zee oofee"
If word.ToLower = "the" Then
retval
= MatchCase(c, "z") & "ee"
i
+= 3
Continue
While
End If

'If the first character
If i = 0 Then
Select Case c
Case "E", "e" '"e" -> "i"; "East" -> "Iest"
retval
= MatchCase(c, "i")
i
+= 1
Continue
While
Case "o", "O" '"o" -> "oo"; "Open" -> "Oopin"
retval
= MatchCase(c, "o") & "o"
i
+= 1
Continue
While
End Select
Else ' not the first character
Select Case c
Case "e"
If nc = "w" Then '"ew" -> "oo"; "new" -> "noo"
retval
+= "oo"
i
+= 2
Continue
While
End If
If nc = "" Then '"e" -> "e-a"; "gone" -> "gune-a"
retval
+= "e-a"
i
+= 1
Continue
While
End If
Case "f" '"f" -> "ff"; "of" -> "ooff"
retval
+= "ff"
i
+= 1
Continue
While

Case "i"
If nc = "r" Then '"ir" -> "ur"; "fire" -> "fure-a"
retval
+= "ur"
i
+= 2
Continue
While
End If
'If we've not replaced an "i" before. Prevents too many "ee"'s in a word.
If Not biseen Then
retval
+= "ee" '"i" -> "ee"; "bid" -> "beed"
i
+= 1
biseen
= True
Continue
While
End If

Case "o"
If nc = "w" Then '"ow" -> "oo"; "Owl" -> "Oowl"
retval
+= "oo"
i
+= 2
Continue
While
Else
retval
+= "u" '"o" -> "u"; "tool" -> "tuul"
i
+= 1
Continue
While
End If

Case "t", "s"
If i <= word.Length - 4 Then
'"-sion" or "-tion" -> "-shun"; "compulsion" -> "cumpoolshun"
If word.Substring(i + 1, 3) = "ion" Then
retval
+= "shun" "Action" -> "Ecshun"
i
+= 4
Continue
While
End If
End If
Case "U", "u" '"u" -> "oo"; "bun" -> "boon"
retval
+= MatchCase(c, "o") & "o"
i
+= 1
Continue
While
End Select
End If

' characters that may be replaced anywhere
Select Case c
Case "A", "a"
Select Case nc
Case "n" '"an" -> "un"; "American" -> "Emereecun"
retval
+= MatchCase(c, "u") & "n"
i
+= 2
Continue
While
Case "u"
retval
+= MatchCase(c, "o") & "o" '"au" -> "ao"; "because" -> "becoose"
i
+= 2
Continue
While
Case ""
'do default action if "a" is last character
Case Else ' "a" is not last character and nc <> "n" or "u"
retval
+= MatchCase(c, "e") '"a" -> "e"; "easy" -> "iesy"
i
+= 1
Continue
While
End Select

Case "e"
If nc = "n" And i = word.Length - 2 Then '"en" -> "ee"; "golden" -> "guldee"
retval
+= "ee"
i
+= 2
Continue
While
Else
' do nothing - use existing character
End If

Case "T", "t"
If nc = "h" Then
If i = word.Length - 2 Then ' If "th" at end of word, "th" -> "t"; "worth" -> "vurt"
retval
+= MatchCase(c, "t")
i
+= 2
Continue
While
Else
' If "th" not at end of word, "th" -> "ze"; "this" -> "zeees"
retval
+= MatchCase(c, "z") & "e"
i
+= 2
Continue
While
End If
End If

Case "V", "v" '"v" -> "f"; "fever" -> "fefer"
retval
+= MatchCase(c, "f")
i
+= 1
Continue
While
Case "W", "w" '"w" -> "v"; "worth" -> "vurt"
retval
+= MatchCase(c, "v")
i
+= 1
Continue
While
End Select

' Default behavior is to replace character with character.
retval
+= c
i
+= 1
End While
Return retval
End Function


'MatchCase returns the resultant, in the same case of the determinate
Private Function MatchCase(ByVal determinate As Char, ByVal resultant As Char) As Char
If Char.IsUpper(determinate) Then
Return Char.ToUpper(resultant)
Else
Return Char.ToLower(resultant)
End If
End Function
End Class

No comments: