Ben / Nujel

;;; Nujel - Copyright (C) 2020-2021 - Benjamin Vincent Schulenburg
;;; This project uses the MIT license, a copy should be included under /LICENSE
;;;
;;; Various functions dealing with strings of all sorts

(defn pad-start (text pad-length padding)
      "Pad a string to a certain length by prepending another string."
      :cat :string-manipulation
      :related pad-middle
      :related pad-end
      :related trim


      (when-not padding (set! padding " "))
      (when-not (string? text) (set! text (:string text)))
      (when-not (string? padding)
                (exception :type-error "pad-start needs char as a string, so that one can pad with multiple characters" padding))
      (while (< (:length text) pad-length)
             (set! text (cat padding text)))
      (if (> (:length text) pad-length)
          (:cut text (- (:length text) pad-length) (:length text))
          text))

(defn pad-end (text pad-length padding)
      "Pad a string to a certain length by appending another string."
      :cat :string-manipulation
      :related pad-middle
      :related pad-start
      :related trim


      (when-not padding (set! padding " "))
      (when-not (string? text) (set! text (:string text)))
      (when-not (string? padding)
                (exception :type-error "pad-end needs char as a string, so that one can pad with multiple characters" padding))
      (while (< (:length text) pad-length)
             (set! text (cat text padding)))
      (if (> (:length text) pad-length)
          (:cut text 0 pad-length)
          text))

(defn pad-middle (text pad-length padding)
      "Pad a string to a certain length by surrounding it with another string."
      :cat :string-manipulation
      :related pad-start
      :related pad-end
      :related trim

      (when-not padding (set! padding " "))
      (when-not (string? text) (set! text (:string text)))
      (when-not (string? padding)
                (exception :type-error "string/pad-middle needs char as a string, so that one can pad with multiple characters" padding))
      (while (< (:length text) pad-length)
             (set! text (cat padding text padding)))
      (if (> (:length text) pad-length)
          (let ((end-overflow (div/int (- (:length text) pad-length) 2))
                (start-overflow (- (- (:length text) pad-length) end-overflow)))
               (:cut text start-overflow (+ start-overflow pad-length)))
          text))

(defn trim (text)
      "Remove all whitespace from the start and end of text"
      :cat :string-manipulation
      :related pad-start
      :related pad-middle
      :related pad-end
      :related trim

      (def start 0)
      (def end (:length text))
      (while (and (< start end) (whitespace? (ref text start))) (set! start (+ start 1)))
      (while (and (> end 0) (whitespace? (ref text (- end 1)))) (set! end (- end 1)))
      (:cut text start end))

(defn upper-case (text)
      "Convert text into a version using only capitals or uppercase letters."
      :cat :string-manipulation
      :related lower-case
      :related capitalize

      (def ret (buffer/allocate (:length text)))
      (dotimes (i (:length text) (buffer->string ret))
        (set! ret i (upper-case-char (ref text i)))))

(defn lower-case (text)
      "Convert text into a version using only lowercase letters."
      :cat :string-manipulation
      :related upper-case
      :related capitalize

      (def ret (buffer/allocate (:length text)))
      (dotimes (i (:length text) (buffer->string ret))
        (set! ret i (lower-case-char (ref text i)))))

(defn capitalize (text)
      "Convert text into a capitalized version."
      :cat :string-manipulation
      :related upper-case
      :related lower-case

      (def ret (buffer/allocate (:length text)))
      (def caps? #t)
      (dotimes (i (:length text) (buffer->string ret))
         (set! ret i ((if caps? upper-case-char lower-case-char) (ref text i)))
        (set! caps? (if (whitespace? (ref text i)) #t #f))))

(defn string/round (text decimal-digits)
      "Round the floating point representation in TEXT to have at most DECIMAL-DIGITS after the period"
      (def pos (:last-index-of text "."))
      (if (>= pos 0)
          (:cut text 0 (+ pos 1 decimal-digits))
          text))

(def split (let*
             (defn split/empty (str separator)
                   (def slen (:length str))
                   (def start 0)
                   (def ret #nil)
                   (while (< start slen)
                     (set! ret (cons (:cut str start (+ 1 start)) ret))
                     (inc! start))
                   (reverse ret))

             (defn split/string (str separator start)
                   (when-not start (set! start 0))
                   (def pos-found (:index-of str separator start))
                   (if (>= pos-found 0)
                       (cons (:cut str start pos-found)
                             (split/string str separator (+ pos-found (:length separator))))
                       (cons (:cut str start (:length str))
                             #nil)))

             (defn split (str separator)
                   "Splits STR into a list at every occurunse of SEPARATOR"
                   (typecheck/only str :string)
                   (typecheck/only separator :string)
                   (case (:length separator)
                         (0 (split/empty str))
                         (otherwise (split/string str separator 0))))))

(defn read/single (text)
      "Uses the reader and returns the first single value read from string TEXT"
      (typecheck/only text :string)
      (car (read text)))

(defn read/int (text)
      "Reads the first string from TEXT"
      (int (read/single text)))

(defn read/float (text)
      "Reads the first float from TEXT"
      (float (read/single text)))

(defn println (str)
      "Print STR on a single line"
      (print (cat str "\n")))

(defn errorln (str)
      "Print to stderr STR on a single line"
      (error (cat str "\n")))