RosettaCodeData/Task/Palindrome-detection/BASIC/palindrome-detection.basic

' OPTION _EXPLICIT ' For QB64. In VB-DOS remove the underscore.

DIM txt$

' Palindrome
CLS
PRINT "This is a palindrome detector program."
PRINT
INPUT "Please, type a word or phrase: ", txt$

IF IsPalindrome(txt$) THEN
  PRINT "Is a palindrome."
ELSE
  PRINT "Is Not a palindrome."
END IF

END


FUNCTION IsPalindrome (AText$)
  ' Var
  DIM CleanTXT$, RvrsTXT$

  CleanTXT$ = CleanText$(AText$)
  RvrsTXT$ = RvrsText$(CleanTXT$)

  IsPalindrome = (CleanTXT$ = RvrsTXT$)

END FUNCTION

FUNCTION CleanText$ (WhichText$)
  ' Var
  DIM i%, j%, c$, NewText$, CpyTxt$, AddIt%, SubsTXT$
  CONST False = 0, True = NOT False

  SubsTXT$ = "AIOUE"
  CpyTxt$ = UCASE$(WhichText$)
  j% = LEN(CpyTxt$)

  FOR i% = 1 TO j%
    c$ = MID$(CpyTxt$, i%, 1)

    ' See if it is a letter. Includes Spanish letters.
    SELECT CASE c$
      CASE "A" TO "Z"
        AddIt% = True
      CASE " ", "¡", "¢", "£"
        c$ = MID$(SubsTXT$, ASC(c$) - 159, 1)
        AddIt% = True
      CASE "‚"
        c$ = "E"
        AddIt% = True
      CASE "¤"
        c$ = "¥"
        AddIt% = True
      CASE ELSE
        AddIt% = False
    END SELECT

    IF AddIt% THEN
      NewText$ = NewText$ + c$
    END IF
  NEXT i%

  CleanText$ = NewText$

END FUNCTION

FUNCTION RvrsText$ (WhichText$)
  ' Var
  DIM i%, NewText$, j%

  j% = LEN(WhichText$)
  FOR i% = 1 TO j%
    NewText$ = MID$(WhichText$, i%, 1) + NewText$
  NEXT i%

  RvrsText$ = NewText$

END FUNCTION