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

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

;;;;;;;;
;;;; Table domain provides:
;;;;  - table
;;;;  - row
;;;;  - cell

;;;;;;
;;; Data structure

(def class* table/base ()
  ())

(def class* table/table (table/base)
  ((rows :type sequence)))

(def class* table/row (table/base)
  ((cells :type sequence)))

(def class* table/cell (table/base)
  ((content :type t)))

;;;;;;
;;; Construction

(def (function e) make-table/table (rows)
  (make-instance 'table/table :rows rows))

(def (function e) make-table/row (cells)
  (make-instance 'table/row :cells cells))

(def (function e) make-table/cell (content)
  (make-instance 'table/cell :content content))

;;;;;;
;;; Construction

(def (macro e) table/table (() &body rows)
  `(make-table/table (list ,@rows)))

(def (macro e) table/row (() &body cells)
  `(make-table/row (list ,@cells)))

(def (macro e) table/cell (() &body content)
  `(make-table/cell ,(first content)))

;;;;;;
;;; API

(def (function e) 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 (+ 1 (apply 'sum (table/row-heights content))
                                                         (length (rows-of 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 e) 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 (+ 1 (apply 'sum (table/column-widths content))
                                                         (length (cells-of (first-elt (rows-of 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))))))))))))))

;;;;;;
;;; Provider

(def (function e) table-color-provider (iomap reference)
  (map-backward iomap reference
                (lambda (iomap reference)
                  (declare (ignore iomap))
                  (pattern-case reference
                    ((the character (elt (the string (border-of ?a)) ?b))
                     (return-from table-color-provider
                       (sdl:color :r 196 :g 196 :b 196)))))))