;(load "~/quicklisp/quicklisp.lisp")
(load "~/quicklisp/setup.lisp")
;(ql:quickload "cl-typesetting")
(ql:quickload "cl-pdf")
(require 'cl-pdf)
(require 'cl-ppcre)

;(declaim (optimize (safety 2) (debug 3) (speed 0)))
(declaim (optimize (safety 2) (debug 3) (speed 1) (space 0) (compilation-speed 1)))
(if (> (length sb-ext:*posix-argv*) 1)
    (progn
      (defparameter *leer-este-archivo* (cadr sb-ext:*posix-argv*))
      (defparameter *escribir-este-archivo* (caddr sb-ext:*posix-argv*)))
    (progn
      (defparameter *leer-este-archivo* "~/pdf/drogmail.txt")
      (defparameter *escribir-este-archivo* "~/pdf/ecc2.pdf")))

(defun datos-procesamiento-de-linea ()
  (let ((istream nil)
	(cadena-leida "")
	(cadenas-extraidas nil))
    (break)
    (values
     (lambda (x) (setf istream x))
     (lambda (x) (setf cadena-leida x))
     (lambda (x) (setf cadenas-extraidas x))
     (lambda () istream)
     (lambda () cadena-leida)
     (lambda () cadenas-extraidas))))

(defun procesar-la-linea (cadena-leida-setter
			  cadenas-extraidas-setter
			  istream-setter
			  cadena-leida-getter
			  cadenas-extraidas-getter
			  istream-getter)


  (let* ((cadena-leida (funcall cadena-leida-getter))
	 (cadenas-extraidas (funcall cadenas-extraidas-getter))
	 (istream (funcall istream-getter)))
    (if (eql (length cadenas-extraidas) 0)
	(progn
	  (setf cadena-leida (read-line istream nil 'fin))
	  (funcall cadena-leida-setter cadena-leida)
	  (if (eq cadena-leida 'fin)
	      (setf cadenas-extraidas 'nil)
	      (setf cadenas-extraidas (cl-ppcre:split (string #\Page) cadena-leida)))
	  (funcall cadenas-extraidas-setter cadenas-extraidas))
	(funcall cadenas-extraidas-setter (cdr cadenas-extraidas )))))

(defun imprimir-el-texto (x y font size text)
  (break)
  (pdf:in-text-mode
    (pdf:set-font font size)
    (pdf:move-text x y)
    (pdf:draw-text (format nil "~A" text))))

(defun ajustar-rectangulo (coordenadas ajustes)
  (break)
  (loop
     for i in coordenadas
     for j in ajustes
     collect (+ i j)))

(defun imprimir-lineas (margenx topy font size)
  (break)
  (let ((nombre-de-archivo-pasado-por-parametro *leer-este-archivo*))
    (multiple-value-bind (istream-setter cadena-leida-setter cadenas-extraidas-setter istream-getter cadena-leida-getter cadenas-extraidas-getter)
     (datos-procesamiento-de-linea)
     (with-open-file (s nombre-de-archivo-pasado-por-parametro :direction :input :external-format :iso-8859-1)
       (funcall istream-setter s)
       (procesar-la-linea cadena-leida-setter cadenas-extraidas-setter istream-setter
			  cadena-leida-getter cadenas-extraidas-getter istream-getter)
	(do ((mypage 1 (setf mypage (+ 1 mypage)))
	     (hallada-primera-linea-no-en-blanco nil nil)
	     (m-imprimir-en-esta-linea-del-pdf 3 3))
	    ((or (eq (funcall cadena-leida-getter) 'fin)
		 (eql (length (funcall cadenas-extraidas-getter)) 0)))
	  (pdf:with-page ()
	    (pdf:add-font-to-page font)
	    (let* ((coords
		    (ajustar-rectangulo (coerce pdf:*a4-portrait-page-bounds* 'list)
					'(+1 +1 -2 -2)))
		   (coords-inner
		    (ajustar-rectangulo coords
					'(+0.5 +0.5 -1 -1))))
	      (apply #'pdf:rectangle coords)
	      (pdf:close-fill-and-stroke)
	      (pdf:set-rgb-fill 255.0 255.0 255.0)
	      (apply #'pdf:rectangle coords-inner )
	      (pdf:close-fill-and-stroke)
	      (pdf:set-rgb-fill 0 0 0)
	      (imprimir-el-texto 300 4 font 6 (format nil "Página ~A" mypage)))
	    (block control-L
	      (do* ((n 0 (setf n (+ 1 n)))
		    (m m-imprimir-en-esta-linea-del-pdf m-imprimir-en-esta-linea-del-pdf)
		    (posy (- topy (* size m)) (- topy (* size m))))
		   ((or
		     (eq (funcall cadena-leida-getter) 'fin)
		     (eql (length (funcall cadenas-extraidas-getter)) 0)
		     (< posy size)))
		(if hallada-primera-linea-no-en-blanco
		    (progn
		      (imprimir-el-texto margenx posy font size (car (funcall cadenas-extraidas-getter)))
		      (incf m-imprimir-en-esta-linea-del-pdf)
		      (when (length (funcall cadenas-extraidas-getter))
			(return-from control-L)))
		    (when (> (length (car (funcall cadenas-extraidas-getter))) 2)
		      (setf hallada-primera-linea-no-en-blanco t)))))))))))


(defun imprimir-documento ()
  (pdf:with-document ()
    (pdf:load-ttu-font "~/quicklisp/dists/quicklisp/software/cl-pdf-20191007-git/contrib/FreeMono.ufm" "~/quicklisp/dists/quicklisp/software/cl-pdf-20191007-git/contrib/FreeMono.ttf")
    (let ((margenx 20)
	  (topy 800)
	  (font (pdf:get-font "FreeMono"))
	  (size 11))
      (imprimir-lineas margenx topy font size))
    (pdf:write-document *escribir-este-archivo*)))

(imprimir-documento)