;;; page.el ---                                      -*- lexical-binding: t; -*-

;; Copyright (C) 2020  Arthur Miller

;; Author: Arthur Miller <arthur.miller@live.com>
;; Keywords: 

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:
;;
;; documnet is just a plain buffer with bunch of local variables
;; 
;; page, footer, header and clientarea are ranges between points in the
;; buffer
;; (bopp) (eopp) (bohp) (eohp) (bocp) (eocp) <- similar as (bobp) (eobp)
;;
;; currently footer and header are global for all pages; it would be easy to
;; make them page-unique; just not done currently
;;

;;; Code:
(require 'svg)
(require 'paper-size-iso)

(defface fill-face
  '((t :foreground "white" :background "white" :box "white" :height 100))
  "Default face for document background" :group 'doc)

(defface page-break-face
  '((t :foreground "grey" :background "grey" :box "grey"))
  "Default face for page breaks" :group 'doc)

(defun doc-page-break (doc)
  (let ((svg) (w) (h))
    (with-current-buffer (get-buffer doc)
      (unless pagebreak-svg
        (setq w page-pixel-width
              h (window-font-height nil 'fill-face))
        (message "W: %s H: %s" w h)
        (setq svg (svg-create w h))
        (svg-rectangle svg 0 0 w h :fill "grey")
        (setq pagebreak-svg (svg-image svg :ascent 'center)))
    pagebreak-svg)))

(defun doc-new (&optional title)
  (interactive)
  
  (unless title
    (setq title "New Document"))

  (let ((doc (generate-new-buffer title)))

    (with-current-buffer (get-buffer-create doc)

      (setq screen-res 96
            print-res 300
            format 'A4
            orientation 'portrait
            pages 1
            current-page 0
            page-rows 0
            page-cols 0
            header nil
            footer nil
            document (current-buffer)
            pagebreak-svg nil
            real-pixel-width 0
            page-pixel-width 0
            page-pixel-height 0)

      (make-local-variable 'document)
      (make-local-variable 'title)
      (make-local-variable 'screen-res)
      (make-local-variable 'print-res)
      (make-local-variable 'format)
      (make-local-variable 'orientation)
      (make-local-variable 'pages)
      (make-local-variable 'current-page)
      (make-local-variable 'page-pixel-width)
      (make-local-variable 'page-pixel-height)
      (make-local-variable 'page-rows)
      (make-local-variable 'page-cols)
      (make-local-variable 'real-pixel-width)
      (make-local-variable 'header)
      (make-local-variable 'footer)
      (make-local-variable 'pagebreak-svg)
      
      (let ((dims (paper-size-iso-in-to-pixels format screen-res)))
        (setq page-pixel-width (car dims))
        (setq page-pixel-height (cdr dims))))

      (switch-to-buffer doc)
      (doc-insert-page doc (point-min))
  document))

(defun doc-append-page ()
  "Append a new page at the end"
  (interactive)
  (with-current-buffer (buffer-name)
  (doc-insert-page (buffer-name) (point-max))))

(defun doc-insert-pagebreak (buffer point)
  (with-current-buffer buffer
    (goto-char point)
    (setq real-pixel-width
	  (car (window-text-pixel-size
                nil (beginning-of-line) (end-of-line))))
    (insert ?\n)
    ;; (insert ?\^L)
    ;; (set-text-properties (line-beginning-position) (line-end-position)
    ;;                      `(face nil display ,(doc-page-break buffer)))
    ;; (newline)
    ))

(defun doc-insert-footer (buffer point)
  (save-excursion
    (with-current-buffer buffer
      (goto-char point)
      (insert (buffer-substring (car footer) (cdr footer))))))

(defun doc-insert-header (buffer point)
  (save-excursion
    (with-current-buffer buffer
      (goto-char point)
      (insert (buffer-substring (car header) (cdr header))))))

(defun doc-insert-page (buffer point)
  "Insert page at point."
  (with-current-buffer buffer
    (hl-line-mode -1)
    (auto-fill-mode -1)
    (goto-char point)
    ;; Emacs needs a live window to calculate pixel sizes
    ;; so we have to calculate stuff when first page is shown
    (if (= 0 current-page)
        (let* ((w 0) (h 0) (space-width) (space-height) (d)
              (font-width (window-font-width nil 'fill-face))
              (font-height (window-font-height nil 'fill-face)))

          (insert ?\s)
          (set-text-properties point (point-max) '(face fill-face))
          (setq space-width (car (window-text-pixel-size
                                  nil (beginning-of-line) (end-of-line))))
          (setq space-height (cdr (window-text-pixel-size
                                  nil (beginning-of-line) (end-of-line))))
          (setq cols (truncate (fround (/ page-pixel-width font-width))))
          (setq rows (truncate (fround (/ page-pixel-height font-height))))
          (setq cols (+ cols (truncate (/ 158 font-width)))) ;; some nasty magick here
          (delete-backward-char 1)

          (setq page-cols cols page-rows rows)
          (while (< h rows)
            (self-insert-command cols ?\s)
            (setq h (+ h 1))
            (newline)))
      (progn ;; we already have page dimensions
        (doc-insert-pagebreak buffer (point))
        (setq point (point))
        (dotimes (i page-rows)
          (self-insert-command page-cols ?\s)
          (newline))))
    (set-text-properties point (point-max) '(face fill-face))
    (setq current-page (+ current-page 1))
    ;;(setq pages (append pages (list point (- (point-max) 1))))
    ))

(defun buffer-document (&optional buffer)
  (unless buffer
    (setq buffer (buffer-name)))
  (with-current-buffer (get-buffer buffer)
    document))

(defun doc-set-footer (begin end)
  "Set current region as footer."
  (interactive "r")
  (with-current-buffer (buffer-document)
    (setq footer (cons begin end))))

(defun doc-set-header (begin end)
  "Set current region as header."
  (interactive "r")
  (with-current-buffer (buffer-document)
    (setq header (cons begin end))))

(provide 'page)
;;; page.el ends here