source: trunk/source/contrib/krueger/InterfaceProjects/Loan Document/loan-print-view.lisp @ 13390

Last change on this file since 13390 was 13390, checked in by plkrueger, 10 years ago

New contrib from Paul Krueger

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