| 1 | ;; loan-pr-view.lisp
|
|---|
| 2 |
|
|---|
| 3 | (eval-when (:compile-toplevel :load-toplevel :execute)
|
|---|
| 4 | (require :date)
|
|---|
| 5 | (require :nslog-utils))
|
|---|
| 6 |
|
|---|
| 7 | (defpackage :loan-document
|
|---|
| 8 | (:nicknames :lnd)
|
|---|
| 9 | (:use :iu :ccl :common-lisp))
|
|---|
| 10 |
|
|---|
| 11 | (in-package :lnd)
|
|---|
| 12 |
|
|---|
| 13 | ;; provides a view class used to print loan information
|
|---|
| 14 |
|
|---|
| 15 | (defclass loan-print-view (ns:ns-view)
|
|---|
| 16 | ((loan :accessor loan
|
|---|
| 17 | :initarg :loan)
|
|---|
| 18 | (attributes :accessor attributes
|
|---|
| 19 | :initform (make-instance ns:ns-mutable-dictionary))
|
|---|
| 20 | (page-line-count :accessor page-line-count
|
|---|
| 21 | :initform 0)
|
|---|
| 22 | (line-height :accessor line-height)
|
|---|
| 23 | (page-num :accessor page-num
|
|---|
| 24 | :initform 0)
|
|---|
| 25 | (page-rect :accessor page-rect))
|
|---|
| 26 | (:metaclass ns:+ns-object))
|
|---|
| 27 |
|
|---|
| 28 | (defmethod initialize-instance :after ((self loan-print-view)
|
|---|
| 29 | &key &allow-other-keys)
|
|---|
| 30 | ;; assure loan still exists if user closes the window while we are printing
|
|---|
| 31 | (#/retain (loan self))
|
|---|
| 32 | (ccl:terminate-when-unreachable self)
|
|---|
| 33 | (let* ((font (#/fontWithName:size: ns:ns-font #@"Courier" 8.0)))
|
|---|
| 34 | (setf (line-height self) (* (+ (#/ascender font) (abs (#/descender font))) 1.5))
|
|---|
| 35 | (#/setObject:forKey: (attributes self) font #$NSFontAttributeName)))
|
|---|
| 36 |
|
|---|
| 37 | (defmethod ccl:terminate ((self loan-print-view))
|
|---|
| 38 | (#/release (loan self))
|
|---|
| 39 | (#/release (attributes self)))
|
|---|
| 40 |
|
|---|
| 41 | (objc:defmethod (#/knowsPageRange: :<BOOL>)
|
|---|
| 42 | ((self loan-print-view) (range (:* #>NSRange)))
|
|---|
| 43 | ;; compute printing parameters and set the range
|
|---|
| 44 | (let* ((pr-op (#/currentOperation ns:ns-print-operation))
|
|---|
| 45 | (pr-info (#/printInfo pr-op))
|
|---|
| 46 | ;; (pg-size (#/paperSize pr-info))
|
|---|
| 47 | ;; (left-margin (#/leftMargin pr-info))
|
|---|
| 48 | ;; (right-margin (#/rightMargin pr-info))
|
|---|
| 49 | ;; (top-margin (#/topMargin pr-info))
|
|---|
| 50 | ;; (bottom-margin (#/bottomMargin pr-info))
|
|---|
| 51 | (image-rect (#/imageablePageBounds pr-info))
|
|---|
| 52 | (pg-rect (ns:make-ns-rect 0
|
|---|
| 53 | 0
|
|---|
| 54 | (ns:ns-rect-width image-rect)
|
|---|
| 55 | (ns:ns-rect-height image-rect))))
|
|---|
| 56 | ;; (log-size pg-size "pg-size: ")
|
|---|
| 57 | ;; (log-4floats left-margin right-margin top-margin bottom-margin
|
|---|
| 58 | ;; (list "Margins: left = " " right = " " top = " " bottom = "))
|
|---|
| 59 | ;; (log-rect image-rect "imageable rect: ")
|
|---|
| 60 | (setf (page-rect self) pg-rect)
|
|---|
| 61 | ;; (log-rect pg-rect "my page rect: ")
|
|---|
| 62 | (#/setFrame: self pg-rect)
|
|---|
| 63 | ;; (log-float (line-height self) "Line Height: ")
|
|---|
| 64 | (setf (page-line-count self) (floor (ns:ns-rect-height pg-rect)
|
|---|
| 65 | (line-height self)))
|
|---|
| 66 | ;; start on page 1
|
|---|
| 67 | (setf (ns:ns-range-location range) 1)
|
|---|
| 68 | ;; compute the number of pages for 9 header lines on page 1 and 2 header
|
|---|
| 69 | ;; lines on subsequet pages plus a line per payment
|
|---|
| 70 | (let* ((pay-lines-on-p-1 (- (page-line-count self) 7))
|
|---|
| 71 | (other-pages-needed (ceiling (max 0 (- (list-length (pay-schedule (loan self)))
|
|---|
| 72 | pay-lines-on-p-1))
|
|---|
| 73 | (page-line-count self))))
|
|---|
| 74 | (setf (ns:ns-range-length range)
|
|---|
| 75 | (1+ other-pages-needed))))
|
|---|
| 76 | #$YES)
|
|---|
| 77 |
|
|---|
| 78 | (objc:defmethod (#/rectForPage: #>NSRect)
|
|---|
| 79 | ((self loan-print-view) (pg #>NSInteger))
|
|---|
| 80 | (setf (page-num self) (1- pg))
|
|---|
| 81 | (page-rect self))
|
|---|
| 82 |
|
|---|
| 83 | (objc:defmethod (#/isFlipped #>BOOL)
|
|---|
| 84 | ((self loan-print-view))
|
|---|
| 85 | ;; we compute coords from upper left
|
|---|
| 86 | #$YES)
|
|---|
| 87 |
|
|---|
| 88 | (objc:defmethod (#/drawRect: :void)
|
|---|
| 89 | ((self loan-print-view) (r #>NSRect))
|
|---|
| 90 | (with-slots (loan attributes page-line-count line-height page-num page-rect) self
|
|---|
| 91 | (ns:with-ns-rect (line-rect (ns:ns-rect-x r)
|
|---|
| 92 | (- (ns:ns-rect-y r) line-height)
|
|---|
| 93 | (ns:ns-rect-width r)
|
|---|
| 94 | line-height)
|
|---|
| 95 |
|
|---|
| 96 | ;; (log-rect r "draw rect: ")
|
|---|
| 97 | (labels ((draw-next-line (str)
|
|---|
| 98 | (incf (ns:ns-rect-y line-rect) line-height)
|
|---|
| 99 | (#/drawInRect:withAttributes:
|
|---|
| 100 | (lisp-to-temp-nsstring str)
|
|---|
| 101 | line-rect
|
|---|
| 102 | attributes))
|
|---|
| 103 | (draw-next-payment (sched-line)
|
|---|
| 104 | (draw-next-line
|
|---|
| 105 | (format nil
|
|---|
| 106 | "~1{On ~a balance = $~$ + interest of $~$ - payment of $~$ = ~a balance of $~$~}"
|
|---|
| 107 | sched-line))))
|
|---|
| 108 | (when (zerop page-num)
|
|---|
| 109 | ;; print all the basic loan info
|
|---|
| 110 | (draw-next-line (format nil
|
|---|
| 111 | "Loan ID: ~a"
|
|---|
| 112 | (ns-to-lisp-string (#/displayName loan))))
|
|---|
| 113 | (draw-next-line (format nil
|
|---|
| 114 | "Amount: $~$"
|
|---|
| 115 | (/ (loan-amount loan) 100)))
|
|---|
| 116 | (draw-next-line (format nil
|
|---|
| 117 | "Origination Date: ~a"
|
|---|
| 118 | (date-string (origination-date loan))))
|
|---|
| 119 | (draw-next-line (format nil
|
|---|
| 120 | "Annual Interest Rate: ~7,4F%"
|
|---|
| 121 | (* 100 (interest-rate loan))))
|
|---|
| 122 | (draw-next-line (format nil
|
|---|
| 123 | "Loan Duration: ~D month~:P"
|
|---|
| 124 | (loan-duration loan)))
|
|---|
| 125 | (draw-next-line (format nil
|
|---|
| 126 | "Monthly Payment: $~$"
|
|---|
| 127 | (/ (monthly-payment loan) 100)))
|
|---|
| 128 | ;; draw spacer line
|
|---|
| 129 | (incf (ns:ns-rect-y line-rect) line-height))
|
|---|
| 130 | ;; print the appropriate schedule lines for this page
|
|---|
| 131 | (let* ((lines-per-page (- page-line-count (if (zerop page-num) 7 0)))
|
|---|
| 132 | (start-indx (if (zerop page-num) 0 (+ (- page-line-count 7)
|
|---|
| 133 | (* lines-per-page (1- page-num)))))
|
|---|
| 134 | (end-indx (min (length (pay-schedule loan))
|
|---|
| 135 | (+ start-indx lines-per-page 1))))
|
|---|
| 136 | (dolist (sched-line (subseq (pay-schedule loan) start-indx end-indx))
|
|---|
| 137 | (draw-next-payment sched-line)))))))
|
|---|
| 138 |
|
|---|
| 139 | (provide :loan-pr-view)
|
|---|
