;;;
;;; scmail - a mail filter written in Scheme
;;;
;;; Copyright (C) 2002-2004 Satoru Takabayashi <satoru@namazu.org> 
;;;     All rights reserved.
;;;     This is free software with ABSOLUTELY NO WARRANTY.
;;;
;;; Permission to use, copy, modify, distribute this software and
;;; accompanying documentation for any purpose is hereby granted,
;;; provided that existing copyright notices are retained in all
;;; copies and that this notice is included verbatim in all
;;; distributions.
;;; This software is provided as is, without express or implied
;;; warranty.  In no circumstances the author(s) shall be liable
;;; for any damages arising out of the use of this software.
;;;

(define-module scmail.progress
  (use srfi-13)
  (use srfi-19)
  (export <progress> 
          progress-finish!
          progress-inc!))

(select-module scmail.progress)

(define-class <progress> ()
  ((title :init-value "progress"
          :init-keyword :title)
   (total :init-value 100
          :init-keyword :total)
   (port  :init-form (current-output-port) ;; not init-value!!
          :init-keyword :port)

   (title-width :init-value 10)
   (bar-width :init-value 44)
   (bar-mark :init-value #\o
             :init-keyword :bar-mark)
   (current :init-value 0)
   (previous :init-value 0)
   (finished? :init-value #f)
   (previous-time)
   (start-time)))

(define (time-difference->real time0 time1)
  (let1 time (time-difference time0 time1)
        (+ (time-second time)
           (/ (time-nanosecond time) 1000000000))))
 
(define-method initialize ((progress <progress>) initargs)
  (next-method)
  (slot-set! progress 'start-time (current-time))
  (slot-set! progress 'previous-time (ref progress 'start-time))
  (set! (port-buffering (ref progress 'port)) :none)
  (show progress))

(define-method write-object ((progress <progress>) port)
  (format port "[progress]"))

(define (format-time t)
  (let* ((t (round t))
         (sec (modulo t 60))
         (min (modulo (round (/ t 60)) 60))
         (hour (/ t 3600)))
    (format #f "~2,'0d:~2,'0d:~2,'0d" 
            (round hour)
            (round min)
            (round sec))))

(define-method eta ((progress <progress>))
  (if (zero? (ref progress 'current))
      "ETA:  --:--:--"
      (let* ((elapsed (time-difference->real
                        (current-time) (ref progress 'start-time)))
             (eta (round (- (/ (* elapsed (ref progress 'total))
                               (ref progress 'current))
                            elapsed))))
        (format #f "ETA:  ~a" (format-time eta)))))

(define-method elapsed ((progress <progress>))
  (let1 elapsed (time-difference->real
                 (current-time) (ref progress 'start-time))
        (format #f "Time: ~a" (format-time elapsed))))
        
(define-method stat ((progress <progress>))
  (if (ref progress 'finished?)
      (elapsed progress)
      (eta progress)))

(define-method eol ((progress <progress>))
  (if (ref progress 'finished?)
      "\n"
      "\r"))

(define-method bar ((progress <progress>))
  (let1 len (round (/ (* (percentage progress) 
                         (ref progress 'bar-width)) 100))
        (format #f "|~a~a|" 
                (string-tabulate (lambda (i) (ref progress 'bar-mark)) len)
                (string-tabulate (lambda (i) #\ )
                                 (- (ref progress 'bar-width) len)))))

(define-method percentage ((progress <progress>))
  (if (zero? (ref progress 'total))
      100
      (round (/ (* (ref progress 'current) 100) (ref progress 'total)))))

(define-method title ((progress <progress>))
  (string-append (substring (ref progress 'title) 0 
                            (min (- (ref progress 'title-width) 1)
                                 (string-length (ref progress 'title))))
                 ":"))

(define-method show ((progress <progress>))
  (let1 line (format #f #`"~,(ref progress 'title-width)a ~3d% ~a ~a "
                     (title progress)
                     (percentage progress)
                     (bar progress)
                     (stat progress))
        (display line (ref progress 'port))
        (display (eol progress) (ref progress 'port))
        (slot-set! progress 'previous-time (current-time))
        ))
                 
(define-method show-progress ((progress <progress>))
  (let ((current-percentage (if (zero? (ref progress 'total))
                                100
                                (/ (* (ref progress 'current) 100)
                                   (ref progress 'total))))
        (previous-percentage (if (zero? (ref progress 'total))
                                 0
                                 (/ (* (ref progress 'previous) 100)
                                    (ref progress 'total)))))
    (if (or (> (round current-percentage) (round previous-percentage))
            (>= (time-difference->real (current-time) 
                                       (ref progress 'previous-time)) 
               1.0) ;; 1 sec. elapsed.
            (ref progress 'finished?))
        (show progress))))


(define-method progress-finish! ((progress <progress>))
  (slot-set! progress 'current (ref progress 'total))
  (slot-set! progress 'finished? #t)
  (show-progress progress))

(define-method progress-inc! ((progress <progress>) . step)
  (let1 step (get-optional step 1)
        (slot-set! progress 'current (+ (ref progress 'current) step))
        (if (> (ref progress 'current) (ref progress 'total))
            (slot-set! progress 'current (ref progress 'total)))
        (show-progress progress)
        (slot-set! progress 'previous (ref progress 'current))))

(provide "scmail/progress")

