;;; -*- Mode:LISP; Package:USER; Readtable:CL; Base:10 -*-

;;;; Checkbook
(defstruct checkbook
  entries
  balance
  pathname)

(defstruct (entry (:print-function print-entry))
  credit-date
  date
  number
  (memo "")
  (type 'misc)
  (checked nil)
  amount
  balance)

(defun create-entry (credit-date date number memo type checked amount)
  (make-entry :credit-date credit-date
	      :date date
	      :number number
	      :memo memo
	      :type type
	      :checked checked
	      :amount amount))


(defun print-entry (entry &optional (stream t) depth)
  (declare (ignore depth))
  (format stream "[~A]" (entry-string entry))) 

(defun entry-string (entry)
  (format nil "~A ~A ~A ~4D ~36A ~A"
	  (date-string (entry-credit-date entry))
	  (date-string (entry-date entry))
	  (if (entry-checked entry)
	      #\* #\space)
	  (if (entry-number entry)
	      (entry-number entry)
	    "")
	  (entry-memo entry)
	  (amount-string (entry-amount entry))))

(defun date-string (universal-time)
  (multiple-value-bind (nil nil nil day month year)
      (decode-universal-time universal-time)
    (format nil "~2,'0D/~2,'0D/~2,'0D" month day (mod year 100.))))

(defun amount-string (amount)
  (multiple-value-bind (dollars cents)
      (truncate amount 100.)
    (format nil "~5D.~2,'0D" dollars (abs cents))))

(defun entry-earlier-p (entry1 entry2)
  (let ((cdate1 (entry-credit-date entry1))
	(cdate2 (entry-credit-date entry2)))
    (cond ((< cdate1 cdate2) t)
	  ((> cdate1 cdate2) nil)
	  (t (let ((date1 (entry-date entry1))
		   (date2 (entry-date entry2)))
	       (cond ((< date1 date2) t)
		     ((> date1 date2) nil)
		     (t
		      (and (entry-number entry1)
			   (entry-number entry2)
			   (< (entry-number entry1)
			      (entry-number entry2))))))))))

(defun insert-entry (entry checkbook)
  (setf (checkbook-entries checkbook)
	(merge 'list (list entry)
	       (checkbook-entries checkbook)
	       #'entry-earlier-p)))

;;; fix this up
(defun input-entry ()
  (let ((date (prompt-and-read :date "~&Date: "))
	(number (prompt-and-read '(:number :or-nil t) "Number: "))
	(memo (prompt-and-read :string-trim "Memo: "))
	(amount (floor (* 100. (prompt-and-read :number "Amount: ")))))
    (make-entry :credit-date date :date date
		:number number
		:memo memo
		:amount amount)))

(defun input-and-insert-entry (checkbook)
  (insert-entry (input-entry) checkbook))


(defun doit (checkbook)
  (do ()
      (())
    (send-if-handles *standard-output* :clear-screen)
    (print-checkbook checkbook)
    (input-and-insert-entry checkbook)))
	

(defun print-checkbook (checkbook &optional (stream t))
  (let ((balance 0))
    (dolist (entry (checkbook-entries checkbook))
      (setq balance (+ balance (entry-amount entry)))
      (format stream "~&~A ~A"
	      (entry-string entry)
	      (amount-string balance)))
    (terpri stream)))


(defun print-checkbook-to-file (checkbook file)
  (with-open-file (stream file :out)
    (print-checkbook checkbook stream)))

(defun save-entry (entry &optional (stream *standard-output*))
  (prin1 (list (entry-credit-date entry)
	       (entry-date entry)
	       (entry-number entry)
	       (entry-memo entry)
	       (entry-type entry)
	       (entry-checked entry)
	       (entry-amount entry))
	 stream)
  (terpri stream))


(defun save-checkbook (checkbook file)
  (with-open-file (stream file :direction :output)
    (dolist (entry (checkbook-entries checkbook))
      (save-entry entry stream))))

			   

(defflavor scroll-mouse-window
	 ()
	 (tv:scroll-mouse-mixin tv:scroll-window))

(defvar *checkbook* nil)
(defvar *checkbooks* nil)

(defvar *start-date* 0)
(defvar *end-date* (time:parse-universal-time "Jan 1 2000"))

(defvar *filter-list* '())
(defvar *filter-function* 'all)

(defmacro def-filter (name namestring doc &body body)
  `(progn (defun ,name (entry)
	    ,@body)
	  (push '(,namestring :eval (setq *filter-function* #',name)
		              :documentation ,doc)
		   *filter-list*
		   )))

(def-filter food     "  Food      "
  "Show Food"
  (eq (entry-type entry) 'food))

(def-filter electric "  Electric  "
  "Show Electric Payments"
  (eq (entry-type entry) 'electric))

(def-filter gas      "  Gas       "
  "Show Gas Payments"
  (eq (entry-type entry) 'Gas))


(def-filter mortgage "  Mortgage  "
  "Show Mortgage Payments"
  (eq (entry-type entry) 'mortgage))


	    
(def-filter deposits "  Deposits  "
  "Show deposits"
  (plusp (entry-amount entry)))

(def-filter debits   "  Withdrawals/Debits"
  "Show withdrawals and debits"
  (and (minusp (entry-amount entry))
       (not (entry-number entry))))

(def-filter checks   "  Checks    "
  "Show checks"
  (entry-number entry))

(def-filter all      "  All       "
  "Show all entries"
  entry)


(defun get-entry-list ()
  (let ((balance 0))
    (remove-if-not *filter-function*
	(remove-if-not #'(lambda (entry)
	    (and (>= (entry-credit-date entry) *start-date*)
		 (<= (entry-credit-date entry) *end-date*)))
		       (mapc #'(lambda (entry)
				 (setf (entry-balance entry)
				       (incf balance (entry-amount entry))))
			     (if *checkbook*
				 (checkbook-entries *checkbook*)))))))

(defun checkbook-items ()
  (tv:scroll-maintain-list
    #'get-entry-list
    #'(lambda (entry)
	(tv:scroll-parse-item
	  :mouse `(nil :eval (do-in-command-loop '(:delete-entry ,entry))
		       :documentation "Delete Entry")
	  `(:mouse
	     (nil :eval (do-in-command-loop '(:change-credit-date ,entry))
		  :documentation "Credit Date")
	     :function ,#'(lambda () (date-string (entry-credit-date entry))) nil 10)
	  `(:mouse
	     (nil :eval (do-in-command-loop '(:change-date ,entry))
		  :documentation "Date")
	     :function ,#'(lambda () (date-string (entry-date entry))) nil 10)
	  `(:mouse
	     (nil :eval (do-in-command-loop '(:toggle-checked ,entry))
		  :documentation "Checked")
	     :function ,#'(lambda () (if (entry-checked entry) #\* #\.)) nil 2)
	  `(:mouse
	     (nil :eval (tv:beep)
		  :documentation "Number")
	     :string ,(if (entry-number entry)
			  (format nil "~4D" (entry-number entry))
			"    ") 5)	  
	  `(:mouse
	     (nil :eval (do-in-command-loop '(:change-memo ,entry))
		  :documentation "Memo")
	     :function ,#'(lambda () (entry-memo entry)) nil 36.)
	  `(:mouse
	     (nil :eval (do-in-command-loop '(:change-amount ,entry))
		  :documentation "Amount")
	     :function ,#'(lambda () (amount-string (entry-amount entry))) nil 10.)
	  `(:function ,#'(lambda () (amount-string (entry-balance entry))) nil 10.)))))


(defflavor ledger-interactor
	 ()
	 (tv:process-mixin tv:lisp-interactor)
  (:default-init-plist :process
		       '(command-loop)))


(defun title-item-list ()
  `(("From:" :no-select nil :font fonts:cptfontb)
    (,(date-string *start-date*) start-date)
    ("  To:" :no-select nil :font fonts:cptfontb)
    (,(date-string *end-date*) end-date)))
    
(defflavor ledger-frame
	 ((checkbook)
	  (checkbooks nil))
	 (tv:bordered-constraint-frame-with-shared-io-buffer)
  :gettable-instance-variables
  :settable-instance-variables
  (:default-init-plist
    :panes
    `((from-to tv:command-menu :item-list
	     ,(title-item-list))
      (title tv:window :blinker-p nil :label nil)
      (menu tv:command-menu :item-list
	    ,(append
	       '(("File        " :no-select nil :font fonts:cptfontb)
		 ("  Load      " load-checkbook-file)
		 ("  Save      " save-checkbook-file)
		 ("  Save To   " save-checkbook-file-to)
		 ("  Save Text " write-file)
		 ("" :no-select nil)
		 ("Add Entry   " add-entry)
		 ("" :no-select nil)
		 ("Show Only   " :no-select nil :font fonts:cptfontb)
		 )
	       *filter-list*))
      (display scroll-mouse-window :display-item ,(checkbook-items) :label "none")
      (interactor ledger-interactor))
    :constraints
    `((main . ((title-strip middle interactor)
	       ((title-strip :horizontal (2 :lines from-to)
		  (from-to title)
		  ((from-to .2)
		   (title :even))))
	       ((middle :horizontal (40 :lines display)
		  (display menu)
		  ((display .8)
		   (menu :even))))
	       ((interactor :even)))))))


(defmethod (ledger-frame :after :init) (&rest ignore)
  (send self :set-selection-substitute (send self :get-pane 'interactor)))

(tv:add-system-key #\x 'ledger-frame "Checkbook")

(defun update (interactor-window)
  (let ((frame (send interactor-window :superior)))
    (send frame :send-pane 'display :redisplay)
    (send frame :send-pane 'display :set-label
	  (format nil "~a"
		  (if *checkbook*
		      (checkbook-pathname *checkbook*)
		    "None")))
    (send frame :send-pane 'from-to :set-item-list (title-item-list))))

(defvar *interaction-window*)

(defun do-in-command-loop (blip)
  (tv:io-buffer-put (send *interaction-window* :io-buffer) blip))

(defun command-loop (window)
  (setq *interaction-window* window)
  (setq *filter-function* #'all)
  (let ((*terminal-io* window))
    (do ((blip (send window :any-tyi) (send window :any-tyi)))
	(())
      (cond ((consp blip)
	     (case (car blip)
	       (:menu
		(if (eq (second (second blip)) :eval)
		    (eval (third (second blip)))
		  (funcall (second (second blip)))))
	       (:change-credit-date
		(setf (entry-credit-date (second blip))
		      (prompt-and-read :date "~&Credit Date: "))
		(resort-checkbook))
	       (:change-date
		(setf (entry-date (second blip))
		      (prompt-and-read :date "~&Date: "))
		(resort-checkbook))
	       (:toggle-checked
		(setf (entry-checked (second blip))
		      (not (entry-checked (second blip)))))
	       (:change-memo
		(setf (entry-memo (second blip))
		      (prompt-and-read :string-trim "Memo: ")))
	       (:change-amount
		(setf (entry-amount (second blip))
		      (truncate (* 100. (prompt-and-read :number "Amount: ")))))
	       (:delete-entry
		(delete-entry (second blip) *checkbook*))
	       (t (tv:beep))))
	    (t ))
      (update window))))

(defun resort-checkbook ()
  (setf (checkbook-entries *checkbook*)
	(sort (checkbook-entries *checkbook*) #'entry-earlier-p)))

(defun load-checkbook-file ()
  (let ((entries '())
	(pathname (prompt-and-read :pathname "File: ")))
    (with-open-file (stream pathname :direction :input)
      (do ((next (read stream nil) (read stream nil)))
	  ((null next))
	(push (apply #'create-entry next) entries)))
    (if *checkbook* (pushnew *checkbook* *checkbooks*))
    (pushnew (setq *checkbook* (make-checkbook :entries (nreverse entries)
					       :pathname pathname))
	     *checkbooks*)))


(defun save-checkbook-file ()
  (save-checkbook *checkbook*
		  (or (checkbook-pathname *checkbook*)
		      (setf (checkbook-pathname *checkbook*)
			    (prompt-and-read :pathname "~&Save to file: ")))))

(defun save-checkbook-file-to ()
  (save-checkbook *checkbook*
		  (setf (checkbook-pathname *checkbook*)
			(prompt-and-read `(:pathname :defaults
						     ,(checkbook-pathname *checkbook*))
					 "~&Save to file (default ~a): "
					 (checkbook-pathname *checkbook*)))))

(defun print-entries (entries &optional (stream t))
  (dolist (entry entries)
    (format stream "~&~A ~A"
	    (entry-string entry)
	    (amount-string (entry-balance entry))))
    (terpri stream))


(defun print-entries-to-file (entries file)
  (with-open-file (stream file :out)
    (print-entries entries stream)))

(defun write-file ()
  (print-entries-to-file (get-entry-list)
			 (prompt-and-read `(:pathname :defaults
						      ,(checkbook-pathname *checkbook*))
					  "~&Write Text File (default ~a): "
					  (checkbook-pathname *checkbook*))))

(defun delete-entry (entry &optional (checkbook *checkbook*))
  (setf (checkbook-entries checkbook)
	(delete entry (checkbook-entries checkbook))))
    
(defun add-entry ()
  (insert-entry (get-entry)
		*checkbook*))

(defun get-entry ()
  (let ((*credit-date* (time:get-universal-time))
	(*date* (time:get-universal-time))
	(*number* nil)
	(*memo* "")
	(*checked* nil)
	(*type* 'misc)
	(*amount* 0))
    (declare (special *credit-date* *date* *number* *memo* *checked* *type* *amount*))
    (tv:choose-variable-values
      '((*credit-date* "Credit Date" :date)
	(*date* "Date" :date)
	(*number* "Number" :number-or-nil)
	(*memo* "Memo" :string)
	(*checked* "Checked" :boolean)
	(*type* "Type" :choose (misc deposit food gas elec mort phone ins-car ins-house))	;:menu-alist allows mouse doc
	(*amount* "Amount" :number)))
    (create-entry *credit-date* *date* *number* *memo* *type* *checked*
		  (floor (* 100. *amount*)))))


(defun start-date ()
  (setq *start-date* (prompt-and-read :date "~&Start Date: ")))

(defun end-date ()
  (setq *end-date* (prompt-and-read :date "~&End Date: ")))