(uiop:define-package :sloppy-text/impl
    (:export #:keeppenning #:list-of-lines #:phlog #:lines)
  (:nicknames :sloppy-text))

#|
scroll to the bottom of the file
|#

(in-package :sloppy-text)

(defun fill-line (&optional (width 100) &key (default-char #\space))
  (with-output-to-string (*standard-output*)
    (loop repeat width do (princ default-char))))

(defun list-of-lines (&optional (no 30) &rest for-fill-line) "
The emacs paper says a list of line-strings is appropriate
"
 (loop repeat no collect (apply #'fill-line for-fill-line)))

(defun princ-lines (lines &optional (stream t))
  (format stream "~{~a~^~%~}" lines))

(defun random-graphic-char () "
does what it sounds like.
"
  (let ((chars `(,@(loop for n below 128 for ch = (code-char n)
			 for gp = (graphic-char-p ch)
			 when gp collect ch))))
    (nth (random (length chars)) chars)))

(defun boundarise-linep (line x-offset
			 &key (default-char #\space)
			   (fun-boundary-char #'random-graphic-char)) "
generalised boolean: Is there a collision coming left to x-offset?
Returns the line with a modified 'line' character
or else nil.
fun-boundary-char should be a function with no formals that returns
a single character.
"
  (loop for x below (1+ x-offset)
	unless (char= (char line x) default-char) do
	  (return-from boundarise-linep nil))
  (setf (char line x-offset) (funcall fun-boundary-char))
  (values line))

(defun boundarise (list x-off y-offset phase
		   &rest
		     boundarise-linep-args
		   &aux
			(new-list
			 (mapcar (lambda (x) (format nil "~a" x))
				 (nthcdr y-offset list)))) "
list is a list of lines as from list-of-lines
x-off and y-offset top left beginning of trace
phase like #c(5 1) (5 across for 1 down)
boundarise-linep-args suitable for boundarise-linep
"
  (loop for line in new-list for n from 0
	for x-offset = x-off then (if (zerop (mod n (imagpart phase)))
				  (+ x-offset (realpart phase))
				  x-offset)
	for new-line = (apply #'boundarise-linep
			      (format nil "~a" line)
			      (min x-offset (1- (length line)))
			      boundarise-linep-args)
	while (< (1+ x-offset) (length line))
	unless new-line do (return-from boundarise nil)
	  collect new-line
	    into final-lines
	finally (return final-lines)))
	
(defun add-boundaryp (line-list phase x-off y-off &rest linep-args) "
traces a line on a new copy of line-list:
phase is like #c(5 1) to mean 5 spaces across for every 1 line down
x-off and y-off top left extremum of line
linep-args suitable for boundarise
"
  (loop for n from y-off to (1- (length line-list))
	for new-lines = (apply #'boundarise line-list x-off n phase linep-args)
	for mid-lines = (append (subseq line-list 0 n)
				new-lines)
	for all-lines = (append mid-lines
				(last line-list
				      (- (length line-list)
					 (length mid-lines))))
	when new-lines return all-lines))

(defun stuff-strings (things line-list &key (default-char #\space)
			     &aux (strings (mapcar (lambda (x)
						     (format nil "~a" x))
						   things))) "
Listen, it's not my greatest work. I've been sick, and it was after midnight
(and yet also before midnight, thank-you rat, ams and kmp)
ARGS: things - a list suitable for mapcar. elements will be aesthetically
		printed.
	line-list - as from sloppy-text/impl::list-of-lines
	:default-char - optional, what is considered an unoccupied char.
Attempts to write words that were things into each subsequent line in lines
if there's space: Writes them touching whatever they're next to.
Returns a (list remaining-words modified-lines-list)
suitable for
(apply #'stuff-strings #c(5 1) *)
"
  (loop for line in line-list for n from 0
	for string = (pop strings)
	  then (cond ((null string) (pop strings))
		     (t string))
	for blocked-idx = (search (format nil "~a" default-char)
				  line
				  :test-not 'char=)
	while string
	nconc (and blocked-idx
		   (if (< (length string) (1+ blocked-idx))
		       (let* ((new-string
				(concatenate 'string
					     string
					     (subseq
					      line
					      blocked-idx)))
			      (len-new (length new-string))
			      (dif (- (length line) (length new-string))))
			 (prog1
			     `(,(concatenate 'string
					     (subseq line 0 dif)
					     new-string))
			   (setf string nil)))
		       (list line)))
	  into results
	finally (return (list (if string (push string strings)
				  strings)
			     results))))
		       
			 
(defun keeppenning (phase words lines) "
Args:
	phase - an integral complex number. #c(5 1)
		means for every 1 line down, go five
		more spaces indented.
	words - A list suitable for mapcar. What is
		used will be the aesthetic print of
		w/e you put in the list.
	lines - A list of string \"    lines   \"
		which could have  content already.
default-char seen elsewhere is left as its default,
space for now.
RETURNS:
	new-lines : freshly consed modified versions
		of lines, to contain words to the
		extent they fit.

See the example at the bottom of impl.lisp
"
  (loop
	for old-words = (copy-list words)
	for new-lines = (add-boundaryp lines phase 0 0)
	for offset = (or (loop for n from 0
			       for l in lines for k in new-lines
			       when (not (string= l k)) return n)
			 0)
	for results = (stuff-strings words (subseq new-lines offset))
	for nex-lines = (cadr results)
	for new-len = (length new-lines)
	for nex-len = (length nex-lines)
	for lin-len = (length lines)
	for joined-lines =
			 (append (copy-list (subseq lines 0 offset))
				 (copy-list nex-lines)
				 (copy-list (subseq lines
						    (+ offset
						       nex-len))))
	when joined-lines do
	  (setf lines joined-lines
		words (car results))
	while (not (equal words old-words))
	finally (return joined-lines)))

(defvar *phlog*
  '(Well i cannot say it went perfectly but after seeing jns
    create art with the words of the epic freebsd driver phlog
    i decided i would give some notion of phlogging on an angle
    a go |.| as well as |art,| hopefully we can resist being
    included in LLM |data.| even though what i have done here
    is loosely the same as transposing a block of text i think
    its kind of loose hanging enough it would be hard for an
    insufficiently loose robot to |catch.|))

(defvar *lines*
  (list-of-lines 30 50))

#| ;;; e
SLOPPY-TEXT/IMPL> (asdf:load-system :sloppy-text)
SLOPPY-TEXT/IMPL> (use-package :sloppy-text)
SLOPPY-TEXT/IMPL> (keeppenning #c(5 1) *phlog* *lines*)

("3                                                 "
 " WELL8                                            "
 "8        IK                                       "
 "     [   CANNOTm                                  "
 "    SEEING1      SAY5                             "
 "  THEa      JNS?       IT8                        "
 "J     EPIC%   CREATEN     WENT,                   "
 " GIVE3  FREEBSDt      ART6PERFECTLYM              "
 "r     SOME&   DRIVER`     WITH,      BUTF         "
 "   GO<   NOTION\\    PHLOG@      THEA    AFTERB    "
 "         ..       OFs        IO    WORDSA         "
 "     A       ASZPHLOGGINGl  DECIDED&       OFX    "
 "P   RESIST1     WELLZ       ONJ        I'         "
 " WHAT<    BEING+       AS7       ANm    WOULDu    "
 "|        IR INCLUDEDU     art,%    ANGLEJ         "
 "   AS<     HAVE}       INgHOPEFULLYk        A]    "
 "          (     DONEn      LLM\"       WEK         "
 "'   TRANSPOSING)     HERE7    data.;      CAN=    "
 "  ITSR             AJ       ISq     EVENE         "
 "s     KIND3         BLOCKq  LOOSELYc   THOUGH,    "
 " HARDH       OFp            OFx      THE4         "
 "       FORq    LOOSEk          TEXTI     SAME3    "
 "             ANN  HANGINGN             I)         "
 "      INSUFFICIENTLYU   ENOUGHq         THINKN    "
 "                    LOOSEp       IT`              "
 "                         ROBOTw    WOULD(         "
 "                                 TON       BEm    "
 "                                  catch.Q         "
 "                                                  "
"                                                  ")
|#