blob: 429f6665e7dda269e739a68f90442d0ab4912ab3 (
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
|
(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 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)))
(qt
(if old-item
(progn
(delete-item inv old-item)
(+ quantity (cdr old-item)))
quantity)))
(prog1 (setq filled (+ filled qt))
(push (cons item qt)
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))))))
|
