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:
Post a Comment