eutils.lisp v1.5

;(mapcar #'ql:quickload '(qt qt-test qt-repl qt-tutorial cffi named-readtables cl-ppcre alexandria closer-mop iterate trivial-garbage))

(defun flatten (tree)
    "David S. Toutersky."
    (cond ((atom tree) (list tree))
        (t (append (flatten (car tree))
                   (flatten (cdr tree))))))

(defmacro nappend (list &rest input)
    `(setf ,list (append ,list ,@input)))

(defun pairings (list &optional &key remove-nil)
    "Turn a list into a list of lists, each with pairs of value (n and n+1 on the index). :REMOVE-NIL, if T, removes all the NIL values. Just bite the bullet and use it"
    (let ((out (loop for n from 0 to (length list) append (list (list (nth n list) (nth (1+ n) list))) do (incf n))))
        (if (not (null remove-nil))
            (setf out (remove-if #'(lambda (x) (or (null (car x)) (null (cadr x)))) out)))
        (append out)))

(defun sequence-from-pairings (input-list pairing-list)
    "Take an INPUT-LIST, split it into many lists using the pair values (START, END) from the lists in PAIRING-LIST."
    (loop for n from 0 to (1- (length pairing-list)) collecting (list-subseq input-list (car (nth n pairing-list)) (cadr (nth n pairing-list)))))

(defun split-string (string char)
  "Thanks to the Common Lisp Cookbook. http://cl-cookbook.sourceforge.net/strings.html#reverse"
    (let* ((parsed-string (loop for i = 0 then (1+ j)
          as j = (position char string :start i)
          collect (subseq string i j)
          while j)))
      (remove-if #'(lambda (x) (equalp x "")) parsed-string)))


(defun tokenize (string replacement &key (test #'char=))
    "Thanks to the Common Lisp Cookbook. http://cl-cookbook.sourceforge.net/strings.html#manip
    Returns a new string in which all the occurences of the part
    is replaced with replacement."
    (with-output-to-string (out)
      (loop with part-length = (length "(")
            for old-pos = 0 then (+ pos part-length)
            for pos = (search "(" string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                             :start old-pos
                             :end (or pos (length string)))
            when pos do (write-string " ( " out)
            while pos))
    (with-output-to-string (out)
      (loop with part-length = (length ")")
            for old-pos = 0 then (+ pos part-length)
            for pos = (search ")" string
                              :start2 old-pos
                              :test test)
            do (write-string string out
                             :start old-pos
                             :end (or pos (length string)))
            when pos do (write-string " ) " out)
            while pos))
)

(defun trim-excess-chars (string char)
    "Remove all the instances of CHAR from STRING. CHAR must be a single-character string, not a character."
    (coerce (delete (car (coerce char 'list))  (coerce string 'list)) 'string))

(defun list-subseq (list start &optional end)
    "Return the items from a LIST between START and (Optionally, defaults to length of string) END."
    (loop for a from start to (if end end (1- (length list))) collecting (nth a list)))

(defun string-subseq (string start &optional end)
    "Return the items from a LIST between START and (Optionally, defaults to length of string) END."
    (coerce (loop for a from start to (if end end (1- (length string))) collecting (aref string a)) 'string))

(defun collapse-list (list start end)
    "Replace all the items from a LIST between START and END with a list containing said items."
    (nconc (list-subseq list 0 (1- start))
           (list (list-subseq list start end))
           (list-subseq list (1+ end) (1- (length list)))))

(defun enclose-delimiters (list delimiter &optional expand-left expand-right)
   "Return a list where all items between the first and last instances of DELIMITER have been enclosed into a list, except the delimiters themselves. OPTIONAL: EXPAND-LEFT and EXPAND-RIGHT
   enclose items up to a certain number to the left or right (Respectively) into the output list."
   (let* ((delimiter-list '()))
   (loop for n from 0 to (length list) do
        (if (equalp delimiter (nth n list))
            (push n delimiter-list)
            ))
    (setf delimiter-list (append (list (first (reverse delimiter-list))) (last (reverse delimiter-list))))
    (if expand-left  (decf (car delimiter-list) expand-left))
        (if (< (car delimiter-list) 0) (setf (car delimiter-list) 0))
    (if expand-right (incf (car (last delimiter-list)) expand-right))
        (if (> (car (last delimiter-list)) (length list)) (setf (car (last delimiter-list)) (length list)))
    (collapse-list list (car delimiter-list) (car (last delimiter-list)))))

(defun collect-item-positions (list item &optional &key append-beginning append-end single?)
    "Collect the positions of many instances of ITEM in a LIST. The variable :SINGLE?, if T, tells the interpreter to return after one instance has been found."
    (let ((delimiter-positions '()))
        (loop for n from 0 to (length list) do
            (if (equalp item (nth n list))
                (progn  (setf delimiter-positions (nconc delimiter-positions (list n)))
                        (if single? (return n)))))
        (append delimiter-positions)))

(defun list-split-multiple-delimiters (list delimiter)
    "Split a list into many sublists using the instances of DELIMITER as delimiters. The beginning of the list and endpoint are taken as delimiters too."
    (let ((output-list list)
          (item-positions '()))
        (loop for n from 0 to (length output-list) do
            (cond ((equalp delimiter (nth n output-list))
                    (setf output-list (nconc  (list-subseq output-list 0 (1- n))
                                          (list delimiter delimiter)
                                          (list-subseq output-list (1+ n))))
                    (incf n 1)
                    (setf output-list (remove-if #'null (flatten output-list))))))
        (setf output-list (nconc (list delimiter) output-list (list delimiter)))
        (setf item-positions (collect-item-positions output-list delimiter))
        (setf item-positions (pairings item-positions :remove-nil t))
        (setf output-list (sequence-from-pairings output-list item-positions))
        (setf output-list (reverse (rest (reverse (loop for n from 0 to (length output-list) collecting
            (list-subseq (nth n output-list) 1 (- (length (nth n output-list)) 2)))))))
))

(defun concatenate-list-of-strings (list)
    "Concatenate the strings in LIST into a single string (hurr durr)."
        (apply #'concatenate 'string list))

(defun concatenate-strings-with-spaces (list)
    "Concatenate the strings in LIST into a single string but separate each string them with a space. Except the last one."
    (loop for n from 0 to (- (length list) 2) do (setf (nth n list) (concatenate 'string (nth n list) " ")))
    (setf list (concatenate-list-of-strings list)))

(defmacro writeline (control-string &optional &rest arguments)
    "Handle output from the interactive fiction engine. By default it works using writeline, though more advanced systems should be made available."
    (if (not (null arguments))
        (append `(format t ,control-string) arguments)
        `(format t ,control-string)))

(defmacro qstring (string)
    string)

;;TODO: Add optional :test=#' arguments to a bunch of these