;;; -*- mode: lisp; package: editor -*-
;;;
;;; File: drive-info/editor/kuma.l
;;;
;;; License:
;;;
;;;   Copyright (c) 2007 MIYAMUKO Katsuyuki.
;;;
;;;   drive-info is released under an MIT license.
;;;   See drive-info/docs/MIT-LICENSE for full license.
;;;

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require "drive-info/api"))

(in-package :editor)

(export '(drive-info-popup-disk-free-space-kuma--))

(defparameter *drive-info-no-such-drive-kuma-template* "
丂丂丂丂丂 伩丵丵丵伩
丂丂丂丂丂 | 僲丂 _,丂丂,_ 丷丂丂丂丂~A~A僋儅乗乗
丂丂丂丂丂/丂丂仠丂丂丂仠 |
丂丂丂丂 |丂丂丂丂( _仠_)丂 儈丂丵丂(佨)
丂丂丂丂渃@丂丂|伨|丂丂僲
伡佨丷丂/丂丂丂 丷僲丂 丷 /佨偮
丂 乢丂丷丂 /丂丂 丂 丂丂 丷丂/
丂丂丂乢_,,僲丂丂丂丂丂丂|Q僲 ")

(defparameter *drive-info-kuma-template* "
丂丂丂丂丂丂丂丂丂丂丂丂丂0丂丂丂丂丂丂丂 25丂丂丂丂丂丂丂 50丂丂丂丂丂丂丂 75丂丂丂丂丂丂100%
丂丂丂丂丂丂丂丂丂丂丂丂丂労劒劒劒劒劒劰劒劒劒劒劒劰劒劒劒劒劒劰劒劒劒劒劒劶
_丂丂 伩丵丵丵伩丂丂丂/)
_丂丂 | 僲丂丂丂丂丂 丷丂 ( i )))
_丂丂/丂丂仠丂丂丂仠 | /丂/
_丂 |丂丂丂丂( _仠_)丂 |蓙@/丂丂丂偙偙僋儅乗乗両両
_丂渃@丂丂|伨|丂丂丂丂,/
_ 乛丵丵丂 丷僲丂丂 /丩
_(丵丵丵乯丂丂丂丂 /")

(defparameter *drive-info-kuma-canvas-width* 36)
(defparameter *drive-info-kuma-ruler-offset* 13)

(define-history-variable *drive-info-last-drive* "C:\\")

(defconstant *drive-info-byte-ice-units* '("" "Ki" "Mi" "Gi" "Ti" "Pi" "Ei"))

(defun drive-info-find-unit (n)
  (drive-info-find-unit0 n 1 *drive-info-byte-ice-units*))

(defun drive-info-find-unit0 (n base units)
  (if (or (zerop (floor (/ n base 1024)))
          (null (cdr units)))
      (cons base (car units))
    (drive-info-find-unit0 n (* base 1024) (cdr units))))


(defmacro drive-info-check-argument (arg message)
  `(unless ,arg
     (popup-string (format nil *drive-info-no-such-drive-kuma-template*
                           drive ,message)
                   (point))
     (return-from drive-info-popup-disk-free-space-kuma--)))

(defun drive-info-popup-disk-free-space-kuma-- (root-dir)
  (interactive "sDrive: " :default0 *drive-info-last-drive* :history0 'drive-info)
  (let* ((drive (drive:drive-name root-dir))
         (info (drive:get-drive-info drive))
         (space (cdr (assoc :space info))))
    (flet ((make-ws (w)
             (make-sequence 'string w :initial-element #\丂)))
      (drive-info-check-argument info "僪儔僀僽側傫偰懚嵼偟側偄")
      (drive-info-check-argument space "僪儔僀僽偵僨傿僗僋偑擖偭偰偄側偄")
      (setf *drive-info-last-drive* drive)
      (let* ((free-size (cdr (assoc :total-number-of-free-bytes space)))
             (total-size (cdr (assoc :total-number-of-bytes space)))
             (free% (cdr (assoc :free-bytes% space)))
             (w (floor (* *drive-info-kuma-canvas-width* (/ free% 100))))
             (unit (drive-info-find-unit total-size))
             (kuma))
        (setf kuma (substitute-string
                    *drive-info-kuma-template*
                    "^_" (make-ws w)))
        (setf kuma (substitute-string
                    kuma
                    (concat "^" (make-ws (min w *drive-info-kuma-ruler-offset*)))
                    ""))
        (setf kuma (concat (format nil "~A僪儔僀僽偺僨傿僗僋嬻偒梕検偼 ~1,F~AB/~1,F~AB (~1,F%) 偩僋儅乗乗"
                                   drive
                                   (/ free-size (car unit))
                                   (cdr unit)
                                   (/ total-size (car unit))
                                   (cdr unit)
                                   free%)
                           kuma))
        (popup-string kuma (point))))))


(provide "drive-info/editor/kuma")

;;; End
