cl-deck-builder2/src/toolkit/utils.lisp

;;;; src/toolkit/toolkit.lisp

(in-package #:cl-deck-builder2.toolkit.utils)

;; https://stackoverflow.com/a/11965885
;; def grouped(l, n):
;;     for i in xrange(0, len(l), n):
;;         yield l[i:i+n]

(defun grouped (seq &optional (n 1000))
       "Group elements in a list by some number of elements.

ARGUMENTS
SEQ   The sequence to be grouped.
N     The number of elements per grouping."
  (loop :for i :upto (1- (length seq)) :by n
        :collect (subseq seq i (min (length seq)
                                    (+ i n)))))

;; Not sure how I arrived at this gist.
;;
;; <https://gist.github.com/html/4085786>
;;
;; My code is modified slightly.
(defun normalize-newlines (string)
  "Remove or replace #\Return(#\Newline)? sequences with just #\Newline.

The \#Newline following #\Return is optional, so just #\Return also gets turned into #\Newline.

ARGUMENTS
STRING  The target string."
  (ppcre:regex-replace-all
   (format nil "~C(\\n)?" #\Return)
   string
   (format nil "~C" #\Newline)))

;; Is this necessary? I uploaded a file with a BOM and it exploded.
(defun strip-bom (string)
  "If STRING is UTF-8 and contains a UTF-8 BOM it will be removed.

ARGUMENTS
STRING  The string to check."

  (when string
    (case (type-of (char string 0))
      (extended-char (subseq string 1))
      (t string))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun query-param (name parsed)
  "Parse query param values. Get the value of the specified element NAME in the query PARSED.

ARGUMENTS
NAME    The query to search for in the parameter list.
PARSED  The parameter list."
  ;; TODO STRING=? STRING-EQUAL?? Maybe I should add a &KEY (test #'STRING=)?
    (assoc-utils:aget parsed name))

;; (defun generate-pages ()
;;   "Generate pagination"
;;   (let ((pages nil))
;;     (dotimes (i 10)
;;       (push (list :id (+ 1 i) :start (* 10 i)) pages))
;;     (reverse pages)))

;; TODO Passing weird floats to this. How can I put the weird math into here?
;;
;; I made it into a helper function for now.
;; No idea how to even explain this. It works!
(defun generate-pages-helper (start &optional (max 10) (multiplier 10))
  "Generate pagination up to MAX pages, with MULTIPLIER items per page."
  ;; We always want 10 pages. If we start at page 0, subtract five,
  ;; then take the nearest lowest non-negative integer (0), this gets
  ;; us a comfy left bound.
  (let ((start- (- start 5)))
    ;; If START- is less than zero, make it zero. This gives us a safe
    ;; left bound.
    (when (< start- 0)
      (setf start- 0))
    (loop for i from 0 upto (1- (min (min max 8) (- max start -8))) collect
          `(:id ,(+ start- i) :offset ,(* multiplier (+ start- i))))))

(defun generate-pages (length offset &optional (limit 10))
  "Generate pagination for LENGTH number of pages, with LIMIT number of items per page, offset into the list by OFFSET number of pages.
  
ARGUMENTS
LENGTH    The length of the array we're generating pages for.
OFFSET    The starting index.
LIMIT     The number of entries per page. Default is 10."
  (generate-pages-helper (floor (/ offset limit))
                         (ceiling (/ length limit))
                         limit))

(defun get-opposite-direction (direction)
  "Get the opposite direction"
  (if (string= direction "asc")
      "desc"
      "asc"))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Idea for RLE from PCL by Paul Graham
;; This implementation based on <https://gist.github.com/trhura/5820848>
;;
;; Nope it's not I wrote my own implementation!
(defun rle-encode (lst &key (key #'identity) (test #'eq))
  (loop for line in (mapcar key (remove-duplicates lst :key key :test test))
        collect (cons (count line lst :key key :test test) line)))
;; (sort * ;#'> :key #'car))

(defun rle-decode (lst)
  (loop for line in lst
        nconc (make-list 3 :initial-element (second line))))

;; XXX Where does this go?
(defun rle-encode-plist (plist &key (key #'identity) (test #'eq))
  (rle-encode
   (mapcar (lambda (plist)
             (setf (getf plist :name)
                   (princ-to-string (getf plist :name)))
             plist)
           plist)
   :key key :test test))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; For The Label Maker
;; https://tex.stackexchange.com/a/119383
(defun latex-escape (s)
  (cl-ppcre:regex-replace-all
   "(\\\\backslash)"
   (cl-ppcre:regex-replace-all
    "~"
    (cl-ppcre:regex-replace-all
     "(\\^)"
     (cl-ppcre:regex-replace-all
      "([\$\#&%_{}])"
      (cl-ppcre:regex-replace-all "\\" s "\\backslash")
      "\\\\\\1")
     "\\\\\\1{}")
    "\\\\texttt{\\~{}}")
   "$\\1$"))