;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CL-USER; Base: 10 -*-
;;; $Header: src/frontend/components/pager.lisp $

;;; Copyright (c) 2008, Andrea Chiumenti.  All rights reserved.

;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:

;;;   * Redistributions of source code must retain the above copyright
;;;     notice, this list of conditions and the following disclaimer.

;;;   * Redistributions in binary form must reproduce the above
;;;     copyright notice, this list of conditions and the following
;;;     disclaimer in the documentation and/or other materials
;;;     provided with the distribution.

;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

(in-package :claw-demo-frontend)

(defgeneric pager-count-pages (pager))

(defgeneric pager-current-page (pager))

(defgeneric pager-page-list (pager))

(defgeneric set-offset-value (pager page))

(defclass pager (wcomponent)
  ((update-component-id :initarg :update-component-id
                        :accessor pager-update-component-id)
   (class :initarg :class
          :reader pager-class)
   (page-size :initarg :page-size
              :reader pager-page-size)
   (visible-pages :initarg :visible-pages
                  :accessor pager-visible-pages)
   (total-items :initarg :total-items
                :accessor pager-total-items)
   (first-item-offset :initarg :first-item-offset
                      :accessor pager-first-item-offset))
  (:metaclass metacomponent)
  (:default-initargs :page-size 10 :visible-pages 10 :class "pager"))

(defmethod wcomponent-template ((pager pager))
  (let ((total-items (pager-total-items pager))
        (page-size (pager-page-size pager))
        (page-list (pager-page-list pager))
        (current-page (pager-current-page pager))
        (count-pages (pager-count-pages pager))
        (id (htcomponent-client-id pager)))
    (when (> total-items page-size)
      (div>
       :static-id id
       :class (pager-class pager)
       (wcomponent-informal-parameters pager)

       (when (> current-page 1)
         (list (div> :class "button first"
                     (span> :on-click (set-offset-value pager 1) "first"))
               (div> :class "button previous"
                     (span> :on-click (set-offset-value pager (1- current-page)) "previous"))))
       (loop for page in page-list
          collect (if (= page current-page)
                      (div> :class "current page"
                            (span> (format nil "~a" page)))
                      (div> :class "page" (span> :on-click (set-offset-value pager page) (format nil "~a" page)))))
       (when (< current-page count-pages)
         (list (div> :class "button next"
                     (span> :on-click (set-offset-value pager (1+ current-page)) "next"))
               (div> :class "button last"
                     (span> :on-click (set-offset-value pager count-pages) "last"))))))))

(defmethod htcomponent-global-initscripts ((pager pager))
  (let ((update-component-id (pager-update-component-id pager))
        (page-size (pager-page-size pager)))
    (list
     (ps:ps* `(defun pager-go-to (page)
                (setf (slot-value (dojo.by-id ,update-component-id) 'value) (* (1- page) ,page-size))
                (defvar form-id (slot-value (slot-value (dojo.by-id ,update-component-id) 'form) 'id))
                (let ((form-el (or (dijit.by-id form-id) 
                                   (dojo.by-id form-id))))
                  (.submit form-el)))))))

(defmethod set-offset-value ((pager pager) page)
  (ps:ps* `(pager-go-to ,page)))

(defmethod pager-count-pages ((pager pager))
  (let ((page-size (pager-page-size pager))
        (total-items (pager-total-items pager)))
    (count-pages page-size total-items)))

(defun count-pages (page-size total-items)
  (multiple-value-bind (pages rest)
      (truncate total-items page-size)
    (when (> rest 0) (incf pages))
    pages))

(defmethod pager-current-page ((pager pager))
  (let ((page-size (pager-page-size pager))
        (first-item-offset (pager-first-item-offset pager)))
    (multiple-value-bind (page rest)
        (truncate (1+ first-item-offset) page-size)
      (when (> rest 0) (incf page))
      page)))

(defmethod pager-page-list ((pager pager))
  (let ((current-page (pager-current-page pager))
        (count-pages (pager-count-pages pager))
        (visible-pages (pager-visible-pages pager))
        (pages-before-current-page)
        (pages-after-current-page)
        (result))
    (when (> current-page 1)
      (setf pages-before-current-page
            (reverse
             (loop for page from (1- current-page) downto (max 1 (- current-page 
                                                                    (truncate visible-pages 2)))
                collect page))))
    (when (< current-page count-pages)
      (setf pages-after-current-page
            (loop for page from (1+ current-page) to (min count-pages (+ (1- current-page) 
                                                                         (- visible-pages (length pages-before-current-page))))
               collect page)))
    (setf result (append pages-before-current-page (list current-page) pages-after-current-page))
    (let ((result-length (length result))
          (first-result-page (first result)))
      (if (< result-length visible-pages)
          (append (reverse (loop for page from (1- first-result-page) downto (max 1 (- first-result-page (- visible-pages result-length)))
                              collect page)) result)
          result))))