' Caocipher Example
' Rosetta Code
' This code was made in Power Basic 3.5 for DOS

CLS

' Left Alphabet
Function AlphaLeft(ct as String, pt as String, CharPos as Integer) as String

  Dim tStr as String: tStr=ct

  ' 1. Shift the entire left alphabet cyclically so the ciphertext letter
  ' just enciphered is positioned at the zenith (i.e., position 1).
  tStr=Right$(ct, Len(ct)-CharPos+1)+Left$(ct, CharPos-1)

  ' 2. Extract the letter found at position zenith+1 (i.e., the letter to
  ' the right of the zenith), taking it out of the alphabet, temporarily
  ' leaving an unfilled "hole"

  Dim Hole as String: Hole=Mid$(tStr, 2, 1): Mid$(tStr, 2, 1)=" "

  ' 3. Shift all letters in positions zenith+2 up to, and including, the
  ' nadir (zenith+13), moving them one position to the left

  tStr=Left$(tStr, 1)+Mid$(tStr, 3, 12)+" "+Right$(tStr, 12)

  ' 4. Insert the just-extracted letter into the nadir position
  ' (i.e., zenith+13)

  Mid$(tStr, 14, 1)=Hole

  AlphaLeft=tStr
End Function

' Right Alphabet
Function AlphaRight(ct as String, pt as String, CharPos as Integer) as String

  Dim tStr as String: tStr=pt

  ' 1. Shift the entire right alphabet cyclically so the plaintext letter
  ' just enciphered is positioned at the zenith.

  tStr=Right$(tStr, Len(tStr)-CharPos+1)+Left$(tStr, CharPos-1)

  ' 2. Now shift the entire alphabet one more position to the left (i.e.,
  ' the leftmost letter moves cyclically to the far right), moving a new
  ' letter into the zenith position.

  tStr=Right$(tStr, 25)+Left$(tStr, 1)

  ' 3. Extract the letter at position zenith+2, taking it out of the
  ' alphabet, temporarily leaving an unfilled "hole".

  Dim Hole as String: Hole=Mid$(tStr, 3, 1): Mid$(tStr, 3, 1)=" ":

  ' 4. Shift all letters beginning with zenith+3 up to, and including, the
  ' nadir (zenith+13), moving them one position to the left.

  tStr=Left$(tStr, 2)+Mid$(tStr, 4, 11)+" "+Right$(tStr, 12)

  ' 5. Insert the just-extracted letter into the nadir position (zenith+13)

  Mid$(tStr, 14, 1)=Hole

  AlphaRight=tStr
End Function

Function Encode(Text as String, ct as String, pt as String) as String
  Dim t as Integer
  Dim tStr as String: tStr=""

  For t=1 to Len(Text)
    Dim Char as String: Char=Mid$(Text, t, 1)
    Dim CharPos as Integer: CharPos=Instr(pt, Char)

    ct=AlphaLeft(ct, pt, CharPos)
    pt=AlphaRight(ct, pt, CharPos)

    tStr=tStr+Left$(ct, 1)
  Next

  Encode=tStr
End Function

' Deciphering a Chaocipher-encrypted message is identical to the steps used
' for enciphering. The sole difference is that the decipherer locates the
' known ciphertext letter in the left (ct) alphabet, with the plaintext
' letter being the corresponding letter in the right (pt) alphabet
'
' Alphabet permuting is identical in enciphering and deciphering

Function Decode(Text as String, ct as String, pt as String) as String
  Dim t as Integer
  Dim tStr as String: tStr=""

  For t=1 to Len(Text)
    Dim Char as String: Char=Mid$(Text, t, 1)
    Dim CharPos as Integer: CharPos=Instr(ct, Char)

    ct=AlphaLeft(ct, pt, CharPos)
    pt=AlphaRight(ct, pt, CharPos)

    tStr=tStr+Right$(pt, 1)
  Next

  Decode=tStr
End Function

' Start of Main Code

' LEFT (Cipher Text): HXUCZVAMDSLKPEFJRIGTWOBNYQ
Dim tLeft as String: tLeft="HXUCZVAMDSLKPEFJRIGTWOBNYQ"

' RIGHT (Plain Text): PTLNBQDEOYSFAVZKGJRIHWXUMC
Dim tRight as String: tRight="PTLNBQDEOYSFAVZKGJRIHWXUMC"

' Cipher Message (Used to verify a good encoding)
Dim cText as String: cText="OAHQHCNYNXTSZJRRHJBYHQKSOUJY"

' Plain Text Message
Dim pText as String: pText="WELLDONEISBETTERTHANWELLSAID"
Print " Plain  Text: "; pText: Print

Dim ctLeft as String: ctLeft=tLeft
Dim ptRight as String: ptRight=tRight

' Final Cipher Text
Dim eText as String: eText=Encode(pText, ctLeft, ptRight)
Print " Cipher Text: "; eText: Print

If eText=cText then Print "Successful" else Print "Failed"

ctLeft=tLeft: ptRight=tRight
Dim dText as String: dText=Decode(eText, ctLeft, ptRight)
Print: Print " Plain Text: "; dText: Print

If dText=pText then Print "Successful" else Print "Failed"