(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 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 of 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 of 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))))))