|
|
@@ -0,0 +1,168 @@
|
|
|
+;;; TRADING ;;;
|
|
|
+(defparameter *trade-opt-lookup* (list (cons '1 'buy-menu)
|
|
|
+ (cons 'b 'buy-menu)
|
|
|
+ (cons '2 'sell-menu)
|
|
|
+ (cons 's 'sell-menu)
|
|
|
+ (cons '3 'display-prices)
|
|
|
+ (cons 'd 'display-prices)
|
|
|
+ (cons '4 'top-level-game-menu)
|
|
|
+ (cons 'r 'top-level-game-menu)))
|
|
|
+
|
|
|
+(defvar *trade-menu-options-display* "
|
|
|
+Actions:
|
|
|
+1 | Buy | b
|
|
|
+2 | Sell | s
|
|
|
+3 | Display Prices | d
|
|
|
+4 | Return to top level | r
|
|
|
+")
|
|
|
+
|
|
|
+(defun buy-transaction (resource quantity)
|
|
|
+ "Do they actual purchase transaction, not intended to be called interactively"
|
|
|
+ (let* ((available-player-funds (player-ship-credits *player-ship*))
|
|
|
+ (inventory (player-ship-inventory *player-ship*))
|
|
|
+ (price (funcall (symbol-function (find-symbol (string-upcase
|
|
|
+ (concatenate 'string "market-price-of-" resource))))
|
|
|
+ (sector-market *sector*)))
|
|
|
+ (total-cost (* quantity price)))
|
|
|
+ (if (> total-cost available-player-funds)
|
|
|
+ (progn
|
|
|
+ (format T "Not enough credits to buy ~A ~A at ~A credits~%" quantity resource price)
|
|
|
+ (format T "~%PLAYER CREDITS: ~A~%" (player-ship-credits *player-ship*))
|
|
|
+ (return-from buy-transaction NIL))
|
|
|
+ (progn
|
|
|
+ (let ((resource-sym (read-from-string resource))
|
|
|
+ (minus-funds (lambda (amount)
|
|
|
+ (let ((remainder (- available-player-funds amount)))
|
|
|
+ (setf (player-ship-credits *player-ship*) remainder)))))
|
|
|
+ (case resource-sym
|
|
|
+ ;;; This is insanely annoying, and will need to be duplicated
|
|
|
+ ;;; for the sell logic, but don't know how else to handle this here
|
|
|
+ (gruel (progn
|
|
|
+ (funcall minus-funds total-cost)
|
|
|
+ (setf (player-inventory-gruel inventory)
|
|
|
+ (+ (player-inventory-gruel inventory) quantity))))
|
|
|
+ (archeotech (progn
|
|
|
+ (funcall minus-funds total-cost)
|
|
|
+ (setf (player-inventory-archeotech inventory)
|
|
|
+ (+ (player-inventory-archeotech inventory) quantity))))
|
|
|
+ (petrofuel (progn
|
|
|
+ (funcall minus-funds total-cost)
|
|
|
+ (setf (player-inventory-petrofuel inventory)
|
|
|
+ (+ (player-inventory-petrofuel inventory) quantity))))
|
|
|
+ (spice (progn
|
|
|
+ (funcall minus-funds total-cost)
|
|
|
+ (setf (player-inventory-spice inventory)
|
|
|
+ (+ (player-inventory-spice inventory) quantity))))
|
|
|
+ (ammo (progn
|
|
|
+ (funcall minus-funds total-cost)
|
|
|
+ (setf (player-inventory-ammo inventory)
|
|
|
+ (+ (player-inventory-ammo inventory) quantity))))))
|
|
|
+ (format T "Successfully purchased ~A ~A~%" quantity resource)))))
|
|
|
+
|
|
|
+(defun buy-menu ()
|
|
|
+ (let ((item-to-buy (prompt-read "Enter a resource to buy: "))
|
|
|
+ (quantity (parse-integer (prompt-read "Enter a quantity to buy: "))))
|
|
|
+ (if (member item-to-buy '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
|
|
|
+ (progn
|
|
|
+ (buy-transaction item-to-buy quantity)
|
|
|
+ (trade-menu)))))
|
|
|
+
|
|
|
+
|
|
|
+(defun sell-transaction (resource quantity)
|
|
|
+ "Do the sale transaction, not intended to be called interactively"
|
|
|
+ (let* ((available-player-funds (player-ship-credits *player-ship*))
|
|
|
+ (inventory (player-ship-inventory *player-ship*))
|
|
|
+ (available-player-resource (funcall (symbol-function (find-symbol (string-upcase
|
|
|
+ (concatenate 'string "player-inventory-" resource))))
|
|
|
+ inventory))
|
|
|
+ (price (funcall (symbol-function (find-symbol (string-upcase
|
|
|
+ (concatenate 'string "market-price-of-" resource))))
|
|
|
+ (sector-market *sector*)))
|
|
|
+ (total-profit (* quantity price)))
|
|
|
+ (if (> quantity available-player-resource)
|
|
|
+ (progn
|
|
|
+ (format T "Not enough ~A to sell ~A. You have ~A~%" resource quantity available-player-resource)
|
|
|
+ (return-from sell-transaction NIL))
|
|
|
+ (progn
|
|
|
+ (let ((resource-sym (read-from-string resource))
|
|
|
+ (remove-resource (lambda (amount)
|
|
|
+ (let ((new-credits (+ available-player-funds total-profit)))
|
|
|
+ (setf (player-ship-credits *player-ship*) new-credits))
|
|
|
+ (- available-player-resource amount)))) ; This is pretty convoluted
|
|
|
+ ;;; remove-resource lambda is a pretty bad idea
|
|
|
+ ;;; it is used to set the new credits amount and then return the amount needed to
|
|
|
+ ;;; be removed from the resource in the player inventory. I did it this way
|
|
|
+ ;;; to keep the logic concise, but it smells bad and is probably stupid
|
|
|
+ (case resource-sym
|
|
|
+ ;;; This is insanely annoying, and will need to be duplicated
|
|
|
+ ;;; for the sell logic, but don't know how else to handle this here
|
|
|
+ (gruel (progn
|
|
|
+ (setf (player-inventory-gruel inventory) (funcall remove-resource quantity))))
|
|
|
+ (petrofuel (progn
|
|
|
+ (setf (player-inventory-petrofuel inventory) (funcall remove-resource quantity))))
|
|
|
+ (spice (progn
|
|
|
+ (setf (player-inventory-spice inventory) (funcall remove-resource quantity))))
|
|
|
+ (ammo (progn
|
|
|
+ (setf (player-inventory-ammo inventory) (funcall remove-resource quantity))))
|
|
|
+ (archeotech (progn
|
|
|
+ (setf (player-inventory-archeotech inventory) (funcall remove-resource quantity))))))
|
|
|
+ (format T "Successfully sold ~A ~A~%" quantity resource)))))
|
|
|
+
|
|
|
+(defun sell-menu ()
|
|
|
+ (let ((item-to-sell (prompt-read "Enter a resource to sell: "))
|
|
|
+ (quantity (parse-integer (prompt-read "Enter a quantity to sell: "))))
|
|
|
+ (if (member item-to-sell '("gruel" "ammo" "petrofuel" "archeotech" "spice") :test #'string=)
|
|
|
+ (progn
|
|
|
+ (sell-transaction item-to-sell quantity)
|
|
|
+ (trade-menu)))))
|
|
|
+
|
|
|
+;;; This is kept around in case I need it. I'm not sure
|
|
|
+;;; this is any less 'bad' than how buy/sell-transaction
|
|
|
+;;; currently work
|
|
|
+(defmacro dynamic-slot-access (predicate slotname accessor)
|
|
|
+ "Given a predicate where the predicate is a struct slot accessor like 'market-price-of-',
|
|
|
+ a slotname like 'petrofuel', and a struct location, return the result of the slot accessor function"
|
|
|
+ `(funcall ,(symbol-function (find-symbol (string-upcase (concatenate 'string predicate slotname)))) ,accessor))
|
|
|
+
|
|
|
+(defmacro dynamic-slot-setting (predicate slotname accessor value)
|
|
|
+ `(setf ,(funcall (symbol-function (find-symbol (string-upcase (concatenate 'string predicate slotname)))) accessor) ,value))
|
|
|
+
|
|
|
+(defun display-prices ()
|
|
|
+ (let ((market-list (list
|
|
|
+ (list "Petrofuel" (market-price-of-petrofuel (sector-market *sector*)))
|
|
|
+ (list "Gruel" (market-price-of-gruel (sector-market *sector*)))
|
|
|
+ (list "Spice" (market-price-of-spice (sector-market *sector*)))
|
|
|
+ (list "Ammo" (market-price-of-ammo (sector-market *sector*)))
|
|
|
+ (list "Archeotech" (market-price-of-archeotech (sector-market *sector*))))))
|
|
|
+ (format T "~%PLAYER CREDITS: ~A~%" (player-ship-credits *player-ship*))
|
|
|
+ (format T "~%MARKET PRICES~%")
|
|
|
+ (format-table T market-list :column-label '("Resource" "Cost"))))
|
|
|
+
|
|
|
+(defun trade-menu ()
|
|
|
+ (format t *trade-menu-options-display*)
|
|
|
+ (let ((option (prompt-read "Enter an option: ")))
|
|
|
+ (format t "~%")
|
|
|
+ (handle-opt (read-from-string option) *trade-opt-lookup*))
|
|
|
+ (trade-menu))
|
|
|
+
|
|
|
+;;; END TRADING ;;;
|
|
|
+
|
|
|
+;;; MARKET ;;;
|
|
|
+(defun range (start end)
|
|
|
+ "Basic function to generate a list that
|
|
|
+ contains a range of ints"
|
|
|
+ (loop for i from start below end collect i))
|
|
|
+
|
|
|
+;;; Use this parameter when randomizing market prices. Used to lookup how
|
|
|
+;;; 'random' prices should really be."
|
|
|
+(defparameter *market-price-bounds*
|
|
|
+ (list (cons 'petrofuel (range 10 41))
|
|
|
+ (cons 'ammo (range 5 31))
|
|
|
+ (cons 'archeotech (range 750 2001))
|
|
|
+ (cons 'spice (range 5 101))
|
|
|
+ (cons 'gruel (range 1 16))))
|
|
|
+
|
|
|
+(defun randomize-market-prices (market)
|
|
|
+ (loop for resource in *market-price-bounds*
|
|
|
+ do (progn
|
|
|
+ (
|
