;;; -*- mode: Lisp; Syntax: Common-Lisp; -*-
;;;
;;; Copyright (c) 2009 by the authors.
;;;
;;; See LICENCE for details.

(in-package :hu.dwim.projectional-editor)

;;;;;;
;;; Table to text projection

(def class* projection/table-to-text (projection)
  ())

;;;;;;
;;; Table to text projection constructors

(def (function e) make-projection/table-to-text ()
  (make-instance 'projection/table-to-text))

;;;;;;
;;; Table to text printer

(def method project-document (table-document (projection projection/table-to-text))
  (bind ((mapping (make-mapping)))
    (labels ((recurse (input input-reference output-reference x y)
               (bind ((typed-input-reference `(the ,(form-type input) ,input-reference)))
                 (etypecase input
                   (document
                    (if (eq input table-document)
                        (recurse (content-of input) `(content-of ,typed-input-reference) `(content-of (the document ,output-reference)) x y)
                        input))
                   (table/table
                    (bind ((row-heights (table/row-heights input))
                           (column-widths (table/column-widths input)))
                      (make-text/document (iter (for row-index :from 0)
                                                (for row :in-sequence (rows-of input))
                                                (for row-height = (elt row-heights row-index))
                                                (for text-reference = `(content-of (the text/string (elt (the list (elements-of (the text/paragraph (elt (the list (elements-of (the text/document ,output-reference))) ,(+ y row-index))))) 0))))
                                                (appending (iter (with cell-text-lines = (make-array row-height :initial-element ""))
                                                                 (for cell-index :from 0)
                                                                 (for cell :in-sequence (cells-of row))
                                                                 (for content = (content-of cell))
                                                                 (for column-width = (elt column-widths cell-index))
                                                                 (for table-reference = `(content-of (the table/cell (elt (the list (cells-of (the table/row (elt (the list (rows-of ,typed-input-reference)) ,row-index)))) ,cell-index))))
                                                                 (labels ((append-text-document (text-document)
                                                                            (iter (for text-line-index :from 0 :below row-height)
                                                                                  (setf (elt cell-text-lines text-line-index)
                                                                                        (string+ (elt cell-text-lines text-line-index)
                                                                                                 (bind ((cell-string (with-output-to-string (string)
                                                                                                                       (when (> (length (elements-of text-document)) text-line-index)
                                                                                                                         (iter (for element-index :from 0)
                                                                                                                               (for element :in-sequence (elements-of (elt (elements-of text-document) text-line-index)))
                                                                                                                               #+nil
                                                                                                                               (insert-character-mapping mapping
                                                                                                                                                         `(content-of (the text/string (elt (the list (elements-of (the text/paragraph (elt (the list (elements-of (the text/document (content-of (the document ,table-reference))))) ,text-line-index)))) ,element-index)))
                                                                                                                                                         text-reference
                                                                                                                                                         (length (content-of element))
                                                                                                                                                         :output-offset (+ (length (elt cell-text-lines text-line-index))
                                                                                                                                                                           (file-position string)))
                                                                                                                               (write-string (content-of element) string))))))
                                                                                                   (string+ cell-string (make-string-of-spaces (- column-width (length cell-string))))))))))
                                                                   (etypecase content
                                                                     (string
                                                                      ;;(format t "~A ~A~%" text-reference (+ x (length (elt cell-text-lines 0))))
                                                                      (insert-character-mapping mapping table-reference text-reference (length content) :output-offset (+ x (length (elt cell-text-lines 0))))
                                                                      (iter (for text-line-index :from 0 :below row-height)
                                                                            (setf (elt cell-text-lines text-line-index)
                                                                                  (string+ (elt cell-text-lines text-line-index)
                                                                                           (if (zerop text-line-index)
                                                                                               (string+ content (make-string-of-spaces (- column-width (length content))))
                                                                                               (make-string-of-spaces column-width))))))
                                                                     (table/table
                                                                      (append-text-document (recurse content table-reference output-reference
                                                                                                     (+ x (length (elt cell-text-lines 0))) (+ y row-index)))
                                                                      (incf y (1- row-height)))
                                                                     (document
                                                                      (bind ((document-content (content-of content)))
                                                                        (etypecase document-content
                                                                          (text/document
                                                                           (append-text-document document-content)))))))
                                                                 (finally (return (iter (for text-line :in-sequence cell-text-lines)
                                                                                        (collect (make-text/paragraph (list (make-text/string text-line)))))))))))))))))
      (make-document (recurse table-document 'document 'document 0 0)
                     :selection (map-reference-forward mapping (selection-of table-document))
                     :source (make-source table-document projection mapping)))))

(def function table/row-heights (table)
  (bind ((rows (rows-of table)))
    (when rows
      (iter (for index :from 0 :below (length rows))
            (collect (iter (for cell :in-sequence (cells-of (elt rows index)))
                           (for content = (content-of cell))
                           (maximizing (etypecase content
                                         (string (1+ (funcall 'count #\NewLine content)))
                                         (table/table (apply 'sum (table/row-heights content)))
                                         (document
                                          (bind ((document-content (content-of content)))
                                            (etypecase document-content
                                              (text/document (length (elements-of document-content)))
                                              (table/table (apply 'sum (table/row-heights document-content))))))))))))))

(def function table/column-widths (table)
  (bind ((rows (rows-of table)))
    (when rows
      (iter (for index :from 0 :below (length (cells-of (first-elt rows))))
            (collect (iter (for row :in-sequence rows)
                           (for content = (content-of (elt (cells-of row) index)))
                           (maximizing (etypecase content
                                         (string (iter (for line :in (split-sequence:split-sequence #\NewLine content))
                                                       (maximizing (length line))))
                                         (table/table (apply 'sum (table/column-widths content)))
                                         (document
                                          (bind ((document-content (content-of content)))
                                            (etypecase document-content
                                              (text/document (iter (for paragraph :in-sequence (elements-of document-content))
                                                                   (maximizing (iter (for element :in-sequence (elements-of paragraph))
                                                                                     (summing (length (content-of element)))))))
                                              (table/table (apply 'sum (table/row-heights document-content))))))))))))))

;;;;;;
;;; Table to text reader

(def method read-operation (table-document (projection projection/table-to-text) xxx)
  (bind ((operation (operation-of xxx)))
    (cond ((typep operation 'operation/replace-selection)
           (make-operation/replace-selection (map-reference-backward (mapping-of (source-of (document-of xxx))) (selection-of operation))))
          (t operation))))