(require 'image-mode)
(require 'svg)

(defgroup image-roll nil
  "Image roll configurations.")

(defcustom image-roll-vertical-margin 2
  "Page gap height."
  :type 'integer)

(defcustom image-roll-step-size
  (lambda ()
    (let* ((o (image-roll-page-overlay))
           (s (overlay-get o 'display))
           (w (image-property s :width)))
      (if w
          (* 50
             (/  (float (if (consp w) (car w) w))
                 (window-pixel-height)))
        50)))
  "Scroll step size.
The value can be either a number or a function that takes no
arguments and returns a positive number. If the number is equal
to or larger than 1, it represents pixel units. Otherwise, if the
value is between 0 and 1, it represents a fraction of the current
page height."
  :type '(choice function interger float))

(defcustom image-roll-center nil
  "When non-nil, center the roll horizontally in the window."
  :type 'boolean)


(defvar-local image-roll-number-of-pages-function nil
  "Function that should return the total number of pages.
The function should return an integer with the total number of
pages in the document.")

(defvar-local image-roll-page-sizes-function nil
  "Function that should return page-sizes of document.
The function should return a list of conses of the form (WIDTH .
HEIGHT), both numbers.")

(defvar-local image-roll-set-redisplay-flag-function nil)

(defvar-local image-roll-display-page 'image-roll-demo-display-page
  "Function that sets the overlay's display property.
The function receives the page number as a single
argument (PAGE). The function should use `(image-roll-page-overlay
PAGE)' to add the image of the page as the overlay's
display-property.")

(defmacro image-roll-debug (object)
  `(progn (print (format "%s = %s" ,object (eval ,object))
                 #'external-debugging-output)
          (eval ,object)))

;; define as macro's for setf-ability

;; TODO update docstring
(defmacro image-roll-overlays (&optional window)
  "List of overlays that make up a scroll.
Overlays with an even index hold the page-overlays, where the
overlay at index 0 holds page number 1. For each page, except for
the last page, the subsequent element holds the gap-overlay."
  `(image-mode-window-get 'overlays ,window))

(defmacro image-roll-page-overlay (&optional page)
  "Return the overlay that hold page number PAGE.
Implemented as macro to make it setf'able."
  `(nth (1- ,page) (image-roll-overlays)))

(defmacro image-roll-page-overlay-get (page prop)
  "Get overlay-property PROP of overlay holding page number PAGE.
Implemented as macro to make it setf'able."
  `(overlay-get (nth (1- ,page) (image-roll-overlays))
                ,prop))

(defmacro image-roll-current-page (&optional window)
  "Return the page number of the currently displayed page.
The current page is the page that overlaps with the window
start (this choice was made in order to simplify the scrolling
logic)"
  `(image-mode-window-get 'page ,window))

(defun image-roll-overlay-height (page)
  (+ (cdr (image-roll-page-overlay-get page 'page-size))
     (* 2 image-roll-vertical-margin)))

(defun image-roll-visible-overlays ()
  "Page numbers corresponding of currently visible overlays.
The numbers are returned in a list. Overlays that are only
partially visible are included."
  (let* (visible
         (page (image-roll-current-page))
         (available-height (window-pixel-height)))

    (push page visible)
    (cl-decf available-height (- (image-roll-overlay-height page)
                                 (window-vscroll nil t)))
    (cl-incf page)

    (while (> available-height 0)
      (push page visible)
      (cl-decf available-height (image-roll-overlay-height page))
      (cl-incf page))
    visible))

(defun image-roll-undisplay-page (page)
  "Undisplay PAGE.
The function replaces the image display property of the overlay
holding PAGE with a space. It size is determined from the image
its `image-size'."
  (display-warning '(image-roll) (format "undisplay %s" page)
                   :debug "*image-roll-debug-log*")
  (let* ((o (image-roll-page-overlay page))
         (im (overlay-get o 'display))
         (s (image-size im t))
         (w (car s))
         (h (cdr s)))
    (overlay-put o 'display `(space . (:width (,w) :height (,h))))
    (overlay-put o 'face `(:background "gray"))))

(defun image-roll--new-window-function (winprops)
  "Function called first after displaying buffer in a new window.
If the buffer is newly created, then it does not contain any
overlay and this function creates erases the buffer contents
after which it inserts empty spaces that each holds a page or gap
overlay. If the buffer already has overlays (i.e. a second or
subsequent window is created), the function simply copies the
overlays and adds the new window as window overlay-property to
each overlay."
  ;; (if (= (buffer-size) 0)
  (if (not (overlays-at 1))
      (let (overlays
            (pages (if image-roll-number-of-pages-function
                       (funcall image-roll-number-of-pages-function)
                     image-roll-demo-number-of-pages))
            (win (car winprops))
            (inhibit-read-only t))

        (erase-buffer)

        ;; here we only add the 'page' and 'window' overlay-properties, we add
        ;; more properties/information as soon as it becomes available in the
        ;; 'image-roll-display' function
        (dotimes (i pages)
          (let ((i (1+ i)))
            (insert " ")
            (let ((po (make-overlay (1- (point)) (point))))
              (overlay-put po 'page  i)
              (overlay-put po 'window win)
              (push po overlays))
            (insert "\n")))
        (delete-char -1)
        (image-mode-window-put 'overlays (nreverse overlays))
        (set-buffer-modified-p nil)

        ;; we must put the cursor at the `point-min' for the vscroll
        ;; functionality to work. It is only required here because we will never
        ;; move the cursor (we will merely update overlay properties and vscroll)
        ;; (goto-char (point-min))

        ;; required to make `pdf-view-redisplay-some-windows' call `pdf-view-redisplay'
        (when-let (fun image-roll-set-redisplay-flag-function)
          (funcall fun)))
    (let ((ols (mapcar (lambda (o)
                         (let ((oc (copy-overlay o)))
                           (overlay-put oc 'window (car winprops))
                           oc))
                       (image-roll-overlays))))
      (image-mode-window-put 'overlays ols winprops)))
  (image-roll-goto-page 1))

(defun image-roll--redisplay (&optional window no-relative-vscroll)
  "Redisplay the scroll.
Besides that this function can be called directly, it should also
be added to the `window-configuration-change-hook'.

The argument WINDOW is not use in the body, but it exists to make
the function compatible with `pdf-tools' (in which case is a
substitute for `pdf-view-redisplay').

When NO-RELATIVE-SCROLL is non-nil, then the relative-scroll is
not included when setting teh vscroll position. For example this
is used in `pdf-view-goto-page' (in the `pdf-scroll.el'
extension) to make it scroll to the start of the page."
  (display-warning '(image-roll) (format "redisplay %s" (car (image-mode-winprops))) :debug "*image-roll-debug-log*")

  ;; NOTE the `(when (listp image-mode-winprops-alist)' from
  ;; `image-mode-reapply-winprops' was removed here (but in the end might turn
  ;; out to be required)

  ;; Beware: this call to image-mode-winprops can't be optimized away, because
  ;; it not only gets the winprops data but sets it up if needed (e.g. it's used
  ;; by doc-view to display the image in a new window).
  (image-mode-winprops nil t)
  (let* ((pages image-roll-demo-number-of-pages)
         ;; (page-sizes (make-list pages (cons (- (window-text-width nil t) 200)
         ;;                                    (* 1.4 (window-text-width nil t)))))
         (page-sizes (if image-roll-page-sizes-function
                         (funcall image-roll-page-sizes-function)
                       (make-list pages (if (functionp image-roll-demo-page-size)
                                            (funcall image-roll-demo-page-size)
                                          image-roll-demo-page-size))))
         ;; (let ((w (window-pixel-width)))
         ;;   (make-list pages (cons w (* 1.4 w))))))

         (n 0))
         ;; (vpos 0))

    (dolist (page-size page-sizes)
      (let* ((page-width (car page-size))
             (overley-heigth (+ (cdr page-size) (* 2 image-roll-vertical-margin)))
             (o (nth n (image-roll-overlays))))
        (when image-roll-center
          (overlay-put o 'before-string
                       (when (> (window-pixel-width) page-width)
                         (propertize " " 'display
                                     `(space :align-to
                                             (,(floor (/ (- (window-pixel-width) page-width) 2))))))))
        (overlay-put o 'display `(space . (:width (,page-width) :height (,overley-heigth))))
        (overlay-put o 'face `(:background "gray"))
        (overlay-put o 'page-size page-size)
        (setq n (+ n 1)))))
  ;; (let ((current-page (car (image-mode-window-get 'displayed-pages))))
  (let (displayed)
    (dolist (p (image-roll-visible-overlays))
      (funcall image-roll-display-page p)
      (push p displayed))
  ;; (image-mode-window-put 'page (car (last displayed))) ; TODO check if possible to use 'displayed-pages
  (image-mode-window-put 'displayed-pages (reverse displayed))
  (image-mode-window-put 'visible-pages-vscroll-limit
                         (- (apply #'+ (mapcar #'image-roll-overlay-height displayed))
                            (window-text-height nil t))))
  (when-let (p (image-roll-current-page))
    (goto-line p)
    ;; (redisplay)
    (image-set-window-vscroll (or (image-mode-window-get 'vscroll) 10))))

(defun image-roll-goto-page (page &optional window)
  "Go to PAGE in PDF.

If optional parameter WINDOW, go to PAGE in all `pdf-view'
windows."
  (interactive
   (list (if current-prefix-arg
             (prefix-numeric-value current-prefix-arg)
           (read-number "Page: "))))
  (unless (and (>= page 1)
               (<= page (count-lines (point-min) (point-max))))
    (error "No such page: %d" page))
  ;; (unless window
  ;;   (setq window
  ;;         (if (pdf-util-pdf-window-p)
  ;;             (selected-window)
  ;;           t)))
  (save-selected-window
    ;; Select the window for the hooks below.
    (when (window-live-p window)
      (select-window window 'norecord))
    (let ((changing-p
           (not (eq page (image-roll-current-page window)))))
      (when changing-p
        ;; (run-hooks 'pdf-view-before-change-page-hook)
        (setf (image-roll-current-page window) page)
        ;; (run-hooks 'pdf-view-change-page-hook))
      (when (window-live-p window)
        (image-roll--redisplay window))
      ;; (when changing-p
      ;;   (pdf-view-deactivate-region)
      ;;   (force-mode-line-update)
      ;;   (run-hooks 'pdf-view-after-change-page-hook))))
  nil))))

(defun image-roll-update-displayed-pages ()
  (let ((old (print (image-mode-window-get 'displayed-pages) #'external-debugging-output))
        (new (print (image-roll-visible-overlays) #'external-debugging-output)))
    ;; dolist because if images/pages are small enough, there might be
    ;; multiple image that need to get updated
    (dolist (p (cl-set-difference old new))
      (image-roll-undisplay-page p)
      (image-mode-window-put 'displayed-pages
                             (setq old (delete p old)))) ; important to update/setq old before
    ;; setting/appending new below
    (dolist (p (cl-set-difference new old))
      (funcall image-roll-display-page p)
      (image-mode-window-put 'displayed-pages (setq old (append old (list p)))))
    ;; update also visible-range
    (image-mode-window-put 'visible-pages-vscroll-limit
                           (- (apply #'+ (mapcar #'image-roll-overlay-height new))
                              (window-text-height nil t)))))

(defun image-roll-next-page (&optional n)
  (interactive)
  (cl-incf (image-roll-current-page) (or n 1))
  ;; (set-window-start nil (+ (point) 2))
  (image-roll--redisplay))

(defun image-roll-previous-page ()
  (interactive)
  (image-roll-next-page -1))

(defun image-roll-scroll-forward (&optional backward screen)
  (interactive)
  (let* ((current-page (image-roll-current-page))
         (current-overlay-height (image-roll-overlay-height current-page))
         (visible-pages-vscroll-limit (image-mode-window-get 'visible-pages-vscroll-limit))
         (step-size (if screen
                        (window-text-height nil t)
                      image-roll-step-size))

         ;; determine number of pages to forward/backward
         ;; (required if pages are small)
         (n 0)
         (available-height step-size)
         (remaining-height available-height)
         new-vscroll)
    (cond (backward
           (cl-decf available-height (window-vscroll nil t))
           (while (> available-height 0)
             (setq remaining-height available-height)
             (setq n (1+ n))
             (cl-decf available-height (image-roll-overlay-height (- current-page n))))
           (setq n (- n)))
          (t
           (cl-decf available-height (- (image-roll-overlay-height current-page)
                                        (window-vscroll nil t)))
           (while (> available-height 0)
             (setq remaining-height available-height)
             (setq n (1+ n))
             (cl-decf available-height (image-roll-overlay-height (+ current-page n))))))

    (when backward
      (setq step-size (- step-size)))

    (image-roll-debug 'n)

    (if (= n 0)
        (setq new-vscroll (+ (window-vscroll nil t) step-size))
      (setq new-vscroll (+ (window-vscroll nil t) remaining-height)))


    (if (cond ((< n 0)
               (forward-line n)
               (cl-decf (image-roll-current-page))
               (image-set-window-vscroll
                (- (image-roll-overlay-height (image-roll-current-page))
                   remaining-height)))
              ((> n 0)
               (forward-line n)
               (cl-incf (image-roll-current-page) n)
               (image-set-window-vscroll
                remaining-height))
              ((> (image-roll-debug 'new-vscroll)
                  (image-roll-debug 'visible-pages-vscroll-limit))
               (image-set-window-vscroll new-vscroll)))
        (image-roll-update-displayed-pages)
      (image-set-window-vscroll new-vscroll))))

(defun image-roll-scroll-backward ()
  (interactive)
  (image-roll-scroll-forward t))

(defun image-roll-scroll-screen-forward ()
  (interactive)
  (image-roll-scroll-forward nil t))

(defun image-roll-scroll-screen-backward ()
  (interactive)
  (image-roll-scroll-forward t t))

(defun image-roll-demo-display-page (page)
  "Return demo image of page.
This function is used for the image-roll-demo."
  (image-roll-debug 'page)
  (let* ((o (image-roll-page-overlay page))
         (s (cdr (overlay-get o 'display)))
         (w (car (plist-get s :width)))
         (h (car (plist-get s :height)))
         (svg (svg-create w h)))
    (unless w (print "NO W" #'external-debugging-output))
    (svg-rectangle svg 0 0 w h :fill-color "white")
    (svg-text svg
              (number-to-string page)
              :font-size "40"
              :fill "black"
              :x 20
              :y 50)
    (when image-roll-center
      (overlay-put o 'before-string
                   (when (> (window-pixel-width) w)
                     (propertize " " 'display
                                 `(space :align-to
                                         (,(floor (/ (- (window-pixel-width) w) 2))))))))
    (overlay-put o 'display (svg-image svg :margin `(0 . ,image-roll-vertical-margin)))))

(define-derived-mode image-roll-mode special-mode "Image Roll"
  ;; we don't use `(image-mode-setup-winprops)' because it would additionally
  ;; add `image-mode-reapply-winprops' to the
  ;; `window-configuration-change-hook', but `image-roll--redisplay' already
  ;; reapplies the vscroll, so we simply initialize the
  ;; `image-mode-winprops-alist' here, and add lines from
  ;; `image-mode-reapply-winprops' at the start of `image-roll--redisplay'.
  (add-hook 'window-configuration-change-hook 'image-roll--redisplay nil t)
  (add-hook 'image-mode-new-window-functions 'image-roll--new-window-function nil t)
  (unless (listp image-mode-winprops-alist)
    (setq image-mode-winprops-alist nil)))
;; (add-hook 'window-configuration-change-hook
;;           #'image-mode-reapply-winprops nil t))
;; (image-mode-setup-winprops))

(setq image-roll-mode-map
      (let ((map (make-sparse-keymap)))
        (define-key map (kbd "<down>") 'image-roll-scroll-forward)
        (define-key map (kbd "<up>") 'image-roll-scroll-backward)
        (define-key map (kbd "<next>") 'image-roll-next-page)
        (define-key map (kbd "<prior>") 'image-roll-previous-page)
        (define-key map (kbd "S-<next>") 'image-roll-scroll-screen-forward)
        (define-key map (kbd "S-<prior>") 'image-roll-scroll-screen-backward)
        map))

(when (featurep 'evil)
  (evil-define-key 'motion image-roll-mode-map
    "j" 'image-roll-scroll-forward
    "k" 'image-roll-scroll-backward
    "J" 'image-roll-next-page
    "K" 'image-roll-previous-page
    (kbd "C-j") 'image-roll-scroll-screen-forward
    (kbd "C-k") 'image-roll-scroll-screen-backward))

(defun image-roll-demo (&optional page-size pages)
  (interactive)
  (with-current-buffer (get-buffer-create "*image-roll-demo*")
    (erase-buffer)
    (image-roll-mode)
    (setq cursor-type nil)
    (setq image-roll-step-size 50)
    (setq-local image-roll-demo-page-size (or page-size
                                              (lambda ()
                                                (let ((w (window-pixel-width)))
                                                  (cons w (* 1.4 w))))))
    (setq-local image-roll-demo-number-of-pages (or pages 1000))
    (setq image-roll-center t)
    (switch-to-buffer (current-buffer))))