blob: e122364b193694a0bb365a60d9cc460198ed1b57 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
(defpackage inventory
(:use :cl)
(:export :new-inventory
:filled
:add-item
:remove-item))
(in-package :inventory)
(defclass inventory ()
((size :initarg :size
:reader size)
(filled :initform 0
:accessor filled)
(items :initform '()
:accessor items)))
(defun new-inventory (size)
(when (> size 0)
(make-instance 'inventory :size size)))
(defmethod find-item ((inv inventory) name)
(with-slots (items) inv
(find-if
#'(lambda (i)
(equal (commodities:name (car i)) name))
items)))
(defmethod delete-item ((inv inventory) item)
;; removes <item> from inventory list and substracts
;; its stored quantity from the filled attribute
(with-slots (filled items) inv
(setq items (remove item items))
(setq filled (- filled (cdr item)))))
(defmethod update-item ((inv inventory) item qty old-item)
(with-slots (filled items) inv
(delete-item inv old-item)
(let ((total-quantity (+ qty (cdr old-item)))
(item-name (commodities:name item))
(item-price (commodities:price item))
(old-qty (cdr old-item))
(old-item-price (commodities:price (car old-item))))
(let ((new-item (commodities:new-commodity item-name
(/ (+ (* qty item-price) (* old-qty old-item-price))
total-quantity))))
(push (cons
new-item
total-quantity) items)
(setq filled (+ filled total-quantity))))))
(defmethod add-item ((inv inventory) item quantity)
;; add <quantity> of <item> to inventory
(when (> quantity 0)
(with-slots (size filled items) inv
(when (>= size (+ filled quantity))
(let ((old-item (find-item inv (commodities:name item))))
(if old-item
(update-item inv item quantity old-item)
(prog1 (setq filled (+ filled quantity))
(push (cons item quantity) items))))))))
(defmethod remove-item ((inv inventory) name quantity)
;; remove <quantity> of <item> from inventory
;; quantity must be positive or zero
(when (> quantity 0)
(with-slots (filled items) inv
(let ((item (find-item inv name)))
(when item
(delete-item inv item)
(if (< quantity (cdr item))
(progn
(add-item inv
(car item)
(- (cdr item) quantity))
(cons (car item) quantity))
item))))))
|
