Browse code
initial commit
Ed L authored on 21/10/2015 06:16:22
Showing 1 changed files
Showing 1 changed files
1 | 1 |
new file mode 100644 |
... | ... |
@@ -0,0 +1,84 @@ |
1 |
+(in-package :cl-user) |
|
2 |
+ |
|
3 |
+(defmacro quickloads (&rest r) |
|
4 |
+ `(progn |
|
5 |
+ ,@(loop for x in r |
|
6 |
+ collect `(ql:quickload ,x)))) |
|
7 |
+ |
|
8 |
+(quickloads |
|
9 |
+ :cl-actors |
|
10 |
+ :cells |
|
11 |
+ :contextl) |
|
12 |
+ |
|
13 |
+(defpackage :math-test |
|
14 |
+ (:use :cl :cl-actors :cells)) |
|
15 |
+ |
|
16 |
+(in-package :math-test) |
|
17 |
+ |
|
18 |
+(defmodel service-rating () |
|
19 |
+ ((rating :cell t :accessor rating :initarg :rating :initform (c-in :normal)) |
|
20 |
+ (rate :cell t :accessor rate :initform (c? (case (rating self) |
|
21 |
+ (:normal 0.18) |
|
22 |
+ (:excellent 0.25) |
|
23 |
+ (:poor 0.15)))))) |
|
24 |
+ |
|
25 |
+(defmodel tip-calc () |
|
26 |
+ ((cost :cell t :accessor cost :initarg :cost :initform (c-in 0)) |
|
27 |
+ (rate :cell t :accessor rate :initarg :rate :initform (c-in 0.18)) |
|
28 |
+ (tip :cell t :accessor tip :initform (c? (* (cost self) |
|
29 |
+ (rate self)))))) |
|
30 |
+ |
|
31 |
+(defmodel item () |
|
32 |
+ ((kind :cell t :accessor kind :initarg :kind :initform (c-in :food)) |
|
33 |
+ (cost :cell t :accessor cost :initarg :cost :initform (c-in 0)))) |
|
34 |
+ |
|
35 |
+(defmodel bill () |
|
36 |
+ ((items :accessor items :initarg :items :initform (c-in nil)) |
|
37 |
+ (cost :accessor cost :initform (c? (apply #'+ |
|
38 |
+ (loop for item in (items self) |
|
39 |
+ collect (cost item))))))) |
|
40 |
+ |
|
41 |
+(defmodel meal-expense-calculator () |
|
42 |
+ ((subtotal :accessor subtotal :initarg :subtotal :initform (c-in 0)) |
|
43 |
+ (tax-rate :accessor tax-rate :initarg :tax-rate :initform (c-in 0.08)) |
|
44 |
+ (tip :accessor tip :initarg :tip :initform (c-in 0)) |
|
45 |
+ (total :accessor total :initform (c? (+ (subtotal self) |
|
46 |
+ (* (tax-rate self) |
|
47 |
+ (subtotal self)) |
|
48 |
+ (tip self)))))) |
|
49 |
+ |
|
50 |
+(defobserver tip ((self tip-calc)) |
|
51 |
+ (when old-value-boundp |
|
52 |
+ (format t "The tip is: ~a~%It changed by: ~a~%" new-value (- new-value |
|
53 |
+ old-value)))) |
|
54 |
+ |
|
55 |
+ |
|
56 |
+ |
|
57 |
+(defmacro push-many (place &body items) |
|
58 |
+ `(progn ,@(loop for item in items |
|
59 |
+ collect `(push ,item ,place)))) |
|
60 |
+ |
|
61 |
+(defparameter s-r (make-instance 'service-rating)) |
|
62 |
+(defparameter bill (make-instance 'bill)) |
|
63 |
+(defparameter tc (make-instance 'tip-calc :cost (c? (cost bill)) :rate (c? (rate s-r)))) |
|
64 |
+(defparameter meal-calc (make-instance 'meal-expense-calculator |
|
65 |
+ :subtotal (c? (cost bill)) |
|
66 |
+ :tip (c? (tip tc)))) |
|
67 |
+ |
|
68 |
+(push-many (items bill) |
|
69 |
+ (make-instance 'item :kind :meatloaf :cost 12.99) |
|
70 |
+ (make-instance 'item :kind :salmon :cost 14.99) |
|
71 |
+ (make-instance 'item :kind :frenchfries :cost 3.99) |
|
72 |
+ (make-instance 'item :kind :tomatosoup :cost 3.99) |
|
73 |
+ (make-instance 'item :kind :burgundy :cost 8.99) |
|
74 |
+ (make-instance 'item :kind :icedtea :cost 3.99)) |
|
75 |
+(setf (rating s-r) :excellent) |
|
76 |
+ |
|
77 |
+(format t "~{~a~20t~a~%~}------------------------------ |
|
78 |
+Subtotal:~20t~a~%Tax:~20t~a~%Tip:~20t~a~%Total:~20t~a~%" |
|
79 |
+ (loop for item in (items bill) |
|
80 |
+ append (list (kind item) (cost item))) |
|
81 |
+ (subtotal meal-calc) |
|
82 |
+ (* 0.08 (subtotal meal-calc)) |
|
83 |
+ (tip tc) |
|
84 |
+ (total meal-calc)) |