Data commit

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

@@ -0,0 +1,80 @@
+' 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%, c$, NewText$, j%
+
+  j% = LEN(WhichText$)
+  FOR i% = 1 TO j%
+    NewText$ = MID$(WhichText$, i%, 1) + NewText$
+  NEXT i%
+
+  RvrsText$ = NewText$
+
+END FUNCTION